(*  ******RTP compiler test. Test  Version 5 ****************)

systemtest;
const
ni = 9;

procedure writeName( VAR z : inoutzone; INSPECT name : String); external;

(*test5daenv;*)
  type
    arrType = Array(1..3) OF Integer;

.


 

(***********************************************************)
(***********************************************************)
(****************** test version 5 *************************)
(***********************************************************)
Program TestVer5(Shared fin,OK : boolean);
Var


 ZoneVar : inoutzone;
 Test5Ok : Boolean;
 OK1 : Boolean;
 Process5DA : Process;
 Linkok : Link_Result;
 CreateOK : Create_Result;
 Shared
   Test5DAOK : boolean := false;
   Test5DAEnd : boolean := false;



 (* Variable for test5ca *)
   var
    
   
   Test5CA_y : Reference;
   Test5CA_x : chain;
   Test5CA_f : pool;
   Test5CA_s : mailbox;
   Test5CA_e :process;
   Test5CA_p : port;


  (* Variable and types For test5cb *)
   type
   trec = record
             x : boolean;
             l : array(1..2) of reference;
          End;
   sss = array(1..4) of record
                          s : integer;
                          m : mailbox;
                        END;
   
   var
   
   Test5CB_ss : sss; 
   Test5CB_f : trec;
   Test5CB_y : array(-1..10) of process;


 (* variabel for test5d *)
   shared
    
   
   Test5d_y, Test5d_index : integer := 24;
   Test5d_x : boolean := true;
   Test5d_f : record
                 x : integer;
                 y : boolean;
              end;
    Test5d_Arr : Array(1..10) OF Integer;
   

  (* variable for test5db  *)

    var high : integer := 10;
    shared
     
    
    Test5db_y,Test5db_index : integer := 24;
    Test5db_x : boolean := true;
    Test5db_f : record
             x : integer;
             y : boolean;
            end;
    shared
    Test5db_Arr : Array(1..high) OF Integer;
    
   (********************* TEST5A ***********************)
   PROCEDURE Test5A;
   (* test new *)
   type
     rec = record
             f1 : integer;
             f2 : array(1..3) of integer;
             f3 : integer;
           end;
   var
     ptr : ^rec;
   begin
     WriteName(ZoneVar,"Test5A");
     new(ptr); 
     ptr^.f1 := 1;
     for i := 1 to 3 do ptr^.f2(i) := i + 1;
     with ptr^ do
         f3 := 5;
     PrintInteger(Zonevar,ptr^.f1); (* 1 *)
     PrintInteger(Zonevar,ptr^.f2(1)); (* 2 *)
     PrintInteger(Zonevar,ptr^.f2(2)); (* 3 *)
     PrintInteger(Zonevar,ptr^.f2(3)); (* 4 *)
     PrintInteger(Zonevar,ptr^.f3); (* 5 *)
     IF (ptr^.F1 = 1) AND 
        (ptr^.f2(1) = 2) AND
        (ptr^.f2(2) = 3) AND
        (ptr^.f2(3) = 4) AND
        (ptr^.f3 = 5) THEN Test5OK := true;
   END;






    (******************* TEST5AA ***********************)
    PROCEDURE test5aa;
    const
    ni = 9;
    type
    t = 1..4;
    data = array( t ) of integer;
    data1 = array(0..2) of boolean;
    data2 = array(-10..10) of integer;
    ptrtype = ^data;
    
    var
    a,c : integer;
    d :^data;
    d1: ^data1;
    d2: ^data2;
    ptr : ptrtype;
    dtype : data;
      FUNCTION newandInit( i : integer) : ptrtype;
      var help : ptrtype;
      begin
        new(help);
        for j := 1 to 4 do help^(j) := i;
        newandinit := help;
      end;
    begin
    WriteName(ZoneVar,"Test5AA");
    new(d1);
    new(d2);
    new(d);
    a:= 2;
    d^(2):= a;
    c:= d^(a) + ni;
    printinteger(zonevar,  c );   (* 11 *)
    IF c <> 11 THEN EXIT;
    
    for i := 0 to 2 do
    begin
    d1^(i) := d^(2) + i = a;
    end;
    printboolean(ZoneVar,d1^(0));     (* true *)
    printboolean(ZoneVar, d1^(1));     (*  false *)
    printboolean(ZoneVar,d1^(2));     (* false *)
    IF (d1^(1) OR d1^(2) OR (d1^(0) = false)) THEN EXIT;
    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 d2^(d2^(10) - d2^(c) - 1) <> 110 THEN EXIT;
    PrintInteger(ZoneVar,d2^(-7)); (* 7*)
    IF d2^(-7) <> 7 THEN EXIT;

    dtype := newandinit(5)^;
    ptr := newandinit(10);

    FOR i := 1 to 4 do 
      BEGIN
        PrintInteger(ZoneVar,dtype(i)); (* 5 , 5 , 5 , 5 *)
        PrintInteger(ZoneVar,Ptr^(i));  (* 10, 10, 10, 10 *)
        IF (dtype(i) <> 5) OR ( Ptr^(i) <> 10) THEN EXIT;
      END;
      Test5OK := true;
    end;
    
    
    
    
   (*********************** TEST5AB *******************)
     (* initialize pointer types *)
   PROCEDURE test5ab;
   type
   ptrtrec;
   trec = record
             x : boolean;
             l : array(1..2) of ptrtrec;
          End;
   ptrtrec = ^trec;
   sss = array(1..4) of record
                          s : integer;
                          m : ptrtrec;
                        END;
   var
   p : ptrtrec;
   d : ARRAY(-2..3) of ^integer;
   ss : sss; 
   f : trec;
   e : trec;
   begin
     WriteName(ZoneVar,"Test5AB");
     f.x := nil(p);
     printboolean(ZoneVar, f.x); (* true *)
     IF f.x <> true THEN EXIT;
     f.x := true;
     for i := -2 to 3 do 
       f.x := f.x and nil(d(i));
     printboolean(ZoneVar, f.x); (* true *)
     IF f.x <> true THEN EXIT;
     f.x := true;
     for i := 1 to 4 do
       f.x := f.x and nil(ss(i).m);
     printboolean(ZoneVar, f.x);  (* true *)
     IF f.x <> true THEN EXIT;
     f.x := ( nil(f.l(1)) and nil(f.l(2)) ) AND
            ( nil(e.l(1)) and nil(e.l(2)) ) ;
     printboolean(ZoneVar, f.x); (* true *)
     IF f.x  THEN Test5OK := true;
   
     
   end;


   (********************** TEST5AC *******************)

    Procedure test5ac;
    (* test of new and init *)
    const
    ni = 9;
    type
    t = 1..4;
    data = array( t ) of ^integer;
    data1 = array(0..2) of record
                             p : data;
                             ref : reference;
                             b : boolean;
                             mail : mailbox;
                             proc : process;
                           END;
    
    var
    a,c : integer;
    d :^data;
    d1: ^data1;
    b : boolean;
    
    
    begin
    
    WriteName(ZoneVar,"Test5AC");
    new(d);
$code
    new(d1);
$nocode
    d1^(0).b := true;
    for i := 1 to  4 do d1^(0).b := d1^(0).b and nil(d^(i));
    printBoolean(ZoneVar,d1^(0).b);   (* true *)
    IF Not d1^(0).b THEN EXIT;
    
    for i := 1 to 4 do new(d^(i));
    a:= 2;
    d^(2)^:= a;
    c:= d^(a)^ + ni;
    printinteger(ZoneVar, c );   (* 11 *)
    IF c <> 11 THEN EXIT;
    
    c := 0;
    for i := 1 to 4 do d^(i)^ := i;
    for i := 1 to 4 do c := c + d^(i)^;
    
    PrintInteger(ZoneVar,c);   (* 10 *)
    IF c <> 10 THEN EXIT;
    
    
    b := true;
    for i := 0 to 2 do
    begin
    for j := 1 to 4 do b := b and nil(d1^(i).p(j));
$code
    b := b and nil(d1^(i).Ref); 
$nocode   
    b := b and Passive(d1^(i).Mail); 
    b := b and nil(d1^(i).Proc); 
    end;
    printboolean(ZoneVar,b);  (* true *)
    IF b  THEN Test5OK := true;
    end;
    


   (******************* TEST5AD ***************)
   PROCEDURE TEST5AD;
    var i : integer := 100;
     Type
       data = array(1..1100) OF integer;
       data1 = array(1..i) of integer; 
       integer10=array(0..9) of integer;
    var d : ^data;
        d1 : ^data1;
        Sum,sum1,sum2 : integer := 0;
        d2 : array(1..100) of ^integer10;
    begin
      WriteName(ZoneVar,"Test5AD");
      new(d);
      for i := 1 to 1100 do d^(i) := 2;
      new(d1);
      For j := 1 TO i DO d1^(j) := 4;
      FOR i := 1 To 100 do BEGIN
                             new(d2(i));
                             for j:=0 to 9 do d2(i)^(j) := 3;
                           END;

      For j := 1 TO 1100 DO Sum := Sum + d^(j);
      For j := 1 TO i DO Sum1 := Sum1 + d1^(j);
      For j := 1 TO 100 DO
      For i := 0 to 9 do Sum2 := Sum2 + d2(j)^(i);
      PrintInteger(ZoneVar,Sum); (* 2200 *)
      PrintInteger(ZoneVar,Sum1); (* 400 *)
      PrintInteger(ZoneVar,Sum2); (* 3000 *)
      IF (Sum = 2200) AND (Sum1 = 400) AND (Sum2 = 3000) THEN Test5OK := true;
    END;




   (********************* TEST5CA ********************)
   (* declaretion  of shielded types*)
   PROCEDURE test5ca;
   
   var
   b : boolean;

   begin
   WriteName(ZoneVar,"Test5CA");
   b := nil(Test5CA_y);
   printboolean(ZoneVar, b);  (* true *);
   IF b <> true THEN EXIT;
   b := nil(Test5CA_e);
   printboolean(ZoneVar, b);  (* true *);
   IF b <> true THEN EXIT;
   b := passive(Test5CA_s);
   printboolean(ZoneVar, b);  (* true *);
   IF b <> true THEN EXIT;
   b := locked(Test5CA_s);
   PrintBoolean(ZoneVar, b); (* false *)
   IF b  THEN EXIT;
   b := Open(Test5CA_s);
   PrintBoolean(ZoneVar, b); (* false *)
   IF b <> true THEN Test5OK := True;
   
   end;





   (******************** TEST5CB *********************)
   (* initialize shielded types *)
   PROCEDURE test5cb;
   begin
$code
     WriteName(ZoneVar,"Test5CB");
     Test5CB_f.x := true;
     for i := 1 to 4 do
       Test5CB_f.x := Test5CB_f.x and passive(Test5CB_ss(i).m);
     printboolean(Zonevar,Test5CB_f.x);  (* true *)
     IF Test5CB_f.x <> true THEN EXIT;
$nocode   
     Test5CB_f.x := nil(Test5CB_f.l(1)) and nil(Test5CB_f.l(2));
     printBoolean(Zonevar,Test5CB_f.x);  (* true *)
     IF Test5CB_f.x <> true THEN EXIT;
   
     Test5CB_f.x := true;
     for i := -1 to 10 do
      Test5CB_f.x :=  nil(Test5CB_y(i)) and Test5CB_f.x;
     printBoolean(Zonevar,Test5CB_f.x);  (* true *)
     IF Test5CB_f.x THEN Test5OK := true;
   end;
   
   
   
   (******************* TEST5D **********************)
   (* shared variabel declaration *)
   Procedure test5d;
   const
   ni = 9;
   var j : integer;
   procedure addshared(shared x,y : integer);
   begin
     region x do region y do x := x  + y;
   end;
   
   
   procedure addvarparam(var x : integer; y : integer);
   begin
    x := x + y;
   end;
   
   
   
   procedure testshared(shared xx : integer ; shared yy : Boolean);
   begin
     Region xx do region yy do region Test5d_y do
   
       begin
         Test5d_y := 30;
         xx := 6;
         j := 1;
         region Test5d_arr do Test5d_arr(7) := 0;
         while yy do 
           begin
             if j = 6 then exit
             else region  Test5d_arr do  Test5d_arr(j) := j;
             j := j + 1;
           End;
       end;
   end;
   begin
     WriteName(ZoneVar,"Test5D");
     region Test5d_y do region Test5d_x do region Test5d_index do
       begin
         PrintInteger(ZoneVar,Test5d_y); (* 24*)
         IF test5d_y <> 24 THEN EXIT;
         PrintInteger(ZoneVar, Test5d_index); (* 24 *)
         IF Test5d_Index <> 24 THEN EXIT;
         PrintBoolean(ZoneVar, Test5d_x); (* true *)
         IF Test5d_x <> true THEN EXIT;
         region Test5d_y do region Test5d_f do
           begin
             Test5d_f.x := 5;
             Test5d_f.y := false;
           end;
       End;
   
   
     testshared(Test5d_y,Test5d_x);
   
     region Test5d_y do PrintInteger(ZoneVar,Test5d_y);   (* 6 *)
     Region Test5d_y do IF Test5d_y <> 6 THEN EXIT;
   
   
     region Test5d_y do
       begin
         addshared(Test5d_y,Test5d_y);
         PrintInteger(ZoneVar,Test5d_y); (* 12 *)
         IF Test5d_y <> 12 THEN EXIT;
       end;
   
     region Test5d_y do
       begin
         addvarparam(Test5d_y,Test5d_y);
         PrintInteger(ZoneVar,Test5d_y); (* 24 *)
         IF Test5d_y <> 24 THEN EXIT;
       
       end;
   
     region Test5d_f do region Test5d_index do
      Begin
        Test5d_index := 1;
        while Test5d_f.y = false do
         begin
          region Test5d_arr do
            if Test5d_arr(Test5d_index) = Test5d_f.x Then ExitLoop
            Else Test5d_arr(7) := Test5d_Arr(Test5d_index) + Test5d_arr(7);
          Test5d_index := Test5d_index + 1;
         end;
      end;
   
    region Test5d_arr do PrintInteger(ZoneVar,Test5d_arr(7)) ;  (* 10 *)
    region test5d_arr do If test5d_arr(7) = 10 THEN Test5OK := true;
   
   
   
   end;


  (************************* TEST5DA ******************************)
  PROGRAM Test5da(shared finish : boolean; shared Test5DAOK : boolean);
  EXTERNAL;


  (************************ TEST5DB ************************)
    (* shared variabel declaration  with  dynamic type *)
    PROCEDURE test5db;
    
     
    
    var j : integer;
    
    procedure addshared(shared x,y : integer);
    begin
      region x do region y do x := x  + y;
    end;
    
    
    procedure addvarparam(var x : integer; y : integer);
    begin
     x := x + y;
    end;
    
    
    
    procedure testshared(shared xx : integer ; shared yy : Boolean);
    begin
      Region xx do region yy do region Test5db_y do
    
        begin
          Test5db_y := 30;
          xx := 6;
          j := 1;
          region Test5db_arr do Test5db_arr(7) := 0;
          while yy do 
            begin
              if j = 6 then exit
              else region Test5db_arr do Test5db_arr(j) := j;
              j := j + 1;
            End;
        end;
    end;
    begin
      WriteName(ZoneVar,"Test5DB");
      region Test5db_y do region Test5db_x do region Test5db_index do
        begin
          PrintInteger(ZoneVar, Test5db_y); (* 24*)
          IF Test5db_y <> 24 THEN EXIT;
          PrintInteger(ZoneVar, Test5db_index); (* 24 *)
          IF Test5db_Index <> 24 THEN EXIT;
          PrintBoolean(ZoneVar, Test5db_x); (* true *)
          IF Test5db_x <> True THEN EXIT;
          region Test5db_y do region Test5db_f do
            begin
              Test5db_f.x := 5;
              Test5db_f.y := false;
            end;
        End;
    
    
      testshared(Test5db_y,Test5db_x);
    
      region Test5db_y do PrintInteger(ZoneVar, Test5db_y);   (* 6 *)
      region Test5db_y Do IF Test5db_y <> 6 THEN EXIT;
    
    
      region Test5db_y do
        begin
          addshared(Test5db_y,Test5db_y);
          PrintInteger(ZoneVar, Test5db_y); (* 12 *)
          IF Test5db_y <> 12 THEN EXIT;
        end;
    
      region Test5db_y do
        begin
          addvarparam(Test5db_y,Test5db_y);
          PrintInteger(ZoneVar, Test5db_y); (* 24 *)
          IF Test5db_y <> 24 THEN EXIT;
        end;
    
      region Test5db_f do region Test5db_index do
       Begin
         Test5db_index := 1;
         while Test5db_f.y = false do
          begin
           region Test5db_arr do
             if Test5db_arr(Test5db_index) = Test5db_f.x Then ExitLoop
             Else Test5db_arr(7) := Test5db_Arr(Test5db_index) + Test5db_arr(7);
           Test5db_index := Test5db_index + 1;
          end;
       end;
    
     region Test5db_arr do PrintInteger(ZoneVar, Test5db_arr(7)) ;  (* 10 *)
     region Test5DB_arr do IF Test5db_arr(7) = 10 THEN Test5OK := true;
    
    
    end;





begin  (* Main program *)

  WriteName(ZoneVar,"TESTVERSION5");


  (********************* TEST5A ***************)
  Test5OK := false;
  Test5A;
  IF Test5OK = false THEN GOTO ExitError;


  (********************* TEST5AA ***************)
  Test5OK := false;
  Test5AA;
  IF Test5OK = false THEN GOTO ExitError;


  (********************* TEST5AB ***************)
  Test5OK := false;
  Test5AB;
  IF Test5OK = false THEN GOTO ExitError;


  (********************* TEST5AC ***************)
  Test5OK := false;
  Test5AC;
  IF Test5OK = false THEN GOTO ExitError;




  (********************* TEST5AD ***************)
  Test5OK := false;
  Test5AD;
  IF Test5OK = false THEN GOTO ExitError;

  (********************* TEST5CA ***************)
  Test5OK := false;
  Test5CA;
  IF Test5OK = false THEN GOTO ExitError;



  (********************* TEST5CB ***************)
  Test5OK := false;
  Test5CB;
  IF Test5OK = false THEN GOTO ExitError;



  (********************* TEST5D ***************)
  Test5OK := false;
  Test5D;
  IF Test5OK = false THEN GOTO ExitError;

  (*********************** TEST5DA ************************)
  LinkOk := Link("TEST5DA",test5da);

  PrintInteger(ZoneVar,ord(LinkOK));
  IF LinkOK <> Link_OK THEN GOTO EXitError;
  region test5daok do test5daok := false;
  region test5daend do test5daend := false;
  createok := Create("test5da", Test5da(test5daend,test5daok),Process5da,2000,stdpriority);
  PrintInteger(ZoneVar,ord(CreateOK));
  IF CreateOK <> Create_OK THEN GOTO EXitError;

  OK1 := false;
  WHILE Not OK1 do 
     begin
       REGION test5daEnd do OK1 := test5daEnd;
       delay(2);
     end;
  (* test5da finish *)
  REGION test5daOK do  OK1 := test5daOK ;
  IF OK1 = false THEN GOTO ExitError;
  remove(Process5da); 



  (********************* TEST5DB ***************)
  Test5OK := false;
  Test5DB;
  IF Test5OK = false THEN GOTO ExitError;


  WriteChar(ZoneVar,'*');
  WriteChar(ZoneVar,'O');
  WriteChar(ZoneVar,'K');
  WriteChar(ZoneVar,'5');
  WriteChar(ZoneVar,'*');
  region OK do OK := true;
  region fin do fin := true;
  EXIT;
  ExitError:
  WriteChar(ZoneVar,'*');
  WriteChar(ZoneVar,'N');
  WriteChar(ZoneVar,'O');
  WriteChar(ZoneVar,'T');
  WriteChar(ZoneVar,' ');
  WriteChar(ZoneVar,'O');
  WriteChar(ZoneVar,'K');
  WriteChar(ZoneVar,'5');
  region OK do OK := false;
  region fin do fin := true;
end;


  (************************* TEST5DA ******************************)
  PROGRAM Test5da(shared finish : boolean; shared Test5DAOK : boolean);
  (* test of shared variabel and the following routines
     create, link, unlink,remove, resume, stop  *)
  Shared x : integer;
         ArrVal : ArrType;
  VAR   ProcessArr : Array(1..3) Of Process;
        LR : Link_Result;
        Ul : UnLink_Result;
        CRes : Create_Result;
        ZoneVar : inoutzone;
        FirstTime : boolean := true;
        OK : Boolean := true;

  Program P1(Shared x : integer; Shared ArrVal : ArrType); External;
  Program P2(Shared x : integer; Shared ArrVal : ArrType; ProcessNo : integer);
    Var ZoneVar : inoutzone;
        sss : integer;
    BEGIN
      WriteName(ZoneVar,"P2");
      For i := 1 TO 1000 Do
        Region x do Region ArrVal do
          Begin
            x := x + 1;
            ArrVal(ProcessNo) := ArrVal(ProcessNo) + 1;
            if ArrVal(ProcessNo) = 500 then
              begin
                PrintInteger(ZoneVar,processNo);
                PrintInteger(ZoneVar,x);
              end;
              
          End;
    END;

  BEGIN
    WriteName(ZoneVar,"Test5DA");
$IF target = ta
    FOR i := 1 TO 1 DO
$ELSE
    for i := 1 to 2 DO
$ENDIF
      BEGIN
        region x do x := 0;
        region arrval do for i := 1 to 3 do arrval(i) := 0;
    
        IF FirstTime THEN LR := Link("EXTERNALP1",P1);
        FirstTime := false;
        PrintInteger(ZoneVar,ord(LR));
        CRes := Create("Pro1",P1(x,ArrVal),ProcessArr(1),2000,stdpriority);
        PrintInteger(ZoneVar,ord(CRes));
        CRes := Create("Pro2",P2(x,ArrVal,2),ProcessArr(2),2000,stdpriority);
        PrintInteger(ZoneVar,ord(CRes));
        CRes := Create("Pro3",P2(x,ArrVal,3),ProcessArr(3),2000,stdpriority);
        PrintInteger(ZoneVar,ord(CRes));
        region x do region arrval do
          begin
--            stop(processArr(1));
--            stop(processArr(2));
          end;
    
        loop
--          Resume(processArr(1));
--          Resume(processArr(2));
          region x do 
           Begin
            if x = 3000 then exitloop;
            region  arrVal do if x <> ( arrVal(1) + ArrVal(2) + ArrVal(3))
                                then exitloop;
           end;
          delay(2);
        endloop; 
           
        region x do 
           begin
             printinteger(ZoneVar,x);  (* 3000*)
             IF x <> 3000 THEN 
                 region finish do 
                   begin
                     finish := true;
                     EXIT;
                   END;
           end;
        
    
        region ArrVal do For i := 1 TO 3 do 
          BEGIN
             PrintInteger(ZoneVar,ArrVal(i));  (* 1000 *)
             IF ArrVal(i) <> 1000 THEN 
                 region finish do 
                   begin
                     finish := true;
                     EXIT;
                   END;
          end;
    

        FOR i := 1 TO 3 DO 
        begin
          trace(1024+i);
          ReMove(ProcessArr(i));
        end; 
      END;   
    Ul := UnLink(P1);
    PrintInteger(ZoneVar,ord(Ul));
    IF ord(UL) = 0 THEN Region test5daOK do test5daOK := true;

    Region finish do finish := true;
  end;
    
  Program EXTERNALP1(Shared x : integer; Shared ArrVal : ArrType);

    Var ZoneVar : inoutzone;
         sss : integer;

    BEGIN
      WriteName(ZoneVar,"EXTERNALP1");
      For i := 1 TO 1000 Do
        Region x do Region ArrVal do
          Begin
            x := x + 1;
            ArrVal(1) := ArrVal(1) + 1;
            IF arrVal(1) = 500 then 
              BEGIN
                 PrintInteger(ZoneVar,1);
                 PrintInteger(ZoneVar,x);
              END;
          End;
    END
.