{

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

awk 'BEGIN { FS="[ (]"; i=-1} \
      /TEST/ {i=0}; \
      i>=0 { l[i++]=$0}; \
      /^\s*program\s+/d { 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 }' \
      deviance.pas
}


{TEST 6.1.2a}
{ check that nil is implemented as a reserved word. }
program d6p1p2a(output);
var
    i:(tick,cross,nil);  { !!! nil is a reserved word }
begin
    i := nil; {!!!}
    writeln(' DEVIATES ... 6.1.2a, NIL')
end.


{TEST 6.1.2b}
{ check that reserved words cannot be redefined.}
program d6p1p2b(output);
var
   thing: (var,str); { !!! var is a reserved word }
begin
    thing := str;
    writeln(' DEVIATES ... 6.1.2b, RESERVED WORDS')
end.


{ ------- 6 .1 .5 Numbers ------- }

{TEST 6.1.5a}
{ The number productions specified in the Pascal Standard clearly state
that a number with an exponent and no decimal point is real, not integer. }
program d6p1p5a(output);
const
   r    = 12e1;
var
   i : 0..r; { !!! r is real, not integer }

begin
   i := 13;
   writeln(' DEVIATES .. .6.1.5a');
end.


{TEST 6.1.5c}
{ The number productions specified in the Pascal Standard clearly
  state that a decimal point must be preceded by a digit sequence. }
program d6p1p5c(output);
const
   r    = .123;  { !!! digit must precede decimal point }
var
   i : real;
begin
   i := .123; { !!! digit must precede decimal point }
   i := -.123; { !!! digit must precede decimal point }
   writeln(' DEVIATES .. .6.1.5c');
end.


{TEST 6.1.5d}
{The number productions specified in the Pascal Standard clearly
state that a decimal point must be followed by a digit sequence. }
program d6p1p5d(output);
const
   r    = 123.;  { !!! digit must follow decimal point }
var
    i : real;
begin
   i := 0123.; { !!! decimal point must be followed by a digit }
    writeln(' DEVIATES ...6.1.5d');
end.


{TEST 6.1.5e}
{Spaces in numbers are forbidden by the Pascal Standard
This includes spaces around '.' and 'E'.
 The compiler deviates if ONE or MORE of the cases below are accepted.
The compiler conforms if ALL cases are rejected. }
program d6p1p5e(output);
const
   one = 1 234;     {!!! no space allowed in number}
   two = 0 .1234;     {!!! no space allowed in number}
   three = 0. 1234;     {!!! no space allowed in number}
   four = 1234 E2;     {!!! no space allowed in number}
   five = 1234E 2;     {!!! no space allowed in number}
   six = 1234E- 2;     {!!! no space allowed in number}
   seven = 1234E+ 2;     {!!! no space allowed in number}
begin
    writeln(' DEVIATES ...6.1.5e')
end.


{TEST 6.1.6a}
{labels can have any value in the closed interval 0..9999.
 The compiler deviates if it allows labels outside this range}
program d6p1p6a(output);
label 10000;      {!!! 5 digit label }
begin
    if false then goto 10000;
10000:    writeln(' DEVIATES ...6.1.6a labels may have more than 4 digits')
end.


{TEST 6.1.6b}
{labels can have any value in the closed interval 0..9999.
 The compiler deviates if it allows labels outside this range}
program d6p1p6b(output);
label -1;      {!!! -ve nr label }
begin
   if false then goto -1; {!!! label number must be in range 0..9999}
-1:  {!!! bad label}
writeln(' DEVIATES ...6.1.6b labels < 0 allowed')
end.


{ ------- 6.1.7 Character-strings ------- }

{TEST 6.1.7a}
{ A character string is a sequence of characters delimited by 'apostrophe characters'
 The compiler deviates if it allows other delimiters}
program d6p1p7a(output);
const s = "double quotes";  { !!! string is not 'single quotes'}
begin
   writeln(' DEVIATES ...6.1.7a "double quotes" allowed')
end.


{ ------- 6.2 Blocks, scopes, and activations ------- }

{ ------- 6.2.1 Blocks ------- }


{TEST 6.2.1a}
{ Check to see that labels are not permitted unless they have been declared in the heading. }
program d6p2p1a(output);
begin
3: { !!! label not declared}
   writeln(' DEVIATES ... 6.2.1a, UNDECLARED LABEL')
end.


{TEST 6.2.1b}
{ Check to see that a double semi colon after the program statement is detected and reported as an error. }
program d6p2p1b(output);;    {!!! double semi colon}
begin
   writeln(' DEVIATES ... 6.2.1b, double semicolon after program header')
end.


{TEST 6.2.1c}
{ Check to see that a double semi colon after the label statement is detected and reported as an error. }
program d6p2p1b(output);
label 13;;    {!!! double semi colon}
begin
13:
   writeln(' DEVIATES ... 6.2.1c, double semicolon after label statement')
end.


{TEST 6.2.1d}
{ Check to see that a double semi colon after the const statement is detected and reported as an error. }
program d6p2p1d(output);
const c = 13;;    {!!! double semi colon}
begin
   writeln(' DEVIATES ... 6.2.1d, double semicolon after const statement')
end.


{TEST 6.2.1e}
{ Check to see that a double semi colon after the type statement is detected and reported as an error. }
program d6p2p1e(output);
type testType = (mon, tue, wed, thu, fri);;    {!!! double semi colon}
begin
   writeln(' DEVIATES ... 6.2.1e, double semicolon after type statement')
end.


{TEST 6.2.1f}
{ Check to see that a double semi colon after the var statement is detected and reported as an error. }
program d6p2p1f(output);
var day: (mon, tue, wed, thu, fri);;    {!!! double semi colon}
begin
   writeln(' DEVIATES ... 6.2.1f, double semicolon after var statement')
end.


{TEST 6.2.1g}
{ Check to see that a double semi colon after a procedure heading is detected and reported as an error. }
program d6p2p1g(output);
procedure doNothing;;    {!!! double semi colon}
begin
end;
begin
   doNothing;
   writeln(' DEVIATES ... 6.2.1g, double semicolon after procedure')
end.


{TEST 6.2.1h}
{ Check to see that a double semi colon after a procedure is detected and reported as an error. }
program d6p2p1h(output);
procedure doNothing;
begin
end;;    {!!! double semi colon}

begin
   doNothing;
   writeln(' DEVIATES ... 6.2.1g, double semicolon after procedure')
end.


{TEST 6.2.1i}
{ Check to see that a double semi colon after a function statement is detected and reported as an error. }
program d6p2p1i(output);
function Space: char;;    {!!! double semi colon}
begin
   Space := ' ';
end;
begin
   writeln(Space, 'DEVIATES ... 6.2.1i, double semicolon after function statement')
end.


{TEST 6.2.1j}
{ Check to see that a double semi colon after a function statement is detected and reported as an error. }
program d6p2p1j(output);
function Space: char;
begin
   Space := ' ';
end;;    {!!! double semi colon}

begin
   writeln(Space, 'DEVIATES ... 6.2.1i, double semicolon after function statement')
end.



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

{TODO: scope tests with parameters}
{TEST 6.2.2.9d}
{The Pascal Standard says that the defining occurrence of an identifier
or label precedes all corresponding occurrences of that identifier or
label in the program text (except for specific pointer case).
The scope of an identifier or label also includes the whole block in which
it is defined, thereby disallowing any references to an outer identifier of
the same name preceeding the defining occurrence.
Some compilers may not conform to this and allow some scope overlap.
 The compiler conforms if the program does not compile and objects
 to the use of 'red' in ouch preceding its definition. }
program d6p2p2p9d(output);
const
   red = 1;
   violet = 2;
procedure ouch;
const
   m = red; { !!! red used but redefined in this level }
   n = violet; { !!! same again }
type
   a = array[m .. n] of integer;
var
   v : a;
   colour: (yellow,green,blue,red,indigo,violet); { !!! red & violet used before defined }
begin
   v[1] := 1;
   colour := red;
end;
begin
   ouch;
   writeln(' DEVIATES ... 6.2.2.9d, SCOPE OVERLAP NOT DETECTED')
end.


{TEST 6.2.2.9e}
{ scope with pointer test - this test breaks scope rules.
tI1 the integer pointer should be hidden by tI1 the boolean record,
and tI1, the type of p2 is used before it is defined.}
program d6p2p2p9e(output);

type
    tI1 = record   { deviates if this record is used in procedure below }
             pI :integer;
         end;

procedure p;
type
    t1 = record
            p1 : ^tI1;  { tI1 points to boolean record below}
            p2 : tI1;   { !!! tI1 used before defined}
         end;

    tI1 = record
             pB : boolean;
          end;
var
    v1 : t1;

begin
    new(v1.p1);

    v1.p1^.pB := true;
    v1.p2.pI := 13;

    writeln(' DEVIATES ... 6.2.2.9e, scope with pointer');

    dispose(v1.p1);
end;
begin
    p;
end.


{TEST 6.3b}
{ Check that signed chars are not permitted.
Note that minus may have a worse effect than plus. }
program d6p3b(output);
const
   dot = '.';
   plusdot = + dot; { !!! illegal use of unary + operator }
begin
   writeln(' DEVIATES ... 6.3b, signed char')
end.


{TEST 6.3c}
{ Check that signed strings are not permitted.
Note that minus may have a worse effect than plus.}
program d6p3c(output);
const
   stars = '****';
   plusstars = + stars; { !!! illegal use of unary + operator }
begin
   writeln(' DEVIATES ... 6.3c, signed string')
end.


{TEST 6.3d}
{ Check that signed scalars are not permitted.
Note than minus may have a worse effect than plus. }
program d6p3d(output);
const
   truth = true;
   plustruth = + truth; { !!! illegal use of unary + operator }
begin
   writeln(' DEVIATES ... 6.3d, signed boolean')
end.


{TEST 6.3e}
{ Verify that signed constants are not permitted in other contexts than const declarations.}
program d6p3e(output);
const
   dot = '.';
begin
   writeln(' DEVIATES', +dot, ' ... 6.3e, signed non-numeric constant') { !!! illegal use of unary + operator }
end.


{TEST 6.3f}
{A constant may not be used in its own declaration
 - this is a pathological case which should be detected or at least handled with care. }
program d6p3f(output);
const
   ten = 10;
procedure p;
const
   ten = ten; { !!! dubious declaration }
begin
   if ten=10 then
      writeln(' DEVIATES ... 6.3f: SCOPE ERROR')
   else
      writeln(' DEVIATES ... 6.3f: DEFINITION POINT ERROR')
end;
begin
   p
end.


{TEST 6.4.1b}
{Verify that attempts to use types in their own definitions are detected.
Two examples are attempted. Both should fail. }
program d6p4p1b(output);
type
   x = record
	  xx : X 	{ !!! x used in its own definition }
       end;
   y = array[0 .. 1] of y;	{ !!! y used in its own definition }
begin
   writeln(' DEVIATES ... 6.4.1b')
end.


{TEST 6.4.1c}
{Another test that attempts to use types in their own definitions are detected,
but inserts a nasty scope twist by making another type with the same identifier
available in an outer scope.
It should be excluded from this scope, according to the Standard. }
program d6p4p1c(output);
type
   t = integer;
procedure p;
type
   t = record
	  y :  t  { !!! t used in its own definition }
       end;
var
   a : t;
begin
   writeln(' DEVIATES ... 6.4.1c: SCOPE ERROR')
end;
begin
   p
end.


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

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

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


{TEST 6.4.2.4a}
{Verify that real constants are not permitted in a subrange declaration.
 A subrange must be defined as a subrange of another ordinal type. }
program d6p4p2p4a(output);
type
   wiregauge = 0.001 .. 0.2; {!!! subrange must use ordinal types}
begin
   writeln(' DEVIATES ... 6.4.2.4a')
end.


{TEST 6.4.2.4b}
{Verify that real constants are not permitted in a subrange declaration.
 A subrange must be defined as a subrange of another ordinal type. }
program d6p4p2p4b(output);
const
   small = 0.001;
   large = 0.2;
type
   wiregauge = small .. large; {!!! subrange must use ordinal types}
begin
   writeln(' DEVIATES ... 6.4.2.4b')
end.


{TEST 6.4.2.4c}
{Verify that string constants are not permitted in a subrange declaration.
 A subrange must be defined as a subrange of another ordinal type. }
program d6p4p2p4c(output);
type
   subrange = 'ABC' .. 'DEF'; {!!! subrange must use ordinal types}
begin
   writeln(' DEVIATES ... 6.4.2.4c')
end.


{TEST 6.4.2.4d}
{Verify that string constants are not permitted in a subrange declaration.
 A subrange must be defined as a subrange of another ordinal type. }
program d6p4p2p4d(output);
const
   first = 'abc';
   last  = 'def';
type
   subrange = first .. last; {!!! subrange must use ordinal types}
begin
   writeln(' DEVIATES ... 6.4.2.4d')
end.


{TEST 6.4.2.4e}
{Verify that the first constant in a definition specifies the lower bound,
which is less than or equal to the upper bound. }
program d6p4p2p4e(output);
type
   mixedup = 100 .. 0;    {!!! bad range}
   reverse = 'Z' .. 'A';  {!!! bad range}
begin
   writeln(' DEVIATES ... 6.4.2.4e  EMPTY SUBRANGES ALLOWED')
end.


{TEST 6.4.3.1a}
{Verify that only structured (array, set, file and record) types may be PACKED. }
program d6p4p3p1a(output);
type
   switch = packed(on,off);             {!!! can't pack enumeration}
   state = packed(high,low,invalid);    {!!! can't pack enumeration}
   decade = packed 0 .. 10;             {!!! can't pack a range}
begin
   writeln(' DEVIATES ... 6.4.3.1a IMPROPER USE OF PACKED')
end.


{TEST 6.4.3.1b}
{Verify that a structured type identifier may not be used in a PACKED type definition. }
program d6p4p3p1b(output);
type
   complex = record
		realpart : real;
		imagpart : real;
	     end;
   packcom = packed complex; {!!! packed must be part of structure definition}
begin
   writeln(' DEVIATES ... 6.4.3.1b' )
end.


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

{TEST 6.4.3.2a}
{Verify that an index-type must be an ordinal-type - not REAL.}
program d6p4p3p2a(output);
type
   testArray = array[1.0 .. 10.0] of real; { !!! index should not be real }
begin
   writeln(' DEVIATES ... 6.4.3.2a real array index')
end.


{TEST 6.4.3.2c}
{Verify that an index-type must be an ordinal-type - not string.}
program d6p4p3p2c(output);
type
   testArray = array['s1' .. 's2'] of real; { !!! index should not be string }
begin
   writeln(' DEVIATES ... 6.4.3.2c string array index')
end.


{TEST 6.4.3.2d}
{Strings must have a subrange of integers as an index type. }
{ see also 6.9.3l and 6.4.3.2f }
program d6p4p3p2d(output);
type
   colour = (red,blue,yellow,green);
   cl1 = blue .. green;
var
   s:packed array[cl1] of char;
begin
   s := 'ABC'; { !!! s should have integer indexes }
   writeln(' DEVIATES ... 6.4.3.2d, STRING INDEX TYPE')
end.


{TEST 6.4.3.2e}
{Strings must have a subrange of integers as an index type. }
program d6p4p3p2e(output);
type
    colour = (red,blue,yellow,green);
    cl1 = blue .. green;
    pac = packed array[cl1] of char;
procedure p( s: pac);
begin
end;
begin
    p('ABC'); { !!! s should have integer indexes }
    writeln(' DEVIATES ... 6.4.3.2e, STRING INDEX TYPE')
end.


{TEST 6.4.3.2f}
{index type of Strings must be a subrange of integer. }
program d6p4p3p2f(output);
type
   colour = (red,blue,yellow,green);
var
   c: colour;
   s: packed array[blue..green] of char;
begin
   for c := blue to green do
      s[c] := chr( ord(c) + ord('K') );
   write( '''', s, ''''); { !!! s should have integer indexes }
   writeln(' DEVIATES ... 6.4.3.2f, STRING INDEX TYPE')
end.


{TEST 6.4.3.2g}
{index type of Strings must be a subrange of integer. }
program d6p4p3p2g(output);
type
   colour = (red,blue,yellow,green);
var
   c: colour;
   s: packed array[blue..green] of char;
begin
   for c := blue to green do
      s[c] := chr( ord(c) + ord('K') );
   if s = 'LMN' then write( 'LMN' ); { !!! s should have integer indexes }
   writeln(' DEVIATES ... 6.4.3.2g, STRING INDEX TYPE')
end.


{TEST 6.4.3.2i}
{lower bound of string index type must be 1. }
program d6p4p3p2i(output);
var
    s1,s2: packed array[0..1] of char;
begin
    s1 := '01';  {!!! lower bound must be 1}
    s2 := s1;
    writeln(' DEVIATES ... 6.4.3.2i, STRING INDEX LOWER BOUND')
end. {d6p4p3p2i}


{TEST 6.4.3.2j}
{upper bound of string index type must be > 1. }
program d6p4p3p2j(output);
var
    s1,s2: packed array[1..1] of char;
begin
    s1 := 'D'; {!!! upper bound must be > 1}
    s2 := s1;
    writeln(' ', s1, 'EVIATES ... 6.4.3.2j, STRING INDEX UPPER BOUND')
end. {d6p4p3p2j}


{TEST 6.4.3.2k}
{upper bound of string index type must be > 1. }
program d6p4p3p2k(output);
var
    s1,s2: packed array[1..1] of char;
begin
    s1[1] := '1';
    s2 := s1;
    if s1 >= s2 then  {!!! upper bound must be > 1}
        writeln(' DEVIATES ... 6.4.3.2k, STRING INDEX UPPER BOUND')
end. {d6p4p3p2k}


{TEST 6.4.3.2l}
{upper bound of string index type must be > 1. }
program d6p4p3p2l(output);
type pac1 = packed array[1..1] of char;
var
    s1,s2: pac1;
function test(s : pac1) : char;
begin
    test := s[1];
end;
begin
    s2 := s1;
    write(test(' ') );  {!!! upper bound must be > 1}
    writeln( 'DEVIATES ... 6.4.3.2l, STRING INDEX UPPER BOUND')
end. {d6p4p3p2l}


{TEST 6.4.3.2m}
{upper bound of string index type must be > 1. }
program d6p4p3p2m(output);
var
    s1,s2: packed array[1..1] of char;
begin
    s1[1] := 'D';
    s2 := s1;
    write(' ', s1); {!!! upper bound must be > 1}
    writeln('EVIATES ... 6.4.3.2m, STRING INDEX UPPER BOUND')
end. {d6p4p3p2m}


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

{TEST 6.4.3.3a}
{ The standard does not support string tag types in variant records. }
program d6p4p3p3a(output);

type myType = packed array[1..5] of char;
var
   a: record case val: myType of   { !!! string tags not supported }
             'true ': (i: integer);
             'false': (c: char);
          end;
begin
   a.val := 'false';
   a.c := 'c';
   writeln(' DEVIATES ... 6.4.3.3a, string tag types')
end.


{TEST 6.4.3.3h}
{This program is similar to 6.4.3.3c, except here,an empty record is assigned a value.
 This should not be possible. }
program d6p4p3p3h(output);
type
   statuskind = (defined,undefined);
   emptykind = record end;
var
   empty : emptykind;
   number: record
	      case status:statuskind of
		 defined: (i : integer);
		 undefined: (e : emptykind)
	   end;
begin
   with number do begin
      status := undefined;
      e := 666;  { !!! this is illegal }
   end;
   writeln(' DEVIATES ... 6.4.3.3h')
end.


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

{TEST 6.4.3.4c}
{Verify that the base-type of the range of a set must be an ordinal-type.
This should eliminate sets with real and structured ranges.
Some compilers may allow these and hence will deviate for those cases not flagged as errors. }
program d6p4p3p4c(output);
type
   legalset = set of 1..3;
   arrType    = array[1 .. 4] of integer;
   setone   = set of real;  			{ !!! set must not be of real }
   setType  = set of record a : 0 .. 3 end;	{ !!! set must not be of record }
   setthree = set of array[1 .. 5] of real;	{ !!! set must not be of array }
   setfour  = set of arrType;			{ !!! set must not be of array }
   setfive  = set of legalset;			{ !!! set must not be of another set }
   setsix   = set of set of 1 .. 4;		{ !!! set must not be of another set }
begin
   writeln(' DEVIATES ... 6.4.3.4c')
end.


{TEST 6.4.3.4e}
{Verify that the base-type of a set must be an ordinal-type, not string. }
program d6p4p3p4e(output);
const
   s = 'str';
begin
   if s in [] then {!!! set must ordinal elements, not strings}
      writeln(' DEVIATES ... 6.4.3.4e - string set elements')
end.


{TEST 6.4.3.4f}
{Verify that the base-type of a set must be an ordinal-type, not real. }
program d6p4p3p4f(output);
var
   x: real;
begin
   x := 6.3;
   if [x] >= [] then {!!! set must not have real elements}
      writeln(' DEVIATES ... 6.4.3.4f - real set elements')
end.


{TEST 6.4.4b}
{Test the diagnostic that should be produced by the compiler if
the type to which a pointer points is not found. }
program d6p4p4b(output);
var
   pointer1 : ^real;
   pointer2 : ^myRecord; { !!! there is no myRecord }
begin
   pointer1 := nil;
   new(pointer1);
   pointer1^ := 12.3;
   new(pointer2);
   pointer2^ := 99;  {pointer to integer}
   pointer2^ := 1.1;  {pointer to real}
   pointer2^ := 'a';  {pointer to char}
   pointer2^ := true;  {pointer to boolean}
   pointer2^ := [1,2];  {pointer to set}
   rewrite(pointer2^);  {pointer to file}
   pointer2^[1] := 1;  {pointer to array}
   pointer2^.i := 1;  {pointer to record}
   writeln(' DEVIATES ... 6.4.4b - pointer to missing type')
end.


{TEST 6.4.4c}
{Pointers to items in the stack are not allowed,
The ^ symbol is not permitted to act as an operator, giving the reference to a variable. }
program d6p4p4c(output);
var
   p: ^integer;
   X: integer;
begin
   x := 10;
   p := ^x;  { !!! p must point to new() data, not to a variable }
   writeln(' DEVIATES ... 6.4.4c, POINTER')
end.


{------- 6.4.5 Compatible types -------}

{TEST 6.4.5b}
{Verify that the compiler does not deviate from the Standard in the case of
subranges of the same host being treated as identical. }
program d6p4p5b(output);
type
   colour = (red,pink,orange,yellow,green,blue);
   subone = red .. yellow;
   subtwo = pink .. blue;
var
   colour1 : subone;
   colour2 : subtwo;
procedure test(var col1: subone);
begin
   writeln(' DEVIATES ...6.4.5b')
end;
begin
   { Although colour1 and colour2 are compatible (ie subone and subtwo are compatible),
     they are not identical, and the call to procedure test should fail. }
   colour2 := pink;
   test(colour2){ !!! colour2 is not assignment compatible with arg to procedure test }
end.


{TEST 6.4.5d}
{ Some implementations may have an implicit ordering between different types, and allow these
to be compared etc., thus not conforming to the compatibility rules of the Pascal Standard. }
program d6p4p5d(output);
var
   colour : (red,green,blue);
begin
   if red < 0 then  { !!! comparing different types }
      writeln(' DEVIATES ... 6.4.5d')
   else writeln(' DEVIATES ... 6.4.5d')
end.


{TEST 6.4.5k}
{The Pascal Standard permits compatibility only between string
types of the same number of components.
Some compilers may allow compatibility between string types
with different numbers of components. (see 6.1.7d and 6 ...... }
program d6p4p5k(output);
begin
   if 'CAT' < 'HOUND' then { !!! the strings have different lengths }
      writeln(' DEVIATES ... 6.4.5k compare constant strings with different lengths')
end.


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

{TEST 6.4.6a}
{Test assignemnet campatibility for arrays. }
program d6p4p6a(output);
type
   arrTypeone = array[1 .. 10] of char;
   arrTypetwo = array[1 .. 10] of char;
var
   arrayone : arrTypeone;
   arraytwo : arrTypetwo;
procedure test(myArray : arrTypeone);
begin
   writeln(' DEVIATES ... 6.4.6a, assignment compatibility, arrays')
end;
begin
   { The two arraytypes, arrTypeone and arrTypetwo, are not identical
     and hence the call to procedure test should fail. }
   test(arraytwo) { !!! arraytwo is not assignment compatible with arg to procedure test }
end.


{TEST 6.4.6b}
{This program is similar to 6.4.6a, except that compatibility for records is tested.
 The program should fail to compile/execute if the compiler conforms. }
program d6p4p6b(output);
type
   recone = record
	       a:  integer;
	       b : boolean;
	    end;
   rectwo = record
	       a:  integer;
	       b : boolean
	    end;
var
   recordone : recone;
   recordtwo : rectwo;
procedure test(var rec : recone);
begin
   writeln(' DEVIATES ... 6.4.6b')
end;
begin
   { Although the two record types are compatible, they are
     not identical, and hence the call to procedure test should fail. }
   recordtwo.a := 0;
   recordtwo.b := true;
   test(recordtwo) { !!! recordtwo is not assignment compatible with arg to procedure test }
end.


{TEST 6.4.6c}
{Again, this test is similar to 6.4.6a, except that compatibility for pointers is tested.
 Although the two pointers in this example point to the same type, they are not identical.}
program d6p4p6c(output);
type
   myRecord = record
	       a : integer;
	    end;
   ptrone = ^myRecord;
   ptrtwo = ^myRecord;
var
   ptrtorec   : ptrone;
   ptrtorectoo : ptrtwo;
procedure test(var ptr : ptrone);
begin
   writeln(' DEVIATES ... 6.4.6c')
end;
begin
   new(ptrtorectoo);
   ptrtorectoo := nil;
   test(ptrtorectoo) { !!! ptrtorectoo is not assignment compatible with parameter }
end.


{TEST 6.4.6d}
{This test is similar to 6.4.6a, except that compatibility for files is tested. }
program d6p4p6d(output);
type
   arrType = array[1 .. 10] of boolean;
   fileTypeone = file of arrType;
   fileTypetwo = file of arrType;
var
   fileone : fileTypeone;
   filetwo : fileTypetwo;
procedure test(var myFile : fileTypeone);
begin
   writeln(' DEVIATES ... 6.4.6d')
end;
begin
   test(fileone); {OK}
   { The two filetypes, fileTypeone and fileTypetwo, are not identical
     so this call to procedure test should fail. }
   test(filetwo); {!!! incorrect type}
end.


{TEST 6.4.6i}
{The Pascal Standard allows assignment of integers to reals, but not reals to integers.
 Check that assignment of reals to integers is not allowed. }
program d6p4p6i(output);
var
   r : real;
   i : integer;
procedure test(arg1:integer);
begin
end;
begin
   r := 6.345;
   i := r;       { !!! illegal assign of real to integer }
   test(6.345); { !!! arg1 should be an integer, not real }
   writeln(' DEVIATES ... 6.4.6i ASSIGN REAL TO INTEGER')
end.


{TEST 6.4.6j}
{Verify that the two types T1 and T2 (in determining assignment compatibility)
must not be a a file type. }
program d6p4p6j(output);
var
   file1 : text;
   file2 : text;
begin
   reset(file1);
   rewrite(file2);
   writeln(file1,'ABC');
   file2 := file1;   { !!! assignment of file types not allowed }
   writeln(' DEVIATES ... 6.4.6j, FILES')
end.


{TEST 6.4.6k}
{Verify that the two types T1 and T2 (in determining assignment
compatibility) must not be a structured type with a file component.
See also test 6.4.6j.}
program d6p4p6k(output);
type
   myRecord = record
	       f: text;
	       a : integer
	    end;
var
   record1 : myRecord;
   record2 : myRecord;
begin
   record1.a := 1;
   reset(record1.f);
   rewrite(record2.f);
   writeln(record1.f);
   record2 := record1;   { !!! assignment of file types inside records not allowed }
   writeln(' DEVIATES ... 6.4.6k, FILES')
end.


{TEST 6.4.6l}
{Verify that the two types T1 and T2 (in determining assignment
compatibility) must not be an array type with a file component.
see also test 6.4.6j.}
program d6p4p6l(output);
type
   myArray = array[1..9] of text;
var
   array1 : myArray;
   array2 : myArray;
begin
   reset(array1[1]);
   rewrite(array2[1]);
   writeln(array1[1]);
   array2 := array1;   { !!! assignment of file types inside arrays not allowed }
   writeln(' DEVIATES ... 6.4.6l, FILES')
end.


{TEST 6.4.6m}
{The standard specifies that a filetype T2 cannot be assignment-compatible
with an identical type T1, nor can a structure containing such a fi1etype.
This precludes any assignments involving files. }
program d6p4p6m(output);
var
   f1,f2:^text;
begin
   new(f1);
   new(f2);
   rewrite(f1^);
   writeln(f1^,'TEST');
   f2^ := f1^; { !!! file assignment is illegal }
   writeln(' DEVIATES ... 6.4.6m, FILES');
end.


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

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

{TEST 6.6.1c}
{Test if the compiler allows the formal parameter list to be included in
the subsequent procedure declaration of a forward procedure. }
program d6p6p1c(output);
var
   c : integer;
procedure one(var a : integer);  forward;
procedure two(var b : integer);
begin
   b := b+1;
   one (b)
end;
procedure one(var a : integer); { !!! parameter list should not be repeated }
begin
   a := a+1;
   if a = 1 then two(a)
end;
begin
   c := 0;
   one(c);
   writeln( ' DEVIATES ... 6.6.1c, forward parameter lists')
end.


{TEST 6.6.1d}
{Test if the compiler allows two forward declaration for the same procedure. }
program d6p6p1d(output);
var
   c : integer;
procedure one(var a : integer);  forward;
procedure two(var b : integer);
begin
   b := b+1;
   one (b)
end;
procedure one(var a : integer); forward; { !!! forward declared earlier }
procedure one;
begin
   a := a+1;
   if a = 1 then two(a)
end;
begin
   c := 0;
   one(c);
   writeln( ' DEVIATES ... 6.6.1d, forward parameter lists')
end.


{TEST 6.6.1e}
{ If the compiler permits the formal parameter list to be included in
the subsequent procedure declaration of a forward procedure (6.6.1d),
does it check the parameter list is the same?
The compiler deviates if the program compiles, and only conforms
 if the second formal parameter list is flagged as an error. }
program d6p6p1e(output);
var
   c : integer;
procedure one(var arg1 : integer); forward;
procedure two(var b : integer);
begin
   b := b+1;
   one (b)
end;
procedure one(arg1 : integer); { !!! arg1 was a var param earlier }
begin
   arg1 := arg1+1;
   if arg1 = 1 then two(arg1)
end;
begin
   c := 0;
   one(c);
   writeln(' DEVIATES ... 6.6.1e')
end.


{TEST 6.6.2d}
{ Test the compiler's actions when the type of result returned by a function is not a simple type.
 All the cases should be rejected by the compiler if it conforms to the Standard. }
program d6p6p2d(output);
type
   recType = record
		a : integer;
		b : boolean
	     end;
   setType = set of 0 .. 3;
   arrType =  packed array[1 .. 3] of char;
var
   record1:   recType;
   set1:   setType;
   array1:   arrType;
function one : setType; { !!! function must return ordinal type, not aggregate types like a set }
begin
   one := [0 .. 3]
end;
function two : arrType; { !!! function must reurn ordinal type, not aggregate types like an array }
begin
   two := 'ABC'
end;
function three : recType; { !!! function must return ordinal type, not aggregate types like a record }
var
   myRecord : recType;
begin
   myRecord.a := 1;
   myRecord.b := true;
   three := myRecord
end;
begin
   record1 := three; { was one }
   set1 := one;      { was two }
   array1 := two;    { was three }
   writeln(' DEVIATES ... 6.6.2d')
end.


{TEST 6.6.2e}
{Check that a function with no assignment to the function identifier is detected
 and that an error is issued. }
program d6p6p2e(output);
var
   a : integer;
function illegal(var b : integer) : integer;
var
   x : integer;
begin
   x := b*2
end;	{ !!! there is no assignment to the function }
begin
   a := 2;
   a := illegal (a);
   writeln(' DEVIATES ... 6.6.2e')
end.


{TEST 6.6.2j}
{verify that an error is issued when a function with forward directive
 is declared with its parameters}
program d6p6p2h( output );

var
   x,y : real;

function pow(a : real;  b : real) : real; forward;
function pow(a : real;  b : real) : real;               { !!! parameter list is not standard }
begin
   pow := exp(ln(a)*b)
end;

begin

   x := pow( 2, 2 );

   writeln( 'DEVIATES ... 6.6.2j forward function declared with parameters' );

end.


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

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

{TEST 6.6.3.1d}
{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.
This precludes the declaration of a local variable with the same name as
 an identifier in the formal parameter 1ist.
Check if the compiler detects this as an error, or allows it to occur with some form of side effect. }
program d6p6p3p1d(output);
var
   i : integer;
procedure deviates(var x:  integer);
var x : integer;   { !!! redefining x }
begin
   x := 2*x;
   writeln (' DEVIATES ... 6.6.3.1d : x= ',x)
end;
procedure deviates1 (x : integer);
var x : integer;   { !!! redefining x }
begin
   x := 0;
   x := 2*x;
   writeln(' DEVIATES ... 6.6.3.1d :  x is ',x)
end;
begin
   i := 5;
   deviates (i);
   i := 5;
   deviates1 (i)
end.


{TEST 6.6.3.3d}
{Check that a var parameter cannot be a component of a packed variable. }
program d6p6p3p3d(output);
var
   pr : packed record
                  a: 1..6;
                  b: 0..100;
                  k: integer;
               end;
procedure p(var i : integer);
begin
   i := 99;
end;
begin
   p(pr.k); { !!! var parameter is component of a packed record }
   writeln(' DEVIATES ... 6.6.3.3d, PACKED VAR PARAMS')
end.


{TEST 6.6.3.3e}
{Check that a var parameter cannot be a component of a packed variable.
 This time the variable is in the variant part of the record }
program d6p6p3p3e(output);
var
   pr : packed record
                  a: 1..6;
                  case boolean of
                  true:  (b: 0..100);
                  false: (k: integer);
               end;
procedure p(var i : integer);
begin
   i := 99;
end;
begin
   p(pr.k); { !!! var parameter is component of a packed record }
   writeln(' DEVIATES ... 6.6.3.3e, PACKED VAR PARAMS')
end.


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

{TEST 6.6.5.3a}
{Test whether dispose can take a nil parameter.}
program d6p6p5p3a(output);
begin
   dispose(nil);
   writeln(' DEVIATES ... 6.6.5.3a - dispose take nil parameter')
end.


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

{TEST 6.6.5.4b}
{Test that source and destination of pack are respectively unpacked and packed arrays.}
program d6p6p5p4b(output);
var
   a: array[1..9] of integer;
   z: array[1..9] of integer;
begin
   pack(a,1,z); { !!! z must be packed }
   writeln(' DEVIATES ... 6.6.5.4b - PACK, destination array is not packed')
end.


{TEST 6.6.5.4c}
{Test that source and destination of pack are respectively unpacked and packed arrays.}
program d6p6p5p4c(output);
var
   a: packed array[1..9] of integer;
   z: packed array[1..9] of integer;
begin
   pack(a,1,z); { !!! a must be unpacked }
   writeln(' DEVIATES ... 6.6.5.4c - PACK, source array is packed')
end.


{TEST 6.6.5.4d}
{Test that source and destination of unpack are respectively packed and unpacked arrays.}
program d6p6p5p4d(output);
var
   a: array[1..9] of integer;
   z: array[1..9] of integer;
begin
   unpack(z,a,1); { !!! z must be packed }
   writeln(' DEVIATES ... 6.6.5.4d - UNPACK, source array is unpacked')
end.


{TEST 6.6.5.4e}
{Test that source and destination of unpack are respectively packed and unpacked arrays.}
program d6p6p5p4e(output);
var
   a: packed array[1..9] of integer;
   z: packed array[1..9] of integer;
begin
   unpack(z,a,1); { !!! a must be unpacked }
   writeln(' DEVIATES ... 6.6.5.4e - UNPACK, destination array is packed')
end.


{TEST 6.6.5.4l}
{Test that source of unpack is a packed array variable.}
program d6p6p5p4l(output);
var
   a: array[1..9] of char;
   z: packed array[1..9] of char;
begin
   z := '123456789';
   unpack(z,a,1); { OK }
   unpack('1234567890', a, 1); { !!! src must be a variable }
   writeln('DEVIATES ... 6.6.5.4l - UNPACK, source is a constant')
end.


{TEST 6.6.5.4m}
{Test that the arguments of pack are array variables.}
program d6p6p5p4m(output);
var
   a : record c : char end;
   z : packed record c : char end;
begin
   a.c := 'a';
   pack(a, 1, z); { !!! args must be arrays }
   writeln('DEVIATES ... 6.6.5.4m - PACK, records')
end.


{TEST 6.6.5.4n}
{Test that the arguments of unpack are array variables.}
program d6p6p5p4n(output);
var
   a : record c : char end;
   z : packed record c : char end;
begin
   z.c := 'z';
   unpack(z, a, 1); { !!! args must be arrays }
   writeln('DEVIATES ... 6.6.5.4n - UNPACK, records')
end.


{TEST 6.6.6.3d}
{Check that neither trunc nor round are permitted to have integer parameters.
The Standard requires these to be real. }
program d6p6p6p3d(output);
var
   i : integer;
   x:real;
begin
   i := 1979;
   x := trunc(i)+round(i+1);  { !!! trunc() & round() should have real arguments }
   writeln(' DEVIATES ... 6.6.6.3d, TRUNC/ROUND')
end.



{ ------- 6.6.6.3 Transfer functions ------- }


{TEST 6.6.6.4f}
{Check that succ and pred cannot be applied to real values. }
program d6p6p6p4f(output);
var
   x:real;
begin
   x := 0.3;
   if (succ(x) > x) and (pred(x) < x) then { !!! succ() & pred() should not have real arguments }
      writeln(' DEVIATES ... 6.6.6.4f, REAL SUCC/PRED')
   else
      writeln(' DEVIATES ... 6.6.6.4f, MESS')
end.


{TEST 6.6.6.4h}
{Check that ord cannot be applied to real values. }
program d6p6p6p4h(output);
var
   x:real;
begin
   x := 0.3;
   if (ord(x) >= x-1) and (ord(x) <= x+1) then { !!! ord() should not have a real argument }
      writeln(' DEVIATES ... 6.6.6.4h, REAL ORD')
   else
      writeln(' DEVIATES ... 6.6.6.4h, MESS')
end.


{TEST 6.6.6.4i}
{Check that succ and pred cannot have pointer arguments. }
program d6p6p6p4i(output);
var
   p:^real;
begin
   if (succ(p) <> nil) and (pred(p) = p) then { !!! succ() & pred() should not have pointer arguments }
      writeln(' DEVIATES ... 6.6.6.4i, POINTER SUCC/PRED')
   else
      writeln(' DEVIATES ... 6.6.6.4i, MESS')
end.


{TEST 6.6.6.4j}
{Check that ord cannot have pointer arguments. }
program d6p6p6p4j(output);
var
   p:^real;
begin
   if ord(p) <= maxint then
      writeln(' DEVIATES ... 6.6.6.4j, POINTER ORD')
end.


{TEST 6.6.6.5c}
{Check that the function odd is restricted to integer parameters. }
program d6p6p6p5c(output);
var
   x:real;
begin
   x := 1.0;
   if odd(x) then	 { !!! odd() should have integer argument, not real  }
      writeln(' DEVIATES ... 6.6.6.5c, REAL 0DD')
   else
      writeln(' DEVIATES ... 6.6.6.5c, MESS')
end.


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

{TEST 6.7.2.2c}
{In standard pascal, the second operand of the MOD operator must be strictly positive.
 Check if the compiler allows a negative operand on the right hand side. }
program d6p7p2p2c(output);
var
   i, j, k : integer;
begin
   i := 6;
   j := -1;
   k := i mod j;  { !!! mod wrt -ve nr }
   writeln(' DEVIATES ... 6.7.2.2c: negative mod')
end.


{TEST 6.7.2.2i}
{ Test that he unary operator "+" cannot be applied to non-numeric operands. }
program d6p7p2p2i(output);
const
   capa = 'A';
begin
   writeln(+capa);	{ !!! illegal use of unary + operator }
   writeln(' DEVIATES ... 6.7.2.2i, UNARY OPERATCR')
end.


{TEST 6.7.2.2n}
{Check whether records can be compared }
program d6p7p2p2n(output);
var
   r1, r2 : record i : integer end;
begin
   r1.i := 6;
   r2.i := 6;
   if r1 = r2 then  { !!! non-nemeric operand }
      writeln('DEVIATES ... 6.7.2.2n: compare records')
end.


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


{TEST 6.7.2.3d}
{Are logical operators allowed to be performed on integers? }
program d6p7p2p3d(output);
var
   i,j :integer;
begin
   i := 1; j := 2;
   i := i and j; { !!! bitwise and is not part of iso pascal }
   writeln(' DEVIATES ... 6.7.2.3d, logical and operators on integers')
end.


{TEST 6.7.2.3e}
{Are logical operators allowed to be performed on integers? }
program d6p7p2p3e(output);
var
   i :integer;
begin
   i := 1;
   i := i and 1; { !!! bitwise and is not part of iso pascal }
   writeln(' DEVIATES ... 6.7.2.3e, logical and operators on integers')
end.


{TEST 6.7.2.3f}
{Are logical operators allowed to be performed on integers? }
program d6p7p2p3f(output);
var
   i,j :integer;
begin
   i := 1; j := 2;
   i := i or j; { !!! bitwise or is not part of iso pascal }
   writeln(' DEVIATES ... 6.7.2.3f, logical or operators on integers')
end.


{TEST 6.7.2.3g}
{Are logical operators allowed to be performed on integers? }
program d6p7p2p3g(output);
var
   i :integer;
begin
   i := 1;
   i := i or 1; { !!! bitwise or is not part of iso pascal }
   writeln(' DEVIATES ... 6.7.2.3g, logical or operator on integers')
end.


{TEST 6.7.2.3h}
{Are logical operators allowed to be performed on integers? }
program d6p7p2p3h(output);
var
   i :integer;
begin
   i := 1;
   i := not j; { !!! bitwise not is not part of iso pascal }
   writeln(' DEVIATES ... 6.7.2.3h, logical not operators on integers')
end.


{TEST 6.7.2.3i}
{Are logical operators allowed to be performed on integers? }
program d6p7p2p3i(output);
var
   i :integer;
begin
   i := not 1; { !!! bitwise not is not part of iso pascal }
   writeln(' DEVIATES ... 6.7.2.3i, logical not operators on integers')
end.


{------- 6.7.2.5 Relational operators -------}

{TEST 6.7.2.5a}
{Check that string comparisons compare the whole string. }
program d6p7p2p5a(output);
var
   s1, s2: packed array[1..6] of char;
begin
   s1 := 'ABCDEF';
   s2 := 'ABCDDD';
   s1[4] := chr(0);
   s2[4] := chr(0);
   if s1 = s2 then
      writeln(' DEVIATES ... 6.7.2.5a, string compare null terminated')
end.


{TEST 6.7.2.5c}
{Check that file comparisons are not allowed.
The semantics of this situation are particularly ill-defined,
and not within standard Pascal. }
program d6p7p2p5c(output);
var
   f:text;
begin
   rewrite(f);
   if f=output then { !!! file comparisons are not allowed }
      writeln(' FAIL1 ... 6.7.2.5c, DEVIATES CONTENTS COMPARED')
   else
      writeln(' FAIL2 ... 6.7.2.5c, DEVIATES DESCRIPTORS COMPARED')
end.


{TEST 6.7.2.5d}
{Are relational operators permitted to concatenate? }
program d6p7p2p5d(output);
var
   x,y,z:integer;
   b:boolean;
begin
   x := 1;
   y := 2;
   z := 3;
   b := (x<y<z);	 { !!! illegal use of < operator }
   writeln(' DEVIATES ... 6.7.2.5d, REL. OPS. ')
end.


{TEST 6.7.2.5e}
{The standard does not support strict less than as a set ralational operator }
program d6p7p2p5e(output);
var
   s: set of 0..10;
begin
   s := [1,2,3];
   if s < [1,2,3,4] then                     { !!! illegal use of < operator }
      writeln(' DEVIATES ... 6.7.2.5e, < set relational operator ')
end.


{TEST 6.7.2.5f}
{The standard does not support strict greater than as a set ralational operator }
program d6p7p2p5f(output);
var
   s: set of 'a'..'k';
begin
   s := ['b','c','d'];
   if s > ['b'..'d'] then                     { !!! illegal use of > operator }
      writeln(' DEVIATES ... 6.7.2.5e, > set relational operator ')
end.


{TEST 6.7.2.5g}
{The standard allows only equality tests on pointers.
 support for other relational operators is a deviation from the standard}
program d6p7p2p5g(output);
type pi = ^integer;
var
   p1, p2 :pi;
begin
   new(p1); new(p2);
   if p1 > p2 then                     { !!! illegal use of > operator }
      writeln(' DEVIATES ... 6.7.2.5g, > pointer relational operator ')
end.


{TEST 6.7.2.5h}
{The standard does allows only equality tests on pointers.
 support for other relational operators is a deviation from the standard}
program d6p7p2p5h(output);
type pi = ^integer;
var
   p1, p2 :pi;
begin
   new(p1); new(p2);
   if p1 >= p2 then                     { !!! illegal use of >= operator }
      writeln(' DEVIATES ... 6.7.2.5h, >= pointer relational operator ')
end.


{TEST 6.7.2.5i}
{The standard does allows only equality tests on pointers.
 support for other relational operators is a deviation from the standard}
program d6p7p2p5i(output);
type pi = ^integer;
var
   p1, p2 :pi;
begin
   new(p1); new(p2);
   if p1 < p2 then                     { !!! illegal use of < operator }
      writeln(' DEVIATES ... 6.7.2.5i, < pointer relational operator ')
end.


{TEST 6.7.2.5j}
{The standard does allows only equality tests on pointers.
 support for other relational operators is a deviation from the standard}
program d6p7p2p5j(output);
type pi = ^integer;
var
   p1, p2 :pi;
begin
   new(p1); new(p2);
   if p1 <= p2 then                     { !!! illegal use of <= operator }
      writeln(' DEVIATES ... 6.7.2.5j, <= pointer relational operator ')
end.


{TEST 6.8.1a}
{only one label is permitted to prefix a statement}
program d6p8p1a(output);
label 1,2;
begin
1:
2:  {!!! another label in one statement}
   writeln(' DEVIATES ... 6.8.1a, LABELS ON STATEMENTS');
end.


{TEST 6.8.2.3c}
{Check that a function cannot be used as a procedure }
program d6p8p2p3c(output);
function f( ai: integer) : integer;
begin
   f := 0;
   writeln(' DEVIATES ... 6.8.2.3c, function used as procedure');
end;
begin
   f(0); {!!! function used where a procedure is required}
end.


{TEST 6.8.2.4a}
{ Check whether jumps into nested statements are allowed. }
program d6p8p2p4a(output);
label
    1;
var
    i: integer;
begin
    i := 0;
    goto 1;
    while i > 0 do begin

1:	{ !!! not allowed to goto here from outside the while statement }
        writeln(' DEVIATES ... 6.8.2.4a, GOTO');
    end;
end.


{TEST 6.8.2.4b}
{ Check whether jumps into nested statements are allowed. }
program d6p8p2p4b(output);
label
    1;
var
    i: integer;
begin
    i := 0;
    while i > 0 do begin

1:
        writeln(' DEVIATES ... 6.8.2.4b, GOTO');
    end;
    if i > 0 then
        goto 1; { !!! not allowed to jump inside the while statement }
end.


{TEST 6.8.2.4c}
{ Check whether jumps between branches of a case statement are allowed. }
program d6p8p2p4c(output);
label
   4;
var
   i: 1..3;
begin
   for i := 1 to 2 do
      case i of
      1: ;
      2: goto 4;
      3: { case }
      4: { label }  { !!! not allowed to goto here from another branch of case statement }
	     writeln(' DEVIATES ... 6.8.2.4c, JUMPS IN CASE');
      end;
end.


{TEST 6.8.2.4d}
{ Similar to 6.8.2.4c, but here the label precedes the goto. }
program d6p8p2p4d(output);
label
   4;
var
   i: 1..3;
begin
   for i := 1 to 2 do
      case i of
      3: { case }
      4: { label }
        writeln(' DEVIATES ... 6.8.2.4d, JUMPS IN CASE');
      1: ;
      2: goto 4;  { !!! not allowed to jump to another branch of case statement }
      end;
end.


{TEST 6.8.2.4e}
{ Check whether jumps between nested statements are allowed. }
program d6p8p2p4e(output);
label
    1;
var
    i: integer;
begin
    i := 0;
    while i > 0 do begin
1:
        writeln(' DEVIATES ... 6.8.2.4e, GOTO');
        i := -1;
    end;
    while i >= 0 do begin
        goto 1; { !!! not allowed to jump into another nested statement }
        writeln(' DEVIATES ... 6.8.2.4e, GOTO');
    end;
end.


{TEST 6.8.2.4f}
{ Check whether jumps between nested statements are allowed. }
program d6p8p2p4f(output);
label
    1;
var
    i: integer;
begin
    i := 0;
    while i <= 0 do begin
        goto 1;
        writeln(' DEVIATES ... 6.8.2.4f, GOTO');
    end;
    while i > 2 do begin
1:	 { !!! not allowed to jump into another nested statement }
        writeln(' DEVIATES ... 6.8.2.4f, GOTO');
        i := 1;
    end;
end.


{TEST 6.8.2.4g}
{ Check whether jumps between branches of an if statement are allowed. }
program d6p8p2p4g(output);
label
   1,2;
var
   i: integer;
begin
   i := 5;
   if i<10 then
      goto 1
   else
1:	{ !!! not allowed to goto here from the other branch of if statement }
      writeln(' DEVIATES ... 6.8.2.4g');
   if i>10 then
2:
      writeln(' DEVIATES ... 6.8.2.4g')
   else
      goto 2;	{ !!! not allowed to goto the other branch of if statement from here }
end.


{TEST 6.8.2.4i}
{ Check that a goto statement causes an error when the statement(S)
to which control is transferred is not activated either by S or a
statement in the statement sequence of which S is an immediate constituent. }
program d6p8p2p4i(output);
var
   flag :boolean;
procedure a(i:integer; b:boolean);
label 99;
procedure r;
begin
   goto 99;
end;
begin {a}
   case i of
   { here the case value & label are on same line }
   0:99: if b then  { !!! can't goto here from outside block }
        writeln(' DEVIATES ... 6.8.2.4i')
      else
	 if flag then
	    writeln(' SHOULDN''T BE HERE ... 6.8.2.4i')
	 else begin
	    flag := true;
	    a(1,false);
	 end;
   1:
      a(2,true);
   2:
      r;
   end;
end; {a}
begin {d6p8p2p4i}
   flag := false;
   a(0,false);
end. {d6p8p2p4i}


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

{TEST 6.8.3.5a}
{Check if an error occurs when the case statement does not contain a constant
of the selected value. }
program d6p8p3p5a(output);
var
   i: integer;
begin
   i := 0;
   case i of	{ !!! unhandled case selector }
   -3,3: writeln(' FAIL ... 6.8.3.5e, CASE');
   end;
   writeln('DEVIATES ... 6.8.3.5a, CASE CONSTANT');
end.


{TEST 6.8.3.5b}
{This test is similar to the previous one - a case statement is given without
a case-constant of the selected value.
This time the value is a long way outside the case. }
program d6p8p3p5b(output);
var
   i :integer;
begin
   i := maxint-1000;
   case i of	{ !!! unhandled case selector }
   -3,3: writeln(' FAIL ... 6.8.3.5b, CASE');
   end;
   writeln('DEVIATES ... 6.8.3.5b, CASE CONSTANT');
end.


{TEST 6.8.3.5c}
{ Check that the constants of a case statement cannot be strings. }
program d6p8p3p5c(output);
var
   a:char;
   i: integer;
begin
   for a := 'a' to 'd' do
      case a of
      'a': i := 1;
      'b': i := i+1;
      'e': i := i+1;
      'de': i := i+1;	{ !!! can't have string as case constant }
      end;
   writeln(' DEVIATES ... 6.8.3.5c, CASE')
end.


{TEST 6.8.3.5f}
{This test contains an inva1id real case-constant with an integer case expression.
 Similar to test 6.8.3.5i.
 If the program compiles the effect at run-time could be curious. }
program d6p8p3p5f(output);
const c = 2.5;
var
   a,i:integer;
begin
   for i := 1 to 4 do
      case i of
      1,2: a := 1;
      c: writeln(' DEVIATES ... 6.8.3.5f. CASE'); { !!! real case constant }
      3: a := 2;
      end;
   writeln(' DEVIATES ... 6.8.3.5f, CASE');
end.


{TEST 6.8.3.5g}
{This test contains an inva1id real case-constant with an integer case expression.
 Similar to test 6.8.3.5i.
 If the program compiles the effect at run-time could be curious. }
program d6p8p3p5g(output);
var
   a,i:integer;
begin
   for i := 1 to 4 do
      case i of
      1,2: a := 1;
      2.5: writeln(' DEVIATES ... 6.8.3.5g. CASE'); { !!! real case constant }
      3: a := 2;
      4e0: writeln(' DEVIATES ... 6.8.3.5g, CASE'); { !!! real case constant }
      end;
   writeln(' DEVIATES ... 6.8.3.5g, CASE');
end.


{TEST 6.8.3.5i}
{Check that the compiler detects when case-constants and the case-index are of different types.
Similar to test 6.8.3.5g. }
program d6p8p3p5i(output);
var
   i,counter:integer;
begin
   counter := 0;
   for i := 1 to 4 do
      case i of
      1: counter := counter+1;
      2.0: counter := counter+1;	{ !!! can't have real case constant }
      3: counter := counter+1;
      4e0: counter := counter+1;  { !!! same here }
      end;
   if counter=4 then
      writeln(' DEVIATES  6.8.3.5i, CASE CONSTANTS')
   else
      writeln(' FAILS  6.8.3.5i, CASE CONSTANTS');
end.


{TEST 6.8.3.5j}
{Check that the compiler detects real case constants
and a real case index, even When the values are integers.
The compiler fails if the program compiles and the program prints FAILS. }
program d6p8p3p5j(output);
var
   i,counter:integer;
   r:real;
begin
   counter := 0;
   for i := 1 to 4 do begin
      r := i;
      case r of 			{ !!! case index must not be real }
	 1.0: counter := counter+1;       { !!! case selector must not be real }
	 2.0: counter := counter+1;
	 3.0: counter := counter+1;
	 4e0: counter := counter+1;
      end;
   end;
   if counter=4 then
      writeln(' DEVIATES  6.8.3.5j, CASE CONSTANTS')
   else
      writeln(' FAILS  6.S.3.5j, CASE CONSTANTS');
end.


{TEST 6.8.3.5k}
{: Check that  a case index and the case constants must be the same type. }
program d6p8p3p5k(output);
var
   i,counter:integer;
   r:real;
begin
   counter := 0;
   for i := 1 to 4 do begin
      r := i;
      case r of { !!! case selector must not be real }
      1: counter := counter+1;
      2: counter := counter+1;
      3: counter := counter+1;
      4: counter := counter+1;
      end;
   end;
   if counter=4 then
      writeln(' DEVIATES  6.8.3.5k, CASE CONSTANTS')
   else
      writeln(' FAILS  6.8.3.5k, CASE CONSTANTS');
end.


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

{TEST 6.8.3.9a}
{ Check that an assignnent cannot be made to a for statement control variable. }
program d6p8p3p9a(output);
var
   i,j :integer;
begin
   j := 0;
   for i := 1 to 10 do begin
      j := j+1;
      i := i+1;  { !!! illegal assignment to i }
      write( j, i, ' ');
   end;
   writeln(' DEVIATES ... 6.8.3.9a, FOR');
end.


{TEST 6.8.3.9b}
{Test whether a non local variable at an intermediate
level can be used as a for statement control variable. }
program d6p8p3p9b(output);
procedure p;
var
   i: integer;
procedure loop;
var
   j: integer;
begin
   j := 0;
   for i := 1 to 10 do { !!! i shouldn't belong to an outer level}
      j := j+1;
end;
begin
   loop
end;
begin
   p;
   writeln(' DEVIATES . 6.8.3.9b, FOR');
end.


{TEST 6.8.3.9c}
{ Check that an error is produced when a for statement control variable is used as a var parameter. }
program d6p8p3p9c(output);
var
   i,j :integer;
procedure addone(var n:integer);
begin
   n := n+1;
end;
begin
   j := 0;
   for i := 1 to 10 do begin
      j := j+1;
      addone(i);   { !!! called procedure could assign new value to i }
   end;
   writeln(' DEVIATES ... 6.8.3.9c, FOR');
end.


{TEST 6.8.3.9d}
{ Verify that an error is produced when an assignnent is made to
  a for statement control variable in a nested procedure. }
program d6p8p3p9d(output);
var
   i,j: integer;
procedure iassign;
begin
   i := i+1;
end;
begin
   j := 0;
   for i := 1 to 10 do begin {!!! i is threatened}
      j := j+1;
      iassign;  { !!! hidden assignment to i }
   end;
   writeln(' DEVIATES ... 6.8.3.9d, FOR');
end.


{TEST 6.8.3.9e}
{ Verify that an error is produced when an assignnent is made to
  a for statement control variable in a nested procedure. }
program d6p8p3p9e(output);
var
   i,j: integer;
procedure myproc;
procedure addone( var k: integer );
begin
   k := k+1;
end;
begin {myproc}
   addone(i);
end;
begin {d6p8p3p9d}
   j := 0;
   for i := 1 to 10 do begin {!!! i is threatened}
      j := j+1;
      myproc;  { !!! hidden assignment to i }
   end;
   writeln(' DEVIATES ... 6.8.3.9e, FOR');
end.


{TEST 6.8.3.9j}
{Test whether a real number can be assigned to a for statement control variable. }
program d6p8p3p9j(output);
var
   i: integer;
   counter: integer;
begin
   counter := 0;
   for i := 0.0 to 3.5 do   { !!! can't have real loop limits }
      counter := counter+1;
   if counter=4 then
      writeln(' DEVIATES  6.8.3.9j, FOR EXPRESSION ROUNDED')
   else
      writeln(' DEVIATES  6.8.3.9j, FOR EXPRESSION TRUNCATED');
end.


{TEST 6.8.3.9k}
{Check whether a for statement control variable can be a component variable. }
program d6p8p3p9k(output);
var
   rec:record
	  i,j :integer;
       end;
begin
   for rec.i := 0 to 10 do { !!! for loop index belongs to a record }
      rec.j := rec.i;
   with rec do
      for i := 0 to 10 do { !!! for loop index belongs to a record }
         j := i;
   writeln(' DEVIATES  6.8.3.9k, FOR');
end.


{TEST 6.8.3.9l)
{Check whether a for statement control variable can be a pointer variable. }
program d6p8p3p9l(output);
type
   int = ^integer;
var
   ptr: int;
   j: integer;
begin
   j := 0;
   new(ptr);
   for ptr^ := 0 to 10 do { !!! using pointer variable as loop control variable }
      j := j+1;
   writeln(' DEVIATES  6.8.3.9l, FOR');
end.


{TEST 6.8.3.9m}
{Check whether a for statement control variable can be an array element. }
program d6p8p3p9m(output);
var
   arr: array[1..9] of char;
begin
   for arr[1] := 'A' to 'Z' do { !!! for loop index is an array element }
      arr[2] := arr[1];
   writeln(' DEVIATES  6.8.3.9m, FOR');
end.


{TEST 6.8.3.9n}
{Test whether a formal parameter can be used as a for statement control variable. }
program d6p8p3p9n(output);
procedure p;
var
   i : integer;
procedure loop(var i:integer);
var
   j: integer;
begin
   j := 0;
   for i := 1 to 10 do { !!! using var parameter as loop control variable }
      j := j+1;
end;
begin
   i := 10;
   loop(i)
end;
begin
   p;
   writeln(' DEVIATES  6.8.3.9n, FOR');
end.


{TEST 6.8.3.9o}
{Test whether a global variable (at program level)
can be used as a for statement control variable. }
program d6p8p3p9o(output);
var
   i: integer;
procedure p;
procedure loop;
var
   j: integer;
begin
   j := 0;
   for i := 1 to 10 do { !!! i should be local }
      j := j+1;
end;
begin
   loop
end;
begin
   p;
   writeln(' DEVIATES  6.8.3.9o, FOR');
end.


{TEST 6.8.3.9p}
{Check the type of error produced when a for statement control
variable value is read during the execution of the for statement. }
program d6p8p3p9p(output);
var
   f :text;
   i,j:integer;
begin
   j := 0;
   rewrite(f);
   writeln(f,5,5,5,5,5);
   reset (f);
   for i := 1 to 10 do begin
      if i<5 then
	 read(f,i); { !!! illegal update of for loop index }
      j := j+1;
   end;
   writeln(' DEVIATES  6.8.3.9p, FOR');
end.


{TEST 6.8.3.9s}
{Check that compilers that permit the deviation (extension?) of allowing
non-local control variables do so responsibly and do not introduce new insecurities.
Check that a nested for statement using the same control variable is detected.
It is similar to test 6.8.3.9n but requires a degree of sophistication to
detect this condition.
The program may loop endlessly under some compilers. }
program d6p8p3p9s(output);
var
   i : integer;
procedure p;
procedure q;
procedure r;
procedure s(i:integer);  { i was var param, but this is tested in test 6.8.3.9a }
begin {s}
   writeln(i);
end; {s}
begin {r}
   for i := 5 downto 2 do {!!! i must be local}
      s(i);  { !!! using same control variable as main program }
end; {r}
begin {q}
   r
end; {q}
begin {p}
   q
end; {p}
begin
   for i := 1 to 6 do	 { !!! i could be modified inside procedure p }
      p;
   writeln(' DEVIATES  6.8.3.9s, FOR INDEX VARIABLE')
end.


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

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

{TEST 6.9.1a}
{ attempt to read a boolean value from a file.
  This is not supported by the standard }
program d6p9p1a(output);
var
   f : text;
   a : boolean;
begin
   rewrite(f);
   writeln(f, true);
   reset(f);
   read(f,a);  { !!! read a boolean }
   writeln(' DEVIATES ... 6.9.1a, read a boolean');
end.


{TEST 6.9.1b}
{ attempt to read a string value from a file.
  This is not supported by the standard }
program d6p9p1b(output);
var
   f : text;
   s : packed array[1..10] of char;
begin
   rewrite(f);
   writeln(f, 'testString');
   reset(f);
   read(f,s);  { !!! read a string }
   writeln(' DEVIATES ... 6.9.1b, read a string');
end.


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

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

{TEST 6.9.3h}
{ Attempt to output an integer number using a real format. }
program d6p9p3h(output);
var
   i : integer;
begin
   i := 123;
   writeln(i:6:1); { !!! writing integer with real format }
   writeln(' DEVIATES ... 6.9.3h, WRITE');
end.


{TEST 6.9.3i}
{Attempt to output chars, strings, integers and reals whose field width parameters are negative. }
program d6p9p3i(output);
begin
   writeln;
   writeln('''', 'A':6, '''', ', ''', 'REP=':6, '''' );
   writeln('''', 'A':-6, '''', ', ''', 'REP=':-6, '''' ); { !!! field width must be positive }
   writeln;
   writeln( '1:6 ''', 1:6, '''');
   writeln( '1:-6 ''', 1:-6, ''''); { !!! field width must be positive }
   writeln;
   writeln( 'true:6 ''', true:6, '''');
   writeln( 'true:-6 ''', true:-6, ''''); { !!! field width must be positive }
   writeln;
   writeln( '1.1:16 ''', 1.1:16, '''');
   writeln( '1.1:-16 ''', 1.1:-16, ''''); { !!! field width must be positive }
   writeln(' DEVIATES ... 6.9.3i, WRITE -VE FIELD WIDTH');
end.


{TEST 6.9.3l}
{Check whether an unpacked array of characters can be output. }
program d6p9p3l(output);
var
   s:array[1 .. 3] of char;
begin
   s[1] := 'R'; s[2] := 'A'; s[3] := 'N';
   writeln(' RAN=', s);	{ !!! writeln() requires packed array of char }
   writeln(' DEVIATES ... 6.9.3l, WRITE UNPACKED STRING');
end.


{TEST 6.9.3m}
{Check whether it is possible to write a packed array of characters whose starting index is not 1.
 see also test 6.4.3.2i}
program d6p9p3m(output);
var
   s:packed array[0 .. 3] of char;
begin
   s[0] := 'F'; s[1] := 'R'; s[2] := 'A'; s[3] := 'N';
   writeln(' FRAN=', s); { !!! writeln() requires strings to start at index 1 }
   writeln(' DEVIATES ... 6.9.3m, WRITE STRING INDEX 0');
end.


{TEST 6.9.3n}
{Check whether it is possible to write a pointer. }
program d6p9p3n(output);
var
   f : text;
   p : ^integer;
begin
   new(p);
   p^ := 13;
   rewrite(f);
   write(f, ' pointer is ', p:18); { !!! write( pointer ) }
   writeln(f);
   dispose(p);
   writeln(' DEVIATES ... 6.9.3n, WRITE POINTER');
end.


{TEST 6.9.3.4.1a}
{Check the rounding of formatted real numbers.
 numbers should be rounded to nearest, and numbers midway between two limits should be
 rounded away from zero.
 Some implementations may use rounding to even (aka IEEE or bankers rounding)
 as specified in the ieee 754 floating point standard}
program d6p9p4p3p1a(output);
var
   f   :text;
   x,y :real;
begin
   rewrite(f);
   write(f, 0.25:1:1, 0.75:1:1);
   reset(f);
   read(f, x, y);
   if y <> 0.8 then
      writeln(' ERROR ... 6.9.3.4.1a, Rounding error')
   else if x = 0.2 then  {!!! round away from zero or round towards even}
      writeln(' DEVIATES ... 6.9.3.4.1a, Round to even');
end.


{TEST 6.10a}
{Check the effect of using a default file not declared in the program heading. }
program d6p10a(input);
begin
   writeln(' DEVIATES ... 6.10a, FILE DECLARATION'); {!!! output not declared}
end.


{TEST 6.10b}
{Check the effect of using a default file not declared in the program heading. }
program d6p10b(input);
begin
   writeln(output, ' DEVIATES ... 6.10b, FILE DECLARATION'); {!!! output not declared}
end.


{TEST 6.10c}
{ Check that the default file output is implicitly declared at the program level
by attempting to redefine it. The file input should be identical, of course.
The test should not compile. }

program d6p10c(output);
var
   output: integer; { !!! redefining output }
begin
   output := 1; {!!!}

   writeln( ' DEVIATES ... 6.10c, OUTPUT REDEFINED')
end.


{TEST 6.10d}
{ Check that the default file output is implicitly declared at the program level
by attempting to redefine it. The file input should be identical, of course.
The test should not compile. }

program d6p10d(input, output);
var
   input: integer; { !!! redefining input }
begin
   input := 1; {!!!}

   writeln( ' DEVIATES ... 6.10d, INPUT REDEFINED')
end.


{TEST 6.10d}
{ This program has no program statement.
Some compilers may assume the existence of such a statement if none is present. }

var  {!!! missing program header}
   i :integer;
begin
   i := 5;
   writeln(' DEVIATES ... 6.10d, missing program header') {!!! output not declared}
end.



{kate: debugMode on; cfgIndentCase false;}
