ack/lang/pc/test/t3.p

{
  (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
 
           This product is part of the Amsterdam Compiler Kit.
 
  Permission to use, sell, duplicate or disclose this software must be
  obtained in writing. Requests for such permissions may be sent to
 
       Dr. Andrew S. Tanenbaum
       Wiskundig Seminarium
       Vrije Universiteit
       Postbox 7161
       1007 MC Amsterdam
       The Netherlands
 
}
{$i64 : sets of integers contain 64 bits}
program t3(input,output,f1,f2,f3,f4,f5,f6);

{ The Berkeley and EM-1 compilers both can handle this program }

const rcsversion='$Header$';
type wavelength = (red,blue,yellow,q1,q2,q3,q4,q5,q6,q7,q8,q9,q10,q11,
                   pink,green,orange);
  spectrum= set of wavelength;
  bit = 0..1;
  tp3=  packed record c1:char; i:integer; p:boolean; x:real end;
  tp4=  record c1:char; i:integer; p:boolean; x:real end;
  vec1 =  array [-10..+10] of integer;
  vrec = record case t:boolean of false:(r:real); true:(b:bit) end;

var t,pct,ect:integer;
 i,j,k,l:integer;
 x,y: real;
 p:boolean;
 c2:char;
 a1: vec1;
 c: array [1..20] of char;
 r3: tp3;
 r4: tp4;
 vr: vrec;
 colors: spectrum;
 letters,cset:set of char;
 f1: text;
 f2: file of spectrum;
 f3: file of tp3;
 f4: file of tp4;
 f5: file of vec1;
 f6: file of vrec;



procedure e(n:integer); 
begin 
  ect := ect + 1;
  writeln(' Error', n:3,' in test ', t) 
end;








{************************************************************************}
procedure tst34;
{ Global files }
var i:integer; c1:char;
begin t:=34; pct := pct + 1;
  rewrite(f1);
  if not eof(f1) then e(1);
  write(f1,'abc',20+7:2,'a':2); writeln(f1);
  write(f1,'xyz');
  i:=-3000;  write(f1,i:5);
  reset(f1);
  if eof(f1) or eoln(f1) then e(2);
  for i:=1 to 17 do read(f1,c[i]);
  if(c[1]<>'a') or (c[3]<>'c') or (c[5]<>'7') or (c[8]<>' ') or
     (c[12]<>'-') or (c[13]<>'3') or (c[16]<>'0') then e(3);
  if not eof(f1) then e(4);
  rewrite(f1);
  for i:= 32 to 127 do write(f1,chr(i));
  reset(f1);  p:= false;
  for i:= 32 to 127 do begin read(f1,c1); if ord(c1) <> i then p:=true end;
  if p then e(5);
  rewrite(f1);
  for c1 := 'a' to 'z' do write(f1,c1);
  reset(f1);  p:= false;
  for c1 := 'a' to 'z' do begin read(f1,c2); if c2 <> c1 then p:=true end;
  if p then e(6);
end;

procedure tst36;
var i,j:integer;
begin t:=36; pct:=pct+1;
  rewrite(f2); rewrite(f3); rewrite(f4); rewrite(f5); rewrite(f6);
  colors := []; f2^ := colors; put(f2);
  colors := [red]; f2^ := colors; put(f2);
  colors := [red,blue]; f2^ := colors; put(f2);
  colors := [yellow,blue]; f2^ := colors; put(f2);
  reset(f2);
  colors := f2^;  get(f2);  if colors <> [] then e(4);
  colors := f2^;  get(f2);  if colors <> [red] then e(5);
  colors := f2^;  get(f2);  if colors <> [blue,red] then e(6);
  colors := f2^;  get(f2);  if colors <> [blue,yellow] then e(7);
  r3.c1:='w';  r3.i:= -100; r3.x:=303.56;  r3.p:=true; f3^:=r3; put(f3);
  r3.c1:='y';  r3.i:= -35;  r3.x:=26.32;   f3^:=r3; put(f3);
  r3.c1:='q';  r3.i:= +29;  r3.x:=10.00;   f3^:=r3; put(f3);
  r3.c1:='j';  r3.i:=   8;  r3.x:=10000;   f3^:=r3; put(f3);
  for i:= 1 to 1000 do begin f3^ := r3; put(f3) end;
  reset(f3);
  r3 := f3^; get(f3);
  if (r3.c1<>'w') or (r3.i<>-100) or (r3.x<>303.56) then e(8);
  r3 := f3^; get(f3);
  if (r3.c1<>'y') or (r3.i<> -35) or (r3.x<> 26.32) then e(9);
  r3 := f3^; get(f3);
  if (r3.c1<>'q') or (r3.i<>  29) or (r3.x<> 10.00) then e(10);
  r3 := f3^; get(f3);
  if (r3.c1<>'j') or (r3.i<>   8) or (r3.x<> 10000) then e(11);

  r4.c1:='w';  r4.i:= -100; r4.x:=303.56;  r4.p:=true; f4^:=r4; put(f4);
  r4.c1:='y';  r4.i:= -35;  r4.x:=26.32;   f4^:=r4; put(f4);
  r4.c1:='q';  r4.i:= +29;  r4.x:=10.00;   f4^:=r4; put(f4);
  r4.c1:='j';  r4.i:=   8;  r4.x:=10000;   f4^:=r4; put(f4);
  for i:= 1 to 1000 do begin f4^ := r4; put(f4) end;
  reset(f4);
  r4 := f4^; get(f4);
  if (r4.c1<>'w') or (r4.i<>-100) or (r4.x<>303.56) then e(12);
  r4 := f4^; get(f4);
  if (r4.c1<>'y') or (r4.i<> -35) or (r4.x<> 26.32) then e(13);
  r4 := f4^; get(f4);
  if (r4.c1<>'q') or (r4.i<>  29) or (r4.x<> 10.00) then e(13);
  r4 := f4^; get(f4);
  if (r4.c1<>'j') or (r4.i<>   8) or (r4.x<> 10000) then e(14);

  for j:= 1 to 100 do
    begin for i:= -10 to +10 do a1[i] := i*j; f5^ := a1; put(f5); end;
  reset(f5);
  for j:= 1 to 99 do
    begin a1:=f5^; get(f5); for i:= -10 to +10 do if a1[i]<> i*j then e(14) end;

  vr.t:=false;
  for i:= 1 to 1000 do begin vr.r:=i+0.5;   f6^:=vr; put(f6) ;  p:=true; end;
  reset(f6);   p:=false;
  for i:= 1 to 999 do 
     begin  vr:=f6^; get(f6); if vr.r <> i+0.5 then p:=true end;
  if p then e(15);
  rewrite(f6);
  if not eof(f6) then e(16);
  for i:= 1 to 1000 do begin vr.b:=i mod 2; f6^:=vr; put(f6) end;
  reset(f6);
  if eof(f6) then e(17);
  p:=false;
  for i:= 1 to 1000 do 
     begin  vr:=f6^; get(f6); if vr.b <> i mod 2 then p:=true end;
  if not eof(f6) then e(18);
  if p then e(19);

  rewrite(f1);
  f1^:=chr(10); 
  put(f1);
  reset(f1);
  if ord(f1^) <> 32 then e(20);

  rewrite(f1);
  x:=0.0625;  write(f1,x:6:4, x:6:2);
  reset(f1);  read(f1,y);  if y <> 0.0625 then e(21);
  reset(f1);  for i:= 1 to 12 do begin c[i]:= f1^; get(f1) end;
  if (c[1]<>'0') or (c[2]<>'.') or (c[4]<>'6') then e(22);
  if (c[7]<>' ') or (c[9]<>'0') or (c[10]<>'.') or (c[12]<>'6') then e(23);
end;

{************************************************************************}
procedure tst35;
{ Local files }
var g1: text;
    g2: file of spectrum;
    g3: file of tp4;
    g4: file of vec1;
    i,j:integer;
 begin t:=35; pct := pct + 1;
  rewrite(g1); rewrite(g2); rewrite(g3); rewrite(g4);
  if (not (eof(g1) and eof(g4))) then e(1);
  writeln(g1,'abc', 20+7:2,'a':2);
  write(g1,'xyz');
  reset(g1);
  if eof(g1) or eoln(g1) then e(2);
  read(g1,c[1]); read(g1,c[2]); read(g1,c[3],c[4],c[5],c[6],c[7]);
  if (c[1]<>'a') or (c[3]<>'c') or (c[4]<>'2') or (c[7]<>'a') then e(3);
  if not eoln(g1) then e(4)
  else readln(g1);
  for i:=1 to 2 do read(g1,c[8+i]);
  if c[10]<>'y' then e(5);
  if eof(g1) or eoln(g1) then e(6);
  colors := []; g2^ := colors; put(g2);
  colors := [pink]; g2^ := colors; put(g2);
  colors := [pink,green];  g2^ := colors;  put(g2); 
  colors := [orange,green];  g2^ := colors;  put(g2); 
  reset(g2); 
  colors := g2^;  get(g2); if colors <> [] then e(7); 
  colors := g2^; get(g2); if colors <> [pink] then e(8);
  colors := g2^; get(g2); if colors <> [green,pink] then e(9);
  colors := g2^; get(g2); if colors <> [green,orange] then e(10);
  r4.c1:='w';  r4.i:= -100; r4.x:=303.56;  g3^:=r4; put(g3);
  r4.c1:='y';  r4.i:= -35;  r4.x:=26.32;   g3^:=r4; put(g3);
  r4.c1:='q';  r4.i:= +29;  r4.x:=10.00;   g3^:=r4; put(g3);
  r4.c1:='j';  r4.i:=   8;  r4.x:=10000;   g3^:=r4; put(g3);
  for i:= 1 to 1000 do begin g3^ := r4; put(g3) end;
  reset(g3);
  if eof(g3) then e(11);
  r4 := g3^;  get(g3);
  if (r4.c1<>'w') or (r4.i<>-100) or (r4.x<>303.56) then e(12);
  r4 := g3^;  get(g3);
  if (r4.c1<>'y') or (r4.i<> -35) or (r4.x<> 26.32) then e(13);
  r4 := g3^;  get(g3);
  if (r4.c1<>'q') or (r4.i<>  29) or (r4.x<> 10.00) then e(14);
  r4 := g3^;  get(g3);
  if (r4.c1<>'j') or (r4.i<>   8) or (r4.x<> 10000) then e(15);

  for j:= 1 to 100 do
    begin for i:= -10 to +10 do a1[i] := i*j; g4^ := a1; put(g4) end;
  reset(g4);
  for j:= 1 to 100 do
    begin a1:=g4^; get(g4); for i:= -10 to +10 do if a1[i]<>i*j then e(16) end;
  if not eof(g2) then e(17);
colors:=[q1,q2,q3,q4,q5,q6,q7,q8,q9,q10,q11];
end;


{***********************************************************************}
procedure tst37;
{ Intermediate level files }
var g1: text;
    g2: file of spectrum;
    g3: file of tp4;
    g4: file of vec1;

 procedure tst3701;
 var i,j:integer;
 begin t:=3701; pct := pct + 1;
  rewrite(g1); rewrite(g2); rewrite(g3); rewrite(g4);
  if (not (eof(g1) and eof(g4))) then e(1);
  writeln(g1,'abc', 20+7:2,'a':2);
  write(g1,'xyz');
  reset(g1);
  if eof(g1) or eoln(g1) then e(2);
  read(g1,c[1]); read(g1,c[2]); read(g1,c[3],c[4],c[5],c[6],c[7]);
  if (c[1]<>'a') or (c[3]<>'c') or (c[4]<>'2') or (c[7]<>'a') then e(3);
  if not eoln(g1) then e(4)
  else readln(g1);
  for i:=1 to 2 do read(g1,c[8+i]);
  if c[10]<>'y' then e(5);
  if eof(g1) or eoln(g1) then e(6);
  colors := []; g2^ := colors; put(g2);
  colors := [pink]; g2^ := colors; put(g2);
  colors := [pink,green];  g2^ := colors;  put(g2); 
  colors := [orange,green];  g2^ := colors;  put(g2); 
  reset(g2); 
  colors := g2^;  get(g2); if colors <> [] then e(7); 
  colors := g2^; get(g2); if colors <> [pink] then e(8);
  colors := g2^; get(g2); if colors <> [green,pink] then e(9);
  colors := g2^; get(g2); if colors <> [green,orange] then e(10);
  r4.c1:='w';  r4.i:= -100; r4.x:=303.56;  g3^:=r4; put(g3);
  r4.c1:='y';  r4.i:= -35;  r4.x:=26.32;   g3^:=r4; put(g3);
  r4.c1:='q';  r4.i:= +29;  r4.x:=10.00;   g3^:=r4; put(g3);
  r4.c1:='j';  r4.i:=   8;  r4.x:=10000;   g3^:=r4; put(g3);
  for i:= 1 to 1000 do begin g3^ := r4; put(g3) end;
  reset(g3);
  if eof(g3) then e(11);
  r4 := g3^;  get(g3);
  if (r4.c1<>'w') or (r4.i<>-100) or (r4.x<>303.56) then e(12);
  r4 := g3^;  get(g3);
  if (r4.c1<>'y') or (r4.i<> -35) or (r4.x<> 26.32) then e(13);
  r4 := g3^;  get(g3);
  if (r4.c1<>'q') or (r4.i<>  29) or (r4.x<> 10.00) then e(14);
  r4 := g3^;  get(g3);
  if (r4.c1<>'j') or (r4.i<>   8) or (r4.x<> 10000) then e(15);

  for j:= 1 to 100 do
    begin for i:= -10 to +10 do a1[i] := i*j; g4^ := a1; put(g4) end;
  reset(g4);
  for j:= 1 to 100 do
    begin a1:=g4^; get(g4); for i:= -10 to +10 do if a1[i]<>i*j then e(16) end;
 end;

begin t:=37;  pct := pct+1;
  tst3701;
  t:=37;
  if not eof(g2) then e(1);
end;



{***********************************************************************}
procedure tst38;
{ Advanced set theory }
begin t:=38;  pct := pct + 1;
  if [50] >= [49,51] then e(1);
  if [10] <= [9,11] then e(2);
  if not ([50] <= [49..51]) then e(3);
  i:=1;  j:=2; k:=3;  l:=5;
  if [i] + [j] <> [i,j] then e(4);
  if [i] + [j] <> [i..j] then e(5);
  if [j..i] <> [] then e(6);
  if [j..l] + [j..k] <> [2,3,4,5] then e(7);
  if ([1..k, l..8] + [10]) * [k..7, 2, l] <> [2,3,l..7] then e(8);
  if [i..9] - [j..l] <> [1,l+1..k*k] then e(9);
  if [k..j] <> [i..j] * [k..l] then e(10);
  if not ([k..10] <= [i..15]) then e(11);
  if not ([k-1..k*l] <= [i..15]) then e(12);

  letters := ['a','b', 'z'];
  if letters <> ['a', 'b', 'z'] then e(13);
  cset := ['a'] + ['b', 'c', 'z'] - ['c','d'];
  if cset <> letters then e(14);
  cset := ['a'..'e'];
  if cset <> ['a', 'b', 'c', 'd', 'e'] then e(15);
  cset := ['a'..'z', '0'..'9', '+','-','*','/','.',':','(',')','{','}']; 
  if not ('+' in cset) or not ('.' in cset) or not ('}' in cset) then e(16);
  letters := ['a'..'z' , '0'..'9'];
  if letters >= cset then e(17);
end;


{***********************************************************************}

{ Main program }
begin ect:=0; pct:=0;
  tst34;   tst35;   tst36;   tst37;   tst38;
  write('Program t3:',pct:3,' tests completed.');
  writeln('Number of errors = ',ect:0);
end.