mirror of
git://gcc.gnu.org/git/gcc.git
synced 2025-02-23 04:19:09 +08:00
re PR fortran/60128 (Wrong ouput using en edit descriptor)
2014-03-08 Dominique d'Humieres <dominiq@lps.ens.fr> PR libgfortran/60128 * io/write_float.def (output_float): Remove unused variable nzero_real. Replace a double space with a single one. (determine_en_precision): Fix wrong handling of the EN format. PR libfortran/60128 * gfortran.dg/fmt_en.f90: New test. From-SVN: r208423
This commit is contained in:
Dominique d'Humieres
Jerry DeLisle
parent
494c3d0e55
commit
4e185d7cee
@ -1,3 +1,8 @@
|
|||||||
|
2014-03-08 Dominique d'Humieres <dominiq@lps.ens.fr>
|
||||||
|
|
||||||
|
PR libfortran/60128
|
||||||
|
* gfortran.dg/fmt_en.f90: New test.
|
||||||
|
|
||||||
2014-03-07 Jason Merrill <jason@redhat.com>
|
2014-03-07 Jason Merrill <jason@redhat.com>
|
||||||
|
|
||||||
* lib/g++-dg.exp (g++-dg-runtest): Run tests in C++1y mode, too.
|
* lib/g++-dg.exp (g++-dg-runtest): Run tests in C++1y mode, too.
|
||||||
|
|||||||
141
gcc/testsuite/gfortran.dg/fmt_en.f90
Normal file
141
gcc/testsuite/gfortran.dg/fmt_en.f90
Normal file
@ -0,0 +1,141 @@
|
|||||||
|
! { dg-do run }
|
||||||
|
! PR60128 Invalid outputs with EN descriptors
|
||||||
|
! Test case provided by Walt Brainerd.
|
||||||
|
program pr60128
|
||||||
|
implicit none
|
||||||
|
integer :: n_tst = 0, n_cnt = 0
|
||||||
|
|
||||||
|
! Original test.
|
||||||
|
call checkfmt("(en15.2)", -.44444, " -444.44E-03")
|
||||||
|
|
||||||
|
! Test for the bug in comment 6.
|
||||||
|
call checkfmt("(en15.0)", 1.0, " 1.E+00")
|
||||||
|
call checkfmt("(en15.0)", 1.00000012, " 1.E+00")
|
||||||
|
call checkfmt("(en15.0)", 0.99999994, " 1.E+00")
|
||||||
|
call checkfmt("(en15.0)", 10.0, " 10.E+00")
|
||||||
|
call checkfmt("(en15.0)", 10.0000010, " 10.E+00")
|
||||||
|
call checkfmt("(en15.0)", 9.99999905, " 10.E+00")
|
||||||
|
call checkfmt("(en15.0)", 100.0, " 100.E+00")
|
||||||
|
call checkfmt("(en15.0)", 100.000008, " 100.E+00")
|
||||||
|
call checkfmt("(en15.0)", 99.9999924, " 100.E+00")
|
||||||
|
call checkfmt("(en15.0)", 1000.0, " 1.E+03")
|
||||||
|
call checkfmt("(en15.0)", 1000.00006, " 1.E+03")
|
||||||
|
call checkfmt("(en15.0)", 999.999939, " 1.E+03")
|
||||||
|
call checkfmt("(en15.0)", 9.5, " 10.E+00")
|
||||||
|
call checkfmt("(en15.0)", 9.50000095, " 10.E+00")
|
||||||
|
call checkfmt("(en15.0)", 9.49999905, " 9.E+00")
|
||||||
|
call checkfmt("(en15.0)", 99.5, " 100.E+00")
|
||||||
|
call checkfmt("(en15.0)", 99.5000076, " 100.E+00")
|
||||||
|
call checkfmt("(en15.0)", 99.4999924, " 99.E+00")
|
||||||
|
call checkfmt("(en15.0)", 999.5, " 1.E+03")
|
||||||
|
call checkfmt("(en15.0)", 999.500061, " 1.E+03")
|
||||||
|
call checkfmt("(en15.0)", 999.499939, " 999.E+00")
|
||||||
|
call checkfmt("(en15.0)", 9500.0, " 10.E+03")
|
||||||
|
call checkfmt("(en15.0)", 9500.00098, " 10.E+03")
|
||||||
|
call checkfmt("(en15.0)", 9499.99902, " 9.E+03")
|
||||||
|
call checkfmt("(en15.1)", 9950.0, " 10.0E+03")
|
||||||
|
call checkfmt("(en15.2)", 9995.0, " 10.00E+03")
|
||||||
|
call checkfmt("(en15.3)", 9999.5, " 10.000E+03")
|
||||||
|
call checkfmt("(en15.1)", 9.5, " 9.5E+00")
|
||||||
|
call checkfmt("(en15.1)", 9.50000095, " 9.5E+00")
|
||||||
|
call checkfmt("(en15.1)", 9.49999905, " 9.5E+00")
|
||||||
|
call checkfmt("(en15.1)", 0.099951, " 100.0E-03")
|
||||||
|
call checkfmt("(en15.1)", 0.009951, " 10.0E-03")
|
||||||
|
call checkfmt("(en15.1)", 0.000999951," 1.0E-03")
|
||||||
|
|
||||||
|
call checkfmt("(en15.0)", -1.0, " -1.E+00")
|
||||||
|
call checkfmt("(en15.0)", -1.00000012, " -1.E+00")
|
||||||
|
call checkfmt("(en15.0)", -0.99999994, " -1.E+00")
|
||||||
|
call checkfmt("(en15.0)", -10.0, " -10.E+00")
|
||||||
|
call checkfmt("(en15.0)", -10.0000010, " -10.E+00")
|
||||||
|
call checkfmt("(en15.0)", -9.99999905, " -10.E+00")
|
||||||
|
call checkfmt("(en15.0)", -100.0, " -100.E+00")
|
||||||
|
call checkfmt("(en15.0)", -100.000008, " -100.E+00")
|
||||||
|
call checkfmt("(en15.0)", -99.9999924, " -100.E+00")
|
||||||
|
call checkfmt("(en15.0)", -1000.0, " -1.E+03")
|
||||||
|
call checkfmt("(en15.0)", -1000.00006, " -1.E+03")
|
||||||
|
call checkfmt("(en15.0)", -999.999939, " -1.E+03")
|
||||||
|
call checkfmt("(en15.0)", -9.5, " -10.E+00")
|
||||||
|
call checkfmt("(en15.0)", -9.50000095, " -10.E+00")
|
||||||
|
call checkfmt("(en15.0)", -9.49999905, " -9.E+00")
|
||||||
|
call checkfmt("(en15.0)", -99.5, " -100.E+00")
|
||||||
|
call checkfmt("(en15.0)", -99.5000076, " -100.E+00")
|
||||||
|
call checkfmt("(en15.0)", -99.4999924, " -99.E+00")
|
||||||
|
call checkfmt("(en15.0)", -999.5, " -1.E+03")
|
||||||
|
call checkfmt("(en15.0)", -999.500061, " -1.E+03")
|
||||||
|
call checkfmt("(en15.0)", -999.499939, " -999.E+00")
|
||||||
|
call checkfmt("(en15.0)", -9500.0, " -10.E+03")
|
||||||
|
call checkfmt("(en15.0)", -9500.00098, " -10.E+03")
|
||||||
|
call checkfmt("(en15.0)", -9499.99902, " -9.E+03")
|
||||||
|
call checkfmt("(en15.1)", -9950.0, " -10.0E+03")
|
||||||
|
call checkfmt("(en15.2)", -9995.0, " -10.00E+03")
|
||||||
|
call checkfmt("(en15.3)", -9999.5, " -10.000E+03")
|
||||||
|
call checkfmt("(en15.1)", -9.5, " -9.5E+00")
|
||||||
|
call checkfmt("(en15.1)", -9.50000095, " -9.5E+00")
|
||||||
|
call checkfmt("(en15.1)", -9.49999905, " -9.5E+00")
|
||||||
|
call checkfmt("(en15.1)", -0.099951, " -100.0E-03")
|
||||||
|
call checkfmt("(en15.1)", -0.009951, " -10.0E-03")
|
||||||
|
call checkfmt("(en15.1)", -0.000999951," -1.0E-03")
|
||||||
|
|
||||||
|
call checkfmt("(en15.1)", 987350., " 987.4E+03")
|
||||||
|
call checkfmt("(en15.2)", 98735., " 98.74E+03")
|
||||||
|
call checkfmt("(en15.3)", 9873.5, " 9.874E+03")
|
||||||
|
call checkfmt("(en15.1)", 987650., " 987.6E+03")
|
||||||
|
call checkfmt("(en15.2)", 98765., " 98.76E+03")
|
||||||
|
call checkfmt("(en15.3)", 9876.5, " 9.876E+03")
|
||||||
|
call checkfmt("(en15.1)", 3.125E-02, " 31.2E-03")
|
||||||
|
call checkfmt("(en15.1)", 9.375E-02, " 93.8E-03")
|
||||||
|
call checkfmt("(en15.2)", 1.5625E-02, " 15.62E-03")
|
||||||
|
call checkfmt("(en15.2)", 4.6875E-02, " 46.88E-03")
|
||||||
|
call checkfmt("(en15.3)", 7.8125E-03, " 7.812E-03")
|
||||||
|
call checkfmt("(en15.3)", 2.34375E-02, " 23.438E-03")
|
||||||
|
call checkfmt("(en15.3)", 9.765625E-04," 976.562E-06")
|
||||||
|
call checkfmt("(en15.6)", 2.9296875E-03," 2.929688E-03")
|
||||||
|
|
||||||
|
call checkfmt("(en15.1)", -987350., " -987.4E+03")
|
||||||
|
call checkfmt("(en15.2)", -98735., " -98.74E+03")
|
||||||
|
call checkfmt("(en15.3)", -9873.5, " -9.874E+03")
|
||||||
|
call checkfmt("(en15.1)", -987650., " -987.6E+03")
|
||||||
|
call checkfmt("(en15.2)", -98765., " -98.76E+03")
|
||||||
|
call checkfmt("(en15.3)", -9876.5, " -9.876E+03")
|
||||||
|
call checkfmt("(en15.1)", -3.125E-02, " -31.2E-03")
|
||||||
|
call checkfmt("(en15.1)", -9.375E-02, " -93.8E-03")
|
||||||
|
call checkfmt("(en15.2)", -1.5625E-02, " -15.62E-03")
|
||||||
|
call checkfmt("(en15.2)", -4.6875E-02, " -46.88E-03")
|
||||||
|
call checkfmt("(en15.3)", -7.8125E-03, " -7.812E-03")
|
||||||
|
call checkfmt("(en15.3)", -2.34375E-02, " -23.438E-03")
|
||||||
|
call checkfmt("(en15.3)", -9.765625E-04," -976.562E-06")
|
||||||
|
call checkfmt("(en15.6)", -2.9296875E-03," -2.929688E-03")
|
||||||
|
|
||||||
|
!print *, n_tst, n_cnt
|
||||||
|
if (n_cnt /= 0) call abort
|
||||||
|
|
||||||
|
contains
|
||||||
|
subroutine checkfmt(fmt, x, cmp)
|
||||||
|
use ISO_FORTRAN_ENV
|
||||||
|
implicit none
|
||||||
|
integer, parameter :: j(size(real_kinds)+4)=[REAL_KINDS, [4, 4, 4, 4]]
|
||||||
|
integer :: i
|
||||||
|
character(len=*), intent(in) :: fmt
|
||||||
|
real, intent(in) :: x
|
||||||
|
character(len=*), intent(in) :: cmp
|
||||||
|
character(len=20) :: s
|
||||||
|
do i=1,size(real_kinds)
|
||||||
|
if (i == 1) then
|
||||||
|
write(s, fmt) real(x,kind=j(1))
|
||||||
|
else if (i == 2) then
|
||||||
|
write(s, fmt) real(x,kind=j(2))
|
||||||
|
else if (i == 3) then
|
||||||
|
write(s, fmt) real(x,kind=j(3))
|
||||||
|
else if (i == 4) then
|
||||||
|
write(s, fmt) real(x,kind=j(4))
|
||||||
|
end if
|
||||||
|
n_tst = n_tst + 1
|
||||||
|
if (s /= cmp) then
|
||||||
|
print "(a,1x,a,' expected: ',1x,a)", fmt, s, cmp
|
||||||
|
n_cnt = n_cnt + 1
|
||||||
|
end if
|
||||||
|
end do
|
||||||
|
|
||||||
|
end subroutine
|
||||||
|
end program
|
||||||
@ -1,3 +1,10 @@
|
|||||||
|
2014-03-08 Dominique d'Humieres <dominiq@lps.ens.fr>
|
||||||
|
|
||||||
|
PR libgfortran/60128
|
||||||
|
* io/write_float.def (output_float): Remove unused variable
|
||||||
|
nzero_real. Replace a double space with a single one.
|
||||||
|
(determine_en_precision): Fix wrong handling of the EN format.
|
||||||
|
|
||||||
2014-03-03 Jerry DeLisle <jvdelisle@gcc.gnu>
|
2014-03-03 Jerry DeLisle <jvdelisle@gcc.gnu>
|
||||||
|
|
||||||
PR libfortran/60148
|
PR libfortran/60148
|
||||||
|
|||||||
@ -125,8 +125,6 @@ output_float (st_parameter_dt *dtp, const fnode *f, char *buffer, size_t size,
|
|||||||
int nzero;
|
int nzero;
|
||||||
/* Number of digits after the decimal point. */
|
/* Number of digits after the decimal point. */
|
||||||
int nafter;
|
int nafter;
|
||||||
/* Number of zeros after the decimal point, whatever the precision. */
|
|
||||||
int nzero_real;
|
|
||||||
int leadzero;
|
int leadzero;
|
||||||
int nblanks;
|
int nblanks;
|
||||||
int ndigits, edigits;
|
int ndigits, edigits;
|
||||||
@ -138,7 +136,6 @@ output_float (st_parameter_dt *dtp, const fnode *f, char *buffer, size_t size,
|
|||||||
p = dtp->u.p.scale_factor;
|
p = dtp->u.p.scale_factor;
|
||||||
|
|
||||||
rchar = '5';
|
rchar = '5';
|
||||||
nzero_real = -1;
|
|
||||||
|
|
||||||
/* We should always know the field width and precision. */
|
/* We should always know the field width and precision. */
|
||||||
if (d < 0)
|
if (d < 0)
|
||||||
@ -191,7 +188,7 @@ output_float (st_parameter_dt *dtp, const fnode *f, char *buffer, size_t size,
|
|||||||
if (nafter < 0)
|
if (nafter < 0)
|
||||||
nafter = 0;
|
nafter = 0;
|
||||||
nafter = d;
|
nafter = d;
|
||||||
nzero = nzero_real = 0;
|
nzero = 0;
|
||||||
}
|
}
|
||||||
else /* p < 0 */
|
else /* p < 0 */
|
||||||
{
|
{
|
||||||
@ -211,14 +208,13 @@ output_float (st_parameter_dt *dtp, const fnode *f, char *buffer, size_t size,
|
|||||||
nafter = d + nbefore;
|
nafter = d + nbefore;
|
||||||
nbefore = 0;
|
nbefore = 0;
|
||||||
}
|
}
|
||||||
nzero_real = nzero;
|
|
||||||
if (nzero > d)
|
if (nzero > d)
|
||||||
nzero = d;
|
nzero = d;
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
else
|
else
|
||||||
{
|
{
|
||||||
nzero = nzero_real = 0;
|
nzero = 0;
|
||||||
nafter = d;
|
nafter = d;
|
||||||
}
|
}
|
||||||
|
|
||||||
@ -373,7 +369,7 @@ output_float (st_parameter_dt *dtp, const fnode *f, char *buffer, size_t size,
|
|||||||
updown:
|
updown:
|
||||||
|
|
||||||
rchar = '0';
|
rchar = '0';
|
||||||
if (ft != FMT_F && w > 0 && d == 0 && p == 0)
|
if (ft != FMT_F && w > 0 && d == 0 && p == 0)
|
||||||
nbefore = 1;
|
nbefore = 1;
|
||||||
/* Scan for trailing zeros to see if we really need to round it. */
|
/* Scan for trailing zeros to see if we really need to round it. */
|
||||||
for(i = nbefore + nafter; i < ndigits; i++)
|
for(i = nbefore + nafter; i < ndigits; i++)
|
||||||
@ -1153,14 +1149,36 @@ OUTPUT_FLOAT_FMT_G(16,L)
|
|||||||
/* EN format is tricky since the number of significant digits depends
|
/* EN format is tricky since the number of significant digits depends
|
||||||
on the magnitude. Solve it by first printing a temporary value and
|
on the magnitude. Solve it by first printing a temporary value and
|
||||||
figure out the number of significant digits from the printed
|
figure out the number of significant digits from the printed
|
||||||
exponent. */
|
exponent. Values y, 0.95*10.0**e <= y <10.0**e, are rounded to
|
||||||
|
10.0**e even when the final result will not be rounded to 10.0**e.
|
||||||
|
For these values the exponent returned by atoi has to be decremented
|
||||||
|
by one. The values y in the ranges
|
||||||
|
(1000.0-0.5*10.0**(-d))*10.0**(3*n) <= y < 10.0*(3*(n+1))
|
||||||
|
(100.0-0.5*10.0**(-d))*10.0**(3*n) <= y < 10.0*(3*n+2)
|
||||||
|
(10.0-0.5*10.0**(-d))*10.0**(3*n) <= y < 10.0*(3*n+1)
|
||||||
|
are correctly rounded respectively to 1.0...0*10.0*(3*(n+1)),
|
||||||
|
100.0...0*10.0*(3*n), and 10.0...0*10.0*(3*n), where 0...0
|
||||||
|
represents d zeroes, by the lines 279 to 297. */
|
||||||
|
|
||||||
#define EN_PREC(x,y)\
|
#define EN_PREC(x,y)\
|
||||||
{\
|
{\
|
||||||
GFC_REAL_ ## x tmp; \
|
volatile GFC_REAL_ ## x tmp, one = 1.0;\
|
||||||
tmp = * (GFC_REAL_ ## x *)source; \
|
tmp = * (GFC_REAL_ ## x *)source;\
|
||||||
if (ISFINITE (y,tmp)) \
|
if (ISFINITE (y,tmp))\
|
||||||
nprinted = DTOA(y,0,tmp); \
|
{\
|
||||||
|
nprinted = DTOA(y,0,tmp);\
|
||||||
|
int e = atoi (&buffer[4]);\
|
||||||
|
if (buffer[1] == '1')\
|
||||||
|
{\
|
||||||
|
tmp = (calculate_exp_ ## x (-e)) * tmp;\
|
||||||
|
tmp = one - (tmp < 0 ? -tmp : tmp); \
|
||||||
|
if (tmp > 0)\
|
||||||
|
e = e - 1;\
|
||||||
|
}\
|
||||||
|
nbefore = e%3;\
|
||||||
|
if (nbefore < 0)\
|
||||||
|
nbefore = 3 + nbefore;\
|
||||||
|
}\
|
||||||
else\
|
else\
|
||||||
nprinted = -1;\
|
nprinted = -1;\
|
||||||
}\
|
}\
|
||||||
@ -1172,6 +1190,7 @@ determine_en_precision (st_parameter_dt *dtp, const fnode *f,
|
|||||||
int nprinted;
|
int nprinted;
|
||||||
char buffer[10];
|
char buffer[10];
|
||||||
const size_t size = 10;
|
const size_t size = 10;
|
||||||
|
int nbefore; /* digits before decimal point - 1. */
|
||||||
|
|
||||||
switch (len)
|
switch (len)
|
||||||
{
|
{
|
||||||
@ -1204,16 +1223,6 @@ determine_en_precision (st_parameter_dt *dtp, const fnode *f,
|
|||||||
if (nprinted == -1)
|
if (nprinted == -1)
|
||||||
return -1;
|
return -1;
|
||||||
|
|
||||||
int e = atoi (&buffer[5]);
|
|
||||||
int nbefore; /* digits before decimal point - 1. */
|
|
||||||
if (e >= 0)
|
|
||||||
nbefore = e % 3;
|
|
||||||
else
|
|
||||||
{
|
|
||||||
nbefore = (-e) % 3;
|
|
||||||
if (nbefore != 0)
|
|
||||||
nbefore = 3 - nbefore;
|
|
||||||
}
|
|
||||||
int prec = f->u.real.d + nbefore;
|
int prec = f->u.real.d + nbefore;
|
||||||
if (dtp->u.p.current_unit->round_status != ROUND_UNSPECIFIED
|
if (dtp->u.p.current_unit->round_status != ROUND_UNSPECIFIED
|
||||||
&& dtp->u.p.current_unit->round_status != ROUND_PROCDEFINED)
|
&& dtp->u.p.current_unit->round_status != ROUND_PROCDEFINED)
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user