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/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. */