# { (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 rcsversion='$Header$'; 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 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(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 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(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.