re PR libfortran/19155 ([4.0 only] blanks not treated as zeros in 'E' format read (NIST FM110.FOR))

PR libfortran/19155
	* io/read.c (read_f): Take care of spaces after initial sign.
	* gfortran.dg/pr19155.f: Add test.

From-SVN: r100861
This commit is contained in:
Francois-Xavier Coudert 2005-06-12 21:59:17 +02:00 committed by François-Xavier Coudert
parent d35310e309
commit 57504df9ee
4 changed files with 37 additions and 20 deletions

View File

@ -1,3 +1,8 @@
2005-06-12 Francois-Xavier Coudert <coudert@clipper.ens.fr>
PR libfortran/19155
* gfortran.dg/pr19155.f: Add test.
2005-06-12 Tobias Schl"uter <tobias.schlueter@physik.uni-muenchen.de>
* gfortran.dg/f2c_7.f90: New test.

View File

@ -5,6 +5,7 @@
! but doesn't require us to issue an error. Since g77 accepts this as zero,
! we do the same.
real a
character*10 c
a = 42
open (19,status='scratch')
write (19,'(A15)') 'E+00'
@ -12,4 +13,8 @@
read (19,'(E15.8)') a
if (a .ne. 0) call abort
close (19)
c = "+ "
read (c,"(F10.4)") a
if (a /= 0) call abort
end

View File

@ -1,3 +1,8 @@
2005-06-12 Francois-Xavier Coudert <coudert@clipper.ens.fr>
PR libfortran/19155
* io/read.c (read_f): Take care of spaces after initial sign.
2005-06-09 Thomas Koenig <Thomas.Koenig@online.de>
PR libfortran/21480

View File

@ -504,23 +504,7 @@ read_f (fnode * f, char *dest, int length)
p = eat_leading_spaces (&w, p);
if (w == 0)
{
switch (length)
{
case 4:
*((float *) dest) = 0.0f;
break;
case 8:
*((double *) dest) = 0.0;
break;
default:
internal_error ("Unsupported real kind during IO");
}
return;
}
goto zero;
/* Optional sign */
@ -529,12 +513,13 @@ read_f (fnode * f, char *dest, int length)
if (*p == '-')
val_sign = -1;
p++;
if (--w == 0)
goto bad_float;
w--;
}
exponent_sign = 1;
p = eat_leading_spaces (&w, p);
if (w == 0)
goto zero;
/* A digit, a '.' or a exponent character ('e', 'E', 'd' or 'D')
is required at this point */
@ -604,6 +589,23 @@ read_f (fnode * f, char *dest, int length)
generate_error (ERROR_READ_VALUE, "Bad value during floating point read");
return;
/* The value read is zero */
zero:
switch (length)
{
case 4:
*((float *) dest) = 0.0f;
break;
case 8:
*((double *) dest) = 0.0;
break;
default:
internal_error ("Unsupported real kind during IO");
}
return;
/* At this point the start of an exponent has been found */
exp1:
while (w > 0 && *p == ' ')