{

These are pascal non conformance tests, these errors are expected to be found at run time
All programs are in one file so they can be managed easily.
To run the tests, first separate it into separate test programs,
eg use this awk script ...

awk 'BEGIN { FS="[ (]"; i=-1} \
/TEST/ {i=0}; \
i>=0 { l[i++]=$0}; \
/^\s*program\s+e/ { name=$2 }; \
/^\s*end\s*\./ {print "{ --- DO NOT EDIT THIS FILE --- }" > name ".p" ;\
n=i; for(i=0; i<n; i++) print l[i] > name ".p"; i=-1 }' \
ErrorHandling.pas
}


{TEST 6.1.8a }
{test that premature eof inside a comment is well handled }
program e6p1p8a( output );

{ comment, file ends here -->
end.

{TEST 6.2.1a }
{labels must be uniquely defined. }
program e6p2p1a(output);
label 1;

begin
1:   writeln(' ERROR NOT DETECTED ... 6.2.1a duplicate label definitions' );
1:   if false then goto 1;   {!!! duplicate label}
end. {e6p2p1a}


{TEST 6.2.1b }
{labels must be declared once only. }
program e6p2p1b(output);
label 1, 1;   {!!! duplicate label}

begin
     if false then goto 1;
1:   writeln(' ERROR NOT DETECTED ... 6.2.1a duplicate label declarations' )
end. {e6p2p2b}


{TEST 6.2.1c}
{ Check to see that undefined labels are not permitted. }
program e6p2p1c(output);
label 3;
begin
    goto 3; { !!! label not defined}
    writeln(' ERROR NOT DETECTED ... 6.2.1c, UNDEFINED LABEL')
end.


{TEST 6.2.1d}
{ labels must be defined in the same block as they are declared. }
program e6p2p1d(output);
label 3;
procedure inner;
begin
3: writeln;  {!!! label declared in outer block}
end;
begin
    goto 3; { !!! label not defined here}
    writeln(' ERROR NOT DETECTED ... 6.2.1d, LABEL BLOCKS')
end.


{ ------- 6.2.2 Scopes -------  }

{TEST 6.2.2a }
{The occurrence of an identifier within an identifier 1ist of a pararmeter group
is its defining occurrence as a parameter identifer for the formal parameter
list in which it occurs and any corresponding procedure block or function block.
Check if the compiler detects that the return type of a function is outside this scope. }
program e6p2p2a(output);
type
   ttt = integer;
var
   i : integer;

{ here, function ttt introduces a new scope,
  while ttt the return type is in outer scope}
function ttt(arg:  integer) : ttt; {!!! ttt is already used in this scope}
begin
   ttt := 2*arg;
end;

begin
   i := ttt(5);
   writeln(' ERROR NOT DETECTED ... 6.2.2a redefine name in same scope' )
end. {e6p2p2a}


{TEST 6.2.2.7a}
{When an identifier has a defining-point for a region, another identifier with the same spelling shall not have a defining-point for that region.}
program e6p2p2p7a(output);

var
   i,j,k,p: integer;

procedure p;     {!!! p declared twice}
begin
   i := 5;
end;

begin
   i := 6;
   writeln(' ERROR NOT DETECTED ... 6.2.2.7a redefine name in same scope' )
end. {e6p2p2p7a}


{TEST 6.2.2.7b}
{When an identifier has a defining-point for a region, another identifier with the same spelling shall not have a defining-point for that region.}
program e6p2p2p7b(output);

var
   i,j,k,p: integer;

   p: ^integer;     {!!! p declared twice}

begin
   i := 5;
   writeln(' ERROR NOT DETECTED ... 6.2.2.7b redefine name in same scope' )
end. {e6p2p2p7b}


{TEST 6.2.2.7c}
{When a label has a defining-point for a region, another label with the same spelling shall not have a defining-point for that region.}
program e6p2p2p7c(output);
label 1, 002, 001; {!!! label 1 declared twice}
var
  i,j,k: integer;

procedure p;
label 1;      {OK, new scope}
begin
   i := 5;
1:
end;

begin
1:
  p;
2:
  writeln(' ERROR NOT DETECTED ... 6.2.2.7c redefine label in same scope' )
end. {e6p2p2p7c}



{ ------- 6.3 Constant-definitions ------- }


{TEST 6.3.1a}
{Check that const declarations must be terminated with a semi colon. }
program e6p3p1a(output);
const
   one = 1, two = 2 {!!! missing semicolon}
begin
   writeln('ERROR NOT DETECTED ... 6.3.1a const declaration error')
end.


{TEST 6.3.1b}
{Check that a compilation error occurs for a constant declaration when the
   constant expression is bad }
program e6p3p1b( output );

const
   c0 = [0,1];
   c1 = ;
   c2 = *;
   c3 = or 1;
   c4 = !;
   c5 = ^0;
   c6 = .1;
   c7 = ?;
   c8 = >ff;
   c9 = nil;

begin
   writeln('ERROR NOT DETECTED ... 6.3.1b illegal constant declaration' );
end.


{TEST 6.3.1c}
{Check that a compilation error occurs for a constant declaration when the
   constant expression uses an undeclared identifier }

program e6p3p1c( output );

const
   c0 = 12;
   c1 = c0;
   c3 = c2;  {!!! c2 is not declared}

begin
   writeln('ERROR NOT DETECTED ... 6.3.1c illegal constant declaration' );
end.


{ ------- 6.4 Type-definitions ------- }

{TEST 6.4.1a}
{Check that type declarations must be terminated with a semi colon. }
program e6p4p1a(output);
type
   myType = (one, two) {!!! missing semicolon}
   begin
      writeln('ERROR NOT DETECTED ... 6.4.1a const declaration error')
   end.


{TEST 6.4.1b}
{Check that pointer types must point to a declared type. }
program e6p4p1b(output);
type
    r = record
            case boolean of
            true : (p: ^undec); {!!! undec is not declared}
            false: (i: integer);
        end;
begin
    writeln('ERROR NOT DETECTED ... 6.4.1b pointer declaration error')
end.


{ ------- 6.4.2 Simple-types ------- }

{ ------- 6.4.2.4 Subrange-types ------- }

{TEST 6.4.2.4a}
{Verify that both constants in a subrange declaration are the same ordinal type. }
program e6p4p2p4a(output);
type
   bad = 1 .. 'a'; {!!! incompatible limits}
begin
   writeln('ERROR NOT DETECTED ... 6.4.2.4a SUBRANGE')
end.


{TEST 6.4.2.4b}
{Verify that both constants in a subrange declaration are the same ordinal type. }
program e6p4p2p4b(output);
const c = 'a';
type
   bad = 1 .. c; {!!! incompatible limits}
begin
   writeln('ERROR NOT DETECTED ... 6.4.2.4b SUBRANGE')
end.


{TEST 6.4.2.4c}
{Verify that both constants in a subrange declaration are the same ordinal type. }
program e6p4p2p4c(output);
const c = 'a';
type
   bad = c .. 9; {!!! incompatible limits}
begin
   writeln('ERROR NOT DETECTED ... 6.4.2.4c SUBRANGE')
end.


{TEST 6.4.2.4d}
{Verify that the first constant in a subrange declaration is less than the second. }
program e6p4p2p4d(output);
type
   bad = 6 .. 0; {!!!  bad limits }
begin
   writeln('ERROR NOT DETECTED ... 6.4.2.4d SUBRANGE')
end.


{TEST 6.4.2.4e}
{Verify that the constants in a subrange declaration are ordinals. }
program e6p4p2p4e(output);
const pi = 3.14;
      tau = 6.28;
type
   bad = pi .. tau; {!!!  real limits }
begin
   writeln('ERROR NOT DETECTED ... 6.4.2.4d SUBRANGE')
end.


{TEST 6.4.2.4f}
{Verify that the constants in a subrange declaration are ordinals. }
program e6p4p2p4f(output);
type
   bad = 3.14 .. 6.28; {!!!  real limits }
begin
   writeln('ERROR NOT DETECTED ... 6.4.2.4f SUBRANGE')
end.


{TEST 6.4.2.4g}
{Verify that the constants in a subrange declaration are ordinals. }
program e6p4p2p4g(output);
const
   s1 = 'ABC';
   s2 = 'abc';
type
   bad = s1 .. s2; {!!!  string limits }
begin
   writeln('ERROR NOT DETECTED ... 6.4.2.4g SUBRANGE')
end.


{TEST 6.4.2.4h}
{Verify that the constants in a subrange declaration are ordinals. }
program e6p4p2p4h(output);
type
   bad = 'ABC' .. 'abc'; {!!!  string limits }
begin
   writeln('ERROR NOT DETECTED ... 6.4.2.4h SUBRANGE')
end.


{TEST 6.4.2.4i}
{Verify that an undefined constant in a subrange declaration is detected. }
program e6p4p2p4i(output);
const c1 = 1;
type
   bad = c1 .. c2; {!!! c2 is undefined }
begin
   writeln('ERROR NOT DETECTED ... 6.4.2.4i SUBRANGE')
end.



{------- 6.4.3 Structured-types -------}

{------- 6.4.3.1 General -------}


{TEST 6.4.3.1b}
{Verify that a missing type declaraion generates an error.}
program e6p4p3p1b(output);
type
   testArray = packed; { !!! missing declaration }
begin
   writeln('ERROR NOT DETECTED ... 6.4.3.1b real array index')
end.


{------- 6.4.3.2  Array-types -------}

{TEST 6.4.3.2b}
{Verify that an index-type must not have real type.}
program e6p4p3p2b(output);
type
   testArray = array[real] of real; { !!! index must not be real }
begin
   writeln('ERROR NOT DETECTED ... 6.4.3.2b real array index')
end.


{TEST 6.4.3.2c}
{Verify that a non-ordinal index-type of an array is rejected.}
program e6p4p3p2c(output);
type
   istring = packed array[1..5] of char;
   testArray = array[iString] of real; { !!! index must be ordinal }
begin
   writeln('ERROR NOT DETECTED ... 6.4.3.2c non-ordinal array index')
end.


{TEST 6.4.3.2d}
{Verify that an error in the index-type of a string declaration is rejected and
 that the compiler recovers well.}
program e6p4p3p2d(output);
type
   istring = packed array[1..len] of char;  {!!! error in index type}
begin
   writeln('ERROR NOT DETECTED ... 6.4.3.2d string declaration array index error')
end.


{TEST 6.4.3.2e}
{Verify that an error in the index-type of a string declaration is rejected and
 that the compiler recovers well.}
program e6p4p3p2e(output);
type
   istring = packed array[1.5] of char;  {!!! error in index type}
begin
   writeln('ERROR NOT DETECTED ... 6.4.3.2e string declaration array index error')
end.


{TEST 6.4.3.2f}
{Verify that an error in the index-type of an array declaration is rejected and
 that the compiler recovers well.}
program e6p4p3p2f(output);
type
   testArray = array[badType] of integer;  {!!! error in index type}
begin
   writeln('ERROR NOT DETECTED ... 6.4.3.2f array type index error')
end.


{------- 6.4.3.3  Record-types -------}

{TEST 6.4.3.3a}
{ Verify that the case constants in a variant record are compatible with the type of the tag. }
program e6p4p3p3a(output);
var
    vRec : record
             case tag:boolean of
             0:  (a: integer);   { !!! illegal - type of case constant must match type of tag }
             1:  (b: integer);   { !!! ditto }
         end;
begin
    vRec.tag := true;
    vRec.a := 1;
    writeln('ERROR NOT DETECTED ... 6.4.3.3a tag type')
end.


{TEST 6.4.3.3b}
{ Verify that an error is reported when the tag type in a variant record is real. }
program e6p4p3p3b(output);
var
   vRec : record
             case tag:real of           { !!! type of tag must be ordinal, not real }
             0.0:  (a: integer);
             1.0:  (b: integer);
          end;
begin
   vRec.tag := 1.0;
   vRec.a := 1;
   writeln('ERROR NOT DETECTED ... 6.4.3.3b tag type')
end.


{TEST 6.4.3.3c}
{Check that the fields of a variant record cease to exist
when a new value is assigned to the tag-field. }
program e6p4p3p3c(output);
var
   vRec : record
             case tag:boolean of
             true:  (a: integer);
             false: (b: integer);
          end;
   i:   integer;
begin
   vRec.tag := true;
   vRec.a := 1;    {OK}
   vRec.tag := false;
   i := vRec.a;    { !!! illegal - a no longer exists }
   writeln('ERROR NOT DETECTED ... 6.4.3.3c variant record (i is ',i:1, ')')
end.


{TEST 6.4.3.3d}
{Test that using a non-record variable as a record is detected and causes an error. }
program e6p4p3p3d(output);
var
   ar     : array [1..5] of record
                n     : integer;
                f1,f2 : file of integer;
                g     : array[1..4] of file of real;
             end;
begin
   ar[1].n := 12; { OK }
   ar.n := 12;    { !!! ar is not a record }
   writeln('ERROR NOT DETECTED ... 6.4.3.3d, record variable access')
end.


{TEST 6.4.3.3e}
{Similar to 6.4.3.3c, but this time use 2 levels of tags. }
program e6p4p3p3e(output);
var
   vRec : record
             case tag1:boolean of
             true:  (r: record
                     case tag2:boolean of
                     true:  (a: integer);
                     false: (b: integer);
                     end;);
             false: (b: integer);
          end;
   i:   integer;
begin
   vRec.tag1 := true;
   vRec.r.tag2 := true;
   vRec.r.a := 1;    {OK}
   vRec.tag1 := false; {tag2 might appear to still hold earlier value}
   i := vRec.r.a;    { !!! illegal - r & a no longer exist }
   writeln('ERROR NOT DETECTED ... 6.4.3.3e variant record (i is ',i:1, ')')
end.


{TEST 6.4.3.3f}
{The program causes an error by accessing a field with an undefined value.
The undefinition arises because when a change of variant occurs, those fields
associated with the new variant come into existence with undefined values. }
program e6p4p3p3f(output);
type
   two = (a,b);
var
    variant : record
                  case tagfield:two of
                  a:  (m : integer;
                       l : integer);
                  b:  (n: integer;
                       o: integer)
              end;
    i: integer;
begin
   variant.tagfield := a;
   variant.m := 1;
   variant.l := 1;
   variant.tagfield := b;
   variant.n := 1;
   i := variant.o; { !!! illegal - o is not defined }
   writeln('ERROR NOT DETECTED ... 6.4.3.3f access variant field with undefined value')
end.


{TEST 6.4.3.3g}
{This test is similar to 6.4.3.3e, except that no tagfield is used.
Variant changes occur implicitly as a result of assignment to fields.
The fields associated with the new variant come into existence with undefined values. }
program e6p4p3p3g(output);
type
   two = (a,b);
var
   variant : record
		case two of
		   a:  (m : integer);
		   b : (n : integer);
	     end;
   i :  integer;
begin
   variant.m := 2;
   i := variant.n; { !!! illegal - n is undefined }
   writeln('ERROR NOT DETECTED ... 6.4.3.3g access variant field with undefined value')
end.


{TEST 6.4.3.3h}
{Similar to 6.4.3.3e, except that no tag-field is used.
A change of variant occurs by reference to a field associated with a new variant.
 Again, these fields come into existance undefined.
The compiler conforms if the program does not compile. }
program e6p4p3p3h(output);
type
   two = (a,b);
var
   variant : record
		case two of
		   a: (m:integer;
		       l:integer);
		   b: (n: integer;
		       o:integer)
	     end;
   i:  integer;
begin
   variant.n := 1;
   variant.o := 1;
   variant.m := 1;
   i := variant.l; { !!! illegal - l is undefined }
   writeln('ERROR NOT DETECTED ... 6.4.3.3h access variant field with undefined value')
end.


{TEST 6.4.3.3l}
{This program is similar to 6.4.3.3c, except here an error is caused
by assigning the undefined value of the variable empty to the field e.
 This error should be detected. }
program e6p4p3p3l(output);
type
   statuskind = (defined,undefined);
   emptykind  = record end;
var
    empty : emptykind;
    mmber: record
               case status:statuskind of
               defined  : (i : integer);
               undefined: (e : emptykind)
           end;
begin
   with mmber do begin
      status := undefined;
      e := empty { !!! undefined despite being empty}
   end;
   writeln('ERROR NOT DETECTED ... 6.4.3.3l - EMPTY UNDEFINED VALUE')
end.


{------- 6.4.3.4  Set-types -------}

{------- 6.4.3.5 File-types -------}

{TEST 6.4.3.5a}
{test that using a non-file variable as a file buffer variable is detected and causes an error. }
program e6p4p3p5a(output);
type
   r = record
          a : integer;
          b : boolean;
          f : file of real;
       end;
var
   file1 :   file of char;
   file2 :   file of real;
begin
   r.a^ := 0;   {!!! illegal - r.a is not a file}
   writeln('ERROR NOT DETECTED ... 6.4.3.5a - file')
end.


{TEST 6.4.3.5f}
{A file-type must not contain another file. }
program e6p4p3p5f(output);
type
   r = record
          f : file of real;
          a : integer;
          b : boolean;
       end;
var
   file1 :   file of char;
   file2 :   file of real;
   file3 :   file of r;    {!!! illegal - r contains a file}
begin
   writeln('ERROR NOT DETECTED ... 6.4.3.5f - file of file')
end.


{------- 6.4.4 Pointer-types -------}

{TEST 6.4.4a}
{Test that dereferencing a non-pointer variable is illegal. }
program e6p4p4a(output);

var
   myrec : record
              n     : integer;
              f1,f2 : file of integer;
              g     : file of real;
           end;

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

   ar     : array [1..5] of record
                n     : integer;
                f1,f2 : file of integer;
                g     : array[1..4] of file of real;
             end;
begin
   with myrec do begin
      n:=1;
      rewrite(f1);
   end;

   ar[1].n^ := 12;    { !!! ar[1].n is not a pointer variable }
   writeln('ERROR NOT DETECTED ... 6.4.4a - dereferencing non pointer')
end.


{------- 6.4.6 Assignment-compatibility -------}

{TEST 6.4.6d}
{The Pascal standard says that if the two types in an assignment
compatibility test (T1 and T2) are compatible ordinal types
and the value of the expression E which is of type T2 is not in
the closed interval specified by the type T1, an error occurs.
Check that this error is detected. }
program e6p4p6d(output);
type
   subrange = 0 .. 5;
var
   i : subrange;
begin
   i := 5;
   i := i*2; { !!! error, result is beyond subrange limits }
   writeln('ERROR NOT DETECTED ... 6.4.6d ASSIGNMENT RANGE CHECK')
end.


{TEST 6.4.6e}
{ This program is similar to 6.4.6d, except that parameter
 assignment compatibility is tested. }
program e6p4p6e(output);
type
   subrange = 0 .. 5;
var
   i : subrange;
procedure test(a: subrange);
begin
   a := 5
end;
begin
   i := 5;
   test(i*2); { !!! error, result is beyond subrange limits }
   writeln('ERROR NOT DETECTED ... 6.4.6e PARAMETER RANGE CHECK')
end.


{TEST 6.4.6f}
{   This program is similar to 6.4.6d, except that array
   subscript assignment compatibility is tested.
   The program causes an error, which should be detected.}
program e6p4p6f(output);
type
   colour = (red,pink,orange,yellow,green);
var
   v:    colour;
   myArray: array[red .. orange] of boolean;
begin
   v := orange;
   myArray[succ(v)] := true;	{ !!! error, result is beyond subrange limits }
   writeln('ERROR NOT DETECTED ... 6.4.6f')
end.


{TEST 6.4.6g}
{ Check that an error is detected for assignment of sets when
  the set types are compatible, but members of the RHS set expression is not in the closed
  interval specified by the base-type of the LHS. }
program e6p4p6g(output);
type
   colour = (red,pink,orange,yellow,green,blue);
   subone = red .. orange;
   subtwo = pink .. yellow;
var
   setone: set of subone;
   settwo: set of subtwo;
begin
   settwo := [pink,yellow];
   setone := settwo;   { !!! set ranges do not match }
   writeln('ERROR NOT DETECTED ... 6.4.6g SET ASSIGNMENT')
end.


{TEST 6.4.6h}
{ This test is similar to 6.4.6g, now cause a range error
  in a set expression. }
program e6p4p6h(output);
const
   n =  5;
var
   s     : set of 0..n;
   i     : integer;
   comma : boolean;
begin
   s := [2,3,4];
   i := 256;
   s := s + [i] - [4];  {!!! i is out of range}
   writeln('ERROR NOT DETECTED ... 6.4.6h SET ASSIGNMENT WITH RANGE ERROR');
   write( 's is [' );
   comma := false;
   for i := 0 to n do begin
      if i in s then begin
         if comma then write(',');
         write(i:1);
         comma := true;
      end;
   end;
   writeln(']');
end.


{TEST 6.4.6i}
{ This test is similar to 6.4.6g, now cause a range error
  in a set expression. }
program e6p4p6i(output);
const
   n =  5;
var
   s     : set of 0..n;
   i     : integer;
   comma : boolean;
begin
   s := [2,3,4];
   i := 256;
   s := [2..4] + [i] - [4];  {!!! i is out of range}
   writeln('ERROR NOT DETECTED ... 6.4.6i SET ASSIGNMENT WITH RANGE ERROR');
   write( 's is [' );
   comma := false;
   for i := 0 to n do begin
      if i in s then begin
         if comma then write(',');
         write(i:1);
         comma := true;
      end;
   end;
   writeln(']');
end.


{TEST 6.4.6j}
{ This test is similar to 6.4.6g, now cause a range error
  in a set expression. }
program e6p4p6j(output);
const
   n =  5;
var
   s     : set of 0..n;
   i     : integer;
   comma : boolean;
begin
   s := [2,3,4];
   i := 256;
   s := [2,3,4] + [i] - [4];  {!!! i is out of range}
   writeln('ERROR NOT DETECTED ... 6.4.6j SET ASSIGNMENT WITH RANGE ERROR');
   write( 's is [' );
   comma := false;
   for i := 0 to n do begin
      if i in s then begin
         if comma then write(',');
         write(i:1);
         comma := true;
      end;
   end;
   writeln(']');
end.


{TEST 6.4.6k}
{ This test is similar to 6.4.6g, except that assignment
 compatibility for sets passed as parameters is tested.
 The program causes an error which should be detected. }
program e6p4p6k(output);
type
   colour=    (red,pink,orange,yellow,green,blue);
   subone    = red .. green;
   settwo    = set of yellow .. blue;
var
   setone:    set of subone;
procedure test(a : settwo);
begin
end;
begin
   setone := [red,pink,orange];
   test (setone); { !!! range of setone not what test requires }
   writeln('ERROR NOT DETECTED ... 6.4.6k SET PARAMETER')
end.


{TEST 6.4.6l}
{ verify that records of different types are not assignment compatible. }
program e6p4p6l(output);
type
   myRecord = record
                 a: integer;
                 c: char;
                 x: real;
              end;
var
   r1: record
          a: integer;
          c: char;
          x: real;
       end;
   r2: myRecord;
begin
   with r1 do begin
      a := 2;
      c := '2';
      x := 2.0;
   end;

   r2 := r1; {!!! not the same type}

   writeln('ERROR NOT DETECTED ... 6.4.6l compatible records' )
end.


{TEST 6.4.6m}
{ verify that records of different types are not assignment compatible.
  Similar to previous test, but this time test assignment to a procedure parameter }
program e6p4p6m(output);
type
   myRecord = record
                 a: integer;
                 c: char;
                 x: real;
              end;
var
   r1: record
          a: integer;
          c: char;
          x: real;
       end;
procedure test(a : myRecord);
begin
   a.a := 6;
end;
begin
   with r1 do begin
      a := 2;
      c := '2';
      x := 2.0;
   end;

   test( r1 );  {!!! not the same type}

   writeln('ERROR NOT DETECTED ... 6.4.6m compatible records' )
end.


{TEST 6.4.6n}
{ verify that files of different types are not assignment compatible.
  file assignment is normally illegal, but we can test assignment to a var procedure parameter }
program e6p4p6n(output);
type
   myFile = file of real;
var
   f1: file of real;
procedure test(var af : myFile);
begin
   rewrite(af);
end;
begin

   test( f1 );  {!!! not the same type}

   writeln('ERROR NOT DETECTED ... 6.4.6n compatible files' )
end.


{ -------- 6.5 Declarations and denotations of variables ------- }

{ ------- 6.5.1 Variable-declarations ------- }


{ ------- 6.5.3 Component-variables ------- }

{ ------- 6.5.3.1 General ------- }

{ ------- 6.5.3.2 Indexed-variables ------- }

{TEST 6.5.3.2a}
{check array bounds for a two dimensional array. }
program e6p5p3p2a(output);
var
   myArray : array[1 .. 10,1 .. 10] of integer;
   i   : integer;
begin
   i := 3;
   myArray[i*2,i*4] := 0; { !!! access outside array bounds }
   writeln('ERROR NOT DETECTED ... 6.5.3.2a ARRAY BOUNDS')
end.


{------- 6.5.3.3 Field-designators -------}

{TEST 6.5.3.3a}
{verify that the field designator (ie dot) rejects variables that are not records}
program e6p5p3p3a(output);
var
   myArray: array[1..10] of integer;
begin
   myArray.1 := 0;  {!!! must use a record here}
   writeln('ERROR NOT DETECTED ... 6.5.3.3a, record field designator');
end. {e6p8p3p3a}


{TEST 6.5.3.3b}
{It is an error unless a variant is active for the entirety of each reference
and access to each component of the variant.}
{verify that an error is detected and reported when a variant is made inactive when there is a reference to it.}
program e6p5p3p3b(output);
var
   testRec: record
               case b:boolean of
                  true: ( i: integer);
                  false: (c:char);
            end;
begin
   testRec.b := true;
   testRec.i := 7;
   testRec.c := '7';  {!!! variant containing c is inactive}
   writeln('ERROR NOT DETECTED ... 6.5.3.3b, reference to inactive variant');
end. {e6p8p3p3b}


{TEST 6.5.3.3c}
{It is an error unless a variant is active for the entirety of each reference
and access to each component of the variant.}
{verify that an error is detected and reported when a variant is made inactive when there is a reference to it.}
program e6p5p3p3c(output);
var
   testRec: record
               case b:boolean of
               true: ( r: record i: integer; end );
               false: (c:char);
            end;

begin
   testRec.b := true;
   with testRec.r do begin
      testRec.b := false;   {!!! error, refrence to testRec.r does not exist }
      i := 7;
   end;
   writeln('ERROR NOT DETECTED ... 6.5.3.3c, reference to inactive variant');
end. {e6p8p3p3b}


{TEST 6.5.3.3d}
{It is an error unless a variant is active for the entirety of each reference
and access to each component of the variant.}
{verify that an error is detected and reported when a variant is made inactive when there is a reference to it.}
program e6p5p3p3d(output);
var
   testRec: record
               case b:boolean of
                  true: ( i: integer);
                  false: (c:char);
            end;
procedure bad(var ai:integer);
begin
   testRec.b := false;   {!!! error, refrence to ai does not exist }
   ai := 7;
end;

begin
   testRec.b := true;
   bad(testRec.i);
   writeln('ERROR NOT DETECTED ... 6.5.3.3d, reference to inactive variant');
end. {e6p8p3p3d}


{TEST 6.5.3.3e}
{It is an error unless a variant is active for the entirety of each reference
and access to each component of the variant.}
{verify that an error is detected and reported when a variant is made inactive when there is a reference to it.}
program e6p5p3p3e(output);
var
   testRec: record
               case b:boolean of
                  true: ( i: integer);
                  false: (c:char);
            end;
function bad :integer;
begin
   testRec.b := false;  {!!! destination of return value does not exist now}
   bad := 7;
end;

begin
   testRec.b := true;
   testRec.i := bad;
   writeln('ERROR NOT DETECTED ... 6.5.3.3e, reference to inactive variant');
end. {e6p8p3p3e}


{ ------- 6.5.4 Identified-variables ------- }

{TEST 6.5.4a}
{ Check that dereferencing the nil pointer causes a runtime error }
program e6p5p4a(output);
type
   myRecord = record
	       a:  integer;
	       b : boolean
	    end;
var
   pointer : ^myRecord;
begin
   pointer := nil;
   pointer^.a := 1; { !!! dereference nil pointer }
   pointer^.b := true;
   writeln('ERROR NOT DETECTED... 6.5.4a')
end.


{TEST 6.5.4b}
{ Similarly to 6.5.4a, an error occurs if a pointer variable
has an undefined value when it is dereferenced. }
program e6p5p4b(output);
type
   myRecord = record
	       a:  integer;
	       b : boolean
	    end;
var
   pointer : ^myRecord;
begin
   pointer^.a := 1;	{ !!! dereference uninitialised pointer }
   pointer^.b := true;
   writeln('ERROR NOT DETECTED... 6.5.4b')
end.


{TEST 6.5.4c}
{ Check that an error occurs if a pointer variable
  is dereferenced after its memory has been disposed. }
program e6p5p4c(output);
type
   myRecord = record
               a:  integer;
               b : boolean
            end;
var
   pointer : ^myRecord;
begin
   new(pointer);
   dispose(pointer);
   pointer^.a := 1;     { !!! dereference disposed pointer }
   pointer^.b := true;
   writeln('ERROR NOT DETECTED... 6.5.4c, dereference pointer after disposed')
end.


{TEST 6.5.4d}
{ It shall be an error to remove from the set of values of the pointer-type the identifying-value
  of an identified-variable (see 6.6.5.3) when a reference to the identified-variable exists.

  Check that an error occurs if a pointer's data is removed while there is a reference to it. }
program e6p5p4d(output);
type
   myRecord = record
               a:  integer;
               b : boolean
            end;
var
   pointer : ^myRecord;
begin
   new(pointer);
   with pointer^ do begin
      dispose(pointer);       { !!! remove pointer data while it has a reference}
      a := 1;
      b := true;
   end;
   writeln('ERROR NOT DETECTED... 6.5.4d, remove pointer''s data while it has a reference')
end.


{TEST 6.5.4e}
{ It shall be an error to remove from the set of values of the pointer-type the identifying-value
  of an identified-variable (see 6.6.5.3) when a reference to the identified-variable exists.

  Check that an error occurs if a pointer's data is removed while there is a reference to it.
  Similar to previous test, but now reference pointer is o var parameter }
program e6p5p4e(output);
type
   myRecord = record
               a:  integer;
               b : boolean
            end;
var
   pointer : ^myRecord;
procedure test( var r: myRecord);
begin
   dispose(pointer);       { !!! remove pointer data while it has a reference}
   r.a := 1;
   r.b := true;
end;

begin
   new(pointer);
   test(pointer^);
   writeln('ERROR NOT DETECTED... 6.5.4e, remove pointer''s data while it has a reference')
end.


{TEST 6.5.4f}
{ It shall be an error to remove from the set of values of the pointer-type the identifying-value
  of an identified-variable (see 6.6.5.3) when a reference to the identified-variable exists.

  Check that an error occurs if a pointer's data is removed while there is a reference to it.
  Similar to previous test, but now reference pointer is on lhs of assignment statement }
program e6p5p4f(output);
type
   myRecord = record
               a:  integer;
               b : boolean
            end;
var
   pointer : ^myRecord;
function test: integer;
begin
   dispose(pointer);       { !!! remove pointer data while it has a reference}
   test := 13;
end;

begin
   new(pointer);
   pointer^.a := test;
   writeln('ERROR NOT DETECTED... 6.5.4f, remove pointer''s data while it has a reference')
end.


{ ------- 6.5.5 Buffer-variables ------- }

{It shall be an error to alter the value of a file-variable f when a reference to the buffer-variable f^ exists.
 A reference or an access to a buffer-variable shall constitute a reference or an access, respectively,
to the associated file-variable.}

{TEST 6.5.5a}
{Cause an error to occur by changing the current file position of a file f,
while a reference to its buffer variable is in use
 eg it is a var parameter to a procedure. }
program e6p5p5a(output);
var
   f : text;
procedure wrong(var c : char);
begin
   if c='G' then
      put(f)           { !!! changes the file position }
end;
begin
   rewrite(f);
   f^ := 'G';
   wrong(f^);
   writeln('ERROR NOT DETECTED ... 6.5.5a - FILE BUFFER VAR')
end.


{TEST 6.5.5b}
{This test is similar to the previous one, but now the buffer variable
is an element of the record variable list of a with statement. }
program e6p5p5b(output);
type
   sex = (male,female,notgiven);
   socialsecuritynumber = 0 .. 10000;
   myRecord = record
               a: socialsecuritynumber;
               b : sex
            end;
var
   f: file of myRecord;
begin
   rewrite (f);
   with f^ do begin
      a := 9999;
      b := notgiven;
      put(f)    { !!! changes the file position }
   end;
   writeln('ERROR NOT DETECTED ... 6.5.5b - FILE BUFFER VAR')
end.


{TEST 6.5.5c}
{This test is similar, except that the buffer variable
is used on the left hand side of an assignment statement. }
program e6p5p5c(output);
type
   sex = (male,female,notgiven);
   socialsecuritynumber = 0 .. 10000;
   myRecord = record
               a: socialsecuritynumber;
               b : sex
            end;
var
   f: file of myRecord;

function wrong: integer;
begin
   put(f);
   wrong := 142
end;

begin
   rewrite(f);
   f^.a := 999;   {OK}
   f^.a := wrong; { !!! changes the file position }
   writeln('ERROR NOT DETECTED ... 6.5.5c - FILE BUFFER VAR')
end.


{------- 6.6 Procedure and function declarations -------}

{------- 6.6.1 Procedure-declarations -------}

{TEST 6.6.1a}
{verify that a syntax error is detected when the procedure name is missing in
 a procedure declaraion.  Here there are 2 instances of missing names to verify that
 the compiler is able to recover from the first error }
program e6p6p1a( output );
procedure test(one, two: integer);

procedure (ai : integer); {!!! missing procedure name}
begin
   writeln('ai is ', ai);
end; {  }

begin
   one := 1;
   two := 2
end;

procedure (one, two: integer);  {!!! missing procedure name}
begin
   one := 1;
   two := 2
end;

begin

end. {e6p6p1a}


{TEST 6.6.1b}
{verify that a syntax error after a forward directive is detected }
program e6p6p1b( output );
procedure p; forward;
proc p; {!!! misspelt procedure }
begin
   writeln( 'ERROR NOT DETECTED ... 6.6.1b - foward syntax error' );
end;

begin
   p;
end. {e6p6p1b}


{TEST 6.6.1c}
{verify that a syntax error is detected if a procedure has a return type }
program e6p6p1c( output );
procedure p : integer;  {!!! procedure or function?}
begin
   writeln( 'ERROR NOT DETECTED ... 6.6.1c - procedure has return type' );
end;

begin
   p;
end. {e6p6p1c}



{------- 6.6.2 Function-declarations -------}

{TEST 6.6.2a}
{verify that a syntax error is detected when the function name is missing in
 a function declaraion.  Here there are 2 instances of missing names to verify that
 the compiler is able to recover from the first error }
program e6p6p2a( output );
procedure test(one, two: integer);

function (ai : integer) : char; {!!! missing function name}
begin
   writeln('ai is ', ai);
end; {  }

begin
   one := 1;
   two := 2
end {test};

function (one, two: integer) : char;  {!!! missing function name}
begin
   one := 1;
   two := 2
end;

begin

end. {e6p6p2a}


{TEST 6.6.2b}
{verify that a syntax error is detected when the function name is duplicated.}
program e6p6p2b( output );

function myFunc2(ai : integer) : char;
begin
   writeln('ai is ', ai);
   myFunc2 := '1'
end; {  }

function myFunc1(ai : integer) : char;
begin
   writeln('ai is ', ai);
   myFunc1 := '1'
end; {  }

function myFunc3(ai : integer) : char;
begin
   writeln('ai is ', ai);
   myFunc3 := '1'
end; {  }

function myFunc2(one, two: integer) : char;  {!!! duplicate function name}
begin
   myFunc2 := chr(one + two)
end;

begin
   writeln(myFunc1(0), myFunc2(0), myFunc3(0));
   writeln(myFunc2(1,2));
end. {e6p6p2b}


{TEST 6.6.2c}
{verify that assigning a value to an inactive function is not allowed }
program e6p6p2c( output );
function func: integer;
begin
   func := 12;
end; { func }

procedure proc;
begin
   func := 3; {!!! func is not active}
end; { proc }

begin
   proc;
   writeln( 'ERROR NOT DETECTED ... 6.6.2c - assign to inactive function' );
end. {e6p6p2c}


{TEST 6.6.2d}
{verify that assigning a value to a formal function parameter is not allowed }
program e6p6p2d( output );
var
   a  : integer;
function go: integer;
begin
   go := 12;
end; { go }

procedure p(function f: integer );
begin
   if f <> 12 then
      writeln('unexpected function result');
   f := 0;  {!!! illegal}
end; { p }

begin

   p(go);
   writeln( 'ERROR NOT DETECTED ... 6.6.2d - assign to standard function' );
end.


{TEST 6.6.2f}
{The Pascal Standard states that the result of a function wi11 be the most receny value
 assigned to its identifier. If no assignment occurs then the result is undefined.
 This program contains a function with an assigment to its identifier,
 however the assignment is never executed.
 An error should occur during execution. }
program e6p6p2f(output);
var
   radius,
   circlearea : real;
function area(a : real): real;
var
   x : real;
begin
   if a > 0 then x := 3.1415926*a*a
   else area := 0
end; 	{ !!! function return value is not set }
begin
   radius := 2;
   circlearea := area(radius);
   writeln('ERROR NOT DETECTED ... 6.6.2f NO RETURN VALUE')
end.


{TEST 6.6.2g}
{verify that a syntax error is detected if a function has no return type }
program e6p6p2g( output );
function f;  {!!! function without a return type}
begin
   writeln( 'ERROR NOT DETECTED ... 6.6.2g - function has no return type' );
end;

begin
   f;
end. {e6p6p2g}


{TEST 6.6.2h}
{verify that a syntax error after a forward directive is detected }
program e6p6p2h( output );
function f: integer; forward;
func f: integer; {!!! misspelt function }
begin
   writeln( 'ERROR NOT DETECTED ... 6.6.2h - foward syntax error' );
   f := 12
end;

begin
   if f = 12 then;
end. {e6p6p2h}


{TEST 6.6.2i}
{verify that an error is issued when a function with forward directive has been declared previously}
{NB: see }
program e6p6p2i( output );

var
   x,y : real;

function pow(a : real;  b : real) : real;
begin
   pow := exp(ln(a)*b)
end;

function pow(u : real;  v : real) : real; forward; { !!! previously declared }

begin {e6p6p2i}
   x := pow( 2, 2 );
   writeln( 'ERROR NOT DETECTED ... 6.6.2i forward function declared previously' );
end.


{------- 6.6.3 Parameters -------}

{------- 6.6.3.1 General -------}

{TEST 6.6.3.1a}
{Test that a syntax error in parameter list is detected and handled.}
program e6p6p3p1a(output);
procedure p1( procedure ap(ai : integer); ); { !!! extra semicolon }
begin
  ap(3);
end;
procedure p2(ai: integer);
begin
end;
begin
   p1(p2);
   writeln('ERROR NOT DETECTED ... 6.6.3.1a, syntax error in parameter list')
end.


{TEST 6.6.3.1b}
{Test that a syntax error in parameter list is detected and handled.}
program e6p6p3p1b(output);
var
  k : integer;
function f1( function af(ai : integer) ): integer; { !!! missing return type }
begin
   f1 := af(3);
end;
function f2(ai: integer) : integer;
begin
   f2 := ai;
end;
begin
  k := f1(f2);
  writeln('ERROR NOT DETECTED ... 6.6.3.1b, syntax error in parameter list')
end.


{TEST 6.6.3.1c}
{Test that a syntax error in parameter list is detected and handled.}
program e6p6p3p1c(output);
procedure p( ai : integer ) : integer { !!! illegal return type }
begin
  writeln('ERROR NOT DETECTED ... 6.6.3.1c, syntax error in parameter list')
end;
begin
  p(2);
end.


{TEST 6.6.3.1d}
{Test that a syntax error in parameter list is detected and handled.}
program e6p6p3p1d(output);
procedure p1( procedure ap(ai : integer), c: char); { !!! need semicolon, not comma }
begin
   ap(3, 'a');
end;
procedure p2(ai: integer; c: char);
begin
end;
begin
   p1(p2);
   writeln('ERROR NOT DETECTED ... 6.6.3.1d, syntax error in parameter list')
end.


{TEST 6.6.3.1e}
{Test that a syntax error in parameter list is detected and handled.}
program e6p6p3p1e(output);
var
   k : integer;
function f1( function af(ai : integer, c: char) : integer ): integer; { !!! need semicolon, not comma }
begin
   f1 := af(3);
end;
function f2(ai: integer) : integer;
begin
   f2 := ai;
end;
begin
   k := f1(f2);
   writeln('ERROR NOT DETECTED ... 6.6.3.1e, syntax error in parameter list')
end.


{TEST 6.6.3.1f}
{Test that a syntax error in parameter list is detected and handled.}
program e6p6p3p1f(output);
procedure p1( function af, bf : integer ); { !!! two functions }
begin
   if af + bf = 6 then
      writeln('ERROR NOT DETECTED ... 6.6.3.1f, syntax error in parameter list')
end;
function f1 : integer;
begin
   f1 := 3;
end;
begin
   p1(f1, f1);
end.


{TEST 6.6.3.1g}
{Test that a syntax error in parameter list is detected and handled.}
program e6p6p3p1g(output);
procedure p( ai : integer, c: char ); { !!! need semicolon, not comma }
begin
   writeln('ERROR NOT DETECTED ... 6.6.3.1g, syntax error in parameter list')
end;
begin
   p(2, 'z');
end.


{TEST 6.6.3.1h}
{Test that a syntax error in parameter list is detected and handled.}
program e6p6p3p1h(output);
var
   k : integer;
function f1( function af(ai : integer) : procedure p): integer; { !!! missing return type }
begin
   f1 := af(3);
end;
function f2(ai: integer) : integer;
begin
   f2 := ai;
end;
begin
   k := f1(f2);
   writeln('ERROR NOT DETECTED ... 6.6.3.1h, syntax error in parameter list')
end.


{TEST 6.6.3.1i}
{Test that a syntax error in parameter list is detected and handled.}
program e6p6p3p1i(output);
procedure p( function af : integer, c: char ); { !!! need semicolon, not comma }
begin
   writeln('ERROR NOT DETECTED ... 6.6.3.1i, syntax error in parameter list')
end;
function f: integer;
begin
   f := 2;
end;
begin
   p(f, 'z');
end.


{TEST 6.6.3.1j}
{Test that a syntax error in parameter list is detected and handled.}
program e6p6p3p1j(output);
procedure p( procedure ap(c: char ); { !!! missing closing paren }
const n = 9;
begin
  ap('z');
end;
procedure p1(c: char);
begin
   writeln('ERROR NOT DETECTED ... 6.6.3.1j, syntax error in parameter list')
end;
begin
   p(p1);
end.


{------- 6.6.3.2 Value parameters -------}

{TEST 6.6.3.2b}
{Test that a file type must not be an actual value parameter.}
program e6p6p3p2b(output);
type
   myType = text;
var
   f1 : myType;
procedure pok(var r: myType); { OK }
begin
   rewrite( r );
end;
procedure p(r: myType);     { !!! file type inside actual value parameter not allowed }
begin
   rewrite( r );
end;
begin
   pok(f1);   { OK: file type inside actual var parameter is allowed }
   p(f1);
   writeln('ERROR NOT DETECTED ... 6.6.3.2b VALUE PARAMETER CONTAINS A FILE')
end.


{TEST 6.6.3.2c}
{Test that an array type with a file component must not be an actual value parameter.}
program e6p6p3p2c(output);
type
   myArray = array[1..10] of  text;
var
   array1 : myArray;
procedure pok(var a: myArray); { OK }
begin
   rewrite( a[1] );
end;
procedure p(a: myArray);     { !!! file type inside actual value parameter not allowed }
begin
   rewrite( a[1] );
end;
begin
   pok(array1);   { OK: file type inside actual var parameter is allowed }
   p(array1);
   writeln('ERROR NOT DETECTED ... 6.6.3.2c VALUE PARAMETER CONTAINS A FILE')
end.


{TEST 6.6.3.2d}
{Test that a record type with a file component must not be an actual value parameter.}
program e6p6p3p2d(output);
type
   myRecord = record
               f: text;
               a : integer
            end;
var
   record1 : myRecord;
procedure pok(var r: myRecord); { OK }
begin
   write( r.a:1 );
end;
procedure p(r: myRecord);     { !!! file type inside actual value parameter not allowed }
begin
   write( r.a:1 );
end;
begin
   record1.a := 1;
   pok(record1);   { OK: file type inside actual var parameter is allowed }
   p(record1);
   writeln('ERROR NOT DETECTED ... 6.6.3.2d VALUE PARAMETER CONTAINS A FILE')
end.


{TEST 6.6.3.2e}
{For a value parameter, it is an error if the actual-parameter is an expression of a set-type
 whose value is not assignment-compatible with the type possessed by the formal-parameter.}
program e6p6p3p2e(output);
type
    nums = set of 1..9;
procedure p(s : nums);
begin
end;

begin
    p([1,3]);  {OK}
    p([0,3]);  {!!! 0 is not in nums type}

    writeln('ERROR NOT DETECTED ... 6.6.3.2e VALUE PARAMETER set range')
end. {e6p6p3p2e}


{TEST 6.6.3.2f}
{For a value parameter, it is an error if the actual-parameter is an expression of a set-type
 whose value is not assignment-compatible with the type possessed by the formal-parameter.}
program e6p6p3p2f(output);
type
    nums = set of 1..9;
var
    a,b:integer;
procedure p(s : nums);
begin
end;

begin
    a := 1; b := 9;
    p([a,b]);  {OK}
    b  := 10;
    p([a,b]);  {!!! b=10, is not in nums type}

    writeln('ERROR NOT DETECTED ... 6.6.3.2f VALUE PARAMETER set range')
end. {e6p6p3p2f}


{------- 6.6.3.3 Variable parameters -------}

{TEST 6.6.3.3a}
{Test that an expression must not be an actual var parameter.}
program e6p6p3p3a(output);
var
   aci, aci1 : integer;

procedure p1(var aa1: integer);
begin
   aa1 := 0;
end; { p1 }

procedure p2(aa1: integer);
var
   z   : char;
begin
   z := '3';
   aa1 := 3;
end;

procedure test( procedure p(var aa1: integer ) );
begin
   p(aci); {OK}
   p(aci*2);  {!!! var parameter must not be an expression}
end; { test }

begin

   test(p1);
   writeln('ERROR NOT DETECTED ... 6.6.3.3a VAR PARAMETER IS AN EXPRESSION')
end.


{TEST 6.6.3.3b}
{Test that a constant must not be an actual var parameter.
 see also 6.6.3.6a}
program e6p6p3p3b(output);
var
   aci, aci1 : integer;

procedure p1(var aa1: integer);
begin
   aa1 := 0;
end; { p1 }

procedure p2(aa1: integer);
var
   z   : char;
begin
   z := '3';
   aa1 := 3;
end;

procedure test( procedure p(var aa1: integer ) );
begin
   p(aci); {OK}
   p(2);  {!!! var parameter must not be a constant}
end; { test }

begin

   test(p1);
   writeln('ERROR NOT DETECTED ... 6.6.3.3b VAR PARAMETER IS A CONSTANT')
end.


{TEST 6.6.3.3f}
{Test that a tagfield must not be an actual var parameter.}
program e6p6p3p3f(output);
type
   myRecord = record
               x : real;
               a : integer;
               case tc:char of
               'a':(q1, q2:boolean);
               'b':(b1,b2:boolean);
               end;
var
   record1 : myRecord;
procedure test(var c: char);
begin
   write( c:1 );
end;
begin
   record1.a := 1;
   record1.tc := 'a';
   record1.q1 := false;
   test(record1.tc);   {!!! var parameter must not be a tagfield }
   writeln('ERROR NOT DETECTED ... 6.6.3.3f VAR PARAMETER IS A TAGFIELD')
end.


{TEST 6.6.3.3g}
{Test that a tagfield must not be an actual var parameter.
 in this test, the tagfield is used inside a with statement}
program e6p6p3p3g(output);
type
   myRecord = record
               x : real;
               a : integer;
               case tc:char of
               'a':(q1, q2:boolean);
               'b':(b1,b2:boolean);
               end;
var
   record1 : myRecord;
procedure test(var c: char);
begin
   write( c:1 );
end;
begin
   with record1 do begin
      a := 1;
      tc := 'b';
      b1 := true;
      test(tc);   { !!! var parameter must not be a tagfield }
   end;
   writeln('ERROR NOT DETECTED ... 6.6.3.3g VAR PARAMETER IS A TAGFIELD')
end.


{------- 6.6.3.4 Procedural parameters -------}

{TEST 6.6.3.4a}
{verify that a missing procedure name in a procedure parameter is
 detected and handled gracefully. }
program e6p6p3p4a( output );
var
   a  : integer;
procedure proc( procedure (ai: integer));   {!!! missing procedure name}
begin
   writeln('in illegal procedure');
end; {  }

begin
   writeln( 'ERROR NOT DETECTED ... 6.6.3.4a - missing procedure name' );
end.


{TEST 6.6.3.4b}
{verify that a missing procedure name in a procedure parameter is
 detected and handled gracefully. }
program e6p6p3p4b( output );
var
   a  : integer;
procedure proc( procedure ap( procedure (ai: integer)) );   {!!! missing procedure name}
begin
   writeln('in illegal procedure');
end; {  }

begin
   writeln( 'ERROR NOT DETECTED ... 6.6.3.4b - missing procedure name' );
end.


{TEST 6.6.3.4e}
{test a compilation error occurs if parameter lists are not congruous }
program e6p6p3p4e( output );

type
   smallInt  = 1..10;
   arrayType =   array['1'..'9'] of integer;

var
   aci, aci1 : arrayType;
   aci2      : array['1'..'9'] of integer;

   aii : array[1..9] of integer;

procedure p1(aa1, aa2: arrayType);
begin
   aa1['1'] := 0;
end; { p1 }

procedure test( procedure p(aa1, aa2: arrayType ) );
begin
   p(aci); { !!! not enough arguments }
end; { test }

begin {e6p6p3p4e}
   test(p1);
   writeln('ERROR NOT DETECTED ... 6.6.3.4e, PARAMS DIFFERENT');
end. { e6p6p3p4e }


{TEST 6.6.3.4f}
{test a compilation error occurs if the parameter list contains a syntax error }
program e6p6p3p4f( output );

procedure p1(aa1: integer);
begin
  aa1 := 0;
end; { p1 }

procedure test( procedure p(aa1: integer ); ai: integer );
begin
p(ai);
end; { test }

begin {e6p6p3p4f}
test(p1 0);  { !!! syntax error, missing comma }
writeln('ERROR NOT DETECTED ... 6.6.3.4f, PARAM LIST SYNTAX ERROR');
end. { e6p6p3p4f }


{------- 6.6.3.5 Functional parameters -------}

{TEST 6.6.3.5a}
{verify that a missing function name in a function parameter
 is detected and handled gracefully. }
program e6p6p3p5a( output );
var
   a  : integer;
function func( function (ai: integer): integer) : integer;   {!!! missing function name}
begin
   writeln('in illegal function');
   func := 0;
end; {  }

begin
   writeln( 'ERROR NOT DETECTED ... 6.6.3.5a - missing function name' );
end.


{TEST 6.6.3.5b}
{Check that the argument types of function parameters are identical. }
program e6p6p3p5b(output);
type
   capitals = 'A'..'Z';
var
   c : char;
function actual(c1 :capitals): capitals;
begin
   actual := c1
end;
procedure p(function formal(c1 :char): capitals);
begin
  c := formal('B')
end;
begin
   p(actual); { !!! argument type of procedure actual is capitals,
                    but procedure p requires a function with char argument}
   writeln('ERROR NOT DETECTED ... 6.6.3.5b, FUNCTION PARAMETER MISMATCH')
end.


{TEST 6.6.3.5c}
{Check that the return types of function parameters are identical. }
program e6p6p3p5c(output);
type
   capitals = 'A'..'Z';
var
   c : char;
function actual(ac :capitals): capitals;
begin
   actual := ac
end;
procedure p(function formal(ac :capitals): char);
begin
   c := formal('C')
end;
begin
   p(actual); { !!! return type of procedure actual is capitals,
                    but procedure p requires a function with char return type }
   writeln('ERROR NOT DETECTED ... 6.6.3.5c, FUNCTION TYPE MISMATCH')
end.


{TEST 6.6.3.5d}
{Check that the classes of function parameters must be identical. }
program e6p6p3p5d(output);
var
   c : char;
function actual: char;
begin
   actual := c
end;
procedure p(procedure formal);
begin
   formal;
end;
begin
   p(actual); { !!! parameter actual is a function but a procedure is required }
   writeln('ERROR NOT DETECTED ... 6.6.3.5d, FUNCTION CLASS MISMATCH')
end.


{TEST 6.6.3.5e}
{Check that the classes of function parameters must be identical. }
program e6p6p3p5e(output);
var
   c : char;
function actual(function f(ac :char): char): char;
begin
   actual := f(c)
end;
procedure p(function formal(procedure p(ac :char)): char);
procedure p1( ac: char);
begin
end;
begin
   c := formal(p1)
end;
begin
   p(actual); { !!! parameter actual is a function but a procedure is required }
   writeln('ERROR NOT DETECTED ... 6.6.3.5e, FUNCTION CLASS MISMATCH')
end.


{TEST 6.6.3.5f}
{verify that a missing function name in a function parameter
 is detected and generates an error. }
program e6p6p3p5f( output );
var
   a  : integer;

function fun2( function f( function (ai: integer): integer;                      {!!! missing function name}
                           function (ai: integer): integer) : integer ): integer;   {!!! missing function name}
begin
  writeln('in illegal function');
  fun2 := 0;
end; {  }

function func( function f( function (ai: integer): integer) : integer ): integer;   {!!! missing function name}
begin
  writeln('in illegal function');
  func := 0;
end; {  }

begin
   writeln( 'ERROR NOT DETECTED ... 6.6.3.5f - missing function name' );
end.


{TEST 6.6.3.5g}
{verify that function parameters with identical names are detected and generate an error. }
program e6p6p3p5g( output );
var
  a  : integer;

function func( function f(ai: integer): integer; function f : integer ): integer;   {!!! duplicate function name}
begin
  writeln('in illegal function');
  func := 0;
end; {  }

begin
  writeln( 'ERROR NOT DETECTED ... 6.6.3.5g - duplicate function name' );
end.


{TEST 6.6.3.5h}
{Check that an undefined function parameter generates an error. }
program e6p6p3p5h(output);
var
   c : char;
procedure p(function formal (c1 :char): char);
begin
   c := formal('A')
end;
begin
   p(ufunc); { !!! ufunc is not defined }
   writeln('ERROR NOT DETECTED ... 6.6.3.5h, undefined function')
end.



{------- 6.6.3.6 Parameter list congruity -------}

{TEST 6.6.3.6a}
{ Check that constants are not permitted as var parameters.
 see also 6.6.3.3b }
program e6p6p3p6a(output);
const
   x=1;
var
   y:integer;
procedure assign(var p:integer);
begin
   p := 100
end;
begin
   assign(y);
   assign(x);  { !!! const as var parameter is not allowed}
   writeln('ERROR NOT DETECTED ... 6.6.3.6a, VAR PARAMS')
end.


{TEST 6.6.3.6b}
{ Check that parameter list compatibility is correctly implemented. }
program e6p6p3p6b(output);
type
   capitals = 'A' .. 'Z';
procedure actual(ac1 :char; ac2:capitals);
begin
   ac1 := ac2
end;
procedure p(procedure formal(a: char; b: char));
var
   c1,c2 : char;
begin
   c1 := '1'; c2 := '2';
   formal(c1,c2)
end;
begin
   p(actual);           { !!! parameter types in actual() don't match types required by p() }
   writeln('ERROR NOT DETECTED ... 6.6.3.6b, VALUE PARAMS TYPE MISMATCH')
end.


{TEST 6.6.3.6c}
{Check that parameter list compatibility is correctly implemented. }
program e6p6p3p6c(output);
type
   capitals = 'A' .. 'Z';
procedure actual(ac1:char; ac2:capitals);
begin
   ac1 := ac2
end;
procedure p(procedure formal(var a:char; b:capitals));
var
   c1,c2: char;
begin
   c2 := 'A'; c2 := 'B';
   formal (c1,c2)
end;
begin
   p(actual);   { !!! parameters of actual() don't match parameters required by p() }
   writeln ('ERROR NOT DETECTED ... 6.6.3.6c, VALUE/VAR MISMATCH')
end.


{TEST 6.6.3.6d}
{Check that parameter list compatibility is correctly implemented. }
program e6p6p3p6d(output);
type
   capitals = 'A' .. 'Z';
procedure actual(var ac1:char; ac2:capitals);
begin
   ac1 := ac2
end;
procedure p(procedure formal(a:char; b:capitals));
var
   ac1,ac2: char;
begin
   ac1 := 'A'; ac2 := 'B';
   formal (ac1,ac2)
end;
begin
   p(actual);   { !!! parameters of actual() don't match parameters required by p() }
   writeln ('ERROR NOT DETECTED ... 6.6.3.6d, VALUE/VAR MISMATCH')
end.


{TEST 6.6.3.6e}
{Check that parameter list compatibility is correctly implemented. }
program e6p6p3p6e(output);
type
   capitals = 'A' .. 'Z';
procedure actual(var ac1:char; var ac2:capitals);
begin
   ac1 := ac2
end;
procedure p(procedure formal (var a: char; var b: char));
var
   c1, c2 : char ;
begin
   c1 := 'a'; c2 := 'b';
   formal (c1,c2)
end;
begin
   p(actual);   { !!! parameter types in actual() don't match types required by p() }
   writeln('ERROR NOT DETECTED ... 6.6.3.6e, VAR PARAMS TYPE MISMATCH')
end.


{TEST 6.6.3.6f}
{Check that parameter list compatibility is correctly implemented. }
program e6p6p3p6f(output);
procedure actual(i:integer; j:integer; k:integer);
begin
   i := k
end;
procedure p(procedure formal(a:integer; b:integer));
var
   k,l:integer;
begin
   k := 1; l := 2;
   formal (k,l)
end;
begin
   p(actual); { !!! actual() has 3 parameters, p() requires function with 2 parameters }
   writeln('ERROR NOT DETECTED ... 6.6.3.6f, NR PARAMS DIFFERENT')
end.


{TEST 6.6.3.6g}
{test a compilation error occurs if parameter lists are not congruous }
program e6p6p3p6g( output );

type
   smallInt  = 1..10;
   arrayType =   array['1'..'9'] of integer;

var
   aci, aci1 : arrayType;
   aci2      : array['1'..'9'] of integer;

   aii : array[1..9] of integer;

procedure p1(ii1: integer);
begin
   aci1['1'] := ii1;
end; { p1 }

procedure p2( function ff1: integer);
var
   z   : char;
begin
   z := '3';
   aci2[z] := 3;
   aci['8'] := 3;
end;

procedure test( procedure p(ii1: integer ) );
begin
   p(aii[2]);
end; { test }

begin {e6p6p3p6g}
   test(p1);    { OK }
   test(p2);    { !!! parameter is not a function }
   writeln('ERROR NOT DETECTED ... 6.6.3.6g, PARAMS DIFFERENT CLASS');
end. { e6p6p3p6g }


{TEST 6.6.3.6h}
{test a compilation error occurs if parameter lists are not congruous }
program e6p6p3p6h( output );

var
   aci2      : array['1'..'9'] of integer;
   aii : array[1..9] of integer;

procedure p0( ii1: integer );
begin
   aci2['1'] := ii1;
end; { p1 }

procedure p1(procedure p(ii1: integer) );
begin
   p(aci2['1']);
end; { p1 }

procedure p2( procedure p(function ff1: integer) );
var
   z   : char;
begin
   z := '3';
   aci2[z] := 3;
   aci2['8'] := 3;
end;

procedure test( procedure p( procedure pp(ii1: integer) ) );
begin
   p(p0);
end; { test }

begin {e6p6p3p6h}
   test(p1);    { OK }
   test(p2);    { !!! parameter is a function }
   writeln('ERROR NOT DETECTED ... 6.6.3.6h, PARAMS DIFFERENT CLASS');
end. { e6p6p3p6h }


{TEST 6.6.3.6i}
{test a compilation error occurs if parameter lists are not congruous }
program e6p6p3p6i( output );

procedure p1(ii1:integer; ii2: integer);
begin
end; { p1 }

procedure p2(ii1, ii2: integer);
begin
end; { p2 }

procedure test( procedure p( i : integer; j : integer ) );
begin
   p( 3, 4 );
end;
begin {e6p6p3p6i}
   test(p1);    { OK }
   test(p2);    { !!! parameter sections are different }
   writeln('ERROR NOT DETECTED ... 6.6.3.6i, PARAM sections');
end. { e6p6p3p6i }


{TEST 6.6.3.6j}
{test a compilation error occurs if parameter lists are not congruous }
program e6p6p3p6j( output );

procedure p1(ii1, ii2: integer);
begin
end; { p1 }

procedure p2(ii1:integer; ii2: integer);
begin
end; { p2 }

procedure test( procedure p( i,j : integer ) );
begin
   p( 3, 4 );
end;
begin {e6p6p3p6j}
   test(p1);    { OK }
   test(p2);    { !!! parameter sections are different }
   writeln('ERROR NOT DETECTED ... 6.6.3.6j, PARAM sections');
end. { e6p6p3p6j }


{TEST 6.6.5.2a}
{Cause an error to occur if put(f) is called when the file is in read mode. }
program e6p6p5p2a(output);
var
   f : text;
begin
   rewrite(f);
   writeln(f,'ABC');
   reset(f); { eof is false and f^='A' }
   put(f); { !!! error - file is in read mode (and eof is not true) }
   writeln('ERROR NOT DETECTED ... 6.6.5.2a put() called in read mode')
end.


{TEST 6.6.5.2b}
{Cause an error to occur if write(f) is called when the file is in read mode. }
program e6p6p5p2b(output);
var
   f : text;
begin
   rewrite(f);
   writeln(f,'ABC');
   reset(f); { eof is false and f^='A' }
   write(f, 'test'); { !!! error - file is in read mode (and eof is not true) }
   writeln('ERROR NOT DETECTED ... 6.6.5.2b write() called in read mode')
end.


{TEST 6.6.5.2c}
{Cause an error to occur if writeln(f) is called when the file is in read mode. }
program e6p6p5p2c(output);
var
   f : text;
begin
   rewrite(f);
   writeln(f,'ABC');
   reset(f); { eof is false and f^='A' }
   writeln(f, 'TEST'); { !!! error - file is in read mode (and eof is not true) }
   writeln('ERROR NOT DETECTED ... 6.6.5.2c writeln() called in read mode')
end.


{TEST 6.6.5.2d}
{Cause an error to occur if page(f) is called when the file is in read mode. }
program e6p6p5p2d(output);
var
   f : text;
begin
   rewrite(f);
   writeln(f,'ABC');
   reset(f); { eof is false and f^='A' }
   page(f); { !!! error - file is in read mode (and eof is not true) }
   writeln('ERROR NOT DETECTED ... 6.6.5.2d page() called in read mode')
end.


{TEST 6.6.5.2e}
{Cause an error to occur if get(f) is called when eof(f) is true. }
program e6p6p5p2e(output);
const
   verbose = false;
var
   f : text;
begin
   { lazy i/o means file is not really read until f^ is used }
   rewrite( f);
   writeln( f,' ABC');
   reset (f); { f^=' ' }
   if verbose then write( '''', f^, ''', ', eof(f), ', ');
   get (f); { f^='A' }
   if verbose then write( '''', f^, ''', ', eof(f), ', ');
   get (f); { f^= 'B' }
   if verbose then write( '''', f^, ''', ', eof(f), ', ');
   get (f); { f^= 'C' }
   if verbose then write( '''', f^, ''', ', eof(f), ', ');
   get (f); { f^= ' ', from the writeln }
   if verbose then write( '''', f^, ''', ', eof(f), ', ');
   get(f); { f^ undefined ... eof is true}
   if verbose then write( '''', f^, ''', ', eof(f), ', ');
   get(f); { !!! error since eof is true}
   if verbose then write( '''', f^, ''', ', eof(f), ', ');
   writeln('ERROR NOT DETECTED ... 6.6.5.2e get() when at EOF')
end.


{TEST 6.6.5.2f}
{Cause an error to occur if get(f) is called when eof(f) is true.
 Similar to  6.6.5.2e, but this time the file is empty}
program e6p6p5p2f(output);
const
   verbose = false;
var
   f : text;
begin
   { lazy i/o means file is not really read until f^ is used }
   rewrite( f);
   reset (f); { eof is true, f^ is undefined }
   get(f); { !!! error since eof is true}
   if verbose then write( '''', f^, ''', ', eof(f), ', ');
   writeln('ERROR NOT DETECTED ... 6.6.5.2f get on empty file')
end.


{TEST 6.6.5.2h}
{Cause an error to occur if read(f) is called when the file is in write mode. }
program e6p6p5p2h(output);
var
   f : text;
   c : char;
begin
   rewrite(f);
   writeln(f,'ABC');
   read(f,c); { !!! causes an error - file is in write mode (and eof is true) }
   writeln('ERROR NOT DETECTED ... 6.6.5.2h read() for file in write mode')
end.


{TEST 6.6.5.2i}
{Cause an error to occur if readln(f) is called when the file is in write mode. }
program e6p6p5p2i(output);
var
   f : text;
   c : char;
begin
   rewrite(f);
   writeln(f,'ABC');
   readln(f,c); { !!! causes an error - file is in write mode (and eof is true) }
   writeln('ERROR NOT DETECTED ... 6.6.5.2i read() for file in write mode')
end.


{TEST 6.6.5.2j}
{Cause an error to occur if get(f) is called when the file is in write mode. }
program e6p6p5p2j(output);
var
   f : text;
begin
   rewrite(f);
   writeln(f,'ABC');
   get(f); { !!! causes an error - file is in write mode (and eof is true) }
   writeln('ERROR NOT DETECTED ... 6.6.5.2j get() for file in write mode')
end.


{TEST 6.6.5.2k}
{Check that reading from a file causes an error when the value possessed by the
 buffer-variable is not assignment-compatible with the variable-access.}
program e6p6p5p2k(output);
var
   f : file of integer;
   x : real;
begin
   rewrite(f);
   write(f, 1,2,3,4);
   reset(f);
   read(f,x); { !!! error - attempted read real from file of integer }
   writeln('ERROR NOT DETECTED ... 6.6.5.2k read file type')
end.


{TEST 6.6.5.2l}
{Check that  writing to a file causes an error when the value possessed by the
 buffer-variable is not assignment-compatible with the variable-access.}
program e6p6p5p2l(output);
var
   f : file of integer;
   x : real;
begin
   rewrite(f);
   x := 123.456;
   write(f,x); { !!! error - attempted write real number to file of integer }
writeln('ERROR NOT DETECTED ... 6.6.5.2l get() write file type')
end.


{TEST 6.6.5.2m}
{Cause an error to occur if put(f) is called when the file is undefined. }
program e6p6p5p2m(output);
var
   f : text;
begin
   put(f); { !!! error - file is undefined }
   writeln('ERROR NOT DETECTED ... 6.6.5.2m put() called when file is undefined')
end.


{TEST 6.6.5.2n}
{Cause an error to occur if write(f) is called when the file is undefined. }
program e6p6p5p2n(output);
var
   f : text;
begin
   write(f, 'test'); { !!! error - is undefined }
   writeln('ERROR NOT DETECTED ... 6.6.5.2n write() called when file is undefined')
end.


{TEST 6.6.5.2o}
{Cause an error to occur if writeln(f) is called when the file is undefined. }
program e6p6p5p2o(output);
var
   f : text;
begin
   writeln(f, 'TEST'); { !!! error - file is undefined }
   writeln('ERROR NOT DETECTED ... 6.6.5.2o writeln() called when file is undefined')
end.


{TEST 6.6.5.2p}
{Cause an error to occur if page(f) is called when the file is undefined. }
program e6p6p5p2p(output);
var
   f : text;
begin
   page(f); { !!! error - file is undefined }
   writeln('ERROR NOT DETECTED ... 6.6.5.2p page() called when file is undefined')
end.


{TEST 6.6.5.2q}
{Cause an error to occur if write(f) is called with no other parameters. }
program e6p6p5p2q(output);
var
   f : text;
begin
   rewrite(f);
   write(f); { !!! error - no data to write }
   writeln('ERROR NOT DETECTED ... 6.6.5.2q write() called with only a file parameter')
end.


{------- 6.6.5.3 Dynamic allocation procedures -------}

{TEST 6.6.5.3c}
{ Cause an error to occur if the pointer parameter of dispose is nil. }
program e6p6p5p3c(output);
type
   myRecord = record
           a : integer;
           b : boolean
        end;
var
   ptr : ^myRecord;
begin
   ptr := nil;
   dispose (ptr); { !!! nil pointer }
   writeln('ERROR NOT DETECTED ... 6.6.5.3c - DISPOSE')
end.


{TEST 6.6.5.3d}
{Similarly to 6.6.5.3c, an error is caused by the pointer variable of
dispose being uninitialised.
The error should be detected by the compiler or at run-time. }
program e6p6p5p3d(output);
type
   myRecord = record
	       a : integer;
	       b : boolean
	    end;
var
   ptr: ^myRecord;
begin
   dispose(ptr); { !!! uninitialised pointer }
   writeln('ERROR NOT DETECTED ... 6.6.5.3d - DISPOSE')
end.


{TEST 6.6.5.3e}
{Cause an error to occur if a variable which is currently an actual
variable parameter is refered to by the pointer parameter of dispose. }
program e6p6p5p3e(output);
var
   ptr : ^integer;
procedure wrong(var a:integer);
var
   x : integer;
begin
   x := a*2;
   dispose(ptr)
end;
begin
   new(ptr);
   ptr^ := 6;
   wrong(ptr^);		{ !!! pointer is disposed inside wrong() }
   writeln('ERROR NOT DETECTED ... 6.6.5.3e - NEW')
end.


{TEST 6.6.5.3f}
{Cause an error to occur if a variable which is an element of the record-variable-list
of a with statement is refered to by the pointer parameter of dispose. }
program e6p6p5p3f(output);
type
   subrange = 0 .. 9999;
   myRecord = record
	     name : packed array[1 .. 15] of char;
	     employeenr : subrange
	  end;
var
   ptr : ^myRecord;
begin
   new(ptr);
   with ptr^ do begin
      name := 'HARRY M. MULLER';
      employeenr := 9998;
      dispose (ptr)	{ !!! dispose memory while part of with statement }
   end;
   writeln('ERROR NOT DETECTED ... 6.6.5.3f - DISPOSE')
end.


{TEST 6.6.5.3g}
{Check if an error is detected and reported when a variable created by the
 the variant form of new is used in an expression. }
program e6p6p5p3g(output);
type
   two = (a,b);
   myRecord=   record
	 case tagfield:two of
	    a : (m : boolean);
	    b : (n : char)
      end;

var
   ptr: ^myRecord;
   r:   myRecord;
begin
   new(ptr,a);
   ptr^.m := true;
   r := ptr^;   { !!! ptr^ created by variant form of new(), r is not }
   dispose(ptr,a);
   writeln('ERROR NOT DETECTED ... 6.6.5.3g - NEW')
end.


{TEST 6.6.5.3h}
{Cause an error to occur, as a variable created by the use of
 the variant form of new is used as the variable in an assignment statement. }
program e6p6p5p3h(output);
type
   two = (a,b);
   myRecord =   record
      case tagfield:two of
	 a : (m : boolean);
	 b : (n : char)
      end;
var
   ptr:   ^myRecord;
   r :myRecord;
begin
   new(ptr,b);
   r.tagfield := b;
   r.n := 'A';
   ptr^ := r;  { !!! 2nd form of new() in assignment }
   writeln('ERROR NOT DETECTED ... 6.6.5.3h - NEW');
   dispose(ptr);
end.


{TEST 6.6.5.3i}
{ Cause an error to occur, as a variable created by the
  use of the variant form of new is used as an actual parameter. }
program e6p6p5p3i(output);
type
   two =  (a,b);
   myRecord =  record
		case tagfield:two of
		   a : (m : boolean);
		   b : (c : char)
		end;
var
   ptr: ^myRecord;
procedure wrong(c : myRecord);
begin
   writeln('ERROR NOT DETECTED ... 6.6.5.3i - NEW')
end;
begin
   new(ptr,a);
   ptr^.m := true;
   wrong(ptr^); { !!! 2nd form of new() is an actual parameter }
   dispose(ptr);
end.


{TEST 6.6.5.3j}
{ Cause an error to occur if the variant form of new is used when there is no variant. }
program e6p6p5p3j(output);
type
   myRecord = record
           i : integer;
           c : char;
        end;
var
   ptr : ^myRecord;
begin
   new(ptr,0);  { !!! there is no variant }
   writeln('ERROR NOT DETECTED ... 6.6.5.3j - new(), missing variant')
end.


{TEST 6.6.5.3k}
{ Cause an error to occur if the variant form of new is used with a real tagfield. }
program e6p6p5p3k(output);
type
   myRecord = record
           i : integer;
           c : char;
           case b: boolean of
           true:  (x: real);
           false: (l: boolean)
        end;
var
   ptr : ^myRecord;
begin
   new(ptr, true); {ok}
   new(ptr,0.0);  { !!! cannot have a real tagfield }
   writeln('ERROR NOT DETECTED ... 6.6.5.3k - new(), invalid tagfield')
end.


{TEST 6.6.5.3l}
{ Cause an error to occur if the variant form of new is used with a string tag field. }
program e6p6p5p3l(output);
type
   myRecord = record
           i : integer;
           c : char;
           case b: boolean of
           true:  (x: real);
           false: (l: boolean)
        end;
var
   ptr : ^myRecord;
begin
   new(ptr, true); {ok}
   new(ptr, 'aa');  { !!! cannot have a string tagfield }
   writeln('ERROR NOT DETECTED ... 6.6.5.3l - new(), invalid tagfield')
end.


{TEST 6.6.5.3m}
{ Cause an error to occur if the variant form of new is used with an extra tag field. }
program e6p6p5p3m(output);
type
   myRecord = record
           i : integer;
           c : char;
           case b: boolean of
           true:  (r: record x: real; end);
           false: (l: boolean)
        end;
var
   ptr : ^myRecord;
begin
   new(ptr, true); {ok}
   new(ptr, true, 0);  { !!! there is no second tagfield }
   writeln('ERROR NOT DETECTED ... 6.6.5.3m - new(), extra tagfield')
end.


{TEST 6.6.5.3n}
{ Cause an error to occur if the parameter of dispose is not a pointer. }
program e6p6p5p3n(output);
var
   ptr : ^integer;
begin
   new(ptr);
   ptr^ := 42;
   dispose (ptr^); { !!! arg is not a pointer }
   writeln('ERROR NOT DETECTED ... 6.6.5.3n - DISPOSE HAS NON-POINTER ARG')
end.


{TEST 6.6.5.3o}
{ Cause an error to occur if the parameter of new is not a pointer. }
program e6p6p5p3n(output);
var
ptr : ^integer;
begin
   new(ptr^); { !!! arg is not a pointer }
   writeln('ERROR NOT DETECTED ... 6.6.5.3o - ARG OF NEW IS NOT A POINTER')
end.


{TEST 6.6.5.3p}
{Check if an error is detected and reported when a tag the
 the variant form of new has the incorrect type. }
program e6p6p5p3p(output);
type
   two = (a,b);
   myRecord =   record
                   case tagfield:two of
                      a : (m : boolean);
                      b : (n : char)
                   end;

var
   ptr: ^myRecord;
begin
   new(ptr, 1);   { !!! tag has incorrect type }
   dispose(ptr, 1);
   writeln('ERROR NOT DETECTED ... 6.6.5.3p - NEW')
end.


{------- 6.6.5.4 Transfer procedures -------}

{TEST 6.6.5.4a}
{In the pack procedure, verify that the starting index of the unpacked array must
 allow enough components to fill the packed array.}
program e6p6p5p4a(output);
var
  a: array[1..9] of char;
  z: packed array[1..4] of char;
begin
  a[1] := 'l'; a[2] := 'a'; a[3] := 'm'; a[4] := 'b';
  pack(a,7,z); { !!! not enough components available to fill z }
  writeln('ERROR NOT DETECTED ... 6.6.5.4a - PACK, index error')
end.


{TEST 6.6.5.4a}
{In the unpack procedure, verify that the starting index of the unpacked array must
 allow enough components to be transferred from the packed array.}
program e6p6p5p4b(output);
var
  a: array[1..9] of char;
  z: packed array[1..4] of char;
begin
  a[1] := 'l'; a[2] := 'a'; a[3] := 'm'; a[4] := 'b';
  unpack(z, a, 7); { !!! not enough space available to store all of z }
  writeln('ERROR NOT DETECTED ... 6.6.5.4b - UNPACK, index error')
end.


{TEST 6.6.5.4d}
{Test that the index variable of pack is assignment compatible with the packed array.}
program e6p6p5p4d(output);
type
   colour = (red, yellow, green, blue, tartan);
var
   a: array[colour] of integer;
   z: packed array[colour] of integer;
begin
   unpack(z,a,0); { !!! index must be colour type }
   writeln('ERROR NOT DETECTED ... 6.6.5.4d - UNPACK')
end.


{TEST 6.6.5.4e}
{Test that the index variable of unpack is assignment compatible with the packed array.}
program e6p6p5p4e(output);
type
   colour = (red, yellow, green, blue, tartan);
var
   a: array[colour] of integer;
   z: packed array[colour] of integer;
begin
   unpack(z,a,0); { !!! index must be colour type }
   writeln('ERROR NOT DETECTED ... 6.6.5.4e - UNPACK')
end.


{TEST 6.6.5.4f}
{Test that component types of source and destination of pack are are the same.}
program e6p6p5p4f(output);
type
   colour = (red, yellow, green, blue, tartan);
var
   a: array[1..9] of colour;
   z: packed array[1..9] of integer;
begin
   pack(a,1,z); { !!! component types of a & z are not the same }
   writeln('ERROR NOT DETECTED ... 6.6.5.4f - PACK, component types')
end.


{TEST 6.6.5.4g}
{Test that component types of source and destination of unpack are are the same.}
program e6p6p5p4g(output);
type
   colour = (red, yellow, green, blue, tartan);
var
   a: array[1..9] of colour;
   z: packed array[1..9] of integer;
begin
   unpack(z,a,1); { !!! component types of a & z are the same }
   writeln('ERROR NOT DETECTED ... 6.6.5.4g - UNPACK,  component types')
end.


{TEST 6.6.5.4h}
{Test that component types of source and destination of pack are are the same.}
program d6p6p5p4h(output);
type
  capitals = 'A'..'Z';
var
  a: array[1..9] of char;
  z: packed array[1..4] of capitals;
begin
  a[1] := 'l'; a[2] := 'a'; a[3] := 'm'; a[4] := 'b';
  pack(a,1,z); { !!! component types of a & z are not the same }
  writeln('ERROR NOT DETECTED ... 6.6.5.4h - PACK, component types not identical')
end.


{TEST 6.6.5.4i}
{Test that component types of source and destination of unpack are are the same.}
program d6p6p5p4i(output);
type
  capitals = 'A'..'Z';
var
  a: array[1..9] of capitals;
  z: packed array[1..4] of char;
begin
  z := 'lion';
  unpack(z,a,1); { !!! component types of a & z are not compatible }
  writeln('ERROR NOT DETECTED ... 6.6.5.4i - UNPACK,  component types not identical')
end.


{TEST 6.6.5.4j}
{Test that component types of source and destination of unpack do not
 assign components that contain files.}
program e6p6p5p4j(output);
type
  rec = record
          f: text;
          b: boolean;
        end;
var
  a: array[1..9] of rec;
  z: packed array[1..9] of rec;
begin
  pack(a,1,z); { !!! component types of a & z contain a file }
  writeln('ERROR NOT DETECTED ... 6.6.5.4j - PACK,  file in component types')
end.


{TEST 6.6.5.4k}
{Test that component types of source and destination of unpack do not
 assign components that contain files.}
program e6p6p5p4k(output);
type
  rec = record
          f: text;
          b: boolean;
        end;
var
  a: array[1..9] of rec;
  z: packed array[1..9] of rec;
begin
  unpack(z,a,1); { !!! component types of a & z contain a file }
  writeln('ERROR NOT DETECTED ... 6.6.5.4k - UNPACK,  file in component types')
end.


{------- 6.6.6.2 Arithmetic functions -------}

{TEST 6.6.6.2a}
{ test that sqr(n) causes a fatal error if it overflows }
program e6p6p6p2a(output);
var
   k, l, h : 0..maxint;
begin
   k := 1;
   while sqr(k) <= maxint div 4 do
      k := 2*k;

   h := 2*k+1;
   l := k;
   {sqr(l) <= maxint, sqr(h) > maxint}

   while h > l+1 do begin
      k := (h-l) div 2;
      if sqr(l) > maxint -sqr(k) - 2*l*k then
         h := l+k
      else
         l := l+k;
   end;

   { now, sqr(l) <= maxint, sqr(h) > maxint, h = l+1 }
   writeln( 'sqr(', l:1, ') is ', sqr(l):1 ); { this should not overflow }
   writeln( 'sqr(', l+1:1, ') is ', sqr(l+1):1 ); { !!! this should overflow }
   writeln('ERROR NOT DETECTED ... 6.6.6.2a, sqr(n) > maxint')
end. { e6p6p6p2a }


{TEST 6.6.6.2b}
{ test that sqr(n) causes a fatal error if it overflows, where n is negative }
program e6p6p6p2b(output);
var
   k, l, h : 0..maxint;
begin
   k := 1;
   while sqr(k) <= maxint div 4 do
      k := 2*k;

   h := 2*k+1;
   l := k;
   {sqr(l) <= maxint, sqr(h) > maxint}

   while h > l+1 do begin
      k := (h-l) div 2;
      if sqr(l) > maxint -sqr(k) - 2*l*k then
         h := l+k
      else
         l := l+k;
   end;

   { now, sqr(l) <= maxint, sqr(h) > maxint, h = l+1 }
   writeln( 'sqr(', -l:1, ') is ', sqr(-l):1 ); { this should not overflow }
   writeln( 'sqr(', -l-1:1, ') is ', sqr(-l-1):1 ); { !!! this should overflow }
   writeln('ERROR NOT DETECTED ... 6.6.6.2b, sqr(-n) > maxint')
end. { e6p6p6p2b }


{TEST 6.6.6.2d}
{Check that an error occurs when a negative argument is used for the ln function. }
program e6p6p6p2d(output);
var
   m : real;
begin
   m := -2.71828;
   m := ln(m*2);	{ !!! illegal negative argument }
   writeln('ERROR NOT DETECTED ... 6.6.6.2d, ln negative nr')
end.


{TEST 6.6.6.2e}
{Cause an error to occur when a negative real argument is used for the sqrt function. }
program e6p6p6p2e(output);
var
   m   : real;
   x, y : real;
begin
   x := 256.0;
   y := x*2;
   y := y-257;
   m := sqrt(y-x);	{ !!! illegal negative argument }
   writeln('ERROR NOT DETECTED ... 6.6.6.2e, sqrt negative real nr')
end.


{TEST 6.6.6.2f}
{Cause an error to occur when a negative integer argument is used for the sqrt function. }
program e6p6p6p2f(output);
var
   m   : real;
   i, j : integer;
begin
   i := 256;
   j := i*2;
   j := j-257;
   m := sqrt(j-i);      { !!! illegal negative argument }
   writeln('ERROR NOT DETECTED ... 6.6.6.2f, sqrt negative integer')
end.


{TEST 6.6.6.2g}
{verify that an error is detected when the argument of abs() is not integer or real.}
program e6p6p6p2g(output);
var
  c   : char;
begin
  c := 'a';
  write(abs(c));      { !!! illegal argument }
  writeln('ERROR NOT DETECTED ... 6.6.6.2g, argument of abs not integer or real')
end.


{TEST 6.6.6.2g}
{verify that an error is detected when the argument of sqr() is not integer or real.}
program e6p6p6p2g(output);
var
c   : char;
begin
c := 'a';
write(sqr(c));      { !!! illegal argument }
writeln('ERROR NOT DETECTED ... 6.6.6.2g, argument of sqr not integer or real')
end.


{TEST 6.6.6.3a}
{ Cause an error to occur if the result returned
  by the trunc function is not a value of the type integer. }
program e6p6p6p3a(output);
var
    x: real;
    i: integer;
begin
    x := maxint+0.9;
    i := trunc (x);	{ OK }
    x := maxint+1.0;
    i := trunc (x);	{ !!! becomes greater than maxint }
    writeln('ERROR NOT DETECTED ... 6.6.6.3a TRUNC(MAXINT)')
end.


{TEST 6.6.6.3b}
{ Cause an error to occur if the result returned
  by the trunc function is not a value of the type integer. }
program e6p6p6p3b(output);
var
   x: real;
   i: integer;
begin
    x := -maxint-0.9;
    i := trunc (x);	{ OK }
    x := -maxint-2.0;
    i := trunc (x);	{ !!! becomes less than -maxint }
    writeln('ERROR NOT DETECTED ... 6.6.6.3b TRUNC(-MAXINT)')
end.


{TEST 6.6.6.3c}
{Cause an error to occur if the result returned
 by the round function is not a value of the type integer. }
program e6p6p6p3c(output);
var
    x : real;
    i : integer;
begin
    x := maxint+0.4;
    i := round(x);	{ OK }
    x := maxint+0.5;
    i := round(x);	{ !!! becomes greater than maxint }
    writeln('ERROR NOT DETECTED ... 6.6.6.3c ROUND(BIGNR)')
end.


{TEST 6.6.6.3d}
{Cause an error to occur if the result returned
 by the round function is not a value of the type integer. }
program e6p6p6p3d(output);
var
    x : real;
    i : integer;
begin
    x := -maxint - 0.4;
    i := round(x);	{ OK }
    x := -maxint - 1.5;
    i := round(x);	{ !!! becomes less than -maxint }
    writeln('ERROR NOT DETECTED ... 6.6.6.3d ROUND(-BIGNR)')
end.


{TODO: test for large -ve integer}
{TEST 6.6.6.3e}
{ Cause an error to occur if the result returned
  by the trunc function is not a value of the type integer. }
program e6p6p6p3e(output);
var
    x: real;
    i: integer;
    ok: boolean;
begin
    x := 11111.11111;
    ok := true;
    while ok do begin
        i := trunc (x);	{ !!! becomes greater than maxint }
        if i<0 then
            ok := false
        else
            x := x*2
    end;
    writeln('ERROR NOT DETECTED ... 6.6.6.3e TRUNC(BIGNR)')
end.


{TODO: test for large -ve integer}
{TEST 6.6.6.3f}
{Cause an error to occur if the result returned
 by the round function is not a value of the type integer. }
program e6p6p6p3f(output);
var
   x : real;
   i : integer;
   ok : boolean;
begin
   x := 11111.11111;
   ok := true;
   while ok do begin
      i := round(x);	{ !!! becomes greater than maxint }
      if i<0 then
	 ok := false
      else
	 x := x*2
   end;
   writeln('ERROR NOT DETECTED ... 6.6.6.3f ROUND(BIGNR)')
end.


{TEST 6.6.6.4d}
{Cause an error to occur when the function SUCC is applied to the last value of an ordinal type. }
program e6p6p6p4d(output);
type
   enumerated = (first,second,third,last);
var
   ordinal : enumerated;
begin
   ordinal := succ(last);  { !!! exceeds upper bound }
   writeln('ERROR NOT DETECTED ... 6.6.6.4d')
end.


{TEST 6.6.6.4e}
{Cause an error to occur when PRED is applied to the first value of an ordinal type.}
program e6p6p6p4e(output);
type
   enumerated = (first,second,third,fourth,last);
var
   ordinal : enumerated;
begin
   ordinal := first;
   ordinal := pred(ordinal); { !!! result goes beyond low bound }
   writeln('ERROR NOT DETECTED ... 6.6.6.4e, PRED')
end.


{TEST 6.6.6.4g}
{Test than an error occurs when the argument of chr() exceeds the largest character.}
program e6p6p6p4g(output);
var
   i : integer;
   c:char;
begin
   i := 1;
   while i < maxint div 2 do begin
     c := chr(i);	{ !!! result exceeds max char bound }
     i := 2*i;
   end;
   writeln('ERROR NOT DETECTED ... 6.6.6.4g, CHR')
end.


{------- 6.6.6.5 Boolean functions -------}

{TEST 6.6.6.5a}
{Check that an error occurs when eof is called without parameters and
there is no input parameter in the program header. }
program e6p6p6p5a(output);
begin
   if eoln then        { !!! eoln requires input in program header }
     writeln(' DEVIATES ... 6.6.6.5a, eoln standard input');
   writeln('ERROR NOT DETECTED ... 6.6.6.5a, eof standard input')
end.


{TEST 6.6.6.5b}
{Check that an error occurs when eoln is called on a binary file. }
program e6p6p6p5b(output);
var
f : packed file of char;
begin
   rewrite(f);
   if eoln(f) then        { !!! eoln requires a text file }
      writeln(' DEVIATES ... 6.6.6.5b, eoln binary file');
   writeln('ERROR NOT DETECTED ... 6.6.6.5b, eoln binary file')
end.


{TEST 6.6.6.5c}
{Check that an error occurs when eoln is called without parameters and
there is no input parameter in the program header. }
program e6p6p6p5c(output);
begin
   if eoln then        { !!! eoln requires input in program header }
      writeln(' DEVIATES ... 6.6.6.5c, eoln standard input');
   writeln('ERROR NOT DETECTED ... 6.6.6.5c, eoln standard input')
end.


{TEST 6.6.6.5d}
{Check that eoln is restricted to text files.
 Similar to TEST 6.6.6.5b, but test eoln when file is in read mode}
program e6p6p6p5d(output);
var
   f: packed file of char;
begin
   rewrite(f);
   write(f, 'a', 'b', 'c', 'd');
   reset(f);
   if eoln(f) then        { !!! eoln() applies to text files only }
      writeln(' DEVIATES ... 6.6.6.5d, eoln non-text file');
   writeln('ERROR NOT DETECTED ... 6.6.6.5d, eoln non-text file')
end.


{TEST 6.6.6.5e}
{Check that eoln(f) causes an error if file f is undefined. }
program e6p6p6p5e(output);
var
   f: text;
   b: boolean;
begin
   b := eoln(f);        { !!! file f is not yet defined }
      writeln('ERROR NOT DETECTED ... 6.6.6.5e, eoln undefined file')
end.


{TEST 6.6.6.5f}
{Check that eoln(f) causes an error if file f is in write mode.
This is indirectly implied by the standard, since
- eoln(f) causes an error if eof(f) is true, and
- eof(f) is always true if the file is writable }
program e6p6p6p5f(output);
var
   f: text;
   b: boolean;
begin
   rewrite(f);
   b := eoln(f);        { !!! file f is not in read mode }
   writeln('ERROR NOT DETECTED ... 6.6.6.5f, eoln write mode')
end.


{TEST 6.6.6.5g}
{Check that eof(f) causes an error if file f is undefined. }
program e6p6p6p5g(output);
var
   f: file of real;
   b: boolean;
begin
   b := eof(f);        { !!! file f is not yet defined }
      writeln('ERROR NOT DETECTED ... 6.6.6.5g, eof undefined file')
end.


{TEST 6.6.6.5h}
{Check that eoln(f) causes an error if eof(f) is true. }
program e6p6p6p5h(output);
var
   f: text;
   b: boolean;
begin
   rewrite(f);
   write(f, 'test');
   reset(f);
   while not eof(f) do
      get(f);
   b := eoln(f);        { !!! eoln(f) is invalid when file f is at end of file }
   writeln('ERROR NOT DETECTED ... 6.6.6.5h, eoln when at eof')
end.


{------- 6.7 Expressions -------}

{------- 6.7.1 General -------}


{------- 6.7.2.2 Arithmetic operators -------}

{TEST 6.7.2.2a}
{Check that an error occurs when the second operand of the / operator is 0. }
program e6p7p2p2a(output);
var
   x, y, z : real;
begin
   x := 6;
   y := 0;
   z := x / y;  { !!! division by zero }
   writeln('ERROR NOT DETECTED ... 6.7.2.2a: ZERO DIVIDE')
end.


{TEST 6.7.2.2b}
{Check that an error occurs when the second operand of the DIV operator is 0. }
program e6p7p2p2b(output);
var
   i, j, k : integer;
begin
   i := 6;
   j := 0;
   k := i div j;  { !!! division by zero }
   writeln('ERROR NOT DETECTED ... 6.7.2.2b: ZERO DIVIDE (DIV)')
end.


{TEST 6.7.2.2c}
{cause an error to occur if the second operand of the MOD operator is O. }
program e6p7p2p2c(output);
var
   i, j, k : integer;
begin
   i := 6;
   j := 0;
   k := i mod j; { !!! an error as j=0 }
   writeln('ERROR NOT DETECTED ... 6.7.2.2c: MOD ZERO')
end.


{TEST 6.7.2.2d}
{Cause an error to occur if the result of a binary integer operation > +maxint. }
program e6p7p2p2d(output);
var
   i : integer;
begin
   i := (maxint-(maxint div 2))*2+2; { !!! error, result > maxint }
   i := maxint+1;
   writeln('ERROR NOT DETECTED ... 6.7.2.2d INTEGER EXPRESSION OVERFLOW')
end.


{TEST 6.7.2.2e}
{ Cause an error to occur if the result of a binary integer operation < -maxint. }
program e6p7p2p2e(output);
var
   i : integer;
begin
   i := (-maxint+(maxint div 2))*2-2; { !!! error, result < -maxint }
   writeln('ERROR NOT DETECTED ... 6.7.2.2e INTEGER EXPRESSION OVERFLOW')
end.


{TEST 6.7.2.2h}
{Check that an error occurs when one of the operands of the DIV operator is non-numeric }
program e6p7p2p2h(output);
var
  i, k : integer;
begin
  i := 6;
  k := 'a' div i;  { !!! non-numeric operand }
  writeln('ERROR NOT DETECTED ... 6.7.2.2h: integer divide non-numeric operand')
end.


{TEST 6.7.2.2i}
{Check that an error occurs when one of the operands of the / operator is non-numeric }
program e6p7p2p2i(output);
var
  x, y : real;
begin
  x := 6.0;
  y := 'a' / x;  { !!! non-numeric operand }
  writeln('ERROR NOT DETECTED ... 6.7.2.2i: read divide non-numeric operand')
end.


{TEST 6.7.2.2j}
{Check that an error occurs when one of the operands of the MOD operator is non-numeric }
program e6p7p2p2j(output);
var
  i, k : integer;
begin
  i := 6;
  k := 'a' mod i;  { !!! non-numeric operand }
  writeln('ERROR NOT DETECTED ... 6.7.2.2j: mod non-numeric operand')
end.


{TEST 6.7.2.2k}
{Check that an error occurs when one of the operands of the * operator is neither numeric nor a set }
program e6p7p2p2k(output);
var
  i, k : integer;
begin
  i := 6;
  k := 'a' * i;  { !!! non-nemeric operand }
  writeln('ERROR NOT DETECTED ... 6.7.2.2k: add non-numeric operand')
end.


{TEST 6.7.2.2l}
{Check that an error occurs when one of the operands of the * operator is neither numeric nor a set }
program e6p7p2p2l(output);
var
  i, k : integer;
begin
  i := 6;
  k := 'a' * i;  { !!! non-nemeric operand }
  writeln('ERROR NOT DETECTED ... 6.7.2.2l: multiply non-numeric operand')
end.


{TEST 6.7.2.2m}
{Check that an error occurs when one of the operands of the - operator is neither numeric nor a set }
program e6p7p2p2m(output);
var
  i, k : integer;
begin
  i := 6;
  k := 'a' - i;  { !!! non-nemeric operand }
  writeln('ERROR NOT DETECTED ... 6.7.2.2m: sub non-numeric operand')
end.


{------- 6.7.2.3 Boolean operators -------}


{TEST 6.7.2.4a}
{Check that set bound errors are detected. }
program e6p7p2p4a(output);
var
   a,d : set of 0 .. 10;
   b,c : set of 5 .. 15;
begin
   b := [5,10];
   a := [0,5,10];
   d := a+b;  {ok}
   b := [5,10,15];
   c := a+b; { !!! set element out of range }
   writeln('ERROR NOT DETECTED ... 6.7.2.4a: OVERLAPPING SETS');
end.


{------- 6.7.3 Function-designators -------}

{TEST 6.7.3a}
{Check that using a function result that is undefined causes an error. }
program e6p7p3a(output);

function f: char;
begin
    if false then
        f := 'a'
end;                 { <---  error here, f unassigned}
begin
    write(f);        {!!! using undefined function result}
    writeln('ERROR NOT DETECTED ... 6.7.3a: using undefined function result');
end.


{TEST 6.7.3b}
{test that an error is detected if a variable is used when a function parameter is expected}
program e6p7p3b(output);
var
  pass: boolean;
procedure p( function af: boolean );
begin
  pass := af;
end;
begin
  pass := false;
  p(pass);  {!!! should be a boolean function}
  writeln('ERROR NOT DETECTED ... 6.7.3b, call function parameter')
end. {e6p7p3b}


{------- 6.8 Statements -------}

{------- 6.8.1 General -------}

{TEST 6.8.1a}
{Verify that using an undeclared array variable in a statement is detected and reported.}
program e6p8p1a(output);
type
   nums = 1..9;
var
   myArray: array [1..4] of nums;
   a,b : integer;
begin
   b := 2;
   a := myArray[1] + myArray[b];  {OK}
   a := undec1[1] + undec2[b];  {!!! undeclared arrays}
   writeln('ERROR NOT DETECTED ... 6.8.1a undeclared arrays')
end. {e6p8p1a}


{TEST 6.8.1b}
{Verify that using an undeclared record variable in a statement is detected and reported.}
program e6p8p1b(output);
type
   nums = 1..9;
var
   myRecord: record
      u, v: nums;
      c: char;
   end;
   a,b : integer;
begin
   b := 2;
   myRecord.u := b;  {OK}
   unDecRec.x :=  b;   {!!! undeclared record}
   writeln('ERROR NOT DETECTED ... 6.8.1b undeclared record')
end. {e6p8p1b}


{TEST 6.8.1c}
{Verify that using an undeclared pointer variable in a statement is detected and reported.}
program e6p8p1c(output);
type
   nums = 1..9;
var
   myPointer: ^real;
   a,b : integer;
begin
   b := 2;
   new(myPointer);
   myPointer^ := b;  {OK}

   undecPtr^ := 2;  {!!! undeclared pointer}
   writeln('ERROR NOT DETECTED ... 6.8.1c undeclared pointer')
end. {e6p8p1c}


{------- 6.8.2 Simple-statements -------}

{------- 6.8.2.1 General -------}


{------- 6.8.2.2 Assignment-statements -------}


{TEST 6.8.2.2a}
{For an assignment-statement, it is an error if the expression is of a set-type whose value is not
 assignment-compatible with the type possessed by the variable.
 Here we use a constant so the error is detectable at compile time.}
program e6p8p2p2a(output);
type
    nums = 1..9;
var
    s: set of nums;
    a,b : integer;
begin
    s := [1,3];  {OK}
    s := [0,3];  {!!! 0 is not in nums type}

    writeln('ERROR NOT DETECTED ... 6.8.2.2a assignment set range')
end. {e6p8p2p2a}


{TEST 6.8.2.2b}
{For an assignment-statement, it is an error if the expression is of a set-type whose value is not
 assignment-compatible with the type possessed by the variable.
 This test is similar to the previous one, but this time we use a variable so normally the error is
 not dectectable until run time. }
program e6p8p2p2b(output);
type
    nums = 1..9;
var
    s: set of nums;
    a,b : integer;
begin
    a := 1; b := 10;
    s := [a,b];  {OK}
    s := [a,b];  {!!! b=10 is not in nums type}

    writeln('ERROR NOT DETECTED ... 6.8.2.2b assignment set range')
end. {e6p8p2p2b}


{------- 6.8.2.3 Procedure-statements -------}


{TEST 6.8.2.3a}
{Check parameter list correctness }
program e6p8p2p3a(output);
procedure p( var ai: integer);
begin
  writeln('ERROR NOT DETECTED ... 6.8.2.3a, parameter list error');
end;
begin
  p(nil); {!!! integer variable required}
end.


{TEST 6.8.2.3b}
{Check parameter list correctness }
program e6p8p2p3b(output);
procedure p( function f: integer);
begin
   writeln('ERROR NOT DETECTED ... 6.8.2.3b, parameter list error');
end;
begin
   p(nil); {!!! function returning integer required}
end.


{------- 6.8.2.4 Goto-statements -------}


{------- 6.8.3 Structured-statements -------}

{------- 6.8.3.1 General -------}

{------- 6.8.3.2 Compound-statements -------}


{TEST 6.8.3.2b}
{ Check that a reserved word incorrectly placed in a compuond statement
  is detected and generates an error. }
program e6p8p3p2b(output);
var
   lab : integer;
begin
   lab := 13;
   if lab >= 0 then begin
      label := -13;  {!!! reserved word here}
   end; {if}
   writeln('ERROR NOT DETECTED ... 6.8.3.2b, reserved word in compound statement');
end.


{TEST 6.8.3.2c}
{ Check that an incorrectly terminated compound statement
  is detected and generates an error. }
program e6p8p3p2c(output);
var
   lab : integer;
begin
   lab := 13;
   repeat
      while lab >= 0 do begin
         lab := lab - 1;
      {end}
   until lab < 0;  {!!! missing end, misplaced until}
   writeln('ERROR NOT DETECTED ... 6.8.3.2c, missing end of compound statement');
end.


{TEST 6.8.3.4a}
{Check that an if statement rejects conditions that are not boolean. }
program e6p8p3p4a(output);
var
   i: integer;
begin
    i := 0;
    if i then	{ !!! boolean expression needed }
        writeln(' FAIL ... 6.8.3.4a, IF');
    writeln('ERROR NOT DETECTED ... 6.8.3.4a, if integer then');
end.


{------- 6.8.3.5 Case-statements -------}

{TEST 6.8.3.5a}
{Verify that duplicate case constants are detected and produce an error. }
program e6p8p3p5a(output);
var
    i: integer;
begin
    i := 0;
    case i of
    0,1,2: i:=6;
    3,3: writeln(' FAIL ... 6.8.3.5a, CASE');	{ !!! duplicate case selector }
    end;
    writeln('ERROR NOT DETECTED ... 6.8.3.5a, duplicate case constant');
end.


{TEST 6.8.3.5b}
{Verify that an error is detected when a case selector is not a constant. }
program e6p8p3p5b(output);
var
   i: integer;
   c: integer;
   begin
   i := 0;
   c := 3;
   case i of
   0,1,2: i:=6;
   c: writeln(' FAIL ... 6.8.3.5b, CASE selector is a variable');	{ !!! case selector is a variable}
   end;
   writeln('ERROR NOT DETECTED ... 6.8.3.5b, CASE selector is a variable');
end.


{TEST 6.8.3.5g}
{Verify that a missing end in a the case statement
is detected and generates an error. }
program e6p8p3p5g(output);
var
i: integer;
begin
   repeat
      i := 3;
      case i of	{ !!! unhandled case selector }
         3: writeln(' FAIL ... 6.8.3.5e, CASE');
      {end}        { !!! missing end }
   until true;
   writeln('ERROR NOT DETECTED ... 6.8.3.5g, MISSING END IN CASE STATEMENT');
end.

{------- 6.8.3.6 Repetitive-statements -------}


{------- 6.8.3.7 Repeat-statements -------}


{TEST 6.8.3.7a}
{Check that the until part of a repeat statement
rejects conditions that are not boolean. }
program e6p8p3p7a(output);
label 9;
var
    i: integer;
begin
    i := 0;
    repeat
        writeln(' FAIL ... 6.8.3.7a, UNTIL');
        goto 9;
    until i;	{ !!! boolean expression needed }
9:
    writeln('ERROR NOT DETECTED ... 6.8.3.7a, repeat ... until integer');
end.


{------- 6.8.3.8 While-statements -------}

{TEST 6.8.3.8a}
{Check that a while statement rejects conditions that are not boolean. }
program e6p8p3p8a(output);
label 9;
var
    i: integer;
begin
    i := 0;
    while i do begin	{ !!! boolean expression needed }
        writeln(' FAIL ... 6.8.3.8a, WHILE');
        goto 9;
    end;
9:
    writeln('ERROR NOT DETECTED ... 6.8.3.8a, while integer do');
end.


{------- 6.8.3.9 For-statements -------}


{TEST 6.8.3.9a}
{Test whether the initial value of a for statement control variable is checked for type compatibility. }
program e6p8p3p9a(output);
var
   i: integer;
begin
   for i := 'a' to ord('b') do   { !!! 'a' is not compatible with control variable }
      ;
   writeln('ERROR NOT DETECTED ...  6.8.3.9a, FOR EXPRESSION INCOMPATIBLE INITIAL VALUE')
end.


{TEST 6.8.3.9b}
{Test whether the final value of a for statement control variable is checked for type compatibility. }
program e6p8p3p9b(output);
var
i: integer;
begin
for i := ord('a') to 'b' do   { !!! 'b' is not compatible with control variable }
;
writeln('ERROR NOT DETECTED ...  6.8.3.9b, FOR EXPRESSION INCOMPATIBLE FINAL VALUE')
end.


{TEST 6.8.3.9c}
{Test whether the initial value of a for statement control variable is checked for type compatibility. }
program e6p8p3p9c(output);
var
i: integer;
begin
for i := ['a'] to ord('b') do   { !!! ['a'] is not compatible with control variable }
;
writeln('ERROR NOT DETECTED ...  6.8.3.9c, FOR EXPRESSION INCOMPATIBLE INITIAL VALUE')
end.


{TEST 6.8.3.9d}
{Test whether the final value of a for statement control variable is checked for type compatibility. }
program e6p8p3p9d(output);
var
i: integer;
begin
for i := ord('a') to ['b'] do   { !!! ['b'] are not compatible with control variable }
;
writeln('ERROR NOT DETECTED ...  6.8.3.9d, FOR EXPRESSION INCOMPATIBLE FINAL VALUE')
end.


{TEST 6.8.3.9e}
{Check that the use of a for statement control variable after the completion
of the for statement, and without an intervening assignment is detected. }
program e6p8p3p9e(output);
var
   i,j,k,m:integer;
begin
   i := 100;
   j := 1;
   k := 10;
   m := 0;
   for i := j to k do begin
      m := m+1;
   end;
   writeln('ERROR NOT DETECTED ... 6.8.3.9e, FOR THE VALUE OF I =', i:1);
end.


{TEST 6.8.3.9f}
{Use a for statement control variable after a for loop which is not entered.
 The control variable should be undefined after the for statement. }
program e6p8p3p9f(output);
var
   i,j,k,m:integer;
begin
   i := 100;
   k := 1;
   m := 0;
   j := 10;
   for i := j to k do begin {for loop not entered}
      m := m+1;
   end;
   writeln('ERROR NOT DETECTED ... 6.8.3.9f, FOR: I =', i:1);
end.


{TEST 6.8.3.9q}
{ Check the type of error produced when two nested for statements use the same control variable. }
program e6p8p3p9q(output);
var
   i,j : integer;
begin
   j := 0;
   for i := 1 to 10 do
      for i := 1 to 10 do { !!! both loops use same i }
	 j := j+i;
   writeln('ERROR NOT DETECTED ... 6.8.3.9q, FOR, (j is ', j, ')');
end. {e6p8p3p9q}


{TEST 6.8.3.9s}
{Check that range checking is applied to the end condition of for loops. }
program e6p8p3p9s(output);
const
   n0=0; n1=12;
var
   i: n0..n1;
   j : integer;
begin
   j := 0;
   for i := n0 to n1+1 do   { !!! i extends past upper limit of its range}
      j := j + i;

   writeln('ERROR NOT DETECTED ... 6.8.3.9s, FOR LOOP RANGE CHECKING UPPER LIMIT')
end. {e6p8p3p9s}


{TEST 6.8.3.9t}
{Check that range checking is applied to the start conditions of for loops. }
program e6p8p3p9t(output);
const
   n0=0; n1=12;
var
   i: n0..n1;
   j : integer;
begin
   j := 0;
   for i := n0-1 to n1 do   { !!! i starts outside lower limit of its range}
      j := j + i;

   writeln('ERROR NOT DETECTED ... 6.8.3.9t, FOR LOOP RANGE CHECKING LOWER LIMIT')
end. {e6p8p3p9t}


{TEST 6.8.3.9u}
{Check that range checking is applied to the end condition of for loops. }
program e6p8p3p9u(output);
const
   n0=-4; n1=12;
var
   i: n0..n1;
   j : integer;
begin
   j := 0;
   for i := n1+1 downto n0 do   { !!! i starts past upper limit of its range}
      j := j + i;

   writeln('ERROR NOT DETECTED ... 6.8.3.9u, FOR LOOP RANGE CHECKING UPPER LIMIT')
end. {e6p8p3p9u}


{TEST 6.8.3.9v}
{Check that range checking is applied to the end conditions of for loops. }
program e6p8p3p9v(output);
const
   n0=-4; n1=12;
var
   i: n0..n1;
   j : integer;
begin
   j := 0;
   for i := n1 downto n0-1 do  { !!! i falls below lower limit of its range}
      j := j + i;
   writeln('ERROR NOT DETECTED ... 6.8.3.9v, FOR LOOP RANGE CHECKING LOWER LIMIT');
end. {e6p8p3p9v}


{TEST 6.8.3.9w}
{Similar to 6.8.3.9v, but this time counting down to the lower limit might not
work if the control variable is unsigned - it could wrap around}
program e6p8p3p9w(output);
label 9;
const
   n1=12;
var
   i: 0..n1;
   j : integer;
begin
   j := -1;
   {in this test, i i could be unsigned, and decrementing it will cause it to wrap around
    so it will never reach -1}
   for i := n1 downto -1 do begin  { !!! i falls below lower limit of its range}
      j := j + 1;
      if j > n1 then begin
         writeln('ERROR NOT DETECTED ... 6.8.3.9w, FOR LOOP END CONDITION, UNSIGNED CONTROL VARIABLE');
         goto 9;
      end;
   end;
   writeln('ERROR NOT DETECTED ... 6.8.3.9w, FOR LOOP RANGE CHECKING LOWER LIMIT');
9:
end. {e6p8p3p9w}


{TEST 6.8.3.9x}
{Similar to 6.8.3.9v, but this time counting up to the upper limit might not
work if the control variable is implemented in 8 bits
- does it wrap around so never reaches the upper bound?}
program e6p8p3p9x(output);
label 9;
const
   n1=255;
var
   i: 0..n1;
   j : integer;
begin
   j := -1;
   {in this test, i i could be a single byte, and incrementing it will cause it to wrap around
    so it will never reach 256}
   for i := 0 to 256 do begin  { !!! i exceeds upper limit of its range}
      j := j + 1;
      if j > n1 then begin
         writeln('ERROR NOT DETECTED ... 6.8.3.9x, FOR LOOP END CONDITION, UNSIGNED CONTROL VARIABLE');
         goto 9;
      end;
   end;
   writeln('ERROR NOT DETECTED ... 6.8.3.9x, FOR LOOP RANGE CHECKING LOWER LIMIT');
9:
end. {e6p8p3p9x}


{------- 6.8.3.10 With-statements -------}

{TEST 6.8.3.10a}
{verify that the with statement rejects variables that are not records}
program e6p8p3p10a(output);
var
   myArray: array[1..10] of integer;
begin
   with myArray do begin  {!!! must use a record here}
      writeln('ERROR NOT DETECTED ... 6.8.3.10a, WITH STATEMENT');
   end;
end. {e6p8p3p10a}


{------- 6.9 Input and output -------}

{------- 6.9.1 The procedure read -------}

{TEST 6.9.1a}
{Check that an error is produced when read is called without any parameters. }
program e6p9p1a(input, output);
var    r:real;
begin
read; { !!! no parameters }
writeln('ERROR NOT DETECTED ... 6.9.1a READ without parameters');
end.


{TEST 6.9.1b}
{Check that an error is produced when read is called without a file parameter and
there is no input parameter in the program header. }
program e6p9p1b(output);
var    r:real;
begin
   read(r); { !!! no input file in the program header }
   writeln('ERROR NOT DETECTED ... 6.9.1b READ standard input');
end.


{TEST 6.9.1d}
{Check that an error is produced when an attempt is made to read an integer but
the sequence of characters on the input file does not form a valid integer. }
program e6p9p1d(output);
var
   f: text;
   n: integer;
begin
   rewrite (f);
   writeln(f,'ABC123456');
   reset(f);
   read(f,n); { !!! the file does not contain an integer }
   writeln('ERROR NOT DETECTED ... 6.9.1d READ INTEGER');
end.


{TEST 6.9.1e}
{Check that an error is produced when an attempt is made to read a real but
the sequence of characters on the input file does not form a valid real. }
program e6p9p1e(output);
var
   f:text;
   r:real;
begin
   rewrite (f);
   writeln(f,'ABC123.456');
   reset(f);
   read(f,r); { !!! the file does not contain a real nr }
   writeln('ERROR NOT DETECTED ... 6.9.1e READ REAL');
end.


{TEST 6.9.1f}
{Check that an error is produced when there is a syntax error in the read parameter list. }
program e6p9p1f(output);
var
   f: text;
   c: char;
begin
   rewrite(f);
   writeln(f,'ABC123.456');
   reset(f);
   read(f; c); { !!! syntax error, semicolon instead of comma }
   writeln('ERROR NOT DETECTED ... 6.9.1f READ SYNTAX ERROR');
end.


{TEST 6.9.1g}
{Check that an error is produced when an attempt is made to read an integer but
the integer in the input file is larger than maxint. }
program e6p9p1g(output);
var
   f:   text;
   n:   integer;
   p10: integer;
   m10: integer;
   d10: integer;
   c: char;
begin
   p10 := 10;
   while p10 < maxint div 10 do
      p10 := 10*p10;
   m10 := maxint mod p10;
   d10 := maxint div p10;

   m10 := m10+1;
   if m10 >= p10 then begin
      m10 := m10-p10;
      d10 := d10+1;
   end;

   rewrite (f);
   writeln(f, maxint);
   writeln(f, d10:1, m10:1); { should be maxint+1 }

   reset(f);
   while not eof(f) do begin
      if eoln(f) then begin
         readln(f); writeln;
      end
      else begin
         read(f,c); write(c);
      end;
   end;

   reset(f);
   readln(f,n); { OK, n = maxint }
   if n <> maxint then writeln( '6.9.1g - unexpected error');
   read(f,n); { !!! overflow, attempt to read maxint+1 }
   writeln('ERROR NOT DETECTED ... 6.9.1g READ LARGE INTEGER');
end.


{TEST 6.9.1h}
{Check that an error is produced when an attempt is made to read an integer but
the integer in the input file is less than -maxint. }
program e6p9p1h(output);
var
   f:   text;
   n:   integer;
   p10: integer;
   m10: integer;
   d10: integer;
   c: char;
begin
   p10 := 10;
   while p10 < maxint div 10 do
      p10 := 10*p10;
   m10 := maxint mod p10;
   d10 := maxint div p10;

   m10 := m10+2;
   if m10 >= p10 then begin
      m10 := m10-p10;
      d10 := d10+1;
   end;

   rewrite (f);
   writeln(f, -maxint);
   writeln(f, '-', d10:1, m10:1); { should be -maxint-2 }

   reset(f);
   while not eof(f) do begin
      if eoln(f) then begin
         readln(f); writeln;
      end
      else begin
         read(f,c); write(c);
      end;
   end;

   reset(f);
   readln(f,n); { OK, n = -maxint }
   if n <> -maxint then writeln( '6.9.1h - unexpected error');
   read(f,n); { !!! overflow, attempt to read -maxint-2 }
   writeln('ERROR NOT DETECTED ... 6.9.1h READ LARGE -VE INTEGER');
   end.


{------- 6.9.2 The procedure readln -------}

{TEST 6.9.2c}
{Check that an error is produced when readln is called without parameters and
there is no input parameter in the program header. }
program e6p9p2c(output);
begin
   readln; { !!! no input file in the program header }
   writeln('ERROR NOT DETECTED ... 6.9.2c READ standard input');
end.


{TEST 6.9.2d}
{Check that an error is produced when an attempt is made to read an integer but
the sequence of characters on the input file does not form a valid signed integer. }
program e6p9p2d(output);
var
   f:text;
   i: integer;
begin
   rewrite(f);
   writeln(f,'ABC123');
   reset (f);
   read(f,i); { !!! the file does not contain an integer }
   writeln('ERROR NOT DETECTED ... 6.9.2d READ INTEGER');
end.


{TEST 6.9.2e}
{Attempt to call readln on a binary file. }
program e6p9p2e(output);
var
   f: packed file of char;
begin
   rewrite(f);
   write(f, 'a');
   reset(f);
   readln(f);   {!!! only text files can use readln}
   writeln('ERROR NOT DETECTED ... 6.9.2e, READLN NON-TEXT FILE');
end.


{------- 6.9.3 The procedure write -------}

{TEST 6.9.3c}
{Check that an error is produced when write is called without any parameters. }
program e6p9p3c(output);
var r:real;
begin
   r := 1.0;
   write(r); {OK}
   write;   { !!! no parameters }
   writeln('ERROR NOT DETECTED ... 6.9.3c write, no parameters');
end.


{TEST 6.9.3d}
{Check that an error is produced when write is called without a file parameter and
there is no output parameter in the program header. }
program e6p9p3d(input);
var r:real;
begin
   r := 1.0;
   write(r); { !!! no output file in the program header }
   writeln('ERROR NOT DETECTED ... 6.9.3d write standard output'); {!!! here too}
end.


{TEST 6.9.3f}
{Check that an error is produced when there is a syntax error in the read parameter list. }
program e6p9p3f(output);
var
f: text;
c: char;
begin
rewrite(f);
c := '!';
write(f; c); { !!! syntax error, semicolon instead of comma }
writeln('ERROR NOT DETECTED ... 6.9.3f WRITE SYNTAX ERROR');
end.


{TEST 6.9.3g}
{Attempt to write a scalar value whose field width parameter is not an integer. }
program e6p9p3g(output);
const wid = '?';
begin
   write('test');
   write( '1:6 ', 1:6);           { OK }
   write( '1:?', 1:wid);  { !!! field width must be an integer }
   writeln('ERROR NOT DETECTED ... 6.9.3g, WRITE VALUE WITH NON-INTEGER FIELD WIDTH');
end.


{TEST 6.9.3j}
{Attempt to output real numbers whose precision width parameters are negative. }
program e6p9p3j(output);
begin
write('test');
write( '1.1:6:1 ', 1.1:6:1);
write( '1.1:6:-1 ', 1.1:6:-1); { !!! field width must be positive }
writeln('ERROR NOT DETECTED ... 6.9.3j, WRITE REAL -VE PRECISION FIELD WIDTH');
end.


{TEST 6.9.3k}
{Attempt to output real numbers whose precision width parameter is not an integer. }
program e6p9p3k(output);
const prec = 3.2;
begin
write('test');
write( '1.1:6:-1 ', 1.1:6:prec); { !!! field width must be an integer }
writeln('ERROR NOT DETECTED ... 6.9.3k, WRITE REAL WITH NON-INTEGER PRECISION FIELD WIDTH');
end.


{------- 6.9.4 The procedure writeln -------}

{TEST 6.9.4b}
{Attempt to call writeln on a binary file. }
program e6p9p4b(output);
var
   f: packed file of char;
begin
   rewrite(f);
   writeln(f); {!!! only text files can use writeln}
   writeln('ERROR NOT DETECTED ... 6.9.4b, WRITELN NON-TEXT FILE');
end.


{TEST 6.9.4c}
{Check that an error is produced when writeln is called without a file parameter and
there is no output parameter in the program header. }
program e6p9p4c(input);
begin
   writeln; { !!! no output file in the program header }
   writeln('ERROR NOT DETECTED ... 6.9.4c READ standard input'); {!!! here too}
end.


{------- 6.9.5 The procedure page -------}

{TEST 6.9.5a}
{Check that an error is produced when page is called without a file parameter and
there is no output parameter in the program header. }
program e6p9p5a(input);
begin
page; { !!! no output file in the program header }
writeln('ERROR NOT DETECTED ... 6.9.4c READ standard input'); {!!! here too}
end.


{TEST 6.9.5b}
{Attempt to call page on a binary file. }
program e6p9p5b(output);
var
   f : packed file of char;
begin
   rewrite(f);
   page(f); {!!! only text files can use page}
   writeln('ERROR NOT DETECTED ... 6.9.5b, PAGE NON-TEXT FILE');
end.


{kate: debugMode off; cfgIndentCase false;}
