home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1989 / 06 / hitech / testarra.mod < prev    next >
Encoding:
Text File  |  1988-10-03  |  4.0 KB  |  133 lines
  1. MODULE TestArray;
  2.  
  3. (*-------------------------------------------------------------------*
  4.  * Programm zum Testen dynamischer Arrays des Moduls DynArrayHandler *
  5.  *-------------------------------------------------------------------*)
  6.  
  7. (*$C+*)    (* Setze Variablen bei Deklaration auf 0 *)
  8. (*$A+*)    (* Quick Subroutine Calls                *)
  9.  
  10. FROM Debugger IMPORT stop, Error, InitDebugger, Activate,
  11.                      Into, Leaving, Message, ShowByte, ShowWord, ShowLong;
  12. FROM Streams  IMPORT Stream, StreamKinds, OpenStream, CloseStream;
  13. FROM TextIO   IMPORT ReadString, ReadCard, ReadReal, 
  14.                      WriteCard, WriteReal, WriteString, WriteLn;
  15. FROM VT52     IMPORT ClearHome, WrapOn;
  16.  
  17. FROM DynArrayHandler IMPORT DynArray, DefDynArray, DeleteDynArray,
  18.                             Get, Put, LastIndex, ElementSize,
  19.                             LoadDynArray, SaveDynArray;
  20.  
  21. CONST DEBUG = FALSE;
  22.  
  23. TYPE
  24.    Typ1 = RECORD
  25.       r1,r2: REAL;
  26.       c1,c2: CARDINAL;
  27.    END;
  28.    
  29.    Typ2 = RECORD
  30.       part1: Typ1;
  31.       card : CARDINAL;
  32.    END;
  33.  
  34. VAR
  35.    t1   : Typ1;
  36.    t2   : Typ2;
  37.    s    : ARRAY[0..1000] OF CHAR;
  38.    a1,a2: DynArray;
  39.    out  : Stream;
  40.    reply: INTEGER;
  41.    i    : CARDINAL;
  42.  
  43.  
  44. PROCEDURE ShowArray (dyn: DynArray);
  45. VAR i : CARDINAL;
  46.     t1: Typ1;
  47.     
  48. BEGIN
  49.    IF DEBUG THEN Into ('ShowArray') END;
  50.    ClearHome; 
  51.    WriteString ('Das Array hat folgende Werte:'); WriteLn;
  52.  
  53.    FOR i:=0 TO LastIndex (a1) DO
  54.       Get (a1,i, t1);
  55.       WITH t1 DO
  56.          WriteString ('Index = '); 
  57.          WriteCard (i,3); 
  58.          WriteString (': ');
  59.          WriteReal (r1,10,5); WriteReal (r2,10,5); WriteString (' | ');
  60.          WriteCard (c1,8);    WriteCard (c2,8); WriteLn;
  61.       END;
  62.    END;
  63.    IF DEBUG THEN Leaving ('ShowArray') END;
  64. END ShowArray;
  65.    
  66.  
  67. BEGIN (* TestArray *)
  68.    InitDebugger ('TESTARRAY.BUG');
  69.    
  70.    (* Initialisierung der Records *)
  71.    WITH t1 DO r1:=9.0; r2:=11.0; c1:=0; c2:=1; END;
  72.    WITH t2 DO part1:=t1; card:=9; END;
  73.  
  74.    (* Definition der dynamischen Arrays  *)
  75.    DefDynArray (a1, t1);
  76.    DefDynArray (a2, t2);
  77.  
  78.    ClearHome; WrapOn;
  79.    WriteString ('***     Testprogramm für dynamische Arrays     ***');
  80.    WriteLn; WriteLn;
  81.  
  82.    (* Test: ElementSize *)
  83.    WriteString ('ElementSize von t1 = ');
  84.    WriteCard ( ElementSize(a1), 5); WriteLn;
  85.    
  86.    (* Eingabe von Werten in a1 *)
  87.    REPEAT
  88.       WriteLn;
  89.       WriteString ('Eingabe von Werten in ein dynamisches Array:'); WriteLn;
  90.       WriteString ('Index ( Ende der Eingabe: Index>30 ): '); 
  91.       ReadCard (i); WriteLn;      
  92.       WITH t1 DO
  93.          WriteString ('REALZAHL 1: '); ReadReal (r1); WriteLn;
  94.          WriteString ('REALZAHL 2: '); ReadReal (r2); WriteLn;
  95.          WriteString ('CARDINAL 1: '); ReadCard (c1); WriteLn;
  96.          WriteString ('CARDINAL 2: '); ReadCard (c2); WriteLn;
  97.       END;
  98.       Put (a1, i, t1); 
  99.       ShowArray (a1);
  100.    UNTIL LastIndex(a1)>30;
  101.    
  102.    (* Erzeugen der Fehlermeldung: Nicht initialisiertes Array       *)
  103.    DeleteDynArray (a2); (* Erst löschen, sonst Run-Time-Error Nr. 8 *)
  104.    Get (a2, 0, t2);
  105.    
  106.    (* Erzeugen der Fehlermeldung: Array Element inkompatible  *)
  107.    Get (a1, 0, t2);
  108.    
  109.    (* Erzeugen der Fehlermeldung: Array Index out of Bounds   *)
  110.    Get (a1, 999, t1);
  111.  
  112.    (* Erzeugen der Fehlermeldung: Array Element too large     *)
  113.    DefDynArray (a2, s);
  114.    
  115.    WriteString ('Speichern eines dynamischen Arrays ...'); WriteLn;
  116.    OpenStream (out,'DYNARRAY.OUT', READWRITE, reply);
  117.    IF reply<>0 THEN Error (reply); HALT END;
  118.    SaveDynArray (out, a1, t1); CloseStream (out, reply);
  119.    IF reply<>0 THEN Error (reply); HALT END;
  120.    
  121.    WriteString ('Laden eines dynamischen Arrays ...'); WriteLn;
  122.    WITH t1 DO r1:=0.0; r2:=1.0; c1:=1; c2:=0; END;
  123.    OpenStream (out,'DYNARRAY.OUT', READ, reply);
  124.    IF reply<>0 THEN Error (reply); HALT END;
  125.    LoadDynArray (out, a2, t1); CloseStream (out, reply);
  126.    IF reply<>0 THEN Error (reply); HALT END;
  127.    ShowArray (a2);
  128.    
  129.    (* Array löschen *)
  130.    DeleteDynArray (a1); DeleteDynArray (a2);
  131. END TestArray.
  132.  
  133.