home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / TSPAS19.ZIP / TSUNTD.TST < prev    next >
Encoding:
Text File  |  1990-06-13  |  4.3 KB  |  172 lines
  1. {$R+}  (* Index range check on *)
  2.  
  3. (* This is a test program for the TSUNTD.TPU unit
  4.    2-Aug-89, Updated 25-Sep-89, 13-Jun-90 *)
  5.  
  6. uses TSUNTB,
  7.      TSUNTD;
  8.  
  9. const loop = 200;   (* If you do want to make it quickly, change this to 1 *)
  10.  
  11. var time : real;    (* For timing the tests *)
  12.  
  13. procedure LOGO;
  14. begin
  15.   writeln;
  16.   writeln ('TSUNTD unit test by Prof. Timo Salmi');
  17.   writeln ('University of Vaasa, Finland, ts@chyde.uwasa.fi');
  18.   writeln;
  19. end;
  20.  
  21. (* Dosdelay function, no Ctr unit needed *)
  22. procedure TEST1;
  23. begin
  24.   time := TIMERFN;
  25.   DOSDELAY (1000);
  26.   time := TIMERFN - time;
  27.   writeln ('DOSDELAY(1000)');
  28.   writeln ('Elapsed ', time:0:2);
  29.   writeln;
  30. end;  (* test1 *)
  31.  
  32. (* Justify a string right *)
  33. procedure TEST2;
  34. var sj1, sj2 : string;
  35.     i        : word;
  36. begin
  37.   writeln ('....:....1....:....2....:....3....:....4....:....5....');
  38.   sj1 := 'TSUNTD';
  39.   time := TIMERFN;
  40.   for i := 1 to loop do sj2 := TRIMRGFN (sj1, 20);
  41.   time := TIMERFN - time;
  42.   writeln (sj1); writeln (sj2);
  43.   writeln ('Elapsed ', time:0:2);
  44. end;  (* test2 *)
  45.  
  46. procedure TEST3;
  47. var sj1, sj2 : string;
  48.     i        : word;
  49. begin
  50.   writeln ('....:....1....:....2....:....3....:....4....:....5....');
  51.   sj1 := 'TSUNTD';
  52.   time := TIMERFN;
  53.   for i := 1 to loop do sj2 := TRIMRGFN (sj1, 4);
  54.   time := TIMERFN - time;
  55.   writeln (sj1); writeln (sj2);
  56.   writeln ('Elapsed ', time:0:2);
  57. end;  (* test3 *)
  58.  
  59. (* Justify a string left *)
  60. procedure TEST4;
  61. var sj1, sj2 : string;
  62.     i        : word;
  63. begin
  64.   writeln ('....:....1....:....2....:....3....:....4....:....5....');
  65.   sj1 := '     TSUNTD';
  66.   time := TIMERFN;
  67.   for i := 1 to loop do sj2 := TRIMLFFN (sj1, 20);
  68.   time := TIMERFN - time;
  69.   writeln (sj1); writeln (sj2);
  70.   writeln ('Elapsed ', time:0:2);
  71. end;  (* test4 *)
  72.  
  73. procedure TEST5;
  74. var sj1, sj2 : string;
  75.     i        : word;
  76. begin
  77.   writeln ('....:....1....:....2....:....3....:....4....:....5....');
  78.   sj1 := '     TSUNTD';
  79.   time := TIMERFN;
  80.   for i := 1 to loop do sj2 := TRIMLFFN (sj1, 4);
  81.   time := TIMERFN - time;
  82.   writeln (sj1); writeln (sj2);
  83.   writeln ('Elapsed ', time:0:2);
  84. end;  (* test5 *)
  85.  
  86. (* Lead a string *)
  87. procedure TEST6;
  88. var sj1, sj2 : string;
  89.     i        : word;
  90. begin
  91.   writeln ('....:....1....:....2....:....3....:....4....:....5....');
  92.   sj1 := 'TSUNTD';
  93.   time := TIMERFN;
  94.   for i := 1 to loop do sj2 := LEADFN (sj1, 20, '.');
  95.   time := TIMERFN - time;
  96.   writeln (sj1); writeln (sj2);
  97.   writeln ('Elapsed ', time:0:2);
  98. end;  (* test6 *)
  99.  
  100. (* Trail a string *)
  101. procedure TEST7;
  102. var sj1, sj2 : string;
  103.     i        : word;
  104. begin
  105.   writeln ('....:....1....:....2....:....3....:....4....:....5....');
  106.   sj1 := 'TSUNTD';
  107.   time := TIMERFN;
  108.   for i := 1 to loop do sj2 := TRAILFN (sj1, 20, '.');
  109.   time := TIMERFN - time;
  110.   writeln (sj1); writeln (sj2);
  111.   writeln ('Elapsed ', time:0:2);
  112. end;  (* test7 *)
  113.  
  114. (* Extract all substrings from a string *)
  115. procedure TEST8;
  116. {$IFNDEF VER40}
  117. const separators : string = ' ' + ',' + #9;
  118. {$ENDIF}
  119. var sj      : string;
  120.     partPtr : parseVectorPtrType;
  121.     n       : integer;
  122.     ok      : boolean;
  123.     i       : byte;
  124. {$IFDEF VER40} var separators : string; {$ENDIF}
  125. begin
  126.   {$IFDEF VER40} separators := ' ' + ',' + #9; {$ENDIF}
  127.   New (partPtr);
  128.   sj := 'TSUNTD unit test by Prof. Timo Salmi';
  129.   PARSE (sj, parse_parts_max, separators,
  130.          n, partPtr, ok);
  131.   if not ok then halt;   {or whatever you want do in case of an error}
  132.   for i := 1 to n do writeln (partPtr^[i]);
  133.   Dispose (partPtr); partPtr := nil;
  134. end;  (* test8 *)
  135.  
  136. (* Alternative method: Extract all substrings from a string *)
  137. procedure TEST9;
  138. var sj      : string;
  139.     n       : integer;
  140.     i       : byte;
  141. var separators : string;
  142. begin
  143.   separators := ' ' + ',' + #9;
  144.   sj := 'TSUNTD unit test by Prof. Timo Salmi';
  145.   n := STRCNTFN (sj, separators);
  146.   for i := 1 to n do writeln (SPARTFN(sj, separators, i));
  147. end;  (* test9 *)
  148.  
  149. (* How does it sound *)
  150. procedure TEST10;
  151. begin
  152.   AUDIO (300, 300); DOSDELAY(20); AUDIO (300, 300); AUDIO (400, 600);
  153. end;  (* test10 *)
  154.  
  155. (* Main program *)
  156. begin
  157.   TEST10;
  158.   LOGO;
  159.   TEST1;
  160.   TEST2;
  161.   TEST3;
  162.   TEST4;
  163.   write ('Press «═╝ '); readln;
  164.   TEST5;
  165.   TEST6;
  166.   TEST7;
  167.   write ('Press «═╝ '); readln;
  168.   TEST8;
  169.   write ('Press «═╝ '); readln;
  170.   TEST9;
  171. end.  (* tsuntd.tst *)
  172.