(*  ****** RTP compiler test  ****************)
 (* Test version 4 **)


(* Impl. external routines used by SYSTEMTEST *)
systemtest;
const
ni = 9;

procedure writename(Var z : Zone ; Inspect name : string); External;
.


(************************************************************* *)
(*************** TEST VERSION 4 ********************************)
(************************************************************* *)
  PROGRAM TestVer4(SHARED Test4End,TestVerOK : Boolean);
  

  const
  ccc = 100;




TYPE
  SubTypeDef = 1..4;




  ttt = 90..ccc;
  arr = array(80..120, ttt,  95..100) of array(1..2) of ttt;
  

  t = 1..4;
  data = array( t ) of integer;
  data1 = array(0..2) of boolean;
  data2 = array(-10..10) of integer;


  farve = ( rod, gul, blaa, gron, violet, sort );

  rec = record
  r1,r2: integer;
  b1,b2:boolean;
  end;
  
  ix_type = 0..10;
  rectype = record
             f1: ix_type;
             f2: boolean;
            end;
  
  artype = array(ix_type) of rectype;

  rect = record
          f1, f2, f3, f4: integer;
         end;

  ddddata = array( 0..34 ) of array(1..8) of integer;
    
      
  var
  a,c : integer;
  d : data;
  d1: data1;
  d2: data2;
  
  
  b : integer;
  f : farve;
  
  arec : rec;

  ar1: artype;
  
  x: integer;
  aarray: array(t) of integer;     (* 8 bytes *)

  aaa : array(0..2) of integer;
  bbb : array(1..5,3..5) of integer;
  i1,i3,i4 : integer;

  dddd : ddddata;
  dddd1: array(t,t) of boolean;
  
  Test4Ok : Boolean;
  ZoneVar : Zone;



Procedure PrintFarve( aa : Farve);
 begin
   with aa  as x : byte do PrintByte(ZoneVar, x);
 end;

  (*********************** PROCEDURE USED BY TEST4AA ***********************)

  procedure p(var a : integer);
  begin
  a:= 2;
  dddd(2)(a):= a;
  dddd(1,8) := 6;
  dddd(a+1,8) := 16;
  dddd(2,4*a) := -3;
  dddd(a)(3 + a) := dddd(a-1)(a+3*a) + dddd(3)(a+3*a) + dddd(a)(a+3*a);
  c := dddd(a)(2) + ni;
  PrintInteger(ZoneVar, c); (* 11 *)
  END;





  (********************************** TEST4AB ****************************)


  (* array vith dimension > 2 *)
  PROCEDURE TEST4AB;
  var
  a1: arr;
  y1,y2 : integer;
  x1, x100 : integer;
  
  begin
  WriteName(ZoneVar,"Test4AB");
  for  i := 92 to ccc - 3 do
  begin
  a1(i , i, 100,1) := i;
  end;
  Test4OK := false;
  y1 := 92;
  y2 := 93;
  x1 := 1;
  x100 := 100;
  PrintInteger(ZoneVar, a1(y1, y1,x100,x1)); (* 92*)
  IF a1(y1,y1,100,1) <> 92 THEN EXIT;
  PrintInteger(ZoneVar, a1(93, y2, 100,1));  (* 93 *) 
  IF a1(93,93,100,1) <> 93 THEN EXIT;
  PrintInteger(ZoneVar, a1(y2 + 1, 94, x100,x1));  (* 94 *) 
  IF a1(y1 + 2,y1 + 2,100,1) <> 94 THEN EXIT;
  PrintInteger(ZoneVar, a1(95,  95, 100,1));  (* 95 *)
  IF a1(y1+3,y1+3,100,1) <> 95 THEN EXIT;
  PrintInteger(ZoneVar, a1(96, y2 + 3, x100,1));  (* 96 *)
  IF a1(96,96,100,1) <> 96 THEN EXIT;
  PrintInteger(ZoneVar, a1(97, 97, x100,x1));  (* 97 *)
  IF a1(97,97,100,1) = 97 THEN Test4Ok := true;
  
  end;
  
  


  (********************************* TEST4AC ***************************)
  PROCEDURE test4ac ;

  (* Assignment, Exchange, =/<>  involving total arrays *)
  type
  ix_type = 0..10;
  artype = array(ix_type) of integer;
  
  var
  ar1: artype;
  ar2: artype := (:11***20:);
  boo: boolean;
  sum : integer;
  
  procedure printarray(a: artype);
  begin
  sum := 0;
  for i := 0 to 10 do
  begin
  printinteger(ZoneVar,a(i));
  sum := sum + a(i);
  end;
  end;
  
  begin
  WriteName(ZoneVar,"Test4AC");
  Test4OK := false;  

  ar1 := artype(:3***5,4***6,4***7:);
  
  printarray(ar1);   (* se ovenfor *)
  IF Sum <> ((3 * 5) + (4 * 6) + (4 * 7)) THEN EXIT;
  
  (** exchange **)
  ar1 :=: ar2;
  printarray(ar1);   (* 11 gange 20 *)
  IF Sum <> 220 THEN EXIT;
  
  (* assignment *)
  
  ar2 := ArType(:2***0,3***2,3,4,5,3***0:);
  
  printarray(ar2);   (* 0-0-2-2-2-3-4-5-0-0-0 *)
  IF Sum <> ((2 * 0) + (3 * 2) + 3 + 4 + 5 ) THEN EXIT;
  
  ar2 := ar1;
  printarray(ar2);    (* 11 gange 20 *)
  IF Sum <> 220 THEN EXIT;
  
  boo := ar1 = ar2;
  printboolean(ZoneVar, boo);    (* true *)
  IF boo <> true THEN EXIT;
  
  boo := ar1 <> ar2;

  printboolean(ZoneVar, boo);    (* false *)
  IF boo = false THEN Test4OK := true;
  
  end;



  (*********************************** TEST4AE *******************************)
  (* ARRAY - byte expressions *)
  PROCEDURE test4ae;
  var
  a : array(2..3) of byte;
  b : array(-1..2) of byte;
  i1,i2 : integer;
  ai : array(1..2) of -1..2;
  
  
  begin
  WriteName(ZoneVar,"Test4AE");
  Test4OK := false;
  b(-1) :=#d0;
  a(2) := #H18;

  i1 := -1;
  i2 := 2;
  ai(1) := -1;
  ai(2) := 2;
  
  b(ai(ai(2) - 1)):= (a(ai(1) + 3) AND ( b(i1) or ( a(i2) xor 
                ( not b(ai(1)) and ( a(ai(2)) or b(ai(ai(ai(1) + 3) - 1)))
           xor a(i2)))));
  PrintByte(ZoneVar, b(i1));  (* 18   *)
  IF b(i1) <> #H18 THEN EXIT;
  b(ai(1)) := not a(ai(1) + 3);
  PrintByte(ZoneVar, b(ai(ai(2) - 1)));  (* E7 *)
  IF b(ai(1)) <> #He7 THEN EXIT;
  b(-1) := ( a(2) xor b(ai(ai(2) - 1))) xor ((a(i2) and
           b(ai(ai(2) - 1))) or ((a(ai(2)) xor b(i1)) 
           and (a(ai(1) + 3) and (b(i1) or a(i2)))));
  PrintByte(ZoneVar, b(ai(1)));   (* E7 *)
  IF b(ai(1)) <> #He7 THEN EXIT;
  
  b(i1):=  b(ai(ai(2) - 1)) + (( b(i1) - #h02) + (( a(ai(1) + 3) div #H04)
         * b(ai(ai(2) - 1))) 
           mod a(ai(1) + 3) +( #h04 +
   ( ( a(2)*b(-1)) DIV (b(i1) div a(i2))) +#H03) );
  PrintByte(ZoneVar, b(i1));   (* EF *)
  IF b(i1) <> #HEF THEN EXIT;
  b(ai(1)) := b(i1) * a(ai(2)) MOD ( a(ai(1) + 3)) ;
  PrintByte(ZoneVar, b(i1));   (* 8 *)
  IF b(ai(1)) <> #H8 THEN EXIT;
  b(ai(1)) := (#Hc7 div b(i1)) * b(i1) + (#Hc7 mod b(-1));
  PrintByte(ZoneVar, b(i1));   (* C7 *)
  IF b(i1) <> #Hc7 THEN EXIT;
  b(-1) := (a(i2) div (#H20 + b(i1))) xor (b(ai(1)) and (#He7 * (b(-1)+ #H3)));
  PrintByte(ZoneVar, b(i1));   (* 46 *)
  IF b(i1) = #H46 THEN Test4Ok := true;
  
  end;







  (******************************* TEST4AF ****************************)
  (* Integer ARRAY - expressions  with inspect paramenter*)
  PROCEDURE TEST4AF;
  var
  a : array(0..2) of integer;
  b : array(1..5,3..5) of integer;
  i1,i3,i4 : integer;
  
  
  PROCEDURE testinspect(inspect i1 : integer;var i3 : integer; inspect 
                                                      i4 : integer);
  begin
  i3 := 3;
  a(1):= 7;
  PrintInteger(ZoneVar,a(i1));  (* 7 *)
  IF a(i1) <> 7 THEN EXIT;
  b(3,4):= - 30;
 
  PrintInteger(ZoneVar,b(i3,i4));   (* -30 *)
  IF b(i3,i4) <> -30 THEN EXIT;
 (* b(i3,4) := a(i4 - i3) + (( (a(i1) + 60) DIV b(i3,i4)) +
         ((  (a(i1) + 30) MOD b(i3,i4) ) DIV (( a(i1) + 342 - 758)
        + ((23 + a(i4 - i3)) + (( a(i1) MOD b(i4 - i1,i1 + (i1 + (i1 + 1)) )) -
        (( 303 + a(i4 -(i1 + ( i1 + i1))  ) - 300)
        * ((b(i3,i4) + a(i1 + ( a(1) - a(i1)) )) + ((200 + (b(i3,i4) 
        - 230))  mod ( a(i1) + b(3,i4)) ))))))));
  *)
  b(3,i4) := 2;
  PrintInteger(ZoneVar,b(3,i4)); (* 2 *)
  IF b(3,i4) = 2 THEN Test4OK := true;
                  
  end;
  
  begin
  WriteName(ZoneVar,"Test4AF");
   Test4OK := false;
   i1 := 1;
   i4 := 4;
   testinspect(i1 ,i3, i4);
  end;




  (****************************** TEST4AG ****************************)

 PROCEDURE test4ag;
  (* compare arrays in complicated expression *)
  
  
  type
    ar = array(-1..10) Of array(1..3) of record
                                            i : integer;
                                            j1 : integer;
                                            b : boolean;
                                         End;
  
  var  a1,a2 : ar;
       i : integer;  
       b : boolean;
  
  function IncI : integer;
   begin
     i := 1 + i;
     Inci := i;
   end;
  
  BEGIN
  WriteName(ZoneVar,"Test4AG");
    Test4OK := false;
    for i := -1 to 10 do
      for j := 1 to 3 do 
        with a1(i,j) do
          begin
            i := 23;
            j1 := 46;
            b := true;
          end;
    a2 := a1;
  a2(5,1).i := 24;
  
  i := 4;
  b := a1(i) = a2((i - i) + ( ( i-i) + ( (i-i)  + ( (i-i) * (i + i)  + i) )));
  printboolean(ZoneVar,b); (*true *) 
  IF b <> true THEN EXIT;
  i := 5;
  b := a1(i) = a2((i - i) + ( ( i-i) + ( (i-i)  + ( (i-i) * (i + i)  + i) )));
  printboolean(ZoneVar,b);  (* false *)
  IF b THEN EXIT;
       
  b := a1(i) = a2(incI);
  Printboolean(ZoneVar,b); (* true *)
  IF b = false THEN EXIT;
  i := 4;
  b :=  a1(i) = a2(Inci);
  PrintBoolean(ZoneVar,b);  (* false *)
  IF not b  THEN Test4OK := true;
  
  

  end;





  (************************************** TEST4BA **********************)

  (* record with subtypes and dot-notation *)
  PROCEDURE test4ba;
  type
  rec = record
  r1,r2: integer;
  r3 : record
  f1,f2,f3 : integer;
  end;
  r4 : array(1..11) of 0..255;
  b1,b2:boolean;
  end;
  var
  a : rec;
  begin
  WriteName(ZoneVar,"Test4BA");
  Test4Ok := false;
  a.r1:= 17;
  a.r2:= ni;
  a.r3.f2:= 110;
  a.r4(7):= 1;
  a.b1:= true;
  a.b2:= a.r2 > 8;
  
  PrintInteger(ZoneVar, a.r1);   (* 17 *)
  IF a.r1 <> 17 THEN Exit;
  PrintInteger(ZoneVar, a.r2);   (* 9 *)
  IF a.r2 <> 9 THEN Exit;
  PrintInteger(ZoneVar, a.r3.f2);   (* 110 *)
  IF a.r3.f2 <> 110 THEN Exit;
  PrintInteger(ZoneVar, a.r4(7));   (* 1 *)
  IF a.r4(7) <> 1 THEN Exit;
  PrintBoolean(ZoneVar, a.b1);  (* true *)
  IF a.b1 <> true THEN Exit;
  PrintBoolean(ZoneVar, a.b2);  (* true *)
  IF a.b2 = true THEN Test4Ok := true;
  end;




 (****************************** TEST4BB *************************)

  (* record with subtypes - with-notation *)
  PROCEDURE test4bb;
  type
  rec = record
  r1,r2: integer;
  r3 : record
  f1,f2,f3 : integer;
  end;
  r4 : array(1..11) of 1..200;
  b1,b2:boolean;
  end;
  var
  a : rec;
  begin
  WriteName(ZoneVar,"Test4BB");
  Test4Ok := false;
  with a do
  begin
  r1:= 17;
  r2:= ni;
  r3.f2:= 110;
  r4(7):= 1;
  b1:= true;
  b2:= r2 > 8;
  
  PrintInteger(ZoneVar, r1);  (* 17 *)
  IF r1 <> 17 THEN EXIT;
  PrintInteger(ZoneVar, r2);  (* 9 *)
  IF r2 <> 9 THEN EXIT;
  PrintInteger(ZoneVar, r3.f2);  (* 110 *)
  IF r3.f2 <> 110 THEN EXIT;
  PrintInteger(ZoneVar, r4(7));  (* 1 *)
  IF r4(7) <> 1 THEN EXIT;
  PrintBoolean(ZoneVar, b1);  (* true *)
  IF b1 <> true THEN Exit;
  PrintBoolean(ZoneVar, b2);  (* true *)
  IF b2  THEN Test4OK := True;
  
  end;
  end;

  (******************************* TEST4CB **********************)
  PROCEDURE test4cb;
  (* Assignment, exchange, <>/= between recordtypes *)
  (*  With on a constant **)
  
  type
  ix_type = -7..10;
  rectype = record
              f1: ix_type;
              f2: boolean;
              f3,f4: integer;
            end;
  var
  rec1: rectype;
  rec2: rectype := (:5,true, 30,40:);
  rec3: rectype := rectype(:4, false, 50, 60:);
  i : integer;
  const
  rec4 = rectype(:1, true, -1, -2:);
  
  procedure printrec(r: rectype);
  begin
  with r do
  begin
  PrintInteger(ZoneVar,f1);
  if f2 then PrintInteger(ZoneVar,f3)
  else PrintInteger(ZoneVar,f4);
  end;
  end; (* printrec *)
  
  begin 
  WriteName(ZoneVar,"Test4CB");
  Test4OK := false;
  rec1 := rectype(:3, false, 10, 20:);
  printrec(rec1);     (* 3  20 *)
  IF Rec1 <> rectype(:3,false,10,20:) THEN EXIT;
  printrec(rec2);     (* 5  30 *)
  IF rec2 <> rectype(:5,true,30,40:) THEN EXIT;
  
  rec1 :=: rec2;
  printrec(rec1);     (* 5  30 *)
  IF rec1 <> recType(:5,true,30,40:) THEN EXIT;
  if not (rec1 <> rec2) then
  begin
  printboolean(ZoneVar,false);
  EXIT;
  end
  else
  printboolean(ZoneVar,true);  (* true *)
  
  rec1 := rec4;
  printrec(rec1);     (** 1  -1 **)
  IF rec1 <> rectype(:1,true,-1,-2:) THEN EXIT;
  
  rec3.f2 := rec1 = rec2;   (* false *)
  printrec(rec3);        (* 4 60 *)
  IF rec3 <> recType(:4,false,50,60:) THEN EXIT;
  
  (* with paa constant *)
  with rec4 as y do
  begin
  printrec(y);      (* 1 -1 *)
  IF y <> RecType(:1,true,-1,-2:) THEN EXIT;
  end;
  
  i := rec4.f1;
  printinteger(zonevar,i);  (* 1 *)
  IF i <> 1 THEN EXIT;
  i := rec4.f3;
  printinteger(zonevar,i);  (* - 1 *)
  IF i = -1 THEN Test4OK := true;
  end;
  
  
  (*********************************** TEST4CC *********************)


  (* assignment and exchange on records and array types *)
  PROCEDURE TEST4CC;

  type
  ix_type = 0..10;
  rectype = record
             f1: integer;
             f2: boolean;
             f3: array(ix_type) of 0..210;
             
            end;
  
  artype = array(ix_type) of rectype;
  
  
  var
  ar1,ar2: artype;
  
  begin
  WriteName(ZoneVar,"Test4CC");
  Test4OK := false;
  for step := 0 to 10 do
  begin
  ar1(step).f1 := step;
  ar1(step).f2 := true;
  with ar1(step) do for s := 0 to 10 do f3(s) := step + 100;
  end;
  
  ar2 := ar1;
  
  for step := 0 to 10 do
  with ar2(step) do
  begin
  PrintInteger(ZoneVar, f1);     (* 0 , 1, ...,10 *)
  if f1 <> Step THEN EXIT;
  PrintBoolean(ZoneVar, f2);   (* 11 * true *)
  IF f2 <> True THEN EXIT;
  PrintInteger(ZoneVar, f3(1));  (* 100, 101, .....110 *)
  IF f3(1) <> 100 + Step THEN EXIT;
  end; 
  
  
  for step := 0 to 10 do
  begin
  ar1(step).f1 := step * 2;
  ar1(step).f2 := false;
  with ar1(step) do for s := 0 to 10 do f3(s) := step + 200;
  end;
  
  
  ar2 :=: ar1;
  
  for step := 0 to 10 do
  with ar1(step) do
  begin
  PrintInteger(ZoneVar, f1);     (* 0 , 1, ...,10 *)
  IF f1 <> Step THEN EXIT;
  PrintBoolean(ZoneVar, f2);   (* 11 * true *)
  IF f2 <> true THEN EXIT;
  PrintInteger(ZoneVar, f3(9));  (* 100, 101, .....110 *)
  IF f3(9) <> 100 + Step THEN Exit;
  end; 
  
  for step := 0 to 10 do
  with ar2(step) do
  begin
  PrintInteger(ZoneVar, f1);     (* 0 , 2, 4,...20*)
  IF f1 <> Step * 2 THEN EXIT;
  PrintBoolean(ZoneVar, f2);   (* 11 * false*)
  IF f2 <> false THEN EXIT;
  PrintInteger(ZoneVar, f3(1));  (* 200, 201, .....210 *)
  IF f3(1) <> 200 + Step THEN Exit;
  end; 
  
  TEST4ok := true;
  end;
  
  

 (*********************************** TEST4CD ***************)
  (* compare on array and record type *)
PROCEDURE Test4cd;    
type
  indextype = 1.. 100;
  arr = array(1..100 ) of indextype;
  rec = record
          i : integer;
          i2 : boolean;
          i3 : integer;
        end;
  
  var
  arraya,arrayb: arr;
  recorda,recordb : rec;
  bool : boolean;
  TestOK : Boolean;
  
  
  procedure comparearraysandrecord(a,b : arr; var avar, bvar :arr;
                          var arec : rec; brec : rec);
  
  
  
    var testlokalok : boolean;  
  
  
  
        procedure comparerecord(var r1, r2 : rec);
        begin
        
        bool := false;
        IF r1 = r2 THEN
            bool := true;
        
        PrintBoolean(ZoneVar, bool);  (* true *)
        IF Bool <> true THEN EXIT;
        brec.i := 11;
        IF r1 <> brec THEN 
          bool := false;
        
        brec.i := 5;
        PrintBoolean(ZoneVar, Bool);  (* false *)
        IF Bool THEN EXIT;
        IF  ((bool xor bool) xor (arec = brec)) THEN
          bool := true;
        
        PrintBoolean(ZoneVar, bool);  (* true *)
        IF Bool <> True THEN EXIT;
            
        TestLokalOk := True;
        end;
  
  
     begin
      
     TestOk := false;
     bool := false;
     IF arrayb = avar THEN
         bool := true;
     
     PrintBoolean(ZoneVar, bool);  (* true *)
     IF bool <> true THEN EXIT;
     b(11) := 10;
     IF avar <> b THEN
       bool := false;
     PrintBoolean(ZoneVar, Bool);  (* false *)
     IF Bool THEN EXIT;
     
     b(11) := 11;
     IF (bool or bool) xor ((bool xor bool) xor (avar = bvar)) THEN
       bool := true;
     
     PrintBoolean(ZoneVar, bool);  (* true *)
     IF not bool THEN EXIT;
         
     TESTlokalOk := false;
     comparerecord(arec,brec);
     TestOk := TestlokalOk; 
     end;
     
  begin
  WriteName(ZoneVar,"Test4CD");
  Test4Ok := false;
  for i := 1 to 100 do arraya(i) := i;
  arrayb := arraya;
  
  bool := false;
  IF arrayb = arraya THEN
      bool := true;
  
  PrintBoolean(ZoneVar, bool);  (* true *)
  IF Bool <> true THEN Exit;
  arrayb(11) := 10;
  IF arraya <> arrayb THEN
    bool := false;
  PrintBoolean(ZoneVar, Bool);  (* false *)
  IF Bool THEN EXIT;
  
  arrayb(11) := 11;
  IF (bool or bool) xor ((bool xor bool) xor (Arraya = Arrayb)) THEN
    bool := true;
  
  PrintBoolean(ZoneVar, bool);  (* true *)
  IF Bool <> true THEN EXIT;
      
     
  recorda.i := 5;
  recorda.i2 := true;
  recorda.i3 := -120;
  recordb := recorda;
  
  bool := false;
  IF recordb = recorda THEN
      bool := true;
  
  PrintBoolean(ZoneVar, bool);  (* true *)
  IF Bool <> true THEN EXIT;
  IF recorda <> recordb THEN ELSE
    bool := false;
  
  PrintBoolean(ZoneVar, Bool);  (* false *)
  IF Bool THEN EXIT;
  IF  ((bool xor bool) xor (recorda = recordb)) THEN
    bool := true;
  
  PrintBoolean(ZoneVar, bool);  (* true *)
  IF Bool <> true THEN EXIT;
      
  TestOK := false;

  comparearraysandrecord(arraya,arrayb,arraya,arrayb,recorda,recordb);
  Test4Ok := TestOk;  
  
  end;


  (***************************** TEST4D *************************)
  PROCEDURE test4d;
  (** structured constants of record-type **)
  (* recordtype as parameter *)
  
  type
  ix_type = 0..10;
  rectype = record
              f1: ix_type;
              f2: boolean;
              f3,f4: integer;
            end;
  
  var
  rec1: rectype;
  rec2: rectype := (:5,true, 30,40:);
  rec3: rectype := rectype(:4, false, 50, 60:);
  
  const
  rec4 = rectype(:1, true, -1, -2:);
  
  procedure printrec(r: rectype);
  begin
  with r do
  begin
  PrintInteger(ZoneVar,f1);
  if f2 then PrintInteger(ZoneVar,f3)
  else PrintInteger(ZoneVar,f4);
  end;
  end; (* printrec *)
  
  begin (*t4d*)
  WriteName(ZoneVar,"Test4D");
  
  rec1 := rectype(:3, false, 10, 20:);
  
  printrec(rec1);     (* 3  20 *)
  printrec(rec2);     (* 5  30 *)
  printrec(rec3);     (* 4  60 *)
  
  printrec(rec4);     (* 1  -1 *)
  IF (Rec1.f1 = 3) AND
     (Rec1.f4 = 20) AND
     (Rec1.f2 = false) AND
     (Rec2.f1 = 5) AND
     (Rec2.f3 = 30) AND
     (Rec2.f2 ) AND
     (Rec3.f1 = 4) AND
     (Rec3.f4 = 60) AND
     (Rec3.f2 = false) AND
     (Rec4.f1 = 1) AND
     (Rec4.f3 = -1) AND
     (Rec4.f2 ) AND
     (rec1 = rectype(:3,false,10,20:) ) AND
     (Rec2 = rectype(:5,true,30,40:) ) AND
     (rec3 = rectype(:4,false,50,60:) ) AND
     (rec4 = rectype(:1,true,-1,-2:)) THEN Test4OK := true
                                      ELSE Test4Ok := false; 
     
  end;
  

  (**************************** TEST4DA ***************************)
  PROCEDURE test4da;
  (* reference to an element in struc const *)
  type
  arr = array(1..3) of integer;
  const
  arr1 = arr(:10,20,30:);
  
  begin 
  WriteName(ZoneVar,"Test4DA");
  
  printinteger(zonevar,arr1(1));  (*10*)
  printinteger(zonevar,arr1(2));  (*20*)
  printinteger(zonevar,arr1(3));  (*30*)
  IF ( ( arr1(1) = 10) AND
       ( arr1(2) = 20) AND
       ( arr1(3) = 30) ) THEN Test4OK := true
                         ELSE Test4OK := false;
  end;

  
  (************************ TEST4E ******************************)
  PROCEDURE test4e;
    (** structured constants of array-type **)
    (* '***' - notation *)
    type
    ix_type = 0..10;
    artype = array(ix_type) of integer;
    bigarray = array(1..5000) of integer;
    var
    
    ar1: artype;
    ar2: artype := (:11***100:);
    ar3: artype := artype(:11***3:);
    big : bigarray;
    sum : integer := 0;
    begin
  WriteName(ZoneVar,"Test4E");
    Test4OK := false;
    ar1 := artype(:3***5,4***6,4***7:);
    for step := 0 to 10 do
    begin
    PrintInteger(ZoneVar,ar1(step));  (* 5 5 5 6 6 6 6 7 7 7 7 *)
    sum := sum + ar1(step);
    end;
    IF Sum <> (3*5 + 4*6 + 4*7) THEN EXIT;
    
    for step := 0 to 10 do
    BEGIN
    PrintInteger(ZoneVar,ar2(step));  (* 11 gange 100 *)
    IF ar2(step) <> 100 THEN EXIT;
    END;
    
    
    for step := 0 to 10 do
    BEGIN
    PrintInteger(ZoneVar,ar3(step));  (* 11 gange 3 *)
    IF ar3(step) <> 3 THEN EXIT;
    end;
    big := bigarray(:5000***2:);
    sum := 0;
    for i := 1 To 5000 do sum := sum + big(i);
    printinteger(zoneVar,sum); (* 10000 *)
    IF Sum = 10000 THEN Test4OK := true;
end;


  (*************************** TEST4F ******************)
  PROCEDURE test4f;
    (* structured constant with array of records *)
    (* and with 2 - dim arrays  **)
    type
    ix_type = 0..10;
    rectype = record
               f1: ix_type;
               f2: boolean;
              end;
    
    artype = array(ix_type) of rectype;
    var
    step: ix_type;
    ar1: artype := (:(:7,true:),10***(:1,false:):);
    ar2: array(1..2) of artype := (: (:11***(:5,false:):),(:11***(:1, true :):)  :);
    begin
  WriteName(ZoneVar,"Test4F");
    Test4OK := false;
    for step := 0 to 10 do
    with ar1(step) do
    begin
    PrintInteger(ZoneVar,f1);     (* 7 , 10 * 1 *)
    IF Step= 0 THEN
      BEGIN
        IF f1 <> 7 THEN EXIT;
      END
    ELSE
      IF f1<> 1 THEN EXIT;
    printBoolean(ZoneVar,f2);   (* true , 10 * false *)
    IF Step= 0 THEN
      BEGIN
        IF f2 <> true THEN EXIT;
      END
    ELSE
      IF f2 <> false THEN EXIT;
    end;
    
    for step := 1 to 2 do
    with ar2(step,step) do
    begin
    PrintInteger(ZoneVar,f1);     (* 5 , 1 *)
    printBoolean(ZoneVar,f2);   (* false , true *)
    end;
    IF (ar2(1,1).f1 = 5) AND
       (ar2(1,1).f2 = false) AND
       (ar2(2,2).f1 = 1) AND
       (ar2(2,2).f2 ) THEN Test4OK := true;
     
    end;

  (*************************** TEST4GB **************************)
   PROCEDURE test4gb;
(*  case med OTHERWISE  with more than two integer label*)
(* and with function as case-variable *)
var a,b : integer;

function fct(x: integer): integer;
begin
fct := x;
end; (* fct *)

begin
  WriteName(ZoneVar,"Test4GB");
a := 0;
for i:= -2 to 7 do
case fct(i) of
-1: a:= a + 1 + fct(i) + 50;
0:  a := a - 10;
3:  a := a + 5;
6: a:= a + i
otherwise a:= a + i + 1
end; (* case *)
PrintInteger(ZoneVar, a);    (* 74 *)
IF A <> 74 THEN Test4OK := False
           ELSE Test4OK := true;
end;





  (****************************** TEST4I *************************)
(* WITH on simpel type *)
(* renaming in WITH *)
(* retyping in WITH *)
  PROCEDURE TEST4I;
  var
    Res, Res1 : integer;
    resword : word;
  PROCEDURE Snyd( x : integer);
    VAR
      LocalInt : integer;
      LocalWord : Word;
    begin
      with x as y : word
        do
        begin
          y := y - #H1;
          LocalWord := y;
          with y as xx : integer do LocalInt := xx + 2;
        end;
      Res := LocalInt;
      ResWord := LocalWord;
      Res1 := x;
    end; 
  begin
  WriteName(ZoneVar,"Test4I");
    Test4OK := false;
    Res := 0;
    with  res as x do x := 5;
    PrintInteger(ZoneVar, res);  (* 5 *)
    IF Res <> 5 THEN  Exit;

    
    ResWord := #HFFFF;
    with ResWord as x : 0..255 do x := 1;
    PrintWord(ZoneVar, ResWord);  (* HFF01 *)
    IF ResWord <> #HFF01 THEN EXIT;


    Snyd(0);
    PrintInteger(ZoneVar, Res);  (* 1 *)
    IF Res <> 1 THEN EXIT;
    PrintInteger(ZoneVar, Res1);  (* - 1 *)
    IF Res1 <> -1 THEN EXIT;
    PrintWord(ZoneVar, ResWord); (* FFFF *)
    IF ResWord = #HFFFF THEN Test4OK := true;

  end;




  (*************************** TEST4HA ********************************) 
(* subrange of scalar types and scalar type as step variabel
   and scalar user in with stat and scalar as paramenter and case with 
   scalar labels *)
   
   PROCEDURE TEST4HA;
   type
   dag = (man, tir, ons, tor, fre, lqr, sqn);
   arbdag = man..fre;
   weekend = lqr..sqn;
   langweekend = fre..sqn;
   var
   f,f1,f2 : farve;
   fridag : weekend;
   d : dag;
   lys :rod..gul;
   mork : blaa..sort;
   noday,noworkday,nofriday : integer;
   procedure addfarve(var a : farve; b : farve);
   begin
     with a as k : 0..5 do
       with b as kk : 0..5 do k := kk + k;
   end;
   
   
   procedure printdag(dd : dag);
     procedure writetreechar(ch1,ch2,ch3 : char);
      begin
        WriteChar(ZoneVar, ch1);
        WriteChar(ZoneVar, ch2);
        WriteChar(ZoneVar, ch3);
        WriteChar(ZoneVar, cr);
        WriteChar(ZoneVar, lf);
      end;
   begin
     case dd of
      man : 
              writetreechar('m','a','n');
      tir :   writetreechar('t','i','r');
      tor :   writetreechar('t','o','r');
      ons :   writetreechar('o','n','s');
      Fre :   writetreechar('f','r','e');
      lqr :   writetreechar('l','q','r');
      sqn :   writetreechar('S','q','n')
     end;
   end;
   begin
  WriteName(ZoneVar,"Test4HA");
   Test4Ok := false;
   f:= blaa;
   lys :=rod;
   mork := f;
   printfarve(mork);    (* 2 *)
   IF mork <> blaa THEN Exit;
   printfarve(lys);   (* 0 *)
   IF Lys <> rod THEN EXIT;
   if mork = f THEN d := tor
               else d := tir;
   printdag(d);  (* tor *)
   IF d <> tor THEN EXIT;
   fridag := sqn;
   printdag(fridag); (* sqn *)
   IF Fridag <> sqn THEN EXIT;

   
   
   with mork as fff : dag do
   begin
      d := fff;
      printdag(d);   (* ons *)
      IF ons <> d THEN EXIT;
      mork := sort;
      IF d = ons THEN fridag := fff;
      printdag(fridag);  (* lqr *)
      IF fridag <> lqr THEN EXIT;
   END;
   
   noday := 0;
   noworkday := 0;
   nofriday  := 0;
   for i := man to sqn do 
    begin
      if ((i >= man) and (i <= Sqn)) THEN noday := noday + 1;
      if i < lqr then noworkday := noworkday + 1
                 else nofriday := nofriday + 1;
    end;
   
   PrintInteger(ZoneVar, noday);  (* 7*)
   IF NoDay <> 7 THEN EXIT;
   PrintInteger(ZoneVar, noworkday); (* 5 *)
   IF NoWorkDay <> 5 THEN EXIT;
   PrintInteger(ZoneVar, nofriday);  (* 2 *)
   IF NoFriDay <> 2 THEN EXIT;
   
   f1 := lys;
   addfarve(f1,gul);
   printfarve(f1);  (* 1 *)
   IF F1 <> gul THEN EXIT;
   lys := f1;
   addfarve(f,lys);
   printfarve(f);  (* 3 *)
   IF f =  gron THEN Test4OK := true;
      
   
   end;
   



  (********************** TEST4HB *******************)
  (* arrays mixed with scalar type *)
  PROCEDURE test4hb;
  type
  dag = (man, tir, ons, tor, fre, lqr, sqn);
  arbdag = man..fre;
  var
  arbtid : array(arbdag) of record
                            start,slut : 0..24;
                          end;
  fritid : array(dag) of record
                           ialt: 0..24;
                          end;
  
  
  
  fri,arbejde : integer := 0;
  
  begin
  WriteName(ZoneVar,"Test4HB");
  for i:= man to fre do
    with arbtid(i) do begin
                      start := 8;
                      slut := 16;
                      end;
     
  arbtid(tir).start := 11;
  arbtid(fre).slut := 19;
  
  for i:= man to sqn do
    with fritid(i) do begin
                         if i <= fre then ialt := 24 - (arbtid(i).slut -
                                                       arbtid(i).start)
                         else ialt := 24;
                      end;
     
  
  
  
  for i := man to sqn do
    begin
      if i >= lqr THEN 
      else arbejde := arbejde + (Arbtid(i).slut - Arbtid(i).Start);
    end;
  
  
  for i := man to sqn do fri := fri + fritid(i).ialt;
     
  Test4OK := false;
  PrintInteger(ZoneVar,arbejde);   (* 40 *)
  IF arbejde <> 40 THEN EXIT;
   PrintInteger(ZoneVar,fri);       (* 128 *)
  IF Fri = 128 THEN Test4OK := true;
  
  
  end;
  
  
  




  (*************************** TEST4JA *******************************)
  PROCEDURE  test4ja;
  (* test array with index type boolean, char and scalar *)
  
  
    type scalar = (a1,a2,a3,a4,a5,a6);
  
  var
    ar1 : array(char) of integer;
    ar2 : array(boolean) of integer;
    ar3 : array(scalar) of integer;
    sum : integer := 0;
  
  begin
  WriteName(ZoneVar,"Test4JA");
    Test4OK := false;
  for i := false to true do  ar2(i) := 500 + ord(i);
  
  for i := a1 to a6 do ar3(i) := 1000 + ord(i);
  for i := chr(0) TO chr(255) do ar1(i) := ord(i);
  
  
  for i := false to true do sum := sum + ar2(i);
  PrintInteger(ZoneVar,sum);  (* 1001 *)
  IF sum <> 1001 THEN EXIT;
  
  sum := 0;
  for i := a1 to a6 do  sum := sum + ar3(i);
  PrintInteger(ZoneVar,sum); (* 6015*)
  IF sum <> 6015 THEN EXIT;
  
  PrintInteger(ZoneVar,ar1(chr(100))); (* 100 *)
  IF ar1(chr(100)) <> 100 THEN EXIT;
  PrintInteger(ZoneVar,ar1('0'));  (* 48 *)
  IF ar1('0') = 48 THEN Test4OK := true;
  end;
  

  (*********************** TEST4KA *****************************)
  Procedure test4ka;
  (* type of size > maxint *)
  (* renaming a big type with a smaller one *)
  (* operations on small arrays (2 bytes) **)
  type
  big_arr = array(-3..maxint) of 0..255;
  small_arr = array(1..2) of 0..255;
  
  var
  ba: big_arr;
  a1, a2: small_arr;
  i : integer;
  begin
  WriteName(ZoneVar,"Test4KA");
  Test4OK := false;
  i := -3;
  ba(i) := 7;
  printinteger(ZoneVar,ba(-3)); (* 7 *)
  IF ba(-3) <>  7 THEN EXIT;
  ba(-2) := 5;
  
  with ba as sa: small_arr do
  begin
  printinteger(ZoneVar,sa(1));    (* 7 *)
  IF sa(1) <> 7 THEN EXIT;
  printinteger(ZoneVar,sa(2));    (* 5 *) 
  IF sa(2) <> 5 THEN EXIT;
  end;
  
  (** operations on small arrays **)
  a1 := small_arr(:7, 9:);
  a2 := a1;
  if not(a1 <> a2) then
  printinteger(ZoneVar,a1(1))   (* 7 *)
  else 
  begin
   printinteger(ZoneVar,a2(2));   (* 9 *)
   EXIT;
  END;
  
  a1(1) := a2(1) + a2(2);
  
  a1 :=: a2;
  printinteger(ZoneVar,a2(1));   (* 16 *)
  IF a2(1) <> 16 THEN EXIT;
  printinteger(ZoneVar,a2(2));   (* 9 *)
  IF a2(2) = 9 THEN Test4OK := true;
  
  
  end;




 
BEGIN
  WriteName(ZoneVar,"TESTVERSION4");

  (******************************* TEST4A *****************************)
  (* subrange and 1-dim array type *)
  (* simple element type *)
  WriteName(ZoneVar,"Test4A");
  a:= 2;
  d(2):= a;
  c:= d(a) + ni;
  PrintInteger(ZoneVar,  c );   (* 11 *)
  IF c <> 11 THEN GOTO ExitError;
  
  for i := 0 to 2 do
  begin
  d1(i) := d(2) + i = a;
  end;
  PrintBoolean(ZoneVar, d1(0));     (* true *)
  IF d1(0) <> true THEN GOTO ExitError;
  PrintBoolean(ZoneVar, d1(1));     (*  false *)
  IF d1(1) <> False THEN GOTO ExitError;
  PrintBoolean(ZoneVar, d1(2));     (* false *)
  IF d1(2) <> false THEN GOTO ExitError;
  
  d2(0) := 0;
  for i := 1 to 10 do
  begin
  d2(i) := i;
  d2(-i) := i;
  d2(0) := (d2(d2(-i)) + d2(-i)) + d2(0);
  end;
  c := 9;
  
  PrintInteger(ZoneVar, d2(d2(10) - d2(c) - 1));    (* 110 *)
  IF 110 <> (d2(d2(10) - d2(c) - 1)) THEN GOTO ExitError;
  PrintInteger(ZoneVar, d2(-7)); (* 7*)
  IF d2(-7) <> 7 THEN GOTO ExitError;



  (************************* TEST4AA ***********************************)
  (* subrange and 2-dim array type *)
  
  WriteName(ZoneVar,"Test4AA");
  p(dddd(4,4));
  IF c <> 11 THEN GOTO ExitError;
  a := 4;
  dddd1(3,3) := dddd(a,a) = 2;
  a := 3;
  PrintBoolean(ZoneVar, dddd1(a,a));      (* true *)
  IF not dddd1(a,a)  THEN Goto ExitError;
  
  PrintInteger(ZoneVar, dddd(2,5));  (* 19 *)
  IF dddd(2,5) <> 19 THEN GOTO ExitError;
  
  



  (************************* TEST4AB ************************)
  TEST4AB;
  IF Test4OK = false THEN GOTO ExitError;



  (************************* TEST4AC ************************)
  TEST4AC;
  IF Test4OK = false THEN GOTO ExitError;


(***************************** TEST4AD **********************************)
(* Integer ARRAY - expressions *)
  WriteName(ZoneVar,"Test4AD");
i1 := 1;
i3 := 3;
i4:= 4;
aaa(1):= 7;
PrintInteger(ZoneVar, aaa(i1));  (* 7 *)
IF aaa(i1) <> 7 THEN GOTO ExitError;
bbb(3,4):= - 30;
PrintInteger(ZoneVar, bbb(i3,i4));   (* -30 *)
IF bbb(i3,i4) <> -30 THEN GOTO ExitError;
(*
bbb(i3,4) := aaa(i4 - i3) + (( (aaa(i1) + 60) DIV bbb(i3,i4)) +
       ((  (aaa(i1) + 30) MOD bbb(i3,i4) ) DIV (( aaa(i1) + 342 - 758)
      + ((23 + aaa(i4 - i3)) + (( aaa(i1) MOD bbb(i4 - i1,i1 + (i1 + (i1 + 1)) )) -
      (( 303 + aaa(i4 -(i1 + ( i1 + i1))  ) - 300)
      * ((bbb(i3,i4) + aaa(i1 + ( aaa(1) - aaa(i1)) )) + ((200 + (bbb(i3,i4) 
      - 230))  mod ( aaa(i1) + bbb(3,i4)) ))))))));
*)
bbb(3,i4) := 2;
PrintInteger(ZoneVar, bbb(3,i4)); (* 2 *) 
IF bbb(3,i4) <> 2 THEN Goto ExitError;
                

   (*************************** TEST4AE *********************)
  TEST4AE;
  IF Not Test4OK THEN GOTO ExitError;



   (*************************** TEST4AF *********************)
  TEST4AF;
  IF Not Test4OK THEN GOTO ExitError;



   (*************************** TEST4AG *********************)
  TEST4AG;
  IF Not Test4OK THEN GOTO ExitError;



  (************************** TEST4B **************************)
  (* record type with two simpel field types *)
  WriteName(ZoneVar,"Test4B");
  arec.r1:= 17;
  arec.r2:= ni;
  arec.b1:= true;
  arec.b2:= arec.r2 > 8;
  
  PrintInteger(ZoneVar, arec.r1);     (* 17 *)
  IF arec.r1 <> 17 THEN GOTO ExitError;
  PrintInteger(ZoneVar, arec.r2);     (* 9 *)
  IF arec.r2 <> 9 THEN GOTO ExitError;
  PrintBoolean(ZoneVar, arec.b1);  (* true *)
  IF arec.b1 <> true THEN GOTO ExitError;
  PrintBoolean(ZoneVar, arec.b2);   (* true *)
  IF arec.b2 <> true THEN GOTO ExitError;





  (*******************************TEST4BA **********************)
  TEST4BA;
  IF TEST4OK = false THEN GOTO ExitError;



  (******************************** TEST4BB *********************)
  TEST4BB;
  IF Test4Ok = false THEN GOTO ExitError;




  (***************************** TEST4C ************************)
  (* array of records *)
  WriteName(ZoneVar,"Test4C");
  for step := 0 to 10 do
  begin
  ar1(step).f1 := step;
  ar1(step).f2 := true;
  end;
  
  Test4Ok := true;

  for step := 0 to 10 do
  with ar1(step) do
  begin
  PrintInteger(ZoneVar, f1);     (* 0 , 1, ...,10 *)
  IF f1 <> Step THEN test4Ok := false;
  PrintBoolean(ZoneVar, f2);   (* 11 * true *)
  If f2 <> true THEN test4Ok := false;
  end;

  IF Not Test4Ok THEN Goto ExitError;



  (******************************* TEST4CA *******************************)
  (* array-type renamed to recordtype *)
  WriteName(ZoneVar,"Test4CA");
  
  TEST4Ok := True;
  for i := 1 to 4 do
  begin
    aarray(i) := 100 + i;
    x := aarray(i);
    PrintInteger(ZoneVar, x);    (* 101 - 102 - 103 - 104 *)
    IF x <> (100 + i) THEN Test4Ok := False; 
  end;
  
  IF not Test4Ok THEN GOTO ExitError;

  with aarray as r: rect do with r do
  begin
    PrintInteger(ZoneVar, f1);     (* 101 *)
    IF F1 <> 101 THEN Test4Ok := false;
    PrintInteger(ZoneVar, f2);     (* 102 *)
    IF F2 <> 102 THEN Test4Ok := false;
    PrintInteger(ZoneVar, f3);     (* 103 *)
    IF F3 <> 103 THEN Test4Ok := false;
    PrintInteger(ZoneVar, f4);     (* 104 *)
    IF F4 <> 104 THEN Test4Ok := false;
  end;
  
  IF Test4Ok <> true THEN Goto ExitError;




  (************************ TEST4CB ***************************)
  TEST4CB;
  IF Test4OK <> True THEN Goto Exiterror;



  (************************ TEST4CC ***************************)
  TEST4CC;
  IF Test4OK <> True THEN Goto Exiterror;



  


  (************************* TEST4CD ****************************)
  Test4cd;
  IF Test4Ok <> true THEN Goto ExitError;





  (************************ TEST4D ***************************)
  TEST4D;
  IF Test4OK <> True THEN Goto Exiterror;



  (************************ TEST4DA ***************************)
  TEST4DA;
  IF Test4OK <> True THEN Goto Exiterror;



  (************************ TEST4E ***************************)
  TEST4E;
  IF Test4OK <> True THEN Goto Exiterror;



  (************************ TEST4F ***************************)
  TEST4F;
  IF Test4OK <> True THEN Goto Exiterror;




  (************************* TEST4G ********************************)
  (*  case uden OTHERWISE *);
  WriteName(ZoneVar,"Test4G");
  for i:= 1 to 2 do
  case i of
    1: a:= ni;
    2: a:= a + i
  end; (* case *)
  
  PrintInteger(ZoneVar, a);    (* 11 *)
  IF a <> 11 THEN GOTO ExitError;
  b:= a mod 3;
  PrintInteger(ZoneVar,  b );   (* 2 *)
  IF b <> 2 THEN GOTO ExitError;





  (**************************** TEST4GA *********************************)
  (*  case med OTHERWISE *)
  WriteName(ZoneVar,"Test4GA");
  for i:= 1 to 4 do
  case i of
  1: a:= ni;
  2: a:= a + i
  otherwise a:= a + 3*i
  end; (* case *)
  PrintInteger(ZoneVar, a);    (* 32 *)
  IF a <> 32 THEN GOTO ExitError;
  b:= a mod 3;
  PrintInteger(ZoneVar,  b );   (* 2 *)
  IF b <> 2 THEN GOTO ExitError;







  (************************** TEST4GB ********************************)
  (*  case med OTHERWISE  with more than two integer label*)
  Test4gb;
  IF Test4Ok = false THEN GOTO ExitError;


  (**************************** TEST4GC ************************************)
  (*  Nested case  *)
  WriteName(ZoneVar,"Test4GC");
  a := 0;
  b := 5;
  for i:= -2 to 7 do
  case i of
  -1: ;
  0:  if b = 4 THEN a := a - 10;
  3:  case i of
       3 : a := a + 5
      end;
  6:  if b= 4 then else a:= a + i
  otherwise a:= a + i
  end; (* case *)
  PrintInteger(ZoneVar, a);    (* 28 *)
  IF a <> 28 THEN GOTO ExitError;



  (**************************** TEST4GD ******************************)
  (*  Nested case  and labellist*)
  WriteName(ZoneVar,"Test4GD");
  a := 0;
  for i:= -4 to 10 do
  case i of
  -1..1: ;
  9,-3:  case i of
            9..20,-3 : case i of 
                        9 : if i = 9 then a := a + 5;
                        - 3..1 :
                       end
         end;
  6,4:  case  i of 
          4: a := a + i
        otherwise a := a + 2
        end
  otherwise case i of 
              5 : a:= a + i;
             10 : if i = 10 then a := a * i
            otherwise a := a - i
             end
  end; (* case *)
  PrintInteger(ZoneVar, a);    (* 20 *)
  IF a <> 20 THEN GOTO ExitError;






  (******************************* TEST4I *******************************)



  TEST4I;
  IF Test4Ok = false THEN Goto ExitError;



  (****************************** TEST4H **********************************)
  (* scalar types *)
  WriteName(ZoneVar,"Test4H");
  f:= blaa;
  printfarve(f);    (* 2 *)
  IF f <> Blaa THEN GOTO ExitError;
  


  (******************************* TEST4HA *****************************)
  Test4HA;
  IF NOT Test4OK  THEN GOTO ExitError;




   (*************************** TEST4HB *********************)
  TEST4HB;
  IF Not Test4OK THEN GOTO ExitError;



   (*************************** TEST4JA *********************)
  TEST4JA;
  IF Not Test4OK THEN GOTO ExitError;




  (************************ TEST4KA ***************************)
  TEST4KA;
  IF Test4OK <> True THEN Goto Exiterror;


region testverok do
  TestVerOK := true;
region test4end do
  Test4End := true;


  EXIT;

  ExitError:

region testverok do
  TestverOK := false;  

region test4end do
 Test4End := true;


end.