public inbox for gcc-cvs@sourceware.org help / color / mirror / Atom feed
From: Gaius Mulley <gaius@gcc.gnu.org> To: gcc-cvs@gcc.gnu.org Subject: [gcc r13-7658] PR modula2/110631 Bugfix to FIO WriteCardinal Date: Sun, 30 Jul 2023 20:45:44 +0000 (GMT) [thread overview] Message-ID: <20230730204544.3DD533858D35@sourceware.org> (raw) 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.
reply other threads:[~2023-07-30 20:45 UTC|newest] Thread overview: [no followups] expand[flat|nested] mbox.gz Atom feed
Reply instructions: You may reply publicly to this message via plain-text email using any one of the following methods: * Save the following mbox file, import it into your mail client, and reply-to-all from there: mbox Avoid top-posting and favor interleaved quoting: https://en.wikipedia.org/wiki/Posting_style#Interleaved_style * Reply using the --to, --cc, and --in-reply-to switches of git-send-email(1): git send-email \ --in-reply-to=20230730204544.3DD533858D35@sourceware.org \ --to=gaius@gcc.gnu.org \ --cc=gcc-cvs@gcc.gnu.org \ /path/to/YOUR_REPLY https://kernel.org/pub/software/scm/git/docs/git-send-email.html * If your mail client supports setting the In-Reply-To header via mailto: links, try the mailto: linkBe sure your reply has a Subject: header at the top and a blank line before the message body.
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).