d0p1/ack
1
0
Fork 0
Code Issues Pull requests Packages Projects Releases Wiki Activity

Initial revision

Browse source
This commit is contained in:
sater 1984-07-12 13:50:44 +00:00
parent 8c892e94eb
commit 381355408e
8 changed files with 2486 additions and 0 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

30
lang/pc/test/Makefile Normal file
View file

@ -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

224
lang/pc/test/machar.p Normal file
View file

@ -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;

675
lang/pc/test/t1.p Normal file
View file

@ -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<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.

738
lang/pc/test/t2.p Normal file
View file

@ -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<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.

332
lang/pc/test/t3.p Normal file
View file

@ -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.

410
lang/pc/test/t4.p Normal file
View file

@ -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.

12
lang/pc/test/t5.p Normal file
View file

@ -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.

65
lang/pc/test/tstenc.p Normal file
View file

@ -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.