1
(*$Id: m2test.mod,v 1.8 1999/08/19 11:28:42 andreas Exp $*)
2
(*Modula-2 Test Program*)
5
Copyright (C) 1995 Technische Universitaet Braunschweig, Germany.
6
Written by Andreas Zeller <zeller@gnu.org>.
8
This file is part of DDD.
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.
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.
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.
25
DDD is the data display debugger.
26
For details, see the DDD World-Wide-Web page,
27
`http://www.gnu.org/software/ddd/',
28
or send a mail to the DDD developers <ddd@gnu.org>.
31
(*--------------------------------------------------------------------------*)
32
(* This program defines some data structures and values that may be *)
33
(* examined using DDD. *)
34
(*--------------------------------------------------------------------------*)
38
FROM Storage IMPORT ALLOCATE, DEALLOCATE;
39
FROM String IMPORT Assign;
40
FROM InOut IMPORT WriteString, ReadString, WriteLn;
43
'$Id: m2test.mod,v 1.8 1999/08/19 11:28:42 andreas Exp $';
45
TYPE DayOfWeek = (Sun, Mon, Tue, Wed, Thu, Fri, Sat);
47
dayOfWeek : DayOfWeek;
52
DatePtr = POINTER TO Date;
55
name : ARRAY[1..20] OF CHAR;
57
TreePtr = POINTER TO Tree;
60
name : ARRAY[1..20] OF CHAR;
68
PROCEDURE setDate(VAR d: Date; dayOfWeek: DayOfWeek;
69
day: INTEGER; month: INTEGER; year: INTEGER);
71
d.dayOfWeek := dayOfWeek;
77
PROCEDURE newDate(VAR d: DatePtr; dayOfWeek: DayOfWeek;
78
day: INTEGER; month: INTEGER; year: INTEGER);
81
setDate(d^, dayOfWeek, day, month, year)
84
PROCEDURE setHoliday(VAR h: Holiday; dayOfWeek: DayOfWeek;
85
day: INTEGER; month: INTEGER; year: INTEGER;
89
setDate(h.date, dayOfWeek, day, month, year);
90
Assign(name, h.name, success)
93
PROCEDURE newTree(VAR p: TreePtr; value: INTEGER; name: ARRAY OF CHAR);
98
Assign(name, p^.name, success);
103
PROCEDURE disposeTree(p: TreePtr);
105
IF p^.left <> NIL THEN
106
disposeTree(p^.left);
108
IF p^.right <> NIL THEN
109
disposeTree(p^.right);
119
newTree(tree, 7, 'Ada'); (*Byron Lovelace*)
120
newTree(tree^.left, 1, 'Grace'); (*Murray Hopper*)
121
newTree(tree^.left^.left, 5, 'Judy'); (*Clapp*)
122
newTree(tree^.left^.right, 6, 'Kathleen'); (*McNulty*)
123
newTree(tree^.right, 9, 'Mildred'); (*Koss*)
125
setDate(tree^.date, Tue, 29, 11, 1994);
126
setDate(tree^.date, Wed, 30, 11, 1994);
133
daysOfWeek : ARRAY[1..7] OF DayOfWeek;
134
twodim : ARRAY[1..2] OF ARRAY [1..3] OF ARRAY[1..20] OF CHAR;
135
dates : ARRAY[1..4] OF Date;
136
datePtrs : ARRAY[1..4] OF DatePtr;
138
daysOfWeek[1] := Sun;
139
daysOfWeek[2] := Mon;
140
daysOfWeek[3] := Tue;
141
daysOfWeek[4] := Wed;
142
daysOfWeek[5] := Thu;
143
daysOfWeek[6] := Fri;
144
daysOfWeek[7] := Sat;
146
twodim[1,1] := "Pioneering";
147
twodim[1,2] := "women";
149
twodim[2,1] := "computer";
150
twodim[2,2] := "science";
153
newDate(datePtrs[1], Thu, 1, 9, 1994);
154
newDate(datePtrs[2], Tue, 10, 5, 1994);
155
newDate(datePtrs[3], Fri, 15, 7, 1994);
156
newDate(datePtrs[4], Sat, 24, 12, 1994);
159
dates[i] := datePtrs[i]^;
160
DISPOSE(datePtrs[i]);
165
VAR holiday : Holiday;
169
setHoliday(holiday, Sat, 31, 12, 1994, 'May all acquaintance be forgot');
175
VAR name : ARRAY[1..80] OF CHAR;
177
WriteString('What is your name? ');
179
WriteString('Hello, ');