re PR libfortran/17195 (Infinite loop in output_float in libgfortran/io/write.c)

	PR libfortran/17195
	* libgfortran.h (rtoa): Remove prototype.
	* runtime/error.c (rtoa): Remove.
	* io/write.c (calculate_G_format): Don't add blanks if E format is
	used.  Add correct number of blanks when exponent width is specified.
	(output_float): Rewrite.
testsuite/
	* gfortran.dg/edit_real_1.f90: New test.

From-SVN: r86701

gcc/testsuite/ChangeLog

+2004-08-28  Paul Brook  <paul@codesourcery.com>
+
+	PR libfortran/17195
+	* gfortran.dg/edit_real_1.f90: New test.
+
 2004-08-27  Paul Brook  <paul@codesourcery.com>
 
 	* gfortran.dg/rewind_1.f90: New test.

gcc/testsuite/gfortran.dg/edit_real_1.f90

+! { dg-do run }
+! Check real value edit descriptors
+! Also checks that rounding is performed correctly
+program edit_real_1
+  character(len=20) s
+  character(len=20) x
+  character(len=200) t
+  parameter (x = "xxxxxxxxxxxxxxxxxxxx")
+
+  ! W append a "z" onto each test to check the field is the correct width
+  s = x
+  ! G -> F format
+  write (s, '(G10.3,A)') 12.36, "z"
+  if (s .ne. "  12.4    z") call abort
+  s = x
+  ! G -> E format
+  write (s, '(G10.3,A)') -0.0012346, "z"
+  if (s .ne. "-0.123E-02z") call abort
+  s = x
+  ! Gw.eEe format
+  write (s, '(G10.3e1,a)') 12.34, "z"
+  if (s .ne. "   12.3   z") call abort
+  ! E format with excessive precision
+  write (t, '(E199.192,A)') 1.5, "z"
+  if ((t(1:7) .ne. " 0.1500") .or. (t(194:200) .ne. "00E+01z")) call abort
+  ! EN format
+  s = x
+  write (s, '(EN15.3,A)') 12873.6, "z"
+  if (s .ne. "     12.874E+03z") call abort
+  ! EN format, negative exponent
+  s = x
+  write (s, '(EN15.3,A)') 12.345e-6, "z"
+  if (s .ne. "     12.345E-06z") call abort
+  ! ES format
+  s = x
+  write (s, '(ES10.3,A)') 16.235, "z"
+  if (s .ne. " 1.624E+01z") call abort
+  ! F format, small number
+  s = x
+  write (s, '(F10.8,A)') 1.0e-20, "z"
+  if (s .ne. "0.00000000z") call abort
+  ! E format, very large number.
+  ! Used to overflow with positive scale factor
+  s = x
+  write (s, '(1PE10.3,A)') huge(0d0), "z"
+  ! The actual value is target specific, so just do a basic check
+  if ((s(1:1) .eq. "*") .or. (s(7:7) .ne. "+") .or. &
+      (s(11:11) .ne. "z")) call abort
+  ! F format, round up with carry to most significant digit.
+  s = x
+  write (s, '(F10.3,A)') 0.9999, "z"
+  if (s .ne. "     1.000z") call abort
+  ! F format, round up with carry to most significant digit < 0.1.
+  s = x
+  write (s, '(F10.3,A)') 0.0099, "z"
+  if (s .ne. "     0.010z") call abort
+  ! E format, round up with carry to most significant digit.
+  s = x
+  write (s, '(E10.3,A)') 0.9999, "z"
+  if (s .ne. " 0.100E+01z") call abort
+  ! EN format, round up with carry to most significant digit.
+  s = x
+  write (s, '(EN15.3,A)') 999.9999, "z"
+  if (s .ne. "      1.000E+03z") call abort
+end
+

libgfortran/ChangeLog

+2004-08-28  Paul Brook  <paul@codesourcery.com>
+
+	PR libfortran/17195
+	* libgfortran.h (rtoa): Remove prototype.
+	* runtime/error.c (rtoa): Remove.
+	* io/write.c (calculate_G_format): Don't add blanks if E format is
+	used.  Add correct number of blanks when exponent width is specified.
+	(output_float): Rewrite.
+
 2004-08-27  Paul Brook  <paul@codesourcery.com>
 
 	* io/rewind.c (st_rewind): Reset unit to read mode.

libgfortran/io/write.c

@@ -24,6 +24,7 @@ Boston, MA 02111-1307, USA.  */
 #include "libgfortran.h"
 #include "io.h"
 #include <stdio.h>
+#include <stdlib.h>
 
 
 #define star_fill(p, n) memset(p, '*', n)
@@ -150,7 +151,7 @@ calculate_exp (int d)
 
 
 /* Generate corresponding I/O format for FMT_G output.
-   The rules to translate FMT_G to FMT_E or FNT_F from DEC fortran
+   The rules to translate FMT_G to FMT_E or FMT_F from DEC fortran
    LRM (table 11-2, Chapter 11, "I/O Formatting", P11-25) is:
 
    Data Magnitude                              Equivalent Conversion
@@ -192,7 +193,7 @@ calculate_G_format (fnode *f, double value, int len, int *num_blank)
       newf->u.real.w = w;
       newf->u.real.d = d;
       newf->u.real.e = e;
-      *num_blank = e + 2;
+      *num_blank = 0;
       return newf;
     }
 
@@ -232,9 +233,15 @@ calculate_G_format (fnode *f, double value, int len, int *num_blank)
         break;
     }
 
-  /* Generate the F editing. F(w-4).(-(mid-d-1)), 4' '.  */
+  /* Pad with blanks where the exponent would be.  */
+  if (e < 0)
+    *num_blank = 4;
+  else
+    *num_blank = e + 2;
+
+  /* Generate the F editing. F(w-n).(-(mid-d-1)), n' '.  */
   newf->format = FMT_F;
-  newf->u.real.w = f->u.real.w - 4;
+  newf->u.real.w = f->u.real.w - *num_blank;
 
   /* Special case.  */
   if (m == 0.0)
@@ -242,8 +249,6 @@ calculate_G_format (fnode *f, double value, int len, int *num_blank)
   else
     newf->u.real.d = - (mid - d - 1);
 
-  *num_blank = 4;
-
   /* For F editing, the scale factor is ignored.  */
   g.scale_factor = 0;
   return newf;
@@ -255,229 +260,348 @@ calculate_G_format (fnode *f, double value, int len, int *num_blank)
 static void
 output_float (fnode *f, double value, int len)
 {
-  int w, d, e, e_new;
-  int digits;
-  int nsign, nblank, nesign;
-  int sca, neval, itmp;
-  char *p;
-  const char *q, *intstr, *base;
-  double n;
+  /* This must be large enough to accurately hold any value.  */ 
+  char buffer[32];
+  char *out;
+  char *digits;
+  int e;
+  char expchar;
   format_token ft;
-  char exp_char = 'E';
-  int with_exp = 1;
-  int scale_flag = 1 ;
-  double minv = 0.0, maxv = 0.0;
-  sign_t sign = SIGN_NONE, esign = SIGN_NONE;
-
-  int intval = 0, intlen = 0;
-  int j;
-  
-  /* EXP value for this number.  */
-  neval = 0;
-
-  /* Width of EXP and it's sign.  */
-  nesign = 0;
+  int w;
+  int d;
+  int edigits;
+  int ndigits;
+  /* Number of digits before the decimal point.  */
+  int nbefore;
+  /* Number of zeros after the decimal point.  */
+  int nzero;
+  /* Number of digits after the decimal point.  */
+  int nafter;
+  int leadzero;
+  int nblanks;
+  int i;
+  sign_t sign;
 
   ft = f->format;
   w = f->u.real.w;
-  d = f->u.real.d + 1;
+  d = f->u.real.d;
+
+  /* We should always know the field width and precision.  */
+  if (d < 0)
+    internal_error ("Uspecified precision");
+
+  /* Use sprintf to print the number in the format +D.DDDDe+ddd
+     For an N digit exponent, this gives us (32-6)-N digits after the
+     decimal point, plus annother one before the decimal point.  */
+  sign = calculate_sign (value < 0.0);
+  if (value < 0)
+    value = -value;
+
+  /* Printf always prints at least two exponent digits.  */
+  if (value == 0)
+    edigits = 2;
+  else
+    {
+      edigits = 1 + (int) log10 (fabs(log10 (value)));
+      if (edigits < 2)
+	edigits = 2;
+    }
   
-  /* Width of the EXP.  */
-  e = 0;
+  if (FMT_F || FMT_ES)
+    {
+      /* Always convert at full precision to avoid double rounding.  */
+      ndigits = 27 - edigits;
+    }
+  else
+    {
+      /* We know the number of digits, so can let printf do the rounding
+	 for us.  */
+      if (ft == FMT_ES)
+	ndigits = d + 1;
+      else
+	ndigits = d;
+      if (ndigits > 27 - edigits)
+	ndigits = 27 - edigits;
+    }
 
-  sca = g.scale_factor;
-  n = value;
+  sprintf (buffer, "%+-31.*e", ndigits - 1, value);
   
-  sign = calculate_sign (n < 0.0);
-  if (n < 0)
-    n = -n;
+  /* Check the resulting string has punctuation in the correct places.  */
+  if (buffer[2] != '.' || buffer[ndigits + 2] != 'e')
+    {
+      printf ("'%s', %d\n", buffer, ndigits);
+      internal_error ("printf is broken");
+    }
 
-  /* Width of the sign for the whole number.  */
-  nsign = (sign == SIGN_NONE ? 0 : 1);
+  /* Read the exponent back in.  */
+  e = atoi (&buffer[ndigits + 3]) + 1;
+
+  /* Make sure zero comes out as 0.0e0.  */
+  if (value == 0.0)
+    e = 0;
 
-  digits = 0;
-  if (ft != FMT_F)
+  /* Normalize the fractional component.  */
+  buffer[2] = buffer[1];
+  digits = &buffer[2];
+
+  /* Figure out where to place the decimal point.  */
+  switch (ft)
+    {
+    case FMT_F:
+      nbefore = e + g.scale_factor;
+      if (nbefore < 0)
 	{
-      e = f->u.real.e;
+	  nzero = -nbefore;
+	  if (nzero > d)
+	    nzero = d;
+	  nafter = d - nzero;
+	  nbefore = 0;
 	}
-  if (ft == FMT_F || ft == FMT_E || ft == FMT_D)
+      else
 	{
-      if (ft == FMT_F)
-        scale_flag = 0;
-      if (ft == FMT_D)
-        exp_char = 'D' ;
-      minv = 0.1;
-      maxv = 1.0;
+	  nzero = 0;
+	  nafter = d;
+	}
+      expchar = 0;
+      break;
 
-      /* Calculate the new val of the number with consideration
-         of global scale value.  */
-      while (sca >  0)
+    case FMT_E:
+    case FMT_D:
+      i = g.scale_factor;
+      if (i < 0)
+	{
+	  nbefore = 0;
+	  nzero = -i;
+	  nafter = d + i;
+	}
+      else
 	{
-          minv *= 10.0;
-          maxv *= 10.0;
-          n *= 10.0;
-          sca -- ;
-          neval --;
+	  nbefore = i;
+	  nzero = 0;
+	  nafter = d - i;
 	}
+      if (ft = FMT_E)
+	expchar = 'E';
+      else
+	expchar = 'D';
+      break;
 
-      /* Now calculate the new Exp value for this number.  */
-      sca = g.scale_factor;
-      while(sca >= 1)
+    case FMT_EN:
+      /* The exponent must be a multiple of three, with 1-3 digits before
+	 the decimal point.  */
+      e--;
+      if (e >= 0)
+	nbefore = e % 3;
+      else
 	{
-          sca /= 10;
-          digits ++ ;
+	  nbefore = (-e) % 3;
+	  if (nbefore != 0)
+	    nbefore = 3 - nbefore;
 	}
+      e -= nbefore;
+      nbefore++;
+      nzero = 0;
+      nafter = d;
+      expchar = 'E';
+      break;
+
+    case FMT_ES:
+      e--;
+      nbefore = 1;
+      nzero = 0;
+      nafter = d;
+      expchar = 'E';
+      break;
+
+    default:
+      /* Should never happen.  */
+      internal_error ("Unexpected format token");
     }
 
-   if (ft == FMT_EN )
+  /* Round the value.  */
+  if (nbefore + nafter < ndigits && nbefore + nafter > 0)
     {
-       minv = 1.0;
-       maxv = 1000.0;
-     }
-   if (ft == FMT_ES)
+      i = nbefore + nafter;
+      if (digits[i] >= '5')
+	{
+	  /* Propagate the carry.  */
+	  for (i--; i >= 0; i--)
 	    {
-       minv = 1.0;
-       maxv = 10.0;
+	      if (digits[i] != '9')
+		{
+		  digits[i]++;
+		  break;
+		}
+	      digits[i] = '0';
 	    }
 
-   /* OK, let's scale the number to appropriate range.  */
-   while (scale_flag && n > 0.0 && n < minv)
+	  if (i < 0)
 	    {
-       if (n < minv)
+	      /* The carry overflowed.  Fortunately we have some spare space
+		 at the start of the buffer.  We may discard some digits, but
+		 this is ok because we already know they are zero.  */
+	      digits--;
+	      digits[0] = '1';
+	      if (ft == FMT_F)
 		{
-           n = n * 10.0 ;
-           neval --;
+		  if (nzero > 0)
+		    {
+		      nzero--;
+		      nafter++;
 		    }
+		  else
+		    nbefore++;
 		}
-   while (scale_flag && n > 0.0 && n > maxv)
+	      else if (ft == FMT_EN)
 		{
-       if (n > maxv)
+		  nbefore++;
+		  if (nbefore == 4)
 		    {
-           n = n / 10.0 ;
-           neval ++;
+		      nbefore = 1;
+		      e += 3;
+		    }
+		}
+	      else
+		e++;
 	    }
 	}
+    }
+
+  /* Calculate the format of the exponent field.  */
+  if (expchar)
+    {
+      edigits = 1;
+      for (i = abs (e); i >= 10; i /= 10)
+	edigits++;
       
-  /* It is time to process the EXP part of the number.
-     Value of 'nesign' is 0 unless following codes is executed.  */
-  if (ft != FMT_F)
+      if (f->u.real.e < 0)
 	{
-     /* Sign of the EXP value.  */
-     if (neval >= 0)
-       esign = SIGN_PLUS;
+	  /* Width not specified.  Must be no more than 3 digits.  */
+	  if (e > 999 || e < -999)
+	    edigits = -1;
 	  else
 	    {
-         esign = SIGN_MINUS;
-         neval = - neval ;
+	      edigits = 4;
+	      if (e > 99 || e < -99)
+		expchar = ' ';
 	    }
-
-      /* Width of the EXP.  */
-      e_new = 0;
-      j = neval;
-      while (j > 0)
+	}
+      else
 	{
-           j = j / 10;
-           e_new ++ ;
+	  /* Exponent width specified, check it is wide enough.  */
+	  if (edigits > f->u.real.e)
+	    edigits = -1;
+	  else
+	    edigits = f->u.real.e + 2;
 	}
-      if (e <= e_new)
-         e = e_new;
-
-     /* Got the width of EXP.  */
-     if (e < digits)
-       e = digits ;
-
-     /* Minimum value of the width would be 2.  */
-     if (e < 2)
-       e = 2;
-
-     nesign =  1 ;  /* We must give a position for the 'exp_char'  */
-     if (e > 0)
-       nesign = e + nesign + (esign != SIGN_NONE ? 1 : 0);
     }
+  else
+    edigits = 0;
 
-
-  intval = n;
-  intstr = itoa (intval);
-  intlen = strlen (intstr);
-
-  q = rtoa (n, len, d);
-  digits = strlen (q);
-
-  /* Select a width if none was specified.  */
+  /* Pick a field size if none was specified.  */
   if (w <= 0)
-    w = digits + nsign;
+    w = nbefore + nzero + nafter + 2;
 
-  p = write_block (w);
-  if (p == NULL)
+  /* Create the ouput buffer.  */
+  out = write_block (w);
+  if (out == NULL)
     return;
 
-  base = p;
+  /* Work out how much padding is needed.  */
+  nblanks = w - (nbefore + nzero + nafter + edigits + 1);
+  if (sign != SIGN_NONE)
+    nblanks--;
   
-  nblank = w - (nsign + intlen + d + nesign);
-  if (nblank == -1 && ft != FMT_F)
-     {
-       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')
+  /* Check the value fits in the specified field width.  */
+  if (nblanks < 0 || edigits == -1)
     {
-        q++;
-        nblank = 0;
+      star_fill (out, w);
+      return;
     }
 
-  if (nblank < 0)
+  /* See if we have space for a zero before the decimal point.  */
+  if (nbefore == 0 && nblanks > 0)
     {
-      star_fill (p, w);
-      goto done;
+      leadzero = 1;
+      nblanks--;
     }
-  memset (p, ' ', nblank);
-  p += nblank;
+  else
+    leadzero = 0;
 
-  switch (sign)
+  /* Padd to full field width.  */
+  if (nblanks > 0)
     {
-    case SIGN_PLUS:
-      *p++ = '+';
-      break;
-    case SIGN_MINUS:
-      *p++ = '-';
-      break;
-    case SIGN_NONE:
-      break;
+      memset (out, ' ', nblanks);
+      out += nblanks;
     }
 
-  memcpy (p, q, intlen + d + 1);
-  p += intlen + d;
+  /* Output the initial sign (if any).  */
+  if (sign == SIGN_PLUS)
+    *(out++) = '+';
+  else if (sign == SIGN_MINUS)
+    *(out++) = '-';
+
+  /* Output an optional leading zero.  */
+  if (leadzero)
+    *(out++) = '0';
 
-  if (nesign > 0)
+  /* Output the part before the decimal point, padding with zeros.  */
+  if (nbefore > 0)
     {
-      if (with_exp)
-         *p++ = exp_char;
-      switch (esign)
+      if (nbefore > ndigits)
+	i = ndigits;
+      else
+	i = nbefore;
+
+      memcpy (out, digits, i);
+      while (i < nbefore)
+	out[i++] = '0';
+
+      digits += i;
+      ndigits -= i;
+      out += nbefore;
+    }
+  /* Output the decimal point.  */
+  *(out++) = '.';
+
+  /* Output leading zeros after the decimal point.  */
+  if (nzero > 0)
     {
-        case SIGN_PLUS:
-          *p++ = '+';
-          break;
-        case SIGN_MINUS:
-          *p++ = '-';
-          break;
-        case SIGN_NONE:
-          break;
+      for (i = 0; i < nzero; i++)
+	*(out++) = '0';
     }
-      q = itoa (neval);
-      digits = strlen (q);
 
-      for (itmp = 0; itmp < e - digits; itmp++)
-        *p++ = '0';
-      memcpy (p, q, digits);
-      p[digits]  = 0;
+  /* Output digits after the decimal point, padding with zeros.  */
+  if (nafter > 0)
+    {
+      if (nafter > ndigits)
+	i = ndigits;
+      else
+	i = nafter;
+
+      memcpy (out, digits, i);
+      while (i < nafter)
+	out[i++] = '0';
+
+      digits += i;
+      ndigits -= i;
+      out += nafter;
     }
   
-done:
-  return ;
+  /* Output the exponent.  */
+  if (expchar)
+    {
+      if (expchar != ' ')
+	{
+	  *(out++) = expchar;
+	  edigits--;
+	}
+      snprintf (buffer, 32, "%+0*d", edigits, e);
+      memcpy (out, buffer, edigits);
+    }
 }
 
+
 void
 write_l (fnode * f, char *source, int len)
 {

libgfortran/libgfortran.h

@@ -250,9 +250,6 @@ void get_args (int *, char ***);
 
 
 /* error.c */
-#define rtoa prefix(rtoa)
-char *rtoa (double f, int length, int oprec);
-
 #define itoa prefix(itoa)
 char *itoa (int64_t);
 

libgfortran/runtime/error.c

@@ -53,62 +53,6 @@ unsigned line;
 
 static char buffer[32];		/* buffer for integer/ascii conversions */
 
-/* rtoa()-- Real to ascii conversion for base 10 and below.
- * Returns a pointer to a static buffer.  */
-
-char *
-rtoa (double f, int length, int oprec)
-{
-  double n = f;
-  double fval, minval;
-  int negative, prec;
-  unsigned k;
-  char formats[16];
-
-  prec = 0;
-  negative = 0;
-  if (n < 0.0)
-    {
-      negative = 1;
-      n = -n;
-    }
-
-  if (length >= 8)
-    minval = FLT_MIN;
-  else
-    minval = DBL_MIN;
-
-
-  if (n <= minval)
-    {
-      buffer[0] = '0';
-      buffer[1] = '.';
-      for (k = 2; k < 28 ; k++)
-        buffer[k] = '0';
-      buffer[k+1] = '\0';
-      return buffer;
-    }
-  fval = n;
-  while (fval > 1.0)
-    {
-      fval = fval / 10.0;
-      prec ++;
-    }
-
-  prec = sizeof (buffer) - 2 - prec;
-  if (prec > 20)
-     prec = 20;
-  prec = prec > oprec ? oprec : prec ;
-
-  if (negative)
-     sprintf (formats, "-%%.%df", prec);
-  else
-     sprintf (formats, "%%.%df", prec);
-
-  sprintf (buffer, formats, n);
-  return buffer;
-}
-
 
 /* Returns a pointer to a static buffer. */