diff options
author | Dominique d'Humieres <dhumieres.dominique@free.fr> | 2020-07-24 20:27:53 +0200 |
---|---|---|
committer | Thomas Koenig <tkoenig@gcc.gnu.org> | 2020-07-24 20:47:47 +0200 |
commit | aa7e7eff5ec165dc8463a0e74309801b15d1feda (patch) | |
tree | 237c249a7dcaafe8c18ac9b32062f9b5b4eb208c /libgfortran | |
parent | 05e0971bcf94a481cbfa2731484f024a67dbd4a5 (diff) | |
download | gcc-aa7e7eff5ec165dc8463a0e74309801b15d1feda.zip gcc-aa7e7eff5ec165dc8463a0e74309801b15d1feda.tar.gz gcc-aa7e7eff5ec165dc8463a0e74309801b15d1feda.tar.bz2 |
PR 93567, G edit descriptor uses E instead of F editing in rounding mode UP.
The switch between FMT_E and FMT_F is based on the absolute value.
Set r=0 for rounding toward zero and r = 1 otherwise.
If (exp_d - m) == 1 there is no rounding needed.
libgfortran/ChangeLog:
PR fortran/93567
* io/write_float.def (determine_en_precision): Fix switch between
FMT_E and FMT_F.
gcc/testsuite/ChangeLog:
PR fortran/93567
* gfortran.dg/round_3.f08: Add test cases.
Diffstat (limited to 'libgfortran')
-rw-r--r-- | libgfortran/io/write_float.def | 12 |
1 files changed, 8 insertions, 4 deletions
diff --git a/libgfortran/io/write_float.def b/libgfortran/io/write_float.def index 3311db3..9a4462c 100644 --- a/libgfortran/io/write_float.def +++ b/libgfortran/io/write_float.def @@ -988,16 +988,19 @@ determine_en_precision (st_parameter_dt *dtp, const fnode *f, w = default_width;\ d = precision;\ }\ + /* The switch between FMT_E and FMT_F is based on the absolute value. \ + Set r=0 for rounding toward zero and r = 1 otherwise. \ + If (exp_d - m) == 1 there is no rounding needed. */\ switch (dtp->u.p.current_unit->round_status)\ {\ case ROUND_ZERO:\ - r = sign_bit ? 1.0 : 0.0;\ + r = 0.0;\ break;\ case ROUND_UP:\ - r = 1.0;\ + r = sign_bit ? 0.0 : 1.0;\ break;\ case ROUND_DOWN:\ - r = 0.0;\ + r = sign_bit ? 1.0 : 0.0;\ break;\ default:\ break;\ @@ -1005,7 +1008,8 @@ determine_en_precision (st_parameter_dt *dtp, const fnode *f, exp_d = calculate_exp_ ## x (d);\ r_sc = (1 - r / exp_d);\ temp = 0.1 * r_sc;\ - if ((m > 0.0 && ((m < temp) || (r >= (exp_d - m))))\ + if ((m > 0.0 && ((m < temp) || (r < 1 && r >= (exp_d - m))\ + || (r == 1 && 1 > (exp_d - m))))\ || ((m == 0.0) && !(compile_options.allow_std\ & (GFC_STD_F2003 | GFC_STD_F2008)))\ || d == 0)\ |