lang/pc/test/t2.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 program t2(input,output);
  19
  20 { This program can be used to test out PASCAL compilers }
  21
  22 const
  23    rcsversion='$Id: t2.p,v 2.3 1994/06/24 12:36:54 ceriel Exp $';
  24    kew='q';
  25 #ifndef NOFLOAT
  26    eps = 2.0e-7;  { This constant is machine dependent }
  27 #endif
  28
  29 type wavelength = (red,blue,yellow);
  30   tp2=  record c1:char; i,j:integer; p:boolean; x:real end;
  31   single= array [0..0] of integer;
  32   spectrum= set of wavelength;
  33   np= ^node;
  34   node = record val:integer; next: np end;
  35
  36 var t,pct,ect:integer;
  37  i,j,k,l:integer;
  38 #ifndef NOFLOAT
  39  w,x,y,z:real;
  40 #endif
  41  p:boolean;
  42  d:char;
  43  color: wavelength;
  44  head: np;
  45
  46
  47 function twice(k:integer):integer; begin twice := 2*k end;
  48 function inc(k:integer):integer; begin inc := k+1 end;
  49
  50 procedure e(n:integer);
  51 begin
  52   ect := ect + 1;
  53   writeln(' Error', n:3,' in test ', t)
  54 end;
  55
  56
  57
  58
  59
  60 {************************************************************************}
  61 procedure tst21;
  62 { Test things packed }
  63 var i:integer;  c:char;
  64     r1: packed record c:char; b:boolean;  i:integer end;
  65     r2: packed record c:char; i:integer; b:boolean; j:integer end;
  66 #ifndef NOFLOAT
  67     r3: packed record c:char; r:real end;
  68 #else
  69     r3: packed record c:char end;
  70 #endif
  71     r4: packed record i:0..10; j:integer end;
  72     r5: packed record x:array[1..3] of char; i:integer end;
  73     r6: packed record x: packed array[1..3] of char; i:integer end;
  74     r7: packed record c:char; x:packed array[1..3] of char end;
  75     r8: packed record c:char; x:packed array[1..3] of integer end;
  76     r9: record x:packed record c:char; i:integer end; i:integer; c:char end;
  77      r10:packed record a:0..100; b:0..100; c:char; d:char end;
  78
  79     a1: packed array[1..3] of char;
  80     a2: packed array[1..3] of integer;
  81 #ifndef NOFLOAT
  82     a3: packed array[1..7] of real;
  83 #endif
  84     a4: packed array[1..7] of array[1..11] of char;
  85     a5: packed array[1..5] of array[1..11] of integer;
  86     a6: packed array[1..9] of packed array[1..11] of char;
  87     a7: packed array[1..3] of packed array[1..5] of integer;
  88 begin t:=21;  pct := pct + 1;
  89 #ifndef NOFLOAT
  90   i:=4;  x:=3.5;  c:='x'; p:=true;
  91 #else
  92   i:=4;  c:='x'; p:=true;
  93 #endif
  94
  95   r1.c:='a';  r1.b:=true;  r1.i:=i;   p:=r1.b;  j:=r1.i;
  96   r2.c:=c;  r2.i:=i;  r2.b:=p;  r2.j:=i;  j:=r2.i;  j:=r2.j;
  97 #ifndef NOFLOAT
  98   r3.c:=c;  r3.r:=x;  y:=r3.r;
  99 #else
 100   r3.c:=c;
 101 #endif
 102   r4.i:=i;  r4.j:=i;  j:=r4.i;  j:=r4.j;
 103   r5.x[i-2]:=c;  r5.i:=i;  j:=r5.i;
 104   r6.x[i-1]:=c;  r6.i:=i;  j:=r6.i;
 105   r7.c:=c;  r7.x[i-1]:=c;  d:=r7.c;  d:=r7.x[i-1];
 106   r8.c:=c;  r8.x[i-1]:=5;  j:=r8.x[i-1];
 107   r9.x.c:=c;  r9.x.i:=i;  r9.c:=c;  j:=r9.x.i;
 108
 109   if (r1.c <> 'a') or (r1.b <> true) or (r1.i <> 4) then e(1);
 110   if (r2.c<>'x') or (r2.i<>4) or (r2.b<>p) or (r2.j<>4) then e(2);
 111 #ifndef NOFLOAT
 112   if (r3.c<>'x') or (r3.r<>3.5) then e(3);
 113 #else
 114   if (r3.c<>'x') then e(3);
 115 #endif
 116   if (r4.i<>4) or (r4.j<>4) then e(4);
 117   if (r5.x[2]<>'x') or (r5.i<>4) then e(5);
 118   if (r6.x[3]<>'x') or (r6.i<>4) then e(6);
 119   if (r7.c<>'x') or (r7.x[3]<>'x') or (c<>d) then e(7);
 120   if (r8.c<>'x') or (r8.x[3]<>5) then e(8);
 121   if (r9.x.c<>'x') or (r9.x.i<>4) or (r9.c<>'x') then e(9);
 122
 123 #ifndef NOFLOAT
 124   i:=4;  a1[i-1]:=c;    a2[i-1]:=i;   a3[i]:=x;
 125 #else
 126   i:=4;  a1[i-1]:=c;    a2[i-1]:=i;
 127 #endif
 128   a4[i][i+1]:=c;
 129   a5[i][i+1]:=i;  j:=a5[i][i+1];
 130   a6[i][i+1]:=c;
 131   a7[i-1][i+1]:=i;  j:=a7[i-1][i+1];
 132
 133   if a1[i-1] <> 'x' then e(10);
 134   if a2[i-1] <> 4 then e(11);
 135 #ifndef NOFLOAT
 136   if a3[i] <> 3.5 then e(12);
 137 #endif
 138   if a4[i][i+1] <> 'x' then e(13);
 139   if a5[i][i+1] <> 4 then e(14);
 140   if a6[i][i+1] <> 'x' then e(15);
 141   if a7[i-1][i+1] <> 4 then e(16);
 142
 143   i:=75; c:='s';
 144   r10.a:=i;  r10.b:=i+1;  r10.c:='x';  r10.d:=c;
 145   if (r10.a<>i) or (r10.b<>76) or (r10.c<>'x') or (r10.d<>'s') then e(17);
 146   i:=r10.a;  if i<>75 then e(18);
 147   i:=r10.b;  if i<>76 then e(19);
 148   c:=r10.c;  if c<>'x'then e(20);
 149   c:=r10.d;  if c<>'s'then e(21);
 150 end;
 151
 152
 153 {************************************************************************}
 154  procedure tst22;
 155 { References to intermediate lexical levels }
 156  type wavelength = (pink,green,orange);
 157      ww2= 1939..1945;
 158 #ifndef NOFLOAT
 159      tp2=  record c1:char; i,j:integer; p:boolean; x:real end;
 160 #else
 161      tp2=  record c1:char; i,j:integer; p:boolean end;
 162 #endif
 163      single= array [0..0] of integer;
 164      spectrum= set of wavelength;
 165      pnode = ^node;
 166      node = record val:integer; next: pnode end;
 167      vec1 = array[-10..+10] of integer;
 168
 169  var j,k,m:integer;
 170 #ifndef NOFLOAT
 171     x,y,z:real;
 172 #endif
 173     p,q,r:boolean;
 174     c1,c2,c3:char;
 175     sr1,sr2,sr3: 1939..1945;
 176     color,hue,tint: wavelength;
 177     a1: vec1;
 178 #ifndef NOFLOAT
 179     a2: array [ww2] of real;
 180 #endif
 181     a3: array[wavelength] of boolean;
 182     a4: array[(mouse,house)] of char;
 183     a5: array[50..52,(bat,cat,rat),boolean,ww2] of integer;
 184     a6: packed array[0..10,0..3,0..3] of char;
 185     r1,r2: tp2;
 186 #ifndef NOFLOAT
 187     r3: packed record c1:char; i,j:integer; p:boolean; x:real end;
 188 #else
 189     r3: packed record c1:char; i,j:integer; p:boolean end;
 190 #endif
 191     colors: spectrum;
 192     beasts: set of (pig,chicken,farmersdaughter);
 193     bits: set of 0..1;
 194     p1: ^integer;
 195     p2: ^tp2;
 196     p3: ^single;
 197     p4: ^spectrum;
 198     tail: np;
 199
 200
 201
 202
 203  procedure tst2201;
 204  { Arithmetic on intermediate level integer variables }
 205  begin t:=2201; pct := pct + 1;
 206   i:=1;  j:=2;  k:=3;  l:=4;  m:=10;
 207   if i+j <> k then e(1);
 208   if i+k <> l then e(2);
 209   if j-k <> -i then e(3);
 210   if j*(j+k) <> m then e(4);
 211   if -m <> -(k+k+l) then e(5);
 212   if i div i <> 1 then e(6);
 213   if m*m div m <> m then e(7);
 214   if 10*m <> 100 then e(8);
 215   if m*(-10) <> -100 then e(9);
 216   if j div k <> 0 then e(10);
 217   if 100 div k <> 33 then e(11);
 218   if i+j*k+l+m mod j + 50 div k <> 27 then e(12);
 219   if j*k*m div 6 <> 10 then e(13);
 220   if (k>4) or (k>=4) or (k=4) then e(14);
 221   if (m<j) or (m<=j) or (m=j) then e(15);
 222   if k <> i+j then e(16);
 223  end;
 224
 225 #ifndef NOFLOAT
 226
 227  procedure tst2202;
 228  { Real arithmetic using intermediate level variables }
 229  begin t:=2202; pct := pct + 1;
 230
 231   x:=1.50;  y:=3.00; z:= 0.10;
 232   if abs(5*y*z-x) > eps then e(10);
 233   if abs(y*y*y/z*x-405) > eps then e(11);
 234   x:=1.1;  y:= 1.2;
 235   if y<x then e(12);
 236   if y <= x then e(13);
 237   if y = x then e(14);
 238   if x <> x then e(15);
 239   if x >= y then e(16);
 240   if x >y then e(17);
 241  end;
 242
 243 #endif
 244  procedure tst2203;
 245  { Boolean expressions using intermediate level varibales }
 246  begin t:=2203; pct := pct + 1;
 247   p:=true; q:=true; r:=false;
 248   if not p then e(7);
 249   if r then e(8);
 250   if p and r then e(9);
 251   if p and not q then e(10);
 252   if not p or not q then e(11);
 253   if (p and r) or (q and r) then e(12);
 254   if p and q and r then e(13);
 255   if (p or q) = r then e(14);
 256  end;
 257
 258  procedure tst2204;
 259  { Characters, Subranges, Enumerated types using intermediate level vars }
 260  begin t:=2204; pct := pct + 1;
 261   if 'q' <> kew then e(1);
 262   c1 := 'a'; c2 := 'b'; c3 := 'a';
 263   if c1 = c2 then e(2);
 264   if c1 <> c3 then e(3);
 265
 266   sr1:=1939; sr2:=1945; sr3:=1939;
 267   if sr1=sr2 then e(4);
 268   if sr1<>sr3 then e(5);
 269
 270   color := orange; hue := green; tint := orange;
 271   if color = hue then e(6);
 272   if color <> tint then e(7);
 273  end;
 274
 275
 276  procedure tst2205;
 277  { Intermediate level arrays }
 278  var i,l,o:integer;
 279  begin t:=2205; pct := pct + 1;
 280   for i:= -10 to 10 do a1[i] := i*i;
 281   if (a1[-10]<>100) or (a1[9]<>81) then e(1);
 282
 283 #ifndef NOFLOAT
 284   for i:=1939 to 1945 do a2[i]:=i-1938.5;
 285   if (abs(a2[1939]-0.5) > eps) or (abs(a2[1945]-6.5) > eps) then e(2);
 286 #endif
 287
 288   color := orange;
 289   a3[green] := true;  a3[orange] := true;
 290   if (a3[green]<>true) or (a3[orange]<>true) then e(3);
 291   a3[green] := false;  a3[orange] := false;
 292   if (a3[green]<>false) or (a3[orange]<>false) then e(4);
 293
 294   a4[mouse]:='m'; a4[house]:='h';
 295   if (a4[mouse] <> 'm') or (a4[house]<>'h' ) then e(5);
 296
 297   for i:=1939 to 1945 do a5[51,bat,false,i]:=300+i;
 298   if a5[51,bat,false,1940] <> 2240 then e(6);
 299   for i:=50 to 52 do a5[i,cat,true,1943]:=200+i;
 300   if (a5[50,cat,true,1943] <> 250) or (a5[52,cat,true,1943] <> 252) then e(7);
 301
 302   for i:= -10 to 10 do a1[i]:= 0;
 303   for i:= 0 to 10 do a1[i div 2 + i div 2]:= i+1;
 304   if(a1[0]<>2) or (a1[5]<>0) or (a1[8]<>10) then e(8);
 305
 306   for i:= 0 to 10 do
 307   for l:= 0 to 3 do
 308   for o:= 0 to 3 do
 309     if ( (i+l+o) div 2) * 2 = i+l+o then a6[i,l,o]:='e' else a6[i,l,o]:='o';
 310   if (a6[2,2,2]<>'e') or (a6[2,2,3]<>'o') or (a6[0,3,1]<>'e') then e(9);
 311  end;
 312
 313 #ifndef NOFLOAT
 314
 315  procedure tst2206;
 316  { Intermediate level records }
 317  begin t:=2206; 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  procedure tst2206;
 332  { Intermediate level records }
 333  begin t:=2206; pct := pct + 1;
 334   r1.c1:='x'; r1.i:=40; r1.j:=50; r1.p:=true;
 335   c1:='a'; i:=0;  j:=0; p:=false;
 336   if (r1.c1<>'x') or (r1.i<>40) or (r1.p<>true) then e(1);
 337   r2:=r1;
 338   if (r2.c1<>'x') or (r2.i<>40) or (r2.p<>true) then e(2);
 339   i:=r1.i;  p:=r1.p;  c1:=r1.c1;
 340   if (c1<>'x') or (i<>40) or (p<>true) then e(3);
 341   r3.c1:='x'; r3.i:=40; r3.j:=50; r3.p:=true;
 342   if (r3.c1<>'x') or (r3.i<>40) or (r3.p<>true) then e(4);
 343  end;
 344
 345 #endif
 346  procedure tst2207;
 347  { Intermediate level sets }
 348  begin t:=2207; pct := pct + 1;
 349   colors := [];
 350   colors := colors + [];
 351   if colors <> [] then e(1);
 352   colors := colors + [pink];
 353   if colors <> [pink] then e(2);
 354   colors := colors + [green];
 355   if colors <> [pink,green] then e(3);
 356   if colors <> [green,pink] then e(4);
 357   colors := colors - [pink];
 358   if colors <> [green] then e(5);
 359   beasts := [chicken] + [chicken,pig];
 360   if beasts <> [pig,chicken] then e(6);
 361   beasts := [] - [farmersdaughter];
 362   if beasts <> [] then e(7);
 363   bits := [0] + [1] - [0];
 364   if bits <> [1] then e(8);
 365  end;
 366
 367
 368  procedure tst2208;
 369  { Pointers }
 370  begin t:=2208; pct := pct + 1;
 371   new(p1); new(p2); new(p3); new(p4);
 372   p1^ := 1066;
 373   if p1^ <> 1066 then e(1);
 374   p2^.i := 1215;
 375   if p2^.i <> 1215 then e(2);
 376   p3^[0]:= 1566;
 377   if p3^[0] <> 1566 then e(3);
 378   p4^ := [pink];
 379   if p4^ <> [pink] then e(4);
 380  end;
 381
 382
 383  procedure tst2209;
 384  var i:integer;
 385  begin t:=2209; pct := pct + 1;
 386   head := nil;
 387   for i:= 1 to 100 do
 388     begin new(tail); tail^.val:=100+i; tail^.next :=head; head:= tail end;
 389   if (tail^.val<>200) or (tail^.next^.val<>199) then e(1);
 390   if tail^.next^.next^.next^.next^.next^.next^.next^.next^.val<> 192 then e(2);
 391   tail^.next^.next^.next^.val := 30;
 392   if tail^.next^.next^.next^.val <> 30 then e(3);
 393  end;
 394 begin t:=22; pct:=pct+1;
 395 #ifndef NOFLOAT
 396       tst2201; tst2202; tst2203; tst2204; tst2205; tst2206;
 397 #else
 398       tst2201; tst2203; tst2204; tst2205; tst2206;
 399 #endif
 400       tst2207; tst2208; tst2209;
 401 end;
 402
 403
 404
 405
 406
 407 {************************************************************************}
 408 procedure tst25;
 409 { Statement sequencing }
 410 label 0,1,2,3;
 411  procedure tst2501;
 412  begin t:=2501;
 413    goto 0;
 414  e(1);
 415  end;
 416 begin t:=25; pct:=pct+1;
 417   tst2501;
 418   e(1);
 419   0:
 420   ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 421   ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 422   ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 423   ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 424   ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 425   i:=0;
 426 1:  if i>10 then goto 3 else goto 2;
 427   e(2);
 428 2: i:=i+1;  goto 1;
 429   e(3);
 430 3:
 431 end;
 432
 433
 434
 435
 436 {************************************************************************}
 437 procedure tst26;
 438 { More data structures }
 439 type x = array[1..5] of integer;
 440      ta = array [1..5] of array  [1..5] of x;
 441      tb = array [1..5] of record p1: ^x;  p2: ^x end;
 442      tr = record c: record b: record a: integer end  end  end ;
 443
 444 var low,i,j,k:integer; a:ta;  b:tb;  r:tr;  hi:integer;
 445
 446 procedure tst2601(w:ta; x:tb; y:tr);
 447 var i,j,k: integer;
 448 begin t:=2601; pct:=pct+1;
 449   for i:= 1 to 5 do for j:= 1 to 5 do for k:=1 to 5 do
 450      if w[i][j][k] <> i*i + 7*j + k then e(1);
 451   if (x[1].p1^[1] <> -9) or (x[2].p2^[4]<> -39) then e(2);
 452   if y.c.b.a <> 102 then e(3);
 453 end;
 454
 455 begin t:=26; pct:=pct+1;
 456   low := 1000; hi := 1001;
 457   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;
 458   new(b[1].p1);  new(b[2].p2);
 459   b[1].p1^[1] := -9;  b[2].p2^[4] := -39;
 460   r.c.b.a := 102;
 461   tst2601(a,b,r);
 462   t:=26;
 463   if(low <> 1000) or (hi <> 1001) then e(1);
 464 end;
 465
 466
 467
 468 {************************************************************************}
 469 procedure tst27;
 470 { Assignments }
 471 begin t:=27; pct := pct+1;
 472   i:=3; j:=2; k:= -100;
 473   l:= 1+(i*(j+(i*(j+(i*(j+(i*(3+j*(i*1+j*2)))))))));
 474   if l <> 1456 then e(1);
 475   l:= ((((((((((((((((((((((((((((((((0))))))))))))))))))))))))))))))));
 476   if l <> 0 then e(2);
 477   l:=(((i*j)+(3*i)-5) div 10)*(((i*j)+(3*i)-5) div 10)*(((i*j)+(3*i)-5) div 10)
 478    + (((i*j)+(3*i)-5) div 10)*(((i*j)+(3*i)-5) div 10)*(((i*j)+(3*i)-5) div 10);
 479   if l <> 2 then e(3);
 480
 481   l:=((j+j) div 4) * ((j+j) div 4) * ((j+j) div 4)* (j div 3 + j div 4 + 3)+
 482      ((j+j) div 4) * ((j+j) div 4) * ((j+j) div 4)* (j div 3 + j div 4 + 3);
 483   if l <> 6 then e(4);
 484   i:=j*j*j*j*j*j*j*j*j*j*j*j*j*j - 16383;
 485   if i <>1 then e(5);
 486   l:=(i+(i+(i+(i+(i+(i+(i+(i+(i+(i+(i+(i+(i+(i+(i+(i))))))))))))))));
 487   if l <> 16 then e(6);
 488   l:= (((((((((((((((((j)+j)+j)+j)+j)+j)+j)+j)+j)+j)+j)+j)+j)+j)+j)+j)+j);
 489   if l <> 34 then e(7);
 490   l:= (-(-(-(-(-(-(-(-(-(j))))))))));
 491   if l <> -2 then e(8);
 492
 493 #ifndef NOFLOAT
 494   x:= 0.1;  y:=0.2;  z:=0.3;
 495   w:=(((((x+y)/z)*2.0)+(((x+y)/z)*2.0)+(((x+y)/z)*2.0)+(((x+y)/z)*2.0))*
 496       ((((x+y)/z)*2.0)+(((x+y)/z)*2.0)+(((x+y)/z)*2.0)+(((x+y)/z)*2.0))*
 497       ((((x+y)/z)*2.0)+(((x+y)/z)*2.0)+(((x+y)/z)*2.0)+(((x+y)/z)*2.0))*
 498       ((((x+y)/z)*2.0)+(((x+y)/z)*2.0)+(((x+y)/z)*2.0)+(((x+y)/z)*2.0))*
 499       ((((x+y)/z)*2.0)+(((x+y)/z)*2.0)+(((x+y)/z)*2.0)+(((x+y)/z)*2.0)))-1;
 500   if abs(w-32767) > 0.0001 then e(9);
 501
 502   i:= trunc(100*y+0.5);  if i <> 20 then e(10);
 503   i:= 32767;  w:=i;  if w <> 32767 then e(11);
 504 #endif
 505 end;
 506
 507
 508
 509 {************************************************************************}
 510 procedure tst28;
 511 { Calls }
 512 var i:integer;
 513 function ack(m,n:integer):integer;
 514 begin if m=0
 515          then ack := n+1
 516          else if n=0
 517                  then ack := ack(m-1,1)
 518                  else ack := ack(m-1,ack(m,n-1))
 519 end;
 520
 521 procedure fib(a:integer; var b:integer); { Fibonacci nrs }
 522 var i,j:integer;
 523 begin
 524   if (a=1) or (a=2) then b:=1 else
 525      begin fib(a-1,i);  fib(a-2,j);  b:=i+j end
 526 end;
 527
 528 begin t:=28;  pct:= pct+1;
 529   if ack(2,2) <> 7 then e(1);
 530   if ack(3,3) <> 61 then e(2);
 531   if ack(3,5) <> 253 then e(3);
 532   if ack(2,100) <> 203 then e(4);
 533   fib(10,i);  if i <> 55 then e(5);
 534   fib(20,i);  if i <> 6765 then e(6);
 535 end;
 536
 537
 538 {************************************************************************}
 539 procedure tst29;
 540 { Loops }
 541 var i,l:integer; p:boolean;
 542 begin t:= 29; pct:=pct+1;
 543   j:=5;
 544   k:=0; for i:=1 to j do k:=k+1; if k<>5 then e(1);
 545   k:=0; for i:=5 to j do k:=k+1; if k<>1 then e(2);
 546   k:=0; for i:=6 to j do k:=k+1; if k<>0 then e(3);
 547   k:=0; for i:=-1 downto -j do k:=k+1; if k<>5 then e(4);
 548   k:=0; for i:=-5 downto -j do k:=k+1; if k<>1 then e(5);
 549   k:=0; for i:=-6 downto j do k:=k+1; if k<>0 then e(6);
 550   k:=0; for i:=1 downto 10 do k:=k+1; if k<>0 then e(7);
 551
 552   k:=0; for l:=1 to j do k:=k+1; if k<>5 then e(8);
 553   k:=0; for l:=5 to j do k:=k+1; if k<>1 then e(9);
 554   k:=0; for l:=6 to j do k:=k+1; if k<>0 then e(10);
 555   k:=0; for l:=-1 downto -j do k:=k+1; if k<>5 then e(11);
 556   k:=0; for l:=-5 downto -j do k:=k+1; if k<>1 then e(12);
 557   k:=0; for l:=-6 downto j do k:=k+1; if k<>0 then e(13);
 558   k:=0; for l:=1 downto 10 do k:=k+1; if k<>0 then e(14);
 559   k:=0; for p:= true downto false do k:=k+1; if k<>2 then e(15);
 560   k:=0; for p:= false to true do k:=k+1; if k<>2 then e(16);
 561
 562   k:=0; while k<0 do k:=k+1; if k<>0 then e(17);
 563   k:=0; repeat k:=k+1; until k>0; if k<> 1 then e(18);
 564   k:=0; repeat k:=k+1; until k > 15; if k <> 16 then e(18);
 565   k:=0; while k<=10 do k:=k+1;  if k<> 11 then e(19);
 566 end;
 567
 568 {************************************************************************}
 569 procedure tst30;
 570 { case statements }
 571 begin t:=30; pct:=pct+1;
 572   i:=3; k:=0;
 573   case i*i-7 of
 574    0: k:=0;  1: k:=0;  2: k:=1;  3,4: k:=0
 575   end;
 576   if k<>1 then e(1);
 577
 578   color := red; k:=0;
 579   case color of
 580     red: k:=1;  blue: k:=0;  yellow: k:=0
 581   end;
 582   if k<>1 then e(2);
 583
 584   k:=0;
 585   case color of
 586     red,blue: k:=1;  yellow: k:=0
 587   end;
 588   if k<>1 then e(3);
 589 end;
 590 #ifndef NOFLOAT
 591
 592 {************************************************************************}
 593 procedure tst31;
 594 { with statements }
 595 var ra: record i:integer; x:real; p:tp2; q:single;
 596                a2: record a3: tp2 end
 597         end;
 598      rb: record j: integer; y:real; pp:tp2; qq:single end;
 599 begin t:=31; pct:=pct+1;
 600   i:=0;  x:=0;
 601   ra.i:=-3006;  ra.x:=-6000.23;  ra.q[0]:=35;  ra.p.i:=20;
 602   with ra do
 603     begin if (i<>-3006) or (x<>-6000.23) or (q[0]<>35)
 604               or (p.i<>20) then e(2);
 605
 606       i:=300;   x:= 200.5;  q[0]:=35;  p.i:=-10
 607     end;
 608   if (ra.i<>300) or (ra.x<>200.5) or (ra.q[0]<>35) or (ra.p.i<>-10) then e(3);
 609   with ra.p do if i <> -10 then e(4);
 610
 611   i:= -23;
 612   ra.a2.a3.i := -909;
 613   with ra do if a2.a3.i <> -909 then e(5);
 614   with ra.a2 do if a3.i <> -909 then e(6);
 615   with ra.a2.a3 do if i <> -909 then e(7);
 616   with ra.a2 do i:=5;
 617   if (i<>5) or (ra.a2.a3.i <> -909) then e(8);
 618   with ra.a2.a3 do i:= 6;
 619   if i<>5 then e(9);
 620   if ra.a2.a3.i <> 6 then e(10);
 621
 622   with ra,rb do
 623    begin x:=3.5;  y:=6.5;  i:=3;  j:=9 end;
 624   if (ra.x<>3.5) or (rb.y<>6.5) or (ra.i<>3) or (rb.j<>9) then e(11);
 625 end;
 626
 627 #else
 628
 629 {************************************************************************}
 630 procedure tst31;
 631 { with statements }
 632 var ra: record i:integer; p:tp2; q:single;
 633                a2: record a3: tp2 end
 634         end;
 635      rb: record j: integer; pp:tp2; qq:single end;
 636 begin t:=31; pct:=pct+1;
 637 #ifndef NOFLOAT
 638   i:=0;  x:=0;
 639 #else
 640   i:=0;
 641 #endif
 642   ra.i:=-3006; ra.q[0]:=35;  ra.p.i:=20;
 643   with ra do
 644     begin if (i<>-3006) or (q[0]<>35)
 645               or (p.i<>20) then e(2);
 646
 647       i:=300;    q[0]:=35;  p.i:=-10
 648     end;
 649   if (ra.i<>300) or (ra.q[0]<>35) or (ra.p.i<>-10) then e(3);
 650   with ra.p do if i <> -10 then e(4);
 651
 652   i:= -23;
 653   ra.a2.a3.i := -909;
 654   with ra do if a2.a3.i <> -909 then e(5);
 655   with ra.a2 do if a3.i <> -909 then e(6);
 656   with ra.a2.a3 do if i <> -909 then e(7);
 657   with ra.a2 do i:=5;
 658   if (i<>5) or (ra.a2.a3.i <> -909) then e(8);
 659   with ra.a2.a3 do i:= 6;
 660   if i<>5 then e(9);
 661   if ra.a2.a3.i <> 6 then e(10);
 662
 663   with ra,rb do
 664    begin  i:=3;  j:=9 end;
 665   if  (ra.i<>3) or (rb.j<>9) then e(11);
 666 end;
 667
 668
 669 #endif
 670
 671
 672
 673
 674
 675
 676 {************************************************************************}
 677 procedure tst32;
 678 { Standard procedures }
 679 begin t:=32;  pct:=pct+1;
 680   if abs(-1) <> 1 then e(1);
 681   i:= -5;  if abs(i) <> 5 then e(2);
 682 #ifndef NOFLOAT
 683   x:=-2.0;  if abs(x) <> 2.0 then e(3);
 684 #endif
 685   if odd(5) = false then e(4);
 686   if odd(4) then e(5);
 687   if sqr(i) <> 25 then e(6);
 688   if succ(i) <> -4 then e(7);
 689   if succ(red) <> blue then e(8);
 690   if pred(blue) <> red then e(9);
 691   if ord(red) <> 0 then e(10);
 692   if ord(succ(succ(red))) <> 2 then e(11);
 693   if chr(ord(chr(ord(chr(ord('u')))))) <> 'u' then e(12);
 694   if ord(chr(ord(chr(ord(chr(50))))))  <> 50 then e(13);
 695 #ifndef NOFLOAT
 696   if abs(trunc(5.2)-5.0) > eps then e(14);
 697   if abs(sin(3.1415926536)) >  10*eps then e(15);
 698   if abs(exp(1.0)-2.7182818) > 0.0001 then e(16);
 699   if abs(ln(exp(1.0))- 1.0) > 3*eps then e(17);
 700   if abs(sqrt(25.0)-5.0) > eps then e(18);
 701   if abs(arctan(1.0) - 3.1415926535/4.0) > 0.0001 then e(19);
 702   if abs(ln(arctan(1)*4) - 1.144729886) > 0.000001 then e(20);
 703   if abs(sin(1) - 0.841470985 ) > 0.000001 then e(21);
 704   if abs(cos(1) - 0.540302306) > 0.000001 then e(22);
 705   if abs(sqrt(2) - 1.4142135623) > 0.000001 then e(23);
 706   if abs(sqrt(10) - 3.1622776601) > 0.000001 then e(24);
 707   if abs(sqrt(1000.0) - 31.622776602) > 0.00001 then e(25);
 708 #endif
 709 end;
 710
 711
 712 {***************************************************************************}
 713 procedure tst33;
 714 { Functions }
 715 var i,j,k,l,m: integer;
 716 begin t:=33;  pct := pct+1;
 717   i:=1; j:=2;  k:=3;  l:=4;  m:=10;
 718   if twice(k) <> m-l then e(1);
 719   if twice(1) <> 2 then e(2);
 720   if twice(k+1) <> twice(l) then e(3);
 721   if twice(twice(twice(inc(twice(inc(3)))))) <> 72 then e(4);
 722   if twice(inc(j+twice(inc(twice(i+1+inc(k)+inc(k))+twice(2)))))<>106
 723                 then e(5);
 724   if twice(1) + twice(2) * twice(3) <> 26 then e(6);
 725   if 3 <>  0 + twice(1) + 1 then e(7);
 726   if 0 <> 0 * twice(m) then e(8);
 727 end;
 728
 729
 730
 731 {**********************************************************************}
 732
 733 { Main Program }
 734 begin ect := 0;  pct := 0;
 735 tst21; tst22; tst25; tst26; tst27; tst28; tst29; tst30; tst31; tst32; tst33;
 736
 737 write('Program t2:',pct:3,' tests completed.');
 738 writeln('Number of errors = ',ect:1);
 739 end.