lang/pc/test/t1.p

   1 #
   2 {
   3   (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
   4
   5            This product is part of the Amsterdam Compiler Kit.
   6
   7   Permission to use, sell, duplicate or disclose this software must be
   8   obtained in writing. Requests for such permissions may be sent to
   9
  10        Dr. Andrew S. Tanenbaum
  11        Wiskundig Seminarium
  12        Vrije Universiteit
  13        Postbox 7161
  14        1007 MC Amsterdam
  15        The Netherlands
  16
  17 }
  18
  19 program t1(input,output);
  20
  21 { This program can be used to test out PASCAL compilers }
  22
  23 const
  24    rcsversion='$Id: t1.p,v 2.4 1994/06/24 12:36:50 ceriel Exp $';
  25    ONE=1;  TWO=2;  TEN=10; FIFTY=50; MINONE=-1;
  26 #ifndef NOFLOAT
  27    RR1=1.0; RR1H=1.5; RR2=2.0; RR3=3.0; RR4=4.0; RRMINONE=-1.0;
  28 #endif
  29    yes=true; no=false;
  30    kew='q';
  31 #ifndef NOFLOAT
  32    eps = 2.0e-7;  { This constant is machine dependent }
  33 #endif
  34
  35 type wavelength = (red,blue,yellow,purple,white,gray,pink,black,fuchia,maple,
  36              violet,darkred,darkblue,darkyellow,darkwhite,darkpink,darkblack);
  37 #if EM_WSIZE < 4
  38   ww2= 1939..1945;
  39 #else
  40   ww2= 1000939..1000945;
  41 #endif
  42 #ifndef NOFLOAT
  43   tp2=  record c1:char; i,j:integer; p:boolean; x:real end;
  44 #else
  45   tp2=  record c1:char; i,j:integer; p:boolean end;
  46 #endif
  47   single= array [0..0] of integer;
  48   spectrum= set of wavelength;
  49   np = ^node;
  50   node = record val:integer; next: np end;
  51
  52 var t,pct,ect:integer;
  53  i,j,k,l,m:integer;
  54 #ifndef NOFLOAT
  55  x,y,z:real;
  56 #endif
  57  p,q,r:boolean;
  58  c1,c2,c3:char;
  59 #if EM_WSIZE < 4
  60  sr1,sr2,sr3: 1939..1945;
  61 #else
  62  sr1,sr2,sr3: 1000939..1000945;
  63 #endif
  64  bar: packed array[0..3] of 0..255;
  65  color,hue,tint: wavelength;
  66  grat:spectrum;
  67  a1: array [-10..+10] of integer;
  68 #ifndef NOFLOAT
  69  a2: array [ww2] of real;
  70 #endif
  71  a3: array[wavelength] of boolean;
  72  a4: array[(mouse,house)] of char;
  73  a5: array[50..52,(bat,cat),boolean,ww2] of integer;
  74  a6: packed array[0..10,0..3,0..3] of char;
  75  r1,r2: tp2;
  76 #ifndef NOFLOAT
  77  r3: packed record c1:char; i,j:integer; p:boolean; x:real end;
  78 #else
  79  r3: packed record c1:char; i,j:integer; p:boolean end;
  80 #endif
  81  colors: set of wavelength;
  82  beasts: set of (pig,cow,chicken,farmersdaughter);
  83  bits: set of 0..1;
  84  p1: ^integer;
  85  p2: ^tp2;
  86  p3: ^single;
  87  p4: ^spectrum;
  88  head,tail: np;
  89
  90
  91
  92 procedure e(n:integer);
  93 begin
  94   ect := ect + 1;
  95   writeln(' Error', n:3,' in test ', t)
  96 end;
  97
  98
  99
 100
 101 function inc(k:integer):integer; begin inc := k+1 end;
 102
 103
 104
 105 {************************************************************************}
 106 procedure tst1;
 107 { Arithmetic on constants }
 108 begin t:=1; pct := pct + 1;
 109   if 1+1 <> 2 then e(1);
 110   if ONE+ONE <> TWO then e(2);
 111   if ONE+MINONE <> 0 then e(3);
 112   if ONE-TWO <> MINONE then e(4);
 113   if TWO-MINONE <> 3 then e(5);
 114   if TWO*TWO <> 4 then e(6);
 115   if 100*MINONE <> -100 then e(7);
 116   if 50*ONE <> 50 then e(8);
 117   if 50*9 <> 450 then e(9);
 118   if 50*TEN <> 500 then e(10);
 119   if 60 div TWO <> 30 then e(11);
 120   if FIFTY div TWO <> 25 then e(12);
 121   if -2 div 1 <> -2 then e(13);
 122   if -3 div 1 <> -3 then e(14);
 123   if -3 div 2 <> -1 then e(15);
 124   if ((1+2+3) * (2+3+4) * (3+5+5)) div 2 <> ((3 * ((5+3+2)*10)+51)*6) div 6
 125        then e(16);
 126 #if EM_WSIZE < 4
 127   if (1000*2 + 5*7 + 13) div 8 <> 2*2*2*2*4*4 then e(17);
 128 #else
 129   if (1000*2 + 5*7 + 13) * 128 div 8 <> 2*2*2*2*4*4*128 then e(17);
 130 #endif
 131   if (1 * 2 * 3 * 4 * 5 * 6 * 7) div 5040  <>
 132       5040 div 7 div 6 div 5 div 4 div 3 div 2 then e(18);
 133   if -(-(-(-(-(-(-(-(-(1))))))))) <> -1 then e(19);
 134   if -1 -1 -1 -1 -1 <> -5 then e(20);
 135   if -                          1 <> -(((((((((((((1))))))))))))) then e(21);
 136   if -4 * (-5) <> 20 then e(22);
 137   if (9999-8) mod 97 <> 309 mod 3 then e(23);
 138   if 2<1 then e(24);
 139   if 2 <= 1 then e(25);
 140   if 2 = 3 then e(26);
 141   if 2 <> 2 then e(27);
 142   if 2 >= 3 then e(28);
 143   if 2 > 3 then e(29);
 144   if 2+0 <> 2 then e(30);
 145   if 2-0 <> 2 then e(31);
 146   if 2*0 <> 0 then e(32);
 147   if 0+2 <> 2 then e(33);
 148   if 0-2 <> -2 then e(34);
 149   if 0*2 <> 0 then e(35);
 150   if 0 div 1 <> 0 then e(36);
 151   if -0 <> 0 then e(37);
 152   if 0 - 0 <> 0 then e(38);
 153   if 0 * 0 <> 0 then e(39);
 154 end;
 155
 156 {************************************************************************}
 157 procedure tst2;
 158 { Arithmetic on global integer variables }
 159 begin t:=2; pct := pct + 1;
 160   i:=1;  j:=2;  k:=3;  l:=4;  m:=10;
 161   if i+j <> k then e(1);
 162   if i+k <> l then e(2);
 163   if j-k <> -i then e(3);
 164   if j*(j+k) <> m then e(4);
 165   if -m <> -(k+k+l) then e(5);
 166   if i div i <> 1 then e(6);
 167   if m*m div m <> m then e(7);
 168   if 10*m <> 100 then e(8);
 169   if m*(-10) <> -100 then e(9);
 170   if j div k <> 0 then e(10);
 171   if 100 div k <> 33 then e(11);
 172   if i+j*k+l+m mod j + 50 div k <> 27 then e(12);
 173   if j*k*m div 6 <> 10 then e(13);
 174   if (k>4) or (k>=4) or (k=4) then e(14);
 175   if (m<j) or (m<=j) or (m=j) then e(15);
 176   if k <> i+j then e(16);
 177   if j < i then e(17);
 178   if j <= i then e(18);
 179   if j = i then e(19);
 180   if j <> j then e(20);
 181   if i >= j then e(21);
 182   if i > j then e(22);
 183 end;
 184
 185 #ifndef NOFLOAT
 186
 187 {************************************************************************}
 188 procedure tst3;
 189 { Real arithmetic }
 190 begin t:=3; pct := pct + 1;
 191   if abs(1.0+1.0-2.0) > eps then e(1);
 192   if abs(1e10-1e10) > eps then e(2);
 193   if abs(RR1+RR1H+RR2+RR3+RR4+RRMINONE-10.5) > eps then e(3);
 194   if abs(1.0e-1 * 1.0e1 - 100e-2) > eps then e(4);
 195   if abs(10.0/3.0*3.0/10.0-100e-2) > eps then e(5);
 196   if 0.0e0 <> 0 then e(6);
 197   if abs(32767.0-32767.0) > eps then e(7);
 198   if abs(1.0+2+5+3.0e0+5.0e+0+140e-1-30.000)/100 > eps then e(8);
 199   if abs(-1+(-1)+(-1.0)+(-1e0)+(-1e+0)+(-1e-0) + ((((6)))) ) > eps then e(9);
 200
 201   x:=1.50;  y:=3.00; z:= 0.10;
 202   if abs(5*y*z-x) > eps then e(10);
 203   if abs(y*y*y/z*x-405) > eps then e(11);
 204   x:=1.1;  y:= 1.2;
 205   if y<x then e(12);
 206   if y <= x then e(13);
 207   if y = x then e(14);
 208   if x <> x then e(15);
 209   if x >= y then e(16);
 210   if x >y then e(17);
 211 end;
 212
 213 #endif
 214
 215
 216 {************************************************************************}
 217 procedure tst4;
 218 { Boolean expressions }
 219 begin t:=4; pct := pct + 1;
 220   if not yes = true then e(1);
 221   if not no = false then e(2);
 222   if yes = no then e(3);
 223   if not true = not false then e(4);
 224   if true and false then e(5);
 225   if false or false then e(6);
 226
 227   p:=true; q:=true; r:=false;
 228   if not p then e(7);
 229   if r then e(8);
 230   if p and r then e(9);
 231   if p and not q then e(10);
 232   if not p or not q then e(11);
 233   if (p and r) or (q and r) then e(12);
 234   if p and q and r then e(13);
 235   if (p or q) = r then e(14);
 236 end;
 237
 238 {************************************************************************}
 239 procedure tst5;
 240 { Characters, Subranges, Enumerated types }
 241 begin t:=5; pct := pct + 1;
 242   if 'q' <> kew then e(1);
 243   c1 := 'a'; c2 := 'b'; c3 := 'a';
 244   if c1 = c2 then e(2);
 245   if c1 <> c3 then e(3);
 246
 247 #if EM_WSIZE < 4
 248   sr1:=1939; sr2:=1945; sr3:=1939;
 249 #else
 250   sr1:=1000939; sr2:=1000945; sr3:=1000939;
 251 #endif
 252   if sr1=sr2 then e(4);
 253   if sr1<>sr3 then e(5);
 254
 255   color := yellow; hue := blue; tint := yellow;
 256   if color = hue then e(6);
 257   if color <> tint then e(7);
 258 end;
 259
 260
 261 {************************************************************************}
 262 procedure tst6;
 263 { Global arrays }
 264 var i,j,k:integer;
 265 begin t:=6; pct := pct + 1;
 266   for i:= -10 to 10 do a1[i] := i*i;
 267   if (a1[-10]<>100) or (a1[9]<>81) then e(1);
 268
 269 #ifndef NOFLOAT
 270 #if EM_WSIZE < 4
 271   for i:=1939 to 1945 do a2[i]:=i-1938.5;
 272   if (abs(a2[1939]-0.5) > eps) or (abs(a2[1945]-6.5) > eps) then e(2);
 273 #else
 274   for i:=1000939 to 1000945 do a2[i]:=i-1000938.5;
 275   if (abs(a2[1000939]-0.5) > eps) or (abs(a2[1000945]-6.5) > eps) then e(2);
 276 #endif
 277 #endif
 278
 279   color := yellow;
 280   a3[blue] := true;  a3[yellow] := true;
 281   if (a3[blue]<>true) or (a3[yellow]<>true) then e(3);
 282   a3[blue] := false;  a3[yellow] := false;
 283   if (a3[blue]<>false) or (a3[yellow]<>false) then e(4);
 284
 285   a4[mouse]:='m'; a4[house]:='h';
 286   if (a4[mouse] <> 'm') or (a4[house]<>'h' ) then e(5);
 287
 288 #if EM_WSIZE < 4
 289   for i:=1939 to 1945 do a5[51,bat,false,i]:=300+i;
 290   if a5[51,bat,false,1940] <> 2240 then e(6);
 291   for i:=50 to 52 do a5[i,cat,true,1943]:=200+i;
 292   if (a5[50,cat,true,1943] <> 250) or (a5[52,cat,true,1943] <> 252) then e(7);
 293 #else
 294   for i:=1000939 to 1000945 do a5[51,bat,false,i]:=300+i;
 295   if a5[51,bat,false,1000940] <> 1001240 then e(6);
 296   for i:=50 to 52 do a5[i,cat,true,1000943]:=200+i;
 297   if (a5[50,cat,true,1000943] <> 250) or (a5[52,cat,true,1000943] <> 252) then e(7);
 298 #endif
 299
 300   for i:= -10 to 10 do a1[i]:= 0;
 301   for i:= 0 to 10 do a1[i div 2 + i div 2]:= i+1;
 302   if(a1[0]<>2) or (a1[5]<>0) or (a1[8]<>10) then e(8);
 303
 304   for i:= 0 to 10 do
 305   for j:= 0 to 3 do
 306   for k:= 0 to 3 do
 307    if ( (i+j+k) div 2) * 2 = i+j+k then a6[i,j,k]:='e' else a6[i,j,k]:='o';
 308    if (a6[2,2,2]<>'e') or (a6[2,2,3]<>'o') or (a6[0,3,1]<>'e') then e(9);
 309 end;
 310
 311
 312 #ifndef NOFLOAT
 313
 314 {************************************************************************}
 315 procedure tst7;
 316 { Global records }
 317 begin t:=7; pct := pct + 1;
 318   r1.c1:='x'; r1.i:=40; r1.j:=50; r1.p:=true; r1.x:=3.0;
 319   c1:='a'; i:=0;  j:=0; p:=false; x:=100.0;
 320   if (r1.c1<>'x') or (r1.i<>40) or (r1.p<>true) or (r1.x<>3.0) then e(1);
 321   r2:=r1;
 322   if (r2.c1<>'x') or (r2.i<>40) or (r2.p<>true) or (r2.x<>3.0) then e(2);
 323   i:=r1.i;  p:=r1.p;  c1:=r1.c1; x:=r1.x;
 324   if (c1<>'x') or (i<>40) or (p<>true) or (x<>3.0) then e(3);
 325   r3.c1:='x'; r3.i:=40; r3.j:=50; r3.p:=true; r3.x:=3.0;
 326   if (r3.c1<>'x') or (r3.i<>40) or (r3.p<>true) or (r3.x<>3.0) then e(4);
 327 end;
 328
 329 #else
 330
 331 {************************************************************************}
 332 procedure tst7;
 333 { Global records }
 334 begin t:=7; pct := pct + 1;
 335   r1.c1:='x'; r1.i:=40; r1.j:=50; r1.p:=true;
 336   c1:='a'; i:=0;  j:=0; p:=false;
 337   if (r1.c1<>'x') or (r1.i<>40) or (r1.p<>true) then e(1);
 338   r2:=r1;
 339   if (r2.c1<>'x') or (r2.i<>40) or (r2.p<>true) then e(2);
 340   i:=r1.i;  p:=r1.p;  c1:=r1.c1;
 341   if (c1<>'x') or (i<>40) or (p<>true) then e(3);
 342   r3.c1:='x'; r3.i:=40; r3.j:=50; r3.p:=true;
 343   if (r3.c1<>'x') or (r3.i<>40) or (r3.p<>true) then e(4);
 344 end;
 345
 346 #endif
 347
 348
 349 {************************************************************************}
 350 procedure tst8;
 351 { Global sets }
 352 begin t:=8; pct := pct + 1;
 353   colors := [];
 354   colors := colors + [];
 355   if colors <> [] then e(1);
 356   colors := colors + [red];
 357   if colors <> [red] then e(2);
 358   colors := colors + [blue];
 359   if colors <> [red,blue] then e(3);
 360   if colors <> [blue,red] then e(4);
 361   colors := colors - [red];
 362   if colors <> [blue] then e(5);
 363   beasts := [chicken] + [chicken,pig];
 364   if beasts <> [pig,chicken] then e(6);
 365   beasts := [] - [farmersdaughter] + [cow] - [cow];
 366   if beasts <> [] then e(7);
 367   bits := [0] + [1] - [0];
 368   if bits <> [1] then e(8);
 369   bits := [] + [] + [] -[] + [0] + [] + [] - [0];
 370   if bits <> [] then e(9);
 371   if not ([] <= [red]) then e(10);
 372   if [red] >= [blue] then e(11);
 373   if [red] <= [blue] then e(12);
 374   if [red] = [blue] then e(13);
 375   if not ([red] <= [red,blue]) then e(14);
 376   if not ([red,blue] <= [red,yellow,blue]) then e(15);
 377   if not ([blue,yellow] >= [blue] + [yellow]) then e(16);
 378   grat := [ red,blue,yellow,purple,white,gray,pink,black,fuchia,maple,
 379            violet,darkred,darkblue,darkyellow,darkwhite,darkpink,darkblack];
 380   if grat<>[red,blue,yellow,purple,white,gray,pink,black,fuchia,maple,violet,
 381    darkred,darkblue,darkyellow,darkwhite,darkpink,darkblack] then e(17);
 382   if not ([10] <= [10]) then e(18);
 383 end;
 384
 385
 386 {************************************************************************}
 387 procedure tst9;
 388 { Global pointers }
 389 begin t:=9; pct := pct + 1;
 390   new(p1); new(p2); new(p3); new(p4);
 391 #if EM_WSIZE < 4
 392   p1^ := 1066;
 393   if p1^ <> 1066 then e(1);
 394 #else
 395   p1^ := 1000066;
 396   if p1^ <> 1000066 then e(1);
 397 #endif
 398   p2^.i := 1215;
 399   if p2^.i <> 1215 then e(2);
 400   p3^[0]:= 1566;
 401   if p3^[0] <> 1566 then e(3);
 402   p4^ := [red];
 403   if p4^ <> [red] then e(4);
 404 end;
 405
 406
 407 {************************************************************************}
 408 procedure tst10;
 409 { More global pointers }
 410 var i:integer;
 411 begin t:=10; pct := pct + 1;
 412   head := nil;
 413   for i:= 1 to 100 do
 414     begin new(tail); tail^.val:=100+i; tail^.next :=head; head:= tail end;
 415   if (tail^.val<>200) or (tail^.next^.val<>199) then e(1);
 416   if tail^.next^.next^.next^.next^.next^.next^.next^.next^.val<> 192 then e(2);
 417   tail^.next^.next^.next^.val := 30;
 418   if tail^.next^.next^.next^.val <> 30 then e(3);
 419 end;
 420
 421
 422 {************************************************************************}
 423  procedure tst11;
 424  { Arithmetic on local integer variables }
 425  var i,j,k,l,m:integer;
 426  begin t:=11; pct := pct + 1;
 427   i:=1;  j:=2;  k:=3;  l:=4;  m:=10;
 428   if i+j <> k then e(1);
 429   if i+k <> l then e(2);
 430   if j-k <> -i then e(3);
 431   if j*(j+k) <> m then e(4);
 432   if -m <> -(k+k+l) then e(5);
 433   if i div i <> 1 then e(6);
 434   if m*m div m <> m then e(7);
 435   if 10*m <> 100 then e(8);
 436   if m*(-10) <> -100 then e(9);
 437   if j div k <> 0 then e(10);
 438   if 100 div k <> 33 then e(11);
 439   if i+j*k+l+m mod j + 50 div k <> 27 then e(12);
 440   if j*k*m div 6 <> 10 then e(13);
 441   if (k>4) or (k>=4) or (k=4) then e(14);
 442   if (m<j) or (m<=j) or (m=j) then e(15);
 443   if k <> i+j then e(16);
 444  end;
 445
 446 #ifndef NOFLOAT
 447
 448 {************************************************************************}
 449  procedure tst12;
 450  { Real arithmetic on locals }
 451  var x,y,z:real;
 452  begin t:=12; pct := pct + 1;
 453
 454   x:=1.50;  y:=3.00; z:= 0.10;
 455   if abs(5*y*z-x) > eps then e(10);
 456   if abs(y*y*y/z*x-405) > eps then e(11);
 457   x:=1.1;  y:= 1.2;
 458   if y<x then e(12);
 459   if y <= x then e(13);
 460   if y = x then e(14);
 461   if x <> x then e(15);
 462   if x >= y then e(16);
 463   if x >y then e(17);
 464  end;
 465
 466 #endif
 467
 468
 469 {************************************************************************}
 470  procedure tst13;
 471  { Boolean expressions using locals }
 472  var pp,qq,rr:boolean;
 473  begin t:=13; pct := pct + 1;
 474   if not yes = true then e(1);
 475   if not no = false then e(2);
 476   if yes = no then e(3);
 477   if not true = not false then e(4);
 478   if true and false then e(5);
 479   if false or false then e(6);
 480
 481   pp:=true; qq:=true; rr:=false;
 482   if not pp then e(7);
 483   if rr then e(8);
 484   if pp and rr then e(9);
 485   if pp and not qq then e(10);
 486   if not pp or not qq then e(11);
 487   if (pp and rr) or (qq and rr) then e(12);
 488   if pp and qq and rr then e(13);
 489   if (pp or qq) = rr then e(14);
 490  end;
 491
 492 {************************************************************************}
 493  procedure tst14;
 494  { Characters, Subranges, Enumerated types using locals }
 495  var cc1,cc2,cc3:char;
 496 #if EM_WSIZE < 4
 497    sr1,sr2,sr3: 1939..1945;
 498 #else
 499    sr1,sr2,sr3: 1000939..1000945;
 500 #endif
 501    color,hue,tint: (ochre,magenta);
 502  begin t:=14; pct := pct + 1;
 503   if 'q' <> kew then e(1);
 504   cc1 := 'a'; cc2 := 'b'; cc3 := 'a';
 505   if cc1 = cc2 then e(2);
 506   if cc1 <> cc3 then e(3);
 507
 508 #if EM_WSIZE < 4
 509   sr1:=1939; sr2:=1945; sr3:=1939;
 510 #else
 511   sr1:=1000939; sr2:=1000945; sr3:=1000939;
 512 #endif
 513   if sr1=sr2 then e(4);
 514   if sr1<>sr3 then e(5);
 515   bar[0]:=200;  bar[1]:=255;  bar[2]:=255; bar[3]:=203;
 516   if (bar[0]<>200) or (bar[1]<>255) or (bar[2]<>255) or (bar[3]<>203) then e(6);
 517
 518   color := ochre; hue:=magenta; tint := ochre;
 519   if color = hue then e(7);
 520   if color <> tint then e(8);
 521  end;
 522
 523
 524 {************************************************************************}
 525  procedure tst15;
 526  { Local arrays }
 527  type colour = (magenta,ochre);
 528  var aa1: array [-10..+10] of integer;
 529 #ifndef NOFLOAT
 530     aa2: array [ww2] of real;
 531 #endif
 532     aa3: array[colour] of boolean;
 533     aa4: array[(mouse,house,louse)] of char;
 534     aa5: array[50..52,(bat,cat),boolean,ww2] of integer;
 535     aa6: packed array[0..10,0..3,0..3] of char;
 536     i,j,k:integer;
 537  begin t:=15; pct := pct + 1;
 538   for i:= -10 to 10 do aa1[i] := i*i;
 539   if (aa1[-10]<>100) or (aa1[9]<>81) then e(1);
 540
 541 #ifndef NOFLOAT
 542 #if EM_WSIZE < 4
 543   for i:=1939 to 1945 do aa2[i]:=i-1938.5;
 544   if (abs(aa2[1939]-0.5) > eps) or (abs(aa2[1945]-6.5) > eps) then e(2);
 545 #else
 546   for i:=1000939 to 1000945 do aa2[i]:=i-1000938.5;
 547   if (abs(aa2[1000939]-0.5) > eps) or (abs(aa2[1000945]-6.5) > eps) then e(2);
 548 #endif
 549 #endif
 550
 551   aa3[magenta] := true;  aa3[ochre] := true;
 552   if (aa3[magenta]<>true) or (aa3[ochre]<>true) then e(3);
 553   aa3[magenta] := false;  aa3[ochre] := false;
 554   if (aa3[magenta]<>false) or (aa3[ochre]<>false) then e(4);
 555
 556   aa4[mouse]:='m'; aa4[house]:='h';  aa4[louse]:='l';
 557   if (aa4[mouse] <> 'm') or (aa4[house]<>'h' ) or (aa4[louse]<>'l') then e(5);
 558
 559 #if EM_WSIZE < 4
 560   for i:=1939 to 1945 do aa5[51,bat,false,i]:=300+i;
 561   if aa5[51,bat,false,1940] <> 2240 then e(6);
 562   for i:=50 to 52 do aa5[i,cat,true,1943]:=200+i;
 563   if (aa5[50,cat,true,1943] <> 250) or (aa5[52,cat,true,1943] <> 252) then e(7);
 564 #else
 565   for i:=1000939 to 1000945 do aa5[51,bat,false,i]:=300+i;
 566   if aa5[51,bat,false,1000940] <> 1001240 then e(6);
 567   for i:=50 to 52 do aa5[i,cat,true,1000943]:=200+i;
 568   if (aa5[50,cat,true,1000943] <> 250) or (aa5[52,cat,true,1000943] <> 252) then e(7);
 569 #endif
 570
 571   for i:= -10 to 10 do aa1[i]:= 0;
 572   for i:= 0 to 10 do aa1[i div 2 + i div 2]:= i+1;
 573   if(aa1[0]<>2) or (aa1[5]<>0) or (aa1[8]<>10) then e(8);
 574
 575   for i:= 0 to 10 do
 576   for j:= 0 to 3 do
 577   for k:= 0 to 3 do
 578     if ( (i+j+k) div 2) * 2 = i+j+k then aa6[i,j,k]:='e' else aa6[i,j,k]:='o';
 579   if (aa6[2,2,2]<>'e') or (aa6[2,2,3]<>'o') or (aa6[0,3,1]<>'e') then e(9);
 580  end;
 581
 582
 583 #ifndef NOFLOAT
 584
 585 {************************************************************************}
 586  procedure tst16;
 587  { Local records }
 588  var r1,r2: tp2;
 589      r3: packed record c1:char; i,j:integer; p:boolean; x:real end;
 590  begin t:=16; pct := pct + 1;
 591   r1.c1:='x'; r1.i:=40; r1.j:=50; r1.p:=true; r1.x:=3.0;
 592   c1:='a'; i:=0;  j:=0; p:=false; x:=100.0;
 593   if (r1.c1<>'x') or (r1.i<>40) or (r1.p<>true) or (r1.x<>3.0) then e(1);
 594   r2:=r1;
 595   if (r2.c1<>'x') or (r2.i<>40) or (r2.p<>true) or (r2.x<>3.0) then e(2);
 596   i:=r1.i;  p:=r1.p;  c1:=r1.c1; x:=r1.x;
 597   if (c1<>'x') or (i<>40) or (p<>true) or (x<>3.0) then e(3);
 598   r3.c1:='x'; r3.i:=40; r3.j:=50; r3.p:=true; r3.x:=3.0;
 599   if (r3.c1<>'x') or (r3.i<>40) or (r3.p<>true) or (r3.x<>3.0) then e(4);
 600  end;
 601
 602 #else
 603 {************************************************************************}
 604  procedure tst16;
 605  { Local records }
 606  var r1,r2: tp2;
 607      r3: packed record c1:char; i,j:integer; p:boolean end;
 608  begin t:=16; pct := pct + 1;
 609   r1.c1:='x'; r1.i:=40; r1.j:=50; r1.p:=true;
 610   c1:='a'; i:=0;  j:=0; p:=false;
 611   if (r1.c1<>'x') or (r1.i<>40) or (r1.p<>true) then e(1);
 612   r2:=r1;
 613   if (r2.c1<>'x') or (r2.i<>40) or (r2.p<>true) then e(2);
 614   i:=r1.i;  p:=r1.p;  c1:=r1.c1;
 615   if (c1<>'x') or (i<>40) or (p<>true) then e(3);
 616   r3.c1:='x'; r3.i:=40; r3.j:=50; r3.p:=true;
 617   if (r3.c1<>'x') or (r3.i<>40) or (r3.p<>true) then e(4);
 618  end;
 619
 620 #endif
 621
 622 {************************************************************************}
 623  procedure tst17;
 624  { Local sets }
 625  var colors: set of (pink,green,orange,red);
 626      beasts: set of (pig,cow,chicken,farmersdaughter);
 627      bits: set of 0..1;
 628  begin t:=17; pct := pct + 1;
 629   colors := [];
 630   colors := colors + [];
 631   if colors <> [] then e(1);
 632   colors := colors + [pink];
 633   if colors <> [pink] then e(2);
 634   colors := colors + [green];
 635   if colors <> [pink,green] then e(3);
 636   if colors <> [green,pink] then e(4);
 637   colors := colors - [pink,orange];
 638   if colors <> [green] then e(5);
 639   beasts := [chicken] + [chicken,pig];
 640   if beasts <> [pig,chicken] then e(6);
 641   beasts := [] - [farmersdaughter] + [cow] - [cow];
 642   if beasts <> [] then e(7);
 643   bits := [0] + [1] - [0];
 644   if bits <> [1] then e(8);
 645   bits := [] + [] + [] + [0] + [] + [0];
 646   if bits <> [0] then e(9);
 647   if ord(red) <> 3 then e(10);
 648  end;
 649
 650
 651 {************************************************************************}
 652  procedure tst18;
 653  { Local pointers }
 654     type rainbow = set of (pink,purple,chartreuse);
 655     var p1: ^integer;
 656     p2: ^tp2;
 657     p3: ^single;
 658     p4: ^rainbow;
 659  begin t:=18; pct := pct + 1;
 660   new(p1); new(p2); new(p3); new(p4);
 661   p1^ := 1066;
 662   if p1^ <> 1066 then e(1);
 663   p2^.i := 1215;
 664   if p2^.i <> 1215 then e(2);
 665   p3^[0]:= 1566;
 666   if p3^[0] <> 1566 then e(3);
 667   p4^ := [pink] + [purple] + [purple,chartreuse] - [purple];
 668   if p4^ <> [pink,chartreuse] then e(4);
 669  end;
 670
 671
 672 {************************************************************************}
 673  procedure tst19;
 674  var head,tail: np; i:integer;
 675  begin t:=19; pct := pct + 1;
 676   head := nil;
 677   for i:= 1 to 100 do
 678     begin new(tail); tail^.val:=100+i; tail^.next :=head; head:= tail end;
 679   if (tail^.val<>200) or (tail^.next^.val<>199) then e(1);
 680   if tail^.next^.next^.next^.next^.next^.next^.next^.next^.val<> 192 then e(2);
 681   tail^.next^.next^.next^.val := 30;
 682   if tail^.next^.next^.next^.val <> 30 then e(3);
 683  end;
 684
 685 #ifndef NOFLOAT
 686
 687 {************************************************************************}
 688 procedure tst20;
 689 { Mixed local and global }
 690 var li:integer;
 691     lx:real;
 692 begin t:=20; pct := pct + 1;
 693   li:=6;  i:=li;  if i<>6 then e(1);
 694   i:=6;  li:=i;  if li <> 6 then e(2);
 695   lx := 3.5;  x:=lx;  if x <> 3.5 then e(3);
 696   x:= 4.5;  lx:= x;  if lx <> 4.5 then e(4);
 697 end;
 698
 699 #else
 700 {************************************************************************}
 701 procedure tst20;
 702 { Mixed local and global }
 703 var li:integer;
 704 begin t:=20; pct := pct + 1;
 705   li:=6;  i:=li;  if i<>6 then e(1);
 706   i:=6;  li:=i;  if li <> 6 then e(2);
 707 end;
 708
 709 #endif
 710
 711
 712 {************************************************************************}
 713
 714 { Main Program }
 715 begin ect := 0;  pct := 0;
 716 #ifndef NOFLOAT
 717 tst1;   tst2;   tst3;   tst4;   tst5;   tst6;   tst7;   tst8;
 718 tst9;   tst10;  tst11;  tst12;  tst13;  tst14;  tst15;  tst16;
 719 tst17;  tst18;  tst19;  tst20;
 720
 721 #else
 722
 723 tst1;   tst2;   tst4;   tst5;   tst6;   tst7;   tst8;
 724 tst9;   tst10;  tst11;  tst13;  tst14;  tst15;  tst16;
 725 tst17;  tst18;  tst19;  tst20;
 726
 727 #endif
 728 write('Program t1:',pct:3,' tests completed.');
 729 writeln('Number of errors = ',ect:1);
 730 end.