OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

PR libfortran/21875 (FM111.f)

Browse Source 
2005-07-09  Jerry DeLisle  <jvdelisle@verizon.net>

    PR libfortran/21875  (FM111.f)
    * io/read.c (next_char): Return a ' ' character when BLANK_ZERO or
    BLANK_NULL are active.
    (read_decimal): Interpret ' ' character correctly for BZ or BN.
    (read_radix): Interpret ' ' character correctly for BZ or BN.
    (read_f): Interpret ' ' character correctly for BZ or BN.
    * gfortran.dg/test (fmt_read_bz_bn.f90): New test case.

From-SVN: r101837
This commit is contained in:
Jerry DeLisle 2005-07-09 23:40:31 +00:00 committed by Jerry DeLisle
parent f685a2e68d
commit 9fa276de85
3 changed files with 82 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

32
gcc/testsuite/gfortran.dg/fmt_read_bz_bn.f90 Normal file
View File

@ -0,0 +1,32 @@
! { dg-do run }
! Test various uses of BZ and BN format specifiers.
! Portions inspired by NIST F77 testsuite FM711.f
! Contributed by jvdelisle@verizon.net
program test_bn
integer I1(2,2), I2(2,2,2)
real A1(5)
character*80 :: IDATA1="111 2 2 3 3. 3E-1 44 5 5 6 . 67 . 78 8. 8E-1"
character*80 :: IDATA2="2345 1 34512 45123 51234 2345 1 34512 45123 5"
character*80 :: ODATA=""
character*80 :: CORRECT1=" 1110 2020 .30303E-07 44 55 6.6 70.07 .888E+01"
character*80 :: CORRECT2="23450 10345. 12.45 1235 1234 2345 1345. 12.45 1235"
READ(IDATA1, 10) I1(1,2), IVI, A1(3), JVI, KVI, A1(2), AVS, A1(1)
10 FORMAT (BZ,(2I4, E10.1, BN, 2I4, F5.2, BZ, F5.2, BN, E10.1))
WRITE(ODATA, 20) I1(1,2), IVI, A1(3), JVI, KVI, A1(2), AVS, A1(1)
20 FORMAT (2I5, 1X, E10.5, BN, 2I5, F6.1, BZ, F6.2, BN, 1X, E8.3, I5)
if (ODATA /= CORRECT1) call abort
ODATA=""
READ(IDATA2, 30) I2(1,2,1), A1(3), AVS, IVI, I1(1,1), JVI, BVS, A1(2), I2(1,1,1)
30 FORMAT (BZ, (I5, F5.0, BN, F5.2, 2I5, I5, F5.0, BN, F5.2, I5))
WRITE(ODATA, 40) I2(1,2,1), A1(3), AVS, IVI, I1(1,1), JVI, BVS, A1(2), I2(1,1,1)
40 FORMAT (I5, F7.0, BZ, 1X, F5.2, 2(1X,I4),I5, F7.0, BZ, 1X, F5.2, 1X, I4)
if (ODATA /= CORRECT2) call abort
end program test_bn

11
libgfortran/ChangeLog
View File

@ -1,3 +1,14 @@
2005-07-09 Jerry DeLisle <jvdelisle@verizon.net>
PR libfortran/21875 (FM111.f)
* io/read.c (next_char): Return a ' ' character when BLANK_ZERO or
BLANK_NULL are active.
(read_decimal): Interpret ' ' character correctly for BZ or BN.
(read_radix): Interpret ' ' character correctly for BZ or BN.
(read_f): Interpret ' ' character correctly for BZ or BN.
* gfortran.dg/test (fmt_read_bz_bn.f90): New test case.
2005-07-09 Francois-Xavier Coudert <coudert@clipper.ens.fr>
Thomas Koenig <Thomas.Koenig@online.de>

58
libgfortran/io/read.c
View File

@ -266,8 +266,8 @@ next_char (char **p, int *w)
if (c != ' ')
return c;
if (g.blank_status == BLANK_ZERO)
return '0';
if (g.blank_status != BLANK_UNSPECIFIED)
return ' '; /* return a blank to signal a null */
/* At this point, the rest of the field has to be trailing blanks */
@ -336,7 +336,13 @@ read_decimal (fnode * f, char *dest, int length)
c = next_char (&p, &w);
if (c == '\0')
break;
if (c == ' ')
{
if (g.blank_status == BLANK_NULL) continue;
if (g.blank_status == BLANK_ZERO) c = '0';
}
if (c < '0' || c > '9')
goto bad;
@ -424,6 +430,11 @@ read_radix (fnode * f, char *dest, int length, int radix)
c = next_char (&p, &w);
if (c == '\0')
break;
if (c == ' ')
{
if (g.blank_status == BLANK_NULL) continue;
if (g.blank_status == BLANK_ZERO) c = '0';
}
switch (radix)
{
@ -680,19 +691,22 @@ read_f (fnode * f, char *dest, int length)
p++;
w--;
while (w > 0 && isdigit (*p))
{
exponent = 10 * exponent + *p - '0';
p++;
w--;
}
/* Only allow trailing blanks */
while (w > 0)
{
if (*p != ' ')
goto bad_float;
if (*p == ' ')
{
if (g.blank_status == BLANK_ZERO) *p = '0';
if (g.blank_status == BLANK_NULL)
{
p++;
w--;
continue;
}
}
if (!isdigit (*p))
goto bad_float;
exponent = 10 * exponent + *p - '0';
p++;
w--;
}
@ -732,16 +746,22 @@ read_f (fnode * f, char *dest, int length)
buffer = get_mem (i);
/* Reformat the string into a temporary buffer. As we're using atof it's
easiest to just leave the dcimal point in place. */
easiest to just leave the decimal point in place. */
p = buffer;
if (val_sign < 0)
*(p++) = '-';
for (; ndigits > 0; ndigits--)
{
if (*digits == ' ' && g.blank_status == BLANK_ZERO)
*p = '0';
else
*p = *digits;
if (*digits == ' ')
{
if (g.blank_status == BLANK_ZERO) *digits = '0';
if (g.blank_status == BLANK_NULL)
{
digits++;
continue;
}
}
*p = *digits;
p++;
digits++;
}