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

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 (file)
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 a73202de3a25b77bd5aa9bf4d5e80884b61e9c5e..8457da4a5fe4ed69005691a803b9e23233ef6e11 100644 (file)
--- 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 2eb68c84498aec22e5e188fe6ee4fef18237b84b..101652ca8dcdfce0bcd48697dbc89be3766d699f 100644 (file)
--- 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++;
     }