mirror/gcc
2
0
Fork 0
mirror of git://gcc.gnu.org/git/gcc.git synced 2025-02-06 14:20:27 +08:00
Code Issues Packages Projects Releases Wiki Activity

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

Browse Source 
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
This commit is contained in:
Paul Brook 2004-08-28 19:48:02 +00:00 committed by Paul Brook
parent 39b8ce7f98
commit 7984a2f04b
6 changed files with 399 additions and 254 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,8 @@
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.

66
gcc/testsuite/gfortran.dg/edit_real_1.f90 Normal file
View File

@ -0,0 +1,66 @@
! { 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

9
libgfortran/ChangeLog
View File

@ -1,3 +1,12 @@
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.

514
libgfortran/io/write.c
View File

@ -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;
/* Width of the EXP. */
e = 0;
/* We should always know the field width and precision. */
if (d < 0)
internal_error ("Uspecified precision");
sca = g.scale_factor;
n = value;
/* 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;
sign = calculate_sign (n < 0.0);
if (n < 0)
n = -n;
/* Width of the sign for the whole number. */
nsign = (sign == SIGN_NONE ? 0 : 1);
digits = 0;
if (ft != FMT_F)
/* Printf always prints at least two exponent digits. */
if (value == 0)
edigits = 2;
else
{
e = f->u.real.e;
edigits = 1 + (int) log10 (fabs(log10 (value)));
if (edigits < 2)
edigits = 2;
}
if (ft == FMT_F || ft == FMT_E || ft == FMT_D)
if (FMT_F || FMT_ES)
{
if (ft == FMT_F)
scale_flag = 0;
if (ft == FMT_D)
exp_char = 'D' ;
minv = 0.1;
maxv = 1.0;
/* Calculate the new val of the number with consideration
of global scale value. */
while (sca > 0)
{
minv *= 10.0;
maxv *= 10.0;
n *= 10.0;
sca -- ;
neval --;
}
/* Now calculate the new Exp value for this number. */
sca = g.scale_factor;
while(sca >= 1)
{
sca /= 10;
digits ++ ;
}
/* 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;
}
if (ft == FMT_EN )
{
minv = 1.0;
maxv = 1000.0;
}
if (ft == FMT_ES)
{
minv = 1.0;
maxv = 10.0;
}
/* OK, let's scale the number to appropriate range. */
while (scale_flag && n > 0.0 && n < minv)
{
if (n < minv)
{
n = n * 10.0 ;
neval --;
}
}
while (scale_flag && n > 0.0 && n > maxv)
{
if (n > maxv)
{
n = n / 10.0 ;
neval ++;
}
}
/* 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)
sprintf (buffer, "%+-31.*e", ndigits - 1, value);
/* Check the resulting string has punctuation in the correct places. */
if (buffer[2] != '.' || buffer[ndigits + 2] != 'e')
{
/* Sign of the EXP value. */
if (neval >= 0)
esign = SIGN_PLUS;
else
{
esign = SIGN_MINUS;
neval = - neval ;
}
printf ("'%s', %d\n", buffer, ndigits);
internal_error ("printf is broken");
}
/* Width of the EXP. */
e_new = 0;
j = neval;
while (j > 0)
{
j = j / 10;
e_new ++ ;
}
if (e <= e_new)
e = e_new;
/* Read the exponent back in. */
e = atoi (&buffer[ndigits + 3]) + 1;
/* Got the width of EXP. */
if (e < digits)
e = digits ;
/* Make sure zero comes out as 0.0e0. */
if (value == 0.0)
e = 0;
/* Minimum value of the width would be 2. */
if (e < 2)
e = 2;
/* Normalize the fractional component. */
buffer[2] = buffer[1];
digits = &buffer[2];
nesign = 1 ; /* We must give a position for the 'exp_char' */
if (e > 0)
nesign = e + nesign + (esign != SIGN_NONE ? 1 : 0);
}
/* Figure out where to place the decimal point. */
switch (ft)
{
case FMT_F:
nbefore = e + g.scale_factor;
if (nbefore < 0)
{
nzero = -nbefore;
if (nzero > d)
nzero = d;
nafter = d - nzero;
nbefore = 0;
}
else
{
nzero = 0;
nafter = d;
}
expchar = 0;
break;
case FMT_E:
case FMT_D:
i = g.scale_factor;
if (i < 0)
{
nbefore = 0;
nzero = -i;
nafter = d + i;
}
else
{
nbefore = i;
nzero = 0;
nafter = d - i;
}
if (ft = FMT_E)
expchar = 'E';
else
expchar = 'D';
break;
intval = n;
intstr = itoa (intval);
intlen = strlen (intstr);
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
{
nbefore = (-e) % 3;
if (nbefore != 0)
nbefore = 3 - nbefore;
}
e -= nbefore;
nbefore++;
nzero = 0;
nafter = d;
expchar = 'E';
break;
q = rtoa (n, len, d);
digits = strlen (q);
case FMT_ES:
e--;
nbefore = 1;
nzero = 0;
nafter = d;
expchar = 'E';
break;
/* Select a width if none was specified. */
default:
/* Should never happen. */
internal_error ("Unexpected format token");
}
/* Round the value. */
if (nbefore + nafter < ndigits && nbefore + nafter > 0)
{
i = nbefore + nafter;
if (digits[i] >= '5')
{
/* Propagate the carry. */
for (i--; i >= 0; i--)
{
if (digits[i] != '9')
{
digits[i]++;
break;
}
digits[i] = '0';
}
if (i < 0)
{
/* 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)
{
if (nzero > 0)
{
nzero--;
nafter++;
}
else
nbefore++;
}
else if (ft == FMT_EN)
{
nbefore++;
if (nbefore == 4)
{
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++;
if (f->u.real.e < 0)
{
/* Width not specified. Must be no more than 3 digits. */
if (e > 999 || e < -999)
edigits = -1;
else
{
edigits = 4;
if (e > 99 || e < -99)
expchar = ' ';
}
}
else
{
/* Exponent width specified, check it is wide enough. */
if (edigits > f->u.real.e)
edigits = -1;
else
edigits = f->u.real.e + 2;
}
}
else
edigits = 0;
/* 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;
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')
{
q++;
nblank = 0;
}
if (nblank < 0)
/* Work out how much padding is needed. */
nblanks = w - (nbefore + nzero + nafter + edigits + 1);
if (sign != SIGN_NONE)
nblanks--;
/* Check the value fits in the specified field width. */
if (nblanks < 0 || edigits == -1)
{
star_fill (p, w);
goto done;
}
memset (p, ' ', nblank);
p += nblank;
switch (sign)
{
case SIGN_PLUS:
*p++ = '+';
break;
case SIGN_MINUS:
*p++ = '-';
break;
case SIGN_NONE:
break;
star_fill (out, w);
return;
}
memcpy (p, q, intlen + d + 1);
p += intlen + d;
if (nesign > 0)
/* See if we have space for a zero before the decimal point. */
if (nbefore == 0 && nblanks > 0)
{
if (with_exp)
*p++ = exp_char;
switch (esign)
{
case SIGN_PLUS:
*p++ = '+';
break;
case SIGN_MINUS:
*p++ = '-';
break;
case SIGN_NONE:
break;
}
q = itoa (neval);
digits = strlen (q);
leadzero = 1;
nblanks--;
}
else
leadzero = 0;
for (itmp = 0; itmp < e - digits; itmp++)
*p++ = '0';
memcpy (p, q, digits);
p[digits] = 0;
/* Padd to full field width. */
if (nblanks > 0)
{
memset (out, ' ', nblanks);
out += nblanks;
}
done:
return ;
/* 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';
/* Output the part before the decimal point, padding with zeros. */
if (nbefore > 0)
{
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)
{
for (i = 0; i < nzero; i++)
*(out++) = '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;
}
/* 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)
{

3
libgfortran/libgfortran.h
View File

@ -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);

56
libgfortran/runtime/error.c
View File

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