From cf406a6c79ce404c45f99bcf2df3293269dbb462 Mon Sep 17 00:00:00 2001
From: Jerry DeLisle <jvdelisle@gcc.gnu.org>
Date: Mon, 9 Dec 2024 20:11:23 -0800
Subject: [PATCH] Fortran: Fix READ with padding in BLANK ZERO mode.
PR fortran/117819
libgfortran/ChangeLog:
* io/read.c (read_decimal): If the read value is short of the
specified width and pad mode is PAD yes, check for BLANK ZERO
and adjust the value accordingly.
(read_decimal_unsigned): Likewise.
(read_radix): Likewise.
gcc/testsuite/ChangeLog:
* gfortran.dg/pr117819.f90: New test.
---
gcc/testsuite/gfortran.dg/pr117819.f90 | 45 +++++++++++++++++++++++
libgfortran/io/read.c | 51 +++++++++++++++++++++-----
2 files changed, 87 insertions(+), 9 deletions(-)
create mode 100644 gcc/testsuite/gfortran.dg/pr117819.f90
diff --git a/gcc/testsuite/gfortran.dg/pr117819.f90 b/gcc/testsuite/gfortran.dg/pr117819.f90
new file mode 100644
index 000000000000..d9a9b7f6f9be
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr117819.f90
@@ -0,0 +1,45 @@
+! { dg-do run }
+! PR117819
+Program xe1
+ Implicit None
+ Character(6) string
+ Integer x
+ Logical :: ok = .True.
+ string = '111111'
+ !print *, "String we read from is: ", string
+ Read(string,1) x
+1 Format(BZ,B8)
+ If (x/=Int(b'11111100')) Then
+ Print *,'FAIL B8 BZ wrong result'
+ Print *,'Expected',Int(b'11111100')
+ Print *,'Received',x
+ ok = .False.
+ End If
+ string = '123456'
+ !print *, "String we read from is: ", string
+ Read(string,2) x
+2 Format(BZ,I8)
+ If (x/=12345600) Then
+ Print *,'FAIL I8 BZ wrong result'
+ Print *,'Expected',12345600
+ Print *,'Received',x
+ ok = .False.
+ End If
+ Read(string,3) x
+3 Format(BZ,O8)
+ If (x/=Int(o'12345600')) Then
+ Print *,'FAIL O8 BZ wrong result'
+ Print *,'Expected',Int(o'12345600')
+ Print *,'Received',x
+ ok = .False.
+ End If
+ Read(string,4) x
+4 Format(BZ,Z8)
+ If (x/=Int(z'12345600')) Then
+ Print *,'FAIL OZ BZ wrong result'
+ Print *,'Expected',Int(z'12345600')
+ Print *,'Received',x
+ ok = .False.
+ End If
+ If (.not. ok) stop 1
+End Program
diff --git a/libgfortran/io/read.c b/libgfortran/io/read.c
index aa866bf31dae..46413ade0010 100644
--- a/libgfortran/io/read.c
+++ b/libgfortran/io/read.c
@@ -753,11 +753,11 @@ read_decimal (st_parameter_dt *dtp, const fnode *f, char *dest, int length)
{
GFC_UINTEGER_LARGEST value, maxv, maxv_10;
GFC_INTEGER_LARGEST v;
- size_t w;
+ size_t w, padding;
int negative;
char c, *p;
- w = f->u.w;
+ w = padding = f->u.w;
/* This is a legacy extension, and the frontend will only allow such cases
* through when -fdec-format-defaults is passed.
@@ -770,6 +770,10 @@ read_decimal (st_parameter_dt *dtp, const fnode *f, char *dest, int length)
if (p == NULL)
return;
+ /* If the read was not the full width we may need to pad with blanks or zeros
+ * depending on the PAD mode. Save the number of pad characters needed. */
+ padding -= w;
+
p = eat_leading_spaces (&w, p);
if (w == 0)
{
@@ -807,7 +811,14 @@ read_decimal (st_parameter_dt *dtp, const fnode *f, char *dest, int length)
{
c = next_char (dtp, &p, &w);
if (c == '\0')
- break;
+ {
+ if (dtp->u.p.blank_status == BLANK_ZERO)
+ {
+ for (size_t n = 0; n < padding; n++)
+ value = 10 * value;
+ }
+ break;
+ }
if (c == ' ')
{
@@ -864,11 +875,11 @@ read_decimal_unsigned (st_parameter_dt *dtp, const fnode *f, char *dest,
int length)
{
GFC_UINTEGER_LARGEST value, old_value;
- size_t w;
+ size_t w, padding;
int negative;
char c, *p;
- w = f->u.w;
+ w = padding = f->u.w;
/* This is a legacy extension, and the frontend will only allow such cases
* through when -fdec-format-defaults is passed.
@@ -881,6 +892,10 @@ read_decimal_unsigned (st_parameter_dt *dtp, const fnode *f, char *dest,
if (p == NULL)
return;
+ /* If the read was not the full width we may need to pad with blanks or zeros
+ * depending on the PAD mode. Save the number of pad characters needed. */
+ padding -= w;
+
p = eat_leading_spaces (&w, p);
if (w == 0)
{
@@ -917,7 +932,14 @@ read_decimal_unsigned (st_parameter_dt *dtp, const fnode *f, char *dest,
{
c = next_char (dtp, &p, &w);
if (c == '\0')
- break;
+ {
+ if (dtp->u.p.blank_status == BLANK_ZERO)
+ {
+ for (size_t n = 0; n < padding; n++)
+ value = 10 * value;
+ }
+ break;
+ }
if (c == ' ')
{
@@ -981,17 +1003,21 @@ read_radix (st_parameter_dt *dtp, const fnode *f, char *dest, int length,
{
GFC_UINTEGER_LARGEST value, maxv, maxv_r;
GFC_INTEGER_LARGEST v;
- size_t w;
+ size_t w, padding;
int negative;
char c, *p;
- w = f->u.w;
+ w = padding = f->u.w;
p = read_block_form (dtp, &w);
if (p == NULL)
return;
+ /* If the read was not the full width we may need to pad with blanks or zeros
+ * depending on the PAD mode. Save the number of pad characters needed. */
+ padding -= w;
+
p = eat_leading_spaces (&w, p);
if (w == 0)
{
@@ -1029,7 +1055,14 @@ read_radix (st_parameter_dt *dtp, const fnode *f, char *dest, int length,
{
c = next_char (dtp, &p, &w);
if (c == '\0')
- break;
+ {
+ if (dtp->u.p.blank_status == BLANK_ZERO)
+ {
+ for (size_t n = 0; n < padding; n++)
+ value = radix * value;
+ }
+ break;
+ }
if (c == ' ')
{
if (dtp->u.p.blank_status == BLANK_NULL) continue;
--
GitLab