{$w-} {p5c: supress warnings}
{$standard-pascal} { -- set gpc to standard pascal }

{
  PASCAL compiler test suite
  sourced from the Amsterdam Compiler Kit
}

{
  (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.

           This product is part of the Amsterdam Compiler Kit.

  The ACK is now open source, this was the original licence:

  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
}


program ta(output);

const
   yes=true; no=false;
   kew='Q';
   ww2lo = 1000939;
   ww2hi = 1000945;
   ONE=1;  TWO=2;  TEN=10; FIFTY=50; MINONE=-1;
   RR1=1.0; RR1H=1.5; RR2=2.0; RR3=3.0; RR4=4.0; RRMINONE=-1.0;


type
   wavelength = (red,blue,yellow,purple,white,gray,pink,green,orange,black,fuchia,maple,
		 violet,darkred,darkblue,darkyellow,darkwhite,darkpink,darkblack);
   tp2 =  record c1:char; i,j:integer; p:boolean; x:real end;
   tp3 =  packed record c1:char; i:integer; p:boolean; x:real end;
   ww2 = ww2lo..ww2hi;
   spectrum = set of wavelength;
   single = array [0..0] of integer;
   np = ^node;
   node = record val:integer; next: np end;
   bit = 0..1;
   vec1 =  array [-10..+10] of integer;

   vrec = record case t:boolean of false:(r:real); true:(b:bit) end;
   cmat = array[0..3,0..7] of ^spectrum;


var
   t,pct,ect:integer;  {test nr, proc counter, error counter}

   i,j,k,l,m:integer;
   w,x,y,z:real;
   eps: real;
   p,q,r:boolean;
   c1,c2,c3:char;

   sr1,sr2,sr3: ww2lo..ww2hi;
   color,hue,tint: wavelength;
   a1: vec1;
   a2: array [ww2] of real;
   a3: array[wavelength] of boolean;
   a4: array[(mouse,house)] of char;
   a5: array[50..52,(bat,cat),boolean,ww2] of integer;
   a6: packed array[0..10,0..3,0..3] of char;
   r1,r2: tp2;
   r3: tp3;
   r4: packed record c1:char; i,j:integer; p:boolean; x:real end;
   grat:spectrum;
   colors: set of wavelength;
   beasts: set of (pig,cow,chicken,farmersdaughter);
   bits: set of 0..1;
   p1: ^integer;
   p2: ^tp2;
   p3: ^single;
   p4: ^spectrum;
   head,tail: np;
   f1: text;
   f2: file of spectrum;
   f3: file of tp3;
   f4: file of tp2;
   f5: file of vec1;
   f6: file of vrec;

   bar: packed array[0..3] of 0..255;
   vr: vrec;
   c: array [1..20] of char;
   letters,cset:set of char;


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


procedure report;
begin
   write( pct:3,' tests completed,');
   if ect = 0 then
      writeln(' no errors')
   else if ect = 1 then
      writeln(' one error')
   else
      writeln(' ', ect:1, ' errors');
end;

procedure initialise;
var
   tmp : real;
begin
{calculate eps, where 1+eps is smallest nr that is different from 1.0 }
   eps := 1.0;
   repeat
      eps := eps/2;
      tmp := 2+eps;
   until tmp = 2;
   {writeln('eps is ', eps);}
end;


function inc(k:integer):integer; begin inc := k+1 end;
function twice(k:integer):integer; begin twice := 2*k end;
function decr(k:integer):integer; begin decr := k-1 end;


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

{ --- test standard operations on globals & locals --- }

procedure tst1;
{Arithmetic on global and local constants }

procedure tst101;
{ Arithmetic on local constants }
const
   ONE=1;  TWO=2;  TEN=10; FIFTY=50; MINONE=-1;
   RR1=1.0; RR1H=1.5; RR2=2.0; RR3=3.0; RR4=4.0; RRMINONE=-1.0;

begin t:=101; pct := pct + 1;
   if 1+1 <> 2 then e(1);
   if ONE+ONE <> TWO then e(2);
   if ONE+MINONE <> 0 then e(3);
   if ONE-TWO <> MINONE then e(4);
   if TWO-MINONE <> 3 then e(5);
   if TWO*TWO <> 4 then e(6);
   if 100*MINONE <> -100 then e(7);
   if 50*ONE <> 50 then e(8);
   if 50*9 <> 450 then e(9);
   if 50*TEN <> 500 then e(10);
   if 60 div TWO <> 30 then e(11);
   if FIFTY div TWO <> 25 then e(12);
   if -2 div 1 <> -2 then e(13);
   if -3 div 1 <> -3 then e(14);
   if -3 div 2 <> -1 then e(15);
   if ((1+2+3) * (2+3+4) * (3+5+5)) div 2 <> ((3 * ((5+3+2)*10)+51)*6) div 6
   then e(16);
   if (1000*2 + 5*7 + 13) * 128 div 8 <> 2*2*2*2*4*4*128 then e(17);
   if (1 * 2 * 3 * 4 * 5 * 6 * 7) div 5040  <>
      5040 div 7 div 6 div 5 div 4 div 3 div 2 then e(18);
   if -(-(-(-(-(-(-(-(-(1))))))))) <> -1 then e(19);
   if -1 -1 -1 -1 -1 <> -5 then e(20);
   if -                          1 <> -(((((((((((((1))))))))))))) then e(21);
   if -4 * (-5) <> 20 then e(22);
   if (9999-8) mod 97 <> 309 mod 3 then e(23);
   if 2<1 then e(24);
   if 2 <= 1 then e(25);
   if 2 = 3 then e(26);
   if 2 <> 2 then e(27);
   if 2 >= 3 then e(28);
   if 2 > 3 then e(29);
   if 2+0 <> 2 then e(30);
   if 2-0 <> 2 then e(31);
   if 2*0 <> 0 then e(32);
   if 0+2 <> 2 then e(33);
   if 0-2 <> -2 then e(34);
   if 0*2 <> 0 then e(35);
   if 0 div 1 <> 0 then e(36);
   if -0 <> 0 then e(37);
   if 0 - 0 <> 0 then e(38);
   if 0 * 0 <> 0 then e(39);
end;


{ Arithmetic on global constants}
begin t:=1; pct := pct + 1;
  if 1+1 <> 2 then e(1);
  if ONE+ONE <> TWO then e(2);
  if ONE+MINONE <> 0 then e(3);
  if ONE-TWO <> MINONE then e(4);
  if TWO-MINONE <> 3 then e(5);
  if TWO*TWO <> 4 then e(6);
  if 100*MINONE <> -100 then e(7);
  if 50*ONE <> 50 then e(8);
  if 50*9 <> 450 then e(9);
  if 50*TEN <> 500 then e(10);
  if 60 div TWO <> 30 then e(11);
  if FIFTY div TWO <> 25 then e(12);
  if -2 div 1 <> -2 then e(13);
  if -3 div 1 <> -3 then e(14);
  if -3 div 2 <> -1 then e(15);
  if ((1+2+3) * (2+3+4) * (3+5+5)) div 2 <> ((3 * ((5+3+2)*10)+51)*6) div 6
       then e(16);
  if (1000*2 + 5*7 + 13) * 128 div 8 <> 2*2*2*2*4*4*128 then e(17);
  if (1 * 2 * 3 * 4 * 5 * 6 * 7) div 5040  <>
      5040 div 7 div 6 div 5 div 4 div 3 div 2 then e(18);
  if -(-(-(-(-(-(-(-(-(1))))))))) <> -1 then e(19);
  if -1 -1 -1 -1 -1 <> -5 then e(20);
  if -                          1 <> -(((((((((((((1))))))))))))) then e(21);
  if -4 * (-5) <> 20 then e(22);
  if (9999-8) mod 97 <> 309 mod 3 then e(23);
  if 2<1 then e(24);
  if 2 <= 1 then e(25);
  if 2 = 3 then e(26);
  if 2 <> 2 then e(27);
  if 2 >= 3 then e(28);
  if 2 > 3 then e(29);
  if 2+0 <> 2 then e(30);
  if 2-0 <> 2 then e(31);
  if 2*0 <> 0 then e(32);
  if 0+2 <> 2 then e(33);
  if 0-2 <> -2 then e(34);
  if 0*2 <> 0 then e(35);
  if 0 div 1 <> 0 then e(36);
  if -0 <> 0 then e(37);
  if 0 - 0 <> 0 then e(38);
  if 0 * 0 <> 0 then e(39);
  tst101;
end;


{************************************************************************}
procedure tst2;
{ Arithmetic on global integer variables }
begin
  t:=2; pct := pct + 1;
  i:=1;  j:=2;  k:=3;  l:=4;  m:=10;
  if i+j <> k then e(1);
  if i+k <> l then e(2);
  if j-k <> -i then e(3);
  if j*(j+k) <> m then e(4);
  if -m <> -(k+k+l) then e(5);
  if i div i <> 1 then e(6);
  if m*m div m <> m then e(7);
  if 10*m <> 100 then e(8);
  if m*(-10) <> -100 then e(9);
  if j div k <> 0 then e(10);
  if 100 div k <> 33 then e(11);
  if i+j*k+l+m mod j + 50 div k <> 27 then e(12);
  if j*k*m div 6 <> 10 then e(13);
  if (k>4) or (k>=4) or (k=4) then e(14);
  if (m<j) or (m<=j) or (m=j) then e(15);
  if k <> i+j then e(16);
  if j < i then e(17);
  if j <= i then e(18);
  if j = i then e(19);
  if j <> j then e(20);
  if i >= j then e(21);
  if i > j then e(22);
end;


{************************************************************************}
procedure tst3;
{ Real arithmetic on globals }
begin t:=3; pct := pct + 1;
  if abs(1.0+1.0-2.0) > eps then e(1);
  if abs(1e10-1e10) > eps then e(2);
  if abs(RR1+RR1H+RR2+RR3+RR4+RRMINONE-10.5) > eps then e(3);
  if abs(1.0e-1 * 1.0e1 - 100e-2) > eps then e(4);
  if abs(10.0/3.0*3.0/10.0-100e-2) > eps then e(5);
  if 0.0e0 <> 0 then e(6);
  if abs(32767.0-32767.0) > eps then e(7);
  if abs(1.0+2+5+3.0e0+5.0e+0+140e-1-30.000)/100 > eps then e(8);
  if abs(-1+(-1)+(-1.0)+(-1e0)+(-1e+0)+(-1e-0) + ((((6)))) ) > eps then e(9);

  x:=1.50;  y:=3.00; z:= 0.10;
  if abs(5*y*z-x) > eps then e(10);
  if abs(y*y*y/z*x-405) > 405*eps then begin
     writeln((y*y*y/z*x-405)/eps:1:2);
     e(11);
  end;
  x:=1.1;  y:= 1.2;
  if y<x then e(12);
  if y <= x then e(13);
  if y = x then e(14);
  if x <> x then e(15);
  if x >= y then e(16);
  if x >y then e(17);
end;



{************************************************************************}
procedure tst4;
{ Boolean expressions on global consts and vars }
begin t:=4; pct := pct + 1;
  if not yes = true then e(1);
  if not no = false then e(2);
  if yes = no then e(3);
  if not true = not false then e(4);
  if true and false then e(5);
  if false or false then e(6);

  p:=true; q:=true; r:=false;
  if not p then e(7);
  if r then e(8);
  if p and r then e(9);
  if p and not q then e(10);
  if not p or not q then e(11);
  if (p and r) or (q and r) then e(12);
  if p and q and r then e(13);
  if (p or q) = r then e(14);
end;

{************************************************************************}
procedure tst5;
{ Characters, Subranges, Enumerated types with globals }
begin t:=5; pct := pct + 1;
  if 'Q' <> kew then e(1);
  c1 := 'a'; c2 := 'b'; c3 := 'a';
  if c1 = c2 then e(2);
  if c1 <> c3 then e(3);

  sr1:=ww2lo; sr2:=ww2hi; sr3:=ww2lo;
  if sr1=sr2 then e(4);
  if sr1<>sr3 then e(5);

  color := yellow; hue := blue; tint := yellow;
  if color = hue then e(6);
  if color <> tint then e(7);
end;


{************************************************************************}
procedure tst6;
{ Global arrays }
var i,j,k:integer;
begin t:=6; pct := pct + 1;
  for i:= -10 to 10 do a1[i] := i*i;
  if (a1[-10]<>100) or (a1[9]<>81) then e(1);

  for i:=ww2lo to ww2hi do a2[i]:=i-(ww2lo-0.5);
  if (abs(a2[ww2lo]-0.5) > eps) or (abs(a2[ww2hi]-((ww2hi-ww2lo)+0.5)) > eps) then e(2);

  color := yellow;
  a3[blue] := true;  a3[yellow] := true;
  if (a3[blue]<>true) or (a3[yellow]<>true) then e(3);
  a3[blue] := false;  a3[yellow] := false;
  if (a3[blue]<>false) or (a3[yellow]<>false) then e(4);

  a4[mouse]:='m'; a4[house]:='h';
  if (a4[mouse] <> 'm') or (a4[house]<>'h' ) then e(5);

  for i:=ww2lo to ww2hi do a5[51,bat,false,i]:=300+i;
  if a5[51,bat,false,(ww2lo+1)] <> (ww2lo+301) then e(6);
  for i:=50 to 52 do a5[i,cat,true,(ww2lo+4)]:=200+i;
  if (a5[50,cat,true,(ww2lo+4)] <> 250) or (a5[52,cat,true,(ww2lo+4)] <> 252) then e(7);

  for i:= -10 to 10 do a1[i]:= 0;
  for i:= 0 to 10 do a1[i div 2 + i div 2]:= i+1;
  if(a1[0]<>2) or (a1[5]<>0) or (a1[8]<>10) then e(8);

  for i:= 0 to 10 do
  for j:= 0 to 3 do
  for k:= 0 to 3 do
   if ( (i+j+k) div 2) * 2 = i+j+k then a6[i,j,k]:='e' else a6[i,j,k]:='o';
   if (a6[2,2,2]<>'e') or (a6[2,2,3]<>'o') or (a6[0,3,1]<>'e') then e(9);
end;


{************************************************************************}
procedure tst7;
{ Global records }
begin t:=7; pct := pct + 1;
  r1.c1:='x'; r1.i:=40; r1.j:=50; r1.p:=true; r1.x:=3.0;
  c1:='a'; i:=0;  j:=0; p:=false; x:=100.0;
  if (r1.c1<>'x') or (r1.i<>40) or (r1.p<>true) or (r1.x<>3.0) then e(1);
  r2:=r1;
  if (r2.c1<>'x') or (r2.i<>40) or (r2.p<>true) or (r2.x<>3.0) then e(2);
  i:=r1.i;  p:=r1.p;  c1:=r1.c1; x:=r1.x;
  if (c1<>'x') or (i<>40) or (p<>true) or (x<>3.0) then e(3);
  r4.c1:='x'; r4.i:=40; r4.j:=50; r4.p:=true; r4.x:=3.0;
  if (r4.c1<>'x') or (r4.i<>40) or (r4.p<>true) or (r4.x<>3.0) then e(4);
end;



{************************************************************************}
procedure tst8;
{ Global sets }
begin
  t:=8; pct := pct + 1;
  colors := [];
  colors := colors + [];
  if colors <> [] then e(1);
  colors := colors + [red];
  if colors <> [red] then e(2);
  colors := colors + [blue];
  if colors <> [red,blue] then e(3);
  if colors <> [blue,red] then e(4);
  colors := colors - [red];
  if colors <> [blue] then e(5);
  beasts := [chicken] + [chicken,pig];
  if beasts <> [pig,chicken] then e(6);
  beasts := [] - [farmersdaughter] + [cow] - [cow];
  if beasts <> [] then e(7);
  bits := [0] + [1] - [0];
  if bits <> [1] then e(8);
  bits := [] + [] + [] -[] + [0] + [] + [] - [0];
  if bits <> [] then e(9);
  if not ([] <= [red]) then e(10);
  if [red] >= [blue] then e(11);
  if [red] <= [blue] then e(12);
  if [red] = [blue] then e(13);
  if not ([red] <= [red,blue]) then e(14);
  if not ([red,blue] <= [red,yellow,blue]) then e(15);
  if not ([blue,yellow] >= [blue] + [yellow]) then e(16);
  grat := [ red,blue,yellow,purple,white,gray,pink,black,fuchia,maple,
           violet,darkred,darkblue,darkyellow,darkwhite,darkpink,darkblack];
  if grat<>[red,blue,yellow,purple,white,gray,pink,black,fuchia,maple,violet,
   darkred,darkblue,darkyellow,darkwhite,darkpink,darkblack] then e(17);
  if not ([10] <= [10]) then e(18);
end;


{************************************************************************}
procedure tst9;
{ Global pointers }
begin t:=9; pct := pct + 1;
  new(p1); new(p2); new(p3); new(p4);
  p1^ := 1000066;
  if p1^ <> 1000066 then e(1);
  p2^.i := 1215;
  if p2^.i <> 1215 then e(2);
  p3^[0]:= 1566;
  if p3^[0] <> 1566 then e(3);
  p4^ := [red];
  if p4^ <> [red] then e(4);
  dispose(p1); dispose(p2); dispose(p3); dispose(p4);
end;


{************************************************************************}
procedure tst10;
{ More global pointers }
var i:integer;
begin t:=10; pct := pct + 1;
  head := nil;
  for i:= 1 to 100 do
    begin new(tail); tail^.val:=100+i; tail^.next :=head; head:= tail end;
  if (tail^.val<>200) or (tail^.next^.val<>199) then e(1);
  if tail^.next^.next^.next^.next^.next^.next^.next^.next^.val<> 192 then e(2);
  tail^.next^.next^.next^.val := 30;
  if tail^.next^.next^.next^.val <> 30 then e(3);
  while head <> nil do begin
     head := tail^.next;
     dispose(tail);
     tail := head;
  end;
end;


{************************************************************************}
 procedure tst11;
 { Arithmetic on local integer variables }
 var i,j,k,l,m:integer;
 begin t:=11; pct := pct + 1;
  i:=1;  j:=2;  k:=3;  l:=4;  m:=10;
  if i+j <> k then e(1);
  if i+k <> l then e(2);
  if j-k <> -i then e(3);
  if j*(j+k) <> m then e(4);
  if -m <> -(k+k+l) then e(5);
  if i div i <> 1 then e(6);
  if m*m div m <> m then e(7);
  if 10*m <> 100 then e(8);
  if m*(-10) <> -100 then e(9);
  if j div k <> 0 then e(10);
  if 100 div k <> 33 then e(11);
  if i+j*k+l+m mod j + 50 div k <> 27 then e(12);
  if j*k*m div 6 <> 10 then e(13);
  if (k>4) or (k>=4) or (k=4) then e(14);
  if (m<j) or (m<=j) or (m=j) then e(15);
  if k <> i+j then e(16);
  if j < i then e(17);
  if j <= i then e(18);
  if j = i then e(19);
  if j <> j then e(20);
  if i >= j then e(21);
  if i > j then e(22);
 end;


{************************************************************************}
 procedure tst12;
 { Real arithmetic on locals }
 var x,y,z:real;
 begin t:=12; pct := pct + 1;

  x:=1.50;  y:=3.00; z:= 0.10;
  if abs(5*y*z-x) > eps then e(10);
  if abs(y*y*y/z*x-405) > 405*eps then e(11);
  x:=1.1;  y:= 1.2;
  if y<x then e(12);
  if y <= x then e(13);
  if y = x then e(14);
  if x <> x then e(15);
  if x >= y then e(16);
  if x >y then e(17);
 end;



{************************************************************************}
 procedure tst13;
 { Boolean expressions using locals }
 var pp,qq,rr:boolean;
begin
   t:=13; pct := pct + 1;
  if not yes = true then e(1);
  if not no = false then e(2);
  if yes = no then e(3);
  if not true = not false then e(4);
  if true and false then e(5);
  if false or false then e(6);

  pp:=true; qq:=true; rr:=false;
  if not pp then e(7);
  if rr then e(8);
  if pp and rr then e(9);
  if pp and not qq then e(10);
  if not pp or not qq then e(11);
  if (pp and rr) or (qq and rr) then e(12);
  if pp and qq and rr then e(13);
  if (pp or qq) = rr then e(14);
 end;

{************************************************************************}
 procedure tst14;
 { Characters, Subranges, Enumerated types using locals }
const
   kew = 'q';
 var cc1,cc2,cc3:char;
   sr1,sr2,sr3: ww2lo..ww2hi;
   color,hue,tint: (ochre,magenta);
 begin t:=14; pct := pct + 1;
  if 'q' <> kew then e(1);
  cc1 := 'a'; cc2 := 'b'; cc3 := 'a';
  if cc1 = cc2 then e(2);
  if cc1 <> cc3 then e(3);

  sr1:=ww2lo; sr2:=ww2hi; sr3:=ww2lo;
  if sr1=sr2 then e(4);
  if sr1<>sr3 then e(5);
  bar[0]:=200;  bar[1]:=255;  bar[2]:=255; bar[3]:=203;
  if (bar[0]<>200) or (bar[1]<>255) or (bar[2]<>255) or (bar[3]<>203) then e(6);

  color := ochre; hue:=magenta; tint := ochre;
  if color = hue then e(7);
  if color <> tint then e(8);
 end;


{************************************************************************}
 procedure tst15;
 { Local arrays }
 type colour = (magenta,ochre);
 var aa1: array [-10..+10] of integer;
    aa2: array [ww2] of real;
    aa3: array[colour] of boolean;
    aa4: array[(mouse,house,louse)] of char;
    aa5: array[50..52,(bat,cat),boolean,ww2] of integer;
    aa6: packed array[0..10,0..3,0..3] of char;
    i,j,k:integer;
 begin t:=15; pct := pct + 1;
  for i:= -10 to 10 do aa1[i] := i*i;
  if (aa1[-10]<>100) or (aa1[9]<>81) then e(1);

  for i:=ww2lo to ww2hi do aa2[i]:=i-(ww2lo-0.5);
  if (abs(aa2[ww2lo]-0.5) > eps) or (abs(aa2[ww2hi]-((ww2hi-ww2lo)+0.5)) > eps) then e(2);

  aa3[magenta] := true;  aa3[ochre] := true;
  if (aa3[magenta]<>true) or (aa3[ochre]<>true) then e(3);
  aa3[magenta] := false;  aa3[ochre] := false;
  if (aa3[magenta]<>false) or (aa3[ochre]<>false) then e(4);

  aa4[mouse]:='m'; aa4[house]:='h';  aa4[louse]:='l';
  if (aa4[mouse] <> 'm') or (aa4[house]<>'h' ) or (aa4[louse]<>'l') then e(5);

  for i:=ww2lo to ww2hi do aa5[51,bat,false,i]:=300+i;
  if aa5[51,bat,false,(ww2lo+1)] <> (ww2lo+301) then e(6);
  for i:=50 to 52 do aa5[i,cat,true,(ww2lo+4)]:=200+i;
  if (aa5[50,cat,true,(ww2lo+4)] <> 250) or (aa5[52,cat,true,(ww2lo+4)] <> 252) then e(7);

  for i:= -10 to 10 do aa1[i]:= 0;
  for i:= 0 to 10 do aa1[i div 2 + i div 2]:= i+1;
  if(aa1[0]<>2) or (aa1[5]<>0) or (aa1[8]<>10) then e(8);

  for i:= 0 to 10 do
  for j:= 0 to 3 do
  for k:= 0 to 3 do
    if ( (i+j+k) div 2) * 2 = i+j+k then aa6[i,j,k]:='e' else aa6[i,j,k]:='o';
  if (aa6[2,2,2]<>'e') or (aa6[2,2,3]<>'o') or (aa6[0,3,1]<>'e') then e(9);
 end;



{************************************************************************}
 procedure tst16;
 { Local records }
 var r1,r2: tp2;
     r3: packed record c1:char; i,j:integer; p:boolean; x:real end;
 begin t:=16; pct := pct + 1;
  r1.c1:='x'; r1.i:=40; r1.j:=50; r1.p:=true; r1.x:=3.0;
  c1:='a'; i:=0;  j:=0; p:=false; x:=100.0;
  if (r1.c1<>'x') or (r1.i<>40) or (r1.p<>true) or (r1.x<>3.0) then e(1);
  r2:=r1;
  if (r2.c1<>'x') or (r2.i<>40) or (r2.p<>true) or (r2.x<>3.0) then e(2);
  i:=r1.i;  p:=r1.p;  c1:=r1.c1; x:=r1.x;
  if (c1<>'x') or (i<>40) or (p<>true) or (x<>3.0) then e(3);
  r3.c1:='x'; r3.i:=40; r3.j:=50; r3.p:=true; r3.x:=3.0;
  if (r3.c1<>'x') or (r3.i<>40) or (r3.p<>true) or (r3.x<>3.0) then e(4);
 end;


{************************************************************************}
 procedure tst17;
 { Local sets }
 var colors: set of (pink,green,orange,red);
     beasts: set of (pig,cow,chicken,farmersdaughter);
     bits: set of 0..1;
 begin t:=17; pct := pct + 1;
  colors := [];
  colors := colors + [];
  if colors <> [] then e(1);
  colors := colors + [pink];
  if colors <> [pink] then e(2);
  colors := colors + [green];
  if colors <> [pink,green] then e(3);
  if colors <> [green,pink] then e(4);
  colors := colors - [pink,orange];
  if colors <> [green] then e(5);
  beasts := [chicken] + [chicken,pig];
  if beasts <> [pig,chicken] then e(6);
  beasts := [] - [farmersdaughter] + [cow] - [cow];
  if beasts <> [] then e(7);
  bits := [0] + [1] - [0];
  if bits <> [1] then e(8);
  bits := [] + [] + [] + [0] + [] + [0];
  if bits <> [0] then e(9);
  if ord(red) <> 3 then e(10);
 end;


{************************************************************************}
 procedure tst18;
 { Local pointers }
    type rainbow = set of (pink,purple,chartreuse);
    var p1: ^integer;
    p2: ^tp2;
    p3: ^single;
    p4: ^rainbow;
 begin t:=18; pct := pct + 1;
  new(p1); new(p2); new(p3); new(p4);
  p1^ := 1066;
  if p1^ <> 1066 then e(1);
  p2^.i := 1215;
  if p2^.i <> 1215 then e(2);
  p3^[0]:= 1566;
  if p3^[0] <> 1566 then e(3);
  p4^ := [pink] + [purple] + [purple,chartreuse] - [purple];
  if p4^ <> [pink,chartreuse] then e(4);
  dispose(p1); dispose(p2); dispose(p3); dispose(p4);
 end;


{************************************************************************}
procedure tst19;
{ More local pointers }
 var head,tail: np; i:integer;
 begin
  t:=19; pct := pct + 1;
  head := nil;
  for i:= 1 to 100 do
    begin new(tail); tail^.val:=100+i; tail^.next :=head; head:= tail end;
  if (tail^.val<>200) or (tail^.next^.val<>199) then e(1);
  if tail^.next^.next^.next^.next^.next^.next^.next^.next^.val<> 192 then e(2);
  tail^.next^.next^.next^.val := 30;
  if tail^.next^.next^.next^.val <> 30 then e(3);
  while head <> nil do begin
     head := tail^.next;
     dispose(tail);
     tail := head;
  end;
 end;


{************************************************************************}
procedure tst20;
{ Mixed local and global }
var li:integer;
    lx:real;
begin t:=20; pct := pct + 1;
  li:=6;  i:=li;  if i<>6 then e(1);
  i:=6;  li:=i;  if li <> 6 then e(2);
  lx := 3.5;  x:=lx;  if x <> 3.5 then e(3);
  x:= 4.5;  lx:= x;  if lx <> 4.5 then e(4);
end;



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



{************************************************************************}
procedure tst21;
{ Test things packed }
var i:integer;  c:char;
   r1: packed record c:char; b:boolean;  i:integer end;
   r2: packed record c:char; i:integer; b:boolean; j:integer end;
   r3: packed record c:char; r:real end;
   r4: packed record i:0..10; j:integer end;
   r5: packed record x:array[1..3] of char; i:integer end;
   r6: packed record x: packed array[1..3] of char; i:integer end;
   r7: packed record c:char; x:packed array[1..3] of char end;
   r8: packed record c:char; x:packed array[1..3] of integer end;
   r9: record x:packed record c:char; i:integer end; i:integer; c:char end;
   r10:packed record a:0..100; b:0..100; c:char; d:char end;

   a1: packed array[1..3] of char;
   a2: packed array[1..3] of integer;
   a3: packed array[1..7] of real;
   a4: packed array[1..7] of array[1..11] of char;
   a5: packed array[1..5] of array[1..11] of integer;
   a6: packed array[1..9] of packed array[1..11] of char;
   a7: packed array[1..3] of packed array[1..5] of integer;
begin
   t:=21;  pct := pct + 1;
   i:=4;  x:=3.5;  c:='x'; p:=true;

   r1.c:='a';  r1.b:=true;  r1.i:=i;   p:=r1.b;  j:=r1.i;
   r2.c:=c;  r2.i:=i;  r2.b:=p;  r2.j:=i;  j:=r2.i;  j:=r2.j;
   r3.c:=c;  r3.r:=x;  y:=r3.r;
   r4.i:=i;  r4.j:=i;  j:=r4.i;  j:=r4.j;
   r5.x[i-2]:=c;  r5.i:=i;  j:=r5.i;
   r6.x[i-1]:=c;  r6.i:=i;  j:=r6.i;
   r7.c:=c;  r7.x[i-1]:=c;  c1:=r7.c;  c1:=r7.x[i-1];
   r8.c:=c;  r8.x[i-1]:=5;  j:=r8.x[i-1];
   r9.x.c:=c;  r9.x.i:=i;  r9.c:=c;  j:=r9.x.i;

   if (r1.c <> 'a') or (r1.b <> true) or (r1.i <> 4) then e(1);
   if (r2.c<>'x') or (r2.i<>4) or (r2.b<>p) or (r2.j<>4) then e(2);
   if (r3.c<>'x') or (r3.r<>3.5) then e(3);
   if (r4.i<>4) or (r4.j<>4) then e(4);
   if (r5.x[2]<>'x') or (r5.i<>4) then e(5);
   if (r6.x[3]<>'x') or (r6.i<>4) then e(6);
   if (r7.c<>'x') or (r7.x[3]<>'x') or (c<>c1) then e(7);
   if (r8.c<>'x') or (r8.x[3]<>5) then e(8);
   if (r9.x.c<>'x') or (r9.x.i<>4) or (r9.c<>'x') then e(9);

   i:=4;  a1[i-1]:=c;    a2[i-1]:=i;   a3[i]:=x;
   a4[i][i+1]:=c;
   a5[i][i+1]:=i;  j:=a5[i][i+1];
   a6[i][i+1]:=c;
   a7[i-1][i+1]:=i;  j:=a7[i-1][i+1];

   if a1[i-1] <> 'x' then e(10);
   if a2[i-1] <> 4 then e(11);
   if a3[i] <> 3.5 then e(12);
   if a4[i][i+1] <> 'x' then e(13);
   if a5[i][i+1] <> 4 then e(14);
   if a6[i][i+1] <> 'x' then e(15);
   if a7[i-1][i+1] <> 4 then e(16);

   i:=75; c:='s';
   r10.a:=i;  r10.b:=i+1;  r10.c:='x';  r10.d:=c;
   if (r10.a<>i) or (r10.b<>76) or (r10.c<>'x') or (r10.d<>'s') then e(17);
   i:=r10.a;  if i<>75 then e(18);
   i:=r10.b;  if i<>76 then e(19);
   c:=r10.c;  if c<>'x'then e(20);
   c:=r10.d;  if c<>'s'then e(21);
end;


{************************************************************************}
procedure tst22;
{ References to intermediate lexical levels }
const
   kew='q';

type wavelength = (pink,green,orange);
   ww2= 1939..1945;
   tp2=  record c1:char; i,j:integer; p:boolean; x:real end;
   single= array [0..0] of integer;
   spectrum= set of wavelength;
   pnode = ^node;
   node = record val:integer; next: pnode end;
   vec1 = array[-10..+10] of integer;

var j,k,m:integer;
   x,y,z:real;
   p,q,r:boolean;
   c1,c2,c3:char;
   sr1,sr2,sr3: 1939..1945;
   color,hue,tint: wavelength;
   a1: vec1;
   a2: array [ww2] of real;
   a3: array[wavelength] of boolean;
   a4: array[(mouse,house)] of char;
   a5: array[50..52,(bat,cat,rat),boolean,ww2] of integer;
   a6: packed array[0..10,0..3,0..3] of char;
   r1,r2: tp2;
   r3: packed record c1:char; i,j:integer; p:boolean; x:real end;
   colors: spectrum;
   beasts: set of (pig,chicken,farmersdaughter);
   bits: set of 0..1;
   p1: ^integer;
   p2: ^tp2;
   p3: ^single;
   p4: ^spectrum;
   tail: np;




procedure tst2201;
 { Arithmetic on intermediate level integer variables }
begin t:=2201; pct := pct + 1;
   i:=1;  j:=2;  k:=3;  l:=4;  m:=10;
   if i+j <> k then e(1);
   if i+k <> l then e(2);
   if j-k <> -i then e(3);
   if j*(j+k) <> m then e(4);
   if -m <> -(k+k+l) then e(5);
   if i div i <> 1 then e(6);
   if m*m div m <> m then e(7);
   if 10*m <> 100 then e(8);
   if m*(-10) <> -100 then e(9);
   if j div k <> 0 then e(10);
   if 100 div k <> 33 then e(11);
   if i+j*k+l+m mod j + 50 div k <> 27 then e(12);
   if j*k*m div 6 <> 10 then e(13);
   if (k>4) or (k>=4) or (k=4) then e(14);
   if (m<j) or (m<=j) or (m=j) then e(15);
   if k <> i+j then e(16);
end;


procedure tst2202;
 { Real arithmetic using intermediate level variables }
begin t:=2202; pct := pct + 1;

   x:=1.50;  y:=3.00; z:= 0.10;
   if abs(5*y*z-x) > eps then e(10);
   if abs(y*y*y/z*x-405) > 0.25*eps*405 then begin
      writeln('result is',  abs(y*y*y/z*x-405) );
      e(11);
   end;
   x:=1.1;  y:= 1.2;
   if y<x then e(12);
   if y <= x then e(13);
   if y = x then e(14);
   if x <> x then e(15);
   if x >= y then e(16);
   if x >y then e(17);
end;

procedure tst2203;
 { Boolean expressions using intermediate level variables }
begin t:=2203; pct := pct + 1;
   p:=true; q:=true; r:=false;
   if not p then e(7);
   if r then e(8);
   if p and r then e(9);
   if p and not q then e(10);
   if not p or not q then e(11);
   if (p and r) or (q and r) then e(12);
   if p and q and r then e(13);
   if (p or q) = r then e(14);
end;

procedure tst2204;
 { Characters, Subranges, Enumerated types using intermediate level vars }
begin t:=2204; pct := pct + 1;
   if 'q' <> kew then e(1);
   c1 := 'a'; c2 := 'b'; c3 := 'a';
   if c1 = c2 then e(2);
   if c1 <> c3 then e(3);

   sr1:=1939; sr2:=1945; sr3:=1939;
   if sr1=sr2 then e(4);
   if sr1<>sr3 then e(5);

   color := orange; hue := green; tint := orange;
   if color = hue then e(6);
   if color <> tint then e(7);
end;


procedure tst2205;
 { Intermediate level arrays }
var i,l,o:integer;
begin t:=2205; pct := pct + 1;
   for i:= -10 to 10 do a1[i] := i*i;
   if (a1[-10]<>100) or (a1[9]<>81) then e(1);

   for i:=1939 to 1945 do a2[i]:=i-1938.5;
   if (abs(a2[1939]-0.5) > eps) or (abs(a2[1945]-6.5) > eps) then e(2);

   color := orange;
   a3[green] := true;  a3[orange] := true;
   if (a3[green]<>true) or (a3[orange]<>true) then e(3);
   a3[green] := false;  a3[orange] := false;
   if (a3[green]<>false) or (a3[orange]<>false) then e(4);

   a4[mouse]:='m'; a4[house]:='h';
   if (a4[mouse] <> 'm') or (a4[house]<>'h' ) then e(5);

   for i:=1939 to 1945 do a5[51,bat,false,i]:=300+i;
   if a5[51,bat,false,1940] <> 2240 then e(6);
   for i:=50 to 52 do a5[i,cat,true,1943]:=200+i;
   if (a5[50,cat,true,1943] <> 250) or (a5[52,cat,true,1943] <> 252) then e(7);

   for i:= -10 to 10 do a1[i]:= 0;
   for i:= 0 to 10 do a1[i div 2 + i div 2]:= i+1;
   if(a1[0]<>2) or (a1[5]<>0) or (a1[8]<>10) then e(8);

   for i:= 0 to 10 do
      for l:= 0 to 3 do
	 for o:= 0 to 3 do
	    if ( (i+l+o) div 2) * 2 = i+l+o then a6[i,l,o]:='e' else a6[i,l,o]:='o';
   if (a6[2,2,2]<>'e') or (a6[2,2,3]<>'o') or (a6[0,3,1]<>'e') then e(9);
end;


procedure tst2206;
 { Intermediate level records }
begin t:=2206; pct := pct + 1;
   r1.c1:='x'; r1.i:=40; r1.j:=50; r1.p:=true; r1.x:=3.0;
   c1:='a'; i:=0;  j:=0; p:=false; x:=100.0;
   if (r1.c1<>'x') or (r1.i<>40) or (r1.p<>true) or (r1.x<>3.0) then e(1);
   r2:=r1;
   if (r2.c1<>'x') or (r2.i<>40) or (r2.p<>true) or (r2.x<>3.0) then e(2);
   i:=r1.i;  p:=r1.p;  c1:=r1.c1; x:=r1.x;
   if (c1<>'x') or (i<>40) or (p<>true) or (x<>3.0) then e(3);
   r3.c1:='x'; r3.i:=40; r3.j:=50; r3.p:=true; r3.x:=3.0;
   if (r3.c1<>'x') or (r3.i<>40) or (r3.p<>true) or (r3.x<>3.0) then e(4);
end;

procedure tst2207;
 { Intermediate level sets }
begin t:=2207; pct := pct + 1;
   colors := [];
   colors := colors + [];
   if colors <> [] then e(1);
   colors := colors + [pink];
   if colors <> [pink] then e(2);
   colors := colors + [green];
   if colors <> [pink,green] then e(3);
   if colors <> [green,pink] then e(4);
   colors := colors - [pink];
   if colors <> [green] then e(5);
   beasts := [chicken] + [chicken,pig];
   if beasts <> [pig,chicken] then e(6);
   beasts := [] - [farmersdaughter];
   if beasts <> [] then e(7);
   bits := [0] + [1] - [0];
   if bits <> [1] then e(8);
end;


procedure tst2208;
 { Pointers }
begin t:=2208; pct := pct + 1;
   new(p1); new(p2); new(p3); new(p4);
   p1^ := 1066;
   if p1^ <> 1066 then e(1);
   p2^.i := 1215;
   if p2^.i <> 1215 then e(2);
   p3^[0]:= 1566;
   if p3^[0] <> 1566 then e(3);
   p4^ := [pink];
   if p4^ <> [pink] then e(4);
   dispose(p1); dispose(p2); dispose(p3); dispose(p4);
end;


procedure tst2209;
var i:integer;
begin
   t:=2209; pct := pct + 1;
   head := nil;
   for i:= 1 to 100 do
      begin new(tail); tail^.val:=100+i; tail^.next :=head; head:= tail end;
   if (tail^.val<>200) or (tail^.next^.val<>199) then e(1);
   if tail^.next^.next^.next^.next^.next^.next^.next^.next^.val<> 192 then e(2);
   tail^.next^.next^.next^.val := 30;
   if tail^.next^.next^.next^.val <> 30 then e(3);
   while head <> nil do begin
      head := tail^.next;
      dispose(tail);
      tail := head;
   end;
end;
begin
   t:=22; pct:=pct+1;
   tst2201; tst2202; tst2203; tst2204; tst2205; tst2206;
   tst2207; tst2208; tst2209;
end;





{************************************************************************}
procedure tst25;
{ Statement sequencing }
label 0,1,2,3;
procedure tst2501;
begin
   t:=2501;
   goto 0;
   e(1);
end;
begin
   t:=25; pct:=pct+1;
   tst2501;
   e(1);
0:
   ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   i:=0;
1:
   if i>10 then goto 3 else goto 2;
   e(2);
2:
   i:=i+1;  goto 1;
   e(3);
3:
end;




{************************************************************************}
procedure tst26;
{ More data structures }
type x = array[1..5] of integer;
   ta = array [1..5] of array  [1..5] of x;
   tb = array [1..5] of record p1: ^x;  p2: ^x end;
   tr = record c: record b: record a: integer end  end  end ;

var low,i,j,k:integer; a:ta;  b:tb;  r:tr;  hi:integer;

procedure tst2601(w:ta; x:tb; y:tr);
var i,j,k: integer;
begin t:=2601; pct:=pct+1;
   for i:= 1 to 5 do for j:= 1 to 5 do for k:=1 to 5 do
      if w[i][j][k] <> i*i + 7*j + k then e(1);
   if (x[1].p1^[1] <> -9) or (x[2].p2^[4]<> -39) then e(2);
   if y.c.b.a <> 102 then e(3);
end;

begin t:=26; pct:=pct+1;
   low := 1000; hi := 1001;
   for i:= 1 to 5 do for j:=1 to 5 do for k:= 1 to 5 do a[i][j][k] :=i*i+7*j+k;
   new(b[1].p1);  new(b[2].p2);
   b[1].p1^[1] := -9;  b[2].p2^[4] := -39;
   r.c.b.a := 102;
   tst2601(a,b,r);
   t:=26;
   if(low <> 1000) or (hi <> 1001) then e(1);
   dispose(b[1].p1);  dispose(b[2].p2);
end;



{************************************************************************}
procedure tst27;
{ Assignments }
begin t:=27; pct := pct+1;
   i:=3; j:=2; k:= -100;
   l:= 1+(i*(j+(i*(j+(i*(j+(i*(3+j*(i*1+j*2)))))))));
   if l <> 1456 then e(1);
   l:= ((((((((((((((((((((((((((((((((0))))))))))))))))))))))))))))))));
   if l <> 0 then e(2);
   l:=(((i*j)+(3*i)-5) div 10)*(((i*j)+(3*i)-5) div 10)*(((i*j)+(3*i)-5) div 10)
      + (((i*j)+(3*i)-5) div 10)*(((i*j)+(3*i)-5) div 10)*(((i*j)+(3*i)-5) div 10);
   if l <> 2 then e(3);

   l:=((j+j) div 4) * ((j+j) div 4) * ((j+j) div 4)* (j div 3 + j div 4 + 3)+
     ((j+j) div 4) * ((j+j) div 4) * ((j+j) div 4)* (j div 3 + j div 4 + 3);
   if l <> 6 then e(4);
   i:=j*j*j*j*j*j*j*j*j*j*j*j*j*j - 16383;
   if i <>1 then e(5);
   l:=(i+(i+(i+(i+(i+(i+(i+(i+(i+(i+(i+(i+(i+(i+(i+(i))))))))))))))));
   if l <> 16 then e(6);
   l:= (((((((((((((((((j)+j)+j)+j)+j)+j)+j)+j)+j)+j)+j)+j)+j)+j)+j)+j)+j);
   if l <> 34 then e(7);
   l:= (-(-(-(-(-(-(-(-(-(j))))))))));
   if l <> -2 then e(8);

   x:= 0.1;  y:=0.2;  z:=0.3;
   w:=(((((x+y)/z)*2.0)+(((x+y)/z)*2.0)+(((x+y)/z)*2.0)+(((x+y)/z)*2.0))*
       ((((x+y)/z)*2.0)+(((x+y)/z)*2.0)+(((x+y)/z)*2.0)+(((x+y)/z)*2.0))*
       ((((x+y)/z)*2.0)+(((x+y)/z)*2.0)+(((x+y)/z)*2.0)+(((x+y)/z)*2.0))*
       ((((x+y)/z)*2.0)+(((x+y)/z)*2.0)+(((x+y)/z)*2.0)+(((x+y)/z)*2.0))*
       ((((x+y)/z)*2.0)+(((x+y)/z)*2.0)+(((x+y)/z)*2.0)+(((x+y)/z)*2.0)))-1;
   if abs(w-32767) > 0.0001 then e(9);

   i:= trunc(100*y+0.5);  if i <> 20 then e(10);
   i:= 32767;  w:=i;  if w <> 32767 then e(11);
end;



{************************************************************************}
procedure tst28;
{ Calls }
var i:integer;
function ack(m,n:integer):integer;
begin if m=0
   then ack := n+1
else if n=0
then ack := ack(m-1,1)
else ack := ack(m-1,ack(m,n-1))
end;

procedure fib(a:integer; var b:integer); { Fibonacci nrs }
var i,j:integer;
begin
   if (a=1) or (a=2) then b:=1 else
      begin fib(a-1,i);  fib(a-2,j);  b:=i+j end
end;

begin
   t:=28;  pct:= pct+1;
   if ack(2,2) <> 7 then e(1);
   if ack(3,3) <> 61 then e(2);
   if ack(3,5) <> 253 then e(3);
   if ack(2,100) <> 203 then e(4);
   fib(10,i);  if i <> 55 then e(5);
   fib(20,i);  if i <> 6765 then e(6);
end;


{************************************************************************}
procedure tst29;
{ Loops }
var i,l:integer; p:boolean;
begin
   t:= 29; pct:=pct+1;
   j:=5;
   k:=0; for i:=1 to j do k:=k+1; if k<>5 then e(1);
   k:=0; for i:=5 to j do k:=k+1; if k<>1 then e(2);
   k:=0; for i:=6 to j do k:=k+1; if k<>0 then e(3);
   k:=0; for i:=-1 downto -j do k:=k+1; if k<>5 then e(4);
   k:=0; for i:=-5 downto -j do k:=k+1; if k<>1 then e(5);
   k:=0; for i:=-6 downto j do k:=k+1; if k<>0 then e(6);
   k:=0; for i:=1 downto 10 do k:=k+1; if k<>0 then e(7);

   k:=0; for l:=1 to j do k:=k+1; if k<>5 then e(8);
   k:=0; for l:=5 to j do k:=k+1; if k<>1 then e(9);
   k:=0; for l:=6 to j do k:=k+1; if k<>0 then e(10);
   k:=0; for l:=-1 downto -j do k:=k+1; if k<>5 then e(11);
   k:=0; for l:=-5 downto -j do k:=k+1; if k<>1 then e(12);
   k:=0; for l:=-6 downto j do k:=k+1; if k<>0 then e(13);
   k:=0; for l:=1 downto 10 do k:=k+1; if k<>0 then e(14);
   k:=0; for p:= true downto false do k:=k+1; if k<>2 then e(15);
   k:=0; for p:= false to true do k:=k+1; if k<>2 then e(16);

   k:=0; while k<0 do k:=k+1; if k<>0 then e(17);
   k:=0; repeat k:=k+1; until k>0; if k<> 1 then e(18);
   k:=0; repeat k:=k+1; until k > 15; if k <> 16 then e(18);
   k:=0; while k<=10 do k:=k+1;  if k<> 11 then e(19);
end;

{************************************************************************}
procedure tst30;
{ case statements }
var
   colour: (red,blue,yellow);

begin t:=30; pct:=pct+1;
   i:=3; k:=0;
   case i*i-7 of
      0: k:=0;  1: k:=0;  2: k:=1;  3,4: k:=0
   end;
   if k<>1 then e(1);

   colour := red; k:=0;
   case colour of
      red: k:=1;  blue: k:=0;  yellow: k:=0
   end;
   if k<>1 then e(2);

   k:=0;
   case colour of
      red,blue: k:=1;  yellow: k:=0
   end;
   if k<>1 then e(3);
end;

{************************************************************************}
procedure tst31;
{ with statements }
var ra: record i:integer; x:real; p:tp2; q:single;
	       a2: record a3: tp2 end
     end;
	       rb: record j: integer; y:real; pp:tp2; qq:single end;
begin
   t:=31; pct:=pct+1;
   i:=0;  x:=0;
   ra.i:=-3006;  ra.x:=-6000.25;  ra.q[0]:=35;  ra.p.i:=20;
   with ra do begin
      if (i<>-3006) or (x<>-6000.25) or (q[0]<>35) or (p.i<>20) then e(2);
      i:=300;   x:= 200.5;  q[0]:=35;  p.i:=-10
   end;
   if (ra.i<>300) or (ra.x<>200.5) or (ra.q[0]<>35) or (ra.p.i<>-10) then e(3);
   with ra.p do if i <> -10 then e(4);

   i:= -23;
   ra.a2.a3.i := -909;
   with ra do if a2.a3.i <> -909 then e(5);
   with ra.a2 do if a3.i <> -909 then e(6);
   with ra.a2.a3 do if i <> -909 then e(7);
   with ra.a2 do i:=5;
   if (i<>5) or (ra.a2.a3.i <> -909) then e(8);
   with ra.a2.a3 do i:= 6;
   if i<>5 then e(9);
   if ra.a2.a3.i <> 6 then e(10);

   with ra,rb do
      begin x:=3.5;  y:=6.5;  i:=3;  j:=9 end;
   if (ra.x<>3.5) or (rb.y<>6.5) or (ra.i<>3) or (rb.j<>9) then e(11);
end;


{************************************************************************}
procedure tst32;
{ Standard procedures }
begin t:=32;  pct:=pct+1;
   if abs(-1) <> 1 then e(1);
   i:= -5;  if abs(i) <> 5 then e(2);
   x:=-2.0;  if abs(x) <> 2.0 then e(3);
   if odd(5) = false then e(4);
   if odd(4) then e(5);
   if sqr(i) <> 25 then e(6);
   if succ(i) <> -4 then e(7);
   if succ(red) <> blue then e(8);
   if pred(blue) <> red then e(9);
   if ord(red) <> 0 then e(10);
   if ord(succ(succ(red))) <> 2 then e(11);
   if chr(ord(chr(ord(chr(ord('u')))))) <> 'u' then e(12);
   if ord(chr(ord(chr(ord(chr(50))))))  <> 50 then e(13);
   if abs(trunc(5.2)-5.0) > eps then e(14);
   if abs(sin(3.1415926536)) >  1.03e-11 + 10*eps then e(15);
   if abs(exp(1.0)-2.7182818) > 0.0001 then e(16);
   if abs(ln(exp(1.0))- 1.0) > 3*eps then e(17);
   if abs(sqrt(25.0)-5.0) > eps then e(18);
   if abs(arctan(1.0) - 3.1415926535/4.0) > 0.0001 then e(19);
   if abs(ln(arctan(1)*4) - 1.144729886) > 0.000001 then e(20);
   if abs(sin(1) - 0.841470985 ) > 0.000001 then e(21);
   if abs(cos(1) - 0.540302306) > 0.000001 then e(22);
   if abs(sqrt(2) - 1.4142135623) > 0.000001 then e(23);
   if abs(sqrt(10) - 3.1622776601) > 0.000001 then e(24);
   if abs(sqrt(1000.0) - 31.622776602) > 0.00001 then e(25);
end;


{***************************************************************************}
procedure tst33;
{ Functions }
var i,j,k,l,m: integer;
begin t:=33;  pct := pct+1;
   i:=1; j:=2;  k:=3;  l:=4;  m:=10;
   if twice(k) <> m-l then e(1);
   if twice(1) <> 2 then e(2);
   if twice(k+1) <> twice(l) then e(3);
   if twice(twice(twice(inc(twice(inc(3)))))) <> 72 then e(4);
   if twice(inc(j+twice(inc(twice(i+1+inc(k)+inc(k))+twice(2)))))<>106
   then e(5);
   if twice(1) + twice(2) * twice(3) <> 26 then e(6);
   if 3 <>  0 + twice(1) + 1 then e(7);
   if 0 <> 0 * twice(m) then e(8);
end;



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

{$setlimit 64}
{$i64 : sets of integers contain 64 bits}
{ --- test files and sets --- }

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


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 16 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(30);
   if not eoln(f1) then e(31);
   if eof(f1) then e(32)
   else begin
      read(f1,c[17]);
      if c[17] <> ' ' then e(33);
      if not eof(f1) then e(4);
   end;
   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 tst35;
{ Local files }
const
   cx1 = 303.5625;
   cx2 = 26.3203125;
var
   g1: text;
   g2: file of spectrum;
   g3: file of tp2;
   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);

   r2.c1:='w';  r2.i:= -100; r2.j:= -101; r2.x:=cx1;     g3^:=r2; put(g3);
   r2.c1:='y';  r2.i:= -35;  r2.j:= -36;  r2.x:=cx2;     g3^:=r2; put(g3);
   r2.c1:='q';  r2.i:= +29;  r2.j:= +28;  r2.x:=10.00;   g3^:=r2; put(g3);
   r2.c1:='j';  r2.i:=   8;  r2.j:= 7;    r2.x:=10000;   g3^:=r2; put(g3);

   for i:= 1 to 1000 do begin g3^ := r2; put(g3) end;
   reset(g3);
   if eof(g3) then e(11);

   r2 := g3^;  get(g3);
   if (r2.c1<>'w') or (r2.i<>-100) or (r2.j<>-101) or (r2.x<>cx1) then e(12);
   r2 := g3^;  get(g3);
   if (r2.c1<>'y') or (r2.i<> -35) or (r2.j<> -36) or (r2.x<> cx2) then e(13);
   r2 := g3^;  get(g3);
   if (r2.c1<>'q') or (r2.i<>  29) or (r2.j<>  28) or (r2.x<> 10.00) then e(14);
   r2 := g3^;  get(g3);
   if (r2.c1<>'j') or (r2.i<>   8) or (r2.j<>   7) or (r2.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:=[purple,white,gray,pink,green,orange,black,fuchia,maple,
            violet,darkred,darkblue,darkyellow];
end;


procedure tst36;
{ Global files }
const
   cx1 = 303.5625;
   cx2 = 26.3203125;
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:=cx1;  r3.p:=true; f3^:=r3; put(f3);
   r3.c1:='y';  r3.i:= -35;  r3.x:=cx2;   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<>cx1) then e(8);
   r3 := f3^; get(f3);
   if (r3.c1<>'y') or (r3.i<> -35) or (r3.x<> cx2) 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);


   r2.c1:='w';  r2.i:= -100; r2.j:= -101; r2.x:=cx1;   r2.p:=true; f4^:=r2; put(f4);
   r2.c1:='y';  r2.i:= -35;  r2.j:=  -36; r2.x:=cx2;   f4^:=r2; put(f4);
   r2.c1:='q';  r2.i:= +29;  r2.j:=  +28; r2.x:=10.00; f4^:=r2; put(f4);
   r2.c1:='j';  r2.i:=   8;  r2.j:=    7; r2.x:=10000; f4^:=r2; put(f4);

   for i:= 1 to 1000 do begin f4^ := r2; put(f4) end;
   reset(f4);

   r2 := f4^; get(f4);
   if (r2.c1<>'w') or (r2.i<>-100) or (r2.j<>-101) or (r2.x<>cx1) then e(12);
   r2 := f4^; get(f4);
   if (r2.c1<>'y') or (r2.i<> -35) or (r2.j<> -36) or (r2.x<> cx2) then e(13);
   r2 := f4^; get(f4);
   if (r2.c1<>'q') or (r2.i<>  29) or (r2.j<>  28) or (r2.x<> 10.00) then e(13);
   r2 := f4^; get(f4);
   if (r2.c1<>'j') or (r2.i<>   8) or (r2.j<>   7) or (r2.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);
   vr.t:=true;
   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 tst37;
{ Intermediate level files }
var g1: text;
   g2: file of spectrum;
   g3: file of tp2;
   g4: file of vec1;

procedure tst3701;
const
   cx1 = 303.5625;
   cx2 = 26.3203125;
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);

   r2.c1:='w';  r2.i:= -100; r2.j:= -101; r2.x:=cx1;   g3^:=r2; put(g3);
   r2.c1:='y';  r2.i:= -35;  r2.j:=  -36; r2.x:=cx2;   g3^:=r2; put(g3);
   r2.c1:='q';  r2.i:= +29;  r2.j:=  +28; r2.x:=10.00; g3^:=r2; put(g3);
   r2.c1:='j';  r2.i:=   8;  r2.j:=    7; r2.x:=10000; g3^:=r2; put(g3);

   for i:= 1 to 1000 do begin g3^ := r2; put(g3) end;
   reset(g3);
   if eof(g3) then e(11);

   r2 := g3^;  get(g3);
   if (r2.c1<>'w') or (r2.i<>-100) or (r2.j<>-101) or (r2.x<>cx1) then e(12);
   r2 := g3^;  get(g3);
   if (r2.c1<>'y') or (r2.i<> -35) or (r2.j<> -36) or (r2.x<> cx2) then e(13);
   r2 := g3^;  get(g3);
   if (r2.c1<>'q') or (r2.i<>  29) or (r2.j<>  28) or (r2.x<> 10.00) then e(14);
   r2 := g3^;  get(g3);
   if (r2.c1<>'j') or (r2.i<>   8) or (r2.j<>   7) or (r2.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;


{$setlimit 1000}
procedure tst39;
var b:false..true;
   i:integer;
   s:set of 0..99;
begin
   t:=39;  pct := pct + 1;
   b:=true; if not b then e(1);
   s:=[0,10,20,30,40,50,60,70,80,90];
   for i:=0 to 99 do
      if (i in s) <> (i mod 10=0) then e(2);
end; { tst39 }


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

{ Tests for the EM-1 compiler }


procedure tst40;
{ Mark and Release }
type vec = array[1..1000] of integer;
var i:integer;
   pt1,pt2: ^vec;
   pt3:^integer;

procedure grab;
var i:integer;
begin
   for i:=1 to 10 do new(pt1);
   for i:=1 to 1000 do new(pt3);
end;

begin t:= 40;  pct:=pct+1;
   for i:=1 to 10 do begin
      {$ifndef __GPC__ }  { TODO: but only if standard-pascal ($ifopt classic-pascal) }
(*
      mark(mk);
      new(pt2);
      grab;
      release(mk)
 *)
      {$endif }
   end;
end;


procedure tst41;
{ Empty sets }
begin  t:=41;  pct := pct + 1;
   if red in [] then e(1);
   if ([] <> []) then e(2);
   if not ([] = []) then e(3);
   if not([] <=[]) then e(4);
   if not ( [] >= []) then e(5);
end;


{************************************************************************}
procedure tst42;
{ Record variants.  These tests are machine dependent }
var
   s:record
        b:boolean;
        case t:boolean of
        false:(c:char);
        true:(d:cmat)
     end;
   w: packed record
                case boolean of
                false: (x:array[0..20] of integer);
                true: (x1,x2,x3,a,b,c,d,e,f,g,h,i,j,k,l:char)
             end;

   y: record
         case boolean of
         false: (x:array[0..20] of integer);
         true: (a,b,c,d,e,f,g,h,i,j,k,l:char)
      end;
   i:integer;

begin
   t:=42; pct:=pct+1;
   s.t:=false;  s.c:='x';  if s.c <> 'x' then e(1);
   for i:=0 to 20 do begin w.x[i]:=-1; y.x[i]:=-1 end;
   w.a:=chr(0);  w.f:=chr(0);
   y.a:=chr(0);  y.f:=chr(0);
   if (ord(w.a) <> 0) or (ord(w.b) <> 255) then e(3);
   if (ord(w.c) <> 255) or (ord(w.d)<>255) then e(4);
   if (ord(w.e) <> 255) or (ord(w.f) <> 0) then e(5);
   if ord(y.a) <> 0 then e(6);
   if ord(y.f) <> 0 then e(7);
end;


{************************************************************************}
procedure tst43;
{ Procedure and function parameters }
function incr(k:integer):integer; begin incr := k+1 end;
function double(k:integer):integer; begin double := 2*k end;
function eval(function f(a:integer):integer; a:integer):integer;
begin
   eval:=f(a)
end;
function apply(function f(a:integer):integer; a:integer):integer;
begin apply:=eval(f,a) end;

procedure x1(function f(a:integer):integer;  a:integer; var r:integer);
procedure x2(function g(c:integer):integer;  b:integer;  var s:integer);
begin s:=apply(g,b); end;
begin x2(f, a+a, r) end;

procedure p0(procedure p(x:integer); i,j:integer);
begin
   if j=0 then p(i) else p0(p,i+j,j-1)
end;

procedure p1(a,b,c,d:integer);
var k:integer;
procedure p2(x:integer);
begin k:= x*x end;
begin k:=0;
   p0(p2,a,b);
   if k <> c then e(d);
end;

begin
   t:=43; pct := pct+1;
   i:=10;  j:=20;
   if incr(0) <> 1 then e(1);
   if decr(i) <> 9 then e(2);
   if double(i+j) <> 60 then e(3);
   if incr(double(j)) <> 41 then e(4);
   if decr(double(incr(double(i)))) <> 41 then e(5);
   if incr(incr(incr(incr(incr(5))))) <> 10 then e(6);
   if eval(incr,i) <> 11 then e(7);
   if eval(decr,3) <> 2 then e(8);
   if incr(eval(double,15)) <> 31 then e(9);
   if apply(incr,3) <> 4 then e(10);

   x1(double,i,j);  if j <> 40 then e(11);
   x1(incr,i+3,j);  if j <> 27 then e(12);
   p1(3,5,324,13);
   p1(10,4,400,14);
   p1(1,8,1369,15);
   j:=1;
   if inc(incr(twice(double(inc(incr(twice(double(j)))))))) <> 26 then e(13);
end;


{************************************************************************}
procedure tst44;
{ Value parameters }
const
   c1 =-0.3125; { frac part must be power of 0.5 to ensure exact value }
   c2 = 20.3125;
type ww2 = array[-10..+10] of tp2;
   arra = array[-10..+10] of integer;
   reca = record k:single; s:spectrum end;
   pa = np;
var l1:integer;  xr:real;  xb:boolean;  xc:char;  xar:cmat;  xnode:pa;
   vec1: arra;   vec2: ww2;
   s2:spectrum;  rec1: reca;
   zero:0..0;

procedure tst4401(pl1:integer; pxr:real;   pxb:boolean;  pxc:char;
		  pxar:cmat;   pxnode:pa;  pxtp2:tp2;
		  pvec1:arra;  pvec2:ww2; prec1:reca;
		  ps1,ps2:spectrum;  psin:single; i,j:integer);
begin
   t:=4401; pct:=pct+1;
   if pl1<>29 then e(1);
   if pxr<>c1 then e(2);
   if pxb <> false then e(3);
   if pxc <> 'k' then e(4);
   if (pxar[1,1]^<>[red,blue]) or (pxar[2,2]^ <> [yellow]) then e(5);
   if (pxnode^.val <> 105) or (pxnode^.next^.val <> 106) then e(6);
   if (pxtp2.c1 <> 'w') or (pxtp2.x <> c2) then e(7);
   if pvec1[10] <> -996 then e(8);
   if pvec2[zero].x <> -300 then e(9);
   if (prec1.k[zero] <> -421) or (prec1.s <> []) then e(10);
   if (ps1<>[]) or (ps2<>[red]) then e(11);
   if psin[zero] <> -421 then e(12);
   if i <> -421 then e(13);
   if j <> 106 then e(14);

   pl1:=0;  pxc:=' ';  pxb:=true;
   pxar[1,1]^:=[];  pxar[2,2]^:=[];
   pxnode^.val:=0;  pxnode^.next^.val:=1;
   pxtp2.c1:=' ';
   pvec1[10]:=0;
   pvec2[zero].x:=0;
   prec1.k[zero]:=0;
   psin[0]:=0;  i:=0;  j:=0;
end;

begin
   t:=44; pct:=pct+1;
   zero:=0;
   l1:=29;  xr:=c1;  xb:=false;  xc:='k';
   new(xar[1,1]);  xar[1,1]^ := [red,blue];
   new(xar[2,2]);  xar[2,2]^ := [yellow];
   new(xar[1,2]);  xar[1,2]^ := [yellow];
   new(xnode);  xnode^.val :=105;
   new(xnode^.next); xnode^.next^.val :=106;
   r1.c1:='w';  r1.x:=c2;
   vec1[10] := -996;  vec2[zero].x := -300;
   rec1.k[zero]:=-421;  rec1.s :=[];
   s2:=[red];

   tst4401(l1, xr, xb, xc, xar, xnode, r1, vec1, vec2, rec1,
	   [], s2, rec1.k, rec1.k[zero], xnode^.next^.val);;
   t:=44;

   if l1<>29 then e(1);
   if xr<> c1 then e(2);
   if xb <> false then e(3);
   if xc <> 'k' then e(4);
   if (xar[1,1]^ <> [])  or (xar[2,2]^ <> []) then e(5);
   if xar[1,2]^ <> [yellow] then e(6);
   if (xnode^.val <> 0) or (xnode^.next^.val <> 1) then e(7);
   if (r1.c1 <> 'w') or (r1.x <> c2) then e(8);
   if vec1[10] <> -996 then e(9);
   if vec2[zero].x <> -300 then e(10);
   if (rec1.k[zero] <> -421) or (rec1.s <> []) then e(11);
   if s2 <> [red] then e(12);
   dispose(xar[1,1]);
   dispose(xar[2,2]);
   dispose(xar[1,2]);
   dispose(xnode^.next);
   dispose(xnode);
end;


   {************************************************************************}
procedure tst45;
   { Var parameters }

const
   c1 =-0.3125; { frac part must be power of 0.5 to ensure exact value }
   c2 = 20.3125;

type ww2 = array[-10..+10] of tp2;
   arra = array[-10..+10] of integer;
   reca = record k:single; s:spectrum end;
   pa = np;
var l1:integer;  xr:real;  xb:boolean;  xc:char;  xar:cmat;  xnode:pa;
   vec1: arra;   vec2: ww2;
   s1,s2:spectrum;  rec1: reca;
   zero:0..0;

procedure tst4501(var pl1:integer; var pxr:real; var pxb:boolean; var pxc:char;
		  var pxar:cmat;   var pxnode:pa;  var pxtp2:tp2;
		  var pvec1:arra;  var pvec2:ww2; var prec1:reca;
		  var ps1,ps2:spectrum;  var psin:single; var i,j:integer);
begin
   t:=4501; pct:=pct+1;
   if pl1<>29 then e(1);
   if pxr<>c1 then e(2);
   if pxb <> false then e(3);
   if pxc <> 'k' then e(4);
   if (pxar[1,1]^<>[red,blue]) or (pxar[2,2]^ <> [yellow]) then e(5);
   if (pxnode^.val <> 105) or (pxnode^.next^.val <> 106) then e(6);
   if (pxtp2.c1 <> 'w') or (pxtp2.x <> c2) then e(7);
   if pvec1[10] <> -996 then e(8);
   if pvec2[zero].x <> -300 then e(9);
   if (prec1.k[zero] <> -421) or (prec1.s <> []) then e(10);
   if (ps1<>[]) or (ps2<>[red]) then e(11);
   if psin[zero] <> -421 then e(12);
   if i <> -421 then e(13);
   if j <> 106 then e(14);

   pl1:=0;  pxr:=0;  pxc:=' ';  pxb:=true;
   pxar[1,1]^:=[];  pxar[2,2]^:=[];
   pxnode^.val:=0;  pxnode^.next^.val:=1;
   pxtp2.c1:=' ';
   pxtp2.x := 0;
   pvec1[10]:=0;
   pvec2[zero].x:=0;
   prec1.k[zero]:=0;
   psin[0]:=0;  i:=223;  j:=445;
end;

begin
   t:=45; pct:=pct+1;
   zero:=0;
   l1:=29;  xr:=c1;  xb:=false;  xc:='k';
   new(xar[1,1]);  xar[1,1]^ := [red,blue];
   new(xar[2,2]);  xar[2,2]^ := [yellow];
   new(xar[1,2]);  xar[1,2]^ := [yellow];
   new(xnode);  xnode^.val :=105;
   new(xnode^.next); xnode^.next^.val :=106;
   r1.c1:='w';  r1.x:=c2;
   vec1[10] := -996;  vec2[zero].x := -300;
   rec1.k[zero]:=-421;  rec1.s :=[];
   s1:=[];  s2:=[red];

   tst4501(l1, xr, xb, xc, xar, xnode, r1, vec1, vec2, rec1,
	   s1, s2, rec1.k, rec1.k[zero], xnode^.next^.val);;
   t:=45;

   if l1<>0 then e(1);
   if xr<> 0 then e(2);
   if xb <> true then e(3);
   if xc <> ' ' then e(4);
   if (xar[1,1]^ <> [])  or (xar[2,2]^ <> []) then e(5);
   if xar[1,2]^ <> [yellow] then e(6);
   if (xnode^.val <> 0) or (xnode^.next^.val <> 445) then e(7);
   if (r1.c1 <> ' ') or (r1.x <> 0) then e(8);
   if vec1[10] <> 0 then e(9);
   if (rec1.k[zero] <> 223) or (rec1.s <> []) then e(11);
   if (s1 <> []) or (s2 <> [red]) then e(12);
   dispose(xar[1,1]);
   dispose(xar[2,2]);
   dispose(xar[1,2]);
   dispose(xnode^.next);
   dispose(xnode);
end;


procedure tst46;
type int=integer;
   pint=^integer;
var ga0,ga1,ga2,ga3,ga4,ga5:int;
   gp0,gp1,gp2,gp3,gp4,gp5:pint;

procedure level0(a1,a2:int;p1,p2:pint);
label 1;
var a3,a4,a5:int;p3,p4,p5:pint;

procedure level1(a1,a2:int;p1,p2:pint);
var a3,a4,a5:int;p3,p4,p5:pint;

procedure level2(a1,a2:int;p1,p2:pint);
var a3,a4,a5:int;p3,p4,p5:pint;
begin { level 2 }
   a1:= -5;a2:=a1;a3:=a2;a4:=a3;a5:=a4;
   a1:= -4;a2:=a1;a3:=a2;a4:=a3;
   a1:= -3;a2:=a1;a3:=a2;
   a1:= -2;a2:=a1;
   a1:=a5+a5;a1:= -1;
   p1:=gp0;p2:=p1;p3:=p2;p4:=p3;p5:=p4;
   p1:=gp1;p2:=p1;p3:=p2;p4:=p3;
   p1:=gp2;p2:=p1;p3:=p2;
   p1:=gp3;p2:=p1;
   p1:=p5;p1:=gp4;
   goto 1;
end; { level 2 }

begin { level 1 }
   a1:=ga4;a2:=a1;a3:=a2;a4:=a3;a5:=a4;
   a1:=ga3;a2:=a1;a3:=a2;a4:=a3;
   a1:=ga2;a2:=a1;a3:=a2;
   a1:=ga1;a2:=a1;
   a1:=ga0;
   p1:=gp4;p2:=p1;p3:=p2;p4:=p3;p5:=p4;
   p1:=gp3;p2:=p1;p3:=p2;p4:=p3;
   p1:=gp2;p2:=p1;p3:=p2;
   p1:=gp1;p2:=p1;
   p1:=gp0;
   level2(a5,a4,p5,p4);
   { writeln('Error, goto failed'); }
   e(11);
end; { level 1 }

begin { level0 }
   a1:=ga5;a2:=a1;a3:=a2;a4:=a3;a5:=a4;
   a1:=ga4;a2:=a1;a3:=a2;a4:=a3;
   a1:=ga3;a2:=a1;a3:=a2;
   a1:=ga2;a2:=a1;
   a1:=ga1;
   p1:=gp5;p2:=p1;p3:=p2;p4:=p3;p5:=p4;
   p1:=gp4;p2:=p1;p3:=p2;p4:=p3;
   p1:=gp3;p2:=p1;p3:=p2;
   p1:=gp2;p2:=p1;
   p1:=gp1;
   level1(a5,a4,p5,p4);
   { writeln('Error, goto failed'); }
   e(12);
1:
   if (a1 <> ga1) then begin { writeln('level0:a1 has wrong value')} e(1); end;
   if (a2 <> ga2) then begin { writeln('level0:a2 has wrong value')} e(2); end;
   if (a3 <> ga3) then begin { writeln('level0:a3 has wrong value')} e(3); end;
   if (a4 <> ga4) then begin { writeln('level0:a4 has wrong value')} e(4); end;
   if (a5 <> ga5) then begin { writeln('level0:a5 has wrong value')} e(5); end;
   if (p1 <> gp1) then begin { writeln('level0:p1 has wrong value')} e(6); end;
   if (p2 <> gp2) then begin { writeln('level0:p2 has wrong value')} e(7); end;
   if (p3 <> gp3) then begin { writeln('level0:p3 has wrong value')} e(8); end;
   if (p4 <> gp4) then begin { writeln('level0:p4 has wrong value')} e(9); end;
   if (p5 <> gp5) then begin { writeln('level0:p5 has wrong value')} e(10); end;
end; { level 0 }

begin  { t46 }
   t:=46; pct:=pct+1;
   ga0:=0;ga1:=1;ga2:=2;ga3:=3;ga4:=4;ga5:=5;
   new(gp0);
   new(gp1);
   new(gp2);
   new(gp3);
   new(gp4);
   new(gp5);
   level0(ga5,ga4,gp5,gp4);
   dispose(gp0);dispose(gp1);dispose(gp2);dispose(gp3);dispose(gp4);dispose(gp5);
end; { t46 }


procedure t1;
begin { t1 }
   ect := 0;  pct := 0;
   tst1;  tst2;  tst3;  tst4; tst5;   tst6;  tst7;  tst8;
   tst9;  tst10; tst11; tst12; tst13; tst14; tst15; tst16;
   tst17; tst18; tst19; tst20;
   write('Test t1:');
   report;
end; { t1 }


procedure t2;
begin  { t2 }
   ect := 0;  pct := 0;
   tst21; tst22; tst25; tst26; tst27; tst28; tst29; tst30; tst31; tst32; tst33;
   write('Test t2:');
   report;
end; { t2 }


procedure t3;
begin { t3 }
   ect:=0; pct:=0;
   tst34;   tst35;   tst36;   tst37;   tst38;   tst39;
   write('Test t3:');
   report;
end; { t3 }


procedure t4;
begin { t4 }
   ect:=0; pct:=0;
   tst40; tst41; tst42; tst43;
   tst44; tst45; tst46;
   write('Test t4:');
   report;
end; { t4 }


begin
   initialise;
   t1;
   t2;
   t3;
   t4;
end.

{kate: cfgIndentCase true;}
