aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJerry DeLisle <jvdelisle@verizon.net>2005-07-09 23:40:31 +0000
committerJerry DeLisle <jvdelisle@gcc.gnu.org>2005-07-09 23:40:31 +0000
commit9fa276de85bb001784c07c21ba291d85c2fcd710 (patch)
tree503ede726a28e4a251771117cb4154ae761a6fb1
parentf685a2e68d5f87b7eb3b9e7119c7abb9e4304672 (diff)
downloadgcc-9fa276de85bb001784c07c21ba291d85c2fcd710.zip
gcc-9fa276de85bb001784c07c21ba291d85c2fcd710.tar.gz
gcc-9fa276de85bb001784c07c21ba291d85c2fcd710.tar.bz2
PR libfortran/21875 (FM111.f)
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
-rw-r--r--gcc/testsuite/gfortran.dg/fmt_read_bz_bn.f9032
-rw-r--r--libgfortran/ChangeLog11
-rw-r--r--libgfortran/io/read.c58
3 files changed, 82 insertions, 19 deletions
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 0000000..0f2ec64
--- /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 a73202d..8457da4 100644
--- a/libgfortran/ChangeLog
+++ b/libgfortran/ChangeLog
@@ -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>
diff --git a/libgfortran/io/read.c b/libgfortran/io/read.c
index 2eb68c8..101652c 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++;
}