diff mbox series

[fortran] PR 93567 - G edit descriptor uses E instead of F editing in rounding mode UP

Message ID 0c70d7b759a2764cbc80bf8676dccd87@free.fr
State New
Headers show
Series [fortran] PR 93567 - G edit descriptor uses E instead of F editing in rounding mode UP | expand

Commit Message

dhumieres.dominique@free.fr July 21, 2020, 10:09 p.m. UTC 
I am not set up to commit on git, someone will have to do it for me.

TIA

Dominique

Comments

Thomas Koenig July 24, 2020, 6:50 p.m. UTC | #1 
Hi Dominique,

also committed.

Regards

	Thomas
diff mbox series

Patch

--- ../_clean/libgfortran/io/write_float.def	2020-06-13 03:11:55.000000000 +0200
+++ libgfortran/io/write_float.def	2020-07-21 23:03:08.000000000 +0200
@@ -987,16 +987,19 @@  determine_en_precision (st_parameter_dt 
 	  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;\
@@ -1004,7 +1007,8 @@  determine_en_precision (st_parameter_dt 
       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)\
--- ../_clean/gcc/testsuite/gfortran.dg/round_3.f08	2020-06-13 03:11:54.000000000 +0200
+++ gcc/testsuite/gfortran.dg/round_3.f08	2020-07-21 01:14:56.000000000 +0200
@@ -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