procyberian/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Fortran: Fix READ with padding in BLANK ZERO mode.

Browse source 
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.
This commit is contained in:
Jerry DeLisle 2024-12-09 20:11:23 -08:00
parent d26c166001
commit cf406a6c79
2 changed files with 87 additions and 9 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

45
gcc/testsuite/gfortran.dg/pr117819.f90 Normal file
View file

@ -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

51
libgfortran/io/read.c
View file

@ -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;