PR modula2/110631 Bugfix to FIO WriteCardinal

FIO.WriteCardinal fails to write binary data.  This patch fixes two
bugs in FIO.mod and provides a testcase which writes and reads binary
cardinals.  There was an off by one error when using HIGH (a) to
determine the number of bytes and the dest/src pointers were switched
when calling memcpy.

gcc/m2/ChangeLog:

	PR modula2/110631
	* gm2-libs/FIO.def (ReadAny): Correct comment as
	HIGH (a) + 1 is number of bytes.
	(WriteAny): Correct comment as HIGH (a) + 1 is number of
	bytes.
	* gm2-libs/FIO.mod (ReadAny): Correct comment as
	HIGH (a) + 1 is number of bytes.  Also pass HIGH (a) + 1
	to BufferedRead.
	(WriteAny): Correct comment as HIGH (a) + 1 is number of
	bytes.	Also pass HIGH (a) + 1 to BufferedWrite.
	(BufferedWrite): Rename parameter a to src, rename variable
	t to dest.  Correct parameter order to memcpy.

gcc/testsuite/ChangeLog:

	PR modula2/110631
	* gm2/pimlib/run/pass/testfiobinary.mod: New test.

Signed-off-by: Gaius Mulley <gaiusmod2@gmail.com>

diff --git a/gcc/m2/gm2-libs/FIO.def b/gcc/m2/gm2-libs/FIO.def
index f521ef6a6312ebd8c572c71213a5960ec826fd63..f4c201fe31d01a44ddb968cffedf1a0f4354ba2f 100644 (file)
--- a/gcc/m2/gm2-libs/FIO.def
+++ b/gcc/m2/gm2-libs/FIO.def
@@ -159,7 +159,7 @@ PROCEDURE ReadNBytes (f: File; nBytes: CARDINAL;
 
 
 (*
-   ReadAny - reads HIGH(a) bytes into, a. All input
+   ReadAny - reads HIGH (a) + 1 bytes into, a.  All input
              is fully buffered, unlike ReadNBytes and thus is more
              suited to small reads.
 *)
@@ -180,7 +180,7 @@ PROCEDURE WriteNBytes (f: File; nBytes: CARDINAL;
 
 
 (*
-   WriteAny - writes HIGH(a) bytes onto, file, f. All output
+   WriteAny - writes HIGH (a) + 1 bytes onto, file, f.  All output
               is fully buffered, unlike WriteNBytes and thus is more
               suited to small writes.
 *)

diff --git a/gcc/m2/gm2-libs/FIO.mod b/gcc/m2/gm2-libs/FIO.mod
index 1f3e22ed6c5e8d1f5ab6ffa97f79c22bb7af9690..dd6f48c446f2497527d21ddc8f121804ffbec8f4 100644 (file)
--- a/gcc/m2/gm2-libs/FIO.mod
+++ b/gcc/m2/gm2-libs/FIO.mod
@@ -1083,7 +1083,7 @@ END UnReadChar ;
 
 
 (*
-   ReadAny - reads HIGH(a) bytes into, a. All input
+   ReadAny - reads HIGH (a) + 1 bytes into, a.  All input
              is fully buffered, unlike ReadNBytes and thus is more
              suited to small reads.
 *)
@@ -1091,9 +1091,9 @@ END UnReadChar ;
 PROCEDURE ReadAny (f: File; VAR a: ARRAY OF BYTE) ;
 BEGIN
    CheckAccess(f, openedforread, FALSE) ;
-   IF BufferedRead (f, HIGH (a), ADR (a)) = VAL (INTEGER, HIGH (a))
+   IF BufferedRead (f, HIGH (a) + 1, ADR (a)) = VAL (INTEGER, HIGH (a) + 1)
    THEN
-      SetEndOfLine(f, a[HIGH(a)])
+      SetEndOfLine (f, a[HIGH(a)])
    END
 END ReadAny ;
 
@@ -1232,51 +1232,51 @@ END WriteNBytes ;
                    Useful when performing small writes.
 *)
 
-PROCEDURE BufferedWrite (f: File; nBytes: CARDINAL; a: ADDRESS) : INTEGER ;
+PROCEDURE BufferedWrite (f: File; nBytes: CARDINAL; src: ADDRESS) : INTEGER ;
 VAR
-   t     : ADDRESS ;
+   dest  : ADDRESS ;
    total,
    n     : INTEGER ;
    p     : POINTER TO BYTE ;
    fd    : FileDescriptor ;
 BEGIN
-   IF f#Error
+   IF f # Error
    THEN
-      fd := GetIndice(FileInfo, f) ;
+      fd := GetIndice (FileInfo, f) ;
       IF fd#NIL
       THEN
          total := 0 ;   (* how many bytes have we read *)
          WITH fd^ DO
-            IF buffer#NIL
+            IF buffer # NIL
             THEN
                WITH buffer^ DO
-                  WHILE nBytes>0 DO
+                  WHILE nBytes > 0 DO
                      (* place into the buffer first *)
-                     IF left>0
+                     IF left > 0
                      THEN
-                        IF nBytes=1
+                        IF nBytes = 1
                         THEN
                            (* too expensive to call memcpy for 1 character *)
-                           p := a ;
+                           p := src ;
                            contents^[position] := p^ ;
-                           DEC(left) ;         (* reduce space                        *)
-                           INC(position) ;     (* move onwards n byte                 *)
-                           INC(total) ;
+                           DEC (left) ;         (* reduce space                        *)
+                           INC (position) ;     (* move onwards n byte                 *)
+                           INC (total) ;
                            RETURN( total )
                         ELSE
-                           n := Min(left, nBytes) ;
-                           t := address ;
-                           INC(t, position) ;
-                           p := memcpy(a, t, CARDINAL(n)) ;
-                           DEC(left, n) ;      (* remove consumed bytes               *)
-                           INC(position, n) ;  (* move onwards n bytes                *)
-                                               (* move ready for further writes       *)
-                           INC(a, n) ;
-                           DEC(nBytes, n) ;    (* reduce the amount for future writes *)
-                           INC(total, n)
+                           n := Min (left, nBytes) ;
+                           dest := address ;
+                           INC (dest, position) ;
+                           p := memcpy (dest, src, CARDINAL (n)) ;
+                           DEC (left, n) ;      (* remove consumed bytes               *)
+                           INC (position, n) ;  (* move onwards n bytes                *)
+                                                (* move ready for further writes       *)
+                           INC (src, n) ;
+                           DEC (nBytes, n) ;    (* reduce the amount for future writes *)
+                           INC (total, n)
                         END
                      ELSE
-                        FlushBuffer(f) ;
+                        FlushBuffer (f) ;
                         IF (state#successful) AND (state#endofline)
                         THEN
                            nBytes := 0
@@ -1329,7 +1329,7 @@ END FlushBuffer ;
 
 
 (*
-   WriteAny - writes HIGH(a) bytes onto, file, f. All output
+   WriteAny - writes HIGH (a) + 1 bytes onto, file, f.  All output
               is fully buffered, unlike WriteNBytes and thus is more
               suited to small writes.
 *)
@@ -1337,7 +1337,7 @@ END FlushBuffer ;
 PROCEDURE WriteAny (f: File; VAR a: ARRAY OF BYTE) ;
 BEGIN
    CheckAccess (f, openedforwrite, TRUE) ;
-   IF BufferedWrite (f, HIGH (a), ADR (a)) = VAL (INTEGER, HIGH (a))
+   IF BufferedWrite (f, HIGH (a) + 1, ADR (a)) = VAL (INTEGER, HIGH (a) + 1)
    THEN
    END
 END WriteAny ;

diff --git a/gcc/testsuite/gm2/pimlib/run/pass/testfiobinary.mod b/gcc/testsuite/gm2/pimlib/run/pass/testfiobinary.mod
new file mode 100644 (file)
index 0000000..06feb84
--- /dev/null
+++ b/gcc/testsuite/gm2/pimlib/run/pass/testfiobinary.mod
@@ -0,0 +1,89 @@
+MODULE testfiobinary ;
+
+(* Simple test to stress FIO.WriteCardinal.  *)
+
+FROM FIO IMPORT WriteCardinal, File, OpenToRead, OpenToWrite, Close, ReadNBytes, IsNoError, ReadCardinal ;
+FROM libc IMPORT exit, printf ;
+
+
+CONST
+   OutputName = "binary.bin" ;
+   Debugging = TRUE ;
+
+
+PROCEDURE Check (bool: BOOLEAN) ;
+BEGIN
+   IF NOT bool
+   THEN
+      printf ("check assert failed\n");
+      exit (1)
+   END
+END Check ;
+
+
+PROCEDURE Write (f: File; card: CARDINAL) ;
+BEGIN
+   WriteCardinal (f, card)
+END Write ;
+
+
+PROCEDURE Read (f: File; card: CARDINAL) ;
+VAR
+   value: CARDINAL ;
+BEGIN
+   value := ReadCardinal (f) ;
+   IF value # card
+   THEN
+      printf ("Read failed to read cardinal value, expecting %d and read %d\n",
+              card, value) ;
+      exit (2)
+   END
+END Read ;
+
+
+PROCEDURE CreateBinary ;
+VAR
+   f: File ;
+BEGIN
+   f := OpenToWrite (OutputName) ;
+   Check (IsNoError (f)) ;
+   IF SIZE (CARDINAL) >= 4
+   THEN
+      Write (f, 012345678H)
+   END ;
+   Write (f, 0) ;
+   Write (f, 1) ;
+   Write (f, 2) ;
+   Write (f, 3) ;
+   Write (f, 1000) ;
+   Write (f, 1024) ;
+   Write (f, 32767) ;
+   Close (f)
+END CreateBinary ;
+
+
+PROCEDURE CheckBinary ;
+VAR
+   f: File ;
+BEGIN
+   f := OpenToRead (OutputName) ;
+   Check (IsNoError (f)) ;
+   IF SIZE (CARDINAL) >= 4
+   THEN
+      Read (f, 012345678H)
+   END ;
+   Read (f, 0) ;
+   Read (f, 1) ;
+   Read (f, 2) ;
+   Read (f, 3) ;
+   Read (f, 1000) ;
+   Read (f, 1024) ;
+   Read (f, 32767) ;
+   Close (f)
+END CheckBinary ;
+
+
+BEGIN
+   CreateBinary ;
+   CheckBinary
+END testfiobinary.