PR modula2/109830 m2iso library SeqFile.mod appending to a file overwrites content

This patch is for the m2iso library SeqFile.mod to fix a bug when a
file is opened using OpenAppend.  The patch checks to see if the file
exists and it uses FIO.OpenForRandom to ensure the file is not
overwritten.

gcc/m2/ChangeLog:

	PR modula2/109830
	* gm2-libs-iso/SeqFile.mod (newCid): New parameter toAppend
	used to select FIO.OpenForRandom.
	(OpenRead): Pass extra parameter to newCid.
	(OpenWrite): Pass extra parameter to newCid.
	(OpenAppend): Pass extra parameter to newCid.

gcc/testsuite/ChangeLog:

	PR modula2/109830
	* gm2/isolib/run/pass/seqappend.mod: New test.

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

2 files changed, 101 insertions, 21 deletions

diff --git a/gcc/m2/gm2-libs-iso/SeqFile.mod b/gcc/m2/gm2-libs-iso/SeqFile.mod
index e29065a..dd5d04d 100644
--- a/gcc/m2/gm2-libs-iso/SeqFile.mod
+++ b/gcc/m2/gm2-libs-iso/SeqFile.mod
@@ -150,7 +150,7 @@ END checkOpenErrno ;
 PROCEDURE newCid (fname: ARRAY OF CHAR;
                   f: FlagSet;
                   VAR res: OpenResults;
-                  toRead: BOOLEAN;
+                  toRead, toAppend: BOOLEAN;
                   whichreset: ResetProc) : ChanId ;
 VAR
    c   : RTio.ChanId ;
@@ -158,19 +158,22 @@ VAR
    e   : INTEGER ;
    p   : DeviceTablePtr ;
 BEGIN
-   IF toRead
+   IF toAppend
    THEN
-      file := FIO.OpenToRead(fname)
+      file := FIO.OpenForRandom (fname, NOT toRead, NOT FIO.Exists (fname))
+   ELSIF toRead
+   THEN
+      file := FIO.OpenToRead (fname)
    ELSE
-      file := FIO.OpenToWrite(fname)
+      file := FIO.OpenToWrite (fname)
    END ;
-   checkOpenErrno(file, e, res) ;
+   checkOpenErrno (file, e, res) ;
 
-   IF FIO.IsNoError(file)
+   IF FIO.IsNoError (file)
    THEN
-      MakeChan(did, c) ;
-      RTio.SetFile(c, file) ;
-      p := DeviceTablePtrValue(c, did) ;
+      MakeChan (did, c) ;
+      RTio.SetFile (c, file) ;
+      p := DeviceTablePtrValue (c, did) ;
       WITH p^ DO
          flags := f ;
          errNum := e ;
@@ -189,7 +192,7 @@ BEGIN
       END ;
       RETURN( c )
    ELSE
-      RETURN( IOChan.InvalidChan() )
+      RETURN( IOChan.InvalidChan () )
    END
 END newCid ;
 
@@ -213,7 +216,7 @@ BEGIN
    THEN
       INCL(flags, ChanConsts.textFlag)
    END ;
-   cid := newCid(name, flags, res, FALSE, resetWrite)
+   cid := newCid(name, flags, res, FALSE, FALSE, resetWrite)
 END OpenWrite ;
 
 
@@ -235,7 +238,7 @@ BEGIN
    THEN
       INCL(flags, ChanConsts.textFlag)
    END ;
-   cid := newCid(name, flags, res, TRUE, resetRead)
+   cid := newCid(name, flags, res, TRUE, FALSE, resetRead)
 END OpenRead ;
 
 
@@ -250,7 +253,7 @@ END OpenRead ;
                 length of the file.  If a channel cannot be opened
                 as required, the value of res indicates the reason,
                 and cid identifies the invalid channel.
-  *)
+*)
 
 PROCEDURE OpenAppend (VAR cid: ChanId; name: ARRAY OF CHAR;
                       flags: FlagSet; VAR res: OpenResults) ;
@@ -258,13 +261,13 @@ BEGIN
    flags := flags + ChanConsts.write + ChanConsts.old ;
    IF NOT (ChanConsts.rawFlag IN flags)
    THEN
-      INCL(flags, ChanConsts.textFlag)
+      INCL (flags, ChanConsts.textFlag)
    END ;
-   cid := newCid(name, flags, res, FALSE, resetAppend) ;
+   cid := newCid (name, flags, res, FALSE, TRUE, resetAppend) ;
    IF IsSeqFile(cid)
    THEN
-      FIO.SetPositionFromEnd(RTio.GetFile(cid), 0) ;
-      checkErrno(dev, RTio.GetDevicePtr(cid))
+      FIO.SetPositionFromEnd (RTio.GetFile (cid), 0) ;
+      checkErrno (dev, RTio.GetDevicePtr (cid))
    END
 END OpenAppend ;
 
@@ -287,7 +290,7 @@ END resetAppend ;
 
 
 (*
-   resetRead - 
+   resetRead -
 *)
 
 PROCEDURE resetRead (d: DeviceTablePtr) ;
@@ -297,7 +300,7 @@ END resetRead ;
 
 
 (*
-   resetWrite - 
+   resetWrite -
 *)
 
 PROCEDURE resetWrite (d: DeviceTablePtr) ;
@@ -392,7 +395,7 @@ END Rewrite ;
 
 
 (*
-   handlefree - 
+   handlefree -
 *)
 
 PROCEDURE handlefree (d: DeviceTablePtr) ;
@@ -434,7 +437,7 @@ END Close ;
 
 
 (*
-   Init - 
+   Init -
 *)
 
 PROCEDURE Init ;
diff --git a/gcc/testsuite/gm2/isolib/run/pass/seqappend.mod b/gcc/testsuite/gm2/isolib/run/pass/seqappend.mod
new file mode 100644
index 0000000..1443196
--- /dev/null
+++ b/gcc/testsuite/gm2/isolib/run/pass/seqappend.mod
@@ -0,0 +1,77 @@
+MODULE seqappend ;
+
+FROM ChanConsts IMPORT OpenResults, old, raw, write, read ;
+FROM IOChan IMPORT ChanId, RawWrite, RawRead ;
+FROM SYSTEM IMPORT ADR;
+FROM libc IMPORT exit, printf ;
+FROM StrLib IMPORT StrEqual ;
+IMPORT StreamFile;
+IMPORT SeqFile;
+
+
+PROCEDURE stress ;
+VAR
+   cid   : ChanId ;
+   res   : OpenResults;
+   str   : ARRAY [0..20] OF CHAR ;
+   actual: CARDINAL ;
+   code  : INTEGER ;
+BEGIN
+   code := 0 ;
+   str := '0123456789' ;
+
+   (* Open file and create data.  *)
+   StreamFile.Open (cid, 'testdata', write+old+raw, res) ;
+   IF res = opened
+   THEN
+      (* Now write data creating new contents.  *)
+      RawWrite (cid, ADR (str), 10) ;
+      StreamFile.Close(cid)
+   ELSE
+      printf ("failed to open file for write\n") ;
+      code := 2
+   END ;
+
+   str := 'abcdefghij' ;
+   (* Now attempt to append the alphabetic str.  *)
+   SeqFile.OpenAppend (cid, 'testdata', write+old+raw, res) ;
+   IF res = opened
+   THEN
+      RawWrite (cid, ADR (str), 10);
+      SeqFile.Close (cid)
+   ELSE
+      printf ("failed to open file for append\n") ;
+      code := 3
+   END ;
+
+   (* And now test the file for the appended data.  *)
+   StreamFile.Open (cid, 'testdata', read+raw, res) ;
+   IF res = opened
+   THEN
+      (* Now check the new contents for the appended data.  *)
+      RawRead (cid, ADR (str), 20, actual) ;
+      IF actual # 20
+      THEN
+         printf ("short read occurred: %d...\n", actual) ;
+         code := 5
+      END ;
+      StreamFile.Close (cid) ;
+      str[20] := 0C ;
+      IF StrEqual (str, '0123456789abcdefghij')
+      THEN
+         printf ("append test passed\n")
+      ELSE
+         printf ("append test failed\n") ;
+         code := 1
+      END
+   ELSE
+      printf ("failed to open result file\n") ;
+      code := 4
+   END ;
+   exit (code)
+END stress ;
+
+
+BEGIN
+   stress
+END seqappend.