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.

diff --git a/gcc/testsuite/gfortran.dg/round_3.f08 b/gcc/testsuite/gfortran.dg/round_3.f08
index 57d8339553140281e8557c342dd7434f7254411e..4a0a692fa7bf77947cafdfd2659f0a8db2a45160 100644 (file)
--- a/gcc/testsuite/gfortran.dg/round_3.f08
+++ b/gcc/testsuite/gfortran.dg/round_3.f08
@@ -110,6 +110,30 @@ program pr48615
     call checkfmt("(RU,E17.1)", nearest(2.0, 1.0),     "          0.3E+01")
     call checkfmt("(RD,E17.1)", nearest(3.0, -1.0),    "          0.2E+01")
 
+    call checkfmt("(G12.2)", 99.0,       "     99.    ")
+    call checkfmt("(G12.2)", 99.5,       "    0.10E+03")
+    call checkfmt("(G12.2)", 100.0,      "    0.10E+03")
+    call checkfmt("(G12.2)", -99.0,      "    -99.    ")
+    call checkfmt("(G12.2)", -99.5,      "   -0.10E+03")
+    call checkfmt("(G12.2)", -100.0,     "   -0.10E+03")
+    call checkfmt("(RU,G12.2)", 99.0,    "     99.    ")    ! pr93567
+    call checkfmt("(RU,G12.2)", 99.01,   "    0.10E+03")
+    call checkfmt("(RU,G12.2)", -99.0,   "    -99.    ")
+    call checkfmt("(RU,G12.2)", -99.01,  "    -99.    ")
+    call checkfmt("(RU,G12.2)", -100.01, "   -0.10E+03")
+    call checkfmt("(RU,G12.4)", 99.0 ,   "   99.00    ")
+    call checkfmt("(RU,G12.4)", 99.01,   "   99.02    ")
+    call checkfmt("(RD,G12.2)", 99.0,    "     99.    ")
+    call checkfmt("(RD,G12.2)", 99.01,   "     99.    ")
+    call checkfmt("(RD,G12.2)", 100.01,  "    0.10E+03")
+    call checkfmt("(RD,G12.2)", -99.0,   "    -99.    ")
+    call checkfmt("(RD,G12.2)", -99.01,  "   -0.10E+03")
+    call checkfmt("(RD,G12.2)", -100.00, "   -0.10E+03")
+    call checkfmt("(Rz,G12.2)", 99.01,   "     99.    ")
+    call checkfmt("(Rz,G12.2)", 100.01,  "    0.10E+03")
+    call checkfmt("(Rz,G12.2)", -99.01,  "    -99.    ")
+    call checkfmt("(Rz,G12.2)", -100.01, "   -0.10E+03")
+
 contains
     subroutine checkfmt(fmt, x, cmp)
         character(len=*), intent(in) :: fmt
@@ -119,6 +143,6 @@ contains
         
         write(s, fmt) x
         if (s /= cmp) STOP 1
-        !if (s /= cmp) print "(a,1x,a,' expected: ',1x)", fmt, s, cmp
+        !if (s /= cmp) print "(a,1x,a,' expected: ',1x,a)", fmt, s, cmp
     end subroutine
 end program

diff --git a/libgfortran/io/write_float.def b/libgfortran/io/write_float.def
index 3311db3120919383e4cc127745a9ce446860ac29..9a4462c11171dc97005d49d577221fed3f31bd5e 100644 (file)
--- 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)\