home *** CD-ROM | disk | FTP | other *** search
/ ftp.ee.pdx.edu / 2014.02.ftp.ee.pdx.edu.tar / ftp.ee.pdx.edu / pub / users / Harry / compilers / p11 / tst / array3.pcat < prev    next >
Text File  |  2006-03-05  |  2KB  |  35 lines
  1. (* This program tests array allocation. *)
  2.  
  3. program is
  4.  
  5.   type A is array of integer;
  6.   var a: A := nil;
  7.       c1, c2, c3, v1, v2, v3: integer := 0;
  8.  
  9. begin
  10.  
  11.   a := A {{ 3 of 111, 2 of 222, 4 of 333 }};
  12.   if a[0] <> 111 then write ("***** ERROR *****"); else write ("OK"); end;
  13.   if a[1] <> 111 then write ("***** ERROR *****"); else write ("OK"); end;
  14.   if a[2] <> 111 then write ("***** ERROR *****"); else write ("OK"); end;
  15.   if a[3] <> 222 then write ("***** ERROR *****"); else write ("OK"); end;
  16.   if a[4] <> 222 then write ("***** ERROR *****"); else write ("OK"); end;
  17.   if a[5] <> 333 then write ("***** ERROR *****"); else write ("OK"); end;
  18.   if a[6] <> 333 then write ("***** ERROR *****"); else write ("OK"); end;
  19.   if a[7] <> 333 then write ("***** ERROR *****"); else write ("OK"); end;
  20.   if a[8] <> 333 then write ("***** ERROR *****"); else write ("OK"); end;
  21.  
  22.   c1 := 3; c2 := 2; c3 := 4;
  23.   v1 := 111; v2 := 222; v3 := 333;
  24.   a := A {{ c1 of v1, c2 of v2, c3 of v3 }};
  25.   if a[0] <> 111 then write ("***** ERROR *****"); else write ("OK"); end;
  26.   if a[1] <> 111 then write ("***** ERROR *****"); else write ("OK"); end;
  27.   if a[2] <> 111 then write ("***** ERROR *****"); else write ("OK"); end;
  28.   if a[3] <> 222 then write ("***** ERROR *****"); else write ("OK"); end;
  29.   if a[4] <> 222 then write ("***** ERROR *****"); else write ("OK"); end;
  30.   if a[5] <> 333 then write ("***** ERROR *****"); else write ("OK"); end;
  31.   if a[6] <> 333 then write ("***** ERROR *****"); else write ("OK"); end;
  32.   if a[7] <> 333 then write ("***** ERROR *****"); else write ("OK"); end;
  33.   if a[8] <> 333 then write ("***** ERROR *****"); else write ("OK"); end;
  34. end;
  35.