#    // force c preprocessor
{$d-,v-}
program tp5c(input, output);

#include "sys.inc.pas"

{check re-include guard}
#include "sys.inc.pas"

{ TODO: file buffer var as var parameter, is eoln a space? }

{ TODO: deeply nested labels fail if gcc optimisation is turned on
        - is there a workaround? }

label 999;

const
  c1 = 22;
  c2 = c1;

  half = 0.5;
  mhalf = -half;

type

   tR  = array[1..5] of record
           c1 :  char;
        end;
  tI = (red, orange, green, yellow, blue);
  tIVeryVeryVeryLongName = c2..99;
  tA = array[tI,char] of tI;

tR1 = array[0..1] of packed record
          guard : integer;
          b1,b2 : boolean;
          e3    : ( ash, oak, birch );
          e4    : ( apple, banana, grape, pear );
          ii0   : 3..15;
          ii1   : -3..10;
          ii2   : -23..10;
          ii    : integer;
          cc    : char;

          ca    : array[char, -1..3] of real;
          cr    : record
                q : tI;
                bb : tIVeryVeryVeryLongName;
               end;
          ap: ^tA;
          case boolean of
            true  : ();
            false : ( v1:-50..-12; v2:20..40);
        end;
  tS = set of red..green;
  tt = tS;
  tt1 = 12..22;
  pr = ^real;


VAR
   {TODO: check case as well - for types}
  k : integer;
  i : tI;
  z : -3 .. 22;
  lc : 'a'..'z';
  {pq = ^zzz;}
  pr1, pr2: ^pr;
  ii: ^integer;

  a1: ARRAY['a'..'z'] of boolean;
  a2: array['a'..'z',0..3] of boolean;
  a3: array['a'..'z'] of array[0..3] of boolean;
  a: array['a'..'z'] of ^tA;

  r: record
         a: real;
         b: BOOLEAN;
       end;

  vS : tt;

{
  r:tR;
  }

   eps     : real ;   { set by machar, allowed tolerance for real operations }
   maxReal, minReal: real ;   { set by machar }
   gototest: boolean; { used to test global goto statements }

   sideVar : integer;
function sideFun : integer;
begin
   sideFun := sideVar;
   sideVar := sideVar+1;
end;


{ check declarations }
procedure p0;

{ check groups }
procedure p01 {@@ inline @@};
{ integer, char, boolean, real, record, array, pointer * named, unnamed }
type
   myInteger = integer;
   myBoolean = boolean;
   myReal    = real;
   myChar    = char;
   myArray   = array[1..5] of integer;
   myRec     = record x : real; c:char end;

var
   ai    : myInteger {@@ register @@};
   bi    : myInteger;
   pass1 : myBoolean;
   pass2 : myBoolean;
   ar    : myReal;
   br    : myReal;
   ac    : myChar;
   bc    : myChar;
   r1    : myRec;
   r2    : myRec;
   l1    : myArray;
   l2    : myArray;

   aai, bbi : integer;
   p1, p2   : boolean;
   aar, bbr : real;
   aac, bbc : char;
   ll1, ll2 : array[1..5] of integer;
   rr1, rr2 : record x : real; c:char end;

begin
   AI := 3;
   bi := ai;
   pass1 := ai = bi;
   ar := 3;
   br := ar;
   pass1 := pass1 and (ar = br);
   ac := '3';
   bc := ac;
   pass1 := pass1 and (ac = bc);

   for ai := 1 to 5 do l1[ai] := ai*10;
   l2 := l1;
   for ai := 1 to 5 do pass1 := pass1 and (l2[ai] = ai*10);

   r1.x := 3.5; r1.c := 'c';
   r2 := r1;
   pass1 := pass1 and (r2.x = 3.5) and (r2.c = 'c');
   pass2 := pass1;

   aai := -2*(-2);
   bbi := aai;
   p1 := aai = bbi;
   aar := 4;
   bbr := aar;
   p1 := p1 and (aar = bbr);
   aac := '3';
   bbc := aac;
   p1 := p1 and (aac = bbc);
   p2 := p1;
   pass2 := pass2 and p1 and p2;

   for ai := 1 to 5 do ll1[ai] := ai*100;
   ll2 := ll1;
   for ai := 1 to 5 do pass2 := pass2 and (ll2[ai] = ai*100);

   rr1.x := 13.5; rr1.c := 'x';
   rr2 := rr1;
   pass2 := pass2 and (rr2.x = 13.5) and (rr2.c = 'x');

   if pass2 and pass1 then
      writeln( 'group declaration tests passed' )
   else
      writeln( 'group declaration tests failed' );
end; { p01 }

{check emitted ints}
{assumes integer is 32 bits, wil need fixing otherwise}
procedure p02;
const
   n     = 4; {size of integer}
   blank =  '    ';

type
   size =  1..n;
   u1   = 0..255;
   u2   = 0..256;
   u3   = 0..65535;
   u4   = 0..65536;
   u5   = 0..maxint;

   s1 = -128..127;
   s2 = -129..127;
   s3 = -128..128;
   s4 = -32768..32767;
   s5 = -32769..32767;
   s6 = -32768..32768;
   s7 = -maxint .. maxint;

var
   test :  record
              case integer of
                0 : (c:packed array [size] of char);
                1 : (iu1 : u1);
                2 : (iu2 : u2);
                3 : (iu3 : u3);
                4 : (iu4 : u4);
                5 : (iu5 : u5);
                11 : (is1 : s1);
                12 : (is2 : s2);
                13 : (is3 : s3);
                14 : (is4 : s4);
                15 : (is5 : s5);
                16 : (is6 : s6);
                17 : (is7 : s7);
            end; { record }

   pass:boolean;

function check(q :size): boolean;
var
   i,m : size;
begin
   m := n;
   for i := 1 to n do begin
      if test.c[i] = ' ' then
         m := m-1;
   end;
   check := m = q;
end; { check }

begin

   pass := true;

   if maxint <> 2147483647 then begin
      writeln('FIXME: test procedure p02 incorrectly assumes 32 bit integers');
   end;

   test.c := blank;
   test.iu1 := 255;
   if (not check(1)) or (test.iu1 <> 255) then begin
      pass := false;
      writeln('p02: u1 test fails');
   end;

   test.c := blank;
   test.iu2 := 256;
   if (not check(2)) or (test.iu2 <> 256) then begin
      pass := false;
      writeln('p02: u2 test fails');
   end;

   test.c := blank;
   test.iu3 := 65535;
   if (not check(2)) or (test.iu3 <> 65535) then begin
      pass := false;
      writeln('p02: u3 test fails');
   end;

   test.c := blank;
   test.iu4 := 65536;
   if (not check(4)) or (test.iu4 <> 65536) then begin
      pass := false;
      writeln('p02: u4 test fails');
   end;

   test.c := blank;
   test.iu5 := maxint;
   if (not check(4)) or (test.iu5 <> maxint) then begin
      pass := false;
      writeln('p02: u5 test fails');
   end;

   test.c := blank;
   test.is1 := -128;
   if (not check(1)) or (test.is1 <> -128) then begin
      pass := false;
      writeln('p02: s1 test fails (-128)');
   end;

   test.c := blank;
   test.is1 := 127;
   if (not check(1)) or (test.is1 <> 127) then begin
      pass := false;
      writeln('p02: s1 test fails (127)');
   end;

   test.c := blank;
   test.is2 := -129;
   if (not check(2)) or (test.is2 <> -129) then begin
      pass := false;
      writeln('p02: s2 test fails (-129)');
   end;

   test.c := blank;
   test.is2 := 127;
   if (not check(2)) or (test.is2 <> 127) then begin
      pass := false;
      writeln('p02: s2 test fails (127)');
   end;

   test.c := blank;
   test.is3 := -128;
   if (not check(2)) or (test.is3 <> -128) then begin
      pass := false;
      writeln('p02: s3 test fails (-128)');
   end;

   test.c := blank;
   test.is3 := 128;
   if (not check(2)) or (test.is3 <> 128) then begin
      pass := false;
      writeln('p02: s3 test fails (129)');
   end;

   test.c := blank;
   test.is4 := -32768;
   if (not check(2)) or (test.is4 <> -32768) then begin
      pass := false;
      writeln('p02: s4 test fails (-32768)');
   end;

   test.c := blank;
   test.is4 := 32767;
   if (not check(2)) or (test.is4 <> 32767) then begin
      pass := false;
      writeln('p02: s4 test fails (32767)');
   end;

   test.c := blank;
   test.is5 := -32769;
   if (not check(4)) or (test.is5 <> -32769) then begin
      pass := false;
      writeln('p02: s5 test fails (-32769)');
   end;

   test.c := blank;
   test.is5 := 32767;
   if (not check(4)) or (test.is5 <> 32767) then begin
      pass := false;
      writeln('p02: s5 test fails (32767)');
   end;

   test.c := blank;
   test.is6 := -32768;
   if (not check(4)) or (test.is6 <> -32768) then begin
      pass := false;
      writeln('p02: s6 test fails (-32768)');
   end;

   test.c := blank;
   test.is6 := 32768;
   if (not check(4)) or (test.is6 <> 32768) then begin
      pass := false;
      writeln('p02: s6 test fails (32768)');
   end;

   test.c := blank;
   test.is7 := -maxint;
   if (not check(4)) or (test.is7 <> -maxint) then begin
      pass := false;
      writeln('p02: s7 test fails (-maxint)');
   end;

   test.c := blank;
   test.is7 := maxint;
   if (not check(4)) or (test.is7 <> maxint) then begin
      pass := false;
      writeln('p02: s7 test fails (maxint)');
   end;

   if pass then
      writeln('p02: emmitted int size checks pass');

end; { p02 }


{ check pascal declarations do not conflict with c language keywords }
procedure p09;
const
   bslashStr =  'stri\ng with backslash';

var
   { asm, typeof & inline are gcc extensions }
   asm      : integer;
   auto     : integer;
   break    : integer;
   continue : integer;
   default  : integer;
   double   : integer;
   enum     : integer;
   extern   : integer;
   float    : integer;
   inline   : integer;
   int      : integer;
   long     : integer;
   register : integer;
   return   : integer;
   short    : integer;
   signed   : integer;
   sizeof   : integer;
   static   : integer;
   struct   : integer;
   switch   : integer;
   typedef  : integer;
   typeof   : integer;
   union    : integer;
   unsigned : integer;
   void     : integer;
   volatile : integer;
   atan     : integer;
   log      : integer;
   bslashCh : char;
   f        : text;
   pass     : boolean;

begin
   pass := true;

   bslashCh := '\';
   writeln('this is a backslash ''', bslashCh, '''');

   asm := 1;
   auto := 2*asm;
   break := 2*auto;
   continue := 2*break;
   default := 2*continue;
   double := 2*default;
   enum := 2*double;
   extern := 2*enum;
   float := 2*extern;
   inline := 2*float;
   int := 2*inline;
   long := 2*int;
   register := 2*long;
   return := 2*register;
   short := 2*return;
   signed := 2*short;
   sizeof := 2*signed;
   static := 2*sizeof;
   struct := 2*static;
   switch := 2*struct;
   typedef := 2*switch;
   typeof := 2*typedef;
   union := 2*typeof;
   unsigned := 2*union;
   void := 2*unsigned;
   volatile := 2*void;
   atan := 2*volatile;
   log := 2*atan;  { sb 2^27 }

   { sum should be 2^28 - 1, ie 268435455 }
   if asm + auto + break + continue + default + double + enum
      + extern + float + inline + int + long + register + return
      + short + signed + sizeof + static + struct + switch + typedef
      + typeof + union + unsigned + void + volatile + atan + log
      <> 268435455 then begin
      pass := false;
      writeln( 'failed c keyword conflict' );
   end;

   rewrite(f);
   writeln( f, 'te%st ', '%string' );
   writeln( f, '"double quotes" in this string');
   writeln( f, bslashStr );
   reset( f );
   get(f); get(f); { skip 'te' }
   if f^ <> '%' then begin
      pass := false;
      writeln( 'failed string with ''%''' );
   end;
   readln(f);
   if f^ <> '"' then begin
      pass := false;
      writeln( 'failed string with double quote' );
   end;
   readln(f);
   get(f); get(f); get(f); get(f); { skip 'stri' }
   if f^ <> bslashCh then begin
      pass := false;
      writeln( 'failed string with back slash' );
   end;

   if pass then
      writeln( 'p5c c keyword test passed' )
   else
      writeln( 'p5c c keyword test failed' );
   writeln;
end; { p09 }

begin {p0}
   p01;
   p02;
   p09;
end; { p0 }


{ test expressions & statements
  basic operators, precedence, statements }
PROCEDURE p1;
label 0, 1, 2, 3, 9, 90, 9999;
const
   cTen     = 10;
   chOne    = '1';
   pi       = 3.14159265;
   cTrue    = true;
   startval = 0;
   endval   = 5;

Var
   i0   : Integer;
   i1   : Integer;
   i2   : integer;
   ch1  : char;
   ch2  : char;
   x1   : real;
   x2   : real;
   b1   : boolean;
   a,c  : boolean;
   pass : boolean;
   pass1: boolean;
   k    : integer;

procedure machar;
{
    determine the characteristics of the floating-point arithnetic
    system that are specified below.
    The determination of the first three uses an extension of 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.
    An earlier version of this program was published in the book
    Software Manual for the Elementary Functions by W. J. Cody and W. Waite,
    Prentice-Hall, Englewood Cliffs, NJ, 1980.
    The present program is a translation of the Fortran 77 program in
    W. J. Cody, "MACHAR: A subroutine to dynamically determine machine
    parameters". TOMS (14), 1988.

   Parameter values reported are as follows:

        ibeta   - the radix for the floating-point representation
        it      - the number of base ibeta digits in the floating-point
                  significand
        it10    - Number of decimal digits that can be rounded into a
                  real number and back again without change.
        irnd    - 0 if floating-point addition chops
                  1 if floating-point addition rounds, but not in the
                    IEEE style
                  2 if floating-point addition rounds in the IEEE style
                  3 if floating-point addition chops, and there is
                    partial underflow
                  4 if floating-point addition rounds, but not in the
                    IEEE style, and there is partial underflow
                  5 if floating-point addition rounds in the IEEE style,
                    and there is partial underflow
        ngrd    - the number of guard digits for multiplication with
                  truncating arithmetic.  It is
                  0 if floating-point arithmetic rounds, or if it
                    truncates and only if base ibeta digits
                    participate in the post-normalization shift of the
                    floating-point significand in multiplication;
                  1 if floating-point arithmetic truncates and more
                    than  it  base  ibeta  digits participate in the
                    post-normalization shift of the floating-point
                    significand in multiplication.
        machep  - the largest negative integer such that
                  1.0+FLOAT(ibeta)**machep <> 1.0, except that
                  machep is bounded below by  -(it+3)
        negeps  - the largest negative integer such that
                  1.0-FLOAT(ibeta)**negeps <> 1.0, except that
                  negeps is bounded below by  -(it+3)
        iexp    - the number of bits (decimal places if ibeta = 10)
                  reserved for the representation of the exponent
                  (including the bias or sign) of a floating-point
                  number
        minexp  - the largest in magnitude negative integer such that
                  FLOAT(ibeta)**minexp is positive and normalized
        maxexp  - the smallest positive power of BETA that overflows
        eps     - the smallest positive floating-point number such
                  that  1.0+eps <> 1.0. ln particular, if either
                  ibeta = 2  or  IRND = 0, eps = FLOAT(ibeta)**machep.
                  Otherwise,  eps = (FLOAT(ibeta)**machep)/2
        epsneg  - A small positive floating-point number such that
                  1.0-epsneg <> 1.0. In particular, if ibeta = 2
                  or  IRND = 0, epsneg = FLOAT(ibeta)**negeps.
                  Otherwise,  epsneg = (ibeta**negeps)/2.  Because
                  negeps is bounded below by -(it+3), epsneg may not
                  be the smallest number that can alter 1.0 by
                  subtraction.
        xmin    - the smallest non-vanishing normalized floating-point
                  power of the radix, i.e.,  xmin = FLOAT(ibeta)**minexp
        xmax    - the largest finite floating-point number.  ln
                  particular  xmax = (1.0-epsneg)*FLOAT(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.

      Latest revision - August 4, 1988

      Author - W. J. Cody
               Argonne National Laboratory
}

var

   ibeta, it, it10, irnd, ngrd, machep, negep, iexp,
   minexp, maxexp : integer;
   epsneg, xmin, xmax : real;

   i, iz, j, k, mx, itmp, nxres : integer;
   a, b, beta, betain, one, y, z, zero : real;
   betah, t, tmp, tmpa, tmp1, two : real;
   underFlo : boolean;

begin
   irnd := 1;
   one := irnd;
   two := one + one;
   a := two;
   b := a;
   zero := 0.0;

   { determine ibeta,beta ala Malcolm }
   tmp := ((a+one)-a)-one;
   while tmp = zero do begin
      a := a + a;
      tmp := a+one;
      tmp1 := tmp-a;
      tmp := tmp1-one;
   end;

   tmp := a+b;
   itmp := trunc(tmp-a);
   while itmp = 0 do begin
      b := b + b;
      tmp := a+b;
      itmp := trunc(tmp-a);
   end;
   ibeta := itmp;
   beta := ibeta;

   { determine irnd,ngrd,it }
   it := 0;
   b := one;
   tmp := ((b+one)-b)-one;
   while tmp = zero do begin
      it := it + 1;
      b := b * beta;
      tmp := b+one;
      tmp1 := tmp-b;
      tmp := tmp1-one;
   end;

   irnd := 0;
   betah := beta/two;
   tmp := a+betah;
   tmp1 := tmp-a;
   if tmp1 <> zero then
      irnd := 1;
   tmpa := a+beta;
   tmp := tmpa+betah;
   if (irnd = 0) and (tmp-tmpa <> zero) then
      irnd := 2;

   { determine negep, epsneg }
   negep := it + 3;
   betain := one / beta;
   a := one;
   for i := 1 to negep do begin
      a := a * betain;
   end;
   b := a;
   tmp := one-a;
   tmp := tmp-one;
   while tmp = zero do begin
      a := a * beta;
      negep := negep - 1;
      tmp1 := one-a;
      tmp := tmp1-one;
   end;
   negep := - negep;
   epsneg := a;

   { determine machep, eps }
   machep := -it -3;
   a := b;
   tmp := one+a;
   while tmp - one = zero do begin
      a := a * beta;
      machep := machep + 1;
      tmp := one+a;
   end;
   eps := a;

   { determine ngrd }
   ngrd := 0;
   tmp := one+eps;
   tmp := tmp*one;
   if ( irnd = 0) and ((tmp - 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 signalled by an underflow}

   i := 0;
   k := 1;
   z := betain;
   t := one + eps;
   nxres := 0;
   underflo := false;
   repeat
      y := z;
      z := y * y;

      { check for underflow }
      a := z * one;
      tmp := z*t;
      if ( a+a = zero) or ( abs ( z ) > y ) then begin
         underflo := true;
      end else begin
         tmp1 := tmp*betain;
         if tmp1*beta = z then begin
            underflo := true;
         end else begin
            i := i + 1;
            k := k+k;
         end;
      end;
   until underflo;

   { determine k such that (l/beta)**k does not underflow
   first set k = 2 ** i }
   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;

   underflo := false;
   {loop to determine minexp, xmin.
   exit from loop is signaled by an underflow}
   repeat
      xmin := y;
      y := y * betain;
      a := y * one;
      tmp := y*t;
      tmp1 := a+a;
      if ( tmp1 = zero) or ( abs ( y ) > xmin ) then begin
         underflo := true;
      end else begin
         k := k + 1;
         tmp1 := tmp*betain;
         tmp1 := tmp1*beta;
         if (tmp1 = y) and (tmp <> y) then begin
            nxres := 3;
            xmin := y;
            underflo := true;
         end;
      end
   until underflo;
   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 *irnd to reflect partial underflow. }
   irnd := irnd+nxres;

   { Adjust for IEEE style machines. }
   if irnd >= 2 then
      maxexp := maxexp-2;


   { 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 - 1;
   if a <> y then
      maxexp := maxexp - 2;
   xmax := one - epsneg;
   tmp := xmax*one;
   if tmp <> xmax then
      xmax := one - beta * epsneg;

   xmax := xmax / (beta * beta * beta * xmin);
   i := maxexp + minexp + 3;
   if i > 0 then begin
      for j := 1 to i do begin
         if ibeta = 2 then
            xmax := xmax + xmax;
         if ibeta <> 2 then
            xmax := xmax * beta;
      end;
   end;

   minReal := xmin; maxReal := xmax;

   { get nr accurate digits in mantissa - as per c language limits.h }
   k := ibeta;
   it10 := 1;
   while k > 10 do begin {is radix a power of 10?}
      k := k div 10;
      it10 := it10+1;
   end;
   if k <> 10 then
      it10 := trunc((it-1)*ln(ibeta)/ln(10));

   writeln( 'positive real nrs range is', xmin, ' ..', xmax );
   write( 'with ', it:1, ' mantissa bits, ', iexp:1, ' exponent bits' );
   writeln( ', implemented in base ', ibeta:1);
   writeln( 'this is accurate to ', it10:1, ' decimal places' );
   writeln('eps (the smallest nr that can be added to 1.0) is', eps);

   writeln('from sys defs:' );
   writeln('            maxreal is ', REAL_MAX, ', minreal is ', REAL_MIN );
   writeln('            epsilon is ', REAL_EPSILON,
           ', nr real digits is ', REAL_DIGITS:1 );

   if REAL_DIGITS <> it10 then begin
      writeln('realDigits conflict' );
      writeln('expected ', REAL_DIGITS:1 );
      writeln('derived  ', it10:1);
   end;

   if abs(REAL_MAX - maxReal) > REAL_EPSILON*REAL_MAX then begin
      writeln('maxreal conflict' );
      writeln('expected ', REAL_MAX:REAL_DIGITS+7 );
      writeln('derived  ', maxReal:REAL_DIGITS+7 );
   end;
   if (REAL_MIN*(1+REAL_EPSILON) < minReal) or
      (REAL_MIN > minReal*(1+REAL_EPSILON))
   then begin
      writeln('minreal conflict');
      writeln('expected ', REAL_MIN:REAL_DIGITS+7);
      writeln('derived  ', minReal:REAL_DIGITS+7);
   end;
   if abs(REAL_EPSILON - eps) > sqr(REAL_EPSILON) then begin
      writeln('epsilon conflict');
      writeln('expected ', REAL_EPSILON:REAL_DIGITS+7);
      writeln('derived  ', eps:REAL_DIGITS+7);
   end;

   if (irnd = 0) or (irnd = 3) then
      write( 'real arithmetic chops' )
   else
      write( 'real arithmetic rounds' );
   if (irnd = 2) or (irnd=5) then
      write( ' in the IEEE style' )
   else if (irnd = 1) or (irnd = 4 ) then
      write( ', but not in the IEEE style' );
   if irnd >=3 then
      write( ' and there is partial underflow' );
   writeln;

   { don't bother reporting these ...
   writeln('ngrd   is ',ngrd);
   writeln('machep is ',machep);
   writeln('negep  is ',negep);
   writeln('minexp is ',minexp);
   writeln('maxexp is ',maxexp);
   writeln('epsneg is ', epsneg);
   }

   {now check for double rounding}
   i := it;
   z := 1;
   y := ibeta;
   while i <> 0 do begin
      if odd(i) then z := z*y;
      i := i div 2;
      y := sqr(y);
   end;

   z := z + ibeta; { 2^it + 2 }
   t := 1/ibeta;
   while t >= epsneg do begin
      y := 1.0 - t;
      a := z + y;
      b := a - z;
      t := t/ibeta;

      if b = ibeta then begin
         {
         writeln('a is ', a:1:1, ', b is ', b:4:1);
         writeln('a sb ', z:1:1, ', b sb  0.0');
         }
         writeln;
         writeln('warning:  the system floating point library has a double rounding problem');
         writeln('this is probably a side effect of the c library' );
         writeln('evaluating expressions internally in extended precision');
         writeln('this is unlikely to be a problem unless you are doing');
         writeln('serious numerical work');
         writeln('see https://www.vinc17.net/research/extended.en.html');
         writeln;
         t := 0;  {force end of loop}
      end;
   end; {while t}

end; {machar}

   function Thirteen: integer;
   begin
      thirteen := 13;
   end; { Thirteen }

   function retk : integer;
   Begin
      if k = startval then begin
         k := endval;
         retk := startval;
      end
      else if k = endval then begin
         k := k+1;
         retk := endval;
      end
      else begin
         retk := endval+1;
         k := k+10;
      end;
   end; { retk }

   procedure checkgoto;
   begin
      i2 := i2+6;
      x1 := 10*x1+9;
      goto 9;
   end; { checkgoto }

{test standard names, functions and procedures}
procedure p10;
const
   ci = maxint;
   cf = false;
   ct = true;

var
   f : text;
   x : real;
   i : integer;
   b : boolean;
   s : packed array[1..6] of char;
   a : array[1..6] of char;
   p : ^integer;

   function p101(var af : text) : boolean;
   begin
      p101 := eof(af)
   end; { p101 }

begin

   {in these tests, check that correct code is implemented,
    in particular looking for stray semicolons}

   {stdNfalse,   stdNtrue}
   if false then b := true else b := false;
   if b then begin
      pass := false;
      writeln( 'p10: boolean standard name test 1 failed' );
   end;

   if true then b := false else b := true;
   if b then begin
      pass := false;
      writeln( 'p10: boolean standard name test 2 failed' );
   end;

   { stdNinput, stdNoutput}
   if p101(input) then begin
      pass := false;
      writeln('eof(input) is ', b);
   end;
   if not p101(output) then begin
      pass := false;
      writeln('eof(ouput) is ', b);
   end;

   b := true;

   {stdNget, stdNput, stdNreset, stdNrewrite}
   if b then rewrite(f) else reset(f);
   f^ := 'a';
   if b then put(f) else get(f);

   if b then reset(f) else rewrite(f);
   if f^ <> 'a' then begin
      pass := false;
      writeln('p10 fail: f^ is ''', f^, '''');
   end;
   if b then get(f) else put(f);

   if f^ <> ' ' then begin
      pass := false;
      writeln('p10 fail: f^ is ''', f^, '''');
   end;

   {stdNread, stdNwrite}
   rewrite(f);
   if b then write(f, 999) else read(f, i);

   reset(f);
   if b then read(f,i) else write(f,999);
   if i <> 999 then begin
      pass := false;
      writeln('p10 fail: i is ''', i, '''');
   end;

   {stdNreadln,  stdNwriteln, stdNpage}
   rewrite(f);
   if b then writeln(f) else readln(f);
   reset(f);
   if not eoln(f) then begin
      pass := false;
      writeln('p10 fail: eoln(f) is ''', eof(f), '''');
   end;

   rewrite(f);
   if b then page(f) else readln(f);
   reset(f);
   if b then readln(f) else writeln(f);

   if not eof(f) then begin
      pass := false;
      writeln('p10 fail: eof(f) is ''', eof(f), '''');
   end;

   {stdNeof, stdNeoln}
   reset(f);
   if b then b := eof(f) else b := true;
   if b then begin
      pass := false;
      writeln('p10 eof() fail: b is ''', b, '''');
   end;
   b := true;

   if b then b := eoln(f) else b := true;
   if b then begin
      pass := false;
      writeln('p10 eoln() fail: b is ''', b, '''');
   end;
   b := true;

   {stdNpack, stdNunpack, stdNord, stdNchr}
   s := 'string';
   if b then unpack(s, a, 1) else pack(a, 1, s);
   for i := 1 to 6 do
      if b then a[i] := chr(ord(a[i]) - ord('a') + ord('A')) else a[i] := 'x';
   if b then pack(a, 1, s) else unpack(s, a, 1);
   if s <> 'STRING' then begin
      pass := false;
      writeln('p10 fail: s is ''', s, '''');
   end;

   {stdNnew, stdNdispose, stdNmaxint}
   p := nil;
   if b then new(p) else dispose(p);
   if p <> nil then p^ := maxint else p^ := 0;
   if p^ = maxint then dispose(p) else begin
      p := nil;
      pass := false;
      writeln('p10 fail: p^ ''', p^, '''');
   end;

   {stdNtrunc,   stdNround}
   x := 9.9;
   if b then i := trunc(x) else i := round(x);
   if b then i := i + 100*round(x) else i := trunc(x);
   if i <> 1009 then begin
      pass := false;
      writeln('p10 trunc/round fail: i is ''', i, '''');
   end;

   {stdNabs, stdNsqr, stdNodd}
   if b then i := abs(-22) else i := -22;
   if i <> 22 then begin
      pass := false;
      writeln('p10 abs(int) fail: i is ''', i, '''');
   end;
   if b then x := abs(-2.5) else x := -2.5;
   if x <> 2.5 then begin
      pass := false;
      writeln('p10 abs(real) fail: x is ''', x, '''');
   end;

   if b then i := sqr(11) else i := -11;
   if i <> 121 then begin
      pass := false;
      writeln('p10 sqr(int) fail: i is ''', i, '''');
   end;
   if b then x := sqr(-3.5) else x := -3.5;
   if x <> 12.25 then begin
      pass := false;
      writeln('p10 sqr(real) fail: x is ''', x, '''');
   end;

   if b then b := odd(15) else i := -15;
   if not b then begin
      pass := false;
      writeln('p10 odd(int) fail: b is ''', b, '''');
   end;

   {stdNpred, stdNsucc}
   if b then i := succ(9) else i := 0;
   if i <> 10 then begin
      pass := false;
      writeln('p10 sqr(int) fail: i is ''', i, '''');
   end;
   if b then i := pred(-9) else i := 6;
   if i <> -10 then begin
      pass := false;
      writeln('p10 sqr(int) fail: i is ''', i, '''');
   end;

   {stdNsin, stdNcos, stdNexp, stdNsqrt, stdNln, stdNarctan}
   if b then x := sin(0) else x := 1;
   if x <> 0 then begin
      pass := false;
      writeln('p10 sin fail: x is ''', x, '''');
   end;
   if b then x := cos(0) else x := 0;
   if x <> 1 then begin
      pass := false;
      writeln('p10 cos fail: x is ''', x, '''');
   end;
   if b then x := exp(0) else x := 0;
   if x <> 1 then begin
      pass := false;
      writeln('p10 exp fail: x is ''', x, '''');
   end;
   if b then x := sqrt(4) else x := 0;
   if x <> 2 then begin
      pass := false;
      writeln('p10 sqrt fail: x is ''', x, '''');
   end;
   if b then x := ln(1) else x := 1;
   if x <> 0 then begin
      pass := false;
      writeln('p10 ln fail: x is ''', x, '''');
   end;
   if b then x := arctan(0) else x := 1;
   if x <> 0 then begin
      pass := false;
      writeln('p10 arctan fail: x is ''', x, '''');
   end;
end; { p10 }

{test statements are compiled without error}
procedure p11;
label 1;
var x : real;
   r  : record
           xx : real
        end;
   i  : integer;
   procedure p110;
   begin
      x := 2*x
   end; { p110 }

begin
   if true then x := 0 else x := 1;
   if true then p110 else x := 2*x + 1;
   if true then if true then x := 2*x else x := 2*x + 1 else x := 2*x + 1;
   if true then if true then x := 2*x else x := 2*x + 1;  {revise this}
   if true then begin end else x := 2*x + 1;
   i := 0;
   if true then
      case i of
        0  : x := 2*x;
        1  : x := 2*x + 1;
      end {case}
      else x := 2*x + 1;
   if true then
      repeat
         x := 2*x
      until true
   else x := 2*x + 1;
   if true then
      while false do x := 2*x
   else x := 2*x + 1;
   if true then
      with r do
         xx := 2*x
      else r.xx := 2*x + 1;
   x := r.xx;
   if true then
      for i := 0 to 0 do
         x := 2*x
   else x := 2*x + 1;
   if true then
      goto 1
   else x := 2*x + 1;

1:
  writeln;
  if x <= 0 then
     writeln('statement compilation tests passed')
  else begin
     pass := false;
     writeln('p11: statement test fail, x is ', x);
  end;

end; { p11 }


begin { p1 }
   { TODO: tidy this up }

   PASS := true; { check case }

   WRITELN('testing expressions & statements');
   write( 'maxint is ', MAXINT );
   i1 := maxint;
   i2 := 1;
   while i1 >= 1 do begin
      i1 := i1 div 2;
      i2 := i2 + 1;
   end;
   writeln( ', which suggests integers are ', i2:1, ' bits');

   machar;  { report characteristics of real numbers }

   { each type of variable: boolean, char, integer, real, pointer,
   each operator: *, /, mod, div, and, +, -, or, =, <>, <, >, <=, >=
   and assignment }

   pass1 := true;
   if 0 <> 0 then pass1 := false;
   if 1 = 0 then pass1 := false;
   if 0 < 0 then pass1 := false;
   if 1 > 1 then pass1 := false;
   if 0 >= 1 then pass1 := false;
   if 1 <= 0 then pass1 := false;
   if 1 < 0 then pass1 := false;
   if 0 > 1 then pass1 := false;

   if -1 <> -1 then pass1 := false;
   if 0 = -1 then pass1 := false;
   if -1 < -1 then pass1 := false;
   if 0 > 0 then pass1 := false;
   if -1 >= 0 then pass1 := false;
   if 0 <= -1 then pass1 := false;
   if 0 < -1 then pass1 := false;
   if -1 > 0 then pass1 := false;
   if not pass1 then begin
      pass := false;
      writeln( 'integer compare test failed' );
   end;

   pass1 := true;
   if false <> false then pass1 := false;
   if true = false then pass1 := false;
   if false < false then pass1 := false;
   if true > true then pass1 := false;
   if false >= true then pass1 := false;
   if true <= false then pass1 := false;
   if true < false then pass1 := false;
   if false > true then pass1 := false;
   if not pass1 then begin
      pass := false;
      writeln( 'boolean compare test failed' );
   end;


   pass1 := true;
   if 0.0 <> 0.0 then pass1 := false;
   if 1.0 = 0.0 then pass1 := false;
   if 0.0 < 0.0 then pass1 := false;
   if 1.0 > 1.0 then pass1 := false;
   if 0.0 >= 1.0 then pass1 := false;
   if 1.0 <= 0.0 then pass1 := false;
   if 1.0 < 0.0 then pass1 := false;
   if 0.0 > 1.0 then pass1 := false;

   if -1.0 <> -1.0 then pass1 := false;
   if 0.0 = -1.0 then pass1 := false;
   if -1.0 < -1.0 then pass1 := false;
   if 0.0 > 0.0 then pass1 := false;
   if -1.0 >= 0.0 then pass1 := false;
   if 0.0 <= -1.0 then pass1 := false;
   if 0.0 < -1.0 then pass1 := false;
   if -1.0 > 0.0 then pass1 := false;
   if not pass1 then begin
      pass := false;
      writeln( 'real compare test failed' );
   end;

   pass1 := true;
   if 'b' <> 'b' then pass1 := false;
   if 'c' = 'b' then pass1 := false;
   if 'b' < 'b' then pass1 := false;
   if 'a' > 'a' then pass1 := false;
   if 'b' >= 'c' then pass1 := false;
   if 'c' <= 'b' then pass1 := false;
   if 'c' < 'b' then pass1 := false;
   if 'b' > 'c' then pass1 := false;
   if not pass1 then begin
      pass := false;
      writeln( 'character compare test failed' );
   end;


   { TODO: test mixed integer & real ops, especially division }
   i1 := -18 + cTen; { -8 }
   i2 := -i1 * 10;   { 80 }
   i2 := i2 - 7;     { 73 }
   i1 := i2 div 10;  { 7 }
   i2 := i2 mod 10;  { 3 }
   if i1 <> 7 then begin
      Pass := false;
      writeln( 'fail point 1, i1 is ', i1 );
   end;
   if i2 <> 3 then begin
      pass := false;
      writeln( 'fail point 2, i1 is ', i1 );
   end;
   if i1 + i2*4 <> 19 then begin
      pass := false;
      writeln( 'fail point 3, i1 is ', i1 );
   end;
   if i2 - 25 mod i1 <> -1 then begin
      pAsS := false;
      writeln( 'fail point 4, i1 is ', i1 );
   end;
   if i2 + 25 div i1 <> 6 then begin
      pass := false;
      writeln( 'fail point 5, i1 is ', i1 );
   end;
   if ((33 div i1)*i1 + 33 mod i1) <> 33 then begin
      PaSs := false;
      writeln( 'fail point 6, i1 is ', i1 );
   end;
   if (-25) mod i1 <> 3 then begin
      pass := false;
      writeln( 'fail point 7, -25 mod ', i1:1, ' is ', (-25) mod i1 );
   end;

   for i0 := -100 to 100 do begin
      for i1 := 1 to 10 do begin
         k := i0 mod i1;
         if (k < 0) or (k >= i1) or (k <> (i0+i1) mod i1)
            or ((i0=i1) and (k<>0))
            or ((i0>=0) and (i0<i1) and (k<>i0)) then begin
            pass := false;
            writeln( 'fail point 8, ', i0:2, ' mod ', i1:1, ' is ', i0 mod i1 );
         end;
      end;
   end;

   for i0 := -100 to 100 do begin
      for i1 := 1 to 10 do begin
         k := abs(i0 div i1) * i1;
         if (abs(i0)  >= k + abs(i1)) or (k > abs(i0) ) then begin
            pass := false;
            writeln( 'fail point 9, ', i0:2, ' div ', i1:1, ' is ', i0 div i1 );
         end;
      end;
   end;

   if -8 mod 5 <> -3 then begin
      pass := false;
      writeln( 'fail point 10, -8 mod 5 is ', -8 mod 5:1 );
   end;

   if -(-(-(8 mod 5))) <> -3 then begin
      pass := false;
      writeln( 'fail point 11, -(-(-(8 mod 5))) is ', -(-(-(8 mod 5))):1 );
   end;

   if (-8) mod 5 <> 2 then begin
      pass := false;
      writeln( 'fail point 12, -8 mod 5 is ', (-8) mod 5:1 );
   end;


   if not pass then
      writeln( 'integer operator tests failed' );

   i2 := 3;
   x1 := 300 + i2*pi;
   x2 := x1/i2 - pi;
   x1 := -x2;
   if (x1 > -99.99) or (x1 < -100.01) then begin
      pass := false;
      writeln( 'real operator tests failed, x1 is ', x1:8:3 );
   end;

   x1 := -mhalf*3;
   x1 := x1 + half;
   if x1 <> 2 then begin
      pass := false;
      writeln( 'real constant tests failed, x1 is ', x1:8:3 );
   end;


   i2 := -4+3;
   if i2 + 1 <> 0 then begin
      pass := false;
      writeln( 'unary minus test 1 failed' );
   end;

   i2 := -(4+3);
   if i2 + 7 <> 0 then begin
      pass := false;
      writeln( 'unary minus test 2 failed' );
   end;

   i2 := -(-4+3);
   if i2 - 1 <> 0 then begin
      pass := false;
      writeln( 'unary minus test 3 failed' );
   end;

   pass1 := true;
   ch1 := chOne;
   ch2 := '2';
   if chOne <> '1' then
      pass1 := false;
   b1 := ch2 = '2';
   b1 := not b1;
   if b1 then
      pass1 := false;
   if ch2 > '2' then
      pass1 := false;
   if ch1 <= '0' then
      pass1 := false;
   if ch1 < '1' then
      pass1 := false;
   if ch1 >= ch2 then
      pass1 := false;
   if not pass1 then begin
      writeln( 'character compare tests failed' );
      pass := false;
   end;

   ch1 := chr(255);
   if ord(ch1) <> 255 then begin
      pass := false;
      writeln( 'failed char sign test, ord(chr(255)) is ', ord(chr(255)) );
   end;


   pass1 := true;
   x1 := 2.0 * (pi - 1.0);
   pr1 := nil;
   b1 := not( (pr1 <> nil) and cTrue);
   if not b1 then
      pass1 := false;
   b1 := (pr1 = nil) or not cTrue;
   if not b1 then
      pass1 := false;

   { check that parens are obeyed }
   x2 := 2;
   if (x2 + eps + eps) = x2 then
      if x2 + (eps + eps) = x2 then begin
         pass := false;
         writeln( 'parens test failed (a)' );
      end;
   if (eps + eps + x2) = x2 then
      if (eps + eps) + x2 = x2 then begin
         pass := false;
         writeln( 'parens test failed (b)' );
      end;

   { these two tests pass if operators follow pascal precedence,
     fail for c precedence }
   a := false; c := true; { b1 is don't care }
   b1 := (i1 = 8) or (ch1 < ch2) and (x1 > 0.0) or (x2 >= 10.0) and (i2 <= 8);
   b1 := a and b1 < c;
   if not b1 then
      pass1 := false;

   b1 := c or b1 <= a;
   pass1 := not b1 and pass1;

   for a := false to true do begin
      if (true and a) <> a then begin
         pass1 := false;
         writeln('short circuit test failed (1)');
      end;
      if false and a then begin
         pass1 := false;
         writeln('short circuit test failed (2)');
      end;
      if (true or a) <> true then begin
         pass1 := false;
         writeln('short circuit test failed (3)');
      end;
      if (false or a) <> a then begin
         pass1 := false;
         writeln('short circuit test failed (4)');
      end;

      for b1 := false to true do begin

         if (true and a = b1) <> (a=b1) then begin
            pass1 := false;
            writeln('short circuit test failed (5)');
         end;
         if (false and a = b1) = b1 then begin
            pass1 := false;
            writeln('short circuit test failed (6)');
         end;
         if (true or a = b1) <> b1 then begin
            pass1 := false;
            writeln('short circuit test failed (7)');
         end;
         if (false or a = b1) <> (a=b1) then begin
            pass1 := false;
            writeln('short circuit test failed (8)');
         end;


         for c := false to true do begin
            if (a and b1 < c) <> ((a and b1) < c) then begin
               pass1 := false;
               writeln('precedence test failed (1)');
            end;
            if (c > a and b1) <> ((a and b1) < c) then begin
               pass1 := false;
               writeln('precedence test failed (2)');
            end;
            if (a or b1 < c) <> ((a or b1) < c) then begin
               pass1 := false;
               writeln('precedence test failed (3)');
            end;
            if (c > a or b1) <> ((a or b1) < c) then begin
               pass1 := false;
               writeln('precedence test failed (4)');
            end;
         end; {for c ...}
      end; {for b1 ...}
   end; {for a ...}

   {test evaluation is left .. right, => lhs is always evluated}
   k := ord('a');
   sidevar := k;
   if a1[chr(sideFun)] and true then
      ;
   if sideVar <> k+1 then begin
      pass1 := false;
      writeln('short circuit test failed (10)');
   end;

   sidevar := k;
   if a1[chr(sideFun)] and false then else
      ;
   if sideVar <> k+1 then begin
      pass1 := false;
      writeln('short circuit test failed (11)');
   end;

   sidevar := k;
   if a1[chr(sideFun)] or true then
      ;
   if sideVar <> k+1 then begin
      pass1 := false;
      writeln('short circuit test failed (12)');
   end;

   sidevar := k;
   if a1[chr(sideFun)] or false then
      ;
   if sideVar <> k+1 then begin
      pass1 := false;
      writeln('short circuit test failed (13)');
   end;


   if not pass1 then begin
      writeln( 'boolean tests failed' );
      pass := false;
   end;

   { test each statement type }

   if thirteen <> 13 then begin
      pass := false;
      writeln( 'fail point 9, function call' );
   end;

   i1 := 1;
   x1 := 5;
   while x1 < 100 do begin
      x1 := x1*2;
      i1 := i1 + 1
   end;
   if (i1 <> 6) then
      writeln( 'failed, i1 is ', i1:1 );
   if (i1 <> 6) or (x1 > 160.01) or (x1 < 159.99) then begin
      pass := false;
      writeln( 'while loop failed' )
   end;

   if ch2 = ch1 then begin
      ch1 := '&';
      x2 := x2 - 10;
   end
   else
      ch1 := '#';

   x1 := 99.9;
   repeat
      ch1 := '@';
      ch2 := chOne;
      x2 := pi + x1 * i2;
      x1 := x1 - 1;
   until x1 < 99.9;
   if ch2 <> chOne then begin
      pass := false;
      writeln( 'repeat loop should execute at least once' );
   end;

   x1 := 99.9;
   x2 := 0;
   repeat
      x2 := x1 + x2;
      x1 := x1 - 1;
   until x1 < 90.0;
   if (x2 < (99.9-4.5)*10 - 0.001) or (x2 > (99.9-4.5)*10 + 0.001) then begin
      pass := false;
      writeln( 'incorrect execution of repeat loop, x2 is ', x2:7:1 );
   end;

   i2 := 0;
   for i1 := 10 downto 5 do
      i2 := i2 + i1;
   if i2 <> 45 then begin
      pass := false;
      writeln( 'error in for .. downto loop' );
   end;

   pass1 := true;
   i2 := 0;
   k := 10;
   for i1 := 0 to k do begin
      i2 := i2 + i1;
      if i1 <= 6 then
         case i1 of
           0     : if i2 <> 0 then
                      pass1 := false;
           1     : if i2 <> 1 then
                      pass1 := false;
           2,3   : begin
              if i2 < 3 then
                 pass1 := false
              else if i2 > 6 then
                 pass1 := false;
           end;
           4,5,6 :begin
              if (i1 = 4) and (i2 <> 10) then
                 pass1 := false
              else if (i1 = 5) and (i2 <> 15) then
                 pass1 := false
              else if (i1 = 6) and (i2 <> 21) then
                 pass1 := false
              else if (i1 < 4) or (i1 > 6) then begin
                 pass1 := false;
                 writeln( 'error in case statement for case value ', i1 );
              end;
           end;
         end; { case }
      if not pass1 then
         writeln( 'i1 is ', i1, ', i2 is ', i2, ' pass is ', pass );
   end;
   if i2 <> k*(k+1) div 2 then begin
      pass1 := false;
      writeln( 'failure in for .. to loop' );
   end;

   if not pass1 then begin
      writeln( 'fail point 11' );
      pass := false;
   end;

   {  check: start value evaluated before end value
             end evaluated once only }
   k := startval;
   i2 := 0;
   for i1 := retk to retk do begin
      i2 := i2 + 100*k;
   end;
   if k <> endval+1 then begin
      writeln( 'for loop start/end conditions incorrectly evaluated' );
      pass := false;
   end;
   k := (endval-startval+1)*100*(endval+1);
   if i2 <> k then begin
      writeln( 'for loop start/end conditions incorrectly evaluated' );
      writeln( 'i2 is ', i2, ', expected ', k );
      pass := false;
   end;

   { check: loop var assigned only if start <= end }
   i1 := 1;
   for i1 := 10 to 9 do begin
      pass := false;
      writeln( 'for loop incorrectly entered' );
   end;
   if i1 <> 1 then begin
      pass := false;
      writeln( 'for loop variable incorrectly assigned' );
   end;

   i2 := 0;
   for i1 := maxint - 5 to maxint do begin
      i2 := i2 + 1;
      if i2 >= 50 then begin
         pass := false;
         writeln('for .. to loop fails when end value = maxint');
         goto 90;
      end;
   end;
90:

   i2 := 0;
   for i1 := 5 - maxint downto -maxint do begin
      i2 := i2 + 1;
      if i2 >= 50 then begin
         pass := false;
         writeln('for .. downto loop fails when end value = -maxint');
         goto 9999;
      end;
   end;
9999:

   { test empty statements }
   a := true;
   if a then;
   a := false;
   if a then begin
      pass := false;
      writeln( 'fail: empty then statement' );
   end;

   repeat
      if a then
      else  { this should compile }
   until true;

   {test standard functions and procedures}
   p10;

   {test statements}
   p11;

   { test local goto statements }
   i2 := 3;
   x1 := 0;
1: x1 := 10*x1+1;
   if i2 < 0 then checkgoto
   else goto 2;
3: x1 := 10*x1+3;
   i2 := -2*i2;
   goto 1;
2: x1 := 10*x1+2;
   i2 := i2 + 10;
   goto 3;
9:
  writeln;
   if (i2 <> -20) or (x1 <> 12319) then begin
      writeln( 'goto failure, x is ', x1:1, ', i2 is ', i2:1 );
      pass := false;
   end;

   {test goto with nested statements}
   k := 1;
   if k > 0 then begin
      while k > 0 do begin
         if k > 5 then
            goto 0;
         k := k+1;
      end; {while}
      if k = 4 then
         k := k+1;
0:
      k := k-10;

      if k = 10 then
         k := k-1;
      while k > 0 do begin
         k := k-1;
         if k > 4 then
            goto 0;
      end; {while}
   end; {if}

   if k <> -4 then begin
      pass := false;
      writeln('local goto test fails');
   end;

  { TODO: gcc fails here if optimisation is turned on }

   if pass then
      writeln( 'expression & statement tests passed' )
   else
      writeln( 'statement tests failed' );
   writeln;

   gototest := true;
   goto 999;  { calls p1000 below }

end; { p1 }


{ this procedure is used to help test goto statements }
procedure p1000;
label 10, 30;
procedure p1001(f : boolean );
label 1, 2, 3;
begin
   if f then
      f := not f;

   { f is false }
   repeat
      goto 3;
3:
   until true;
   if f then
      goto 1; { shouldn't happen }
1:
  if f then
      f := not f; { shouldn't happen }
   if f then
      writeln( 'fail: label separates statements' );
   goto 30;
   goto 2;
2:  { this is a compile test }
end; { p1001 }

begin
   p1001( true );
30:
   gototest := false;
   writeln( 'interprocedural goto test passed' );
   writeln;
   goto 10;
10:
end; { p1000 }


{ test string handling }
procedure p2;
const
   n   =  10;
   c4  = '0123456789';
type
   mystr1  = packed array[1..n] of char;
   mystr2  = packed array[1..n] of char;
   pmystr1 = ^mystr1;
var
   s1   : mystr1;
   s2   : array[1..3] of mystr2;
   sb   : array[boolean] of packed array[1..12] of char;
   ci   : char;
   i    : integer;
   pass : boolean;
   fail : boolean;
   sp   : ^mystr1;
   sp1   : pmystr1;

procedure p21;
type
   str1 =  packed array[1..1] of char;
   stra =  packed array[1..1] of 'a'..'z';
var
   s1     : str1;
   sa     : stra;
   arr    : array[0..9] of record
                             s : str1;
                             c : char;
                           end;
   testch : char;
procedure p211(a1: str1 );
begin
   if a1[1] <> testch then begin
      pass := false;
      writeln('single char string param test failed found ''', a1[1], ''', expected ''', testch, '''');
   end;
end; { p211 }

procedure p212(aa :stra );
begin
   if aa[1] <> testch then begin
      pass := false;
      writeln('single char string param test failed (subrange) found ''', aa[1], ''', expected ''', testch, '''');
   end;
end; { p212 }

procedure p213(ac : packed array[one..len :integer] of char);
begin
   if (one <> 1) or (len <> 1) then begin
      pass := false;
      writeln('single char string conf array limits test failed found ', one:1, '..', len:1);
   end;
   if ac[1] <> testch then begin
      pass := false;
      writeln('single char string conf array test failedfound ''', ac[1], ''', expected ''', testch, '''');
   end;
end; { p213 }

begin
   s1 := '1';
   if s1[1] <> '1' then begin
      pass := false;
      writeln('single char string assign test failed');
   end;

   s1 := '9';
   if (s1 <> '9') or not ('9' = s1) then begin
      pass := false;
      writeln('single char string compare test failed');
   end;

   arr[1].s := '!';
   if arr[1].s[1] <> '!' then begin
      pass := false;
      writeln('single char string assign test failed');
   end;

   sa := 'a';
   if sa[1] <> 'a' then begin
      pass := false;
      writeln('single char string assign test failed (subrange)');
   end;

   sa := 'z';
   if (sa < 'z') or ('z' > sa) then begin
      pass := false;
      writeln('single char string compare test failed (subrange)');
   end;

   testch := '2';
   p211('2');
   testch := 'b';
   p212('b');
   testch := 'c';
   p213('c');

end; { p21 }

function f22: pmystr1;
var q : pmystr1;
begin
   new(q);
   q^ := sp^;
   sp^[1] := succ(sp^[1]);
   f22 := q;
end; { f22 }

begin
   pass := true;


   { test string assignment }
   s1 := c4;
   s2[1] := s1;
   s2[3] := c4;
   i := 1;
   for ci := '0' to '9' do begin
      if s2[1,i] <> ci then
         pass := false;
      if s2[3,i] <> ci then
         pass := false;
      i := i+1;
   end;

   s1 := 'abcdefghij';
   s2[2] := s1;
   s2[3] := 'ABCDEFGHIJ';
   i := 1;
   for ci := 'a' to 'j' do begin
      if s2[2,i] <> ci then
         pass := false;
      if s2[3,i] <> chr(ord(ci) - ord('a') + ord('A')) then
         pass := false;
      i := i+1;
   end;

   s1 := s2[1];
   i := 1;
   for ci := '0' to '9' do begin
      if s1[i] <> ci then
         pass := false;
      i := i+1;
   end;

   new(sp);

   sp^ := s2[2];
   i := 1;
   for ci := 'a' to 'j' do begin
      if sp^[i] <> ci then
         pass := false;
      i := i+1;
   end;


   { string compares: 6 relops, const & var strings, T & F compare }

   s2[3] := 'abcdefghij';
   s1 := 'abcdefghii';
   sp^ := 'abcdefghii';

   if 'abcdefghij' < 'abcdefghii' then begin
      writeln( 'string compare fails' );
      pass := false;
   end;

   if 'abcdefghii' < s1 then begin
      writeln( 'string compare fails' );
      pass := false;
   end;

   if s2[3] <= 'abcdefghii' then begin
      writeln( 'string compare fails' );
      pass := false;
   end;

   if sp^ > s2[3] then begin
      writeln( 'string compare fails' );
      pass := false;
   end;

   if s2[3] > 'abcdefghij' then begin
      writeln( 'string compare fails' );
      pass := false;
   end;

   if s1 >= 'abcdefghij' then begin
      writeln( 'string compare fails' );
      pass := false;
   end;

   if s2[3] = 'abcdefghii' then begin
      writeln( 'string compare fails' );
      pass := false;
   end;

   if 'abcdefghii' <> s1 then begin
      writeln( 'string compare fails' );
      pass := false;
   end;

   fail := true;
   if s1 < s2[3] then
      fail := false
   else
      writeln( 'string compare fails' );

   if 'abcdefghii' <= 'abcdefghij' then
      fail := false
   else
      writeln( 'string compare fails' );

   if s2[3] > s1 then
      fail := false
   else
      writeln( 'string compare fails' );

   if 'abcdefghij' >= s1 then
      fail := false
   else
      writeln( 'string compare fails' );

   if 'abcdefghii' = sp^ then
      fail := false
   else
      writeln( 'string compare fails' );

   if 'abcdefghii' >= s1 then
      fail := false
   else
      writeln( 'string compare fails' );

   if s2[3] <= 'abcdefghij' then
      fail := false
   else
      writeln( 'string compare fails' );

   if s2[3] <> s1 then
      fail := false
   else
      writeln( 'string compare fails' );


   if fail then
      pass := false;


   { array[boolean, strcmp] of string -- recursive strncmp }

   sb[false] := 'false string';
   sb[true] := 'true string ';

   if sb[ s2[3] > 'abcdefghii' ] <> 'true string ' then begin
      pass := false;
      writeln( 'recursive string compare 1 fails' );
   end;

   if sb[ s2[3] <= 'abcdefghii' ] <> 'false string' then begin
      pass := false;
      writeln( 'recursive string compare 2 fails' );
   end;

   { func with side effects returning pointer to str }
   sp^ := '0123456789';
   sp1 := f22;
   if sp1^ <> '0123456789' then begin
      writeln( 'fail, func returning pointer to string, sp1 is ', sp1^);
      pass := false;
   end;
   dispose(sp1);
   if sp^ <> '1123456789' then begin {test side effect}
      writeln( 'fail, func side effect, sp is ', sp^);
      pass := false;
   end;

   dispose(sp);

   p21; {test single char strings}

   if pass then
      writeln( 'string tests passed' )
   else
      writeln( 'string tests failed' );
   writeln;

end; { p2 }


{ test write & writeln formatting }
procedure p3;
const
   n       = 15;
   testStr = 'te%st str%ing'; { catch c formatting trap }
   zzz     =  123.0;
   mzzz     =  -zzz;

type
   numStr = packed array[1..n] of char;
var
   str     : packed array[1..5] of char;
   longStr : numStr;
   c       : char;
   i,k,m   : integer;
   b1      : boolean;
   pass    : boolean;
   f       : text;
   x       : real;

   function iSide : integer;
   begin
      iSide := k;
      k := k + 1;
   end; { side }
   function cSide : char;
   begin
      k := k + 1;
      cSide := chr(k);
   end; { side }
   function bSide : boolean;
   begin
      k := k + 1;
      bSide := odd(k);
   end; { side }
   function rSide : real;
   begin
      k := k + 1;
      rSide := k+0.9;
   end; { side }
   function  r: char;
   begin
      write('e');
      r := 'c';
   end;
   procedure check(t : numStr );
   var
      i  : integer;
      s  : numStr;
   begin
      for i := 1 to n do
         if not eoln( f ) then
            read( f, s[i] )
         else
            s[i] := ' ';
      readln( f );
      if t <> s then begin
         pass := false;
         writeln( 'write real format fail, x is ''', s, ''', expected ''', t, ''''  );
      end;
   end;

{test format width for strings & booleans }
procedure p31;
const n = 10;
type
   testStr =  packed array[1..n] of char;
var
   i,w: integer;
   s4 : packed array[1..4] of char;
   s5 : packed array[1..5] of char;
   t  : testStr;
   f  : text;
procedure readline(var s: testStr );
var i : 1..n;
begin
   for i := 1 to n do begin
      if not eoln(f) then
         read(f, s[i] )
      else
         s[i] := '_';
   end;
   readln(f);
end; { readline }

{each pair of lines must match}
procedure check2;
var
   t1, t2: testStr;
   i     : 1..n;
begin
   while not eof(f) do begin
      readline( t1 );
      readline( t2 );
      for i := 1 to n do begin
         if t1[i] <> t2[i] then begin
            pass := false;
            writeln( 'fail: write format expected ''', t1,
                                     ', found ''', t2, '''' );
         end;
      end; {for}
   end; {while}
end; { check2 }

begin {p31}
   {write a string with width as variable, then read and analyse it}
   s5 := 'abcde';
   rewrite(f);
   for w := -n to n do
      writeln(f, s5:w);

   reset(f);
   for w := -n to n do begin
      readline(t);
      if w < -5 then begin
         {expect 'abcde  __...'}
         for i := 1 to n do begin
            if i <= 5 then begin
               if t[i] <> chr(ord('a')-1+i) then begin
                  pass := false;
                  writeln( 'fail: string format(', i:1, '), t is ''', t, ''', w is ', w:1 );
               end;
            end
            else if i <= abs(w) then begin
               if t[i] <> ' ' then begin
                  pass := false;
                  writeln( 'fail: string format(', i:1, '), t is ''', t, ''', w is ', w:1 );
               end;
            end
            else if t[i] <> '_'then begin
                  pass := false;
                  writeln( 'fail: string format(', i:1, '), t is ''', t, ''', w is ', w:1 );
            end;
         end; {for}
      end
      else if w < 5 then begin
         {expect'ab...'}
         for i := 1 to n do begin
            if i <= abs(w) then begin
               if t[i] <> chr(ord('a')-1+i) then begin
                  pass := false;
                  writeln( 'fail: string format(', i:1, '), t is ''', t, ''', w is ', w:1 );
               end;
            end
            else if t[i] <> '_'then begin
                  pass := false;
                  writeln( 'fail: string format(', i:1, '), t is ''', t, ''', w is ', w:1 );
            end;
         end; {for}
      end
      else begin
         {expect '  abcde___'}
         for i := 1 to n do begin
            if i <= w-5 then begin
               if t[i] <> ' ' then begin
                  pass := false;
                  writeln( 'fail: string format(', i:1, '), t is ''', t, ''', w is ', w:1 );
               end;
            end else if i <= w then begin
               if t[i] <> chr(ord('a') + i - w + 4) then begin
                  pass := false;
                  writeln( 'fail: string format(', i:1, '), t is ''', t, ''', w is ', w:1 );
               end
            end else begin
               if t[i] <> '_' then begin
                  pass := false;
                  writeln( 'fail: string format(', i:1, '), t is ''', t, ''', w is ', w:1 );
               end
            end;
         end; {for}
      end;
   end; {for}

   { strings now verified, next do booleans & constants for width }
   rewrite(f);
   s5 := 'ABCDE';
   i := -6;    writeln(f, s5:i );
   writeln(f, s5:-6 );
   i := -5;    writeln(f, s5:i );
   writeln(f, s5:-5 );
   i := -4;    writeln(f, s5:i );
   writeln(f, s5:-4 );
   i := 0;    writeln(f, s5:i );
   writeln(f, s5:0 );
   i := 4;    writeln(f, s5:i );
   writeln(f, s5:4 );
   i := 5;    writeln(f, s5:i );
   writeln(f, s5:5 );
   i := 6;    writeln(f, s5:i );
   writeln(f, s5:6 );

   s4 := 'true';
   for w := -n to n do begin
      writeln( f, s4:w);
      writeln( f, true:w );
   end;
   i := -5; writeln( f, s4:i);
   writeln( f, true:-5 );
   i := -4; writeln( f, s4:i);
   writeln( f, true:-4 );
   i := -3; writeln( f, s4:i);
   writeln( f, true:-3 );
   i := 0; writeln( f, s4:i);
   writeln( f, true:0 );
   i := 3; writeln( f, s4:i);
   writeln( f, true:3 );
   i := 4; writeln( f, s4:i);
   writeln( f, true:4 );
   i := 5; writeln( f, s4:i);
   writeln( f, true:5 );

   s5 := 'false';
   for w := -n to n do begin
      writeln( f, s5:w);
      writeln( f, false:w );
   end;
   i := -6; writeln( f, s5:i);
   writeln( f, false:-6 );
   i := -5; writeln( f, s5:i);
   writeln( f, false:-5 );
   i := -4; writeln( f, s5:i);
   writeln( f, false:-4 );
   i := 0; writeln( f, s5:i);
   writeln( f, false:0 );
   i := 4; writeln( f, s5:i);
   writeln( f, false:4 );
   i := 5; writeln( f, s5:i);
   writeln( f, false:5 );
   i := 6; writeln( f, s5:i);
   writeln( f, false:6 );

   reset(f);
   check2;

end; { p31 }


{test format widths for char, boolean & strings}
function f32 : boolean;

var
   fx, fc : text;
   s      : packed array[1..3] of char;
   b      : boolean;
   c      : char;
   i      : integer;
   cc, cx : char;
   pass   : boolean;
   sol    : boolean;
   procedure check;
   begin
      reset(fx); reset(fc);
      sol := true;
      while not eof(fc) do begin
         if sol then begin
            write('''');
            sol := false;
         end;
         if eof(fx) then begin
            writeln('f32 format width test failed: unexpected eof');
            pass := false;
            while not eof(fc) do begin
               if eoln(fc) then begin
                  readln(fc);
                  writeln;
               end
               else begin
                  read(fc, cc);
                  write(cc);
               end;
            end;
         end
         else if eoln(fc) then begin
            if not eoln(fx) then begin
               write(''': f32 format width test failed: expected eoln, found ''');
               while not eoln(fx) do begin
                  read(fx, cx); write(cx);
                  //writeln('''');
               end;
               pass := false;
            end;
            readln(fc); readln(fx);
            writeln('''');
            sol := true;
         end
         else begin
            read(fc, cc); read(fx, cx);
            if cc = cx then
               write(cc)
            else begin
               writeln('f32 format width test failed: expected ''', cc,
                       ''', found ''', cx, '''');
               pass := false;
            end;
         end;
      end; {while}
   end; { check }

function gench: char;
begin
   gench := c;
   if c in ['a'..'z'] then begin
      c := succ(c);
   end
   else begin
      write(fx, '!':3, c);
   end;
end; { gench }

begin {f32}
   pass := true;

   {chars}
   rewrite(fx);   rewrite(fc);
   c := 'a';
   writeln(fx, gench:2);  writeln(fc, ' a');
   writeln(fx, gench:1);  writeln(fc, 'b');
   writeln(fx, gench:0);  writeln(fc);
   writeln(fx, gench:-1); writeln(fc, 'd');
   writeln(fx, gench:-2); writeln(fc, 'e ');

   {reentrancy test:}
   c := '%';
   writeln(fx, gench:2); writeln(fc, '  !% %');
   check;
   rewrite(fx);
   c := 'a';
   for i := 2 downto -2 do
      writeln(fx, gench:i);
   c := '%'; i := 2;
   writeln(fx, gench:i);
   check;

   {booleans}
   rewrite(fx);   rewrite(fc);
   b := true;
   writeln(fx, b:5);  writeln(fc, ' true');
   writeln(fx, b:4);  writeln(fc, 'true');
   writeln(fx, b:3);  writeln(fc, 'tru');
   writeln(fx, b:2);  writeln(fc, 'tr');
   writeln(fx, b:1);  writeln(fc, 't');
   writeln(fx, b:0);  writeln(fc);
   writeln(fx, b:-1); writeln(fc, 't');
   writeln(fx, b:-2); writeln(fc, 'tr');
   writeln(fx, b:-3); writeln(fc, 'tru');
   writeln(fx, b:-4); writeln(fc, 'true');
   writeln(fx, b:-5); writeln(fc, 'true ');
   check;
   rewrite(fx);
   for i := 5 downto -5 do
      writeln(fx, b:i);
   check;

   rewrite(fx);   rewrite(fc);
   b := false;
   writeln(fx, b:6);  writeln(fc, ' false');
   writeln(fx, b:5);  writeln(fc, 'false');
   writeln(fx, b:4);  writeln(fc, 'fals');
   writeln(fx, b:3);  writeln(fc, 'fal');
   writeln(fx, b:2);  writeln(fc, 'fa');
   writeln(fx, b:1);  writeln(fc, 'f');
   writeln(fx, b:0);  writeln(fc);
   writeln(fx, b:-1); writeln(fc, 'f');
   writeln(fx, b:-2); writeln(fc, 'fa');
   writeln(fx, b:-3); writeln(fc, 'fal');
   writeln(fx, b:-4); writeln(fc, 'fals');
   writeln(fx, b:-5); writeln(fc, 'false');
   writeln(fx, b:-6); writeln(fc, 'false ');
   check;
   rewrite(fx);
   for i := 6 downto -6 do
      writeln(fx, b:i);
   check;

   {strings}
   rewrite(fx);   rewrite(fc);
   s := 'ABC';
   writeln(fx, s:5);  writeln(fc, '  ABC');
   writeln(fx, s:4);  writeln(fc, ' ABC');
   writeln(fx, s:3);  writeln(fc, 'ABC');
   writeln(fx, s:2);  writeln(fc, 'AB');
   writeln(fx, s:1);  writeln(fc, 'A');
   writeln(fx, s:0);  writeln(fc);
   writeln(fx, s:-1); writeln(fc, 'A');
   writeln(fx, s:-2); writeln(fc, 'AB');
   writeln(fx, s:-3); writeln(fc, 'ABC');
   writeln(fx, s:-4); writeln(fc, 'ABC ');
   writeln(fx, s:-5); writeln(fc, 'ABC  ');
   check;
   rewrite(fx);
   for i := 5 downto -5 do
      writeln(fx, s:i);
   check;

   {constant strings}
   rewrite(fx);   rewrite(fc);
   writeln(fx, 'XYZ':5);  writeln(fc, '  XYZ');
   writeln(fx, 'XYZ':4);  writeln(fc, ' XYZ');
   writeln(fx, 'XYZ':3);  writeln(fc, 'XYZ');
   writeln(fx, 'XYZ':2);  writeln(fc, 'XY');
   writeln(fx, 'XYZ':1);  writeln(fc, 'X');
   writeln(fx, 'XYZ':0);  writeln(fc);
   writeln(fx, 'XYZ':-1); writeln(fc, 'X');
   writeln(fx, 'XYZ':-2); writeln(fc, 'XY');
   writeln(fx, 'XYZ':-3); writeln(fc, 'XYZ');
   writeln(fx, 'XYZ':-4); writeln(fc, 'XYZ ');
   writeln(fx, 'XYZ':-5); writeln(fc, 'XYZ  ');
   check;
   rewrite(fx);
   for i := 5 downto -5 do
      writeln(fx, 'XYZ':i);
   check;

   if pass then
      writeln('f32: format width tests passed');
   f32 := pass;
end; { f32 }


{floating point format tests}
procedure p33;
var
   i : integer;
begin
   rewrite( f );
   writeln( f, 0.0:1 );                   {0}
   writeln( f, 123:3, 123:4, 123:5 );     {1}
   writeln( f, -123:3, -123:4, -123:5 );  {2}
   writeln( f, zzz:15 );                  {3}
   writeln( f, zzz:15:1 );                {4}
   writeln( f, mzzz:15 );                 {5}
   writeln( f, mzzz:15:1 );               {6}
   writeln( f, 0.0:15:2 );                {7}
   reset( f );

   {test real number format in c library}
   for i := 1 to n do
      if not eoln(f) then
         read( f, longStr[i] )
      else
         longStr[i] := ' ';
   if longStr <> ' 0.0e+00       ' then begin
      writeln( 'result 0 is (', longStr, ')' );
      pass := false;
      i := 1;
      writeln;
      while (i<=n) and not (longStr[i] in ['e','E']) do i := i+1;
      if (i>=n-2) or not (longStr[i+1] in ['+','-']) then begin
         writeln('c library exponential format for real numbers is incorrect');
      end
      else begin
         {2 exp digits expected if c library is correct}
         k := 0;
         i := i+2;
         while (i<=n) and (longStr[i] = '0') do begin
            k := k+1;
            i := i+1;
         end;
         if k <> 2 then begin
            writeln('warning:  the system floating point library has a real number format problem');
            writeln('p5c expects the underlying c library to adhere to the c standard');
            writeln('a correct c library must normally have 2 digits in the exponent');
            writeln('and use more only when necessary to represent the value');
            writeln('expect minor real number formatting issues with this library');
         end;
      end;
      writeln;
   end;
   readln( f );

   for i := 1 to n do
      if not eoln(f) then
         read( f, longStr[i] )
      else
         longStr[i] := ' ';
   if longStr <> '123 123  123   ' then begin
      writeln( 'result 1 is (', longStr, ')' );
      writeln( 'failed integer field width test for +ve nrs (1)' );
      pass := false;
   end;
   readln( f );
   for i := 1 to n do
      if not eoln(f) then
         read( f, longStr[i] )
      else
         longStr[i] := ' ';
   if longStr <> '-123-123 -123  ' then begin
      writeln( 'result 2 is ''', longStr, '''' );
      writeln( 'failed integer field width test for -ve nrs (2)' );
      pass := false;
   end;
   readln( f );
   for i := 1 to n do
      if not eoln(f) then
         read( f, longStr[i] )
      else
         longStr[i] := ' ';
   if longStr <> ' 1.23000000e+02' then begin
      writeln( 'result 3 is (', longStr, ')' );
      writeln( 'failed real field width test for +ve nrs (3)' );
      pass := false;
   end;
   readln( f );
   for i := 1 to n do
      if not eoln(f) then
         read( f, longStr[i] )
      else
         longStr[i] := ' ';
   if longStr <> '          123.0' then begin
      writeln( 'result 4 is ''', longStr, '''' );
      writeln( 'failed real field width test for -ve nrs (4)' );
      pass := false;
   end;
   readln( f );
   for i := 1 to n do
      if not eoln(f) then
         read( f, longStr[i] )
      else
         longStr[i] := ' ';
   if longStr <> '-1.23000000e+02' then begin
      writeln( 'result 5 is (', longStr, ')' );
      writeln( 'failed real field width test for +ve nrs (5)' );
      pass := false;
   end;
   readln( f );
   for i := 1 to n do
      if not eoln(f) then
         read( f, longStr[i] )
      else
         longStr[i] := ' ';
   if longStr <> '         -123.0' then begin
      writeln( 'result 6 is ''', longStr, '''' );
      writeln( 'failed real field width test for -ve nrs (6)' );
      pass := false;
   end;
   readln( f );
   for i := 1 to n do
      if not eoln(f) then
         read( f, longStr[i] )
      else
         longStr[i] := ' ';
   if longStr <> '           0.00' then begin
      writeln( 'result 7 is ''', longStr, '''' );
      writeln( 'failed real field width test for zero (7)' );
      pass := false;
   end;

   rewrite( f );
   x := 12.5e-8;                 {1}
   k := 8;
   writeln( f, x: iSide);
   if k <> 9 then begin
      pass := false;
      writeln( 'fail: write real has side effects' );
   end;
   x := -89.2;                   {2}
   k := 9;
   writeln( f, x: iSide);
   x := -98.2e-12;               {3}
   k := 10;
   writeln( f, x: iSide);
   x := 108.2e11;                {4}
   k := 11;
   writeln( f, x: iSide);

   x := 0.0;
   writeln( f, x:8 );            {5}
   writeln( f, x:9 );            {6}
   writeln( f, x:10 );           {7}
   writeln( f, x:11 );           {8}

   if REAL_MAX_EXP >=1000 then writeln('fail: no tests for 4 digit exponents');

#  if REAL_MAX_EXP >=100

   {test formatting for 3 digit exponents}

   {first check 2 digit side of the boundary,
    (width too small, just right, one too big) *
     (+/- num) * (+/- exp) * const/var}

   x := 9.9e99;
   writeln(f, x:7 );             {10}
   writeln(f, x:8 );             {11}
   writeln(f, x:9 );             {12}

   x := -x;
   writeln(f, x:7 );             {13}
   writeln(f, x:8 );             {14}
   writeln(f, x:9 );             {15}

   x := 9.9e-99;
   writeln(f, x:7 );             {20}
   writeln(f, x:8 );             {21}
   writeln(f, x:9 );             {22}

   x := -x;
   writeln(f, x:7 );             {23}
   writeln(f, x:8 );             {24}
   writeln(f, x:9 );             {25}

   i := 0;
   x := 9.9e99;
   writeln(f, x:i+7 );           {30}
   writeln(f, x:i+8 );           {31}
   writeln(f, x:i+9 );           {32}

   x := -x;
   writeln(f, x:i+7 );           {33}
   writeln(f, x:i+8 );           {34}
   writeln(f, x:i+9 );           {35}

   x := 9.9e-99;
   writeln(f, x:i+7 );           {40}
   writeln(f, x:i+8 );           {41}
   writeln(f, x:i+9 );           {42}

   x := -x;
   writeln(f, x:i+7 );           {43}
   writeln(f, x:i+8 );           {44}
   writeln(f, x:i+9 );           {45}


{now for 3 digit exponents}

   x := 1.0e100;
   writeln(f, x:8 );             {50}
   writeln(f, x:9 );             {51}
   writeln(f, x:10 );            {52}

   x := -x;
   writeln(f, x:8 );             {53}
   writeln(f, x:9 );             {54}
   writeln(f, x:10 );            {55}

   x := 1.0e-100;
   writeln(f, x:8 );             {60}
   writeln(f, x:9 );             {61}
   writeln(f, x:10 );            {62}

   x := -x;
   writeln(f, x:8 );             {63}
   writeln(f, x:9 );             {64}
   writeln(f, x:10 );            {65}

   i := 0;
   x := 1.0e100;
   writeln(f, x:i+8 );           {70}
   writeln(f, x:i+9 );           {71}
   writeln(f, x:i+10 );          {72}

   x := -x;
   writeln(f, x:i+8 );           {73}
   writeln(f, x:i+9 );           {74}
   writeln(f, x:i+10 );          {75}

   x := 1.0e-100;
   writeln(f, x:i+8 );           {80}
   writeln(f, x:i+9 );           {81}
   writeln(f, x:i+10 );          {82}

   x := -x;
   writeln(f, x:i+8 );           {83}
   writeln(f, x:i+9 );           {84}
   writeln(f, x:i+10 );          {85}

#  endif

   {test results}
   reset( f );
   longStr := ' 1.2e-07       ';     {1}
   check( longStr );
   longStr := '-8.92e+01      ';     {2}
   check( longStr );
   longStr := '-9.820e-11     ';     {3}
   check( longStr );
   longStr := ' 1.0820e+13    ';     {4}
   check( longStr );

   longStr := ' 0.0e+00       ';     {5}
   check( longStr );
   longStr := ' 0.00e+00      ';     {6}
   check( longStr );
   longStr := ' 0.000e+00     ';     {7}
   check( longStr );
   longStr := ' 0.0000e+00    ';     {8}
   check( longStr );

#  if REAL_MAX_EXP >=100

   longStr := ' 9.9e+99       ';    {10}
   check( longStr );
   longStr := ' 9.9e+99       ';    {11}
   check( longStr );
   longStr := ' 9.90e+99      ';    {12}
   check( longStr );

   longStr := '-9.9e+99       ';    {13}
   check( longStr );
   longStr := '-9.9e+99       ';    {14}
   check( longStr );
   longStr := '-9.90e+99      ';    {15}
   check( longStr );

   longStr := ' 9.9e-99       ';    {20}
   check( longStr );
   longStr := ' 9.9e-99       ';    {21}
   check( longStr );
   longStr := ' 9.90e-99      ';    {22}
   check( longStr );

   longStr := '-9.9e-99       ';    {23}
   check( longStr );
   longStr := '-9.9e-99       ';    {24}
   check( longStr );
   longStr := '-9.90e-99      ';    {25}
   check( longStr );

   longStr := ' 9.9e+99       ';    {30}
   check( longStr );
   longStr := ' 9.9e+99       ';    {31}
   check( longStr );
   longStr := ' 9.90e+99      ';    {32}
   check( longStr );

   longStr := '-9.9e+99       ';    {33}
   check( longStr );
   longStr := '-9.9e+99       ';    {34}
   check( longStr );
   longStr := '-9.90e+99      ';    {35}
   check( longStr );

   longStr := ' 9.9e-99       ';    {40}
   check( longStr );
   longStr := ' 9.9e-99       ';    {41}
   check( longStr );
   longStr := ' 9.90e-99      ';    {42}
   check( longStr );

   longStr := '-9.9e-99       ';    {43}
   check( longStr );
   longStr := '-9.9e-99       ';    {44}
   check( longStr );
   longStr := '-9.90e-99      ';    {45}
   check( longStr );

   longStr := ' 1.0e+100      ';    {50}
   check( longStr );
   longStr := ' 1.0e+100      ';    {51}
   check( longStr );
   longStr := ' 1.00e+100     ';    {52}
   check( longStr );

   longStr := '-1.0e+100      ';    {53}
   check( longStr );
   longStr := '-1.0e+100      ';    {54}
   check( longStr );
   longStr := '-1.00e+100     ';    {55}
   check( longStr );

   longStr := ' 1.0e-100      ';    {60}
   check( longStr );
   longStr := ' 1.0e-100      ';    {61}
   check( longStr );
   longStr := ' 1.00e-100     ';    {62}
   check( longStr );

   longStr := '-1.0e-100      ';    {63}
   check( longStr );
   longStr := '-1.0e-100      ';    {64}
   check( longStr );
   longStr := '-1.00e-100     ';    {65}
   check( longStr );

   longStr := ' 1.0e+100      ';    {70}
   check( longStr );
   longStr := ' 1.0e+100      ';    {71}
   check( longStr );
   longStr := ' 1.00e+100     ';    {72}
   check( longStr );

   longStr := '-1.0e+100      ';    {73}
   check( longStr );
   longStr := '-1.0e+100      ';    {74}
   check( longStr );
   longStr := '-1.00e+100     ';    {75}
   check( longStr );

   longStr := ' 1.0e-100      ';    {80}
   check( longStr );
   longStr := ' 1.0e-100      ';    {81}
   check( longStr );
   longStr := ' 1.00e-100     ';    {82}
   check( longStr );

   longStr := '-1.0e-100      ';    {83}
   check( longStr );
   longStr := '-1.0e-100      ';    {84}
   check( longStr );
   longStr := '-1.00e-100     ';    {85}
   check( longStr );

#  endif

end; { p33 }


{ test write expression with side effects, bool, int, real, char, string }
procedure p34;
var
   i : integer;
begin
   k := 1;
   write( '        ' );
   writeln( 'next number should be 1 -->', iSide:1, '<--' );
   if k <> 2 then
      pass := false;

   k := 0;
   write( '        ' );
   writeln( 'next number should be 1.9 -->', rSide:4:1, '<--' );
   if k <> 1 then
      pass := false;

   k := 0;
   write( '        ' );
   writeln( 'this should be true -->', bSide, '<--' );
   if k <> 1 then
      pass := false;

   k := ord('A');
   write( '        ' );
   writeln( 'this should be B -->', cSide, '<--' );
   if k <> ord('B') then
      pass := false;

   { test field widths, consts, variable }
   { check if width expressions have side effects }
   { TODO: test writeln( i:1 );}
   writeln( 'aligned':15 );
   writeln( str: 13); { len str = 5 }
   writeln( 'c':9 );
   writeln( 3:9 );
   writeln( true:13 );
   writeln( 1.0:12:1 );

   rewrite( f );
   b1 := true;
   writeln(f, b1, not b1 );      {1}
   writeln(f, b1:3, not b1:4 );  {2}
   writeln(f, b1:4, not b1:5 );  {3}
   writeln(f, b1:5, not b1:6 );  {4}
   k:=3;
   writeln(f, b1:iside, not b1:iside );  {5}
   if k <> 5 then begin
      pass := false;
      writeln( 'fail: boolean width evaluated two or more times (3)' );
   end;
   k:=4;
   writeln(f, b1:iside, not b1:iside );  {6}
   if k <> 6 then begin
      pass := false;
      writeln( 'fail: boolean width evaluated two or more times (3)' );
   end;
   k:=5;
   writeln(f, b1:iside, not b1:iside );  {7}
   if k <> 7 then begin
      pass := false;
      writeln( 'fail: boolean width evaluated two or more times (3)' );
   end;
   reset( f );
   for i := 1 to n do begin
      if not eoln(f) then
         read(f, longStr[i] )
      else
         longStr[i] := '_';
   end;
   if longStr <> 'truefalse______' then begin
      pass := false;
      writeln( 'fail: boolean format fail (1)' );
   end;
   if not eoln( f ) then begin
      pass := false;
      writeln( 'fail: eoln expected after boolean format (1)' );
   end;
   readln( f );

   for i := 1 to n do begin
      if not eoln(f) then
         read(f, longStr[i] )
      else
         longStr[i] := '_';
   end;
   if longStr <> 'trufals________' then begin
      pass := false;
      writeln( 'fail: boolean format fail (2)' );
   end;
   if not eoln( f ) then begin
      pass := false;
      writeln( 'fail: eoln expected after boolean format (2)' );
   end;
   readln( f );
   for i := 1 to n do begin
      if not eoln(f) then
         read(f, longStr[i] )
      else
         longStr[i] := '_';
   end;
   if longStr <> 'truefalse______' then begin
      pass := false;
      writeln( 'fail: boolean format fail (3)' );
   end;
   if not eoln( f ) then begin
      pass := false;
      writeln( 'fail: eoln expected after boolean format (3)' );
   end;
   readln( f );
   for i := 1 to n do begin
      if not eoln(f) then
         read(f, longStr[i] )
      else
         longStr[i] := '_';
   end;
   if longStr <> ' true false____' then begin
      pass := false;
      writeln( 'fail: boolean format fail (4)' );
   end;
   if not eoln( f ) then begin
      pass := false;
      writeln( 'fail: eoln expected after boolean format (4)' );
   end;

   readln( f );
   for i := 1 to n do begin
      if not eoln(f) then
         read(f, longStr[i] )
      else
         longStr[i] := '_';
   end;
   if longStr <> 'trufals________' then begin
      pass := false;
      writeln( 'fail: boolean format fail (5), ''', longStr, '''' );
   end;
   if not eoln( f ) then begin
      pass := false;
      writeln( 'fail: eoln expected after boolean format (5)' );
   end;
   readln( f );
   for i := 1 to n do begin
      if not eoln(f) then
         read(f, longStr[i] )
      else
         longStr[i] := '_';
   end;
   if longStr <> 'truefalse______' then begin
      pass := false;
      writeln( 'fail: boolean format fail (6), ''', longStr, '''' );
   end;
   if not eoln( f ) then begin
      pass := false;
      writeln( 'fail: eoln expected after boolean format (6)' );
   end;
   readln( f );
   for i := 1 to n do begin
      if not eoln(f) then
         read(f, longStr[i] )
      else
         longStr[i] := '_';
   end;
   if longStr <> ' true false____' then begin
      pass := false;
      writeln( 'fail: boolean format fail (7)' );
   end;
   if not eoln( f ) then begin
      pass := false;
      writeln( 'fail: eoln expected after boolean format (7)' );
   end;

   rewrite( f );
   writeln(f, 'TEST' );
   writeln(f, 'TEST':3 );
   writeln(f, 'TEST':4 );
   writeln(f, 'TEST':5 );
   k:=3;
   writeln(f, 'TEST':iSide );
   if k <> 4 then begin
      pass := false;
      writeln( 'fail: string width evaluated ', k-3:1, ' times' );
   end;
   k:=4;
   writeln(f, 'TEST':iSide );
   if k <> 5 then begin
      pass := false;
      writeln( 'fail: string width evaluated ', k-4:1, ' times' );
   end;
   k:=5;
   writeln(f, 'TEST':iSide );
   if k <> 6 then begin
      pass := false;
      writeln( 'fail: string width evaluated ', k-5:1, ' times' );
   end;

   reset( f );
   for i := 1 to 5 do begin
      if not eoln(f) then
         read(f, str[i] )
      else
         str[i] := '-';
   end;
   if str <> 'TEST-' then begin
      pass := false;
      writeln( 'fail: string format (1)' );
   end;
   if not eoln( f ) then begin
      pass := false;
      writeln( 'fail: eoln expected after string format (1)' );
   end;
   readln( f );
   for i := 1 to 5 do begin
      if not eoln(f) then
         read(f, str[i] )
      else
         str[i] := '-';
   end;
   if str <> 'TES--' then begin
      pass := false;
      writeln( 'fail: string format (2)' );
   end;
   if not eoln( f ) then begin
      pass := false;
      writeln( 'fail: eoln expected after string format (2)' );
   end;
   readln( f );
   for i := 1 to 5 do begin
      if not eoln(f) then
         read(f, str[i] )
      else
         str[i] := '-';
   end;
   if str <> 'TEST-' then begin
      pass := false;
      writeln( 'fail: string format fail (3)' );
   end;
   if not eoln( f ) then begin
      pass := false;
      writeln( 'fail: eoln expected after string format (3)' );
   end;
   readln( f );
   for i := 1 to 5 do begin
      if not eoln(f) then
         read(f, str[i] )
      else
         str[i] := '-';
   end;
   if str <> ' TEST' then begin
      pass := false;
      writeln( 'fail: string format fail (4)' );
   end;
   if not eoln( f ) then begin
      pass := false;
      writeln( 'fail: eoln expected after string format (4)' );
   end;

   readln( f );
   for i := 1 to 5 do begin
      if not eoln(f) then
         read(f, str[i] )
      else
         str[i] := '-';
   end;
   if str <> 'TES--' then begin
      pass := false;
      writeln( 'fail: string format fail (5)' );
   end;
   if not eoln( f ) then begin
      pass := false;
      writeln( 'fail: eoln expected after string format (5)' );
   end;
   readln( f );
   for i := 1 to 5 do begin
      if not eoln(f) then
         read(f, str[i] )
      else
         str[i] := '-';
   end;
   if str <> 'TEST-' then begin
      pass := false;
      writeln( 'fail: string format fail (6)' );
   end;
   if not eoln( f ) then begin
      pass := false;
      writeln( 'fail: eoln expected after string format (6)' );
   end;
   readln( f );
   for i := 1 to 5 do begin
      if not eoln(f) then
         read(f, str[i] )
      else
         str[i] := '-';
   end;
   if str <> ' TEST' then begin
      pass := false;
      writeln( 'fail: string format fail (7)' );
   end;
   if not eoln( f ) then begin
      pass := false;
      writeln( 'fail: eoln expected after string format (7)' );
   end;
end; { p34 }


{test pointer write}
procedure p39;
const
   show =  false;
var
   j,l,m     : integer;
   c         : char;
   xp        : ^real;
   xs, xs0   : integer;
   l0        : integer;

   procedure newxs(ac : char);
   begin
      xs := 16*(xs mod ((maxint - 255) div 16)) + ord(ac);
   end; { newxs }

begin
   xp := nil;
   writeln('nil pointer is ''', xp, '''');
   new(xp);

   {xp has a different value and length each time,
    and pointer value is implementation dependent.
    Directly comparing results to auto-verify is not valid,
    so compare length and checksums instead.}
   rewrite(f);
   writeln(f, 'pointer is ''', xp, '''');

   for j := 1 to 20 do begin
      writeln(f, 'valid pointer is ''', xp:j, '''');
      write(f, 'field width = ', j:2, ' ''');
      for m := 1 to j do write(f, '^');
      writeln(f, '''');
   end; { for }

   {now normalise raw data}
   reset(f);
   repeat
      read(f,c); if show then write(c);
   until c = '''';

   {get length & check sum for first pointer
    - it was written with no specified fieldwidth}
   xs := 0;
   l0 := -1; {for the trailing ''''}
   repeat
      l0 := l0+1;
      read(f,c); if show then write(c);
      newxs(c);
   until c = '''';
   xs0 := xs;

   {write(' pointer len is ', l0:1, ' ');}
   readln(f); if show then writeln;

   j := 1; {field width}
   while not eof(f) do begin

      repeat
         read(f,c); if show then write(c);
      until c = '''';

      l := -1; {len}
      m := 0; {nr spaces}
      xs := 0;
      repeat
         read(f,c); if show then write(c);
         if c <= ' ' then m := m+1
         else begin
            l := l+1;
            newxs(c);
         end;
      until c = '''';

      if show then
         writeln(' len is ', l:1, ', nr spaces is ', m:1, ', xs is ', xs:1);
      readln(f);

      if l <> l0 then begin
         pass := false;
         writeln('write pointer length error for field width ', j:1,
                 ', expected ', l0:1, ', found ', l:1, ', pointer is ''', xp:j, '''');
      end;

      if xs <> xs0 then begin
         pass := false;
         writeln('write pointer value error for field width ', j:1,
                 ', expected ', xp, ', found ''', xp:j, '''');
      end;

      if (j > l0) and (m+l <> j) then begin
         pass := false;
         writeln('write pointer fieldwidth error for field width ', j:1,
                 ', expected ', j:1, ', found ', m+l:1, ', pointer is ''', xp:j, '''');
      end;

      while not eoln(f) do begin
         read(f,c); if show then write(c);
      end;
      readln(f); if show then writeln;
      j := j+1;
   end;

   dispose(xp);
end; { p39 }


begin {p3}
   pass := true;

   { TODO: write to a file, read back & check }

   { write/ln for char, integer, boolean, real, string var & string const }
   writeln;
   write('w' ); writeln('r', 'iteln and write', ' tests');
   write( ' ':8 );
   writeln(testStr);
   write( '        ' );
   str := 'test ';
   writeln(str);
   write( '        ' );
   writeln( 'true ', not true, ' false ', not false );
   write( '        ' );
   for c := 'A' to 'Z' do
      write( c );
   for i := 9 downto -9 do
      write( ' ', i );
   writeln;
   write( '        ' );
   writeln( 'pi is approximately ', 355/113:8:5 );

   if not f32 then begin {char, boolean & string format tests}
      pass := false;
   end;

   p33; {fp format tests}

   p34; { test write expression with side effects }

   str := 'test ';
   writeln( str: 8+5); { var width expression }
   for i := 0 to 10 do begin
      writeln( 'aligned':i+15 );
      writeln( str:i+13); { len str = 5 }
      writeln( 'c':i+9 );
      writeln( 3:i+9 );
      writeln( true:i+13 );
      writeln( 1.1:i+12:1 );
   end;

   m := 1;
   k := 1;
   while m < maxint/10 do begin
      k := k + 1;
      m := 10*m + k mod 10;
   end; { while }

   for i := 1 to k+8 do begin
      writeln( m:i );
   end;

   for i := 1 to 15 do begin
      writeln( 1000/8.1 : 8+i: i, ' <-- ', i:1, ' decimal digits' );
   end;
   for i := 1 to 15 do begin
      k := i;
      writeln( -1/1.0125 : 8+i: iSide, ' <-- ', i:1, ' decimal digits' );
      if k <> i+1 then begin
         pass := false;
         writeln( 'fail: write real has side effects, i is ', i:1, ', k is ', k:1 );
      end;
   end;

   { test truncate string }
   for i:= 1 to n do
      longStr[i] := chr( ord('a') + i -1);
   for i := n+8 downto 1 do
      writeln( ' ':8, longStr:i);

   writeln( ' ':8, longStr:4);

   for i := 18 downto 1 do
      writeln( ' ':8, 'ABCDEFGHIJ':i);

   writeln( ' ':8, 'ABCDEFGHIJ':4);

   i := 8; m:=9; k := 10;
   writeln( 'this should be 170 -->', (i+m)*k );

   { recursive write - function r writes chars from inside a writeln }
   writeln( 'r', r, 'ursive write' );

   p31;
   p39;

   if pass then
      writeln( 'writeln tests passed' )
   else
      writeln( 'writeln tests failed' );
   writeln;

end; { p3 }


{ test read & write to/from file }
{ TODO: file buffer var as var parameter, is eoln a space? }
procedure p4;

const
#if ! defined MAXFILES3
#define MAXFILES3 1021
#endif
   nrFiles = MAXFILES3;   {nr allowed open files - 3, ulimit -n}
   wkFiles =  143;  {open and close in blocks of 143 files}

type
   fileRec  =  record
                  a : integer;
                  case b: boolean of
                    true  : ( f : text; );
                    false : ( x : real; );
               end;

var
   pass	: boolean;
   i	: integer;
   c	: char;
   x	: real;
	
procedure A(var c : char );
begin
   c := 'A';
end; { A }

{ verify that a file can be passed into a function as a var param }
procedure p41(var aa : array[a..b: integer] of array[c..d: integer] of fileRec );
var i,j,z :  integer;
begin
   for i := a to b do for j := c to d do begin
      with aa[i,j] do begin
         b := true;
         rewrite(f);
         a := 100*i +j;
         writeln(f,a);
      end;
   end;
   for i := a to b do for j := c to d do begin
      with aa[i,j] do begin
         reset(f);
         read(f,z);
         if z <> a then begin
            pass := false;
            writeln( 'file arg test failed' );
         end;
      end;
   end;

   {extra test to verify that files can be part of record variants}
   for i := a to b do for j := c to d do begin
      with aa[i,j] do begin
         b := false;
         x := 11.1*i*j;
      end;
   end;

end; { p41 }

{ open enough files to almost meet system limit }
procedure check;
var i    : integer;
    ffaa : array[1..nrFiles] of file of integer;
    k    : integer;
begin
   for i := 1 to nrFiles do begin
      //writeln('file nr ', i:1);
      rewrite(ffaa[i]);
      write(ffaa[i], i);
   end;
   for i := 1 to nrFiles do begin
      //writeln('file nr ', i:1);
      reset(ffaa[i]);
      read(ffaa[i], k);
      if i <> k then begin
         pass := false;
         writeln('files open test: file nr ', i:1, 'failed');
      end;
   end;

end; { check }

{ declare & open 143 files }
{ TODO: guaranteed nr files that can be opened is FOPEN_MAX from c library
        this could theoretically be < 143 }
procedure p42;
var
   i, j : integer;
   c    : char;

   ff   : file of record                                          {  1}
             x : real;
             c : char;
          end;

   myrec : record
              n     : integer;
              f1,f2 : file of integer;                            {  3}
              g     : array[1..4] of file of real;                {  7}
              r     : record
                         nn      : integer;
                         ff1,ff2 : file of integer;               {  9}
                         gg      : array[1..4] of file of real;   { 13}
                      end;
           end;

   myrec1 : packed record
               i,j,k,l : 0..15;
               a       : array[0..15] of integer;
            end;

   af     : array[1..10] of file of char;                         { 23}
   af2    : array[1..10] of array['1'..'9'] of file of char;      {113}

   ar     : array [1..5] of record
                n     : integer;
                f1,f2 : file of integer;                          {123}
                g     : array[1..4] of file of real;              {143}
            end;

begin {p42}
   if wkFiles <> 143 then begin
      writeln('test error: wkFiles is ', wkFiles:1, ', expected 143');
   end
   else begin

      rewrite(ff);

      with myrec do begin
         n:=1;
         rewrite(f1);
         rewrite(f2);
         for i := 1 to 4 do rewrite(g[i]);
         rewrite(r.ff1);
         rewrite(r.ff2);
         for i := 1 to 4 do rewrite(r.gg[i]);
      end;

      with myRec1 do begin
         i := 4;
         a[3] := 888;
      end;

      for i := 1 to 10 do rewrite(af[i]);
      for i := 1 to 10 do
         for c := '1' to '9' do
            rewrite(af2[i,c]);

      for i := 1 to 5 do begin
         rewrite(ar[i].f1);
         rewrite(ar[i].f2);
         for j := 1 to 4 do
            rewrite(ar[i].g[j]);
      end;
   end;
end; {p42}


{test file close with interprocedure goto with nested recursive functions }
procedure p43;
label 1;
var
   count : integer;

   procedure p431;
   var f1, f2 :  file of integer;
      procedure p432;
         procedure p433;
         var f1, f2 :  file of integer;
         begin
            rewrite(f1);   rewrite(f2);
            if count = 0 then
               goto 1;
            count := count - 1;
            p431;
         end; { 433 }
      begin
         p433;
      end; { 432 }
   begin
      rewrite(f1);   rewrite(f2);
      p432;
   end; { 431 }
begin
   check;
   count := 4;
   p431;
1:
   check;
end; { p43 }

{ verify file open & cleanup when file is in a variant record }
procedure p44;

var
   i    : integer;
   ci    : char;
   vrec : record
             i1 : integer;
             case c:char of
               'A','B' : (case boolean of
                         true:( f1, f2: text;
                                aa: array[1..4] of integer;
                                g1: file of integer;
                              );
                         false:( x,y:real;
                                 b1: boolean;
                                 i2: integer;
                               );
                     );
               'Y' : (d: boolean;
                      cc: array[char] of integer;
                     );
               'Z' : (q: set of 0..255;
                      a: array[1..9] of real;
                     );
          end;

begin

   with vrec do begin

      {attempt to destroy file description}
      vrec.c := 'Z';
      q := [0..255];
      for i := 1 to 9 do a[i] := maxint*2.01;

      {file should open}
      c := 'A';
      rewrite(f1);
      write(f1, 'testA1' );
      rewrite(f2);
      write(f2, 'testA2' );
      for i := 1 to 4 do aa[i] := sqr(i);

      {new tag - still file should open}
      c := 'B';
      i2 := 355;
      x := i2/113;
      y := 2*x;
      b1 := true;
      rewrite(f2);
      write(f2, 'testB2' );

      {this should not destroy files for tags 'A' & 'B'}
      vrec.c := 'Y';
      d := true;
      for ci := 'a' to 'z' do cc[c] := ord(c) + 99;
      {files should close at cleanup}
   end; {with}

end; { p44 }


{verify that files in dynamic memory are closed when the memory is disposed}
procedure p45;
type
  fft = file of record                                            {  1}
             x : real;
             c : char;
         end;
   fftp =  ^fft;

   myrect = record
               n     : integer;
               f1,f2 : file of integer;                            {  3}
               g     : array[1..4] of file of real;                {  7}
               r     : record
                          nn      : integer;
                          ff1,ff2 : file of integer;               {  9}
                          gg      : array[1..4] of file of real;   { 13}
                       end;
            end;

   myrec1t = packed record
                i,j,k,l : 0..15;
                a       : array[0..15] of integer;
             end;

   aft    = array[1..10] of fftp;                                 { 23}

   af2t   = array[1..10] of array['1'..'9'] of file of char;      {113}

   art    = array [1..5] of record
                n     : integer;
                f1,f2 : file of integer;                          {123}
                g     : array[1..4] of file of real;              {143}
            end;

var
   i, j    : integer;
   c       : char;
   ffp     : ^fft;
   myRecp  : ^myRect;
   myRec1p : ^myRec1t;
   afp     : ^aft;
   af2p    : ^af2t;
   arp     : ^art;
begin

   new(ffp);
   rewrite(ffp^);
   dispose(ffp);

   new(myRecp);
   rewrite(myRecp^.f1);
   rewrite(myRecp^.f2);
   for i := 1 to 4 do
      rewrite(myRecp^.g[i]);
   rewrite(myRecp^.r.ff1);
   rewrite(myRecp^.r.ff2);
   for i := 1 to 4 do
      rewrite(myRecp^.r.gg[i]);
   dispose(myRecp);

   new(myRec1p); {no files here, so shouldn't attempt to close any}
   dispose(myRec1p);

   new(afp);
   for i := 1 to 10 do begin
      new(afp^[i]);
      rewrite(afp^[i]^);
      dispose(afp^[i]);
   end;
   dispose(afp);

   new(af2p);
   for i := 1 to 10 do for c := '1' to '9' do
      rewrite(af2p^[i,c]);
   dispose(af2p);

   new(arp);
   for i := 1 to 5 do begin
      with arp^[i] do begin
         rewrite(f1);
         rewrite(f2);
         for j := 1 to 4 do
            rewrite(g[j]);
      end;
   end;
   dispose(arp);

end; { p45 }


{lazy i/o tests on text files
 With lazy input, the character at the current file position char is not fetched
 until it is needed.
 Test that the character is fetched correctly, and is fetched exactly once
}
procedure p46;
var
   f    : text;
   c    : char;
begin
   rewrite(f);
   writeln(f, 'xyz');

   reset(f);
   {file pos is at 'x', 'x' not yet fetched}
   if f^ <> 'x' then begin
      pass := false;
      writeln('lazy i/o test (1) failed');
   end;
   {file pos is at 'x', 'x' now fetched}
   if eof(f) then begin
      pass := false;
      writeln('lazy i/o test (2) failed');
   end;
   if eoln(f) then begin
      pass := false;
      writeln('lazy i/o test (3) failed');
   end;
   read(f,c);
   if c <> 'x' then begin
      pass := false;
      writeln('lazy i/o test (4) failed');
   end;
   read(f,c); read(f,c);  {skip y & z - file pos should be on eoln}
   if not eoln(f) then begin
      pass := false;
      writeln('lazy i/o test (5) failed');
   end;
   if eof(f) then begin
      pass := false;
      writeln('lazy i/o test (6) failed');
   end;
   if f^ <> ' ' then begin
      pass := false;
      writeln('lazy i/o test (7) failed');
   end;

   reset(f);
   {file pos is at 'x', 'x' not yet fetched}
   if eoln(f) then begin
      pass := false;
      writeln('lazy i/o test (8) failed');
   end;
   {file pos is at 'x', 'x' now fetched}
   if f^ <> 'x' then begin
      pass := false;
      writeln('lazy i/o test (9) failed');
   end;
   if eof(f) then begin
      pass := false;
      writeln('lazy i/o test (10) failed');
   end;
   readln(f,c);
   if c <> 'x' then begin
      pass := false;
      writeln('lazy i/o test (11) failed');
   end;
   {file pos is at EOF, no char fetched}
   if not eof(f) then begin
      pass := false;
      writeln('lazy i/o test (12) failed');
   end;

   reset(f);
   {file pos is at 'x', 'x' not yet fetched}
   if eof(f) then begin
      pass := false;
      writeln('lazy i/o test (13) failed');
   end;
   {file pos is at 'x', 'x' now fetched}
   if eoln(f) then begin
      pass := false;
      writeln('lazy i/o test (14) failed');
   end;
   if f^ <> 'x' then begin
      pass := false;
      writeln('lazy i/o test (15) failed');
   end;
   read(f,c);
   if c <> 'x' then begin
      pass := false;
      writeln('lazy i/o test (16) failed');
   end;
   get(f); get(f);  {skip y & z - file pos should be on eoln}
   if f^ <> ' ' then begin
      pass := false;
      writeln('lazy i/o test (17) failed');
   end;
   if not eoln(f) then begin
      pass := false;
      writeln('lazy i/o test (18) failed');
   end;
   if eof(f) then begin
      pass := false;
      writeln('lazy i/o test (19) failed');
   end;
   read(f,c);
   if c <> ' ' then begin
      pass := false;
      writeln('lazy i/o test (20) failed');
   end;
   {file pos is at EOF, no char fetched}
   if not eof(f) then begin
      pass := false;
      writeln('lazy i/o test (21) failed');
   end;

   reset(f);
   {file pos is at 'x', 'x' not yet fetched}
   read(f,c);
   if c <> 'x' then begin
      pass := false;
      writeln('lazy i/o test (22) failed');
   end;
   {file pos is at 'y', 'x' now fetched}
   if eoln(f) then begin
      pass := false;
      writeln('lazy i/o test (23) failed');
   end;
   if f^ <> 'y' then begin
      pass := false;
      writeln('lazy i/o test (24) failed');
   end;
   if eof(f) then begin
      pass := false;
      writeln('lazy i/o test (25) failed');
   end;
   read(f,c); read(f,c);  {skip y & z - file pos should be on eoln}
   if eof(f) then begin
      pass := false;
      writeln('lazy i/o test (26) failed');
   end;
   if not eoln(f) then begin
      pass := false;
      writeln('lazy i/o test (27) failed');
   end;
   if f^ <> ' ' then begin
      pass := false;
      writeln('lazy i/o test (28) failed');
   end;
   get(f);
   {file pos is at EOF, no char fetched}
   if not eof(f) then begin
      pass := false;
      writeln('lazy i/o test (29) failed');
   end;

end; { p46 }


procedure p47;
{
in pascal, all lines in text files must be terminated with eoln.
So any text file created by a pascal program must have an eoln appended
when it is closed if the last line was not explicitly terminated, and
any text file read in must appear to have a trailing eoln if necessary.
}

type bin = packed file of char;

var
   {p5c does not allow file variables to share memory with other
    variables in a variant record.  We can however share pointers, so here
    we set up 2 pointers to the same file.  The pointers are different types
    so it is possible to see a file as a text file and a binary file.
   }
   f,f1 : record case boolean of
            true  : (fch  : ^bin);
            false : (ftx  : ^text;)
          end; { case }
   c    : char;
   pass1: boolean;

{file f contains 'abc', advance file position just beyond 'c'}
procedure lastCh(var f : text );
begin
   reset(f);
   if f^ <> 'a' then begin
      pass1 := false;
      writeln( 'fails: text file termination test (1): f^ is ''', f^, '''' );
   end;
   get(f);
   if f^ <> 'b' then begin
      pass1 := false;
      writeln( 'fails: text file termination test (2): f^ is ''', f^, '''' );
   end;
   get(f);
   if f^ <> 'c' then begin
      pass1 := false;
      writeln( 'fails: text file termination test (3): f^ is ''', f^, '''' );
   end;
   if not eof(f) then begin
      get(f);
   end
   else begin
      pass1 := false;
      writeln( 'fails: text file termination test (4): unexpected eof' );
   end

end; { lastCh }

begin
   pass1 := true;

   new(f.ftx);

   {****** test write unterminated file ******}

   {write a file without a trailing new line.}
   rewrite(f.ftx^);
   write(f.ftx^, 'xyz');  {no trailing eoln!}
   reset(f.ftx^);         {this should terminate the file}

   reset(f.fch^);         {reopen as binary file}
   if f.fch^^ <> 'x' then begin
      pass1 := false;
      writeln( 'fails: text file termination test (5): expected ''x'', found ', f.fch^^ );
   end;
   get(f.fch^);
   if f.fch^^ <> 'y' then begin
      pass1 := false;
      writeln( 'fails: text file termination test (6): expected ''y'', found ', f.fch^^ );
   end;
   get(f.fch^);
   if f.fch^^ <> 'z' then begin
      pass1 := false;
      writeln( 'fails: text file termination test (7): expected ''z'', found ', f.fch^^ );
   end;
   {has the file been terminated?}
   if eof(f.fch^) then begin
      pass1 := false;
      writeln( 'fails: text file termination test (8): unexpected eof' );
   end
   else begin
      get(f.fch^);
      {writeln('found eoln character(', ord(f.fch^^), ')');}
      if eof(f.fch^) then begin
         pass1 := false;
         writeln( 'fails: text file termination test (9): unexpected eof' );
      end
      else begin
         get(f.fch^);  {this should go to eof}
         if not eof(f.fch^) then begin
            pass1 := false;
            writeln( 'fails: text file termination test (10): expected eof' );
         end;
      end;
   end;

   {slightly different version of this test}
   new(f1.ftx);
   rewrite(f1.ftx^);
   writeln(f1.ftx^, 'xyz');    {terminated with eoln}
   reset(f1.ftx^);
   reset(f.ftx^);
   while not eof(f.fch^) and not eof(f1.fch^) do begin
      if f.fch^^ <> f1.fch^^ then begin
         pass1 := false;
         writeln( 'fails: text file termination test (11): expected ', f1.fch^^,
                  ', found ', f.fch^^ );
      end;
      get(f.fch^);  get(f1.fch^);
   end;
   if eof(f.fch^) <> eof(f1.fch^) then begin
      pass1 := false;
      writeln( 'fails: text file termination test (12): expected eof ', eof(f1.fch^),
               ', found ', eof(f.fch^) );
   end;


   {****** test read unterminated file ******}

   { create an unterminated file as a binary file, then read it back as a
     text file.  It should appear to have a trailing eoln char }
   rewrite(f.fch^);
   write(f.fch^, 'a' ); write(f.fch^, 'b' ); write(f.fch^, 'c' );
   reset(f.fch^);

   { test eof function }
   lastCh(f.ftx^);
   if eof(f.ftx^) then begin
      pass1 := false;
      writeln( 'fails: text file termination test (13): unexpected eof' );
   end
   else begin
      if not eoln(f.ftx^) then begin
         pass1 := false;
         writeln( 'fails: text file termination test (14): expected eoln' );
      end;

      get(f.ftx^);
      if not eof(f.ftx^) then begin
         pass1 := false;
         writeln( 'fails: text file termination test (15): expected eof' );
      end;
   end;


   { test eoln function }
   lastCh(f.ftx^);
   if not eoln(f.ftx^) then begin
      pass1 := false;
      writeln( 'fails: text file termination test (16): expected eoln' );
   end;
   if eof(f.ftx^) then begin
      pass1 := false;
      writeln( 'fails: text file termination test (17): unexpected eof' );
   end
   else begin
      if not eoln(f.ftx^) then begin
         pass1 := false;
         writeln( 'fails: text file termination test (18): expected eoln' );
      end;

      get(f.ftx^);
      if not eof(f.ftx^) then begin
         pass1 := false;
         writeln( 'fails: text file termination test (19): expected eof' );
      end;
   end;


   { test buffer variable }
   lastCh(f.ftx^);
   if f.ftx^^ <> ' ' then begin
      pass1 := false;
      writeln( 'fails: text file termination test (20): expected eoln' );
   end;
   if eof(f.ftx^) then begin
      pass1 := false;
      writeln( 'fails: text file termination test (21): unexpected eof' );
   end
   else begin
      if not eoln(f.ftx^) then begin
         pass1 := false;
         writeln( 'fails: text file termination test (22): expected eoln' );
      end;

      get(f.ftx^);
      if not eof(f.ftx^) then begin
         pass1 := false;
         writeln( 'fails: text file termination test (23): expected eof' );
      end;
   end;


   {test read function }
   lastCh(f.ftx^);
   if eof(f.ftx^) then begin
      pass1 := false;
      writeln( 'fails: text file termination test (24): unexpected eof' );
   end
   else begin
      read(f.ftx^, c);
      if c <> ' ' then begin
         pass1 := false;
         writeln( 'fails: text file termination test (25): ch is ''', c, ''' (',
                   ord(c):1, '), expected eoln' );
      end;
      if not eof(f.ftx^) then begin
         pass1 := false;
         writeln( 'fails: text file termination test (26): expected eof' );
      end;
   end;

   { test readln function }
   lastCh(f.ftx^);
   if eof(f.ftx^) then begin
      pass1 := false;
      writeln( 'fails: text file termination test (27): unexpected eof' );
   end
   else begin
      if not eoln(f.ftx^) then begin
         pass1 := false;
         writeln( 'fails: text file termination test (28): expected eoln' );
      end;
      readln(f.ftx^); {advance file pos beyond eoln}
      if not eof(f.ftx^) then begin
         pass1 := false;
         writeln( 'fails: text file termination test (29): expected eof' );
      end;
   end;


   {loop test again}
   rewrite(f1.ftx^);
   writeln(f1.ftx^, 'abc');    {terminated with eoln}
   reset(f1.ftx^);
   reset(f.ftx^);  { f is unterminated }
   while not eof(f.ftx^) and not eof(f1.ftx^) do begin
      if f.ftx^^ <> f1.ftx^^ then begin
         pass1 := false;
         writeln( 'fails: text file termination test (30): expected ', f1.ftx^^,
                  ', found ', f.ftx^^ );
      end;
      get(f.ftx^);  get(f1.ftx^);
   end;
   if eof(f.ftx^) <> eof(f1.ftx^) then begin
      pass1 := false;
      writeln( 'fails: text file termination test (31): expected eof ', eof(f1.ftx^),
               ', found ', eof(f.ftx^) );
   end;


   {****** test empty file ******}

   {an empty file has no unterminated lines,
    so there should not be any eoln added for read or write}

   rewrite(f.ftx^);
   reset(f.ftx^);
   if not eof(f.ftx^) then begin
      pass1 := false;
      writeln( 'fails: text file termination test (32): expected eof' );
   end;
   reset(f.fch^);
   if not eof(f.fch^) then begin
      pass1 := false;
      writeln( 'fails: text file termination test (33): expected eof' );
   end;


   dispose(f.ftx);   dispose(f1.ftx);
   if pass1 then
      writeln( 'unterminated file test OK' )
   else
      pass := false;

end; { p47 }


{ check eoln and eof are correctly determined under a variety of conditions }
procedure p48;

var
   f    : text;
   c    : char;
   pass1: boolean;

{file f contains 'abc', advance file position just beyond 'c'}
procedure lastCh(var f : text );
begin
   reset(f);
   if f^ <> 'a' then begin
      pass1 := false;
      writeln( 'fails: eoln/eof test (1): f^ is ''', f^, '''' );
   end;
   get(f);
   if f^ <> 'b' then begin
      pass1 := false;
      writeln( 'fails: eoln/eof test (2): f^ is ''', f^, '''' );
   end;
   get(f);
   if f^ <> 'c' then begin
      pass1 := false;
      writeln( 'fails: eoln/eof test (3): f^ is ''', f^, '''' );
   end;
   if not eof(f) then begin
      get(f);
   end
   else begin
      pass1 := false;
      writeln( 'fails: eoln/eof test (4): unexpected eof' );
   end

end; { lastCh }

begin {p48}
   pass1 := true;

   {eof tests}
   rewrite(f);
   writeln( f, 'abc' );
   writeln( f, 'ABC' );
   reset(f);

   if eof(f) then begin
      writeln( 'failed: unexpected eof (1)' );
      pass := false;
   end;
   if eof(f) then begin
      writeln( 'failed: unexpected eof (2)' );
      pass := false;
   end;
   if f^ <> 'a' then begin
      writeln( 'failed: eof (1)' );
      pass := false;
   end;
   if f^ <> 'a' then begin
      writeln( 'failed: eof (2)' );
      pass := false;
   end;
   if eof(f) then begin
      writeln( 'failed: unexpected eof (3)' );
      pass := false;
   end;
   if eof(f) then begin
      writeln( 'failed: unexpected eof (4)' );
      pass := false;
   end;

   get(f); get(f); get(f); {advance past 'abc'}
   if eof(f) then begin
      writeln( 'failed: unexpected eof (5)' );
      pass := false;
   end;
   if eof(f) then begin
      writeln( 'failed: unexpected eof (6)' );
      pass := false;
   end;
   if f^ <> ' ' then begin
      writeln( 'failed: eof (3)' );
      pass := false;
   end;
   if eof(f) then begin
      writeln( 'failed: unexpected eof (7)' );
      pass := false;
   end;
   if eof(f) then begin
      writeln( 'failed: unexpected eof (8)' );
      pass := false;
   end;
   if f^ <> ' ' then begin
      writeln( 'failed: eof (3)' );
      pass := false;
   end;
   if not eoln(f) then begin
      writeln( 'failed: eof (4)' );
      pass := false;
   end;

   get(f); get(f); get(f); get(f); {now at <eoln><eof>}
   if eof(f) then begin
      writeln( 'failed: unexpected eof (9)' );
      pass := false;
   end;
   if eof(f) then begin
      writeln( 'failed: unexpected eof (10)' );
      pass := false;
   end;
   if f^ <> ' ' then begin
      writeln( 'failed: eof (4)' );
      pass := false;
   end;
   if eof(f) then begin
      writeln( 'failed: unexpected eof (11)' );
      pass := false;
   end;
   if eof(f) then begin
      writeln( 'failed: unexpected eof (12)' );
      pass := false;
   end;
   if f^ <> ' ' then begin
      writeln( 'failed: eof (5)' );
      pass := false;
   end;

   get(f); {now at <eof>}
   if not eof(f) then begin
      writeln( 'failed: expected eof (13)' );
      pass := false;
   end;
   if not eof(f) then begin
      writeln( 'failed: expected eof (14)' );
      pass := false;
   end;

   rewrite(f);
   writeln(f, 'abc' );
   reset(f);

   { test eof function }
   lastCh(f);
   if eof(f) then begin
     pass1 := false;
     writeln( 'fails: eoln/eof test (5): unexpected eof' );
   end
   else begin
     if not eoln(f) then begin
       pass1 := false;
       writeln( 'fails: eoln/eof test (6): expected eoln' );
     end;

     get(f);
     if not eof(f) then begin
       pass1 := false;
       writeln( 'fails: eoln/eof test (7): expected eof' );
     end;

     { test eoln function }
     lastCh(f);
     if not eoln(f) then begin
       pass1 := false;
       writeln( 'fails: eoln/eof test (8): expected eoln' );
     end;
     if eof(f) then begin
       pass1 := false;
       writeln( 'fails: eoln/eof test (9): unexpected eof' );
     end
     else begin
       if not eoln(f) then begin
         pass1 := false;
         writeln( 'fails: eoln/eof test (10): expected eoln' );
       end;

       get(f);
       if not eof(f) then begin
         pass1 := false;
         writeln( 'fails: eoln/eof test (11): expected eof' );
       end;
     end;

     { test buffer variable }
     lastCh(f);
     if f^ <> ' ' then begin
       pass1 := false;
       writeln( 'fails: eoln/eof test (12): expected eoln' );
     end;
     if eof(f) then begin
       pass1 := false;
       writeln( 'fails: eoln/eof test (13): unexpected eof' );
     end
     else begin
       if not eoln(f) then begin
         pass1 := false;
         writeln( 'fails: eoln/eof test (14): expected eoln' );
       end;

       get(f);
       if not eof(f) then begin
         pass1 := false;
         writeln( 'fails: eoln/eof test (15): expected eof' );
       end;
     end;

     { test get function }
     lastCh(f);
     get(f);
     if not eof(f) then begin
       pass1 := false;
       writeln( 'fails: eoln/eof test (16): expected eof' );
     end;

     {test read function }
     lastCh(f);
     read(f, c);
     if c <> ' ' then begin
       pass1 := false;
       writeln( 'fails: eoln/eof test (17): ch is ''', c, ''' (',
                 ord(c):1, '), expected eoln' );
     end;
     if not eof(f) then begin
       pass1 := false;
       writeln( 'fails: eoln/eof test (18): expected eof' );
     end;

     { test readln function }
     lastCh(f);
     readln(f); {advance file pos beyond eoln}
     if not eof(f) then begin
       pass1 := false;
       writeln( 'fails: eoln/eof test (19): expected eof' );
     end;
   end;

   if pass1 then
      writeln( 'eoln/eof tests OK' )
   else
      pass := false;

end; { p48 }


procedure p40;
label 97, 98, 99;
const
   nf = 5;

type
   time     = record
                 hours : 0..23;
                 mins  : 0..59;
                 secs  : 0..59;
                 x     : ^y; { test type order }
              end;
   timeFile = file of time;
   y        = (am, pm);
   fileType = file of integer;

var
   farray : array[1..3,1..3] of fileRec;
   ftxt   : text;
   f2     : timeFile;
   c, c1  : char;
   cp     : ^char;
   x      : real;
   ax     : array[1..3] of real;
   i,j    : integer;
   n      : integer;
   f3     : file of record
              i : integer;
              x : real;
            end;
   q      : record
               cq : char;
               fq : file of record
                       qi : integer;
                    end;
            end;

   timep  :^time;
   t1,t2  : time;
   fileTypep    : ^fileType;
   ptext        : ^text;

   { test an array of files}
   af      : array[1..nf] of file of integer;

begin {p40}
   new(timep);

   rewrite(ftxt);
   ftxt^ := chr(255);
   put(ftxt);
   A(ftxt^); { fxtx^ := 'A' }
   put(ftxt);
   reset(ftxt);
   if ftxt^ <> chr(255) then begin
      pass := false;
      writeln( 'fail char 1 read from file is ->', ftxt^, '<- (', ord(ftxt^):1, ')' );
   end;
   get(ftxt);
   if ftxt^ <> 'A' then begin
      pass := false;
      writeln( 'fail char 2 read from file is ->', ftxt^, '<- (', ord(ftxt^):1, ')' );
   end;

   rewrite(f2);
   if not eof( f2 ) then begin
      writeln( 'fail: eof should be true at start of empty file (1)' );
      pass := false;
   end;
   for i := 0 to 11 do begin
      f2^.hours := i;
      f2^.mins := 59;
      f2^.secs := 58;
      put(f2);
   end;
   reset(f2);
   for i := 0 to 5 do begin
      if (f2^.hours <> i) or (f2^.mins <> 59)  or (f2^.secs <> 58) then begin
         pass := false;
         writeln( 'fail(1) time is ', f2^.hours:2, ':', f2^.mins:2, ':', f2^.secs:2 );
      end;
      get(f2);
   end;

   read( f2, t1);
   if (t1.hours <> 6) or (t1.mins <> 59)  or (t1.secs <> 58) then begin
      pass := false;
      writeln( 'fail(2) time is ', t1.hours:2, ':', t1.mins:2, ':', t1.secs:2 );
   end;
   read( f2, t1, t2);
   if (t1.hours <> 7) or (t1.mins <> 59)  or (t1.secs <> 58) then begin
      pass := false;
      writeln( 'fail(3) time is ', t1.hours:2, ':', t1.mins:2, ':', t1.secs:2 );
   end;

   if (t2.hours <> 8) or (t2.mins <> 59)  or (t2.secs <> 58) then begin
      pass := false;
      writeln( 'fail(4) time is ', t2.hours:2, ':', t2.mins:2, ':', t2.secs:2 );
   end;
   { check access to buffer variable does not affect read }
   if (f2^.hours <> 9) or (f2^.mins <> 59)  or (f2^.secs <> 58) then begin
      pass := false;
      writeln( 'fail(5) time is ', f2^.hours:2, ':', f2^.mins:2, ':', f2^.secs:2 );
   end;
   read( f2, t1, t2, timep^);
   if (t1.hours <> 9) or (t1.mins <> 59)  or (t1.secs <> 58) then begin
      pass := false;
      writeln( 'fail(7) time is ', t1.hours:2, ':', t1.mins:2, ':', t1.secs:2 );
   end;
   if (t2.hours <> 10) or (t2.mins <> 59)  or (t2.secs <> 58) then begin
      pass := false;
      writeln( 'fail(8) time is ', t2.hours:2, ':', t2.mins:2, ':', t2.secs:2 );
   end;
   if (timep^.hours <> 11) or (timep^.mins <> 59)  or (timep^.secs <> 58) then begin
      pass := false;
      writeln( 'fail(9) time is ', timep^.hours:2, ':',
              timep^.mins:2, ':', timep^.secs:2 );
   end;

   if not eof(f2) then begin
      { should be at eof }
      pass := false;
      writeln( 'fail: eof not found(1)' );
   end;

   {  read buffer variable from a file }
   rewrite(f2);
   rewrite( ftxt );
   writeln( ftxt, 4:3, 5:3, 6:3 );
   reset( ftxt );
   read( ftxt, f2^.hours, f2^.mins, f2^.secs );
   if (f2^.hours <> 4) or (f2^.mins <> 5)  or (f2^.secs <> 6) then begin
      pass := false;
      writeln( 'fail(9) time is ', f2^.hours:2, ':',
              f2^.mins:2, ':', f2^.secs:2 );
   end;

   rewrite(f2);
   if not eof( f2 ) then begin
      writeln( 'fail: eof should be true at start of empty file(2)' );
      pass := false;
   end;
   reset( f2 );

   { check file components as var parameters }
   p41( farray );


   { test dynamically allocated file variable }

   rewrite(f2);
   with timep^ do begin
         hours :=14;
         mins := 59;
         secs := 05;
      end;
   f2^ := timep^;
   with timep^ do begin
         hours :=00;
         mins := 00;
         secs := 00;
      end;
   put( f2 );
   for i := 12 to 23 do begin
      with f2^ do begin
         hours := i;
         mins := 15;
         secs := 30;
      end;
      put(f2);
   end; { for }
   reset(f2);
   timep^ := f2^;
   with timep^ do begin
      if (hours <> 14) or (mins <> 59) or (secs <> 05) then begin
         pass := false;
         writeln( 'put/get fails with pointer variable' );
      end;
   end;
   get( f2 );
   for i := 12 to 23 do begin
      with f2^ do begin
         if (hours <> i) or (mins <> 15) or (secs <> 30) then begin
            pass := false;
            writeln( 'fail(10) time is ', hours:2, ':', mins:2, ':', secs:2 );
         end;
      end;
      if not eof( f2 ) then
         get(f2);
   end; { for }
   if not eof(f2) then begin
      { should be at eof }
      pass := false;
      writeln( 'fail: eof not found(2)' );
   end;

   { now test read binary data }
   reset(f2);
   read( f2, timep^ );
   with timep^ do begin
      if (hours <> 14) or (mins <> 59) or (secs <> 05) then begin
         pass := false;
         writeln( 'put/get fails with pointer variable' );
      end;
   end;
   for i := 12 to 23 do begin
      if not eof( f2 ) then
         read( f2, timep^ )
      else begin
         writeln( 'fail: unexpected eof' );
         pass := false;
      end;
      with timep^ do begin
         if (hours <> i) or (mins <> 15) or (secs <> 30) then begin
            pass := false;
            writeln( 'fail(3) time is ', hours:2, ':', mins:2, ':', secs:2 );
         end;
      end;
   end; { for }
   if not eof(f2) then begin
      { should be at eof }
      pass := false;
      writeln( 'fail: eof not found(3)' );
   end;


   rewrite( f3 );
   with f3^ do begin
      i := 42;
      x := 3.5;
   end;
   put( f3 );
   reset( f3 );
   with f3^ do begin
      if (i <> 42) or (x <> 3.5) then begin
         pass := false;
         writeln( 'put/get failed with file of anonymous record' );
      end;
   end;

   rewrite( ftxt );
   for c := '0' to '9' do begin
      ftxt^ := c;
      put( ftxt );
   end;
   page( ftxt );

   reset( ftxt ); { this should put eoln at the end of the file (A) }
   page; writeln; { should go to output }

   if eof then begin
      {provided input is not redirected from a file}
      writeln( 'failed: eof on input should be false' );
      pass := false;
   end;

   i := 0;
   while not eof( ftxt ) do begin
      if i > 20 then begin
         writeln( 'eof failed' );
         pass := false;
         goto 99;
      end;
      if (i<=9) and (ftxt^ <> chr(i + ord('0'))) then begin
         pass := false;
         writeln( 'get failed: next ch is ''', ftxt^, ''', i is ', i:1 );
      end
      else if (i=11) and (ftxt^ <> chr(12)) then begin { assuming ascii }
         writeln( 'page test failed, chr is ', ord(ftxt^) );
         pass := false;
      end
      else if (i in [10,12]) and not eoln( ftxt ) then begin { see (A) above }
         pass := false;
         writeln( 'fail: eoln not found, i is ', i:1 );
      end;
      get( ftxt );
      i := i+1;
   end;
99:

   { test array of files and side effects }
   for i := 1 to nf do begin
      sideVar := i;
      rewrite( af[sideFun] );
      if sideVar <> i+1 then begin
         pass := false;
         writeln( 'rewrite fails: file variable has side effects' );
      end;
      sideVar := i;
      af[sideFun]^ := 10*i;
      if sideVar <> i+1 then begin
         pass := false;
         writeln( 'failed: file buffer assign has side effects' );
      end;
      sideVar := i;
      put( af[sideFun] );
      if sideVar <> i+1 then begin
         pass := false;
         writeln( 'put fails: file variable has side effects' );
      end;
      af[i]^ := 100*i;
      put( af[i] );
   end;

   for i := 1 to nf do begin
      sideVar := i;
      reset( af[sideFun] );
      if sideVar <> i+1 then begin
         pass := false;
         writeln( 'reset fails: file variable has side effects' );
      end;
      sideVar := i;
      if af[sideFun]^ <> 10*i then begin
         if sideVar <> i+1 then begin
            writeln( 'failed: file buffer access has side effects' );
         end
         else begin
            writeln( 'array of files get/put test 1 failed' );
         end;
         pass := false;
      end;
      sideVar := i;
      get( af[sideFun] );
      if sideVar <> i+1 then begin
         pass := false;
         writeln( 'get fails: file variable has side effects' );
      end;
      if af[i]^ <> 100*i then begin
         writeln( 'array of files get/put test 2 failed' );
         pass := false;
      end;
      sideVar := i;
      if eof( af[sideFun] ) then begin
         if sideVar <> i+1 then begin
            writeln( 'eof fails: file variable has side effects' );
         end
         else begin
            writeln( 'array of files eof test 1 failed' );
         end;
         pass := false;
      end;
      get( af[i] );
      if not eof( af[i] ) then begin
         writeln( 'array of files eof test 2 failed' );
         pass := false;
      end;
   end;

   { test read/write with an array of files }
   for i := 1 to nf do begin
      rewrite( af[i] );
      sideVar := i;
      write( af[sideFun], 10*i );
      if sideVar <> i+1 then begin
         writeln( 'write fails: file variable has side effects' );
         pass := false;
      end;

      write( af[i], 100*i );

      reset( af[i] );
      if af[i]^ <> 10*i then writeln ( 'xxx1');
      sideVar := i;
      read( af[sideFun], n );
      if sideVar <> i+1 then begin
         writeln( 'read fails: file variable has side effects' );
         pass := false;
      end;
      if n <> 10*i then begin
         writeln( 'array of files read/write test 1 failed n is ', n:1 );
         pass := false;
      end;
      if af[i]^ <> 100*i then writeln ( 'xxx2');
      read( af[i], n );
      if n <> 100*i then begin
         writeln( 'array of files read/write test 2 failed, n is ', n:1 );
         pass := false;
      end;
      if not eof( af[i] ) then begin
         writeln( 'array of files eof test 3 failed' );
         pass := false;
         get( af[i] );
         if not eof( af[i] ) then begin
            writeln( 'array of files eof test 4 failed' );
            pass := false;
         end;
      end;
   end;

   { test read & write for dynamically allocated data }

   { TODO: test eoln }

   { test write/writeln & read/readln }

   new(cp);
   rewrite( ftxt );
   writeln( ftxt, 13 );
   reset( ftxt );
   i := 0;
   n := 0;
   while not eoln(ftxt) do begin
      {writeln( 'char is ''', ftxt^, ''', (', ord(ftxt^), ')' );}
      if ftxt^ <> ' ' then
         n := n*10 + ord(ftxt^) - ord('0');
      get( ftxt);
      i := i + 1;
      if i > 30 then goto 98;
   end;
98:
   if n <> 13 then begin
      writeln( 'write integer failed');
      pass := false;
   end;

   { should now see eoln }
   if not eoln(ftxt) then begin
      writeln( 'failed: eoln expected(1)' );
      pass := false;
   end
   else if ftxt^ <> ' ' then begin
      writeln( 'failed: '' '' expected at eoln, found ''', ftxt^, '''' );
      pass := false;
   end;
   if not eoln(ftxt) then begin
      writeln( 'failed: eoln expected(1a)' );
      pass := false;
   end
   else if ftxt^ <> ' ' then begin
      writeln( 'failed: '' '' expected at eoln(2), found ''', ftxt^, '''' );
      pass := false;
   end;

   get( ftxt ); { advance past \n char, now sb at eof }
   if not eof(ftxt) then begin
      writeln( 'failed: eof expected(1)' );
      pass := false;
   end;


   rewrite( ftxt );
   writeln( ftxt, 105:5, 6.25:6:2 );
   write( ftxt, 'zyxwvutsrqponmlkjihgfedcba' );
   reset( ftxt );   { this should add an eoln }

   read( ftxt, i, x );
   if x <> 6.25 then begin
      writeln( 'read real failed');
      pass := false;
   end;
   if i <> 105 then begin
      writeln( 'read integer failed');
      pass := false;
   end;

   if eoln(ftxt) then
      readln( ftxt)
   else begin
      pass := false;
      writeln( 'fail: eoln expected (2)' );
   end;

   { test read & get cooperation }
   if ftxt^ <> 'z' then begin
      writeln( 'fail: readln leaves file at wrong position, (', ftxt^:1, ')');
      pass := false;
   end;

   read( ftxt, cp^ );
   if cp^ <> 'z' then begin
      writeln( 'read char failed (', cp^, ')' );
      pass := false;
   end;

   get( ftxt );  { skip 'y' }
   read( ftxt, cp^ );
   if cp^ <> 'x' then begin
      writeln( 'read char failed, expected ''x'', found (', cp^, ')' );
      pass := false;
   end;

   while not eoln( ftxt ) do begin
      { a is last char in the line - if it has been read then eol must be true }
      if c = 'a' then begin
         pass := false;
         writeln( 'fail: eoln not found' );
         goto 97;
      end;
      read( ftxt, c );
   end;
97:
   if eof( ftxt ) then begin
      pass := false;
      writeln( 'fail: eof not expected at end of line' );
   end;
   if ftxt^ <> ' ' then begin
      pass := false;
      writeln( ''' '' expected at end of line (1), found ''', ftxt^, '''' );
   end;
   read( ftxt, c );
   if c <> ' ' then begin
      pass := false;
      writeln( ''' '' expected at end of line (2), found ''', c, '''' );
   end;
   if not eof( ftxt ) then begin
      pass := false;
      writeln( 'fail: eof expected at end of file' );
   end;

   reset( ftxt );
   readln( ftxt ); { skip first line }
   read( ftxt, c, cp^ );
   if (c <> 'z') and (cp^ <> 'y') then begin
      writeln( 'readln failed (', c, cp^, ')' );
      pass := false;
   end;

   { test readln, readln(a, skip) readln(a,b,skip)
           read(a), read(a, skip) read (a,b,skip)
           with & without buffer flag set
           then same again for binary

   }
   rewrite( ftxt );
   for i := 0 to 99 do begin
      writeln( ftxt, '#', i:2, ';0123456789' );
   end;
   reset( ftxt );
   readln( ftxt );
    { check that access to buffer does not affect next read }
   if ftxt^ <> '#' then begin
      pass := false;
      writeln( 'readln failed' );
   end;
   readln( ftxt, c );
   if c <> '#' then begin
      writeln( 'readln failed, expected #, found ', c );
      pass := false;
   end;
   get( ftxt ); { skip leading '#' }
   readln( ftxt, n, c );
   if (n <> 2) or (c <> ';') then begin
      writeln( 'readln failed, expected 2, '';'', found ', n:1, ' ''', c, '''' );
      pass := false;
   end;

   while pass and not eof( ftxt ) do begin
      read( ftxt, c1, n, c );
      read( ftxt, c );
      if c <> '0' then begin
         pass := false;
         writeln( 'read failure(4), ''', c, '''' );
      end;
      while pass and not eoln( ftxt ) do begin
         read( ftxt, c1 );
         if c1 <> succ(c) then begin
            pass := false;
            writeln( 'read failure(4), ''', c, '''' );
         end;
         c := c1;
      end;
      readln( ftxt );
   end;

   { test reset/rewrite/get/put/buffer access, read/write/eof/eoln
     for dynamically allocated file variable }
   new( ptext );
   rewrite( ptext^ );
   ptext^^ := 'A';
   put( ptext^ );
   writeln( ptext^, 13, ' ', 130.25, 'Z' );
   reset( ptext^ );
   read( ptext^, c, i, ax[1] );
   if (c<>'A') or (i<>13) or (ax[1] <> 130.25) then begin
      write( 'failed on access to dynamically allocated file variable' );
      writeln( ' c is ''', c, ''', i is ', i, ', x is ', ax[1] );
      pass := false;
   end;
   if ptext^^ <> 'Z' then begin
      writeln( 'failed on access to dynamically allocated file variable(2)' );
      pass := false;
   end;
   get( ptext^ );
   if not eoln( ptext^ ) then begin
      writeln( 'failed on access to dynamically allocated file variable(3)' );
      pass := false;
   end;
   get( ptext^ );
   if not eof( ptext^ ) then begin
      writeln( 'failed on access to dynamically allocated file variable(4)' );
      pass := false;
   end;

   new( fileTypep );
   rewrite( fileTypep^ );
   fileTypep^^ := 12;
   put( fileTypep^ );
   write( fileTypep^, 130, 999 );

   reset( fileTypep^ );
   if fileTypep^^ <> 12 then begin
      writeln( 'failed on access to dynamically allocated binary file variable(1)' );
      pass := false;
   end;
   read( fileTypep^, i, j );
   if (i<>12) or (j<> 130) then begin
      write( 'failed on access to dynamically allocated binary file variable(2)' );
      writeln( '  i is ', i, ', j is ', j );
      pass := false;
   end;
   if fileTypep^^ <> 999 then begin
      writeln( 'failed on access to dynamically allocated binary file variable(3)' );
      pass := false;
   end;
   get( fileTypep^ );
   if not eof( fileTypep^ ) then begin
      writeln( 'failed on access to dynamically allocated binary file variable(4)' );
      pass := false;
   end;

   dispose( fileTypep );
   dispose( ptext );

   dispose(timep);
   dispose(cp);
end; {p40}


begin {p4}
   pass := true;

   output^ := 't';
   put( output );
   writeln( 'esting file operations' );

   {use this only when running interactively}
#if defined TEST_STDIN
   writeln( 'testing input^: type a char + space then an integer + return' );
   c := input^;   get(input);
   writeln( 'you typed ''', c, ''', input^ is''', input^, '''' );
{   writeln( 'testing read: type integer + return' );}
   read(i);
   writeln( 'you typed ''', i:1, '''' );
   readln;
   writeln('now type a real number...');
   readln(x);
   writeln( 'you typed ''', x, '''' );   
#endif

   p40;

   { file close tests - pass or fatal error }
   write( 'checking file close ' );
   check;

   if wkFiles > nrFiles then
      writeln('test skipped - test assumes nr allowed open files > ', wkFiles:1)
   else begin
      for i := 1 to 3*nrFiles div wkFiles do p42; { fails unless files are closed }
      check; { this will fail if some files were not closed }
      write( '... block return OK' );
   end;

   p43;
   write( ' ... goto OK' );
   writeln;

   p44;
   check;
   p45;         {TODO: should also check wkFiles limit}
   check;

   p46;
   p47;
   p48;


   if pass then
      writeln( 'files tests passed' )
   else
      writeln( 'files tests failed' );
   writeln;

end; { p4 }


{ test arrays and records, including with statement }
procedure p5;
const
   lo1    = 20;
   hi1    = 29;
   lo2    = 0;
   hi2    = 9;

type
   { TODO: types need to be in correct order for pointers }
   p1        = ^tvr;
   tColour   = (white, red, orange, yellow, green, blue);
   item      = (widgets, wadgets, wedgets, wodgets, wudgets);
   inventory =  array[item] of integer;

   tenInts   = array[lo1..hi1] of integer;
   pdate     = ^date;
   date      = record
                  month    : 1 ..12;
                  year     : integer;
                  status   : record
                                 good     : boolean;
                                capacity : 0..100;
                             end;
                  sales    : inventory;
               end;

   { check cases like a,b,c,d: char; use next field as well }
   tvr = record
         ai            : integer;
         case t       : tColour of
           red, white : ( bb: boolean;
                          a,b,c,d: char;);
           yellow : ( x : real );
           blue, green : (s: tenInts;
                   case integer of
                   1: ( q1: integer );
                   2: ( str: packed array[1..6] of char; );
                   3: ( c1,c2: (club, heart, diamond, spade) );
                   );
         end;

   tavr = array[0..0] of tvr;

   two = (a,b);

var
   a1    : tenInts;
   a2    : array[lo2..hi2] of tenInts;
   i,j,k : integer;
   ii    : item;
   pass  : boolean;
   pass1 : boolean;
   date1 : date;
   date2 : array[tColour] of date;
   date3 : array[tColour] of pdate;

   emptyRecord :record
                end;
{
   emptyRecord1 :record
          ;
                 end;
}
   vr  :  tvr;
   pvr : ^tvr;
   pavr: ^tavr;

   vr1 : record
         case t       : tColour of
           red, white : ( bb: boolean;
                          a,b,c,d: char;);
           yellow : ( x : real );
           blue, green : (s: tenInts;
                   case integer of
                   1: ();
                   2: ( str: packed array[1..6] of char; );
                   );
         end;

   vr2 : record
         case tColour of
           red, white : (case b: boolean of true: (a: real) );
           yellow : ( c : char );
           blue, green : (
                   case integer of
                   1: ( q1: integer );
                   2: ( str: packed array[1..6] of char;
                          case z: boolean of
                            true: (f, e: boolean);
                            false: ()
                       )
                   );
         end;

   apr1  : tR1;  { array of packed record }
   f : file of tR1;

   packedRec : packed record
                case tagfield : two of
                   a: (n: integer);
                   b: (i,j,k : 0..9;
                       q:      -8..7;
                       pad: 0..65535)
             end;


   cprop  : array[char] of record
               isSpace, isUpper, isNum   : boolean;
            end;


{ record tests}
procedure p50;

const
   n =  77;
var
   i     : integer;
   c     : char;
   ra,rb : record
             ma,mb : packed array[1..6] of boolean;
             mc,md : array[1..6] of ^real;
             p1,p2 : ^tenInts;
           end;

function testInventory(ai : inventory ): boolean;
begin
   testInventory := (ai[widgets] = 990) and
                    (ai[wadgets] = 991) and
                    (ai[wedgets] = 992) and
                    (ai[wodgets] = 993) and
                    (ai[wudgets] = 994)
end; { testInventory }

procedure setInventory(var ai : inventory );
begin
   ai[widgets] := 990;
   ai[wadgets] := 991;
   ai[wedgets] := 992;
   ai[wodgets] := 993;
   ai[wudgets] := 994;
end; { setInventory }

begin { p50 }

   with ra do begin
      for i := 1 to 6 do
         ma[i] := odd( n mod i );
      mb := ma;
   end;

   rb := ra;
   for i := 1 to 6 do
      if rb.mb[i] <> odd( n mod i ) then begin
         pass := false;
         writeln( 'member group var copy failed (1), i is ', i:1 );
      end;

   new(rb.p2);
   new(rb.p1);
   for i := lo1 to hi1 do
      rb.p2^[i] := i-3;
   ra.p1 := rb.p2;
   rb.p1^ := ra.p1^;

   for i := lo1 to hi1 do
      if ra.p1^[i] <> i-3 then begin
         pass := false;
         writeln( 'member group var copy failed (2), i is ', i:1 );
      end;
   for i := lo1 to hi1 do
      if rb.p1^[i] <> i-3 then begin
         pass := false;
         writeln( 'member group var copy failed (2), i is ', i:1 );
      end;
   dispose(ra.p1);
   dispose(rb.p1);

   for i := 1 to 6 do begin
      new(rb.mc[i]);
      rb.mc[i]^ := 9.5+i;
   end;
   ra.md := rb.mc;
   for i := 1 to 6 do begin
      if ra.md[i]^ <> i + 9.5 then begin
         pass := false;
         writeln( 'member group var copy failed (3), i is ', i:1 );
      end;
      dispose( ra.md[i] );
   end;

   vr.t := blue;
   vr.c1 := heart;
   vr.c2 := vr.c1;
   if vr.c2 <> heart then begin
      pass := false;
      writeln( 'variant member group copy failed (1), c2 is ', ord(c2):1 );
   end;

   with vr do begin
      t := blue;
      c2 := spade;
      c1 := pred(c2);
      if c1 <> diamond then begin
         pass := false;
         writeln( 'variant member group copy failed (2), c2 is ', ord(c2):1 );
      end;
   end;

   with vr, date1 do begin
      ai := 12345;
      t := red;
      bb := true;
      a := 'B';
      b := 'U';
      c := 'Z';
      d := 'Z';
      t := white;

      month := 3;
      year := 1903;
      setInventory( sales );
      status.good := true;
      status.capacity := 92;

   end;

   { setting values in one variant should obliterate values in other variants }
   if vr.bb <> true then
      pass1 := false;
   if vr.a <> 'B' then
      pass1 := false;
   if vr.b <> 'U' then
      pass1 := false;
   if vr.c <> 'Z' then
      pass1 := false;
   if vr.d <> 'Z' then
      pass1 := false;

   if not pass1 then begin
      writeln( 'record access tests failed' );
      pass := false;
   end;

   pass1 := true;
   vr.t :=yellow;
   vr.x := 1.625;
   if vr.x <> 1.625 then
      pass := false;
   vr.t := white;
   if (vr.bb = true) and (vr.a = 'B') and (vr.b = 'U')
      and (vr.c = 'Z') and (vr.d = 'Z') then
      pass := false;

   vr.t :=blue;
   for i := lo1 to hi1 do begin
      vr.q1 := i;
      vr.s[vr.q1] := -4*vr.q1;
   end;
   vr.str := 'string';
   if vr.ai <> 12345 then
      pass := false;
   vr.t :=yellow;
   if vr.x = 1.625 then
      pass := false;

   if not pass1 then begin
      writeln( 'variant record tests fail' );
      pass := false;
   end;

   { test access to array of anonymous records }
   for c := chr(0) to chr(255) do begin
      with cprop[c] do begin
         isUpper := (c>='A') and (c<='Z');
         isSpace := c <= ' ';
         isNum := (c>='0') and (c<='9');
      end;
   end;

   for c := 'Z' downto 'A' do
      if not cprop[c].isUpper or cprop[c].isSpace or cprop[c].isNum then begin
         writeln( 'with access to anonymous records failed(1)' );
         pass := false;
      end;
   for c := chr(0) to ' ' do
      if cprop[c].isUpper or not cprop[c].isSpace or cprop[c].isNum then begin
         writeln( 'with access to anonymous records failed(2)' );
         pass := false;
      end;
   for c := '0' to '9' do
      if cprop[c].isUpper or cprop[c].isSpace or not cprop[c].isNum then begin
         writeln( 'with access to anonymous records failed(3)' );
         pass := false;
      end;


   date2[yellow] := date1;


   date2[blue].sales := date1.sales;
   date2[blue].status.good := false;
   date2[blue].status.capacity := 32;
   date2[green].status := date2[blue].status;
   if date2[yellow].year <> 1903 then begin
      writeln( 'record access 1 failed' );
      pass := false;
   end;
   if date2[yellow].month <> 3 then begin
      writeln( 'record access 2 failed' );
      pass := false;
   end;
   if date2[yellow].sales[wodgets] <> 993 then begin
      writeln( 'record access 3 failed' );
      pass := false;
   end;
   if date2[yellow].status.good <> true then begin
      writeln( 'record access 4 failed' );
      pass := false;
   end;
   if date2[yellow].status.capacity <> 92 then begin
      writeln( 'record access 5 failed' );
      pass := false;
   end;
   if date2[green].status.good <> false then begin
      writeln( 'record access 6 failed' );
      pass := false;
   end;
   if date2[green].status.capacity <> 32 then begin
      writeln( 'record access 7 failed' );
      pass := false;
   end;

   with date2[blue] do begin
      if status.good <> false then begin
         writeln( 'record access 8 failed' );
         pass := false;
      end;
      if status.capacity <> 32 then begin
         writeln( 'record access 9 failed' );
         pass := false;
      end;
      if not testInventory(sales) then begin
         writeln( 'record access 10 failed' );
         pass := false;
      end;
   end; {with}


   new( date3[yellow] ); new( date3[green] ); new( date3[blue] );

   date3[yellow]^ := date1;
   date3[blue]^.sales := date1.sales;
   date3[blue]^.status.good := false;
   date3[blue]^.status.capacity := 32;
   date3[green]^.status := date3[blue]^.status;
   if date3[yellow]^.year <> 1903 then begin
      writeln( 'date3 record access 1 failed' );
      pass := false;
   end;
   if date3[yellow]^.month <> 3 then begin
      writeln( 'date3 record access 2 failed' );
      pass := false;
   end;
   if date3[yellow]^.sales[wodgets] <> 993 then begin
      writeln( 'date3 record access 3 failed' );
      pass := false;
   end;
   if date3[yellow]^.status.good <> true then begin
      writeln( 'date3 record access 4 failed' );
      pass := false;
   end;
   if date3[yellow]^.status.capacity <> 92 then begin
      writeln( 'date3 record access 5 failed' );
      pass := false;
   end;
   if date3[green]^.status.good <> false then begin
      writeln( 'date3 record access 6 failed' );
      pass := false;
   end;
   if date3[green]^.status.capacity <> 32 then begin
      writeln( 'date3 record access 7 failed' );
      pass := false;
   end;

   with date3[blue]^ do begin
      if status.good <> false then begin
         writeln( 'date3 record access 8 failed' );
         pass := false;
      end;
      if status.capacity <> 32 then begin
         writeln( 'date3 record access 9 failed' );
         pass := false;
      end;
      if not testInventory(sales) then begin
         writeln( 'date3 record access 10 failed' );
         pass := false;
      end;
   end; {with}

   dispose( date3[yellow] ); dispose( date3[green] ); dispose( date3[blue] );



   vr1.t := red;
   vr1.a := '1'; vr1.b := '2'; vr1.c := '3'; vr1.d := '4';
   vr1.bb := true;
   vr1.t := white;
   if (vr1.a <> '1') or (vr1.b <> '2') or (vr1.c <> '3') or (vr1.d <> '4') or
            not vr1.bb then begin
     pass := false;
     writeln( 'fail: access variant record (1)' );
   end;

   vr1.t := yellow;
   vr1.x := 3.0; { this should overwrite red/white variant }
   vr1.t := white;
   if (vr1.a = '1') and (vr1.b = '2') and (vr1.c = '3') and (vr1.d = '4') and
         vr1.bb then begin
     pass := false;
     writeln( 'fail: variant record (1)' );
   end;

   vr1.t := blue;
   vr1.str := 'piston';
   for i := lo1 to hi1 do
      vr1.s[i] := 13*i;
   vr1.t := yellow;
   if vr1.x = 3.0 then begin
     pass := false;
     writeln( 'fail: variant record (2)' );
   end;
   vr1.t := green;
   pass1 := vr1.str = 'piston';
   for i := lo1 to hi1 do
      pass1 := pass1 and (vr1.s[i] = 13*i);
   if not pass1 then begin
     pass := false;
     writeln( 'fail: access variant record (2)' );
   end;

   vr2.c := '4';
   vr2.b := true;
   vr2.a := 3.14;
   if vr2.c = '4' then begin
      writeln( 'variant access failed (first field test 1)' );
      pass := false;
   end;
   vr2.q1 := 42;
   vr2.str := 'pencil';
   vr2.z := true;
   vr2.e := true;
   vr2.f := false;
   if (vr2.q1 = 42) or (vr2.str <> 'pencil')
      or not vr2.z or not vr2.e or vr2.f
   then begin
      writeln( 'variant access failed (first field test 2)' );
      pass := false;
   end;

   { test packed record }
   with apr1[0] do begin
      guard := 0;
      b1 := true;
      b2 := not b1;
      if b2 then
         e3 := oak
      else
         e3 := ash;
      e4 := pear;
      ii1 := 0;
      ii2 := -1;
      for i := 0 to 12 do begin
         ii0 := i+3;
      end;
      if ii1 <> 0 then b1 := false;
      if ii2 <> -1 then b1 := false;
      e3 := succ(e3);
      e4 := pred(e4);
      v1 := -49;
      v2 := 24;
   end; { with apr1 }
   with apr1[1] do begin
      guard := -1;
      b1 := false;
      b2 := not b1;
      if b2 then
         e3 := oak
      else
         e3 := ash;
      e4 := pear;
      ii1 := -1;
      ii2 := 0;
      for i := 18 downto 6 do begin
         ii0 := i-3;
      end;
      if ii1 <> 0 then b1 := false;
      if ii2 <> -1 then b1 := false;
      e3 := succ(e3);
      e4 := pred(e4);
      v1 := -13;
      v2 := 35;
   end; { with apr1 }

   rewrite(f);
   write(f, apr1);
   reset(f);
   read(f, apr1);

   with apr1[0] do begin
      if guard <> 0 then begin
         pass := false;
         writeln( 'fail: packed record[0] (guard)' );
      end;
      if not b1 then begin
         pass := false;
         writeln( 'fail: packed record[0] (b1)' );
      end;
      if b2 then begin
         pass := false;
         writeln( 'fail: packed record[0] (b2)' );
      end;
      if ii1 <> 0 then begin
         pass := false;
         writeln( 'fail: packed record[0] (ii0)' );
      end;
      if ii2 <> -1 then begin
         pass := false;
         writeln( 'fail: packed record[0] (ii1)' );
      end;
      if e3 <> oak  then begin
         pass := false;
         writeln( 'fail: packed record[0] (e3)' );
      end;
      if e4 <> grape then begin
         pass := false;
         writeln( 'fail: packed record[0] (e4)' );
      end;
      if v1 <> -49 then begin
         pass := false;
         writeln( 'fail: packed record[0] (v1)' );
      end;
      if v2 <> 24  then begin
         pass := false;
         writeln( 'fail: packed record[0] (v2)' );
      end;

   end; { with apr1 }
   with apr1[1] do begin
      if guard <> -1 then begin
         pass := false;
         writeln( 'fail: packed record[1] (guard)' );
      end;
      if b1 then begin
         pass := false;
         writeln( 'fail: packed record[1] (b1)' );
      end;
      if not b2 then begin
         pass := false;
         writeln( 'fail: packed record[1] (b2)' );
      end;
      if ii1 <> -1 then begin
         pass := false;
         writeln( 'fail: packed record[1] (ii0)' );
      end;
      if ii2 <> 0 then begin
         pass := false;
         writeln( 'fail: packed record[1] (ii1)' );
      end;
      if e3 <> birch  then begin
         pass := false;
         writeln( 'fail: packed record[1] (e3)' );
      end;
      if e4 <> grape then begin
         pass := false;
         writeln( 'fail: packed record[1] (e4)' );
      end;
      if v1 <> -13 then begin
         pass := false;
         writeln( 'fail: packed record[1] (v1)' );
      end;
      if v2 <> 35  then begin
         pass := false;
         writeln( 'fail: packed record[1] (v2 is ', v2:1, ')' );
      end;
   end; { with apr1 }

   { NOTE: this test assumes a known overlay of i,j,k,l over n }
   with packedRec do begin
      tagfield:=a;
      n := 5 + 16*6 + 256*7 + (4096)*24;
      tagfield:=b;
      if (i <> 5) or (j <> 6) or (k <> 7) or (q <> -8) then begin
         pass := false;
         writeln( 'packing test fails',
                  ', i is ', i:1, ', j is ', j:1,
                  ', k is ', k:1, ', q is ', q:1 );
      end;
   end; {with}


   { now test for dynamic record }
   pass1 := true;
   new( pavr );
   with pavr^[0] do begin
      ai := 12345;
      t := red;
      bb := true;
      a := 'B';
      b := 'U';
      c := 'Z';
      d := 'Z';
      t :=yellow;
      x := 1.625;
      if x <> 1.625 then
         pass1 := false;
      t := white;
      if (bb = true) and (a = 'B') and (b = 'U')
         and (c = 'Z') and (d = 'Z') then
         pass1 := false;

      t :=blue;
      for i := lo1 to hi1 do begin
         q1 := i;
         s[q1] := -4*q1;
      end;
      str := 'string';
      if ai <> 12345 then
         pass1 := false;
      t :=yellow;
      if x = 1.625 then
         pass1 := false;
   end;

   pavr^[0].t := blue;
   if pavr^[0].str <> 'string' then
      pass1 := false;
   pavr^[0].t := green;
   pavr^[0].str := 'BIGCAT';
   with pavr^[0] do
      if str <> 'BIGCAT' then
         pass1 := false;

   if not pass1 then begin
      writeln( 'with statement fails for variant record' );
      pass := false;
   end;

   dispose( pavr );

   { test access of dynamic memory using second form of new }
   new( pvr, red );
   with pvr^ do begin
      ai := 12345;
      t := red;
      bb := true;
      a := 'B';
      b := 'U';
      c := 'Z';
      d := 'Z';
   end;

   pass1 := true;
   if pvr^.bb <> true then
      pass1 := false;
   if pvr^.a <> 'B' then
      pass1 := false;
   if pvr^.b <> 'U' then
      pass1 := false;
   if pvr^.c <> 'Z' then
      pass1 := false;
   if pvr^.d <> 'Z' then
      pass1 := false;
   dispose( pvr, red );
   if not pass1 then
      writeln( 'record access tests failed' );

end; { p50 }


{ conformant array tests }
function p58 : boolean;
const
   alo = 11;
   ahi = 19;
   aalo = 3;
   aahi = 7;
   key = -29;
   key2 =  13;
type
   smallInt = 0..9;
   arrType  = array[alo..ahi] of real;
   testRec  = record
                 a1 : array[1..9] of real;
                 a2 : array[1..3, 21..23] of real;
              end;

var
   i    : integer;
   x    : real;
   c    : char;
   a    : arrType;
   aa   : array[aalo..aahi] of arrType;
   xaa  : array[aalo..aahi] of real;
   f    : file of arrType;
   p    : ^arrType;
   r    : testRec;
   ar   : array[5..9] of testRec;
   ia1  : array[-90..-80] of integer;
   ia2  : array[ 90..110] of integer;
   a2d  : array[ 'a'..'z', 1..12] of integer;
   a2dp : array[ 'a'..'z'] of packed array[1..12] of integer;

   ca1, ca2 : array['0'..'9'] of real;

   pass, b : boolean;


{ take a conformant array of real numbers,
  compute chcksum and compare with xsum, the expected value }
function check(aa : array[lo..hi : integer] of real;
               xsum, key: real ) : boolean;
const
   trace =  false;
var
   i : integer;
   s : real; { computed checksum }
begin
   if trace then begin
      writeln; writeln( 'lo is ', lo:1, ' , hi is ', hi:1 );
   end;
   s := key;
   for i := lo to hi do begin
      if trace then writeln( 'aa[', i:1, '] is ', aa[i]:1:2 );
      s := s + aa[i]*i;
   end; {for}

   check := abs(s-xsum) < 0.001;

end; { check }


procedure seta(var aa   : array[lo..hi : integer] of real;
               var xsum : real; key: real );
var
   i : integer;
   s : real; { computed checksum }

begin
   s := key;
   for i := lo to hi do begin
      aa[i] := (hi-i)+0.5;
      s := s + aa[i]*i;
   end; {for}
   xsum := s;
end; { seta }


{ set an integer array to known values }
procedure iset(var a : array[lo..hi : integer] of integer; k : integer );
var
   i : integer;
begin
   for i := lo to hi do
      if i = lo then   a[i] := k+lo
      else if i = lo+1 then   a[i] := a[i-1]+1
      else a[i] := (a[i-1] + a[i-2]) mod (maxint div 2);
end; { iset }


{ check if an integer array contains known values }
function icheck(a : array[lo..hi : integer] of integer; k :integer ) : boolean;
var
   i  : integer;
   ok : boolean;
begin
   for i := lo to hi do
      if i = lo then ok := a[i] = k+lo
      else if (i = lo+1) and ok then ok := a[i] = a[i-1]+1
      else if ok then ok := a[i] = (a[i-1] + a[i-2]) mod (maxint div 2);
   icheck := ok;
end; { icheck }


function p587(ar : array[lo..hi :integer] of testRec ): boolean; forward;

procedure p581(var a1 : array[lo1..hi1 : integer] of integer;
                   a2 : array[lo2..hi2 : integer] of integer );

procedure p5812(var a1 : array[lo1..hi1 : integer] of integer;
                    a2 : array[lo2..hi2 : integer] of integer );
begin
   if not icheck( a2, key ) then begin
      pass := false;
      writeln( 'p5812: conformant array value param fails,',
              'lo is ', lo2:1, ', hi is ', hi2:1 );
   end;
   iset( a1, key );
end; { p5812 }

procedure p5813(var a1 : array[lo1..hi1 : integer] of integer;
                    a2 : array[lo2..hi2 : integer] of integer );
begin
   { check if a2 has correct values, set a1 }
   if not icheck( a2, key ) then begin
      pass := false;
      writeln( 'p5813: conformant array value param fails (2),',
              'lo is ', lo2:1, ', hi is ', hi2:1 );
   end;
   if not icheck( a1, key ) then begin
      pass := false;
      writeln( 'p5813: conformant array var param fails (2),',
              'lo is ', lo1:1, ', hi is ', hi1:1 );
   end;
   iset( a1, key2 );
end; { p5813 }

begin {p581}
   p5812( a1, a2 );
   p5813( a2, a1 );
   if not icheck( a2, key2 ) then begin
      pass := false;
      writeln( 'conformant array value param fails,',
              'lo is ', lo2:1, ', hi is ', hi2:1 );
   end;
end; { p581 }


procedure set2d( var aa : array[c1..c2 : char; lo..hi:integer] of integer );
var
   c : char;
   i : integer;
begin
   for c := c1 to c2 do
      for i := lo to hi do
         aa[c,i] := key*ord(c) + key2*i;
end; { set2d }


function p582(aa : array[aa0..aa1 :integer] of arrType;
              x  : array[x0..x1 :integer] of real ) : boolean;
var
   i  : integer;
   ok : boolean;
begin
   ok := true;
   if aa0 <> x0 then begin
      writeln( 'p582: array and xsum low bound must match' );
      ok := false;
   end;
   if aa1 <> x1 then begin
      writeln( 'p582: array and xsum high bound must match' );
      ok := false;
   end;

   for i := aa0 to aa1 do begin
      if not check( aa[i], x[i], i ) then begin
         writeln( 'fail: conformant array of fixed array' );
         ok := false;
      end;
   end; {for}

   p582 := ok;
end; { p582 }

function p583(aa0 : array[c01..c02 : char; lo0..hi0:integer] of integer ) : boolean;
type
   fixed =  array[0..9] of integer;

var
   ok    : boolean;
   i     : integer;
   mixed : array['0'..'9'] of fixed;

function p5831(aa : array[c1..c2 : char; lo..hi:integer] of integer;
               s  : packed array[s0..s1 :integer] of char ) : boolean;
var
   ok : boolean;
   c : char;
   i : integer;
begin
   ok := true;
   for c := c1 to c2 do
      for i := lo to hi do
         if aa[c,i] <> key*ord(c) + key2*i then begin
            if ok then
               writeln( 'fail: conformant 2d array, [', c, ',', i:1, ']' );
            ok := false;
         end;

   if not ok then begin
      for i := s0 to s1 do
         write(s[i]);
      writeln;
   end;

   p5831 := ok;
end; { p5831 }

function p5832(var aa : array[c1..c2 : char; lo..hi:integer] of integer ) : boolean;
var
   s : packed array[1..42] of char;
begin
   set2d( aa );
   s := 'conformant array actual param is var param';
   p5832 := p5831( aa, s );
end; { p5832 }

function p5833( aa : array[c1..c2 :char] of fixed;
                s  : packed array[s0..s1 :integer] of char ): boolean;
begin
   p5833 := p5831(aa, s)
end; { p5833 }

begin {p583}
   ok := true;
   if not p5832(aa0) then begin
      writeln( 'fail, p583: passing 2d array as var param' );
      ok := false;
   end;
   if not p5831(aa0, 'conformant array actual param is value param' ) then begin
      writeln( 'fail, p583: passing 2d array as value param' );
      ok := false;
   end;
   set2d(mixed);
   if not p5833(mixed, 'conformant array of fixed array' ) then begin
      writeln( 'fail, p583: passing 2d array as value param' );
      ok := false;
   end;

   { copy a vector inside a 2d array & from one row to another }
   aa0[c01] := aa0[c02];
   for i := lo0 to hi0 do
      if aa0[c01,i] <> key*ord(c02) + key2*i then begin
         if ok then
            writeln( 'fail: row copy of conformant array, [',
                      c01, ',', i:1, ']' );
         ok := false;
      end;

   iset( aa0[c01], key );
   p581( aa0[succ(c01)], aa0[c01] );
   if not icheck( aa0[succ(c01)], key ) then begin
      writeln( 'p583 fail: pass row of conformant array' );
      ok := false;
   end;

   p583 := ok;

end; { p583 }

procedure p584(var a1, a2 : array[c0..c1 : char] of real );
var
   c : char;
begin
   a2 := a1; { copy items in same group }
   for c := c0 to c1 do
      if a2[c] - 1 <> sqr(ord(c) - ord('0')) then begin
         pass := false;
         writeln( 'p584 fail: conformant arrays in a parameter group' );
      end; {if}
end; { p584 }

function p585(function f(aa0 : array[c01..c02 : char; lo0..hi0:integer] of integer):boolean;
              aa0 : array[c01..c02 : char; lo0..hi0:integer] of integer ): boolean;
begin
   if f(aa0) then begin
      p585 := true;
   end
   else begin
      writeln('conformant array in function parameter fails');
      p585 := false;
   end;
end; { p585 }


function p586(aa : array[ lo1c..hi1c:char; lo1..hi1:integer] of integer;
              aap: array[ lo2c..hi2c:char] of
                       packed array[lo2..hi2:integer] of integer
              ) : boolean;
var
   pass : boolean;
   c    : char;
   i    : integer;

{ test pack/unpack for var conformant array,
  return ap[i] = 2001*i }
function p5861(var ap: packed array[lo..hi:integer] of integer): boolean;
var
   a0 : array[12..28] of integer;
   a1 : array[12..28] of integer;
   i  : integer;
begin
   pass := true;

   for i := 12 to 28 do
      a1[i] := 2001*(hi-28+i);
   pack(a1, 28-hi+lo, ap);  { fill ap from a1[17..28] }

   for i := lo to hi do
      if ap[i] <> 2001*i then begin
         pass := false;
         writeln( 'p5861 fail: pack var conformant array, i is ', i:1 );
      end;

   for i := 12 to 28 do a0[i] := -1;
   unpack(ap, a0, 12);

   for i := 12 to 28 do
      if i <= 12 + hi - lo then begin
         if a0[i] <> 2001*(lo+i-12) then begin
            pass := false;
            writeln( 'p5861 fail: unpack var conformant array, a0[', i:1, '] is ', a0[i]:1 );
         end
      end
      else
         if a0[i] <> -1 then begin
            pass := false;
            writeln( 'p5861 fail: unpack var conformant array, a0[', i:1, '] is ', a0[i]:1 );
         end;

   p5861 := pass;
end; { p5861 }

{ test pack/unpack for value conformant array,
  on entry, a[i] = 2001*i }
function p5862(a: array[lo..hi:integer] of integer): boolean;
var
   { we know that a[lo..hi] = a[1..12] }
   ap0 : packed array[12..18] of integer;
   i  : integer;
begin
   pass := true;

   pack(a, hi-6, ap0);  { fill ap0 from top part of a[] }

   for i := 12 to 18 do
      if ap0[i] <> 2001*(i-18+hi) then begin
         pass := false;
         writeln( 'p5862 fail: pack value conformant array, a[', i:1, '] is ', a[i]:1 );
      end;

   for i := 12 to 18 do ap0[i] := 100+i;
   unpack(ap0, a, lo);

   for i := lo to hi do
      if i <= lo+6 then begin
         if a[i] <> 112+i-lo then begin
            pass := false;
            writeln( 'p5862 fail: unpack var conformant array, a[', i:1, '] is ', a[i]:1 );
         end
      end
      else
         if a[i] <> 2001*i then begin
            pass := false;
            writeln( 'p5862 fail: unpack value conformant array, a[', i:1, '] is ', a[i]:1 );
         end;

   p5862 := pass;
end; { p5862 }

begin
   pass := true;
   for c:= lo1c to hi1c do begin
      for i := lo1 to hi1 do
         aa[c,i] := ord(c)*100 + i;
      pack( aa[c], lo1, aap[c] );
   end; {for}

   for c:= lo1c to hi1c do for i := lo1 to hi1 do
      if aap[c,i] <> ord(c)*100 + i then begin
         pass := false;
         writeln('fail: packing conformant array, c is ', c:1, ', i is ', i:1 );
      end;

   for c:= lo1c to hi1c do begin
      for i := lo1 to hi1 do
         aap[c,i] := ord(c) - 100*i;
      unpack( aap[c], aa[c], lo1 );
   end; {for}

   for c:= lo1c to hi1c do for i := lo1 to hi1 do
      if aa[c,i] <> ord(c) - 100*i then begin
         pass := false;
         writeln('fail: unpacking conformant array, c is ', c:1, ', i is ', i:1 );
      end;

   if not p5861( aap[lo2c] ) then begin
      pass := false;
      writeln('fail: var conformant array' );
   end
   else begin
      for i := 1 to 12 do
         if aap[lo2c,i] <> 2001*i then begin
            pass := false;
            writeln( 'p586 fail: pack var conformant array, a[', i:1, '] is ', a[i]:1 );
         end;
   end;

   unpack(aap[lo2c], aa[lo1c], lo1);
   if not p5862( aa[lo1c] ) then begin
      pass := false;
      writeln('fail: value conformant array' );
   end;

   p586 := pass;
end; { p586 }


{
 conformant array of records, record contains fixed array, ...
 ... call function with fixed array, function doesn't take a conf array
 forward declared function with conf arrays
}
function p587{(ar : array[lo..hi :integer] of testRec ): boolean; forward};

var
   ok : boolean;
   i  : integer;

procedure p5871(var a1: array[lo1..hi1 :smallInt] of real;
                var a2: array[lo2..hi2 :integer; lo3..hi3 :integer] of real;
                k: integer );
var
   i,j : integer;
begin
   for i := lo1 to hi1 do
      a1[i] := i + 0.5 + k*10;
   for i := lo2 to hi2 do for j := lo3 to hi3 do
      a2[i,j] := 1000*k + i + 10*j + 0.25;
end; { p5871 }

function p5872(a1 : array[lo1..hi1 :integer] of real;
               a2: array[lo2..hi2 :integer; lo3..hi3 :integer] of real;
               k: integer ): boolean;
var
   i,j : integer;
   ok  : boolean;
begin
   ok := true;
   for i := lo1 to hi1 do
      if a1[i] <> i + 0.5 + k*10 then begin
         ok := false;
         writeln( 'p5872: contents of array failed at index ', i:1 );
      end;
   for i := lo2 to hi2 do for j := lo3 to hi3 do
      if a2[i,j] <> 1000*k + i + 10*j + 0.25 then begin
         ok := false;
         writeln( 'p5872: contents of array failed at index ', i:1, ', ', j:1 );
      end;
   p5872 := ok;
end; { p5872 }

begin { p587 }
   ok := true;
   for i := lo to hi do
      p5871(ar[i].a1, ar[i].a2, i );
   for i := lo to hi do
      p587 := ok and p5872(ar[i].a1, ar[i].a2, i );
end; { p587 }

procedure p588(procedure p(var a1, a2 : array[c0..c1 : char] of real );
                var f: boolean);
var
   a1,a2 : array['0'..'9'] of real;
   c     : char;
   b     : boolean;
begin
   for c := '0' to '9' do
      a1[c] := 1 + sqr(ord(c) -ord('0'));
   p( a1, a2 );
   b := true;
   for c := '0' to '9' do
      b := b and (a1[c] = 1 + sqr(ord(c) - ord('0')))
             and (a1[c] = a2[c]);
   f := b;
end; { p588 }

begin {p58}

   pass := true;

   { 1. check records, pointers, arrays, array of array, file buffer,
        with statement field is conf arg
        value param, var param
       , anything else? }

   seta( a, x, -1 );
   if not check(a, x, -1) then begin
      writeln( 'fail: conformant array, simple array' );
      pass := false;
   end;

   rewrite(f);
   write( f, a );
   reset( f );
   if not check(f^, x, -1) then begin
      writeln( 'fail: conformant array, array is file buffer (read)' );
      pass := false;
   end;


   rewrite(f);
   seta( f^, x, 99);
   put(f);
   reset( f );
   if not check(f^, x, 99) then begin
      writeln( 'fail: conformant array, array is file buffer (write)' );
      pass := false;
   end;

   seta( aa[3], x, -101 );
   if not check(aa[3], x, -101) then begin
      writeln( 'fail: conformant array, array is array component (1)' );
      pass := false;
   end;


   seta( r.a1, x, 13 );
   if not check(r.a1, x, 13) then begin
      writeln( 'fail: conformant array, array is record member' );
      pass := false;
   end;

   seta(aa[4], x, 199 );
   if not check(aa[4], x, 199) then begin
      writeln( 'fail: conformant array, array is array component (2)' );
      pass := false;
   end;

   new(p);
   seta(p^, x, -31);
   if not check(p^, x, -31) then begin
      writeln( 'fail: conformant array, pointer to array' );
      pass := false;
   end;
   dispose(p);

   with r do begin
      seta(a2[2], x, 87);
      if not check(a2[2], x, 87) then begin
         writeln( 'fail: conformant array, with array of array' );
         pass := false;
      end;
      seta(a1, x, -59);
      if not check( a1, x, -59) then begin
         writeln( 'fail: conformant array, with array' );
         pass := false;
      end;
   end; {with}

   for i := aalo to aahi do
      seta( aa[i], xaa[i], i );
   if not p582( aa, xaa ) then begin
      writeln( 'fail: conformant array of fixed array' );
      pass := false;
   end;


   { 2. verify that conformant arrays inside procedures work as expected,
        funcs with conf arrays parameters that are conformant arrays
        var & value params }
   { test more than one conformant array in a parameter list }
   iset( ia2, key );
   p581( ia1, ia2 );
   if not icheck( ia1, key ) then begin
      writeln( 'fail: conformant array as var parameter' );
      pass := false;
   end;


   { 3. 2D & 3D conformant arrays
        nested func calling conf array value param & var param }
   if not p583( a2d ) then begin
      writeln( 'fail: conformant 2D array' );
      pass := false;
   end;


   { 4. test a group of conformant array parameters }
   for c := '0' to '9' do
      ca1[c] := 1 + sqr(ord(c) -ord('0'));
   p584( ca1, ca2 );

   { 5. function parameters with conformant arrays }
   if not p585( p583, a2d) then begin
      writeln( 'fail: function parameter with conformant array (1)' );
      pass := false;
   end;

   p588(p584, b);
   if not b then begin
      writeln( 'fail: function parameter with conformant array (2)' );
      pass := false;
   end;


   { 6. pack & unpack }
   if not p586(a2d, a2dp) then begin
      writeln( 'fail: pack & unpack in conformant arrays' );
      pass := false;
   end;


   { 7. other tests }
   if not p587(ar) then begin
      writeln( 'fail: conformant array tests' );
      pass := false;
   end;

{   if pass then
      writeln( 'conformant array tests pass' );}

   p58 := pass;

end; { p58 }

begin { p5 }

   pass := true;
   pass1 := true;



   { array tests }
   pass1 := true;
   for i := lo2 to hi2 do
      for j := lo1 to hi1 do
         a2[i,j] := 100*i + j;

   for i := lo2 to hi2 do
      for j := lo1 to hi1 do
         if a2[i,j] <> 100*i + j then
            pass1 := false;

   for i := hi2 downto lo2 do
      for j := hi1 downto lo1 do
         a2[i,j] := 100*i + j;

   for i := lo2 to hi2 do
      for j := lo1 to hi1 do
         if a2[i,j] <> 100*i + j then
            pass1 := false;
   if not pass1 then begin
      writeln( 'array fill test failed' );
      pass := false;
   end;

   for i := lo2 to hi2 do begin
      a1 := a2[i];
      for j := lo1 to hi1 do begin
         if a1[j] <> 100*i + j then begin
            pass := false;
            writeln( 'expect ', 100*i+j:3, ' actual is ', a1[j] );
         end;
      end;
   end;

   { TODO: same test again for dynamically allocated array }


   { check for side effects }
   for i := lo1 to hi1 do begin
      sideVar := i;
      a1[sideFun] := 11*i;
      if (a1[i] <> 11*i) or (sideVar <> i+1) then begin
         pass := false;
         writeln( 'array access side effects test fail' );
      end;
   end;

   { check array access
   a1[3] := '#';
   a2[24,4] := a1[3];
   a2['k'] := a1;}



   p50; {record tests }

   if not p58 then begin {test conformant arrays }
      writeln( 'conformant array tests failed' );
      pass := false;
   end;

   if pass then
      writeln( 'array & record tests passed' )
   else
      writeln( 'array & record tests failed' );
   writeln;
end; { p5 }


{test sets}
procedure p6;

const
      setLim =  23;  { test with sets in range -setlim .. +setLim }

type
      tSc = set of char;

var
   pass  : boolean;
   i,j,k : integer;
   c, c1 : char;
   i1,j1 : integer;
   hi,lo : integer;
   as2 : array[boolean] of set of 0..+setLim;
   vSi : record
            guard1 : integer;
            sn     : set of -setlim..+setLim;
            guard2 : integer;
         end;

   s1  : set of -setlim..+setLim;
   sc0 : set of '0'..'9';
   s   : ^tSc;
   s64 : set of -64..+63;
   sb  : set of boolean;

   e1,e2,e3 : 100000..100020;

{ test assignment and set operations for sets of mixed sizes }
procedure p61;

type
   tTesTSet =  set of 'g'..'s';
var
   s0    : set of 'a'..'z';
   s1    : set of 'b'..'f';
   s2    : set of 'a'..'o'; { ascii codes of 'o' & 'p' are on byte boundary }
   s3    : set of 'g'..'s';
   s4    : set of 'p'..'z';
   s5    : set of 't'..'z';
   s6    : set of 'd'..'t';
   s7    : set of 'i'..'l';
   c     : char;
   pass1 : boolean;

{ test empty set }
{ called with empty set as parameter }
procedure p610(ae: tsc);
var
   o, z  : set of 1..15;
   sc0   : set of '0'..'9';
   i     : integer;
   pass1 : boolean;
begin
   pass1 := true;

   if [] <> [] then begin
      pass1 := false;
      writeln( 'fail: empty set <> (0)' );
   end;

   if ae <> [] then begin
      pass1 := false;
      writeln( 'fail: empty set parameter <> (1)' );
   end;

   sc0 := [];
   if sc0 <> [] then begin
      pass1 := false;
      writeln( 'fail: empty set <> (2)' );
   end;

   sc0 := ['0'];
   if not ([] <> sc0) then begin
      pass1 := false;
      writeln( 'fail: empty set <> (3)' );
   end;

   sc0 := ['2'..'1']; {should be empty set}
   if sc0 <> [] then begin
      pass1 := false;
      writeln( 'fail: empty set <> (4)' );
   end;

   if not ([] = []) then begin
      pass1 := false;
      writeln( 'fail: empty set = (1)' );
   end;

   sc0 := []*['9'];
   if not (sc0 = []) then begin
      pass1 := false;
      writeln( 'fail: empty set = (2)' );
   end;

   sc0 := ['9'];
   if [] = sc0 then begin
      pass1 := false;
      writeln( 'fail: empty set = (3)' );
   end;

   if not ([] <= []) then begin
      pass1 := false;
      writeln( 'fail: empty set <= (1)' );
   end;

   sc0 := ['0']*[];
   if not (sc0 <= []) then begin
      pass1 := false;
      writeln( 'fail: empty set <= (2)' );
   end;

   sc0 := []*[];
   if not ([] <= sc0) then begin
      pass1 := false;
      writeln( 'fail: empty set <= (3)' );
   end;

   sc0 := ['9'];
   if sc0 <= [] then begin
      pass1 := false;
      writeln( 'fail: empty set <= (4)' );
   end;

   sc0 := ['9'];
   if not ([] <= sc0) then begin
      pass1 := false;
      writeln( 'fail: empty set <= (5)' );
   end;

   sc0 := ['9'];
   if not ([] <= sc0 + ['a']) then begin
      pass1 := false;
      writeln( 'fail: empty set <= (6)' );
   end;

   sc0 := ['9'];
   if sc0 + ['a'] <= [] then begin
      pass1 := false;
      writeln( 'fail: empty set <= (7)' );
   end;

   if not ([] >= []) then begin
      pass1 := false;
      writeln( 'fail: empty set >= (1)' );
   end;

   sc0 := []-[];
   if not (sc0 >= []) then begin
      pass1 := false;
      writeln( 'fail: empty set >= (2)' );
   end;

   sc0 := []+[];
   if not ([] >= sc0) then begin
      pass1 := false;
      writeln( 'fail: empty set >= (3)' );
   end;

   sc0 := ['9'];
   if not (sc0 >= []) then begin
      pass1 := false;
      writeln( 'fail: empty set >= (4)' );
   end;

   sc0 := ['9'];
   if [] >= sc0  then begin
      pass1 := false;
      writeln( 'fail: empty set >= (5)' );
   end;

   sc0 := ['9'];
   if [] >= sc0 + ['a'] then begin
      pass1 := false;
      writeln( 'fail: empty set >= (6)' );
   end;

   sc0 := ['9'];
   if not (sc0 + ['a'] >= []) then begin
      pass1 := false;
      writeln( 'fail: empty set >= (7)' );
   end;

   for i := -1000 to +1000 do
      if i in [] then begin
         pass1 := false;
         writeln( 'fail: empty set in' );
      end;

   if []*[] <> []+[]-[] then begin
      pass1 := false;
      writeln( 'fail: empty set expressions (1)' );
   end;

   if not ([]*[] = []+[]-[]) then begin
      pass1 := false;
      writeln( 'fail: empty set expressions (2)' );
   end;

   if not ([]*[] <= []+[]-[]) then begin
      pass1 := false;
      writeln( 'fail: empty set expressions (3)' );
   end;

   if not ([]*[] >= []+[]-[]) then begin
      pass1 := false;
      writeln( 'fail: empty set expressions (4)' );
   end;

   if [] <> [13..12] then begin
      pass1 := false;
      writeln('fail: empty set range (1)');
   end;

   i := 12;
   if [] <> [i..i-1] then begin       {%%W2 -- expect warning 2}
      pass1 := false;
      writeln('fail: empty set range (2)');
   end;

   o := [1];
   z := [];
   if o <= z then begin
      pass1 := false;
      writeln('fail: p610 o <= z');
   end;
   if o = z then begin
      pass1 := false;
      writeln('fail: p610 o = z');
   end;
   if not (o <> z) then begin
      pass1 := false;
      writeln('fail: p610 o <> z');
   end;
   if not (o >= z) then begin
      pass1 := false;
      writeln('fail: p610 o >= z');
   end;
   if not (z <= o) then begin
      pass1 := false;
      writeln('fail: p610 z <= o');
   end;
   if z = o then begin
      pass1 := false;
      writeln('fail: p610 z = o');
   end;
   if not (z <> o) then begin
      pass1 := false;
      writeln('fail: p610 z <> o');
   end;
   if z >= o then begin
      pass1 := false;
      writeln('fail: p610 z >= o');
   end;
   if not (o <= o) then begin
      pass1 := false;
      writeln('fail: p610 o <= o');
   end;
   if not (o = o) then begin
      pass1 := false;
      writeln('fail: p610 o = o');
   end;
   if o <> o then begin
      pass1 := false;
      writeln('fail: p610 o <> o');
   end;
   if not (o >= o) then begin
      pass1 := false;
      writeln('fail: p610 o >= o');
   end;
   if not (z <= z) then begin
      pass1 := false;
      writeln('fail: p610 z <= z');
   end;
   if not (z = z) then begin
      pass1 := false;
      writeln('fail: p610 z = z');
   end;
   if z <> z then begin
      pass1 := false;
      writeln('fail: p610 z <> z');
   end;
   if not (z >= z) then begin
      pass1 := false;
      writeln('fail: p610 z >= z');
   end;

   if not pass1 then
      pass := false;

end; { p610 }


procedure test(st : tTesTSet);
begin
   s0 := st;
end;

begin {p61}
   pass1 := true;

   p610([]); { test empty sets }

   { test set assignment }
   s2 := [];
   s4 := s2;
   for c := 'p' to 'z' do begin
      if c in s4 then begin
         pass1 := false;
         writeln( 'fail: left disjoint set assignment' );
      end;
   end;

   s4 := [];
   s2 := s4;
   for c := 'a' to 'o' do begin
      if c in s2 then begin
         pass1 := false;
         writeln( 'fail: right disjoint set assignment' );
      end;
   end;

   s2 := ['h'..'o'];
   s3 := s2*s2;
   for c := 'g' to 's' do begin
      if (c in s3) <> (c in ['h'..'o']) then begin
         pass1 := false;
         writeln( 'fail: left overlapping set assignment, c is ''', c, '''' );
      end;
   end;

   s4 := ['p'..'r'];
   s3 := s4*s4;
   for c := 'g' to 's' do begin
      if (c in s3) = ((c<'p') or (c>'r')) then begin
         pass1 := false;
         writeln( 'fail: right overlapping set assignment' );
      end;
   end;

   s0 := ['k'..'p'];
   s3 := s0*s0;
   for c := 'g' to 's' do begin
      if (c in s3) = ((c<'k') or (c>'p')) then begin
         pass1 := false;
         writeln( 'fail: large set assignment' );
      end;
   end;

   s3 := ['g'..'j'];
   s0 := s3*s3;
   for c := 'a' to 'z' do begin
      if (c in s0) = ((c<'g') or (c>'j')) then begin
         pass1 := false;
         writeln( 'fail: small set assignment' );
      end;
   end;

   { ------ test set intersection ------ }

   s2 := [ 'b', 'o'];
   s4 := [ 'p', 'q'];
   if s2*s4 <> [] then begin
      pass1 := false;
      writeln( 'fail: left disjoint set intersection' );
   end;

   if s4*s2 <> [] then begin
      pass1 := false;
      writeln( 'fail: right disjoint set intersection (1)' );
   end;

   s2 := ['h'..'o'];
   s3 := ['m'..'s'];
   if s2*s3 <> ['m'..'o'] then begin
      pass1 := false;
      writeln( 'fail: left overlap set intersection' );
   end;

   if s3*s2 <> ['m'..'o'] then begin
      pass1 := false;
      writeln( 'fail: right overlap set intersection (1)' );
   end;

   for c := 'h' to pred(pred('o')) do begin
      s2 := ['h'..succ(succ(c))];
      s3 := [c..'s'];
      if s2*s3 <> [c..succ(succ(c))]*['h'..'s'] then begin
         pass1 := false;
         writeln( 'fail: left overlap set intersection, c is ''', c, '''' );
      end;

      if s3*s2 <> [c..succ(succ(c))] then begin
         pass1 := false;
         writeln( 'fail: right overlap set intersection (1), c is ''', c, '''' );
      end;
   end;

   s4 := ['p'..'z'];
   s3 := ['g'..'s'];
   for c := 'a' to 'z' do begin
      if (c in s3*s4) = ((c<'p') or (c>'s')) then begin
         pass1 := false;
         writeln( 'fail: right overlapping set intersection (2)' );
      end;
   end;

   s0 := ['j'..'p'];
   s3 := ['g'..'k'];
   for c := 'a' to 'z' do begin
      if (c in s3*s0) = ((c<'j') or (c>'k')) then begin
         pass1 := false;
         writeln( 'fail: large set intersection' );
      end;
   end;

   s3 := ['g'..'j'];
   s0 := ['k'..'p'];
   if s0*s3 <> ['k'..'j'] then begin
      pass1 := false;
      writeln( 'fail: small set intersection' );
   end;

   c := 'o';
   s2 := [ 'b', c];
   s4 := [ 'p', 'q'];
   if s2*s4 <> [] then begin
      pass1 := false;
      writeln( 'fail: left disjoint set intersection' );
   end;

   if s4*s2 <> [] then begin
      pass1 := false;
      writeln( 'fail: right disjoint set intersection (2)' );
   end;

   c := 'o';
   s2 := ['h'..c];
   s3 := ['m'..'s'];
   if s2*s3 <> ['m'..'o'] then begin
      pass1 := false;
      writeln( 'fail: left overlap set intersection (2)' );
   end;

    if s3*s2 <> ['m'..c] then begin
      pass1 := false;
      writeln( 'fail: right overlap set intersection (3)' );
   end;

   c := 'z';
   s4 := ['p'..c];
   s3 := ['g'..'s'];
   for c := 'a' to 'z' do begin
      if (c in s3*s4) = ((c<'p') or (c>'s')) then begin
         pass1 := false;
         writeln( 'fail: right overlapping set intersection (4)' );
      end;
   end;

   c := 'p';
   s0 := ['j'..c];
   s3 := ['g'..'k'];
   for c := 'a' to 'z' do begin
      if (c in s3*s0) = ((c<'j') or (c>'k')) then begin
         pass1 := false;
         writeln( 'fail: large set intersection (2)' );
      end;
   end;

   c := 'z';
   s0 := ['k'..c];
   s3 := ['g'..'j'];
   if s0*s3 <> ['k'..'j'] then begin
      pass1 := false;
      writeln( 'fail: small set intersection (2)' );
   end;

   s0 := ['j'..c];
   s3 := ['g'..'k'];
   if s0*s3 <> ['j'..'k'] then begin
      pass1 := false;
      writeln( 'fail: small set intersection (3)' );
   end;

   { ------ test set union ------ }

   s2 := [ 'b', 'o'];
   s4 := [ 'p', 'q'];
   if s2+s4 <> ['b', 'o'..'q'] then begin
      pass1 := false;
      writeln( 'fail: left disjoint set union (1)' );
   end;

   if s4+s2 <> ['b', 'o'..'q'] then begin
      pass1 := false;
      writeln( 'fail: right disjoint set union (1)' );
   end;

   s0 := s4+s2;
   if s0 <> ['b', 'o'..'q'] then begin
      pass1 := false;
      writeln( 'fail: right disjoint set union (2)' );
   end;

   s2 := ['h'..'o'];
   s3 := ['m'..'s'];
   if s2+s3 <> ['h'..'s'] then begin
      pass1 := false;
      writeln( 'fail: left overlap set union' );
   end;

   s0 := s3 + s2;
   if s3+s2 <> ['h'..'s'] then begin
      pass1 := false;
      writeln( 'fail: right overlap set union (1)' );
   end;
   if s0 <> ['h'..'s'] then begin
      pass1 := false;
      writeln( 'fail: right overlap set union (2)' );
   end;

   s4 := ['p'..'y'];
   s3 := ['g'..'s'];
   for c := 'a' to 'z' do begin
      if (c in s3+s4) = ((c<'g') or (c>'y')) then begin
         pass1 := false;
         writeln( 'fail: right overlapping set union (3)' );
      end;
   end;

   s0 := ['j'..'p'];
   s3 := ['g'..'k'];
   for c := 'a' to 'z' do begin
      if (c in s3+s0) = ((c<'g') or (c>'p')) then begin
         pass1 := false;
         writeln( 'fail: large set union' );
      end;
   end;

   s3 := ['g'..'j'];
   s0 := ['k'..'p'];
   if s0+s3 <> ['g'..'p'] then begin
      pass1 := false;
      writeln( 'fail: small set union' );
   end;

   s2 := [ 'h'..'m' ];
   s3 :=  [ 'h'..'m' ];
   c := 'a';
   if s2 = s3 + [c] then begin
      pass1 := false;
      writeln( 'fail: mixed sizes set union (1)' );
   end;

   if s2 + ['a'] <> s3 + [c] then begin
      pass1 := false;
      writeln( 'fail: mixed sizes set union (2)' );
   end;

   { ------ test set difference ------ }

   s2 := [ 'b', 'o'];
   s4 := [ 'p', 'q'];
   if s2-s4 <> ['b', 'o'] then begin
      pass1 := false;
      writeln( 'fail: left disjoint set difference (1)' );
   end;
   s2 := [ 'b', 'n'..'o'];
   if s2-s4 <> ['b', 'n', 'o'] then begin
      pass1 := false;
      writeln( 'fail: left disjoint set difference (2)' );
   end;

   if s4-s2 <> ['p','q'] then begin
      pass1 := false;
      writeln( 'fail: right disjoint set difference (1)' );
   end;

   s0 := (s4+s2)-s2;
   if s0 <> ['p','q'] then begin
      pass1 := false;
      writeln( 'fail: right disjoint set difference (2)' );
   end;

   s2 := ['h'..'o'];
   s3 := ['m'..'s'];
   if s2-s3 <> ['h'..'l'] then begin
      pass1 := false;
      writeln( 'fail: left overlap set difference' );
   end;

   s0 := s3 - s2;
   if s3-s2 <> ['p'..'s'] then begin
      pass1 := false;
      writeln( 'fail: right overlap set difference (1)' );
   end;
   if s0 <> ['p'..'s'] then begin
      pass1 := false;
      writeln( 'fail: right overlap set difference (2)' );
   end;

   s4 := ['p'..'y'];
   s3 := ['g'..'s'];
   for c := 'a' to 'z' do begin
      if (c in s3-s4) = ((c<'g') or (c>'o')) then begin
         pass1 := false;
         writeln( 'fail: right overlapping set difference (3)' );
      end;
   end;

   s0 := ['j'..'p'];
   s3 := ['g'..'k'];
   for c := 'a' to 'z' do begin
      if (c in s3-s0) = ((c<'g') or (c>'i')) then begin
         pass1 := false;
         writeln( 'fail: large set difference' );
      end;
   end;

   s3 := ['g'..'m'];
   s0 := ['k'..'p'];
   if s0-s3 <> ['n'..'p'] then begin
      pass1 := false;
      writeln( 'fail: small set union' );
   end;

   { --- set parameter --- }
   test([]);
   if s0 <> [] then begin
      pass1 := false;
      writeln( 'fail: set parameter empty set' );
   end;

   s1 := [];
   test(s1);
   if s0 <> s1 then begin
      pass1 := false;
      writeln( 'fail: set parameter left disjoint' );
   end;

   s5 := [];
   test(s5);
   if s0 <> [] then begin
      pass1 := false;
      writeln( 'fail: set parameter right disjoint' );
   end;

   s2 := ['h'..'o'];
   test(s2);
   if s0 <> ['h'..'o'] then begin
      pass1 := false;
      writeln( 'fail: set parameter left overlap' );
   end;

   s4 := ['p','q'];
   test(s4);
   if s0 <> ['p'..'q'] then begin
      pass1 := false;
      writeln( 'fail: set parameter right overlap' );
   end;

   s4 := ['p','q'];
   test(s4);
   if s0 <> ['p'..'q'] then begin
      pass1 := false;
      writeln( 'fail: set parameter right overlap' );
   end;

   s6 := ['h','o'];
   test(s6);
   if s0 <> ['h','o'] then begin
      pass1 := false;
      writeln( 'fail: set parameter large size' );
   end;

   s7 := ['i'..'k'];
   test(s7);
   if s0 <> ['i'..'k'] then begin
      pass1 := false;
      writeln( 'fail: set parameter small size (1)' );
   end;

   s2 := ['h','k'];
   s7 := ['i'..'k'];
   test(s2+s7);
   if s0 <> ['h'..'k'] then begin
      pass1 := false;
      writeln( 'fail: set parameter small size (2)' );
   end;

   for c := 'g' to pred(pred('s')) do begin
      test([c..succ(succ(c))]);
      if s0 <> [c..succ(succ(c))] then begin
         pass1 := false;
         writeln( 'fail: set parameter small size, c is ''', c, '''' );
      end;
   end;

   for c := 'g' to 's' do begin
      sideVar := ord(c);
      test(['g'..chr(sideFun)]);
      if sideVar <> ord(c)+1 then begin
         pass1 := false;
         writeln( 'fail: set parameter side effect, chr(sideVar) is ''', chr(sideVar), '''' );
      end;

      if s0 <> ['g'..c] then begin
         pass1 := false;
         writeln( 'fail: set parameter side effect, c is ''', c, '''' );
      end;
   end;

   if not pass1 then
      pass := false;

end; { p61 }


{ sets, in operator }
procedure p62;
var
   c,c1  : char;
   i,j,k : integer;
   lo,hi : integer;
begin
   i := 2;
   j := 5;
   c := 'S';
   if i in [ 1, 3, 4, j, ord(c) ] then begin
      pass := false;
      writeln( 'fail: in operator for constant sets' );
   end;

   i := 5;
   j := 5;
   c := 'S';
   if not (i in [ 1, 3..4, j, ord(c) ]) then begin
      pass := false;
      writeln( 'fail: in operator for constant sets' );
   end;

   { test -ve numbers }
   i := 2;
   j := 5;
   c := 'S';
   if i in [ 1, 3, -4, j, ord(c) ] then begin
      pass := false;
      writeln( 'fail: in operator for sets containing -ve nrs' );
   end;

   i := -4;
   j := 5;
   c := 'S';
   if not (i in [ 1, 3, -4, j, ord(c) ]) then begin
      pass := false;
      writeln( 'fail: in operator for sets containing -ve nrs' );
   end;

   { test range }
   i := 2;
   j := 15;
   c := 'S';
   k := 3;
   if i in [ 1, k..14, j, ord(c) ] then begin
      pass := false;
      writeln( 'fail: in operator for sets containing ranges' );
   end;

   i := 7;
   j := 15;
   c := 'S';
   if not (i in [ 1, 3, 4, 6..j, ord(c) ]) then begin
      pass := false;
      writeln( 'fail: in operator for sets containing ranges' );
   end;

   for i := 102355-10 to 102355+10 do
     if (i in [102355..934343433]) <> (i >= 102355) then begin
       pass := false;
       writeln( 'failed: extreme range (1)' );
   end;

   j := 102355;
   k := 934343433;
   for i := j-10 to j+10 do
      if (i in [6, j..k]) <> (i >= j) then begin
       pass := false;
       writeln( 'failed: extreme range (2)' );
   end;

   j := 102355;
   k := 6;
   for i := j-10 to j+10 do
     if (i in [j..934343433, k]) <> (i >= j) then begin
       pass := false;
       writeln( 'failed: extreme range (3)' );
   end;

   j := 934343433;
   for i := j-10 to j+10 do
     if (i in [k, 102355..j]) <> (i <= j) then begin
       pass := false;
       writeln( 'failed: extreme range (4)' );
   end;

   new(s);
   c := 'z';

   s^ := [ chr(0), 'a', 'b', c, chr(255) ];

   if not (chr(0) in s^) then begin
      pass := false;
      writeln( 'failed: in op for set variable' );
   end;

   for c := chr(0) to chr(255) do begin
      s^ := [c];
      for c1 := chr(0) to chr(255) do begin
         if c1 = c then begin
            if not( c1 in s^) then begin
               pass := false;
               writeln( 'fail: char ', c, '(', ord(c),') should be in set' );
            end
         end
         else begin
            if c1 in s^ then begin
               pass := false;
               writeln( 'fail: char ', c1, '(', ord(c1),') should not be in set' );
            end;
         end;
      end;
   end;

   s^ := [];
   for c := chr(0) to chr(255) do begin
      if c in s^ then begin
         pass := false;
         writeln( 'fail: char ', c, '(', ord(c),') should not be in set (2)' );
      end;
   end;

   s1 := [-5..5];
   for i := -10*setLim to 10*setLim do
     if (i in s1) <> ((i>=-5) and (i<=5)) then begin
       pass := false;
       writeln( 'fail: in operator outside set limits (', i:1, ')' );
   end;

   for lo := -setLim to +setLim do begin
      for hi := -setLim to +setLim do begin
         vSi.guard1 := 0;
         vSi.guard2 := 0;
         vSi.sn := [ lo..hi ];
         for i := -setLim to +setLim do begin
            if ((i>=lo) and (i<=hi)) <> (i in vSi.sn) then begin
               pass := false;
               writeln( 'failed: set with range ', i:1,
                               ' in ', lo:1, ' .. ', hi:1 );
            end;
            if (vSi.guard1 <> 0) or (vSi.guard2 <> 0) then begin
               pass := false;
               writeln( 'failed: writing to set outside its boundary (2)' );
            end;
         end;
      end;
   end;

   with vSi do begin
      guard1 := -1;
      guard2 := -1;
      for i := -setLim to +setLim do begin
         sn := [i];
         for j := -setLim to +setLim do begin
            if (i=j) <> (j in sn) then begin
               pass := false;
               writeln( 'fail: membership of sets with -ve nrs (i is ', i:1,
                       ', j is ', j:1, ', j in sn is ', j in sn );
            end;
            if (vSi.guard1 <> -1) or (vSi.guard2 <> -1) then begin
               pass := false;
               writeln( 'failed: writing to set outside its boundary(3)' );
            end;
         end;
      end;
   end;

   { check ranges:
     - small range inside same byte
     - med range over consecutive bytes
     - large range over several bytes
     - range starts midbyte/vs start byte/vs end byte/vs startset/vs end set
     - range ends midbyte/vs start byte/vs end byte/vs startset/vs end set
   }

   { test constant ranges in sets }
   for j := 1 to 6 do begin
      case j of
        1 :  begin vSi.sn := [ 3..6 ]; lo := 3; hi := 6; end;
        2 :  begin vSi.sn := [ 0..7 ]; lo := 0; hi := 7; end;
        3 :  begin vSi.sn := [ 3..8 ]; lo := 3; hi := 8; end;
        4 :  begin vSi.sn := [ 3..9 ]; lo := 3; hi := 9; end;
        5 :  begin vSi.sn := [ 7..setLim ]; lo := 7; hi := setLim; end;
        6 :  begin vSi.sn := [ 3..3 ]; lo := 3; hi := 3; end;
      end;
      for i := -setLim to +setLim do begin
         if ((i>=lo) and (i<=hi)) <> (i in vSi.sn) then begin
            pass := false;
            writeln( 'failed: set with constant range, i is ', i, ', j is ', j );
         end;
      end;
   end;

   c := 'q';
   i := 42;
   { test different types together }
   if not (i in [12..89]) or not ('c' in ['a'..'z']) then begin
      pass := false;
      writeln( 'failed: set membership different types, i is ', i,
       ', c is ''', c, '''' );
   end;

   for lo := -setLim to +setLim do begin
      for hi := -setLim to +setLim do begin
         vSi.sn := [ lo..hi ];
         for i := -setLim to +setLim do begin
            if ((i>=lo) and (i<=hi)) <> (i in vSi.sn) then begin
               pass := false;
               writeln( 'failed: set with negative range ', i:1,
                               ' in ', hi:1, ' .. ', lo:1 );
            end;
            if (vSi.guard1 <> -1) or (vSi.guard2 <> -1) then begin
               pass := false;
               writeln( 'failed: writing to set outside its boundary (4)' );
            end;
         end;
      end;
   end;

   {test two ranges together}
   vSi.guard1 := -1;
   vSi.guard2 := -1;
   for lo := -setLim to +setLim do begin
      for hi := -setLim to +setLim do begin
         vSi.sn := [ -setLim..lo, hi..setLim ];
         for i := -setLim to +setLim do begin

            if (lo >= hi) or (i<=lo) or (i>=hi) <> (i in vSi.sn) then begin
               pass := false;
               writeln( 'failed: set with 2 ranges ', i:1,
                               ' in ', hi:1, ' .. ', lo:1 );
            end;
         end;
      end;
   end;
   if (vSi.guard1 <> -1) or (vSi.guard2 <> -1) then begin
      pass := false;
      writeln( 'failed: writing to set outside its boundary(6)' );
   end;


end; { p62 }


{ test set compares with mixed set sizes }
procedure p63;
var
   si    : set of tI;
   s0    : set of 1..50;
   s1    : set of -50..0;
   s2    : set of -25..+25;
   s3    : set of 10..30;
   i,j   : integer;
   ii    : tI;
   pass1 : boolean;
   { the set bounds in the generated code must be verified by inspection
     iStr is set with the expected bounds of the relop so an awk script
     can automatically compare them to the actual results }
   iStr  : packed array[1..10] of char;
begin
   pass1 := true;
   s0 := [ 10..20 ];
   for i := 0 to 100 do begin
      if not(s0 + [i] <= [10..20, i] ) then begin    {%%W2 -- expect warning 2}
         pass1 := false;
         writeln( 'fail: mixed sizes set <=, i is ', i:1 );
      end;
   end;

   iStr := '##  10  20';
   for i := -1000 to 1000 do begin
      if (s0 + [i]) * [10..20] <> [10..20 ] then begin
         pass1 := false;
         writeln( 'fail: mixed sizes set <>' );
      end;
   end;

   { ----- test set compares ---- }

   s0 := [ 10..20 ];
   s1 := [ -25..-5 ];
   iStr := '## -50  50';
   if s0 = s1 then begin
      pass1 := false;
      writeln( 'fail: disjoint sets, =' );
   end;
   iStr := '## -50  50';
   if not(s0 <> s1) then begin
      pass1 := false;
      writeln( 'fail: disjoint sets, <>' );
   end;
   iStr := '## -50   0';
   if s0 >= s1 then begin
      pass1 := false;
      writeln( 'fail: disjoint sets, >=' );
   end;
   iStr := '##   1  50';
   if s0 <= s1 then begin
      pass1 := false;
      writeln( 'fail: disjoint sets, <=' );
   end;
   iStr := '## -50  50';
   if s1 = s0 then begin
      pass1 := false;
      writeln( 'fail: disjoint sets, = (2)' );
   end;
   iStr := '## -50  50';
   if not(s1 <> s0) then begin
      pass1 := false;
      writeln( 'fail: disjoint sets, <> (2)' );
   end;
   iStr := '##   1  50';
   if s1 >= s0 then begin
      pass1 := false;
      writeln( 'fail: disjoint sets, >= (2)' );
   end;
   iStr := '## -50   0';
   if s1 <= s0 then begin
      pass1 := false;
      writeln( 'fail: disjoint sets, <= (2)' );
   end;

   s1 := [-25, -15..-5, 0 ];
   s2 := [-25, -15..-5, 0 ];
   iStr := '## -50  25';
   if not(s2 = s1) then begin
      pass1 := false;
      writeln( 'fail: overlapping sets, =' );
   end;
   iStr := '## -50  25';
   if s2 <> s1 then begin
      pass1 := false;
      writeln( 'fail: overlapping sets, <>' );
   end;
   iStr := '## -50   0';
   if not (s2 >= s1) then begin
      pass1 := false;
      writeln( 'fail: overlapping sets, >=' );
   end;
   iStr := '## -25  25';
   if not (s2 <= s1) then begin
      pass1 := false;
      writeln( 'fail: overlapping sets, <=' );
   end;
   iStr := '## -50  25';
   if not (s1 = s2) then begin
      pass1 := false;
      writeln( 'fail: overlapping sets, = (2)' );
   end;
   iStr := '## -50  25';
   if s1 <> s2 then begin
      pass1 := false;
      writeln( 'fail: overlapping sets, <> (2)' );
   end;
   iStr := '## -25  25';
   if not (s1 >= s2) then begin
      pass1 := false;
      writeln( 'fail: overlapping sets, >= (2)' );
   end;
   iStr := '## -50   0';
   if not(s1 <= s2) then begin
      pass1 := false;
      writeln( 'fail: overlapping sets, <= (2)' );
   end;

   s1 := [-25, -15..-5, 0];
   s2 := [-25, -15..-6, 0];
   iStr := '## -50  25';
   if s1 = s2 then begin
      pass1 := false;
      writeln( 'fail: overlapping sets, = (3)' );
   end;
   iStr := '## -50  25';
   if not(s1 <> s2) then begin
      pass1 := false;
      writeln( 'fail: overlapping sets, <> (3)' );
   end;
   iStr := '## -25  25';
   if not(s1 >= s2) then begin
      pass1 := false;
      writeln( 'fail: overlapping sets, >= (3)' );
   end;
   iStr := '## -50   0';
   if s1 <= s2 then begin
      pass1 := false;
      writeln( 'fail: overlapping sets, <= (3)' );
   end;
   iStr := '## -50  25';
   if s2 = s1 then begin
      pass1 := false;
      writeln( 'fail: overlapping sets, = (4)' );
   end;
   iStr := '## -50  25';
   if not(s2 <> s1) then begin
      pass1 := false;
      writeln( 'fail: overlapping sets, <> (4)' );
   end;
   iStr := '## -50   0';
   if s2 >= s1 then begin
      pass1 := false;
      writeln( 'fail: overlapping sets, >= (4)' );
   end;
   iStr := '## -25  25';
   if not(s2 <= s1) then begin
      pass1 := false;
      writeln( 'fail: overlapping sets, <= (4)' );
   end;

   { --------- big vs small }
   s0 := [10, 16..23, 30];
   s3 := [10, 16..23, 30];
   iStr := '##   1  50';
   if not(s3 = s0) then begin
      pass1 := false;
      writeln( 'fail: contained sets, =' );
   end;
   iStr := '##   1  50';
   if s3 <> s0 then begin
      pass1 := false;
      writeln( 'fail: contained sets, <>' );
   end;
   iStr := '##   1  50';
   if not (s3 >= s0) then begin
      pass1 := false;
      writeln( 'fail: contained sets, >=' );
   end;
   iStr := '##  10  30';
   if not (s3 <= s0) then begin
      pass1 := false;
      writeln( 'fail: contained sets, <=' );
   end;
   iStr := '##   1  50';
   if not (s0 = s3) then begin
      pass1 := false;
      writeln( 'fail: contained sets, = (2)' );
   end;
   iStr := '##   1  50';
   if s0 <> s3 then begin
      pass1 := false;
      writeln( 'fail: contained sets, <> (2)' );
   end;
   iStr := '##  10  30';
   if not (s0 >= s3) then begin
      pass1 := false;
      writeln( 'fail: contained sets, >= (2)' );
   end;
   iStr := '##   1  50';
   if not(s0 <= s3) then begin
      pass1 := false;
      writeln( 'fail: contained sets, <= (2)' );
   end;

   s0 := [10, 16..23, 30];
   s3 := [10, 16..24, 30];
   iStr := '##   1  50';
   if s0 = s3 then begin
      pass1 := false;
      writeln( 'fail: contained sets, = (3)' );
   end;
   iStr := '##   1  50';
   if not(s0 <> s3) then begin
      pass1 := false;
      writeln( 'fail: contained sets, <> (3)' );
   end;
   iStr := '##  10  30';
   if s0 >= s3 then begin
      pass1 := false;
      writeln( 'fail: contained sets, >= (3)' );
   end;
   iStr := '##   1  50';
   if not (s0 <= s3) then begin
      pass1 := false;
      writeln( 'fail: contained sets, <= (3)' );
   end;
   iStr := '##   1  50';
   if s3 = s0 then begin
      pass1 := false;
      writeln( 'fail: contained sets, = (4)' );
   end;
   iStr := '##   1  50';
   if not(s3 <> s0) then begin
      pass1 := false;
      writeln( 'fail: contained sets, <> (4)' );
   end;
   iStr := '##   1  50';
   if not(s3 >= s0) then begin
      pass1 := false;
      writeln( 'fail: contained sets, >= (4)' );
   end;
   iStr := '##  10  30';
   if s3 <= s0 then begin
      pass1 := false;
      writeln( 'fail: contained sets, <= (4)' );
   end;

   s0 := [9..31];
   s3 := s0 - [9,31];
   iStr := '##  10  30';
   if s3 <> [10..30] then begin
      pass1 := false;
      writeln( 'fail: contained sets, <> (5)' );
   end;
   iStr := '##  10  30';
   if not (s3 = [10..30]) then begin
      pass1 := false;
      writeln( 'fail: contained sets, = (5)' );
   end;

   s0 := [1..50];
   s3 := s0 - [1..9,31..50];
   iStr := '##  10  30';
   if s3 <> [10..30] then begin
      pass1 := false;
      writeln( 'fail: contained sets, <> (6)' );
   end;
   iStr := '##  10  30';
   if not (s3 = [10..30]) then begin
      pass1 := false;
      writeln( 'fail: contained sets, = (6)' );
   end;

   s0 := [1..50];
   s3 := [10..30];
   iStr := '##   1  50';
   if s3 <> s0-[1..9,31..50] then begin
      pass1 := false;
      writeln( 'fail: contained sets, <> (7)' );
   end;
   iStr := '##  10  30';
   if not (s3 <= s0-[1..9,31..50]) then begin
      pass1 := false;
      writeln( 'fail: contained sets, = (7)' );
   end;

   iStr := '##   1  50';
   if s3 + [1..9,31..50] <> s0 then begin
      pass1 := false;
      writeln( 'fail: contained sets, <> (8)' );
   end;
   iStr := '##   1  50';
   if not (s3 + [1..9,31..50] = s0) then begin
      pass1 := false;
      writeln( 'fail: contained sets, = (8)' );
   end;

   s0 := [1..50];
   s3 := [10..30];
   iStr := '##  10  30';
   if s3 <> s0*[10..30] then begin
      pass1 := false;
      writeln( 'fail: contained sets, <> (9)' );
   end;
   iStr := '##  10  30';
   if not (s3 = s0*[10..30]) then begin
      pass1 := false;
      writeln( 'fail: contained sets, = (9)' );
   end;

   iStr := '##   1  50';
   if s3 + [1..9,31..50] <> s0 then begin
      pass1 := false;
      writeln( 'fail: contained sets, <> (10)' );
   end;
   iStr := '##   1  50';
   if not (s3 + [1..9,31..50] = s0) then begin
      pass1 := false;
      writeln( 'fail: contained sets, = (10)' );
   end;

   { now test sets with lists }
   i := 1; j := 4;
   iStr := '##   1   4';
   if [ 1,2,3,4 ] <> [ 1..4 ] then begin
      pass1 := false;
      writeln( 'fail: set lists (1)' );
   end;

   iStr := '##   1   6';
   if  [ 1..6 ] = [ 1,2,3,4 ] then begin
      pass1 := false;
      writeln( 'fail: set lists (2)' );
   end;

   iStr := '##   1   6';
   if not ([ 1,2,3,4 ] = [ 1..6 ] - [j+1,j+2 ] ) then begin
      pass1 := false;
      writeln( 'fail: set lists (3)' );
   end;

   iStr := '##   1   4';
   if not ([ 1,2,3,4 ] <= [ 1..6 ]) then begin
      pass1 := false;
      writeln( 'fail: set lists (4)' );
   end;

   iStr := '##   1   5';
   if not ([ i..6 ] >= [ 1,2 ] + [ 3,4,5 ]) then begin
      pass1 := false;
      writeln( 'fail: set lists (5)' );
   end;

   ii := orange;
   iStr := '##   0   4';
   if [ pred(ii)..blue ] <> [ red,ii,green ] + [ yellow,blue ] then begin
      pass1 := false;
      writeln( 'fail: set lists (6)' );
   end;

   {same again with integers to verify bounds}
   i := 1;
   iStr := '##-255 255';
   if [ i-1..4 ] <> [ 0,i,2 ] + [ 3,4 ] then begin {%%W2 -- expect warning 2}
      pass1 := false;
      writeln( 'fail: set lists (7)' );
   end;

   if not ([ 1..4 ] = [ i..j ]) then begin      {%%W2 -- expect warning 2}
      pass1 := false;
      writeln( 'fail: set lists (8)' );
   end;

   if [ 1..4 ] <> [ i..j ] then begin           {%%W2 -- expect warning 2}
      pass1 := false;
      writeln( 'fail: set lists (9)' );
   end;

   {$z+ -- algebraic compare on}
   if [ 1..4 ] <> [ i..j ] then begin           {%%W3 -- expect warning 3}
      pass1 := false;
      writeln( 'fail: set lists (10)' );
   end;
   {$z- -- algebraic compare off}

   iStr := '## -20  20'; { default set size truncated }
   if not ([ 1..4 ] = [ i..j ]*[-20..20]) then begin
      pass1 := false;
      writeln( 'fail: set lists (11)' );
   end;

   iStr := '## -20  20'; { default set size truncated }
   if not ([ 1..4 ] = [-20..20]*[ i..j ]) then begin
      pass1 := false;
      writeln( 'fail: set lists (12)' );
   end;

   iStr := '## -20  20'; { default set size truncated }
   if [ 1..4 ] <> [ i..j ]*[-20..20] then begin
      pass1 := false;
      writeln( 'fail: set lists (13)' );
   end;

   iStr := '## -20  20'; { default set size truncated }
   if [ 1..4 ] <> [-20..20]*[ i..j ] then begin
      pass1 := false;
      writeln( 'fail: set lists (14)' );
   end;

   iStr := '##   1   4';
   if not ([ 1..6 ] >= [ 1,2,3,4 ]) then begin
      pass1 := false;
      writeln( 'fail: set lists (15)' );
   end;

   iStr := '##   1   4';
   if not ([ 1,2,3,4 ] - [1] <= [ 1..6 ]) then begin
      pass1 := false;
      writeln( 'fail: set lists, <= (3)' );
   end;

   iStr := '##   1   4';
   if not ([ 1..4 ] - [1] <= [ 1..6 ]) then begin
      pass1 := false;
      writeln( 'fail: set lists, <= (4)' );
   end;

   iStr := '##   1   4';
   if not ([ 1..6 ] >= [ 1..4 ] - [1]) then begin
      pass1 := false;
      writeln( 'fail: set lists, >= (4)' );
   end;

   iStr := '##   1   4';
   if not ([ 1..6 ] >= [ 1,2,3,4 ] - [1]) then begin
      pass1 := false;
      writeln( 'fail: set lists, >= (3)' );
   end;

   iStr := '##   1   4';
   if not ([ 1..6 ] >= [ 1..4 ] - [1]) then begin
      pass1 := false;
      writeln( 'fail: set lists, >= (4)' );
   end;

   iStr := '##   1   4';
   if not ([ 1,2] + [3,4 ] <= [ 1..6 ]) then begin
      pass1 := false;
      writeln( 'fail: set lists, <= (5)' );
   end;

   iStr := '##   1   6';
   if [ 1,2,3,4 ] >= [ 1..4 ] +[ 5,6 ] then begin
      pass1 := false;
      writeln( 'fail: set lists, >= (5)' );
   end;

   iStr := '##   1   4';
   if [ 1,2,3,4 ] <> [ i..j ]*[1..4] then begin
      pass1 := false;
      writeln( 'fail: set lists, <> (2)' );
   end;

   iStr := '##   1   4';
   if not ([ 1,2,3,4 ] <= [ i..j+2 ]) then begin
      pass1 := false;
      writeln( 'fail: set lists, <= (6)' );
   end;

   iStr := '##   1   4';
   if not ([ i..j ]*[1..4] <= [ i..j+2 ]) then begin
      pass1 := false;
      writeln( 'fail: set lists, <= (7)' );
   end;

   iStr := '##   1   4';
   if not ([ i..j+2 ] >= [ 1,2,3,4 ]) then begin
      pass1 := false;
      writeln( 'fail: set lists, >= (6)' );
   end;

   iStr := '##   1   4';
   if not ([ i..j+2 ] >= [1..4]*[ i..j ]) then begin
      pass1 := false;
      writeln( 'fail: set lists, >= (7)' );
   end;

   iStr := '##   1   4';
   if not ([ 1,2,3,4 ] - [1] <= [ i..j+2 ]) then begin
      pass1 := false;
      writeln( 'fail: set lists, <= (8)' );
   end;

   iStr := '##   1   4';
   if not ([1..4]-[ i..j ] <= [ i..j+2 ]) then begin
      pass1 := false;
      writeln( 'fail: set lists, <= (9)' );
   end;

   iStr := '##   1   4';
   if not ([ i..j+2 ] >= [ 1,2,3,4 ] - [1]) then begin
      pass1 := false;
      writeln( 'fail: set lists, >= (8)' );
   end;

   iStr := '##   1   4';
   if not ([ i..j+2 ] >= [ i..j ]*[1..4]) then begin
      pass1 := false;
      writeln( 'fail: set lists, >= (9)' );
   end;

   iStr := '##   1   4';
   if not ([ 1,2] + [3,4 ] <= [ i..j+2 ]) then begin
      pass1 := false;
      writeln( 'fail: set lists, <= (10)' );
   end;

   iStr := '##   1   6';
   if [ 1,2,3,4 ] >= [1..4]-[ i..j ] + [ 5,6 ] then begin
      pass1 := false;
      writeln( 'fail: set lists, >= (10)' );
   end;

   iStr := '##   1   4';
   if [ 1,2,3,4 ] <> [ i..j*6 ]*[1..4] then begin
      pass1 := false;
      writeln( 'fail: set lists, <> (3)' );
   end;

   iStr := '##   1   4';
   if [ 1..4 ] <> [ i,i+2,j-2,j,6*j, -7*j ]*[1..4] then begin
      pass1 := false;
      writeln( 'fail: set lists, <> (4)' );
   end;

   iStr := '## -11  44';
   if [ 1,2,3,4 ] <> [ i..j ]*[-11..44] then begin
      pass1 := false;
      writeln( 'fail: set lists, <> (5)' );
   end;

   iStr := '## -11  44';
   if [ 1..4 ] <> [ i,i+2,j-2,j ]*[-11..44] then begin
      pass1 := false;
      writeln( 'fail: set lists, <> (6)' );
   end;

   { this test takes advantage of the fact that we can limit
     the range of the compare only to the lhs of <= or rhs of >= }
   s0 := [10..22];
   for i := -1000 to 1000 do begin
     if i in [-2..24] then begin
       iStr := '##  10  21';
       if (s0 + [i..i+11]) - [i-3..i+12] >= [10..21] then begin
         writeln( 'fail: range expr >= i = ', i:1 );
         pass := false;
       end;
       iStr := '##  10  21';
        if [10..21] <= (s0 + [i..i+11]) - [i-3..i+12] then begin
         writeln( 'fail: range expr <= i = ', i:1 );
         pass := false;
       end;
     end
     else begin
       iStr := '##  10  21';
       if not( [10..21] <= (s0 + [i..i+11]) - [i-3..i+12]) then begin
         writeln( 'fail: extreme range set <= i = ', i:1 );
         pass := false;
       end;
       iStr := '##  10  21';
        if not( (s0 + [i..i+11]) - [i-3..i+12] >= [10..21] ) then begin
         writeln( 'fail: extreme range set >= i = ', i:1 );
         pass := false;
       end;
     end;
   end;

   if not pass1 then
      pass := false;

end; { p63 }


{$z+  -- compare sets algebraically}
{test expressions with indeterminate set size}
procedure p64;
const
   n    = 100;
   mm10 = 2147483637; { maxint-10 }
type
   ts50    = set of 1..50;
   testRec = record
                desc : packed array[1..20] of char;
                a    : array[1..10] of ts50;
             end;
   tf      = file of array['a'..'z'] of testRec;

var
   i, j, k : integer;
   c       : char;
   s       : array[0..10] of set of 0..n;
   s0      : ts50;
   s1      : set of 0..51;
   sb      : array[boolean] of ts50;
   f       : tf;
   p       : ^tf;
   sm1     : set of -maxint .. -mm10;
   sm2     : set of mm10 .. maxint;

   procedure prs(ak : integer);
   var
      first : boolean;
      i     : integer;
   begin
      first := true;
      write('s[', ak:1, '] is [');
      for i := 1 to n do
         if i in s[ak] then begin
            if not first then write(', ');
            write(i:1);
            first := false;
         end;
      writeln(']');
   end; { prs }

begin {p64}


   for i := 0 to 9 do s[i] := [];
   i := 51; j := 99;
   s[0] := [i..j,55];
   s[1] := [11,52,65];
   s[2] := [6, 40..50,99];

   if s[0] <> [i..j] then begin           {%%W3 -- expect warning 3}
      writeln('p64: <> test failed (1)');
      pass := false;
   end;

   {known set size & sets not large enough for algebraic compare}
   if s[0] <> [51..99] then begin           { expect no warning 3}
      writeln('p64: <> test failed (2)');
      pass := false;
   end;

   {known set size but sets large enough for algebraic compare}
   if s[0] + [1000] <> [51..99, 1000] then begin   {%%W3 -- expect warning 3}
      writeln('p64: <> test failed (3)');
      pass := false;
   end;

   {known set size and algebraic compare, evaluated at compile time}
   if [51..99] + [1000] <> [51..99, 1000] then begin   {%%W3 -- expect warning 3}
      writeln('p64: <> test failed (4)');
      pass := false;
   end;

   if not([51..99] + [1000] = [51..99, 1000]) then begin   {%%W3 -- expect warning 3}
      writeln('p64: = test failed (1)');
      pass := false;
   end;

   if [51..98] + [1000] = [51..99, 1000] then begin   {%%W3 -- expect warning 3}
      writeln('p64: = test failed (2)');
      pass := false;
   end;

   if [51..98] + [1000] >= [51..99, 1000] then begin   {%%W3 -- expect warning 3}
      writeln('p64: >= test failed (1)');
      pass := false;
   end;

   if [51..99] + [1000] <= [51..98, 1000] then begin   {%%W3 -- expect warning 3}
      writeln('p64: <= test failed (1)');
      pass := false;
   end;

   if not (s[0] = [i..j]) then begin        {%%W3 -- expect warning 3}
      writeln('p64: = test failed');
      pass := false;
   end;

   if not (s[0] >= [i..j]) then begin       {%%W3 -- expect warning 3}
      writeln('p64: >= test failed');
      pass := false;
   end;

   if not ([i..j] <= s[0]) then begin       {%%W3 -- expect warning 3}
      writeln('p64: <= test failed');
      pass := false;
   end;

   {side effect test}
   sidevar := 0;
   if s[sideFun] <> [i..j] then begin           {%%W3 -- expect warning 3}
      writeln('p64: indeterminite sets <> test failed');
      pass := false;
   end;
   if sidevar <> 1 then begin
      pass := false;
      writeln('p64: side effect test failed, sideVar is ', sideVar:1);
   end;

   {empty set tests}
   i := 0; j := i+20;
   s0 := [i..j] - [0];
   if s0 - [i..j] <> [j..i]  then begin        {%%W3 -- expect warning 3}
      pass := false;
      writeln('p64: empty set test failed (1)');
   end;
   if not (s0 - [i..j] = [j..i])  then begin        {%%W3 -- expect warning 3}
      pass := false;
      writeln('p64: empty set test failed (2)');
   end;

   if not ([i..j] - [i..j] = [])  then begin        {%%W3 -- expect warning 3}
      pass := false;
      writeln('p64: empty set test failed (3)');
   end;

   if s0 - [j..i] + [0] <> [i..j]  then begin       {%%W3 -- expect warning 3}
      pass := false;
      writeln('p64: empty set test failed (4)');
   end;

   if [i..j] + [] <> [i..j]  then begin        {%%W3 -- expect warning 3}
      pass := false;
      writeln('p64: empty set test failed (5)');
   end;

   if s0 + [] <> [i..j] - [0]  then begin       {%%W3 -- expect warning 3}
      pass := false;
      writeln('p64: empty set test failed (6)');
   end;

   s0 := [];
   if [j..i] + s0 <> []*[]  then begin   {%%W3 -- expect warning 3}
      pass := false;
      writeln('p64: empty set test failed (7)');
   end;

   if [j..i] + s0 * [i..j] <> []  then begin   {%%W3 -- expect warning 3}
      pass := false;
      writeln('p64: empty set test failed (8)');
   end;

   if [] * [i..j] <> [j..i] + s0  then begin      {%%W3 -- expect warning 3}
      pass := false;
      writeln('p64: empty set test failed (9)');
   end;


   new(p);

   rewrite(p^);
   for c := 'a' to 'z' do begin
      with p^^[c] do begin
                 {12345678901234567890}
         desc := 'recs for component ?';
         desc[20] := c;
         for i := 1 to 10 do begin
            a[i] := [ord(c)-ord('a')+1, i+ord(z)];
         end;
      end; {with p^}
   end; {for c}
   put(p^);

   reset(p^);
   for c := 'z' downto 'a' do begin
      with p^^[c] do begin
         if desc[20] <> c then
            writeln('p64: problem at line ', __LINE__, ', c is ''',
                     c, ''', desc is ''', desc, '''');
         desc[20] := '?';
         if desc <> 'recs for component ?' then
            writeln('p64: problem at line ', __LINE__);
      end; {with p^}

      for i := 1 to 10 do begin
         if odd(i) then begin
            sideVar := i;
            if p^^[c].a[sideFun] <> [ord(c)-ord('a')+1, i+ord(z)] then begin            {%%W3 -- expect warning 3}
               writeln('p64: indeterminite sets <> test failed, c is ''',
                         c, ''', i is ', i:1);
               pass := false;
            end;
            if sidevar <> i+1 then begin
               pass := false;
               writeln('p64: side effect test failed, sideVar is ', sideVar:1,
                       ', c is ''', c, ''', i is ', i:1);
            end;
         end
         else begin
            sideVar := ord(c);
            if p^^[chr(sideFun)].a[i] <> [ord(c)-ord('a')+1, i+ord(z)] then begin            {%%W3 -- expect warning 3}
               writeln('p64: indeterminite sets <> test failed, c is ''',
                         c, ''', i is ', i:1);
               pass := false;
            end;
            if sidevar <> ord(c)+1 then begin
               pass := false;
               writeln('p64: side effect test failed, sideVar is ', sideVar:1,
                       ', c is ''', c, ''', i is ', i:1);
            end;
         end;
      end; {for i}
   end; {for c}
   dispose(p);

   {test deep tree, left}
   for i := 1 to 10 do begin
      s[i] := [90+i];
      if i <= 4 then s[i] := [1..10, 21..30]
      else if i <= 7 then s[i] := [6+i,12+i, 21..30]
      else s[i] := [1..30];
   end;

   i := 1;
   if ((s[1] * s[2] * s[3] * s[4]) + s[5] + s[6] + s[7]) * s[8] * s[9] * s[10] <> [i..10, 11..13, 17..19, 21..30] then begin          {%%W3 -- expect warning 3}
      writeln('p64: deep tree test failed (1)' );
      pass := false;
      s[0] := ((s[1] * s[2] * s[3] * s[4]) + s[5] + s[6] + s[7]) * s[8] * s[9] * s[10];
      prs(0);
   end; {if}

   for i := 1 to 4 do begin
      s[i] := s[i] - [i];
      if ((s[1] * s[2] * s[3] * s[4]) + s[5] + s[6] + s[7]) * s[8] * s[9] * s[10] <> [i+1..10, 11..13, 17..19, 21..30] then begin          {%%W3 -- expect warning 3}
         writeln('p64: deep tree test failed (2,', i:1, ')' );
         pass := false;
         s[0] := ((s[1] * s[2] * s[3] * s[4]) + s[5] + s[6] + s[7]) * s[8] * s[9] * s[10];
         prs(0);
      end; {if}
   end; {for}

   for i := 5 to 7 do begin
      s[i] := s[i] + [9+i];
      if ((s[1] * s[2] * s[3] * s[4]) + s[5] + s[6] + s[7]) * s[8] * s[9] * s[10] <> [5..10, 11..13, 14..9+i, 17..19, 21..30] then begin          {%%W3 -- expect warning 3}
         writeln('p64: deep tree test failed (2,', i:1, ')' );
         pass := false;
         s[0] := ((s[1] * s[2] * s[3] * s[4]) + s[5] + s[6] + s[7]) * s[8] * s[9] * s[10];
         prs(0);
      end; {if}
   end; {for}

   for i := 8 to 10 do begin
      s[i] := s[i] - [13+i];
      if ((s[1] * s[2] * s[3] * s[4]) + s[5] + s[6] + s[7]) * s[8] * s[9] * s[10] <> [5..19, 14+i..30] then begin          {%%W3 -- expect warning 3}
         writeln('p64: deep tree test failed (2,', i:1, ')' );
         pass := false;
         s[0] := ((s[1] * s[2] * s[3] * s[4]) + s[5] + s[6] + s[7]) * s[8] * s[9] * s[10];
         prs(0);
      end; {if}
   end; {for}

   k := 29;
   if ((s[1] * s[2] * s[3] * s[4]) + s[5] + s[6] + s[7]) * s[8] * s[9] * s[10] - [30] <> [5..19, 24..k] then begin          {%%W3 -- expect warning 3}
      writeln('p64: deep tree test failed (3)' );
      pass := false;
      s[0] := ((s[1] * s[2] * s[3] * s[4]) + s[5] + s[6] + s[7]) * s[8] * s[9] * s[10] - [30];
      prs(0);
   end; {if}

   k := 23;
   if [0..30] -(((s[1] * s[2] * s[3] * s[4]) + s[5] + s[6] + s[7]) * s[8] * s[9] * s[10]) <> [0..4, 20..k] then begin          {%%W3 -- expect warning 3}
      writeln('p64: deep tree test failed (4)' );
      pass := false;
      s[0] := [0..30] -(((s[1] * s[2] * s[3] * s[4]) + s[5] + s[6] + s[7]) * s[8] * s[9] * s[10]);
      prs(0);
   end; {if}


   {now the right subtree is deep}
   for i := 1 to 10 do begin
      s[i] := [90+i];
      if i <= 4 then s[i] := [1..10, 21..30]
      else if i <= 7 then s[i] := [6+i,12+i, 21..30]
      else s[i] := [1..30];
   end;

   i := 1;
   if s[10] * ( s[9] * ( s[8] * ( s[7] + (s[6] + (s[5] + (s[4] *((s[3] * (s[2] * s[1]))))))))) <>  [i..10, 11..13, 17..19, 21..30]then begin          {%%W3 -- expect warning 3}
      writeln('p64: deep tree test failed (5)' );
      pass := false;
      s[0] := s[10] * ( s[9] * ( s[8] * ( s[7] + (s[6] + (s[5] + (s[4] *((s[3] * (s[2] * s[1])))))))));
      prs(0);
   end; {if}

   for i := 1 to 4 do begin
      s[i] := s[i] - [i];
      if s[10] * ( s[9] * ( s[8] * ( s[7] + (s[6] + (s[5] + (s[4] *((s[3] * (s[2] * s[1]))))))))) <> [i+1..10, 11..13, 17..19, 21..30] then begin          {%%W3 -- expect warning 3}
         writeln('p64: deep tree test failed (6,', i:1, ')' );
         pass := false;
         s[0] := s[10] * ( s[9] * ( s[8] * ( s[7] + (s[6] + (s[5] + (s[4] *((s[3] * (s[2] * s[1])))))))));
         prs(0);
      end; {if}
   end; {for}

   for i := 5 to 7 do begin
      s[i] := s[i] + [9+i];
      if s[10] * ( s[9] * ( s[8] * ( s[7] + (s[6] + (s[5] + (s[4] *((s[3] * (s[2] * s[1]))))))))) <> [5..10, 11..13, 14..9+i, 17..19, 21..30] then begin          {%%W3 -- expect warning 3}
         writeln('p64: deep tree test failed (6,', i:1, ')' );
         pass := false;
         s[0] := s[10] * ( s[9] * ( s[8] * ( s[7] + (s[6] + (s[5] + (s[4] *((s[3] * (s[2] * s[1])))))))));
         prs(0);
      end; {if}
   end; {for}

   for i := 8 to 10 do begin
      s[i] := s[i] - [13+i];
      if s[10] * ( s[9] * ( s[8] * ( s[7] + (s[6] + (s[5] + (s[4] *((s[3] * (s[2] * s[1]))))))))) <> [5..19, 14+i..30] then begin          {%%W3 -- expect warning 3}
         writeln('p64: deep tree test failed (6,', i:1, ')' );
         pass := false;
         s[0] := s[10] * ( s[9] * ( s[8] * ( s[7] + (s[6] + (s[5] + (s[4] *((s[3] * (s[2] * s[1])))))))));
         prs(0);
      end; {if}
   end; {for}

   k := 29;
   if s[10] * ( s[9] * ( s[8] * ( s[7] + (s[6] + (s[5] + (s[4] *((s[3] * (s[2] * s[1]))))))))) - [30] <>  [5..19, 24..k] then begin          {%%W3 -- expect warning 3}
      writeln('p64: deep tree test failed (7)' );
      pass := false;
      s[0] := s[10] * ( s[9] * ( s[8] * ( s[7] + (s[6] + (s[5] + (s[4] *((s[3] * (s[2] * s[1]))))))))) - [30];
      prs(0);
   end; {if}

   k := 23;
   if [0..30] - (s[10] * ( s[9] * ( s[8] * ( s[7] + (s[6] + (s[5] + (s[4] *((s[3] * (s[2] * s[1])))))))))) <>  [0..4, 20..k] then begin          {%%W3 -- expect warning 3}
      writeln('p64: deep tree test failed (8)' );
      pass := false;
      s[0] := [0..30] - (s[10] * ( s[9] * ( s[8] * ( s[7] + (s[6] + (s[5] + (s[4] *((s[3] * (s[2] * s[1]))))))))));
      prs(0);
   end; {if}

 {
   bounds tests:
   s0 = s(wider) + [same]  -- verify width of test
   s0 = s(same) + [wider]  -- verifies vlist is not lost
 }

   i := 50;
   k := i-10;
   s0 := [k..i];
   if s0 <> [] + [k..i] then begin
      writeln('p64: bounds test failed (1)' );
      pass := false;
   end; {if}

   s1 := s0 + [0];
   if s0 = s1 + [k..i] then begin
      writeln('p64: bounds test failed (2)' );
      pass := false;
   end; {if}

   s1 := s0 + [51];
   if s0 = s1 + [k..i] then begin
      writeln('p64: bounds test failed (3)' );
      pass := false;
   end; {if}

  {maxint tests}
   s[1] := [22..44];
   s[0] := s[1];
   k := maxint;
   if s[0] <> s[1] + [k-10..maxint] - [maxint-10..k] then begin          {%%W3 -- expect warning 3}
      writeln('p64: maxint test failed (1)' );
      pass := false;
   end; {if}

   if [-maxint, k..maxint] <> [-k, maxint..k] then begin       {%%W3}
      writeln('p64: maxint test failed (2)' );
      pass := false;
   end; {if}

   k := -maxint;
   if s[0] <> s[1] + [-maxint..k+10] - [k ..-maxint+10] then begin  {%%W3}
      writeln('p64: maxint test failed (3)' );
      pass := false;
   end; {if}

   if [maxint, k..-maxint] <> [-k, -maxint..k] then begin          {%%W3}
      writeln('p64: maxint test failed (4)' );
      pass := false;
   end; {if}

   k := 10;
   if [ 3..13, maxint ] <> [2..15, maxint-k..maxint] - [2,14..15,maxint-k-1..maxint-1]  then begin          {%%W3 -- expect warning 3}
      writeln('p64: indeterminite set maxint test failed (5)' );
      pass := false;
   end; {if}

   if not([ 3..13, -maxint ] = [2..15, -maxint..-maxint+k] - [2,14..15,-maxint+1..-maxint+k])  then begin          {%%W3 -- expect warning 3}
      writeln('p64: indeterminite set -maxint test failed (12)' );
      pass := false;
   end; {if}

   k := maxint;
   if [-maxint..maxint] <> [-k..k] then begin     {%%W3 -- expect warning 3}
         writeln('p64: indeterminite set maxint test failed (13)' );
         pass := false;
      end; {if}

   if [-maxint..maxint,k] <> [-k..k] then begin     {%%W3 -- expect warning 3}
         writeln('p64: indeterminite set maxint test failed (14)' );
         pass := false;
      end; {if}

   if [0,-maxint..maxint,0] <> [-k..k] then begin {%%W3 -- expect warning 3}
         writeln('p64: indeterminite set maxint test failed (15)' );
         pass := false;
      end; {if}

   if [0..maxint, -maxint..0] <> [-k..k] then begin {%%W3 -- expect warning 3}
         writeln('p64: indeterminite set maxint test failed (16)' );
         pass := false;
      end; {if}

   if mm10 + 10 = maxint then begin

      k := 3-maxint;
      sm1 := [-maxint .. 2-maxint];
      if sm1 <> [k-1, k-2, k-3]then begin          {%%W3 -- expect warning 3}
         writeln('p64: indeterminite set -maxint test failed (17)' );
         pass := false;
      end; {if}

      if sm1 = [k-1, k-2]then begin                {%%W3 -- expect warning 3}
         writeln('p64: indeterminite set -maxint test failed (18)' );
         pass := false;
      end; {if}

      k := maxint-3;
      sm2 := [maxint-2 .. maxint];
      if sm2 <> [k+1, k+2, k+3]then begin          {%%W3 -- expect warning 3}
         writeln('p64: indeterminite set maxint test failed (19)' );
         pass := false;
      end; {if}

      if sm2 = [k+1, k+2]then begin               {%%W3 -- expect warning 3}
         writeln('p64: indeterminite set maxint test failed (20)' );
         pass := false;
      end; {if}

   end
   else begin
      {fix constant mm10}
      writeln('fail: some tests invalid due to wrongly assumed value of maxint');
   end;


   {test identity a-(b-c) == a-b + a*c}
   k := 25;
   s[1] := [k..75];
   for i := 10 to 80 do begin
      s[2] := [i..i+10];
      for j := i-10 to i+15 do begin
         s[3] := [j..j+5];
         if [k..75] - ([i..i+10] - [j..j+5]) <> s[1] - s[2] + s[1] * s[3] then begin          {%%W3 -- expect warning 3}
            writeln('p64: indeterminite set identity test failed (13), i is ', i:1, ', j is ', j:1 );
            pass := false;
         end; {if}
      end; {for j}
   end; {for i}

   {recursion test}
   i := 10; j:= 20;
   sb[false] := [1..20];
   sb[true] := [11..30];

   if sb[{false}
           sb[{true}
                not( sb[false] = sb[true])
             ] = [j..30]
        ] <> [1..j] then begin          {%%W3 -- expect warning 3}
      writeln('p64: indeterminite recursion test failed (14)' );
      pass := false;
   end; {if}

end; { p64 }
{$z-  -- algebraic set compare off}


{ check operators
     +, -, *   ( 3 ops )
     var, const list, var list ( 3x(any 2) + all 3)
     then compound expressions
}
procedure p65;

var
   i, j, i1, j1 : integer;

begin

   { test union set expressions. Vary -
      operand types between var and list
      set sizes
      execution order
   }

   s1 := [ -5, 0, 10, 15 ];
   vSi.sn := [ +5, 0, -10, -15 ];
   s1 := vSi.sn + s1;
   for i := -15 to +15 do begin
      if (i mod 5 = 0) <> (i in s1) then begin
         pass := false;
         writeln( 'failed: set union (10) (', i:1, ')' );
      end;
   end;

   s1 := [ -5, 0, 10, 15 ];
   vSi.sn := [ +5, 0, -10, -15 ];
   s1 := s1 + vSi.sn;
   for i := -15 to +15 do begin
      if (i mod 5 = 0) <> (i in s1) then begin
         pass := false;
         writeln( 'failed: set union (11) (', i:1, ')' );
      end;
   end;

   vSi.sn := [ +5, 0, -10, -15 ];
   s1 := vSi.sn + [ -5, 0, 10, 15 ];
   for i := -15 to +15 do begin
      if (i mod 5 = 0) <> (i in s1) then begin
         pass := false;
         writeln( 'failed: set union (20) (', i:1, ')' );
      end;
   end;

   vSi.sn := [ +5, 0, -10, -15 ];
   s1 := [ -5, 0, 10, 15 ] + vSi.sn;
   for i := -15 to +15 do begin
      if (i mod 5 = 0) <> (i in s1) then begin
         pass := false;
         writeln( 'failed: set union (21) (', i:1, ')' );
      end;
   end;

   i := -5; i1 := 0; j := 10; j1 := 15;
   vSi.sn := [ +5, 0, -10, -15 ];
   s1 := vSi.sn + [ i, i1, j, j1 ];
   for i := -15 to +15 do begin
      if (i mod 5 = 0) <> (i in s1) then begin
         pass := false;
         writeln( 'failed: set union (30) (', i:1, ')' );
      end;
   end;

   i := -5; i1 := 0; j := 10; j1 := 15;
   vSi.sn := [ +5, 0, -10, -15 ];
   s1 := [ i, i1, j, j1 ] + vSi.sn;
   for i := -15 to +15 do begin
      if (i mod 5 = 0) <> (i in s1) then begin
         pass := false;
         writeln( 'failed: set union (31) (', i:1, ')' );
      end;
   end;

   i := -5; i1 := 0; j := 10; j1 := 15;
   s1 := [ +5, 0, -10, -15 ] + [ i, i1, j, j1 ];
   for i := -15 to +15 do begin
      if (i mod 5 = 0) <> (i in s1) then begin
         pass := false;
         writeln( 'failed: set union (40) (', i:1, ')' );
      end;
   end;

   i := -4; i1 := 0; j := 8; j1 := 12;
   s1 := [ i, i1, j, j1 ] + [ +4, 0, -8, -12 ];
   for i := -15 to +15 do begin
      if (i mod 4 = 0) <> (i in s1) then begin
         pass := false;
         writeln( 'failed: set union (41) (', i:1, ')' );
      end;
   end;

   i1 := -5; j1 := 10;
   s1 := [ 0, 15 ];
   s1 := [ +5, 0, -10, -15 ] + [ i1, j1 ] + s1;
   for i := -15 to +15 do begin
      if (i mod 5 = 0) <> (i in s1) then begin
         pass := false;
         writeln( 'failed: set union (42) (', i:1, ')' );
      end;
   end;

   i := -5; j := 10;
   vSi.sn := [ +5, 0, -10, -15 ];
   s1 := vSi.sn + [ i, j ] + [ 0, 15 ];
   for i := -15 to +15 do begin
      if (i mod 5 = 0) <> (i in s1) then begin
         pass := false;
         writeln( 'failed: set union (50) (', i:1, ')' );
      end;
   end;

   i := -4; j := 8;
   vSi.sn := [ +4, 0, -8, -12 ];
   s1 :=  [ 0, 12 ] + vSi.sn + [ i, j ];
   for i := -15 to +15 do begin
      if (i mod 4 = 0) <> (i in s1) then begin
         pass := false;
         writeln( 'failed: set union (51) (', i:1, ')' );
      end;
   end;

   i := -5; j := 10;
   vSi.sn := [ ]; { test empty set }
   vSi.sn := vSi.sn + [ +5, 0, -10, -15 ];
   s64 :=  [ 0, 15 ] + [ i, j ] + vSi.sn;
   for i := -64 to +63 do begin
      if ( (abs(i)<=15) and (i mod 5 = 0)) <> (i in s64) then begin
         pass := false;
         writeln( 'failed: set union (52) (', i:1, ')' );
      end;
   end;

   i := -4; j := 8;
   vSi.sn := [ ]; { test empty set }
   vSi.sn := [ +4, 0, -8, -12 ] + vSi.sn;
   s64 :=  vSi.sn + ([ 0, 12 ] + [ i, j ]);
   for i := -64 to +63 do begin
      if ( (abs(i)<=15) and (i mod 4 = 0)) <> (i in s64) then begin
         pass := false;
         writeln( 'failed: set union (53) (', i:1, ')' );
      end;
   end;

   i := -5; j := 10;
   vSi.sn := [ +5, 0, -10, -15 ];
   as2[false] := [ 0, 15 ];
   s1 := vSi.sn + [ i, j ] + as2[false];
   for i := -15 to +15 do begin
      if (i mod 5 = 0) <> (i in s1) then begin
         pass := false;
         writeln( 'failed: set union (54) (', i:1, ')' );
      end;
   end;

   i := +4; j := 8;
   vSi.sn := [ -4, 0, -8, -12 ];
   as2[false] := [ i, j ];
   s64 :=  [ 0, 12 ] + vSi.sn + as2[false];
   for i := -15 to +15 do begin
      if (i mod 4 = 0) <> (i in s64) then begin
         pass := false;
         writeln( 'failed: set union (55) (', i:1, ')' );
      end;
   end;

   i := -5; j := 10;
   vSi.sn := [ ]; { test empty set }
   vSi.sn := vSi.sn + [ +5, 0, -10, -15 ];
   as2[false] := [ 0, 15 ];

   sideVar := 3;  {test side effects}
   s64 :=  as2[sideFun <> 3] + vSi.sn + [ i, j ];
   if sideVar <> 4 then begin
      pass := false;
      writeln( 'failed: set evaluated more than once' );
   end;
   for i := -64 to +63 do begin
      if ( (abs(i)<=15) and (i mod 5 = 0)) <> (i in s64) then begin
         pass := false;
         writeln( 'failed: set union (56) (', i:1, ')' );
      end;
   end;

   i := -4; j := 8;
   vSi.sn := [ +4, 0, -8, -12 ];
   sideVar := i;
   s1 := [ sideFun, j ];
   if sidevar <> i+1 then begin
      pass := false;
      writeln( 'failed: side effect test' );
   end;

   as2[false] := [ 0, 12 ];
   s1 :=  as2[false] + vSi.sn + s1;
   for i := -15 to +15 do begin
      if (i mod 4 = 0) <> (i in s1) then begin
         pass := false;
         writeln( 'failed: set union (57) (', i:1, ')' );
      end;
   end;

   i := -5; j := 10;
   s1 := [ +5, 0, -10, -15 ] + [ i, j ] + [ 0, 15 ];
   for i := -15 to +15 do begin
      if (i mod 5 = 0) <> (i in s1) then begin
         pass := false;
         writeln( 'failed: set union (58) (', i:1, ')' );
      end;
   end;

   i := -5; j := 10;
   vSi.sn := [ +5, 0, -10, -15 ];
   s1 := vSi.sn + ([ i, j ] + [ 0, 15 ]);
   for i := -15 to +15 do begin
      if (i mod 5 = 0) <> (i in s1) then begin
         pass := false;
         writeln( 'failed: set union (60) (', i:1, ')' );
      end;
   end;

   i := -4; j := 8;
   i1 := 0; j1 := 12;
   vSi.sn := [ +4, 0, -8, -12 ];
   s1 :=  [ i1, j1 ] + (vSi.sn + [ i, j ]);
   for i := -15 to +15 do begin
      if (i mod 4 = 0) <> (i in s1) then begin
         pass := false;
         writeln( 'failed: set union (61) (', i:1, ')' );
      end;
   end;

   i := -5; j := 10;
   vSi.sn := [ ]; { test empty set }
   vSi.sn := vSi.sn + [ +5, 0, -10, -15 ];
   s64 :=  [ 0, 15 ] + ([ i, j ] + vSi.sn);
   for i := -64 to +63 do begin
      if ( (abs(i)<=15) and (i mod 5 = 0)) <> (i in s64) then begin
         pass := false;
         writeln( 'failed: set union (62) (', i:1, ')' );
      end;
   end;

   i := -4; j := 8;
   vSi.sn := [ ]; { test empty set }
   vSi.sn := [ +4, 0, -8, -12 ] + vSi.sn;
   s64 :=  vSi.sn + ([ 0, 12 ] + [ i, j ]);
   for i := -64 to +63 do begin
      if ( (abs(i)<=15) and (i mod 4 = 0)) <> (i in s64) then begin
         pass := false;
         writeln( 'failed: set union (63) (', i:1, ')' );
      end;
   end;

   i := -5; j := 10;
   vSi.sn := [ +5, 0, -10, -15 ];
   as2[false] := [ 0, 15 ];
   s1 := vSi.sn + ([ i, j ] + as2[false]);
   for i := -15 to +15 do begin
      if (i mod 5 = 0) <> (i in s1) then begin
         pass := false;
         writeln( 'failed: set union (64) (', i:1, ')' );
      end;
   end;

   i := -4; j := 8;
   vSi.sn := [ +4, 0, -8, -12 ];
   s1 := [ i, j ];
   s64 :=  [ 0, 12 ] + (vSi.sn + s1);
   for i := -15 to +15 do begin
      if (i mod 4 = 0) <> (i in s64) then begin
         pass := false;
         writeln( 'failed: set union (65) (', i:1, ')' );
      end;
   end;

   i := -5; j := 10;
   vSi.sn := [ ]; { test empty set }
   vSi.sn := vSi.sn + [ +5, 0, -10, -15 ];
   as2[false] := [ 0, 15 ];
   s64 :=  as2[ as2[false] <> [ 0, 15 ] ] + (vSi.sn + [ i, j ]);
   for i := -64 to +63 do begin
      if ( (abs(i)<=15) and (i mod 5 = 0)) <> (i in s64) then begin
         pass := false;
         writeln( 'failed: set union (66) (', i:1, ')' );
      end;
   end;

   i := -4; j := 8;
   vSi.sn := [ +4, 0, -8, -12 ];
   s1 := [ i, j ];
   as2[false] := [ 0, 12 ];
   s1 :=  as2[false] + (vSi.sn + s1);
   for i := -15 to +15 do begin
      if (i mod 4 = 0) <> (i in s1) then begin
         pass := false;
         writeln( 'failed: set union (67) (', i:1, ')' );
      end;
   end;

   i := -5; j := 10;
   s1 := [ +5, 0, -10, -15 ] + ([ i, j ] + [ 0, 15 ]);
   for i := -15 to +15 do begin
      if (i mod 5 = 0) <> (i in s1) then begin
         pass := false;
         writeln( 'failed: set union (68) (', i:1, ')' );
      end;
   end;

   i := -5; j := 10;
   i1 := 0; j1 := -10;
   s1 := [ +5, i1, j1, -15 ] + ([ i, j ] + [ 0, 15 ]);
   for i := -15 to +15 do begin
      if (i mod 5 = 0) <> (i in s1) then begin
         pass := false;
         writeln( 'failed: set union (69) (', i:1, ')' );
      end;
   end;

   i1 := -5; j1 := 10;
   vSi.sn := [ -10, -15];
   s64 := [ +5, 0];
   s64 := (vSi.sn + s64) + ([ i1, j1 ] + [ 0, 15 ]);
   for i := -15 to +15 do begin
      if (i mod 5 = 0) <> (i in s64) then begin
         pass := false;
         writeln( 'failed: set union (70) (', i:1, ')' );
      end;
   end;

   i1 := -4; j1 := 8;
   vSi.sn := [ +4, 0] + [ -8, -12];
   s64 := vSi.sn + [ i1, j1 ] + [ 0, 12 ];
   for i := -15 to +15 do begin
      if (i mod 4 = 0) <> (i in s64) then begin
         pass := false;
         writeln( 'failed: set union (71) (', i:1, ')' );
      end;
   end;

   if vSi.sn =  vSi.sn + [24]  then begin
      pass := false;
      writeln( 'failed: set union (72)' );
   end;

   if vSi.sn + [-24] =  vSi.sn  then begin
      pass := false;
      writeln( 'failed: set union (73)' );
   end;

   sc0 := ['9'];
   if sc0 + ['a'] <= sc0 then begin
      pass := false;
      writeln( 'fail: set union (74)' );
   end;

   sc0 := ['9'];
   if sc0 >= sc0 + [' '] then begin
      pass := false;
      writeln( 'fail: set union (75)' );
   end;


   { (set,node)x(listonly, data) + (set,node)x(listonly cat, listonly, data) }

   i1 := -4; j1 := 8;
   vSi.sn := [ +4, 0, 12] + [ -8, -12 ];
   s1 := [i1, j1 ];
   s1 := vSi.sn + s1;
   for i := -15 to +15 do begin
      if (i mod 4 = 0) <> (i in s1 ) then begin
         pass := false;
         writeln( 'failed: set union (80) (', i:1, ')' );
      end;
   end;

   i1 := -4; j1 := 8;
   s1 := ([ +4, 0] + [ -8, -12 ]) + ([ i1, j1 ] + [ 0, 12 ]);
   for i := -15 to +15 do begin
      if (i mod 4 = 0) <> (i in s1 ) then begin
         pass := false;
         writeln( 'failed: set union (81) (', i:1, ')' );
      end;
   end;

   i1 := -4; j1 := 8;
   as2[false] := [ +4, 0, 12];
   vSi.sn := [] + [ -8, -12 ];
   s1 := [i1, j1 ];
   s1 := vSi.sn + (s1+as2[false]);
   for i := -15 to +15 do begin
      if (i mod 4 = 0) <> (i in s1 ) then begin
         pass := false;
         writeln( 'failed: set union (82) (', i:1, ')' );
      end;
   end;

   i1 := -4; j1 := 8;
   vSi.sn := [ +4, 0] + [ -8, -12];
   s1 := vSi.sn + ([ i1, j1 ] + [ 0, 12 ]);
   for i := -15 to +15 do begin
      if (i mod 4 = 0) <> (i in s1 ) then begin
         pass := false;
         writeln( 'failed: set union (83) (', i:1, ')' );
      end;
   end;

   i1 := -4; j1 := 8;
   vSi.sn := [] + [ -8, -12 ];
   as2[ vSi.sn = [ -8, -12 ] ] := [ +4, 0, 12];
   s1 := [i1, j1 ];
   s1 := (s1+as2[true]) + [ -8, -12 ];
   for i := -15 to +15 do begin
      if (i mod 4 = 0) <> (i in s1 ) then begin
         pass := false;
         writeln( 'failed: set union (84) (', i:1, ')' );
      end;
   end;

   i1 := -4; j1 := 8;
   s1 := [ 4, 0, -8, -12, i1, j1 ] + [ 0, 12];
   for i := -15 to +15 do begin
      if (i mod 4 = 0) <> (i in s1) then begin
         pass := false;
         writeln( 'failed: set union (85) (', i:1, ')' );
      end;
   end;

   s1 := [];
   for i := -setLim to setLim do
      if i mod 2 = 0 then s1 := s1 + [i];
   vSi.sn := [];
   for i := -setLim to setLim do
      if i mod 3 = 0 then vSi.sn := vSi.sn + [i];
   s64 := s1 * vSi.sn;
   s1 := s1 * vSi.sn;
   for i := setlim downto -setLim do begin
      if (i mod 6 = 0) <> (i in s1) then begin
         pass := false;
         writeln( 'failed: set intersection (10) (', i:1, ')' );
      end;
   end;
   for i := 63 downto -64 do begin
      if ( (abs(i) <= setLim) and (i mod 6 = 0) ) <> (i in s64) then begin
         pass := false;
         writeln( 'failed: set intersection (11) (', i:1, ')' );
      end;
   end;

   s1 := [];
   for i := -setLim to setLim do
      if i mod 3 = 1 then s1 := s1 + [i];
   vSi.sn := [];
   for i := -setLim to setLim do
      if odd(i) then vSi.sn := vSi.sn + [i];
   s64 := s1 * vSi.sn;
   s1 := s1 - vSi.sn;
   for i := setlim downto -setLim do begin
      if ((i mod 3 = 1)and not odd(i)) <> (i in s1) then begin
         pass := false;
         writeln( 'failed: set subtraction (10) (', i:1, ')' );
      end;
   end;
   for i := 63 downto -64 do begin
      if ( (abs(i) <= setLim) and (i mod 3 = 1) and odd(i) ) <> (i in s64) then begin
         pass := false;
         writeln( 'failed: set subtraction (11) (', i:1, ')' );
      end;
   end;

end; { p65 }


begin {p6}
   pass := true;

   p62;

   for i := -9 to 16 do
      for j := -9 to 16 do
         if ([-20..20]*[i] = [-20..20]*[j]) <> (i = j) then begin
            pass := false;
            writeln( 'failed: set compare, i is ', i:1, ', j is ', j:1 );
         end; {for}

   { check set assignment }
   sc0 := [ '3', '6', '9' ]; { constants }
   s^ := sc0;
   for c := chr(0) to chr(255) do begin
      if ((c='3') or (c='6') or (c='9')) <> (c in s^) then begin
         pass := false;
         writeln( 'failed: set assignment (2) ''', c:1, '''' );
      end;
   end;

   { check set assignment }
   sc0 := [ '3' .. '9' ]; { constants }
   s^ := sc0;
   for c := chr(0) to chr(255) do begin
      if ((c>='3') and (c<='9')) <> (c in s^) then begin
         pass := false;
         writeln( 'failed: set assignment (3) ''', c:1, '''' );
      end;
   end;

   s^ := [ '0'..'9', '+', '-', 'A'..'F' ];
   for c := chr(0) to chr(255) do begin
      if (((c>='0') and (c<='9')) or (c='+') or
                 (c='-') or ((c>='A') and (c<='F'))) <> (c in s^) then begin
         pass := false;
         writeln( 'failed: multiple set ranges ''', c:1, '''' );
      end;
   end;


   k := setLim;
   vSi.sn := [ -k .. -k+8, 0, k div 2 .. k ];
   s1 := vSi.sn;
   for i := -setLim to +setlim do begin
      if (((i>=-setLim) and (i <= -setLim + 8))
                         or (i = 0)
                         or (i>= setLim div 2) and (i<=setLim))
                   <> (i in s1) then begin
         pass := false;
         writeln( 'failed: set assignment with multiple ranges (', i:1, ')' );
      end;
   end;

   for i := -setLim to +setlim do begin
      for j := -setLim to +setlim do begin
         for k := -setLim to +setlim do begin
            vSi.sn := [ i, j, k ]; { variables }
            s1 := vSi.sn;
            for i1 := -setLim to +setlim do begin
               if ((i1 = i) or (i1 = k) or (i1 = j))
                  <> (i1 in s1) then begin
                     pass := false;
                     writeln( 'failed: set assignment (', i:1,
                                                ',', j:1, ',', k:1, ')' );
                  end;
            end;
         end;
      end;
   end;

   p65; {test operators +, *,  - }


   i1 := -4; j1 := 8;
   vSi.sn := [ +4, 0, 12] + [ -8, -12 ];
   s1 := [i1, j1 ];
   for i := -15 to +15 do begin
      if (i mod 4 = 0) <> (i in vSi.sn + s1 ) then begin
         pass := false;
         writeln( 'failed: set membership (10) (', i:1, ')' );
      end;
   end;

   i1 := -4; j1 := 8;
   for i := -15 to +15 do begin
      if (i mod 4 = 0) <> (i in ([ +4, 0] + [ -8, -12 ]) +
                                ([ i1, j1 ] + [ 0, 12 ]) ) then begin
         pass := false;
         writeln( 'failed: set membership (11) (', i:1, ')' );
      end;
   end;

   i1 := -4; j1 := 8;
   as2[false] := [ +4, 0, 12];
   vSi.sn := [] + [ -8, -12 ];
   s1 := [i1, j1];
   for i := -15 to +15 do begin
      if (i mod 4 = 0) <> (i in vSi.sn + (s1+as2[false]) ) then begin
         pass := false;
         writeln( 'failed: set membership (12) (', i:1, ')' );
      end;
   end;

   i1 := -4; j1 := 8;
   vSi.sn := [ +4, 0] + [ -8, -12 ];
   for i := -15 to +15 do begin
      if (i mod 4 = 0) <> (i in vSi.sn +
                                ([ i1, j1 ] + [ 0, 12 ]) ) then begin
         pass := false;
         writeln( 'failed: set membership (13) (', i:1, ')' );
      end;
   end;

   i1 := -4; j1 := 8;
   as2[false] := [ +4, 0, 12];
   s1 := [i1, j1 ];
   for i := -15 to +15 do begin
      if (i mod 4 = 0) <> (i in (s1+as2[false]) + [ -8, -12 ] ) then begin
         pass := false;
         writeln( 'failed: set membership (14) (', i:1, ')' );
      end;
   end;

   i1 := -4; j1 := 8;
   for i := -15 to +15 do begin
      if (i mod 4 = 0) <> (i in [ 4, 0, -8, -12, i1, j1 ] + [ 0, 12]) then begin
         pass := false;
         writeln( 'failed: set membership (15) (', i:1, ')' );
      end;
   end;

      i1 := -4; j1 := 8;
   vSi.sn := [ +4, 0] + [ -8, -12 ];
   for i := -15 to +15 do begin
      if (i mod 4 = 0) <> (i in vSi.sn + [ i1, j1 ] + [ 0, 12 ]) then begin
         pass := false;
         writeln( 'failed: set membership (17) (', i:1, ')' );
      end;
   end;

   i1 := -5; j1 := 10;
   s1 := [ 0, 15 ];
   for i := -15 to +15 do begin
      if (i mod 5 = 0) <> (i in [ +5, 0, -10, -15 ] + [ i1, j1 ] + s1) then begin
         pass := false;
         writeln( 'failed: set membership (18) (', i:1, ')' );
      end;
   end;

   s64 := [5];
   for i := -64 to 63 do
      if i mod 13 = 0 then s64 := s64 + [i];
   for i := 63 downto -64 do begin
      if (i mod 13 = 0) <> (i in s64 + [i+99, 200..230] - [5]) then begin
         pass := false;
         writeln( 'failed: set membership (20) (', i:1, ')' );
      end;
   end;
   for i := 63 downto -64 do begin
      if (i mod 13 = 0) <> (i in s64 - [5] + [i+99, 200..230]) then begin
         pass := false;
         writeln( 'failed: set membership (21) (', i:1, ')' );
      end;
   end;

   s1 := [];
   for i := -setlim to setLim do
      if i mod 2 = 0 then
         s1 := s1 + [i];
   vSi.sn := s1;
   s1 := [];
   for i := -setlim to setLim do
      if i mod 3 = 0 then
         s1 := s1 + [i];
   for i := -setLim to setLim do begin
      if (i mod 6 = 0) <> ( i in s1*vSi.sn ) then begin
         pass := false;
         writeln( 'failed: set membership (30) (', i:1, ')' );
      end;
   end;

   s1 := [9];
   for i := -setlim to setLim do
      if i mod 2 = 0 then
         s1 := s1 + [i];
   vSi.sn := s1;
   s1 := [4];
   for i := -setlim to setLim do
      if i mod 3 = 0 then
         s1 := s1 + [i];
   for i := -setLim to setLim do begin
      if (i mod 6 = 0) <> ( i in s1*vSi.sn - [4,9] ) then begin
         pass := false;
         writeln( 'failed: set membership (31) (', i:1, ')' );
      end;
   end;


   { test set compare }

   s1 := [ +4, 0, 12];
   vSi.sn := [ +4, 0, 12];
   if s1 <> vSi.sn then begin
      pass := false;
      writeln( 'failed: set <> (10)' );
   end;
   if s1 - [4] <> vSi.sn - [4] then begin
      pass := false;
      writeln( 'failed: set <> (10a)' );
   end;
   if not (s1 = vSi.sn) then begin
      pass := false;
      writeln( 'failed: set = (10)' );
   end;
   if not (s1 <= vSi.sn) then begin
      pass := false;
      writeln( 'failed: set <= (10)' );
   end;
   if not (vSi.sn >= s1) then begin
      pass := false;
      writeln( 'failed: set >= (10)' );
   end;

   vSi.sn := [ -4, +4, 0, 12];
   if s1 = vSi.sn then begin
      pass := false;
      writeln( 'failed: set = (11)' );
   end;
   if not (s1 <> vSi.sn) then begin
      pass := false;
      writeln( 'failed: set <> (11)' );
   end;
   if vSi.sn <= s1 then begin
      pass := false;
      writeln( 'failed: set <= (11)' );
   end;
   if not (s1 <= vSi.sn) then begin
      pass := false;
      writeln( 'failed: set <= (11a)' );
   end;
   if not (vSi.sn >= s1) then begin
      pass := false;
      writeln( 'failed: set >= (11)' );
   end;
   if s1 >= vSi.sn then begin
      pass := false;
      writeln( 'failed: set >= (11a)' );
   end;

   if s1 = vSi.sn - [4] then begin
      pass := false;
      writeln( 'failed: set equal (12)' );
   end;
   if s1 <> vSi.sn - [-4] then begin
      pass := false;
      writeln( 'failed: set <> (12)' );
   end;
   if [ 1, 2, 3] >= [2, 3, 4] then begin
      pass := false;
      writeln( 'failed: set >= (12)' );
   end;
   if not ([ 1, 2, 3, 4] >= [2, 3, 4]) then begin
      pass := false;
      writeln( 'failed: set >= (13)' );
   end;
   if [ 1, 2, 3] <= [2, 3, 4] then begin
      pass := false;
      writeln( 'failed: set <= (12)' );
   end;
   if not ([ 1, 2, 3, 4] <= [1, 2, 3, 4]) then begin
      pass := false;
      writeln( 'failed: set <= (13)' );
   end;

   s64 := [-2, 5, 10];
   vSi.sn := [10..15];
   as2[false] := [];
   if s64+vSi.sn+as2[false] <> [-2, 5, 10] + [10..15] then begin
      pass := false;
      writeln( 'failed: set <> (13)' );
   end;
   if vSi.sn+s64+as2[false] <> [-2, 5, 10] + [10..15] then begin
      pass := false;
      writeln( 'failed: set <> (13a)' );
   end;

   as2[false] := [ 2, 4, 6];
   as2[true]  := [3, 6, 9];
   if as2[(as2[true]*as2[false] = [6])] <> [3, 6, 9] then begin
      pass := false;
      writeln( 'failed: recursive set compare (1)' );
   end;

   s1 := [-3, 3];
   sb := [ s1 = [-3, 3] ];
   if not (true in sb) or (false in sb) then begin
      pass := false;
      writeln( 'failed: recursive set compare (2)' );
   end;

   sb := [ 3 in s1 ];
   if not (true in sb) or (false in sb) then begin
      pass := false;
      writeln( 'failed: recursive set compare (3)' );
   end;

   { finally check that the guards have not been touched }
   if (vSi.guard1 <> -1) or (vSi.guard2 <> -1) then begin
      pass := false;
      writeln( 'failed: set overwrite' );
   end;

   {side effects}
   sidevar := ord('4');
   sc0 := [chr(sidevar)];
   s^ := ['z', chr(sideFun)] + sc0;
   if chr(sidevar) <> '5' then begin
      pass := false;
      writeln( 'failed: set with side effects (1)' );
   end;

   if not ('4' in s^) then begin
      pass := false;
      writeln( 'failed: set with side effects (2)' );
   end;

   for c := '9' downto '0' do begin
      if (c in s^) <> (c='4') then begin
         pass := false;
         writeln( 'failed: set with side effects (3), c is ''', c, '''' );
      end;
   end;

#if 0
   { the compiler treats this as a set of integer, rather than
   as a subrange of integer, so the test is not valid.
   TODO:  can the compiler be changed? }
   e1 := 100011; e2 := 100012; e3 := 100013;
   if [ e1, e2, e3 ] <> [ 100011, 100012, 100013 ] then begin
      pass := false;
      writeln( 'failed: set <>, extreme range' );
   end;
   if [ 100011, 100012, 100014 ] = [ e1, e2, e3 ] then begin
      pass := false;
      writeln( 'failed: set equals, extreme range' );
   end;
#endif

   dispose(s);

   p61; {test expressions with mixed set sizes }
   p63; {test compares with mixed set sizes }
   p64; {test compares with indeterminate set sizes }

   if pass then
      writeln( 'set tests passed' )
   else
      writeln( 'set tests failed' );
   writeln;

end; { p6 }


{ test maths functions: sin, cos, etc }
procedure p7;

const
#if REAL_DIGITS > 100
   #error "add more digits to constants"
#else
   {100 decimal places}
   pi  = 3.1415926535897932384626433832795028841971693993751058209749445923078164062862089986280348253421170676;
   ln2 = 0.6931471805599453094172321214581765680755001343602552541206800094933936219696947156058633269964186875;
#endif

var
   i     : integer;
   x,y   : real;
   z,d   : real;
   e1    : real;
   pion4 : real;
   pass  : boolean;

{ calculate pi }
function chudnovsky: real;
var
   a,b : real;
   procedure sumab(a0 : real; n:integer);
   var xa : real;
   begin
      xa := -a0*24*(6*n-5)*(2*n-1)*(6*n-1)/(n*n*n*640320.0*640320.0*640320.0);
      if xa >= eps then
         sumab(xa, n+1);
      a := a + xa;
      b := b + xa*n
   end; { sumab }
begin
   a := 1; b := 0;
   sumab(1,1);
   chudnovsky := 426880*sqrt(10005)/(a*13591409+b*545140134)
end; { chudnovsky }

{ test standard functions & procedures }
procedure p71;
type
   number = 0..99;
var
   pass : boolean;
   a,b  : boolean;
   i    : integer;
   c    : char;
   x    : real;

   ai1  : array[ 2..10 ] of number;
   pai1 : record
             guard0 : integer;
             a      :  packed array[ 1..5 ] of number;
             guard1 : char;
          end;
   abc1 : array[boolean] of array[char] of number;
   par1 : packed array[boolean] of packed array['2'..'9'] of number;

begin
   pass := true;

   if ord(false) <> 0 then begin
      pass := false;
      writeln( 'ord(false) is ', ord(false) );
   end;

   if ord(true) <> 1 then begin
      pass := false;
      writeln( 'ord(true) is ', ord(true) );
   end;

   if chr(ord('A')) <> 'A' then begin
      pass := false;
      writeln( 'ord(true) is ', ord(true) );
   end;

   if 3 * ord(4 + 1) <> 15 then begin
      pass := false;
      writeln( '3*ord(4+1) is ', 3*ord(4+1) );
   end;

   if ord(-1 + 6)*3 <> 15 then begin
      pass := false;
      writeln( '3*ord(4+1) is ', 3*ord(4+1) );
   end;

   if 2 * ord(succ(green)) <> 2*ord(green)+2 then begin
      pass := false;
      writeln( '2*ord(succ(green)) is ', 2*ord(succ(green)) );
   end;

   if odd(0) then begin
      pass := false;
      writeln( 'odd(0) is ', odd(0) );
   end;

   if not odd(-11) then begin
      pass := false;
      writeln( 'odd(-11) is ', odd(-11) );
   end;

   if not odd(89) then begin
      pass := false;
      writeln( 'odd(89) is ', odd(89) );
   end;

   if odd(220) then begin
      pass := false;
      writeln( 'odd(220) is ', odd(220) );
   end;

   if ord(odd(8+5)) <> 1 then begin
      pass := false;
      writeln( 'ord(odd(8+5)) is ', ord(odd(8+5)) );
   end;

   if abs(-16) <> 16 then begin
      writeln( 'abs(-16) is ', abs(-16) );
      pass := false;
   end;

   if abs(26) <> 26 then begin
      writeln( 'abs(26) is ', abs(26) );
      pass := false;
   end;

   if abs(26.5) <> 26.5 then begin
      writeln( 'abs(26.5) is ', abs(26.5) );
      pass := false;
   end;

   if sqr(abs(-6.5)) <> 42.25 then begin
      writeln( 'sqr(abs(-6.5)) is ', sqr(abs(-6.5)) );
      pass := false;
   end;

   if abs(-26.5) <> 26.5 then begin
      writeln( 'abs(-26.5) is ', abs(-26.5) );
      pass := false;
   end;

   if abs(-0.0) <> 0.0 then begin
      writeln( 'abs(0.0) is ', abs(0.0) );
      pass := false;
   end;

   x := -maxReal/2;
   if abs(x) <> maxReal/2 then begin
      writeln( 'fail: abs(-maxReal/2) is ', x );
      pass := false;
   end;

   if sqr(1.5) <> 2.25 then begin
      writeln( 'sqr(1.5) is ', sqr(1.5) );
      pass := false;
   end;

   if sqr(-2.5) <> 6.25 then begin
      writeln( 'sqr(1.2) is ', sqr(1.2) );
      pass := false;
   end;

   if sqr(-20) <> 400 then begin
      writeln( 'sqr(-20) is ', sqr(-20) );
      pass := false;
   end;

   if sqr(-8) <> 64 then begin
      writeln( 'sqr(-8) is ', sqr(-8) );
      pass := false;
   end;

   { avoid overflow due to rounding errors}
   x := sqrt(maxReal)*(1-eps);
   if sqr(x) < maxReal*(1-4*eps) then begin
      writeln( 'fail: sqr(max) is ', x );
      pass := false;
   end;
   x := -sqrt(maxReal)*(1-eps);
   if sqr(x) < maxReal*(1-4*eps) then begin
      writeln( 'fail: sqr(-max) is ', x );
      pass := false;
   end;


   if pred(16) <> 15 then begin
      writeln( 'pred(16) is ', pred(16) );
      pass := false;
   end;

   if pred(-166) <> -167 then begin
      writeln( 'pred(-166) is ', pred(-166) );
      pass := false;
   end;

   { test precedence of +/- 1 }
   a := true; b := true;
   if pred(a>=b) then begin
      writeln( 'pred(a>=b) is ', pred(a>=b) );
      pass := false;
   end;

   b := false;
   if not succ(a<b) then begin
      writeln( 'succ(a<b) is ', succ(a<b) );
      pass := false;
   end;

   if succ(22) <> 23 then begin
      writeln( 'succ(22) is ', succ(22) );
      pass := false;
   end;

   if succ(-999) <> -998 then begin
      writeln( 'succ(-999) is ', succ(-999) );
      pass := false;
   end;

   if succ(pred(-188)) <> -188 then begin
      writeln( 'succ(pred(-188)) is ', succ(pred(-188)) );
      pass := false;
   end;

   if pred(succ(188)) <> 188 then begin
      writeln( 'pred(succ(188)) is ', pred(succ(188)) );
      pass := false;
   end;

   if trunc(0.0) <> 0.0 then begin
      writeln( 'trunc(0.0) is ', trunc(0.0) );
      pass := false;
   end;

   if trunc(10.5) <> 10.0 then begin
      writeln( 'trunc(10.5) is ', trunc(10.5) );
      pass := false;
   end;

   if trunc(1.1) <> 1.0 then begin
      writeln( 'trunc(0.0) is ', trunc(0.0) );
      pass := false;
   end;

   if trunc(99.9) <> 99.0 then begin
      writeln( 'trunc(99.9) is ', trunc(99.9) );
      pass := false;
   end;

   if trunc(-0.0) <> 0.0 then begin
      writeln( 'trunc(0.0) is ', trunc(0.0) );
      pass := false;
   end;

   if trunc(-10.5) <> -10.0 then begin
      writeln( 'trunc(-10.5) is ', trunc(-10.5) );
      pass := false;
   end;

   if trunc(-1.1) <> -1.0 then begin
      writeln( 'trunc(-0.0) is ', trunc(-0.0) );
      pass := false;
   end;

   if trunc(-99.9) <> -99.0 then begin
      writeln( 'trunc(-99.9) is ', trunc(-99.9) );
      pass := false;
   end;

   if round(0.0) <> 0.0 then begin
      writeln( 'round(0.0) is ', round(0.0) );
      pass := false;
   end;

   if round(10.5) <> 11.0 then begin
      writeln( 'round(10.5) is ', round(10.5) );
      pass := false;
   end;

   if round(1.1) <> 1.0 then begin
      writeln( 'round(0.0) is ', round(0.0) );
      pass := false;
   end;

   if round(99.9) <> 100.0 then begin
      writeln( 'round(99.9) is ', round(99.9) );
      pass := false;
   end;

   if round(-0.0) <> 0.0 then begin
      writeln( 'round(0.0) is ', round(0.0) );
      pass := false;
   end;

   if round(-10.5) <> -11.0 then begin
      writeln( 'round(-10.5) is ', round(-10.5) );
      pass := false;
   end;

   if round(-1.1) <> -1.0 then begin
      writeln( 'round(-0.0) is ', round(-0.0) );
      pass := false;
   end;

   if round(-99.9) <> -100.0 then begin
      writeln( 'round(-99.9) is ', round(-99.9) );
      pass := false;
   end;

   { now check for side effects }
   sidevar := -1;
   if (abs( sideFun ) <> 1) or (sideVar <> 0) then begin
      pass := false;
      writeln('fail side effects for abs function' );
   end;
   if (ord( sideFun ) <> 0) or (sideVar <> 1) then begin
      pass := false;
      writeln('fail side effects for ord function' );
   end;
   if (succ( sideFun ) <> 2) or (sideVar <> 2) then begin
      pass := false;
      writeln('fail side effects for succ function' );
   end;
   if (pred( sideFun ) <> 1) or (sideVar <> 3) then begin
      pass := false;
      writeln('fail side effects for pred function' );
   end;
   if (not odd( sideFun )) or (sideVar <> 4) then begin
      pass := false;
      writeln('fail side effects for odd function' );
   end;
   if (sqr( sideFun ) <> 16) or (sideVar <> 5) then begin
      pass := false;
      writeln('fail side effects for sqr function' );
   end;
   if (chr( sideFun + ord('0') ) <> '5') or (sideVar <> 6) then begin
      pass := false;
      writeln('fail side effects for chr function' );
   end;
   if (trunc( sideFun + 1.5 ) <> 7) or (sideVar <> 7) then begin
      pass := false;
      writeln('fail side effects for trunc function' );
   end;
   if (round( sideFun + 1.6 ) <> 9) or (sideVar <> 8) then begin
      pass := false;
      writeln('fail side effects for round function' );
   end;

   { test pack/unpack }

   for i := 2 to 10 do begin
      ai1[i] := 3*i - 2;
   end;
   pai1.guard0 := 0;
   pai1.guard1 := chr(0);
   pack( ai1, 4, pai1.a ); { fill pai1.a from ai1[4...] }

   if pai1.guard0 <> 0 then begin
      writeln( 'pack writes to memory before destination array' );
      pass := false;
   end;
   if pai1.guard1 <> chr(0) then begin
      writeln( 'pack writes to memory following destination array' );
      pass := false;
   end;
   for i := 1 to 5 do begin
      if pai1.a[i] <> ai1[i+4-1] then begin
         pass := false;
         writeln('fail in pack function, pai1[', i:1, '] is ', pai1.a[i]:1 );
      end;
   end;

   for c := 'A' to 'Z' do begin
      abc1[true,c] := ord(c);
   end;
   pack( abc1[true], 'B', pai1.a );

   if pai1.guard0 <> 0 then begin
      writeln( 'pack writes to memory before destination array' );
      pass := false;
   end;
   if pai1.guard1 <> chr(0) then begin
      writeln( 'pack writes to memory after destination array' );
      pass := false;
   end;
   for i := 1 to 5 do begin
      if pai1.a[i] <> abc1[true,chr(i+ord('B')-1)] then begin
         pass := false;
         writeln('fail in pack function, pai1[', i:1, '] is ', pai1.a[i]:1 );
      end;
   end;

   par1[true,'2'] := 99;
   pack( ai1, 2, par1[false] );
   if par1[true,'2'] <> 99 then begin
      pass := false;
      writeln( 'overwrite on pack operation for 2d array destination' );
   end;
   for c := '2' to '9' do begin
      if par1[false, c] <> ai1[ord(c) - ord('2') + 2] then begin
         pass := false;
         writeln('fail in pack function, par1[', c, '] is ', par1[false,c]:1 );
      end;
   end;

   { unpack() }
   for i := 2 to 10 do begin
      ai1[i] := 8*i + 2;
   end;
   for i := 1 to 5 do begin
      pai1.a[i] := sqr(i) + i + 1;
   end;
   unpack( pai1.a, ai1, 3 );

   if ai1[2] <> 18 then begin
      writeln( 'unpack writes to memory before destination array' );
      pass := false;
   end;
   for i := 8 to 10 do begin
      if ai1[i]<> 8*i + 2 then begin
         writeln( 'unpack writes to memory after destination array' );
         pass := false;
      end;
   end;
   for i := 3 to 7 do begin
      if ai1[i] <> pai1.a[i-3+1] then begin
         pass := false;
         writeln('fail in pack function, ai1[', i:1, '] is ', ai1[i]:1 );
      end;
   end;

   for c := 'A' to 'Z' do begin
      abc1[false,c] := ord(c)-1;
   end;
   unpack( pai1.a, abc1[false], 'D' );

   if abc1[false,'C'] <> ord('C')-1 then begin
      writeln( 'unpack writes to memory before destination array' );
      pass := false;
   end;
   if abc1[false,'I'] <> ord('I')-1 then begin
      writeln( 'unpack writes to memory after destination array' );
      pass := false;
   end;
   for c := 'D' to 'H' do begin
      if abc1[false,c] <> pai1.a[ord(c) - ord('D') + 1]  then begin
         pass := false;
         writeln('fail in pack function, abc1[', c, '] is ', abc1[false,c] );
      end;
   end;

   for i := 2 to 10 do begin
      ai1[i] := 20+i;
   end;
   for c := '2' to '9' do begin
      par1[true,c] := 99-ord(c);
   end;
   unpack( par1[true], ai1, 3 );
   if ai1[2] <> 22 then begin
      pass := false;
      writeln( 'overwrite on unpack operation for 2d array destination' );
   end;
   for i := 3 to 10 do begin
      if ai1[i] <> par1[true, chr(i - 3 + ord('2'))] then begin
         pass := false;
         writeln('fail in pack function, ai1[', i:1, '] is ', ai1[i]:1 );
      end;
   end;

   { TODO: test pack/unpack for pointers, var params }


   if  pass then
      writeln( 'standard functions passed' )
   else
      writeln( 'standard functions failed' );
   writeln;

end; { p71 }

begin { p7 }

   writeln( 'testing maths & standard functions' );

   pass := true;

   p71;

   x := sqrt(1.44);
   if (x < 1.2 - eps) or (x > 1.2 + eps) then begin
      writeln( 'sqrt 1.44 is ', sqrt(1.44) );
      pass := false;
   end;
   x := 0.5;
   repeat
      if abs(sqr(sqrt(x)+x/4) - (x +x*sqrt(x)/2 + sqr(x)/16)) > 4*eps then begin
         writeln( 'fail: sqrt test, x is ', x:1:7 );
         pass := false;
      end;
      x := x + 0.0078125;
   until x > 2.0;
   x := 1; y:= 1;
   repeat
      if abs(sqr(sqrt(x)) - x) > 4*x*eps then begin
         writeln( 'fail: sqrt test, x is ', x:8 );
         pass := false;
      end;
      if abs(sqr(sqrt(y)) - y) > 4*y*eps then begin
         writeln( 'fail: sqrt test, y is ', y:8 );
         pass := false;
      end;
      x := x/10;
      y := 10*y;
   until x < minReal;

   if abs(chudnovsky - pi) > eps then begin
      writeln( 'fail: (1) incorrect pi is ', chudnovsky );
      pass := false;
   end;

   pion4 := arctan(1.0);
   if (pion4 - eps > pi/4) or (pion4 + eps < pi/4) then begin
      writeln( 'fail: (2) incorrect pi/4 is ', pion4 );
      pass := false;
   end;

   pion4 := -arctan(-1.0);
   if (pion4 - eps > pi/4) or (pion4 + eps < pi/4) then begin
      writeln( 'fail: (3) incorrect pi is ', pion4 );
      pass := false;
   end;

   pion4 := 4*arctan(1/5) - arctan(1/239);
   if (pion4 - eps > pi/4) or (pion4 + eps < pi/4) then begin
      writeln( 'fail: (4) incorrect pi is ', pion4 );
      pass := false;
   end;
   pion4 := 5*arctan(1/7) + 2*arctan(3/79);
   if (pion4 - eps > pi/4) or (pion4 + eps < pi/4) then begin
      writeln( 'fail: (5) incorrect pi is ', pion4 );
      pass := false;
   end;

   x := -10;
   y :=arctan(x); z := arctan(x/1);
   if y <> z then begin
      pass := false;
      writeln( 'arctan div test 1 failed' );
      writeln( y:33, ', ', z:33, ', ', y-z:33 );
   end;
   y := arctan(-x); z := arctan(x/(-1));
   if y <> z then begin
      pass := false;
      writeln( 'arctan div test 2 failed' );
   end;
   y := arctan(x); z := arctan((-x)/(-1));
   if y <> z then begin
      pass := false;
      writeln( 'arctan div test 3 failed' );
   end;
   y := arctan(-x); z := arctan((-x)/1);
  if y <> z then begin
      pass := false;
      writeln( 'arctan div test 4 failed' );
   end;

   x := cos(0.0);
   if (x < 1-eps) or (x > 1+eps) then begin
      writeln( 'cos(0) is ', cos(0.0) );
      pass := false;
   end;

   x := cos(pi);
   if (x < -1-eps) or (x > -1+eps) then begin
      writeln( 'cos(pi) is ', cos(pi) );
      pass := false;
   end;

   x := cos(pi/4);
   if (x < 1/sqrt(2)-eps) or (x > 1/sqrt(2)+eps) then begin
      writeln( 'cos(pi/4) is ', cos(pi/4) );
      pass := false;
   end;

   x := sin(pi/2);
   if (x < 1-eps) or (x > 1+eps) then begin
      writeln( 'sin(pi/2) is ', sin(pi/2) );
      pass := false;
   end;

   x := 2*sin(2*pi/3);
   if (x < sqrt(3)-eps) or (x > sqrt(3)+eps) then begin
      writeln( 'sin(pi/3) is ', sin(pi/3) );
      pass := false;
   end;

   e1 := exp(-1);   {writeln( 'e is ', 1/e1:1:33 );}
   x := exp(1.0);
   if abs(x*e1 - 1) > eps then begin
      writeln( 'exp -1.0 is ', exp(-1.0) );
      pass := false;
   end;

   x := exp(-0.5);
   if abs(sqr(x) - e1) > eps then begin
      writeln( 'exp -1.0 is ', exp(-1.0) );
      pass := false;
   end;

   x := sqrt(eps);
   {writeln( 'dx is ', x:20, ', exp(x)-1 is ', exp(x) - 1.0:20 );}
   if abs(exp(x) - 1 - x)  > eps then begin
      writeln( 'exp dx is ', exp(x) );
      pass := false;
   end;

   x := exp(ln2);
   if (x < 2*(1-eps)) or (x > 2*(1+eps)) then begin
      writeln( 'exp(ln2) is ', exp(ln2) );
      pass := false;
   end;

   x := ln(10) - ln(5);
   if abs(x - ln2) > 2*eps then begin
      writeln( 'ln2 is ', ln2,  ', error is ', abs(x-ln2)/eps:1:1, '*eps' );
      pass := false;
   end;

   x := -10;
   while x < 10 do begin
      y := exp(x + ln2);
      z := exp(x);
      if abs(2*z - y) > abs(y*eps) then begin
         writeln( 'fail: exp ln2, x is ', x:5:2, ', error is ', abs(y-2*z)/eps:1:1, '*eps' );
         pass := false;
      end;
      x := x+0.5;
   end;

   i := 0;
   x := 1;
   z := ln(10);
   while (i < REAL_MAX_EXP) and (i > REAL_MIN_EXP) do begin
      y := exp(i*z);
      if abs(x-y) > 3*i*x*eps then begin
         pass := false;
         writeln('fail: exp(', i:1, '*ln10) is ', y:1, ' expected ', x:1,
                 ', error is ', abs(x-y)/x/eps:1);
      end;

      y := exp(-i*z);
      if abs(x*y - 1) > 3*i*eps then begin
         pass := false;
         writeln('fail: exp(-', i:1, '*ln10) is ', y:1, ' expected ', 1/x:1,
                 ', error is ', abs(x*y - 1)/eps:1);
      end;

      i := i+1;
      x := 10*x;
   end;

   if abs(ln(1+eps) - eps) > sqr(eps) then begin
      writeln( 'ln(1+eps) - eps is ', ln(1+eps) - eps );
      pass := false;
   end;

   x := ln(64)/ln2;
   if abs(x - 6) > 6*eps then begin
      writeln( 'lg(64) is ', x, ', error is ', abs(x-6)/eps:1:1, '*eps' );
      pass := false;
   end;

   x := exp(ln(42));
   if (x < 42*(1-eps)) or (x > 42*(1+eps)) then begin
      writeln( 'exp(ln(42)) is ', exp(ln(42)) );
      pass := false;
   end;

   x := exp(sin(pi/3)*2);              { sin(pi/3) is sqrt(3)/2 }
   if abs(x - exp(sqrt(3))) > 6*eps then begin
      writeln( 'failed, exp(sin(pi/3)) is ', exp(sin(pi/3)) );
      pass := false;
   end;

   {exp(ln(a)*b) is implemented as pow(a,b) - check}
   x := 1.0; y := ln(100);
   repeat
      if abs(exp(ln(x)*2) - sqr(x)) > 2*sqr(x)*ln(x)*eps then begin
         pass := false;
         writeln( x:7, '**2 failed, x is ', x:7, ', exp(ln(x)*2) is ', exp(ln(x)*2));
      end;
      if abs(exp(0.5*ln(x)) - sqrt(x)) > 0.5*sqr(x)*ln(x)*eps then begin
         pass := false;
         writeln( x:7, '**0.5 failed, x is ', x:7, ', exp(ln(x)*0.5) is ', exp(ln(x)*0.5));
      end;

      if abs( exp(ln(x) + y) - 100*x ) > 100*ln(100+x)*x*eps then begin
         pass := false;
         writeln( x:7, 'exp() failed, x is ', x:7, ', exp(ln(x) + ln(100)) is ', exp(ln(x)+y) );
         //writeln('error is ', (exp(ln(x) + y) - 100*x)/(x*ln(100+x)*eps):5:1, ' * x * eps' );
      end;
      x := 10*x;
   until x > sqrt(maxReal);

   x := 0.1; y := ln(100);
   repeat
      if abs(exp(2*ln(x)) - sqr(x)) > 2*exp(x)*eps then begin
         pass := false;
         writeln( x:7, '**2 failed, x is ', x:7, ', exp(ln(x)*2) is ', exp(ln(x)*2));
      end;
      if abs(exp(ln(x)*0.5) - sqrt(x)) > 0.5*exp(x)*eps then begin
         pass := false;
         writeln( x:7, '**0.5 failed, x is ', x:7, ', exp(ln(x)*0.5) is ', exp(ln(x)*0.5));
      end;

      if abs( exp(ln(x) + y) - 100*x ) > abs(200*ln(x)*x*eps) then begin
         pass := false;
         writeln( x:7, 'exp() failed, x is ', x:7, ', exp(ln(x) + ln(100)) is ', exp(ln(x)+y) );
         writeln('error is ', (exp(ln(x) + y) - 100*x)/(x*ln(x)*eps):5:1, ' * x * eps' );
      end;
          x := 0.1*x;
   until sqr(x) < minReal;


   x := arctan(sin(1)/cos(1));
   if (x < 1-eps) or (x > 1+eps) then begin
      writeln( 'arctan(sin(1)/cos(1)) is ', arctan(sin(1)/cos(1)) );
      pass := false;
   end;

   x := ln(sqrt(exp(2*42)));
   if (x < 42-eps) or (x > 42+eps) then begin
      writeln( 'ln(sqrt(exp(2*42)) ) is ', ln(sqrt(exp(2*42))) );
      pass := false;
   end;

   x := 1;
   i := 0;
   repeat
      if abs(ln(x) + i*ln2 ) > 4*i*eps then begin
         writeln( 'ln(', x:9, ' is ', ln(x), ', expected ', -ln2*i );
         pass := false;
      end;
      if abs(exp(-i*ln2) - x) > 4*i*x*eps then begin
         writeln( 'exp(', -i*ln2:9, ' is ', exp(-i*ln2), ', expected ', x );
         pass := false;
      end;
      if abs(ln(1/x) - i*ln2 ) > 4*i*eps then begin
         writeln( 'ln(', 1/x:9, ' is ', ln(1/x), ', expected ', ln2*i );
         pass := false;
      end;
      if abs(exp(i*ln2) - 1/x) > 4*i*eps/x then begin
         writeln( 'exp(', i*ln2:9, ' is ', exp(i*ln2), ', expected ', 1/x );
         pass := false;
      end;
      x := x/2;
      i := i+1;
   until x <= minReal;

   if pass then
      writeln( 'maths test passed' )
   else
      writeln( 'maths test failed' );
   writeln;
end; { p7 }


procedure p8; forward;

{ test function arguments }
procedure p8;

const
   city =  'Canberra';

type
   at  = array[1..4] of boolean;
   st  = set of char;
   ift = file of integer;
   pit = ^integer;
   rt  = record
            i1  : integer;
            x1  : real;
            c1  : char;
            b1  : boolean;
            s1  : st;
            str : packed array[1..5] of char;
         end;
   rpt = ^rt;
   strt = packed array[1..8] of char;

var
   pass : boolean;
   r    : rt;
   rp   : ^rt;
   a    : at;
   i    : integer;
   s    : st;
   sCap : set of 'A'..'Z';
   f    : ift;
   pi   : pit;
   x    : real;
   c    : char;
   b    : boolean;
   str  : strt;
   str1 : packed array[1..8] of char;
   str2 : array[1..8] of char;

   function pow(a : real;  b : real) : real; external;
   function tgamma(a : real) : real; external;

   { should be able to declare a procedure called external}
   procedure external;
   begin
      x := 99.5;
   end; { external }

   { test value params }
   { test pointers value/var }
   { test with fields value/var }
   { file value param is illegal }

   function p800( i1: integer; x1 : real; c1 : char; b1 : boolean ) : boolean;
   begin
      p800 := (i1 = 13) and (x1 = 6.25) and (c1 = 'c') and b1;
   end; { p800 }

   function p801( r1 :  rt ) : boolean;
   begin
      with r1 do
         p801 := (i1 = 31) and (x1 = 16.25) and (c1 = 'Q') and b1
                 and (s1 = [ 'c', 'a', 't' ]) and (str = 'tiger' );
   end; { p801 }

   function p802( a1 : at ) : boolean;
   begin
      p802 := not a[1] and a[2] and not a[3] and a[4];
   end; { p802 }

   function p803( s1 : st ) : boolean;
   begin
      p803 := s1 = [ 'A', 'E', 'I', 'O', 'U' ];
   end; { p803 }

   function p804( pi1: pit; c1 : char; b1 : boolean ) : boolean;
   begin
      p804 := (pi1^ = 543) and (c1 = 'Z') and not b1;
   end; { p804 }

   function p805( r1p :  rpt ) : boolean;
   begin
      with r1p^ do
         p805 := (i1 = 311) and (x1 = 61.25) and (c1 = 'K')
                and not b1 and (s1 = [ 'z', 'e', 'b', 'r', 'a' ]);
   end; { p805 }

   function p806( s :  strt ) : boolean;
   begin
      p806 := s = 'Adelaide';
   end; { p806 }

   function p807(b : boolean ) : boolean;
   begin
      p807 := b;
   end; { p807 }


   { test var params }
   procedure p810( var i1: integer; var x1 : real;
                   var c1 : char; var b1 : boolean );
   begin
      i1 := 13;
      x1 := 6.25;
      c1 := 'c';
      b1 := true;
   end; { p810 }

   procedure p811( var r1 :  rt );
   begin
      with r1 do begin
         p810( i1, x1, c1, b1 );
         i1 := i1+18 {31};
         x1 := x1 + 10 {16.25};
         s1 := [ 'c', 'a', 't' ];
         str := 'tiger';
      end;
      r1.c1 := 'Q';
      {r1.b1 := true;}
   end; { p811 }

   procedure p812( var a1 : at );
   begin
      a1[1] := false;
      a1[2] := true;
      a1[3] := false;
      a1[4] := true;
   end; { p812 }

   procedure p813( var s1 : st );
   begin
      s1 := [ 'A', 'E', 'I', 'O', 'U' ];
   end; { p813 }

   procedure p814( var pi1: pit; var c1 : char; var b1 : boolean );
   begin
      pi1^ := 543;
      c1 := 'Z';
      b1 := false;
   end; { p814 }

   procedure p815( var r1p :  rpt );
   begin
      r1p^.s1 := [ 'z', 'e', 'b', 'r', 'a', 't' ];
      with r1p^ do begin
         i1 := 311;
         x1 := 61.25;
         c1 := 'K';
         b1 := false;
         s1 := s1 - ['t'];
         str := 'Tiger';
      end;
      r1p^.str[1] := 't';
   end; { p815 }

   procedure p816(var s :strt );
   begin
      s := 'Adelaide';
   end; { p816 }

   procedure p819( var f1: ift );
   begin
      rewrite( f1 );
      f1^ := 42;
      put( f1 );
   end; { p819 }


   { forward procs/funcs }

   { call chain is: main -> f820 -> p821 -> p822 -> f820 -> main }
   function f820( i1 : integer; var v : real ) : integer; forward;
   procedure p822( i1, j1 : integer; var v : real ); forward;

   procedure p821( var v : real );
   begin
      p822( 1, 13, v );
   end; { p821 }

   function f820;
   begin
      if i1 = 0 then
         p821( v )
      else begin
         sCap := [ 'O', 'K' ];
         v := 125.125
      end;
      f820 := 42;
   end; { f820 }

   procedure p822;
   begin
      if (i1 <> 1) or (j1 <> 13) then
         sCap := [ 'B', 'A', 'D' ]
      else
         i1 := f820( 1, v );
   end; { p822 }


   { test function/procedure params }

   procedure p830( i, j :integer; var v : real  );
   begin
      p822( i, j, v );
   end;

   procedure p831( procedure p( i,j :integer; var v : real ); var v : real );
   begin
      p( 1, 13, v );
   end;

   procedure p832( procedure p( procedure pp( i,j :integer; var v : real );
                                var v : real);
                   var v : real);
   begin
      p( p830, v );
   end;

   function f835( i, j :integer  ) : integer;
   begin
      f835 := j - i;
   end;

      function f836(function f( i,j : integer ):integer ) : integer;
   begin
      f836 := 10 * f( 1, 13 ) + 6; { = 126 }
   end;

      function f837(function f(function ff( i,j : integer ) : integer ) : integer ) : integer;
   begin
      f837 := 10 * f( f835 ) + 7; { = 1267 }
   end;


   { others? }

begin
   pass := true;

   { test external directive }
   x := pow( 1.69, 0.5 );
   if abs(x-1.3) >= 0.001 then begin
      pass := false;
      writeln( 'fail: external directive 1, x is ', x );
   end;

   x := Pow( 2.25, 0.5 ); { case not significant here }
   if abs(x-1.5) >= 0.001 then begin
      pass := false;
      writeln( 'fail: external directive case, x is ', x );
   end;

   x := tgamma( 0.5 );
   if abs(sqr(x)-355/113) >= 0.001 then begin
      pass := false;
      writeln( 'fail: external directive 2, x is ', x );
   end;

   x := 0;
   external;
   if x <> 99.5 then begin
      pass := false;
      writeln( 'external not recognised as an identifier' );
   end;

   p810( i, x, c, b );
   if not p800( i, x, c, b ) then begin
      pass := false;
      writeln( 'failed: params basic types' );
   end;

   with r do begin
      i1 := 13;
      x1 := 6.25;
      c1 := 'c';
      b1 := true;
      if not p800( i1, x1, c1, b1 ) then begin
         pass := false;
         writeln( 'failed: value params record field types' );
      end;
   end;

   p811( r );
   if not p801( r ) then begin
      pass := false;
      writeln( 'failed: param record' );
   end;

   p812( a );
   if not p802( a ) then begin
      pass := false;
      writeln( 'failed: param array' );
   end;

   sCap := [ 'A', 'E', 'I', 'O', 'U' ];
   if not p803( sCap ) then begin
      pass := false;
      writeln( 'failed: value param set (1)' );
   end;

   if not p803( [ 'A', 'E', 'I', 'O', 'U' ] ) then begin
      pass := false;
      writeln( 'failed: value param set (2)' );
   end;
   sCap := [];
   if p803( sCap ) then begin
      pass := false;
      writeln( 'failed: value param set (3)' );
   end;

   p813( r.s1 );
   if not p803( r.s1 ) then begin
      pass := false;
      writeln( 'failed: param set (4)' );
   end;

   with r do begin
      p813( s1 );
      if not p803( s1 ) then begin
         pass := false;
         writeln( 'failed: param set (5)' );
      end;
   end;

   new( rp );
   with rp^ do begin
      p813( s1 );
      if not p803( s1 ) then begin
         pass := false;
         writeln( 'failed: param set (6)' );
      end;
   end;
   dispose( rp );

   p813( s );
   if not p803( s ) then begin
      pass := false;
      writeln( 'failed: param set (7)' );
   end;

   new( pi );
   p814( pi, r.c1, a[4] );
   if not p804( pi, r.c1, a[4] ) then begin
      pass := false;
      writeln( 'failed: value params advanced types' );
   end;
   dispose( pi );

   if not p806( 'Adelaide' ) then begin
      pass := false;
      writeln( 'failed: value params strings (1)' );
   end;
   if p806( 'Brisbane' ) then begin
      pass := false;
      writeln( 'failed: value params strings (2)' );
   end;
   if p806( city ) then begin
      pass := false;
      writeln( 'failed: value params strings (3)' );
   end;
   p816( str );
   if not p806( str ) then begin
      pass := false;
      writeln( 'failed: value params strings (4)' );
   end;

   { p816( str1 ); compiler doesn't allow this }
   str1 := 'Adelaide';
   if not p806( str1 ) then begin
      pass := false;
      writeln( 'failed: value params strings (5)' );
   end;

   if not p807( str1 = 'Adelaide' ) then begin
      pass := false;
      writeln( 'failed: boolean value parameter (strings)' );
   end;

   sCap := [ 'A', 'E', 'I', 'O', 'U'];
   if p807( sCap <= [ 'G'..'T' ] ) then begin
      pass := false;
      writeln( 'failed: boolean value parameter (sets)' );
   end;

   p819( f );
   reset( f );
   read( f, i );
   if i <> 42  then begin
      pass := false;
      writeln( 'failed: param file, i is ', i:1 );
   end;

   sCap := [];
   x := 0;
   i := f820( 0, x );
   if sCap <> [ 'O', 'K' ] then begin
      pass := false;
      writeln( 'failed: forward reference' );
   end;

   if x <> 125.125 then begin
      pass := false;
      writeln( 'failed: var parameter' );
   end;

   { test function parameters }
   sCap := [];
   x := 0;
   p832( p831, x );
   if sCap <> [ 'O', 'K' ] then begin
      pass := false;
      writeln( 'failed: procedure parameter (1)' );
   end;

   if x <> 125.125 then begin
      pass := false;
      writeln( 'failed: procedure parameter (2)' );
   end;

   if f837( f836 ) <> 1267 then begin
      pass := false;
      writeln( 'failed: function parameter (1)' );
   end;


   if pass then
      writeln( 'function arguments test passed' )
   else
      writeln( 'function arguments test failed' );
   writeln;
end; { p8 }


{ test pointers, dynamic memory & recursive data structures
  this includes checking that the c declarations are generated
  in the correct order.
}
procedure p9;

{ TODO: write code to check all these data structures work }

type
   { forward references }
   tpFlower  =  ^tFlower;
   tpA1      = ^tpA;
   tFlower = (rose, daffodil, buttercup, daisy, violet);
   tpA       = array[1..10] of char;

   node = record
             left    : ^node;
             right   : ^node;
             payload : integer;
          end;

{test forward pointers & links in recursive data structures}
{ recursive references }
   (* check fwd ref inside nested structs
    * check fwd ref twice or more so duplicates fwd refs not issued
    *)
   tpra = ^tra;
   tprb = ^trb;
   tra = record
            ra1: record
                linkb : tprb;
            end;
            id1a   : integer;
            id2a   : char;
            linka  : tpra{^tra};
         end;
   { tbird is here to stress the declaration ordering for c.
     if trb gets moved to solve recursive references, so should tbird }
   tbird = (eagle, woodpecker, turkey, pigeon);
   trb = record
            link : tpra;
            id1b   : woodpecker..pigeon;
            id2b   : char;
            ra1: record
                linka : tpra{^tra};
            end;
         end;

   { test self referencing pointers }
   tSelf = ^tSelf;
   tp1 = ^tp2;
   tp2 = ^tp3;
   tp3 = ^tp1;
   tppp1 = ^this1;
   this1 = array[1..10] of tppp1;
   this3 = array[1..10] of ^this3; {TODO: ^^ is illegal, but shouldn't crash}

   pp1 = array[1..3] of ^pp2;
   pp2 = array[1..3] of ^pp1;

   tppp2 = ^this2;
   this2 = array[1..4] of record
                            c : char;
                            d : ^tppp2;
                            e : ^this2;
                            s : tSelf;
                          end;

   tppp20 = ^this20;
   this20 = record
               c : char;
               d : ^tppp20;
               e : ^this20;
            end;

   tI1 = record            { this record is used in test p900 }
            pI :integer;
         end;

var
   i          : integer;
   f1         : tpFlower;
   a          : tpA1;
   tree       : ^node;
   pra        : tpra;
   prb        : tprb;
   tme1, tme2 : tSelf;
   af         : array[-1..5] of ^tpFlower;
   pass       : boolean;
   v1         : tp1;
   v2         : tp2;
   v3         : tp3;
   vthis3     : this3;
   va         : tppp1;
   va1        : this1;
   vpp1       : pp1;
   vb         : this2;
   vb20       : this20;

{ another pointer test }
procedure p900;
type
        t1 = record
                p1 : ^tB1;  { tB1 points to boolean record below}
                p2 : tI1;   { tI1 refers to integer record above}
                end;

tB1 = record
       pB : boolean;
      end;

var
  v1 : t1;

function f910: pr;
begin
   f910 := nil;
end;

begin
   new(v1.p1);

   v1.p1^.pB := f910 <> nil;
   v1.p2.pI := 13;

   if (v1.p2.pI <> 13) or v1.p1^.pB then begin
      pass := false;
      writeln( 'pointer test 900 failed' );
   end;

   dispose(v1.p1);

end; {p900}


begin { p9 }
   pass := true;

   new(f1);
   f1^ := daffodil;

   for i := -1 to 5 do
      new(af[i]);
   sidevar := 1;
   af[1]^ := f1;
   if pred(af[1]^^) <> rose then begin
      writeln('pointer test 10 failed');
      pass := false;
   end;

   sidevar := 1;
   af[sideFun]^ := f1;
   if sideVar <> 2 then begin
      writeln('pointer test 11 failed, sideVar is ', sidevar:1);
      pass := false;
   end;
   if af[1]^^ <> daffodil then begin
      writeln('pointer test 12 failed');
      pass := false;
   end;

   for i := -1 to 5 do
      dispose(af[i]);
   dispose(f1);

   new(a);
   a^[1] := '0';
   for i := 2 to 10 do
      a^[i] := succ(a^[i-1]);
   if a^[10] <> '9' then begin
      writeln('pointer test 20 failed');
      pass := false;
   end;
   dispose(a);

   new(tree);
   tree^.left := nil;
   tree^.right := nil;
   tree^.payload := 42;
   if tree^.payload <> 42 then begin
      writeln('pointer test 30 failed');
      pass := false;
   end;
   dispose(tree);

   new(pra); new(prb);
   pra^.ra1.linkb := prb;
   prb^.link := pra;

   prb^.id2b := 'b';
   pra^.ra1.linkb^.id1b := woodpecker;
   prb^.link^.id1a := 170;

   pra^.ra1.linkb^.ra1.linka := pra^.ra1.linkb^.link; { = pra }
   pra^.linka := pra;


   pra^.id2a := 'a';

   if prb^.link^.id2a <> 'a' then begin
      writeln('pointer test 40 failed');
      pass := false;
   end;
   if pra^.id1a <> 170 then begin
      writeln('pointer test 50 failed');
      pass := false;
   end;
   if prb^.id1b <> woodpecker then begin
      writeln('pointer test 60 failed');
      pass := false;
   end;
   if pra^.ra1.linkb^.ra1.linka^.ra1.linkb^.id2b <> 'b' then begin
      writeln('pointer test 70 failed');
      pass := false;
   end;

   new(tme1); new(tme2);

   tme1^ := tme2; tme2^ := tme1;
   if (tme1^^ <> tme1) or (tme2^^^^ <> tme1^^^) then begin
      writeln('pointer test 80 failed');
      pass := false;
   end;

   new(v1); new(v2); new(v3);

   v1^ := v2; v2^ := v3; v3^ := v1;
   if (v3^^^ <> v3) or (v2^^^^ <> v3) or (v1^^^^^ <> v3)  then begin
      writeln('pointer test 90 failed');
      pass := false;
   end;

   new(vthis3[3]);
   vthis3[3]^ := vthis3;
   if vthis3[3]^[3] <> vthis3[3]  then begin
      writeln('pointer test 100 failed');
      pass := false;
   end;
   dispose(vthis3[3]);


   new(va);
   va1 := va^;
   for i := 1 to 10 do
      va^[i] := nil;
   va^[5] := va;
   va := va^[5];

  if va^[5] <> va then begin
      writeln('pointer test 110 failed');
      pass := false;
   end;
  if va^[5]^[6] <> nil then begin
      writeln('pointer test 120 failed');
      pass := false;
   end;
   if va^[5]^[5] <> va then begin
      writeln('pointer test 130 failed');
      pass := false;
   end;

   dispose(va);

   new(vpp1[1]);
   new(vpp1[1]^[2]);

   vpp1[1]^[2]^ := vpp1;
   if vpp1[1]^[2]^[1] <> vpp1[1] then begin
      writeln('pointer test 140 failed');
      pass := false;
   end;

   dispose(vpp1[1]^[2]);
   dispose(vpp1[1]);

   vb[1].c := 'a'; vb[2].c := 'b'; vb[3].c := 'c'; vb[4].c := 'd';
   new(vb[3].d);
   new(vb[3].d^);
   vb[3].d^^ := vb;
   if (vb[3].d^^[1].c <> 'a')
         or  (vb[3].d^^[2].c <> 'b')
         or  (vb[3].d^^[3].c <> 'c')
         or  (vb[3].d^^[4].c <> 'd')  then begin
      writeln('pointer test 150 failed');
      pass := false;
   end;
   dispose(vb[3].d^);
   dispose(vb[3].d);

   new(vb[3].e);
   vb[3].e^ := vb;
   if (vb[3].e^[1].c <> 'a')
         or  (vb[3].e^[2].c <> 'b')
         or  (vb[3].e^[3].c <> 'c')
         or  (vb[3].e^[4].c <> 'd')  then begin
      writeln('pointer test 160 failed');
      pass := false;
   end;
   dispose(vb[3].e);

   vb20.c := 'Z';
   new(vb20.d);
   new(vb20.d^);
   vb20.d^^ := vb20;
   if vb20.d^^.c <> 'Z'  then begin
      writeln('pointer test 170 failed');
      pass := false;
   end;
   dispose(vb20.d^);
   dispose(vb20.d);

   new(vb20.e);
   vb20.e^ := vb20;
   if vb20.e^.c <> 'Z'  then begin
      writeln('pointer test 180 failed');
      pass := false;
   end;
   dispose(vb20.e);

   dispose(v1); dispose(v2); dispose(v3);
   dispose(tme1); dispose(tme2);
   dispose(pra); dispose(prb);

   p900;

   if pass then
      writeln( 'pointer test passed' )
   else
      writeln( 'pointer test failed' );
   writeln;

end; { p9 }


begin

  p0;  { declarations & c identifiers }
  p1;  { expressions & statements }
999:
  if gototest then
     p1000;

  p2;  { strings }
  p3;  { write & writeln formatting }
  p4;  { files }
  p5;  { arrays & records }
  p6;  { sets }
  p7;  { maths & standard functions }
  p8;  { function parameters }
  p9;  { pointers, dynamic memory, recursive data structures }

   {test embedded c code ...}

{@@
   {
   int check = 0;
   check++;
@@}                                {2 lines of c code}

   (*@@ check++;
                           @@*)    {using alternative comment markers}

   { @@  c line a  @@}             {should be a pascal comment}
   {@ @  c line b  @@}             {should be a pascal comment}
   {@@
    @@}                            {empty line}

   {@@ #if 0 @@}                   {c preprocessor ... }
   {@@ junk 1 @ @}  @@@} {}        {... disables a few ...}
   {@@ junk2 @@ }
   {@@  sb new line here
       @@}                         {... lines of junk }
{@@    #endif @@}                  {end of junk}

{ embedded end of comment is ignored }
{@@
    if(!(void*)0)
         {check++;}
    if(check==3){printf("embedded c code test passed\n");}
    }
@@} {}



end.

{ ============= end of tp5c.pas ================= }
