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

gcc/testsuite/gfortran.dg/fmt_read_bz_bn.f90

+! { 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

libgfortran/ChangeLog

+
+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>
 

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 */
 
@@ -337,6 +337,12 @@ read_decimal (fnode * f, char *dest, int length)
       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))
+  while (w > 0)
+    {
+      if (*p == ' ')
+        {
+          if (g.blank_status == BLANK_ZERO) *p = '0';
+          if (g.blank_status == BLANK_NULL)
             {
-      exponent = 10 * exponent + *p - '0';
               p++;
               w--;
+              continue;
             }
-
-  /* Only allow trailing blanks */
-
-  while (w > 0)
-    {
-      if (*p != ' ')
+        }
+      if (!isdigit (*p))
         goto bad_float;
+        
+      exponent = 10 * exponent + *p - '0';
       p++;
       w--;
     }
@@ -732,15 +746,21 @@ 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
+      if (*digits == ' ')
+        {
+          if (g.blank_status == BLANK_ZERO) *digits = '0';
+          if (g.blank_status == BLANK_NULL)
+            {
+              digits++;
+              continue;
+            } 
+        }
       *p = *digits;
       p++;
       digits++;