https://gcc.gnu.org/g:2d9dbaf06e4cd83125781d1eb760f5404da3d175
commit r14-11079-g2d9dbaf06e4cd83125781d1eb760f5404da3d175
Author: 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_radix): Likewise.
gcc/testsuite/ChangeLog:
* gfortran.dg/pr117819.f90: New test.
(cherry picked from commit cf406a6c79ce404c45f99bcf2df3293269dbb462)
Diff:
---
gcc/testsuite/gfortran.dg/pr117819.f90 | 45 ++++++++++++++++++++++++++++++++++
libgfortran/io/read.c | 36 +++++++++++++++++++++------
2 files changed, 73 insertions(+), 8 deletions(-)
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 7a9e341d7d80..24cfe8599cd0 100644
--- a/libgfortran/io/read.c
+++ b/libgfortran/io/read.c
@@ -675,11 +675,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.
@@ -692,6 +692,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)
{
@@ -729,8 +733,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 == ' ')
{
if (dtp->u.p.blank_status == BLANK_NULL)
@@ -778,7 +788,6 @@ read_decimal (st_parameter_dt *dtp, const fnode *f, char
*dest, int length)
}
-
/* read_radix()-- This function reads values for non-decimal radixes.
The difference here is that we treat the values here as unsigned
values for the purposes of overflow. If minus sign is present and
@@ -790,17 +799,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)
{
@@ -838,7 +851,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;
