Skip to content

R
riscv-gcc-1
Commit 7984a2f0 by Paul Brook Committed by Paul Brook
Options

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
parent 39b8ce7f
Showing with 369 additions and 224 deletions
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 0 → 100644
! { 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. */
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment