TP3/shell/tests/OpenArrTest.mod

MODULE OpenArrTest ;

(* Minimal probe: do open-array formals actually propagate writes back to the
   caller's buffer under gm2 -fiso?  Linker.WriteCom builds its path with
   ZCopy(dst : ARRAY OF CHAR ; src : ARRAY OF CHAR) and the file it created
   was named "END" - i.e. the destination buffer was never written.  Before
   working around it, measure it.

   Prints what each variant leaves in its buffer, so the answer is a run and
   not an opinion. *)

FROM Posix IMPORT write ;
FROM SYSTEM IMPORT ADR ;

PROCEDURE PutStr (s : ARRAY OF CHAR) ;
VAR i : CARDINAL ; n : LONGINT ;
BEGIN
   i := 0 ;
   WHILE (i <= HIGH (s)) AND (s [i] # 0C) DO
      n := write (1, ADR (s [i]), 1) ;
      INC (i)
   END
END PutStr ;

PROCEDURE NL ;
VAR n : LONGINT ; c : ARRAY [0..1] OF CHAR ;
BEGIN
   c [0] := CHR (13) ; c [1] := CHR (10) ;
   n := write (1, ADR (c), 2)
END NL ;

(* open array, value formal *)
PROCEDURE FillOpen (VAR dst : ARRAY OF CHAR ; src : ARRAY OF CHAR) ;
VAR i : CARDINAL ;
BEGIN
   i := 0 ;
   WHILE (i <= HIGH (dst) - 1) AND (i <= HIGH (src)) AND (src [i] # 0C) DO
      dst [i] := src [i] ;
      INC (i)
   END ;
   dst [i] := 0C
END FillOpen ;

(* open array, no VAR - forces a copy, so writes cannot escape *)
PROCEDURE FillOpenVal (dst : ARRAY OF CHAR ; src : ARRAY OF CHAR) ;
VAR i : CARDINAL ;
BEGIN
   i := 0 ;
   WHILE (i <= HIGH (dst) - 1) AND (i <= HIGH (src)) AND (src [i] # 0C) DO
      dst [i] := src [i] ;
      INC (i)
   END ;
   dst [i] := 0C
END FillOpenVal ;

TYPE
   Buf = ARRAY [0..63] OF CHAR ;

(* fixed array, VAR formal *)
PROCEDURE FillFixed (VAR dst : Buf ; src : Buf) ;
VAR i : CARDINAL ;
BEGIN
   i := 0 ;
   WHILE (i <= HIGH (dst) - 1) AND (i <= HIGH (src)) AND (src [i] # 0C) DO
      dst [i] := src [i] ;
      INC (i)
   END ;
   dst [i] := 0C
END FillFixed ;

VAR
   a, b, c : Buf ;
   src     : Buf ;

BEGIN
   (* seed src *)
   src [0] := "A" ; src [1] := "B" ; src [2] := "C" ; src [3] := 0C ;

   a := "XXXXXXXXXXXXXXXX" ;
   FillOpen (a, src) ;
   PutStr ("FillOpen   (VAR dst : ARRAY OF CHAR) -> [") ; PutStr (a) ; PutStr ("]") ; NL ;

   b := "XXXXXXXXXXXXXXXX" ;
   FillOpenVal (b, src) ;
   PutStr ("FillOpenVal(dst  : ARRAY OF CHAR) -> [") ; PutStr (b) ; PutStr ("]") ; NL ;

   c := "XXXXXXXXXXXXXXXX" ;
   FillFixed (c, src) ;
   PutStr ("FillFixed  (VAR dst : Buf)       -> [") ; PutStr (c) ; PutStr ("]") ; NL
END OpenArrTest.