From 381355408eb6bbc7cc27f18c0b27f97b0f65a230 Mon Sep 17 00:00:00 2001 From: sater Date: Thu, 12 Jul 1984 13:50:44 +0000 Subject: [PATCH] Initial revision --- lang/pc/test/Makefile | 30 ++ lang/pc/test/machar.p | 224 +++++++++++++ lang/pc/test/t1.p | 675 ++++++++++++++++++++++++++++++++++++++ lang/pc/test/t2.p | 738 ++++++++++++++++++++++++++++++++++++++++++ lang/pc/test/t3.p | 332 +++++++++++++++++++ lang/pc/test/t4.p | 410 +++++++++++++++++++++++ lang/pc/test/t5.p | 12 + lang/pc/test/tstenc.p | 65 ++++ 8 files changed, 2486 insertions(+) create mode 100644 lang/pc/test/Makefile create mode 100644 lang/pc/test/machar.p create mode 100644 lang/pc/test/t1.p create mode 100644 lang/pc/test/t2.p create mode 100644 lang/pc/test/t3.p create mode 100644 lang/pc/test/t4.p create mode 100644 lang/pc/test/t5.p create mode 100644 lang/pc/test/tstenc.p diff --git a/lang/pc/test/Makefile b/lang/pc/test/Makefile new file mode 100644 index 000000000..ca05de1f7 --- /dev/null +++ b/lang/pc/test/Makefile @@ -0,0 +1,30 @@ +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 diff --git a/lang/pc/test/machar.p b/lang/pc/test/machar.p new file mode 100644 index 000000000..a13e4e73d --- /dev/null +++ b/lang/pc/test/machar.p @@ -0,0 +1,224 @@ +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; diff --git a/lang/pc/test/t1.p b/lang/pc/test/t1.p new file mode 100644 index 000000000..f845d086e --- /dev/null +++ b/lang/pc/test/t1.p @@ -0,0 +1,675 @@ +# +{ + (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 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. diff --git a/lang/pc/test/t2.p b/lang/pc/test/t2.p new file mode 100644 index 000000000..4b618858b --- /dev/null +++ b/lang/pc/test/t2.p @@ -0,0 +1,738 @@ +# +{ + (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 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(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. diff --git a/lang/pc/test/t3.p b/lang/pc/test/t3.p new file mode 100644 index 000000000..b3eb0670a --- /dev/null +++ b/lang/pc/test/t3.p @@ -0,0 +1,332 @@ +{ + (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. diff --git a/lang/pc/test/t4.p b/lang/pc/test/t4.p new file mode 100644 index 000000000..8eedd6151 --- /dev/null +++ b/lang/pc/test/t4.p @@ -0,0 +1,410 @@ +# +{ + (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. diff --git a/lang/pc/test/t5.p b/lang/pc/test/t5.p new file mode 100644 index 000000000..f3076fa80 --- /dev/null +++ b/lang/pc/test/t5.p @@ -0,0 +1,12 @@ +{$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. diff --git a/lang/pc/test/tstenc.p b/lang/pc/test/tstenc.p new file mode 100644 index 000000000..c3099e855 --- /dev/null +++ b/lang/pc/test/tstenc.p @@ -0,0 +1,65 @@ +{ + (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. -- 2.34.1