Hi all,
The attached patch fixes this bug by checking for the case of a short
READ that should be padded with blanks and if the BZ mode is enabled,
those blanks should be treated as trailing zero's.
New test case courtesy Malcom Cohen.
Regression tested on X86_64_linux_gnu.
OK for trunk and backport to 14 in a few days.
uthor: Jerry DeLisle <jvdeli...@gcc.gnu.org>
Date: Mon Dec 9 20:11:23 2024 -0800
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.
diff --git a/gcc/testsuite/gfortran.dg/pr117819.f90 b/gcc/testsuite/gfortran.dg/pr117819.f90
new file mode 100644
index 00000000000..d9a9b7f6f9b
--- /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 aa866bf31da..46413ade001 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;
