--- /dev/null
+all: testC testI
+
+testI:
+# int t1.p; em
+ int t2.p; em
+ int t3.p; em e.out f1 f2 f3 f4 f5 f6
+ int t4.p; em
+ int t5.p; em
+ int tstenc.p; em
+ rm -f e.out f?
+
+testC:
+ apc t1.p; a.out
+ apc t2.p; a.out
+ apc t3.p; a.out f1 f2 f3 f4 f5 f6
+ apc t4.p; a.out
+ apc t5.p; a.out
+ apc tstenc.p; a.out
+ rm -f a.out f?
+
+install cmp:
+
+clean:
+ -rm -f [ea].out f?
+
+opr:
+ make pr | opr
+
+pr:
+ @pr t[12345].p tstenc.p
--- /dev/null
+procedure machar (var ibeta , it , irnd , ngrd , machep , negep , iexp,
+ minexp , maxexp : integer ; var eps , epsneg , xmin , xmax : real ) ;
+var trapped:boolean;
+
+procedure encaps(procedure p; procedure q(i:integer)); extern;
+procedure trap(i:integer); extern;
+
+procedure catch(i:integer);
+const underflo=5;
+begin if i=underflo then trapped:=true else trap(i) end;
+
+procedure work;
+var
+
+
+{ This subroutine is intended to determine the characteristics
+ of the floating-point arithmetic system that are specified
+ below. The first three are determined according to an
+ algorithm due to M. Malcolm, CACM 15 (1972), pp. 949-951,
+ incorporating some, but not all, of the improvements
+ suggested by M. Gentleman and S. Marovich, CACM 17 (1974),
+ pp. 276-277. The version given here is for single precision.
+
+ Latest revision - October 1, 1976.
+
+ Author - W. J. Cody
+ Argonne National Laboratory
+
+ Revised for Pascal - R. A. Freak
+ University of Tasmania
+ Hobart
+ Tasmania
+
+ ibeta is the radix of the floating-point representation
+ it is the number of base ibeta digits in the floating-point
+ significand
+ irnd = 0 if the arithmetic chops,
+ 1 if the arithmetic rounds
+ ngrd = 0 if irnd=1, or if irnd=0 and only it base ibeta
+ digits participate in the post normalization shift
+ of the floating-point significand in multiplication
+ 1 if irnd=0 and more than it base ibeta digits
+ participate in the post normalization shift of the
+ floating-point significand in multiplication
+ machep is the exponent on the smallest positive floating-point
+ number eps such that 1.0+eps <> 1.0
+ negeps is the exponent on the smallest positive fl. pt. no.
+ negeps such that 1.0-negeps <> 1.0, except that
+ negeps is bounded below by it-3
+ iexp is the number of bits (decimal places if ibeta = 10)
+ reserved for the representation of the exponent of
+ a floating-point number
+ minexp is the exponent of the smallest positive fl. pt. no.
+ xmin
+ maxexp is the exponent of the largest finite floating-point
+ number xmax
+ eps is the smallest positive floating-point number such
+ that 1.0+eps <> 1.0. in particular,
+ eps = ibeta**machep
+ epsneg is the smallest positive floating-point number such
+ that 1.0-eps <> 1.0 (except that the exponent
+ negeps is bounded below by it-3). in particular
+ epsneg = ibeta**negep
+ xmin is the smallest positive floating-point number. in
+ particular, xmin = ibeta ** minexp
+ xmax is the largest finite floating-point number. in
+ particular xmax = (1.0-epsneg) * ibeta ** maxexp
+ note - on some machines xmax will be only the
+ second, or perhaps third, largest number, being
+ too small by 1 or 2 units in the last digit of
+ the significand.
+
+ }
+
+ i , iz , j , k , mx : integer ;
+ a , b , beta , betain , betam1 , one , y , z , zero : real ;
+
+begin
+ irnd := 1 ;
+ one := ( irnd );
+ a := one + one ;
+ b := a ;
+ zero := 0.0 ;
+{
+ determine ibeta,beta ala Malcolm
+ }
+ while ( ( ( a + one ) - a ) - one = zero ) do begin
+ a := a + a ;
+ end ;
+ while ( ( a + b ) - a = zero ) do begin
+ b := b + b ;
+ end ;
+ ibeta := trunc ( ( a + b ) - a );
+ beta := ( ibeta );
+ betam1 := beta - one ;
+{
+ determine irnd,ngrd,it
+ }
+ if ( ( a + betam1 ) - a = zero ) then irnd := 0 ;
+ it := 0 ;
+ a := one ;
+ repeat begin
+ it := it + 1 ;
+ a := a * beta ;
+ end until ( ( ( a + one ) - a ) - one <> zero ) ;
+{
+ determine negep, epsneg
+ }
+ negep := it + 3 ;
+ a := one ;
+
+ for i := 1 to negep do begin
+ a := a / beta ;
+ end ;
+
+ while ( ( one - a ) - one = zero ) do begin
+ a := a * beta ;
+ negep := negep - 1 ;
+ end ;
+ negep := - negep ;
+ epsneg := a ;
+{
+ determine machep, eps
+ }
+ machep := negep ;
+ while ( ( one + a ) - one = zero ) do begin
+ a := a * beta ;
+ machep := machep + 1 ;
+ end ;
+ eps := a ;
+{
+ determine ngrd
+ }
+ ngrd := 0 ;
+ if(( irnd = 0) and((( one + eps) * one - one) <> zero)) then
+ ngrd := 1 ;
+{
+ determine iexp, minexp, xmin
+
+ loop to determine largest i such that
+ (1/beta) ** (2**(i))
+ does not underflow
+ exit from loop is signall by an underflow
+ }
+ i := 0 ;
+ betain := one / beta ;
+ z := betain ;
+ trapped:=false;
+ repeat begin
+ y := z ;
+ z := y * y ;
+{
+ check for underflow
+ }
+ i := i + 1 ;
+ end until trapped;
+ i := i - 1;
+ k := 1 ;
+{
+ determine k such that (1/beta)**k does not underflow
+
+ first set k = 2 ** i
+ }
+
+ for j := 1 to i do begin
+ k := k + k ;
+ end ;
+
+ iexp := i + 1 ;
+ mx := k + k ;
+ if ( ibeta = 10 ) then begin
+{
+ for decimal machines only }
+ iexp := 2 ;
+ iz := ibeta ;
+ while ( k >= iz ) do begin
+ iz := iz * ibeta ;
+ iexp := iexp + 1 ;
+ end ;
+ mx := iz + iz - 1 ;
+ end;
+ trapped:=false;
+ repeat begin
+{
+ loop to construct xmin
+ exit from loop is signalled by an underflow
+ }
+ xmin := y ;
+ y := y * betain ;
+ k := k + 1 ;
+ end until trapped;
+ k := k - 1;
+ minexp := - k ;
+{ determine maxexp, xmax
+ }
+ if ( ( mx <= k + k - 3 ) and ( ibeta <> 10 ) ) then begin
+ mx := mx + mx ;
+ iexp := iexp + 1 ;
+ end;
+ maxexp := mx + minexp ;
+{ adjust for machines with implicit leading
+ bit in binary significand and machines with
+ radix point at extreme right of significand
+ }
+ i := maxexp + minexp ;
+ if ( ( ibeta = 2 ) and ( i = 0 ) ) then maxexp := maxexp - 1 ;
+ if ( i > 20 ) then maxexp := maxexp - 3 ;
+ xmax := one - epsneg ;
+ if ( xmax * one <> xmax ) then xmax := one - beta * epsneg ;
+ xmax := ( xmax * betain * betain * betain ) / xmin ;
+ i := maxexp + minexp + 3 ;
+ if ( i > 0 ) then begin
+
+ for j := 1 to i do begin
+ xmax := xmax * beta ;
+ end ;
+ end;
+
+end;
+
+begin
+ trapped:=false;
+ encaps(work,catch);
+end;
--- /dev/null
+#
+{
+ (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
+
+}
+
+program t1(input,output);
+
+{ This program can be used to test out PASCAL compilers }
+
+const ONE=1; TWO=2; TEN=10; FIFTY=50; MINONE=-1;
+#ifndef NOFLOAT
+ RR1=1.0; RR1H=1.5; RR2=2.0; RR3=3.0; RR4=4.0; RRMINONE=-1.0;
+#endif
+ yes=true; no=false;
+ kew='q';
+#ifndef NOFLOAT
+ eps = 2.0e-7; { This constant is machine dependent }
+#endif
+
+type wavelength = (red,blue,yellow,purple,white,gray,pink,black,fuchia,maple,
+ violet,darkred,darkblue,darkyellow,darkwhite,darkpink,darkblack);
+ ww2= 1939..1945;
+#ifndef NOFLOAT
+ tp2= record c1:char; i,j:integer; p:boolean; x:real end;
+#else
+ tp2= record c1:char; i,j:integer; p:boolean end;
+#endif
+ single= array [0..0] of integer;
+ spectrum= set of wavelength;
+ np = ^node;
+ node = record val:integer; next: np end;
+
+var t,pct,ect:integer;
+ i,j,k,l,m:integer;
+#ifndef NOFLOAT
+ x,y,z:real;
+#endif
+ p,q,r:boolean;
+ c1,c2,c3:char;
+ sr1,sr2,sr3: 1939..1945;
+ bar: packed array[0..3] of 0..255;
+ color,hue,tint: wavelength;
+ grat:spectrum;
+ a1: array [-10..+10] of integer;
+#ifndef NOFLOAT
+ a2: array [ww2] of real;
+#endif
+ 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;
+#ifndef NOFLOAT
+ r3: packed record c1:char; i,j:integer; p:boolean; x:real end;
+#else
+ r3: packed record c1:char; i,j:integer; p:boolean end;
+#endif
+ 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;
+
+
+
+procedure e(n:integer);
+begin
+ ect := ect + 1;
+ writeln(' Error', n:3,' in test ', t)
+end;
+
+
+
+
+function inc(k:integer):integer; begin inc := k+1 end;
+
+
+
+{************************************************************************}
+procedure tst1;
+{ Arithmetic on 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) div 8 <> 2*2*2*2*4*4 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;
+
+{************************************************************************}
+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;
+
+#ifndef NOFLOAT
+
+{************************************************************************}
+procedure tst3;
+{ Real arithmetic }
+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) > 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;
+
+#endif
+
+
+{************************************************************************}
+procedure tst4;
+{ Boolean expressions }
+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 }
+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:=1939; sr2:=1945; sr3:=1939;
+ 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);
+
+#ifndef NOFLOAT
+ 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);
+#endif
+
+ 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:=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 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;
+
+
+#ifndef NOFLOAT
+
+{************************************************************************}
+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);
+ 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;
+
+#else
+
+{************************************************************************}
+procedure tst7;
+{ Global records }
+begin t:=7; pct := pct + 1;
+ r1.c1:='x'; r1.i:=40; r1.j:=50; r1.p:=true;
+ c1:='a'; i:=0; j:=0; p:=false;
+ if (r1.c1<>'x') or (r1.i<>40) or (r1.p<>true) then e(1);
+ r2:=r1;
+ if (r2.c1<>'x') or (r2.i<>40) or (r2.p<>true) then e(2);
+ i:=r1.i; p:=r1.p; c1:=r1.c1;
+ if (c1<>'x') or (i<>40) or (p<>true) then e(3);
+ r3.c1:='x'; r3.i:=40; r3.j:=50; r3.p:=true;
+ if (r3.c1<>'x') or (r3.i<>40) or (r3.p<>true) then e(4);
+end;
+
+#endif
+
+
+{************************************************************************}
+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^ := 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^ := [red];
+ if p4^ <> [red] then e(4);
+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);
+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);
+ end;
+
+#ifndef NOFLOAT
+
+{************************************************************************}
+ 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) > 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;
+
+#endif
+
+
+{************************************************************************}
+ 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 }
+ var cc1,cc2,cc3:char;
+ sr1,sr2,sr3: 1939..1945;
+ 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:=1939; sr2:=1945; sr3:=1939;
+ 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;
+#ifndef NOFLOAT
+ aa2: array [ww2] of real;
+#endif
+ 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);
+
+#ifndef NOFLOAT
+ for i:=1939 to 1945 do aa2[i]:=i-1938.5;
+ if (abs(aa2[1939]-0.5) > eps) or (abs(aa2[1945]-6.5) > eps) then e(2);
+#endif
+
+ 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:=1939 to 1945 do aa5[51,bat,false,i]:=300+i;
+ if aa5[51,bat,false,1940] <> 2240 then e(6);
+ for i:=50 to 52 do aa5[i,cat,true,1943]:=200+i;
+ if (aa5[50,cat,true,1943] <> 250) or (aa5[52,cat,true,1943] <> 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;
+
+
+#ifndef NOFLOAT
+
+{************************************************************************}
+ 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;
+
+#else
+{************************************************************************}
+ procedure tst16;
+ { Local records }
+ var r1,r2: tp2;
+ r3: packed record c1:char; i,j:integer; p:boolean end;
+ begin t:=16; pct := pct + 1;
+ r1.c1:='x'; r1.i:=40; r1.j:=50; r1.p:=true;
+ c1:='a'; i:=0; j:=0; p:=false;
+ if (r1.c1<>'x') or (r1.i<>40) or (r1.p<>true) then e(1);
+ r2:=r1;
+ if (r2.c1<>'x') or (r2.i<>40) or (r2.p<>true) then e(2);
+ i:=r1.i; p:=r1.p; c1:=r1.c1;
+ if (c1<>'x') or (i<>40) or (p<>true) then e(3);
+ r3.c1:='x'; r3.i:=40; r3.j:=50; r3.p:=true;
+ if (r3.c1<>'x') or (r3.i<>40) or (r3.p<>true) then e(4);
+ end;
+
+#endif
+
+{************************************************************************}
+ 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);
+ end;
+
+
+{************************************************************************}
+ procedure tst19;
+ 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);
+ end;
+
+#ifndef NOFLOAT
+
+{************************************************************************}
+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;
+
+#else
+{************************************************************************}
+procedure tst20;
+{ Mixed local and global }
+var li:integer;
+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);
+end;
+
+#endif
+
+
+{************************************************************************}
+
+{ Main Program }
+begin ect := 0; pct := 0;
+#ifndef NOFLOAT
+tst1; tst2; tst3; tst4; tst5; tst6; tst7; tst8;
+tst9; tst10; tst11; tst12; tst13; tst14; tst15; tst16;
+tst17; tst18; tst19; tst20;
+
+#else
+
+tst1; tst2; tst4; tst5; tst6; tst7; tst8;
+tst9; tst10; tst11; tst13; tst14; tst15; tst16;
+tst17; tst18; tst19; tst20;
+
+#endif
+write('Program t1:',pct:3,' tests completed.');
+writeln('Number of errors = ',ect:0);
+end.
--- /dev/null
+#
+{
+ (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
+
+}
+program t2(input,output);
+
+{ This program can be used to test out PASCAL compilers }
+
+const
+ kew='q';
+#ifndef NOFLOAT
+ eps = 2.0e-7; { This constant is machine dependent }
+#endif
+
+type wavelength = (red,blue,yellow);
+ tp2= record c1:char; i,j:integer; p:boolean; x:real end;
+ single= array [0..0] of integer;
+ spectrum= set of wavelength;
+ np= ^node;
+ node = record val:integer; next: np end;
+
+var t,pct,ect:integer;
+ i,j,k,l:integer;
+#ifndef NOFLOAT
+ w,x,y,z:real;
+#endif
+ p:boolean;
+ d:char;
+ color: wavelength;
+ head: np;
+
+
+function twice(k:integer):integer; begin twice := 2*k end;
+function inc(k:integer):integer; begin inc := k+1 end;
+
+procedure e(n:integer);
+begin
+ ect := ect + 1;
+ writeln(' Error', n:3,' in test ', t)
+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;
+#ifndef NOFLOAT
+ r3: packed record c:char; r:real end;
+#else
+ r3: packed record c:char end;
+#endif
+ 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;
+#ifndef NOFLOAT
+ a3: packed array[1..7] of real;
+#endif
+ 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;
+#ifndef NOFLOAT
+ i:=4; x:=3.5; c:='x'; p:=true;
+#else
+ i:=4; c:='x'; p:=true;
+#endif
+
+ 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;
+#ifndef NOFLOAT
+ r3.c:=c; r3.r:=x; y:=r3.r;
+#else
+ r3.c:=c;
+#endif
+ 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; d:=r7.c; d:=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);
+#ifndef NOFLOAT
+ if (r3.c<>'x') or (r3.r<>3.5) then e(3);
+#else
+ if (r3.c<>'x') then e(3);
+#endif
+ 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<>d) 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);
+
+#ifndef NOFLOAT
+ i:=4; a1[i-1]:=c; a2[i-1]:=i; a3[i]:=x;
+#else
+ i:=4; a1[i-1]:=c; a2[i-1]:=i;
+#endif
+ 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);
+#ifndef NOFLOAT
+ if a3[i] <> 3.5 then e(12);
+#endif
+ 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 }
+ type wavelength = (pink,green,orange);
+ ww2= 1939..1945;
+#ifndef NOFLOAT
+ tp2= record c1:char; i,j:integer; p:boolean; x:real end;
+#else
+ tp2= record c1:char; i,j:integer; p:boolean end;
+#endif
+ 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;
+#ifndef NOFLOAT
+ x,y,z:real;
+#endif
+ p,q,r:boolean;
+ c1,c2,c3:char;
+ sr1,sr2,sr3: 1939..1945;
+ color,hue,tint: wavelength;
+ a1: vec1;
+#ifndef NOFLOAT
+ a2: array [ww2] of real;
+#endif
+ 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;
+#ifndef NOFLOAT
+ r3: packed record c1:char; i,j:integer; p:boolean; x:real end;
+#else
+ r3: packed record c1:char; i,j:integer; p:boolean end;
+#endif
+ 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;
+
+#ifndef NOFLOAT
+
+ 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) > 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;
+
+#endif
+ procedure tst2203;
+ { Boolean expressions using intermediate level varibales }
+ 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);
+
+#ifndef NOFLOAT
+ 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);
+#endif
+
+ 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;
+
+#ifndef NOFLOAT
+
+ 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;
+
+#else
+
+ procedure tst2206;
+ { Intermediate level records }
+ begin t:=2206; pct := pct + 1;
+ r1.c1:='x'; r1.i:=40; r1.j:=50; r1.p:=true;
+ c1:='a'; i:=0; j:=0; p:=false;
+ if (r1.c1<>'x') or (r1.i<>40) or (r1.p<>true) then e(1);
+ r2:=r1;
+ if (r2.c1<>'x') or (r2.i<>40) or (r2.p<>true) then e(2);
+ i:=r1.i; p:=r1.p; c1:=r1.c1;
+ if (c1<>'x') or (i<>40) or (p<>true) then e(3);
+ r3.c1:='x'; r3.i:=40; r3.j:=50; r3.p:=true;
+ if (r3.c1<>'x') or (r3.i<>40) or (r3.p<>true) then e(4);
+ end;
+
+#endif
+ 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);
+ 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);
+ end;
+begin t:=22; pct:=pct+1;
+#ifndef NOFLOAT
+ tst2201; tst2202; tst2203; tst2204; tst2205; tst2206;
+#else
+ tst2201; tst2203; tst2204; tst2205; tst2206;
+#endif
+ 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);
+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);
+
+#ifndef NOFLOAT
+ 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);
+#endif
+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 }
+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);
+
+ color := red; k:=0;
+ case color of
+ red: k:=1; blue: k:=0; yellow: k:=0
+ end;
+ if k<>1 then e(2);
+
+ k:=0;
+ case color of
+ red,blue: k:=1; yellow: k:=0
+ end;
+ if k<>1 then e(3);
+end;
+#ifndef NOFLOAT
+
+{************************************************************************}
+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.23; ra.q[0]:=35; ra.p.i:=20;
+ with ra do
+ begin if (i<>-3006) or (x<>-6000.23) 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;
+
+#else
+
+{************************************************************************}
+procedure tst31;
+{ with statements }
+var ra: record i:integer; p:tp2; q:single;
+ a2: record a3: tp2 end
+ end;
+ rb: record j: integer; pp:tp2; qq:single end;
+begin t:=31; pct:=pct+1;
+#ifndef NOFLOAT
+ i:=0; x:=0;
+#else
+ i:=0;
+#endif
+ ra.i:=-3006; ra.q[0]:=35; ra.p.i:=20;
+ with ra do
+ begin if (i<>-3006) or (q[0]<>35)
+ or (p.i<>20) then e(2);
+
+ i:=300; q[0]:=35; p.i:=-10
+ end;
+ if (ra.i<>300) 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 i:=3; j:=9 end;
+ if (ra.i<>3) or (rb.j<>9) then e(11);
+end;
+
+
+#endif
+
+
+
+
+
+
+{************************************************************************}
+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);
+#ifndef NOFLOAT
+ x:=-2.0; if abs(x) <> 2.0 then e(3);
+#endif
+ 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);
+#ifndef NOFLOAT
+ if abs(trunc(5.2)-5.0) > eps then e(14);
+ if abs(sin(3.1415926536)) > 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);
+#endif
+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;
+
+
+
+{**********************************************************************}
+
+{ Main Program }
+begin ect := 0; pct := 0;
+tst21; tst22; tst25; tst26; tst27; tst28; tst29; tst30; tst31; tst32; tst33;
+
+write('Program t2:',pct:3,' tests completed.');
+writeln('Number of errors = ',ect:0);
+end.
--- /dev/null
+{
+ (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 }
+
+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.
--- /dev/null
+#
+{
+ (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
+
+}
+
+program t4(input,output);
+{ Tests for the EM-1 compiler }
+type vec = array[1..1000] of integer;
+ spectrum = set of (red,blue,yellow);
+#ifndef NOFLOAT
+ tp2 = record c1:char;i,j:integer; p:boolean; x:real end;
+#else
+ tp2 = record c1:char;i,j:integer; p:boolean end;
+#endif
+ cmat = array[0..3,0..7] of ^spectrum;
+ single = array [0..0] of integer;
+ np = ^node;
+ node = record val: integer; next: np end;
+
+var t,ect,pct:integer;
+ r1: tp2;
+ pt1,pt2: ^vec;
+ pt3:^integer;
+ mk: ^integer;
+ i,j: integer;
+
+
+
+procedure e(n:integer);
+begin
+ ect := ect + 1;
+ writeln(' Error', n:3,' in test ', t)
+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;
+
+
+
+procedure tst40;
+{ Mark and Release }
+var i: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
+ mark(mk);
+ new(pt2);
+ grab;
+ release(mk)
+ 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 z:boolean of
+ false: (x:array[0..20] of integer);
+ true: (a,b,c,d,e,f,g,h,i,j,k,l:char)
+ end;
+
+ y: record
+ case z: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 }
+ type ww2 = array[-10..+10] of tp2;
+ arra = array[-10..+10] of integer;
+ reca = record k:single; s:spectrum end;
+ pa = np;
+#ifndef NOFLOAT
+var l1:integer; xr:real; xb:boolean; xc:char; xar:cmat; xnode:pa;
+#else
+var l1:integer; xb:boolean; xc:char; xar:cmat; xnode:pa;
+#endif
+ vec1: arra; vec2: ww2;
+ s2:spectrum; rec1: reca;
+ zero:0..0;
+
+#ifndef NOFLOAT
+procedure tst4401(pl1:integer; pxr:real; pxb:boolean; pxc:char;
+#else
+procedure tst4401(pl1:integer; pxb:boolean; pxc:char;
+#endif
+ 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);
+#ifndef NOFLOAT
+ if pxr<>-0.31 then e(2);
+#endif
+ 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);
+#ifndef NOFLOAT
+ if (pxtp2.c1 <> 'w') or (pxtp2.x <> 20.3) then e(7);
+#else
+ if (pxtp2.c1 <> 'w') then e(7);
+#endif
+ if pvec1[10] <> -996 then e(8);
+#ifndef NOFLOAT
+ if pvec2[zero].x <> -300 then e(9);
+#endif
+ 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;
+#ifndef NOFLOAT
+ pvec2[zero].x:=0;
+#endif
+ prec1.k[zero]:=0;
+ psin[0]:=0; i:=0; j:=0;
+end;
+
+begin t:=44; pct:=pct+1;
+ zero:=0;
+#ifndef NOFLOAT
+ l1:=29; xr:=-0.31; xb:=false; xc:='k';
+#else
+ l1:=29; xb:=false; xc:='k';
+#endif
+ 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;
+#ifndef NOFLOAT
+ r1.c1:='w'; r1.x:=20.3;
+ vec1[10] := -996; vec2[zero].x := -300;
+#else
+ r1.c1:='w';
+ vec1[10] := -996;
+#endif
+ rec1.k[zero]:=-421; rec1.s :=[];
+ s2:=[red];
+
+#ifndef NOFLOAT
+ tst4401(l1, xr, xb, xc, xar, xnode, r1, vec1, vec2, rec1,
+#else
+ tst4401(l1, xb, xc, xar, xnode, r1, vec1, vec2, rec1,
+#endif
+ [], s2, rec1.k, rec1.k[zero], xnode^.next^.val);;
+ t:=44;
+
+ if l1<>29 then e(1);
+#ifndef NOFLOAT
+ if xr<> -0.31 then e(2);
+#endif
+ 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);
+#ifndef NOFLOAT
+ if (r1.c1 <> 'w') or (r1.x <> 20.3) then e(8);
+#else
+ if (r1.c1 <> 'w') then e(8);
+#endif
+ if vec1[10] <> -996 then e(9);
+#ifndef NOFLOAT
+ if vec2[zero].x <> -300 then e(10);
+#endif
+ if (rec1.k[zero] <> -421) or (rec1.s <> []) then e(11);
+ if s2 <> [red] then e(12);
+end;
+
+
+{************************************************************************}
+ procedure tst45;
+{ Var parameters }
+ type ww2 = array[-10..+10] of tp2;
+ arra = array[-10..+10] of integer;
+ reca = record k:single; s:spectrum end;
+ pa = np;
+#ifndef NOFLOAT
+var l1:integer; xr:real; xb:boolean; xc:char; xar:cmat; xnode:pa;
+#else
+var l1:integer; xb:boolean; xc:char; xar:cmat; xnode:pa;
+#endif
+ vec1: arra; vec2: ww2;
+ s1,s2:spectrum; rec1: reca;
+ zero:0..0;
+
+#ifndef NOFLOAT
+procedure tst4501(var pl1:integer; var pxr:real; var pxb:boolean; var pxc:char;
+#else
+procedure tst4501(var pl1:integer; var pxb:boolean; var pxc:char;
+#endif
+ 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);
+#ifndef NOFLOAT
+ if pxr<>-0.31 then e(2);
+#endif
+ 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);
+#ifndef NOFLOAT
+ if (pxtp2.c1 <> 'w') or (pxtp2.x <> 20.3) then e(7);
+#else
+ if (pxtp2.c1 <> 'w') then e(7);
+#endif
+ if pvec1[10] <> -996 then e(8);
+#ifndef NOFLOAT
+ if pvec2[zero].x <> -300 then e(9);
+#endif
+ 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);
+
+#ifndef NOFLOAT
+ pl1:=0; pxr:=0; pxc:=' '; pxb:=true;
+#else
+ pl1:=0; pxc:=' '; pxb:=true;
+#endif
+ pxar[1,1]^:=[]; pxar[2,2]^:=[];
+ pxnode^.val:=0; pxnode^.next^.val:=1;
+ pxtp2.c1:=' ';
+#ifndef NOFLOAT
+ pxtp2.x := 0;
+#endif
+ pvec1[10]:=0;
+#ifndef NOFLOAT
+ pvec2[zero].x:=0;
+#endif
+ prec1.k[zero]:=0;
+ psin[0]:=0; i:=223; j:=445;
+end;
+
+begin t:=45; pct:=pct+1;
+ zero:=0;
+#ifndef NOFLOAT
+ l1:=29; xr:=-0.31; xb:=false; xc:='k';
+#else
+ l1:=29; xb:=false; xc:='k';
+#endif
+ 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;
+#ifndef NOFLOAT
+ r1.c1:='w'; r1.x:=20.3;
+ vec1[10] := -996; vec2[zero].x := -300;
+#else
+ r1.c1:='w';
+ vec1[10] := -996;
+#endif
+ rec1.k[zero]:=-421; rec1.s :=[];
+ s1:=[]; s2:=[red];
+
+#ifndef NOFLOAT
+ tst4501(l1, xr, xb, xc, xar, xnode, r1, vec1, vec2, rec1,
+#else
+ tst4501(l1, xb, xc, xar, xnode, r1, vec1, vec2, rec1,
+#endif
+ s1, s2, rec1.k, rec1.k[zero], xnode^.next^.val);;
+ t:=45;
+
+ if l1<>0 then e(1);
+#ifndef NOFLOAT
+ if xr<> 0 then e(2);
+#endif
+ 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);
+#ifndef NOFLOAT
+ if (r1.c1 <> ' ') or (r1.x <> 0) then e(8);
+#else
+ if (r1.c1 <> ' ') then e(8);
+#endif
+ if vec1[10] <> 0 then e(9);
+#ifndef NOFLOAT
+ if vec2[zero].x <> 0 then e(10);
+#endif
+ if (rec1.k[zero] <> 223) or (rec1.s <> []) then e(11);
+ if (s1 <> []) or (s2 <> [red]) then e(12);
+end;
+
+
+
+
+begin ect:=0; pct:=0;
+ tst40; tst41; tst42; tst43; tst44; tst45;
+ write('Program t4:',pct:3,' tests completed.');
+ writeln('Number of errors = ',ect:0);
+end.
--- /dev/null
+{$i1000}
+program test(output);
+var b:false..true;
+ i:integer;
+ s:set of 0..999;
+begin
+ b:=true; if not b then writeln('error 1');
+ s:=[0,100,200,300,400,500,600,700,800,900];
+ for i:=0 to 999 do
+ if (i in s) <> (i mod 100=0) then
+ writeln('error 2');
+end.
--- /dev/null
+{
+ (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
+
+}
+program tstenc(output);
+const trapno=150;
+var level:integer;
+ beenhere:boolean;
+ e:integer;
+procedure trap(erno:integer); extern;
+procedure encaps(procedure p;procedure q(erno:integer)); extern;
+procedure p1;
+ label 1;
+ var plevel:integer;
+ procedure p2;
+ var plevel:integer;
+ begin plevel:=3 ; trap(trapno) ;
+ writeln('executing unreachable code in p2') ; e:=e+1 ;
+ end;
+ procedure q2(no:integer);
+ var qlevel:integer;
+ begin qlevel:=-3 ;
+ if no<>trapno then
+ begin writeln('wrong trapno ',no,' in q2'); e:=e+1 end ;
+ if plevel<>2 then
+ begin writeln('wrong level ',plevel,' in q2'); e:=e+1 end ;
+ trap(trapno) ;
+ goto 1;
+ writeln('executing unreachable code in q2') ; e:=e+1 ;
+ end;
+ begin plevel:=2 ; encaps(p2,q2) ;
+ writeln('executing unreachable code in p1'); e:=e+1;
+1: if plevel<>2 then
+ begin writeln('wrong level ', plevel, 'in p1') ; e:=e+1 end ;
+ beenhere:=true ;
+ end; { body of p1 }
+procedure q1(no:integer);
+ var qlevel:integer;
+ begin qlevel:=-2 ;
+ if no<>trapno then
+ begin writeln('wrong trapno ',no,' in q1'); e:=e+1 end ;
+ if level<>1 then
+ begin writeln('wrong level ',level,' in q1'); e:=e+1 end ;
+ end;
+begin
+ level:=1 ;
+ e:=0 ;
+ beenhere:=false ;
+ encaps(p1,q1);
+ if not beenhere then
+ begin writeln('illegaly skipped code in p1') ; e:=e+1 end;
+ if e=0 then writeln('encaps OK')
+end.
public / ack.git / commitdiff