home *** CD-ROM | disk | FTP | other *** search
/ ftp.barnyard.co.uk / 2015.02.ftp.barnyard.co.uk.tar / ftp.barnyard.co.uk / cpm / walnut-creek-CDROM / SIMTEL / CPMUG / CPMUG050.ARK / TESTER.PAS < prev    next >
Pascal/Delphi Source File  |  1984-04-29  |  4KB  |  182 lines
  1. (*
  2.   TITLE        pascal compiler TESTER program
  3.   FILENAME    TESTER.PAS
  4.   AUTHOR    Robert A. Van Valzah   01/08/80
  5.   LAST REVISED    R. A. V.    01/15/80
  6.   REASON    added repeat and while testing
  7. *)
  8.  
  9. (* check that all legal declaraton syntax is accepted *) 
  10. (* semantics can be checked only by inspection of the
  11.    generated code *)
  12.  
  13. const
  14.     c1    = 'x';
  15.     c2    = 13;
  16.     c3    = c2;
  17.     c4    = c3+13;
  18.     c5    = c2+c3+c4;
  19.     amax    = 513; (* max array subsript tested *)
  20.     
  21. type
  22.     t1    = c1..c2;
  23.     t2    = 0 ..c2;
  24.     t3    = c1..99;
  25.     t4    = t3;
  26.     t5    = (zero,one,two);
  27.     t6    = 0..99;
  28.     t7    = array [t1] of t6;
  29.     watyp    = array [0..amax] of word;
  30.     aatyp    = array [0..amax] of alfa;
  31.  
  32. var
  33.     v1    : t1;
  34.     v2,v3    : t2;
  35.     v4    : t6;
  36.     gi    : word; (* global variables used below *)
  37.     gj    : word;
  38.     gwa    : watyp; (* global word array *)
  39.     gaa    : aatyp; (* global alfa array *)
  40.     apatr    : alfa;     (* alfa test pattern *)
  41.  
  42. procedure fortest;
  43.  
  44.     var    i : word;
  45.  
  46.     procedure crlf; (* test nested procedures *)
  47.         begin put#1(13,10) end;
  48.  
  49.     begin
  50.     put#1('for test',13,10);
  51.     put#1('lcl 1-10');
  52.     for i:=1 to 10 do put#1(' ',i#);
  53.     crlf;
  54.     put#1('gbl 1-10');
  55.     for gi:=1 to 10 do put#1(' ',gi#);
  56.     crlf;
  57.     put#1('lcl 10-1');
  58.     for i:=10 downto 1 do put#1(' ',i#);
  59.     crlf;
  60.     end; (* procedure fortest *)
  61.  
  62. procedure repttest;
  63.  
  64.     var    i : word;
  65.  
  66.     begin
  67.     put#1('rpt 1-10');
  68.     i:=1;
  69.     repeat
  70.         put#1(' ',i#); i:=i+1
  71.     until i>10;
  72.     put#1(13,10)
  73.     end; (* procedure repttest *)
  74.  
  75. procedure whiltest;
  76.  
  77.     var    i : word;
  78.  
  79.     begin
  80.     put#1('whl 1-10');
  81.     i:=1;
  82.     while i<=10 do begin
  83.         put#1(' ',i#); i:=i+1 end;
  84.     put#1(13,10)
  85.     end; (* procedure whiltest *)
  86.  
  87. procedure simpvar; (* test simple variables *)
  88.  
  89.     var    i,j : word;
  90.         a,b : alfa;
  91.  
  92.     begin
  93.     put#1('testing ','simpvars',13,10);
  94.     i:=513;j:=1027; (* adjacent vars unique? *)
  95.     if i<>513 then put#1('nope  i=',i#);
  96.     if j<>1027 then put#1('nope  j=',j#);
  97.     a:='abcdefgh';
  98.     if a<>'abcdefgh' then put#1('alfacmpr');
  99.     (* test simple alfa subscripting hack *)
  100.     a[2]:='5'+'6'*256; (* a should = 'abcd56gh' *)
  101.     if (a<>'abcd56gh') or (a[2]<>'5'+'6'*256) then
  102.         put#1('alfa sub')
  103.     end; (* simpvar *)
  104.  
  105. procedure arytest; (* test array variables *)
  106.  
  107.     var    i: word; (* index to test arrays *)
  108.  
  109.     (* return word array test data based on subscript *)
  110.     function pattern(i: word);
  111.  
  112.         begin pattern:=amax-i+13 end;
  113.  
  114.     procedure wordary; (* test word arrays *)
  115.  
  116.         var    lwa: watyp; (* local word array *)
  117.  
  118.         begin
  119.         put#1('lwordary');
  120.         (* fill array with test pattern *)
  121.         for i:=0 to amax do lwa[i]:=pattern(i);
  122.         for i:=0 to amax do
  123.           if lwa[i]<>pattern(i) then
  124.             put#1('lwa fail',i#);
  125.         for i:=0 to amax do gwa[i]:=pattern(i);
  126.         for i:=0 to amax do
  127.           if gwa[i]<>pattern(i) then
  128.             put#1('gwa fail ',i#);
  129.         put#1(13,10)
  130.         end; (* procedure wordary *)
  131.  
  132.     procedure alfaary; (* test alfa arrays *)
  133.  
  134.         var    laa: aatyp;
  135.             a: alfa;
  136.  
  137.         (* return alfa array test data based in apatr *)
  138.         procedure alfapatr(i: word);
  139.  
  140.             begin
  141.             apatr[3]:=i*3;
  142.             apatr[2]:=i*5;
  143.             apatr[1]:=i*7;
  144.             apatr[0]:=i*9
  145.             end; (* procedure alfapatr *)
  146.  
  147.         begin (* procedure alfaary *)
  148.         put#1(13,10,'lalfaary');
  149.         for i:=0 to amax do begin
  150.           put#1('-');
  151.           alfapatr(i); laa[i]:=apatr end;
  152.         for i:=0 to amax do begin
  153.           alfapatr(i);
  154.           if laa[i]<>apatr
  155.             then put#1('laa fail',i#)
  156.             else put#1('.') end;
  157.  
  158.         put#1(13,10,'galfaary');
  159.         for i:=0 to amax do begin
  160.           put#1('-');
  161.           alfapatr(i); gaa[i]:=apatr end;
  162.         for i:=0 to amax do begin
  163.           alfapatr(i);
  164.           if gaa[i]<>apatr
  165.             then put#1('gaa fail',i#)
  166.             else put#1('.') end;
  167.         put#1(13,10)
  168.         end; (* procedure alfaary *)
  169.     
  170.     begin (* procedure arytest *)
  171.     wordary;
  172.     alfaary
  173.     end; (* procedure arytest *)
  174.  
  175. begin (* main line *)
  176. fortest;
  177. repttest;
  178. whiltest;
  179. simpvar;
  180. arytest
  181. end.
  182.