https://gcc.gnu.org/g:84ad0d86df69b3c1b5970efa490eeafc5266802a
commit r16-6211-g84ad0d86df69b3c1b5970efa490eeafc5266802a Author: Gaius Mulley <[email protected]> Date: Wed Dec 17 13:00:33 2025 +0000 PR modula2/123151: Unable to use IsNoError with Close in FIO library module This is a bug fix to the library module FIO to allow Close to return a boolean indicating success. Most probably in the future there should be a GetStatus procedure provided and the FileStatus enumeration inside FIO.mod should also be exported. gcc/m2/ChangeLog: PR modula2/123151 * gm2-libs/FIO.def (IsError): New procedure function. (IsActive): Rewrite the comment. (Exists): Ditto. (OpenToRead): Ditto. (OpenToWrite): Ditto. (Close): Add an optional BOOLEAN return result. * gm2-libs/FIO.mod (Close): Reimplement with an optional BOOLEAN return result. gcc/testsuite/ChangeLog: PR modula2/123151 * gm2/pimlib/base/run/pass/FIO.mod: Reimplement. Copy from gm2-libs/FIO.mod since FIO.def api has changed. * gm2/pimlib/run/pass/testclose.mod: New test. Signed-off-by: Gaius Mulley <[email protected]> Diff: --- gcc/m2/gm2-libs/FIO.def | 30 ++-- gcc/m2/gm2-libs/FIO.mod | 53 +++++-- gcc/testsuite/gm2/pimlib/base/run/pass/FIO.mod | 181 +++++++++++++----------- gcc/testsuite/gm2/pimlib/run/pass/testclose.mod | 41 ++++++ 4 files changed, 202 insertions(+), 103 deletions(-) diff --git a/gcc/m2/gm2-libs/FIO.def b/gcc/m2/gm2-libs/FIO.def index 276536143fe5..8f502dec3d4f 100644 --- a/gcc/m2/gm2-libs/FIO.def +++ b/gcc/m2/gm2-libs/FIO.def @@ -35,7 +35,7 @@ EXPORT QUALIFIED (* types *) File, (* procedures *) OpenToRead, OpenToWrite, OpenForRandom, Close, - EOF, EOLN, WasEOLN, IsNoError, Exists, IsActive, + EOF, EOLN, WasEOLN, IsError, IsNoError, Exists, IsActive, exists, openToRead, openToWrite, openForRandom, SetPositionFromBeginning, SetPositionFromEnd, @@ -55,35 +55,42 @@ EXPORT QUALIFIED (* types *) TYPE File = CARDINAL ; -(* the following variables are initialized to their UNIX equivalents *) +(* The following variables are initialized to their UNIX equivalents. *) VAR StdIn, StdOut, StdErr: File ; (* - IsNoError - returns a TRUE if no error has occured on file, f. + IsNoError - returns TRUE if no error has occured on file f. *) PROCEDURE IsNoError (f: File) : BOOLEAN ; (* - IsActive - returns TRUE if the file, f, is still active. + IsError - returns TRUE if an error has occured on file f. +*) + +PROCEDURE IsError (f: File) : BOOLEAN ; + + +(* + IsActive - returns TRUE if the file f is still active. *) PROCEDURE IsActive (f: File) : BOOLEAN ; (* - Exists - returns TRUE if a file named, fname exists for reading. + Exists - returns TRUE if a file fname exists for reading. *) PROCEDURE Exists (fname: ARRAY OF CHAR) : BOOLEAN ; (* - OpenToRead - attempts to open a file, fname, for reading and + OpenToRead - attempts to open a file fname for reading and it returns this file. The success of this operation can be checked by calling IsNoError. @@ -93,7 +100,7 @@ PROCEDURE OpenToRead (fname: ARRAY OF CHAR) : File ; (* - OpenToWrite - attempts to open a file, fname, for write and + OpenToWrite - attempts to open a file fname for write and it returns this file. The success of this operation can be checked by calling IsNoError. @@ -103,7 +110,7 @@ PROCEDURE OpenToWrite (fname: ARRAY OF CHAR) : File ; (* - OpenForRandom - attempts to open a file, fname, for random access + OpenForRandom - attempts to open a file fname for random access read or write and it returns this file. The success of this operation can be checked by calling IsNoError. @@ -124,9 +131,14 @@ PROCEDURE OpenForRandom (fname: ARRAY OF CHAR; Close - close a file which has been previously opened using: OpenToRead, OpenToWrite, OpenForRandom. It is correct to close a file which has an error status. + Close has an optional return value: + TRUE signifies that the close was successful and all + state associated with f is deallocated. + FALSE signifies that the close was unsuccessful and no + state associated with f has been deallocated. *) -PROCEDURE Close (f: File) ; +PROCEDURE Close (f: File) : [BOOLEAN] ; (* the following functions are functionally equivalent to the above diff --git a/gcc/m2/gm2-libs/FIO.mod b/gcc/m2/gm2-libs/FIO.mod index 8fa43e4b1c6f..dbe84a60cf81 100644 --- a/gcc/m2/gm2-libs/FIO.mod +++ b/gcc/m2/gm2-libs/FIO.mod @@ -194,7 +194,7 @@ END GetNextFreeDescriptor ; (* - IsNoError - returns a TRUE if no error has occured on file, f. + IsNoError - returns a TRUE if no error has occured on file f. *) PROCEDURE IsNoError (f: File) : BOOLEAN ; @@ -211,6 +211,24 @@ BEGIN END IsNoError ; +(* + IsError - returns a TRUE if an error has occured on file f. +*) + +PROCEDURE IsError (f: File) : BOOLEAN ; +VAR + fd: FileDescriptor ; +BEGIN + IF f=Error + THEN + RETURN( FALSE ) + ELSE + fd := GetIndice (FileInfo, f) ; + RETURN( (fd#NIL) AND ((fd^.state#successful) AND (fd^.state#endoffile) AND (fd^.state#endofline)) ) + END +END IsError ; + + (* IsActive - returns TRUE if the file, f, is still active. *) @@ -474,28 +492,32 @@ END OpenForRandom ; Close - close a file which has been previously opened using: OpenToRead, OpenToWrite, OpenForRandom. It is correct to close a file which has an error status. + Close has an optional return value: + TRUE signifies that the close was successful and all + state associated with f is deallocated. + FALSE signifies that the close was unsuccessful and no + state associated with f has been deallocated. *) -PROCEDURE Close (f: File) ; +PROCEDURE Close (f: File) : [BOOLEAN] ; VAR fd: FileDescriptor ; BEGIN - IF f#Error + IF f # Error THEN - fd := GetIndice(FileInfo, f) ; - (* - we allow users to close files which have an error status - *) - IF fd#NIL + fd := GetIndice (FileInfo, f) ; + (* We allow users to close files which have an error status. *) + IF fd # NIL THEN - FlushBuffer(f) ; + FlushBuffer (f) ; WITH fd^ DO - IF unixfd>=0 + IF unixfd >= 0 THEN - IF close(unixfd)#0 + IF close (unixfd) # 0 THEN - FormatError1('failed to close file (%s)\n', name.address) ; - state := failed (* --fixme-- too late to notify user (unless we return a BOOLEAN) *) + FormatError1 ('failed to close file (%s)\n', name.address) ; + state := failed ; + RETURN FALSE END END ; IF name.address#NIL @@ -516,7 +538,10 @@ BEGIN END ; DISPOSE(fd) ; PutIndice(FileInfo, f, NIL) - END + END ; + RETURN TRUE + ELSE + RETURN FALSE END END Close ; diff --git a/gcc/testsuite/gm2/pimlib/base/run/pass/FIO.mod b/gcc/testsuite/gm2/pimlib/base/run/pass/FIO.mod index 94a183301c39..dbe84a60cf81 100644 --- a/gcc/testsuite/gm2/pimlib/base/run/pass/FIO.mod +++ b/gcc/testsuite/gm2/pimlib/base/run/pass/FIO.mod @@ -1,6 +1,6 @@ (* FIO.mod provides a simple buffered file input/output library. -Copyright (C) 2001-2023 Free Software Foundation, Inc. +Copyright (C) 2001-2025 Free Software Foundation, Inc. Contributed by Gaius Mulley <[email protected]>. This file is part of GNU Modula-2. @@ -36,23 +36,21 @@ IMPLEMENTATION MODULE FIO ; provides a simple buffered file input/output library. *) -FROM SYSTEM IMPORT ADR, TSIZE, SIZE, WORD ; +FROM SYSTEM IMPORT ADR, TSIZE, WORD, COFF_T ; FROM ASCII IMPORT nl, nul, tab ; FROM StrLib IMPORT StrLen, StrConCat, StrCopy ; FROM Storage IMPORT ALLOCATE, DEALLOCATE ; FROM NumberIO IMPORT CardToStr ; -FROM libc IMPORT exit, open, creat, read, write, close, lseek, strncpy, memcpy ; FROM Indexing IMPORT Index, InitIndex, InBounds, HighIndice, PutIndice, GetIndice ; FROM M2RTS IMPORT InstallTerminationProcedure ; +FROM libc IMPORT exit, open, creat, read, write, close, lseek, strncpy, memcpy ; +FROM wrapc IMPORT SeekSet, SeekEnd, ReadOnly, WriteOnly ; + CONST - SEEK_SET = 0 ; (* relative from beginning of the file *) - SEEK_END = 2 ; (* relative to the end of the file *) - UNIXREADONLY = 0 ; - UNIXWRITEONLY = 1 ; - CreatePermissions = 666B; MaxBufferLength = 1024*16 ; MaxErrorString = 1024* 8 ; + CreatePermissions = 666B; TYPE FileUsage = (unused, openedforread, openedforwrite, openedforrandom) ; @@ -196,7 +194,7 @@ END GetNextFreeDescriptor ; (* - IsNoError - returns a TRUE if no error has occured on file, f. + IsNoError - returns a TRUE if no error has occured on file f. *) PROCEDURE IsNoError (f: File) : BOOLEAN ; @@ -213,6 +211,24 @@ BEGIN END IsNoError ; +(* + IsError - returns a TRUE if an error has occured on file f. +*) + +PROCEDURE IsError (f: File) : BOOLEAN ; +VAR + fd: FileDescriptor ; +BEGIN + IF f=Error + THEN + RETURN( FALSE ) + ELSE + fd := GetIndice (FileInfo, f) ; + RETURN( (fd#NIL) AND ((fd^.state#successful) AND (fd^.state#endoffile) AND (fd^.state#endofline)) ) + END +END IsError ; + + (* IsActive - returns TRUE if the file, f, is still active. *) @@ -428,10 +444,10 @@ BEGIN THEN unixfd := creat(name.address, CreatePermissions) ELSE - unixfd := open(name.address, UNIXWRITEONLY, 0) + unixfd := open(name.address, INTEGER (WriteOnly ()), 0) END ELSE - unixfd := open(name.address, UNIXREADONLY, 0) + unixfd := open(name.address, INTEGER (ReadOnly ()), 0) END ; IF unixfd<0 THEN @@ -476,28 +492,32 @@ END OpenForRandom ; Close - close a file which has been previously opened using: OpenToRead, OpenToWrite, OpenForRandom. It is correct to close a file which has an error status. + Close has an optional return value: + TRUE signifies that the close was successful and all + state associated with f is deallocated. + FALSE signifies that the close was unsuccessful and no + state associated with f has been deallocated. *) -PROCEDURE Close (f: File) ; +PROCEDURE Close (f: File) : [BOOLEAN] ; VAR fd: FileDescriptor ; BEGIN - IF f#Error + IF f # Error THEN - fd := GetIndice(FileInfo, f) ; - (* - we allow users to close files which have an error status - *) - IF fd#NIL + fd := GetIndice (FileInfo, f) ; + (* We allow users to close files which have an error status. *) + IF fd # NIL THEN - FlushBuffer(f) ; + FlushBuffer (f) ; WITH fd^ DO - IF unixfd>=0 + IF unixfd >= 0 THEN - IF close(unixfd)#0 + IF close (unixfd) # 0 THEN - FormatError1('failed to close file (%s)\n', name.address) ; - state := failed (* --fixme-- too late to notify user (unless we return a BOOLEAN) *) + FormatError1 ('failed to close file (%s)\n', name.address) ; + state := failed ; + RETURN FALSE END END ; IF name.address#NIL @@ -518,7 +538,10 @@ BEGIN END ; DISPOSE(fd) ; PutIndice(FileInfo, f, NIL) - END + END ; + RETURN TRUE + ELSE + RETURN FALSE END END Close ; @@ -664,10 +687,9 @@ END ReadNBytes ; Useful when performing small reads. *) -PROCEDURE BufferedRead (f: File; nBytes: CARDINAL; a: ADDRESS) : INTEGER ; +PROCEDURE BufferedRead (f: File; nBytes: CARDINAL; dest: ADDRESS) : INTEGER ; VAR - t : ADDRESS ; - result: INTEGER ; + src : ADDRESS ; total, n : INTEGER ; p : POINTER TO BYTE ; @@ -675,52 +697,52 @@ VAR BEGIN IF f#Error THEN - fd := GetIndice(FileInfo, f) ; + fd := GetIndice (FileInfo, f) ; total := 0 ; (* how many bytes have we read *) IF fd#NIL THEN WITH fd^ DO (* extract from the buffer first *) - IF buffer#NIL + IF buffer # NIL THEN WITH buffer^ DO - WHILE nBytes>0 DO - IF (left>0) AND valid + WHILE nBytes > 0 DO + IF (left > 0) AND valid THEN - IF nBytes=1 + IF nBytes = 1 THEN (* too expensive to call memcpy for 1 character *) - p := a ; + p := dest ; p^ := contents^[position] ; - DEC(left) ; (* remove consumed byte *) - INC(position) ; (* move onwards n byte *) - INC(total) ; + DEC (left) ; (* remove consumed byte *) + INC (position) ; (* move onwards n byte *) + INC (total) ; RETURN( total ) ELSE - n := Min(left, nBytes) ; - t := address ; - INC(t, position) ; - p := memcpy(a, t, n) ; - DEC(left, n) ; (* remove consumed bytes *) - INC(position, n) ; (* move onwards n bytes *) + n := Min (left, nBytes) ; + src := address ; + INC (src, position) ; + p := memcpy (dest, src, n) ; + DEC (left, n) ; (* remove consumed bytes *) + INC (position, n) ; (* move onwards n bytes *) (* move onwards ready for direct reads *) - INC(a, n) ; - DEC(nBytes, n) ; (* reduce the amount for future direct *) + INC (dest, n) ; + DEC (nBytes, n) ; (* reduce the amount for future direct *) (* read *) - INC(total, n) + INC (total, n) END ELSE (* refill buffer *) - n := read(unixfd, address, size) ; - IF n>=0 + n := read (unixfd, address, size) ; + IF n >= 0 THEN valid := TRUE ; position := 0 ; left := n ; filled := n ; bufstart := abspos ; - INC(abspos, n) ; - IF n=0 + INC (abspos, n) ; + IF n = 0 THEN (* eof reached *) state := endoffile ; @@ -1084,7 +1106,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. *) @@ -1092,9 +1114,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 ; @@ -1233,52 +1255,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 ; - result: INTEGER ; + 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 @@ -1331,7 +1352,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. *) @@ -1339,7 +1360,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 ; @@ -1450,7 +1471,7 @@ BEGIN filled := 0 END END ; - offset := lseek(unixfd, pos, SEEK_SET) ; + offset := lseek (unixfd, VAL (COFF_T, pos), SeekSet ()) ; IF (offset>=0) AND (pos=offset) THEN abspos := pos @@ -1499,7 +1520,7 @@ BEGIN filled := 0 END END ; - offset := lseek(unixfd, pos, SEEK_END) ; + offset := lseek (unixfd, VAL (COFF_T, pos), SeekEnd ()) ; IF offset>=0 THEN abspos := offset ; diff --git a/gcc/testsuite/gm2/pimlib/run/pass/testclose.mod b/gcc/testsuite/gm2/pimlib/run/pass/testclose.mod new file mode 100644 index 000000000000..35794e5fbc2f --- /dev/null +++ b/gcc/testsuite/gm2/pimlib/run/pass/testclose.mod @@ -0,0 +1,41 @@ +MODULE testclose ; + +IMPORT FIO ; +IMPORT libc ; + + +(* + assert - +*) + +PROCEDURE assert (condition: BOOLEAN; line: CARDINAL) ; +BEGIN + IF NOT condition + THEN + libc.printf ("%s:%d:assert failed\n", __FILE__, line) ; + libc.exit (1) + END +END assert ; + + +(* + Init - +*) + +PROCEDURE Init ; +VAR + f: FIO.File ; +BEGIN + f := FIO.OpenToWrite ('testclose.txt') ; + assert (FIO.IsNoError (f), __LINE__) ; + FIO.WriteString (f, 'hello') ; + assert (FIO.IsNoError (f), __LINE__) ; + FIO.WriteLine (f) ; + assert (FIO.IsNoError (f), __LINE__) ; + assert (FIO.Close (f), __LINE__) +END Init ; + + +BEGIN + Init +END testclose.
