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