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 / m2test.mod < prev    next >
Text File  |  1997-10-03  |  5KB  |  195 lines
  1. (*$Id: m2test.mod,v 1.7 1997/10/03 10:41:04 zeller Exp $*)
  2. (*Modula-2 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. 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.7 1997/10/03 10:41:04 zeller 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.
  195.