[gcc(refs/users/guojiufu/heads/personal-branch)] PR 93567, G edit descriptor uses E instead of F editing in rounding mode UP.

[Jiu Fu Guo]

https://gcc.gnu.org/g:aa7e7eff5ec165dc8463a0e74309801b15d1feda

commit aa7e7eff5ec165dc8463a0e74309801b15d1feda
Author: Dominique d'Humieres <dhumieres.dominique@free.fr>
Date:   Fri Jul 24 20:27:53 2020 +0200

    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:
---
 gcc/testsuite/gfortran.dg/round_3.f08 | 26 +++++++++++++++++++++++++-
 libgfortran/io/write_float.def        | 12 ++++++++----
 2 files changed, 33 insertions(+), 5 deletions(-)

diff --git a/gcc/testsuite/gfortran.dg/round_3.f08 b/gcc/testsuite/gfortran.dg/round_3.f08
index 57d83395531..4a0a692fa7b 100644
--- 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 3311db31209..9a4462c1117 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)\