From: Jerry DeLisle <jvdelisle@gcc.gnu.org>
Date: Sat, 15 Feb 2014 16:53:07 +0000 (+0000)
Subject: backport: re PR libfortran/59771 (Cleanup handling of Gw.0 and Gw.0Ee format)
X-Git-Tag: releases/gcc-4.7.4~249
X-Git-Url: http://git.ipfire.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=50a0547289795862af8a39b6338132f4f7951ebc;p=thirdparty%2Fgcc.git

backport: re PR libfortran/59771 (Cleanup handling of Gw.0 and Gw.0Ee format)

2014-02-15  Jerry DeLisle  <jvdelisle@gcc.gnu>
	    Dominique d'Humieres  <dominiq@lps.ens.fr>

	Backport from mainline
	PR libfortran/59771
	PR libfortran/59774
	PR libfortran/59836
	* io/write_float.def (output_float): Fix wrong handling of the
	Fw.0 format.
	(output_float_FMT_G_): Fixes rounding issues with -m32.

Co-Authored-By: Dominique d'Humieres <dominiq@lps.ens.fr>

From-SVN: r207803
---

diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog
index 252a90c612ad..c8f77fe00adc 100644
--- a/libgfortran/ChangeLog
+++ b/libgfortran/ChangeLog
@@ -1,3 +1,14 @@
+2014-02-15  Jerry DeLisle  <jvdelisle@gcc.gnu>
+	    Dominique d'Humieres  <dominiq@lps.ens.fr>
+
+	Backport from mainline
+	PR libfortran/59771
+	PR libfortran/59774
+	PR libfortran/59836
+	* io/write_float.def (output_float): Fix wrong handling of the
+	Fw.0 format.
+	(output_float_FMT_G_): Fixes rounding issues with -m32.
+
 2013-07-03  Uros Bizjak  <ubizjak@gmail.com>
 
 	Backport from mainline
diff --git a/libgfortran/io/write_float.def b/libgfortran/io/write_float.def
index 78f09b298208..c3e7410ccd67 100644
--- a/libgfortran/io/write_float.def
+++ b/libgfortran/io/write_float.def
@@ -273,7 +273,7 @@ output_float (st_parameter_dt *dtp, const fnode *f, char *buffer, size_t size,
   updown:
 
   rchar = '0';
-  if (w > 0 && d == 0 && p == 0)
+  if (ft != FMT_F && w > 0 && d == 0 && p == 0)
     nbefore = 1;
   /* Scan for trailing zeros to see if we really need to round it.  */
   for(i = nbefore + nafter; i < ndigits; i++)
@@ -288,11 +288,20 @@ output_float (st_parameter_dt *dtp, const fnode *f, char *buffer, size_t size,
   if (nbefore + nafter == 0)
     {
       ndigits = 0;
-      if (nzero_real == d && digits[0] >= rchar)
+      if ((d == 0 || nzero_real == d) && digits[0] >= rchar)
 	{
 	  /* We rounded to zero but shouldn't have */
-	  nzero--;
-	  nafter = 1;
+	  if (d != 0)
+	    {
+	      nzero--;
+	      nafter = 1;
+	    }
+	  else
+	    {
+              /* Handle the case Fw.0 and value < 1.0 */
+	      nbefore = 1;
+	      digits--;
+	    }
 	  digits[0] = '1';
 	  ndigits = 1;
 	}
@@ -828,12 +837,13 @@ 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, r = 0.5;\
+  GFC_REAL_ ## x exp_d, r = 0.5, r_sc;\
   int low, high, mid;\
   int ubound, lbound;\
   char *p, pad = ' ';\
   int save_scale_factor, nb = 0;\
   try result;\
+  volatile GFC_REAL_ ## x temp;\
 \
   save_scale_factor = dtp->u.p.scale_factor;\
   newf = (fnode *) get_mem (sizeof (fnode));\
@@ -853,10 +863,13 @@ output_float_FMT_G_ ## x (st_parameter_dt *dtp, const fnode *f, \
 	break;\
     }\
 \
-  rexp_d = calculate_exp_ ## x (-d);\
-  if ((m > 0.0 && ((m < 0.1 - 0.1 * r * rexp_d) || (rexp_d * (m + r) >= 1.0)))\
+  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))))\
       || ((m == 0.0) && !(compile_options.allow_std\
-			  & (GFC_STD_F2003 | GFC_STD_F2008))))\
+			  & (GFC_STD_F2003 | GFC_STD_F2008)))\
+      ||  d == 0)\
     { \
       newf->format = FMT_E;\
       newf->u.real.w = w;\
@@ -874,10 +887,9 @@ output_float_FMT_G_ ## x (st_parameter_dt *dtp, const fnode *f, \
 \
   while (low <= high)\
     { \
-      volatile GFC_REAL_ ## x temp;\
       mid = (low + high) / 2;\
 \
-      temp = (calculate_exp_ ## x (mid - 1) * (1 - r * rexp_d));\
+      temp = (calculate_exp_ ## x (mid - 1) * r_sc);\
 \
       if (m < temp)\
         { \