From 9fa276de85bb001784c07c21ba291d85c2fcd710 Mon Sep 17 00:00:00 2001 From: Jerry DeLisle Date: Sat, 9 Jul 2005 23:40:31 +0000 Subject: [PATCH] PR libfortran/21875 (FM111.f) 2005-07-09 Jerry DeLisle 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 --- gcc/testsuite/gfortran.dg/fmt_read_bz_bn.f90 | 32 +++++++++++ libgfortran/ChangeLog | 11 ++++ libgfortran/io/read.c | 58 +++++++++++++------- 3 files changed, 82 insertions(+), 19 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/fmt_read_bz_bn.f90 diff --git a/gcc/testsuite/gfortran.dg/fmt_read_bz_bn.f90 b/gcc/testsuite/gfortran.dg/fmt_read_bz_bn.f90 new file mode 100644 index 00000000000..0f2ec64b764 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/fmt_read_bz_bn.f90 @@ -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 diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog index a73202de3a2..8457da4a5fe 100644 --- a/libgfortran/ChangeLog +++ b/libgfortran/ChangeLog @@ -1,3 +1,14 @@ + +2005-07-09 Jerry DeLisle + + 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 Thomas Koenig diff --git a/libgfortran/io/read.c b/libgfortran/io/read.c index 2eb68c84498..101652ca8dc 100644 --- a/libgfortran/io/read.c +++ b/libgfortran/io/read.c @@ -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++; }