~pac72/ubuntu/lucid/ddd/devel

« back to all changes in this revision

Viewing changes to ddd/m2test.mod

  • Committer: Bazaar Package Importer
  • Author(s): Daniel Schepler
  • Date: 2004-07-22 03:49:37 UTC
  • mfrom: (1.2.1 upstream) (2.1.1 warty)
  • Revision ID: james.westby@ubuntu.com-20040722034937-cysl08t1jvba4jrx
Tags: 1:3.3.9-3
USERINFO has been renamed to USERINFO.txt; adjust debian/rules code
to match, to get correct information on the About DDD dialog.

Show diffs side-by-side

added added

removed removed

Lines of Context:
1
 
(*$Id: m2test.mod,v 1.8 1999/08/19 11:28:42 andreas Exp $*)
2
 
(*Modula-2 Test Program*)
3
 
 
4
 
(*
5
 
  Copyright (C) 1995 Technische Universitaet Braunschweig, Germany.
6
 
  Written by Andreas Zeller <zeller@gnu.org>.
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.gnu.org/software/ddd/',
28
 
  or send a mail to the DDD developers <ddd@gnu.org>.
29
 
*)
30
 
 
31
 
(*--------------------------------------------------------------------------*)
32
 
(* This program defines some data structures and values that may be         *)
33
 
(* examined using DDD.                                                      *)
34
 
(*--------------------------------------------------------------------------*)
35
 
 
36
 
MODULE m2test;
37
 
 
38
 
FROM Storage IMPORT ALLOCATE, DEALLOCATE;
39
 
FROM String IMPORT Assign;
40
 
FROM InOut IMPORT WriteString, ReadString, WriteLn;
41
 
 
42
 
CONST rcsid = 
43
 
    '$Id: m2test.mod,v 1.8 1999/08/19 11:28:42 andreas Exp $';
44
 
 
45
 
TYPE DayOfWeek = (Sun, Mon, Tue, Wed, Thu, Fri, Sat);
46
 
   Date        = RECORD
47
 
                    dayOfWeek   : DayOfWeek;
48
 
                    day         : INTEGER;
49
 
                    month       : INTEGER;
50
 
                    year        : INTEGER;
51
 
                 END;           
52
 
   DatePtr     = POINTER TO Date;
53
 
   Holiday     = RECORD
54
 
                    date : Date;
55
 
                    name : ARRAY[1..20] OF CHAR;
56
 
                 END;    
57
 
   TreePtr     = POINTER TO Tree;
58
 
   Tree        = RECORD
59
 
                    value : INTEGER;
60
 
                    name  : ARRAY[1..20] OF CHAR;
61
 
                    date  : Date;
62
 
                    left  : TreePtr;
63
 
                    right : TreePtr;
64
 
                 END;
65
 
 
66
 
VAR mainI: INTEGER;
67
 
 
68
 
PROCEDURE setDate(VAR d: Date; dayOfWeek: DayOfWeek;
69
 
                      day: INTEGER; month: INTEGER; year: INTEGER);
70
 
BEGIN
71
 
   d.dayOfWeek := dayOfWeek;
72
 
   d.day       := day;
73
 
   d.month     := month;
74
 
   d.year      := year
75
 
END setDate;
76
 
 
77
 
PROCEDURE newDate(VAR d: DatePtr; dayOfWeek: DayOfWeek;
78
 
                      day: INTEGER; month: INTEGER; year: INTEGER);
79
 
BEGIN
80
 
   NEW(d);
81
 
   setDate(d^, dayOfWeek, day, month, year)
82
 
END newDate;
83
 
 
84
 
PROCEDURE setHoliday(VAR h: Holiday; dayOfWeek: DayOfWeek;
85
 
                         day: INTEGER; month: INTEGER; year: INTEGER;
86
 
                         name: ARRAY OF CHAR);
87
 
VAR success: BOOLEAN;
88
 
BEGIN
89
 
   setDate(h.date, dayOfWeek, day, month, year);
90
 
   Assign(name, h.name, success)
91
 
END setHoliday;
92
 
 
93
 
PROCEDURE newTree(VAR p: TreePtr; value: INTEGER; name: ARRAY OF CHAR);
94
 
VAR success: BOOLEAN;
95
 
BEGIN
96
 
   NEW(p);
97
 
   p^.value := value;
98
 
   Assign(name, p^.name, success);
99
 
   p^.left  := NIL;
100
 
   p^.right := NIL
101
 
END newTree;
102
 
 
103
 
PROCEDURE disposeTree(p: TreePtr);
104
 
BEGIN
105
 
   IF p^.left <> NIL THEN
106
 
      disposeTree(p^.left);
107
 
   END; 
108
 
   IF p^.right <> NIL THEN
109
 
      disposeTree(p^.right);
110
 
   END;
111
 
 
112
 
   DISPOSE(p)
113
 
END disposeTree;
114
 
 
115
 
PROCEDURE treeTest;
116
 
VAR tree : TreePtr;
117
 
BEGIN
118
 
   tree := NIL;
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*)
124
 
 
125
 
   setDate(tree^.date, Tue, 29, 11, 1994);
126
 
   setDate(tree^.date, Wed, 30, 11, 1994);
127
 
 
128
 
   disposeTree(tree)
129
 
END treeTest;
130
 
 
131
 
PROCEDURE arrayTest;
132
 
VAR i           : INTEGER;
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;
137
 
BEGIN
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;
145
 
 
146
 
   twodim[1,1] := "Pioneering";
147
 
   twodim[1,2] := "women";
148
 
   twodim[1,3] := "in";
149
 
   twodim[2,1] := "computer";
150
 
   twodim[2,2] := "science";
151
 
   twodim[2,3] := "!";
152
 
 
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);
157
 
 
158
 
   FOR i := 1 TO 4 DO
159
 
      dates[i] := datePtrs[i]^;
160
 
      DISPOSE(datePtrs[i]);
161
 
   END
162
 
END arrayTest;
163
 
 
164
 
PROCEDURE typeTest;
165
 
VAR holiday : Holiday;
166
 
   r        : REAL;
167
 
   c        : CHAR;
168
 
BEGIN
169
 
   setHoliday(holiday, Sat, 31, 12, 1994, 'May all acquaintance be forgot');
170
 
   r := 3.1415;
171
 
   c := 'A'
172
 
END typeTest;
173
 
 
174
 
PROCEDURE inOutTest;
175
 
VAR name : ARRAY[1..80] OF CHAR;
176
 
BEGIN
177
 
   WriteString('What is your name? ');
178
 
   ReadString(name);
179
 
   WriteString('Hello, ');
180
 
   WriteString(name);
181
 
   WriteString('!');
182
 
   WriteLn
183
 
END inOutTest;
184
 
 
185
 
BEGIN
186
 
   mainI := 42;
187
 
   treeTest;
188
 
   mainI := mainI + 1;
189
 
   arrayTest;
190
 
   mainI := mainI + 1;
191
 
   typeTest;
192
 
   mainI := mainI - 1;
193
 
   inOutTest
194
 
END m2test.