procyberian/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

re PR libfortran/48602 (Invalid F conversion of G descriptor for values close to powers of 10)

Browse source 
2011-04-17  Jerry DeLisle  <jvdelisle@gcc.gnu.org>

	PR libgfortran/48602
	* io/write_float.def (output_float_FMT_G): Use current rounding mode
	to set the rounding parameters. (output_float): Skip rounding
	if value is zero.

From-SVN: r172634
This commit is contained in:
Jerry DeLisle 2011-04-18 03:48:25 +00:00
parent 4ddd8a74ba
commit bc7409a8a9
2 changed files with 31 additions and 5 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

7
libgfortran/ChangeLog
View file

@ -1,3 +1,10 @@
2011-04-17 Jerry DeLisle <jvdelisle@gcc.gnu.org>
PR libgfortran/48602
* io/write_float.def (output_float_FMT_G): Use current rounding mode
to set the rounding parameters. (output_float): Skip rounding
if value is zero.
2011-04-16 Janne Blomqvist <jb@gcc.gnu.org>
* intrinsics/date_and_time.c (date_and_time): Remove sprintf CPP

29
libgfortran/io/write_float.def
View file

@ -221,6 +221,8 @@ output_float (st_parameter_dt *dtp, const fnode *f, char *buffer, size_t size,
internal_error (&dtp->common, "Unexpected format token");
}
if (zero_flag)
goto skip;
/* Round the value. The value being rounded is an unsigned magnitude.
The ROUND_COMPATIBLE is rounding away from zero when there is a tie. */
switch (dtp->u.p.current_unit->round_status)
@ -802,7 +804,8 @@ CALCULATE_EXP(16)
m >= 10**d-0.5 Ew.d[Ee]
notes: for Gw.d , n' ' means 4 blanks
for Gw.dEe, n' ' means e+2 blanks */
for Gw.dEe, n' ' means e+2 blanks
for rounding modes adjustment, r, See Fortran F2008 10.7.5.2.2 */
#define OUTPUT_FLOAT_FMT_G(x) \
static void \
@ -814,7 +817,7 @@ output_float_FMT_G_ ## x (st_parameter_dt *dtp, const fnode *f, \
int d = f->u.real.d;\
int w = f->u.real.w;\
fnode *newf;\
GFC_REAL_ ## x rexp_d;\
GFC_REAL_ ## x rexp_d, r = 0.5;\
int low, high, mid;\
int ubound, lbound;\
char *p, pad = ' ';\
@ -823,10 +826,26 @@ output_float_FMT_G_ ## x (st_parameter_dt *dtp, const fnode *f, \
\
save_scale_factor = dtp->u.p.scale_factor;\
newf = (fnode *) get_mem (sizeof (fnode));\
\
switch (dtp->u.p.current_unit->round_status)\
{\
case ROUND_ZERO:\
r = sign_bit ? 0.0 : 1.0;\
break;\
case ROUND_UP:\
r = 1.0;\
break;\
case ROUND_DOWN:\
r = 0.0;\
break;\
default:\
break;\
}\
\
rexp_d = calculate_exp_ ## x (-d);\
if ((m > 0.0 && m < 0.1 - 0.05 * rexp_d) || (rexp_d * (m + 0.5) >= 1.0) ||\
((m == 0.0) && !(compile_options.allow_std & GFC_STD_F2003)))\
if ((m > 0.0 && ((m < 0.1 - 0.1 * r * rexp_d) || (rexp_d * (m + r) >= 1.0)))\
|| ((m == 0.0) && !(compile_options.allow_std\
& (GFC_STD_F2003 | GFC_STD_F2008))))\
{ \
newf->format = FMT_E;\
newf->u.real.w = w;\
@ -847,7 +866,7 @@ output_float_FMT_G_ ## x (st_parameter_dt *dtp, const fnode *f, \
GFC_REAL_ ## x temp;\
mid = (low + high) / 2;\
\
temp = (calculate_exp_ ## x (mid - 1) * (1 - 0.5 * rexp_d));\
temp = (calculate_exp_ ## x (mid - 1) * (1 - r * rexp_d));\
\
if (m < temp)\
{ \