[gfortran] Patch for PR 14746 - F edit descriptor with wrong fieldwidth

[Bud Davis <bdavis9659 at comcast dot net>]

F2.X edit descriptors did not work correctly. Reading and writing.

Below patch causes no new regression on i686 / gnu / linux.

This patch, along with the one for PR 14565, corrects the failures in
FM101.FOR of the NIST testsuite.


--bud davis



2004-03-37  Bud Davis <bdavis9659@comcast.net>
 
       PR gfortran/14746
       * io/read.c (read_f): Allow a decimal without a leading digit.
       * io/write.c (output_float): remove a leading '0' to keep from
       overflowing the field (F edit descriptor).


gcc/gcc/testsuite/gfortran.fortran-torture/execute/f2_edit.f90

! check F2.x edit descriptors
      CHARACTER*15 LINE
      RCON21 = 9.
      RCON22 = .9
      WRITE(LINE,'(F2.0,1H,,F2.1)')RCON21,RCON22
      READ(LINE,'(F2.0,1X,F2.1)')XRCON21,XRCON22
      IF (RCON21.NE.XRCON21) CALL ABORT
      IF (RCON22.NE.XRCON22) CALL ABORT
      END



 Index: gcc/libgfortran/io/read.c
===================================================================
RCS file: /cvs/gcc/gcc/libgfortran/io/Attic/read.c,v
retrieving revision 1.1.2.5
diff -c -3 -p -r1.1.2.5 read.c
*** gcc/libgfortran/io/read.c   1 Jan 2004 13:57:04 -0000       1.1.2.5
--- gcc/libgfortran/io/read.c   28 Mar 2004 16:43:38 -0000
*************** read_f (fnode * f, char *dest, int lengt
*** 628,636 ****
   
    exponent_sign = 1;
   
!   /* A digit is required at this point */
   
!   if (!isdigit (*p))
      goto bad_float;
   
    while (w > 0)
--- 628,636 ----
   
    exponent_sign = 1;
   
!   /* A digit (or a '.') is required at this point */
   
!   if (!isdigit (*p) && *p != '.')
      goto bad_float;
   
    while (w > 0)
Index: gcc/libgfortran/io/write.c
===================================================================
RCS file: /cvs/gcc/gcc/libgfortran/io/Attic/write.c,v
retrieving revision 1.1.2.8
diff -c -3 -p -r1.1.2.8 write.c
*** gcc/libgfortran/io/write.c  24 Mar 2004 13:08:18 -0000      1.1.2.8
--- gcc/libgfortran/io/write.c  28 Mar 2004 16:43:38 -0000
*************** output_float (fnode *f, double value, in
*** 404,410 ****
    intstr = itoa (intval);
    intlen = strlen (intstr);
   
!   q = rtoa (n, len, d-1);
    digits = strlen (q);
   
    /* Select a width if none was specified.  */
--- 404,410 ----
    intstr = itoa (intval);
    intlen = strlen (intstr);
   
!   q = rtoa (n, len, d);
    digits = strlen (q);
   
    /* Select a width if none was specified.  */
*************** output_float (fnode *f, double value, in
*** 423,428 ****
--- 423,434 ----
         with_exp = 0;
         nesign -= 1;
         nblank = w - (nsign + intlen + d + nesign);
+      }
+   /* don't let a leading '0' cause field overflow */
+   if (nblank == -1 && ft == FMT_F && q[0] == '0')
+      {
+         q++;
+         nblank = 0;
       }
   
    if (nblank < 0)