home *** CD-ROM | disk | FTP | other *** search
/ PC World Komputer 1999 mARCH / PCWK3A99.iso / Linux / DDD331 / DDD-3_1_.000 / DDD-3_1_ / ddd-3.1.1 / ddd / ptest.p < prev    next >
Text File  |  1997-10-03  |  5KB  |  186 lines
  1. {$Id: ptest.p,v 1.6 1997/10/03 10:41:18 zeller Exp $}
  2. {Pascal Test Program}
  3.  
  4. {
  5.   Copyright (C) 1995 Technische Universitaet Braunschweig, Germany.
  6.   Written by Andreas Zeller <zeller@ips.cs.tu-bs.de>.
  7.   
  8.   This file is part of DDD.
  9.   
  10.   DDD is free software; you can redistribute it and/or
  11.   modify it under the terms of the GNU General Public
  12.   License as published by the Free Software Foundation; either
  13.   version 2 of the License, or (at your option) any later version.
  14.   
  15.   DDD is distributed in the hope that it will be useful,
  16.   but WITHOUT ANY WARRANTY; without even the implied warranty of
  17.   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  18.   See the GNU General Public License for more details.
  19.   
  20.   You should have received a copy of the GNU General Public
  21.   License along with DDD -- see the file COPYING.
  22.   If not, write to the Free Software Foundation, Inc.,
  23.   59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
  24.   
  25.   DDD is the data display debugger.
  26.   For details, see the DDD World-Wide-Web page, 
  27.   `http://www.cs.tu-bs.de/softech/ddd/',
  28.   or send a mail to the DDD developers <ddd@ips.cs.tu-bs.de>.
  29. }
  30.  
  31. {--------------------------------------------------------------------------}
  32. { This program defines some data structures and values that may be         }
  33. { examined using DDD.                                                      }
  34. {--------------------------------------------------------------------------}
  35.  
  36. program ptest(input, output);
  37.  
  38. const rcsid =
  39.     '$Id: ptest.p,v 1.6 1997/10/03 10:41:18 zeller Exp $';
  40.  
  41. type DayOfWeek = (Sun, Mon, Tue, Wed, Thu, Fri, Sat);
  42.    Date           = record
  43.             day_of_week    : DayOfWeek;
  44.             day        : integer;
  45.             month    : integer;
  46.             year    : integer;
  47.          end;        
  48.    DatePtr     = ^Date;
  49.    Holiday     = record
  50.             date : Date;
  51.             name : string;
  52.          end;     
  53.    TreePtr     = ^Tree;
  54.    Tree           = record
  55.             value : integer;
  56.             name  : string;
  57.             date  : Date;
  58.             left  : TreePtr;
  59.             right : TreePtr;
  60.          end;
  61.  
  62. var main_i: integer;
  63.  
  64. procedure set_date(var d: Date; day_of_week: DayOfWeek;
  65.                day: integer; month: integer; year: integer);
  66. begin
  67.    d.day_of_week := day_of_week;
  68.    d.day         := day;
  69.    d.month       := month;
  70.    d.year        := year
  71. end; { set_date }
  72.  
  73. procedure new_date(var d: DatePtr; day_of_week: DayOfWeek;
  74.                day: integer; month: integer; year: integer);
  75. begin
  76.    new(d);
  77.    set_date(d^, day_of_week, day, month, year)
  78. end; { new_date }
  79.  
  80. procedure set_holiday(var h: Holiday; day_of_week: DayOfWeek;
  81.               day: integer; month: integer; year: integer;
  82.               name: string);
  83. begin
  84.    set_date(h.date, day_of_week, day, month, year);
  85.    h.name := name
  86. end; { set_holiday }
  87.  
  88. procedure new_tree(var p: TreePtr; value: integer; name: string);
  89. begin
  90.    new(p);
  91.    p^.value := value;
  92.    p^.name  := name;
  93.    p^.left  := nil;
  94.    p^.right := nil
  95. end; { new_tree }
  96.  
  97. procedure dispose_tree(p: TreePtr);
  98. begin
  99.    if p^.left <> nil then
  100.       dispose_tree(p^.left);
  101.    if p^.right <> nil then
  102.       dispose_tree(p^.right);
  103.  
  104.    dispose(p)
  105. end; { dispose_tree }
  106.  
  107. procedure tree_test;
  108. var tree : TreePtr;
  109. begin
  110.    tree := nil;
  111.    new_tree(tree,              7, 'Ada');      {Byron Lovelace}
  112.    new_tree(tree^.left,        1, 'Grace');    {Murray Hopper}
  113.    new_tree(tree^.left^.left,  5, 'Judy');     {Clapp}
  114.    new_tree(tree^.left^.right, 6, 'Kathleen'); {McNulty}
  115.    new_tree(tree^.right,       9, 'Mildred');  {Koss}
  116.  
  117.    set_date(tree^.date, Tue, 29, 11, 1994);
  118.    set_date(tree^.date, Wed, 30, 11, 1994);
  119.  
  120.    dispose_tree(tree)
  121. end; { tree_test }
  122.  
  123. procedure array_test;
  124. var i        : integer;
  125.    days_of_week    : array[1..7] of DayOfWeek;
  126.    twodim    : array[1..2,1..3] of string;
  127.    dates    : array[1..4] of Date;
  128.    date_ptrs    : array[1..4] of DatePtr;
  129. begin
  130.    days_of_week[1] := Sun;
  131.    days_of_week[2] := Mon;
  132.    days_of_week[3] := Tue;
  133.    days_of_week[4] := Wed;
  134.    days_of_week[5] := Thu;
  135.    days_of_week[6] := Fri;
  136.    days_of_week[7] := Sat;
  137.  
  138.    twodim[1,1] := 'Pioneering';
  139.    twodim[1,2] := 'women';
  140.    twodim[1,3] := 'in';
  141.    twodim[2,1] := 'computer';
  142.    twodim[2,2] := 'science';
  143.    twodim[2,3] := '!';
  144.  
  145.    new_date(date_ptrs[1], Thu, 1, 9, 1994);
  146.    new_date(date_ptrs[2], Tue, 10, 5, 1994);
  147.    new_date(date_ptrs[3], Fri, 15, 7, 1994);
  148.    new_date(date_ptrs[4], Sat, 24, 12, 1994);
  149.  
  150.    for i := 1 to 4 do
  151.    begin
  152.       dates[i] := date_ptrs[i]^;
  153.       dispose(date_ptrs[i]);
  154.    end
  155. end; { array_test }
  156.  
  157. procedure type_test;
  158. var holiday : Holiday;
  159.    r        : real;
  160.    c        : char;
  161. begin
  162.    set_holiday(holiday, Sat, 31, 12, 1994, 'May all acquaintance be forgot');
  163.    r := 3.1415;
  164.    c := 'A'
  165. end; { type_test }
  166.  
  167. procedure in_out_test;
  168. var name : string;
  169. begin
  170.    write('What is your name? ');
  171.    read(name);
  172.    readln;
  173.    write('Hello, ', name:20, '!')
  174. end;
  175.  
  176. begin
  177.    main_i := 42;
  178.    tree_test;
  179.    main_i := main_i + 1;
  180.    array_test;
  181.    main_i := main_i + 1;
  182.    type_test;
  183.    main_i := main_i - 1;
  184.    in_out_test
  185. end.
  186.