public inbox for gcc-cvs@sourceware.org
help / color / mirror / Atom feed
* [gcc r13-7658] PR modula2/110631 Bugfix to FIO WriteCardinal
@ 2023-07-30 20:45 Gaius Mulley
0 siblings, 0 replies; only message in thread
From: Gaius Mulley @ 2023-07-30 20:45 UTC (permalink / raw)
To: gcc-cvs
https://gcc.gnu.org/g:d1611c51dd7ce054eceb19fda3be72c2164aaa71
commit r13-7658-gd1611c51dd7ce054eceb19fda3be72c2164aaa71
Author: Gaius Mulley <gaiusmod2@gmail.com>
Date: Sun Jul 30 21:44:49 2023 +0100
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.
(cherry picked from commit 73cc6ce1294ec35e9322b1bbc91009cfc76f732b)
Signed-off-by: Gaius Mulley <gaiusmod2@gmail.com>
Diff:
---
gcc/m2/gm2-libs/FIO.def | 4 +-
gcc/m2/gm2-libs/FIO.mod | 56 +++++++-------
.../gm2/pimlib/run/pass/testfiobinary.mod | 89 ++++++++++++++++++++++
3 files changed, 119 insertions(+), 30 deletions(-)
diff --git a/gcc/m2/gm2-libs/FIO.def b/gcc/m2/gm2-libs/FIO.def
index f521ef6a631..f4c201fe31d 100644
--- 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 1f3e22ed6c5..dd6f48c446f 100644
--- 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
index 00000000000..06feb846ca6
--- /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.
^ permalink raw reply [flat|nested] only message in thread
only message in thread, other threads:[~2023-07-30 20:45 UTC | newest]
Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2023-07-30 20:45 [gcc r13-7658] PR modula2/110631 Bugfix to FIO WriteCardinal Gaius Mulley
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).