lang/pc/test/t3.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 {$i64 : sets of integers contain 64 bits}
  19 program t3(input,output,f1,f2,f3,f4,f5,f6);
  20
  21 { The Berkeley and EM-1 compilers both can handle this program }
  22
  23 const rcsversion='$Id: t3.p,v 2.4 1994/06/24 12:36:57 ceriel Exp $';
  24 type wavelength = (red,blue,yellow,q1,q2,q3,q4,q5,q6,q7,q8,q9,q10,q11,
  25                    pink,green,orange);
  26   spectrum= set of wavelength;
  27   bit = 0..1;
  28
  29 #ifndef NOFLOAT
  30   tp3=  packed record c1:char; i:integer; p:boolean; x:real end;
  31   tp4=  record c1:char; i:integer; p:boolean; x:real end;
  32 #else
  33   tp3=  packed record c1:char; i:integer; p:boolean; end;
  34   tp4=  record c1:char; i:integer; p:boolean; end;
  35 #endif
  36
  37   vec1 =  array [-10..+10] of integer;
  38
  39 #ifndef NOFLOAT
  40   vrec = record case t:boolean of false:(r:real); true:(b:bit) end;
  41 #else
  42   vrec = record case t:boolean of false:(); true:(b:bit) end;
  43 #endif
  44
  45 var t,pct,ect:integer;
  46  i,j,k,l:integer;
  47
  48 #ifndef NOFLOAT
  49  x,y: real;
  50 #endif
  51
  52  p:boolean;
  53  c2:char;
  54  a1: vec1;
  55  c: array [1..20] of char;
  56  r3: tp3;
  57  r4: tp4;
  58  vr: vrec;
  59  colors: spectrum;
  60  letters,cset:set of char;
  61  f1: text;
  62  f2: file of spectrum;
  63  f3: file of tp3;
  64  f4: file of tp4;
  65  f5: file of vec1;
  66  f6: file of vrec;
  67
  68
  69
  70 procedure e(n:integer);
  71 begin
  72   ect := ect + 1;
  73   writeln(' Error', n:3,' in test ', t)
  74 end;
  75
  76
  77
  78
  79
  80
  81
  82
  83 {************************************************************************}
  84 procedure tst34;
  85 { Global files }
  86 var i:integer; c1:char;
  87 begin t:=34; pct := pct + 1;
  88   rewrite(f1);
  89   if not eof(f1) then e(1);
  90   write(f1,'abc',20+7:2,'a':2); writeln(f1);
  91   write(f1,'xyz');
  92   i:=-3000;  write(f1,i:5);
  93   reset(f1);
  94   if eof(f1) or eoln(f1) then e(2);
  95   for i:=1 to 17 do read(f1,c[i]);
  96   if(c[1]<>'a') or (c[3]<>'c') or (c[5]<>'7') or (c[8]<>' ') or
  97      (c[12]<>'-') or (c[13]<>'3') or (c[16]<>'0') then e(3);
  98   if not eof(f1) then e(4);
  99   rewrite(f1);
 100   for i:= 32 to 127 do write(f1,chr(i));
 101   reset(f1);  p:= false;
 102   for i:= 32 to 127 do begin read(f1,c1); if ord(c1) <> i then p:=true end;
 103   if p then e(5);
 104   rewrite(f1);
 105   for c1 := 'a' to 'z' do write(f1,c1);
 106   reset(f1);  p:= false;
 107   for c1 := 'a' to 'z' do begin read(f1,c2); if c2 <> c1 then p:=true end;
 108   if p then e(6);
 109 end;
 110
 111 procedure tst36;
 112 var i,j:integer;
 113 begin t:=36; pct:=pct+1;
 114   rewrite(f2); rewrite(f3); rewrite(f4); rewrite(f5); rewrite(f6);
 115   colors := []; f2^ := colors; put(f2);
 116   colors := [red]; f2^ := colors; put(f2);
 117   colors := [red,blue]; f2^ := colors; put(f2);
 118   colors := [yellow,blue]; f2^ := colors; put(f2);
 119   reset(f2);
 120   colors := f2^;  get(f2);  if colors <> [] then e(4);
 121   colors := f2^;  get(f2);  if colors <> [red] then e(5);
 122   colors := f2^;  get(f2);  if colors <> [blue,red] then e(6);
 123   colors := f2^;  get(f2);  if colors <> [blue,yellow] then e(7);
 124
 125 #ifndef NOFLOAT
 126   r3.c1:='w';  r3.i:= -100; r3.x:=303.56;  r3.p:=true; f3^:=r3; put(f3);
 127   r3.c1:='y';  r3.i:= -35;  r3.x:=26.32;   f3^:=r3; put(f3);
 128   r3.c1:='q';  r3.i:= +29;  r3.x:=10.00;   f3^:=r3; put(f3);
 129   r3.c1:='j';  r3.i:=   8;  r3.x:=10000;   f3^:=r3; put(f3);
 130 #else
 131   r3.c1:='w';  r3.i:= -100; r3.p:=true; f3^:=r3; put(f3);
 132   r3.c1:='y';  r3.i:= -35;  f3^:=r3; put(f3);
 133   r3.c1:='q';  r3.i:= +29;  f3^:=r3; put(f3);
 134   r3.c1:='j';  r3.i:=   8;  f3^:=r3; put(f3);
 135 #endif
 136
 137   for i:= 1 to 1000 do begin f3^ := r3; put(f3) end;
 138   reset(f3);
 139
 140 #ifndef NOFLOAT
 141   r3 := f3^; get(f3);
 142   if (r3.c1<>'w') or (r3.i<>-100) or (r3.x<>303.56) then e(8);
 143   r3 := f3^; get(f3);
 144   if (r3.c1<>'y') or (r3.i<> -35) or (r3.x<> 26.32) then e(9);
 145   r3 := f3^; get(f3);
 146   if (r3.c1<>'q') or (r3.i<>  29) or (r3.x<> 10.00) then e(10);
 147   r3 := f3^; get(f3);
 148   if (r3.c1<>'j') or (r3.i<>   8) or (r3.x<> 10000) then e(11);
 149 #else
 150   r3 := f3^; get(f3);
 151   if (r3.c1<>'w') or (r3.i<>-100) then e(8);
 152   r3 := f3^; get(f3);
 153   if (r3.c1<>'y') or (r3.i<> -35) then e(9);
 154   r3 := f3^; get(f3);
 155   if (r3.c1<>'q') or (r3.i<>  29) then e(10);
 156   r3 := f3^; get(f3);
 157   if (r3.c1<>'j') or (r3.i<>   8) then e(11);
 158 #endif
 159
 160
 161 #ifndef NOFLOAT
 162   r4.c1:='w';  r4.i:= -100; r4.x:=303.56;  r4.p:=true; f4^:=r4; put(f4);
 163   r4.c1:='y';  r4.i:= -35;  r4.x:=26.32;   f4^:=r4; put(f4);
 164   r4.c1:='q';  r4.i:= +29;  r4.x:=10.00;   f4^:=r4; put(f4);
 165   r4.c1:='j';  r4.i:=   8;  r4.x:=10000;   f4^:=r4; put(f4);
 166 #else
 167   r4.c1:='w';  r4.i:= -100; r4.p:=true; f4^:=r4; put(f4);
 168   r4.c1:='y';  r4.i:= -35;  f4^:=r4; put(f4);
 169   r4.c1:='q';  r4.i:= +29;  f4^:=r4; put(f4);
 170   r4.c1:='j';  r4.i:=   8;  f4^:=r4; put(f4);
 171 #endif
 172
 173   for i:= 1 to 1000 do begin f4^ := r4; put(f4) end;
 174   reset(f4);
 175
 176 #ifndef NOFLOAT
 177   r4 := f4^; get(f4);
 178   if (r4.c1<>'w') or (r4.i<>-100) or (r4.x<>303.56) then e(12);
 179   r4 := f4^; get(f4);
 180   if (r4.c1<>'y') or (r4.i<> -35) or (r4.x<> 26.32) then e(13);
 181   r4 := f4^; get(f4);
 182   if (r4.c1<>'q') or (r4.i<>  29) or (r4.x<> 10.00) then e(13);
 183   r4 := f4^; get(f4);
 184   if (r4.c1<>'j') or (r4.i<>   8) or (r4.x<> 10000) then e(14);
 185 #else
 186   r4 := f4^; get(f4);
 187   if (r4.c1<>'w') or (r4.i<>-100) then e(12);
 188   r4 := f4^; get(f4);
 189   if (r4.c1<>'y') or (r4.i<> -35) then e(13);
 190   r4 := f4^; get(f4);
 191   if (r4.c1<>'q') or (r4.i<>  29) then e(13);
 192   r4 := f4^; get(f4);
 193   if (r4.c1<>'j') or (r4.i<>   8) then e(14);
 194 #endif
 195
 196
 197   for j:= 1 to 100 do
 198     begin for i:= -10 to +10 do a1[i] := i*j; f5^ := a1; put(f5); end;
 199   reset(f5);
 200   for j:= 1 to 99 do
 201     begin a1:=f5^; get(f5); for i:= -10 to +10 do if a1[i]<> i*j then e(14) end;
 202
 203 #ifndef NOFLOAT
 204   vr.t:=false;
 205   for i:= 1 to 1000 do begin vr.r:=i+0.5;   f6^:=vr; put(f6) ;  p:=true; end;
 206   reset(f6);   p:=false;
 207   for i:= 1 to 999 do
 208      begin  vr:=f6^; get(f6); if vr.r <> i+0.5 then p:=true end;
 209   if p then e(15);
 210 #endif
 211
 212   rewrite(f6);
 213   if not eof(f6) then e(16);
 214   for i:= 1 to 1000 do begin vr.b:=i mod 2; f6^:=vr; put(f6) end;
 215   reset(f6);
 216   if eof(f6) then e(17);
 217   p:=false;
 218   for i:= 1 to 1000 do
 219      begin  vr:=f6^; get(f6); if vr.b <> i mod 2 then p:=true end;
 220   if not eof(f6) then e(18);
 221   if p then e(19);
 222
 223   rewrite(f1);
 224   f1^:=chr(10);
 225   put(f1);
 226   reset(f1);
 227   if ord(f1^) <> 32 then e(20);
 228
 229 #ifndef NOFLOAT
 230   rewrite(f1);
 231   x:=0.0625;  write(f1,x:6:4, x:6:2);
 232   reset(f1);  read(f1,y);  if y <> 0.0625 then e(21);
 233   reset(f1);  for i:= 1 to 12 do begin c[i]:= f1^; get(f1) end;
 234   if (c[1]<>'0') or (c[2]<>'.') or (c[4]<>'6') then e(22);
 235   if (c[7]<>' ') or (c[9]<>'0') or (c[10]<>'.') or (c[12]<>'6') then e(23);
 236 #endif
 237
 238 end;
 239
 240 {************************************************************************}
 241 procedure tst35;
 242 { Local files }
 243 var g1: text;
 244     g2: file of spectrum;
 245     g3: file of tp4;
 246     g4: file of vec1;
 247     i,j:integer;
 248  begin t:=35; pct := pct + 1;
 249   rewrite(g1); rewrite(g2); rewrite(g3); rewrite(g4);
 250   if (not (eof(g1) and eof(g4))) then e(1);
 251   writeln(g1,'abc', 20+7:2,'a':2);
 252   write(g1,'xyz');
 253   reset(g1);
 254   if eof(g1) or eoln(g1) then e(2);
 255   read(g1,c[1]); read(g1,c[2]); read(g1,c[3],c[4],c[5],c[6],c[7]);
 256   if (c[1]<>'a') or (c[3]<>'c') or (c[4]<>'2') or (c[7]<>'a') then e(3);
 257   if not eoln(g1) then e(4)
 258   else readln(g1);
 259   for i:=1 to 2 do read(g1,c[8+i]);
 260   if c[10]<>'y' then e(5);
 261   if eof(g1) or eoln(g1) then e(6);
 262   colors := []; g2^ := colors; put(g2);
 263   colors := [pink]; g2^ := colors; put(g2);
 264   colors := [pink,green];  g2^ := colors;  put(g2);
 265   colors := [orange,green];  g2^ := colors;  put(g2);
 266   reset(g2);
 267   colors := g2^;  get(g2); if colors <> [] then e(7);
 268   colors := g2^; get(g2); if colors <> [pink] then e(8);
 269   colors := g2^; get(g2); if colors <> [green,pink] then e(9);
 270   colors := g2^; get(g2); if colors <> [green,orange] then e(10);
 271
 272 #ifndef NOFLOAT
 273   r4.c1:='w';  r4.i:= -100; r4.x:=303.56;  g3^:=r4; put(g3);
 274   r4.c1:='y';  r4.i:= -35;  r4.x:=26.32;   g3^:=r4; put(g3);
 275   r4.c1:='q';  r4.i:= +29;  r4.x:=10.00;   g3^:=r4; put(g3);
 276   r4.c1:='j';  r4.i:=   8;  r4.x:=10000;   g3^:=r4; put(g3);
 277 #else
 278   r4.c1:='w';  r4.i:= -100; g3^:=r4; put(g3);
 279   r4.c1:='y';  r4.i:= -35;  g3^:=r4; put(g3);
 280   r4.c1:='q';  r4.i:= +29;  g3^:=r4; put(g3);
 281   r4.c1:='j';  r4.i:=   8;  g3^:=r4; put(g3);
 282 #endif
 283
 284   for i:= 1 to 1000 do begin g3^ := r4; put(g3) end;
 285   reset(g3);
 286   if eof(g3) then e(11);
 287
 288 #ifndef NOFLOAT
 289   r4 := g3^;  get(g3);
 290   if (r4.c1<>'w') or (r4.i<>-100) or (r4.x<>303.56) then e(12);
 291   r4 := g3^;  get(g3);
 292   if (r4.c1<>'y') or (r4.i<> -35) or (r4.x<> 26.32) then e(13);
 293   r4 := g3^;  get(g3);
 294   if (r4.c1<>'q') or (r4.i<>  29) or (r4.x<> 10.00) then e(14);
 295   r4 := g3^;  get(g3);
 296   if (r4.c1<>'j') or (r4.i<>   8) or (r4.x<> 10000) then e(15);
 297 #else
 298   r4 := g3^;  get(g3);
 299   if (r4.c1<>'w') or (r4.i<>-100) then e(12);
 300   r4 := g3^;  get(g3);
 301   if (r4.c1<>'y') or (r4.i<> -35) then e(13);
 302   r4 := g3^;  get(g3);
 303   if (r4.c1<>'q') or (r4.i<>  29) then e(14);
 304   r4 := g3^;  get(g3);
 305   if (r4.c1<>'j') or (r4.i<>   8) then e(15);
 306 #endif
 307
 308
 309   for j:= 1 to 100 do
 310     begin for i:= -10 to +10 do a1[i] := i*j; g4^ := a1; put(g4) end;
 311   reset(g4);
 312   for j:= 1 to 100 do
 313     begin a1:=g4^; get(g4); for i:= -10 to +10 do if a1[i]<>i*j then e(16) end;
 314   if not eof(g2) then e(17);
 315 colors:=[q1,q2,q3,q4,q5,q6,q7,q8,q9,q10,q11];
 316 end;
 317
 318
 319 {***********************************************************************}
 320 procedure tst37;
 321 { Intermediate level files }
 322 var g1: text;
 323     g2: file of spectrum;
 324     g3: file of tp4;
 325     g4: file of vec1;
 326
 327  procedure tst3701;
 328  var i,j:integer;
 329  begin t:=3701; pct := pct + 1;
 330   rewrite(g1); rewrite(g2); rewrite(g3); rewrite(g4);
 331   if (not (eof(g1) and eof(g4))) then e(1);
 332   writeln(g1,'abc', 20+7:2,'a':2);
 333   write(g1,'xyz');
 334   reset(g1);
 335   if eof(g1) or eoln(g1) then e(2);
 336   read(g1,c[1]); read(g1,c[2]); read(g1,c[3],c[4],c[5],c[6],c[7]);
 337   if (c[1]<>'a') or (c[3]<>'c') or (c[4]<>'2') or (c[7]<>'a') then e(3);
 338   if not eoln(g1) then e(4)
 339   else readln(g1);
 340   for i:=1 to 2 do read(g1,c[8+i]);
 341   if c[10]<>'y' then e(5);
 342   if eof(g1) or eoln(g1) then e(6);
 343   colors := []; g2^ := colors; put(g2);
 344   colors := [pink]; g2^ := colors; put(g2);
 345   colors := [pink,green];  g2^ := colors;  put(g2);
 346   colors := [orange,green];  g2^ := colors;  put(g2);
 347   reset(g2);
 348   colors := g2^;  get(g2); if colors <> [] then e(7);
 349   colors := g2^; get(g2); if colors <> [pink] then e(8);
 350   colors := g2^; get(g2); if colors <> [green,pink] then e(9);
 351   colors := g2^; get(g2); if colors <> [green,orange] then e(10);
 352
 353 #ifndef NOFLOAT
 354   r4.c1:='w';  r4.i:= -100; r4.x:=303.56;  g3^:=r4; put(g3);
 355   r4.c1:='y';  r4.i:= -35;  r4.x:=26.32;   g3^:=r4; put(g3);
 356   r4.c1:='q';  r4.i:= +29;  r4.x:=10.00;   g3^:=r4; put(g3);
 357   r4.c1:='j';  r4.i:=   8;  r4.x:=10000;   g3^:=r4; put(g3);
 358 #else
 359   r4.c1:='w';  r4.i:= -100; g3^:=r4; put(g3);
 360   r4.c1:='y';  r4.i:= -35;  g3^:=r4; put(g3);
 361   r4.c1:='q';  r4.i:= +29;  g3^:=r4; put(g3);
 362   r4.c1:='j';  r4.i:=   8;  g3^:=r4; put(g3);
 363 #endif
 364
 365   for i:= 1 to 1000 do begin g3^ := r4; put(g3) end;
 366   reset(g3);
 367   if eof(g3) then e(11);
 368
 369 #ifndef NOFLOAT
 370   r4 := g3^;  get(g3);
 371   if (r4.c1<>'w') or (r4.i<>-100) or (r4.x<>303.56) then e(12);
 372   r4 := g3^;  get(g3);
 373   if (r4.c1<>'y') or (r4.i<> -35) or (r4.x<> 26.32) then e(13);
 374   r4 := g3^;  get(g3);
 375   if (r4.c1<>'q') or (r4.i<>  29) or (r4.x<> 10.00) then e(14);
 376   r4 := g3^;  get(g3);
 377   if (r4.c1<>'j') or (r4.i<>   8) or (r4.x<> 10000) then e(15);
 378 #else
 379   r4 := g3^;  get(g3);
 380   if (r4.c1<>'w') or (r4.i<>-100) then e(12);
 381   r4 := g3^;  get(g3);
 382   if (r4.c1<>'y') or (r4.i<> -35) then e(13);
 383   r4 := g3^;  get(g3);
 384   if (r4.c1<>'q') or (r4.i<>  29) then e(14);
 385   r4 := g3^;  get(g3);
 386   if (r4.c1<>'j') or (r4.i<>   8) then e(15);
 387 #endif
 388
 389   for j:= 1 to 100 do
 390     begin for i:= -10 to +10 do a1[i] := i*j; g4^ := a1; put(g4) end;
 391   reset(g4);
 392   for j:= 1 to 100 do
 393     begin a1:=g4^; get(g4); for i:= -10 to +10 do if a1[i]<>i*j then e(16) end;
 394  end;
 395
 396 begin t:=37;  pct := pct+1;
 397   tst3701;
 398   t:=37;
 399   if not eof(g2) then e(1);
 400 end;
 401
 402
 403
 404 {***********************************************************************}
 405 procedure tst38;
 406 { Advanced set theory }
 407 begin t:=38;  pct := pct + 1;
 408   if [50] >= [49,51] then e(1);
 409   if [10] <= [9,11] then e(2);
 410   if not ([50] <= [49..51]) then e(3);
 411   i:=1;  j:=2; k:=3;  l:=5;
 412   if [i] + [j] <> [i,j] then e(4);
 413   if [i] + [j] <> [i..j] then e(5);
 414   if [j..i] <> [] then e(6);
 415   if [j..l] + [j..k] <> [2,3,4,5] then e(7);
 416   if ([1..k, l..8] + [10]) * [k..7, 2, l] <> [2,3,l..7] then e(8);
 417   if [i..9] - [j..l] <> [1,l+1..k*k] then e(9);
 418   if [k..j] <> [i..j] * [k..l] then e(10);
 419   if not ([k..10] <= [i..15]) then e(11);
 420   if not ([k-1..k*l] <= [i..15]) then e(12);
 421
 422   letters := ['a','b', 'z'];
 423   if letters <> ['a', 'b', 'z'] then e(13);
 424   cset := ['a'] + ['b', 'c', 'z'] - ['c','d'];
 425   if cset <> letters then e(14);
 426   cset := ['a'..'e'];
 427   if cset <> ['a', 'b', 'c', 'd', 'e'] then e(15);
 428   cset := ['a'..'z', '0'..'9', '+','-','*','/','.',':','(',')','{','}'];
 429   if not ('+' in cset) or not ('.' in cset) or not ('}' in cset) then e(16);
 430   letters := ['a'..'z' , '0'..'9'];
 431   if letters >= cset then e(17);
 432 end;
 433
 434
 435 {***********************************************************************}
 436
 437 { Main program }
 438 begin ect:=0; pct:=0;
 439   tst34;   tst35;   tst36;   tst37;   tst38;
 440   write('Program t3:',pct:3,' tests completed.');
 441   writeln('Number of errors = ',ect:1);
 442 end.