Patchwork [libgfortran] PR60128 Wrong ouput using en edit descriptor

login
register
mail settings
Submitter Dominique Dhumieres
Date March 7, 2014, 10:05 p.m.
Message ID <E6A4D766-E094-4F15-BDF7-AA38F63497C5@lps.ens.fr>
Download mbox | patch
Permalink /patch/328092/
State New
Headers show

Comments

Dominique Dhumieres - March 7, 2014, 10:05 p.m.
Hi all!

Patch for pr60128. It is basically the patch posted at =
http://gcc.gnu.org/bugzilla/show_bug.cgi?id=3D60128#c7. I have made tmp =
volatile (although I did not see any differences between -m32 and -m64) =
and added a comment (please feel free to improve the wording).  I have =
also fixed a double space and removed the unused variable nzero_real.

I have regtested 4.8.4 and trunk on x86_64-apple-darwin13 and trunk on =
powerpc-apple-darwin9.

Dominique

2014-03-08  Dominique d'Humieres  <dominiq@lps.ens.fr>

	PR libgfortran/60128
	* io/write_float.def (output_float): Remove unused variable
	nzero_real. Replace a double space with a single one.
	(determine_en_precision): Fix wrong handling of the EN format.

	PR libfortran/60128
	* gfortran.dg/fmt_en.f90: New test.


! { dg-do run }
! PR60128 Invalid outputs with EN descriptors
! Test case provided by Walt Brainerd.
program pr60128
implicit none
   integer :: n_tst = 0, n_cnt = 0

! Original test.
   call checkfmt("(en15.2)", -.44444,    "    -444.44E-03")

! Test for the bug in comment 6.
   call checkfmt("(en15.0)", 1.0,        "         1.E+00")
   call checkfmt("(en15.0)", 1.00000012, "         1.E+00")
   call checkfmt("(en15.0)", 0.99999994, "         1.E+00")
   call checkfmt("(en15.0)", 10.0,       "        10.E+00")
   call checkfmt("(en15.0)", 10.0000010, "        10.E+00")
   call checkfmt("(en15.0)", 9.99999905, "        10.E+00")
   call checkfmt("(en15.0)", 100.0,      "       100.E+00")
   call checkfmt("(en15.0)", 100.000008, "       100.E+00")
   call checkfmt("(en15.0)", 99.9999924, "       100.E+00")
   call checkfmt("(en15.0)", 1000.0,     "         1.E+03")
   call checkfmt("(en15.0)", 1000.00006, "         1.E+03")
   call checkfmt("(en15.0)", 999.999939, "         1.E+03")
   call checkfmt("(en15.0)", 9.5,        "        10.E+00")
   call checkfmt("(en15.0)", 9.50000095, "        10.E+00")
   call checkfmt("(en15.0)", 9.49999905, "         9.E+00")
   call checkfmt("(en15.0)", 99.5,       "       100.E+00")
   call checkfmt("(en15.0)", 99.5000076, "       100.E+00")
   call checkfmt("(en15.0)", 99.4999924, "        99.E+00")
   call checkfmt("(en15.0)", 999.5,      "         1.E+03")
   call checkfmt("(en15.0)", 999.500061, "         1.E+03")
   call checkfmt("(en15.0)", 999.499939, "       999.E+00")
   call checkfmt("(en15.0)", 9500.0,     "        10.E+03")
   call checkfmt("(en15.0)", 9500.00098, "        10.E+03")
   call checkfmt("(en15.0)", 9499.99902, "         9.E+03")
   call checkfmt("(en15.1)", 9950.0,     "       10.0E+03")
   call checkfmt("(en15.2)", 9995.0,     "      10.00E+03")
   call checkfmt("(en15.3)", 9999.5,     "     10.000E+03")
   call checkfmt("(en15.1)", 9.5,        "        9.5E+00")
   call checkfmt("(en15.1)", 9.50000095, "        9.5E+00")
   call checkfmt("(en15.1)", 9.49999905, "        9.5E+00")
   call checkfmt("(en15.1)", 0.099951,   "      100.0E-03")
   call checkfmt("(en15.1)", 0.009951,   "       10.0E-03")
   call checkfmt("(en15.1)", 0.000999951,"        1.0E-03")

   call checkfmt("(en15.0)", -1.0,        "        -1.E+00")
   call checkfmt("(en15.0)", -1.00000012, "        -1.E+00")
   call checkfmt("(en15.0)", -0.99999994, "        -1.E+00")
   call checkfmt("(en15.0)", -10.0,       "       -10.E+00")
   call checkfmt("(en15.0)", -10.0000010, "       -10.E+00")
   call checkfmt("(en15.0)", -9.99999905, "       -10.E+00")
   call checkfmt("(en15.0)", -100.0,      "      -100.E+00")
   call checkfmt("(en15.0)", -100.000008, "      -100.E+00")
   call checkfmt("(en15.0)", -99.9999924, "      -100.E+00")
   call checkfmt("(en15.0)", -1000.0,     "        -1.E+03")
   call checkfmt("(en15.0)", -1000.00006, "        -1.E+03")
   call checkfmt("(en15.0)", -999.999939, "        -1.E+03")
   call checkfmt("(en15.0)", -9.5,        "       -10.E+00")
   call checkfmt("(en15.0)", -9.50000095, "       -10.E+00")
   call checkfmt("(en15.0)", -9.49999905, "        -9.E+00")
   call checkfmt("(en15.0)", -99.5,       "      -100.E+00")
   call checkfmt("(en15.0)", -99.5000076, "      -100.E+00")
   call checkfmt("(en15.0)", -99.4999924, "       -99.E+00")
   call checkfmt("(en15.0)", -999.5,      "        -1.E+03")
   call checkfmt("(en15.0)", -999.500061, "        -1.E+03")
   call checkfmt("(en15.0)", -999.499939, "      -999.E+00")
   call checkfmt("(en15.0)", -9500.0,     "       -10.E+03")
   call checkfmt("(en15.0)", -9500.00098, "       -10.E+03")
   call checkfmt("(en15.0)", -9499.99902, "        -9.E+03")
   call checkfmt("(en15.1)", -9950.0,     "      -10.0E+03")
   call checkfmt("(en15.2)", -9995.0,     "     -10.00E+03")
   call checkfmt("(en15.3)", -9999.5,     "    -10.000E+03")
   call checkfmt("(en15.1)", -9.5,        "       -9.5E+00")
   call checkfmt("(en15.1)", -9.50000095, "       -9.5E+00")
   call checkfmt("(en15.1)", -9.49999905, "       -9.5E+00")
   call checkfmt("(en15.1)", -0.099951,   "     -100.0E-03")
   call checkfmt("(en15.1)", -0.009951,   "      -10.0E-03")
   call checkfmt("(en15.1)", -0.000999951,"       -1.0E-03")

   call checkfmt("(en15.1)", 987350.,     "      987.4E+03")
   call checkfmt("(en15.2)", 98735.,      "      98.74E+03")
   call checkfmt("(en15.3)", 9873.5,      "      9.874E+03")
   call checkfmt("(en15.1)", 987650.,     "      987.6E+03")
   call checkfmt("(en15.2)", 98765.,      "      98.76E+03")
   call checkfmt("(en15.3)", 9876.5,      "      9.876E+03")
   call checkfmt("(en15.1)", 3.125E-02,   "       31.2E-03")
   call checkfmt("(en15.1)", 9.375E-02,   "       93.8E-03")
   call checkfmt("(en15.2)", 1.5625E-02,  "      15.62E-03")
   call checkfmt("(en15.2)", 4.6875E-02,  "      46.88E-03")
   call checkfmt("(en15.3)", 7.8125E-03,  "      7.812E-03")
   call checkfmt("(en15.3)", 2.34375E-02, "     23.438E-03")
   call checkfmt("(en15.3)", 9.765625E-04,"    976.562E-06")
   call checkfmt("(en15.6)", 2.9296875E-03,"   2.929688E-03")

   call checkfmt("(en15.1)", -987350.,     "     -987.4E+03")
   call checkfmt("(en15.2)", -98735.,      "     -98.74E+03")
   call checkfmt("(en15.3)", -9873.5,      "     -9.874E+03")
   call checkfmt("(en15.1)", -987650.,     "     -987.6E+03")
   call checkfmt("(en15.2)", -98765.,      "     -98.76E+03")
   call checkfmt("(en15.3)", -9876.5,      "     -9.876E+03")
   call checkfmt("(en15.1)", -3.125E-02,   "      -31.2E-03")
   call checkfmt("(en15.1)", -9.375E-02,   "      -93.8E-03")
   call checkfmt("(en15.2)", -1.5625E-02,  "     -15.62E-03")
   call checkfmt("(en15.2)", -4.6875E-02,  "     -46.88E-03")
   call checkfmt("(en15.3)", -7.8125E-03,  "     -7.812E-03")
   call checkfmt("(en15.3)", -2.34375E-02, "    -23.438E-03")
   call checkfmt("(en15.3)", -9.765625E-04,"   -976.562E-06")
   call checkfmt("(en15.6)", -2.9296875E-03,"  -2.929688E-03")

   print *, n_tst, n_cnt
   if (n_cnt /= 0) call abort

contains
   subroutine checkfmt(fmt, x, cmp)
       use ISO_FORTRAN_ENV
       implicit none
       integer, parameter :: j(size(real_kinds)+4)=[REAL_KINDS, [4, 4, 4, 4]]
       integer :: i
       character(len=*), intent(in) :: fmt
       real, intent(in) :: x
       character(len=*), intent(in) :: cmp
       character(len=20) :: s
       do i=1,size(real_kinds)
         if (i == 1) then
           write(s, fmt) real(x,kind=j(1))
         else if (i == 2) then
           write(s, fmt) real(x,kind=j(2))
         else if (i == 3) then
           write(s, fmt) real(x,kind=j(3))
         else if (i == 4) then
           write(s, fmt) real(x,kind=j(4))
         end if
         n_tst = n_tst + 1
         if (s /= cmp) then
            print "(a,1x,a,' expected: ',1x,a)", fmt, s, cmp
            n_cnt = n_cnt + 1
          end if
       end do

   end subroutine
end program

--Apple-Mail=_1DBE7B5C-A706-447E-AF87-1D205882FD33
Content-Transfer-Encoding: 7bit
Content-Type: text/html;
	charset=us-ascii

--Apple-Mail=_1DBE7B5C-A706-447E-AF87-1D205882FD33--

--Apple-Mail=_A4A12A44-95D9-4ED2-935A-B85167B6BE6F--
jerry DeLisle - March 8, 2014, 2:05 a.m.
On 03/07/2014 02:05 PM, Dominique d'Humières wrote:
> 
> Hi all!
> 
> Patch for pr60128. It is basically the patch posted at =
> http://gcc.gnu.org/bugzilla/show_bug.cgi?id=3D60128#c7. I have made tmp =
> volatile (although I did not see any differences between -m32 and -m64) =
> and added a comment (please feel free to improve the wording).  I have =
> also fixed a double space and removed the unused variable nzero_real.
> 
> I have regtested 4.8.4 and trunk on x86_64-apple-darwin13 and trunk on =
> powerpc-apple-darwin9.
> 

Super, I will reapply, test and commit. I also added the volatile, but did not
see any difference on -m32 and -m64 either.

Thanks for the patch.

Jerry

Patch

--- ../_clean/libgfortran/io/write_float.def	2014-01-21 08:30:57.000000000 +0100
+++ libgfortran/io/write_float.def	2014-03-04 16:13:05.000000000 +0100
@@ -125,8 +125,6 @@  output_float (st_parameter_dt *dtp, cons
  int nzero;
  /* Number of digits after the decimal point.  */
  int nafter;
-  /* Number of zeros after the decimal point, whatever the precision.  */
-  int nzero_real;
  int leadzero;
  int nblanks;
  int ndigits, edigits;
@@ -138,7 +136,6 @@  output_float (st_parameter_dt *dtp, cons
  p = dtp->u.p.scale_factor;

  rchar = '5';
-  nzero_real = -1;

  /* We should always know the field width and precision.  */
  if (d < 0)
@@ -191,7 +188,7 @@  output_float (st_parameter_dt *dtp, cons
	      if (nafter < 0)
		nafter = 0;
	      nafter = d;
-	      nzero = nzero_real = 0;
+	      nzero = 0;
	    }
	  else /* p < 0  */
	    {
@@ -211,14 +208,13 @@  output_float (st_parameter_dt *dtp, cons
		  nafter = d + nbefore;
		  nbefore = 0;
		}
-	      nzero_real = nzero;
	      if (nzero > d)
		nzero = d;
	    }
	}
      else
	{
-	  nzero = nzero_real = 0;
+	  nzero = 0;
	  nafter = d;
	}

@@ -373,7 +369,7 @@  output_float (st_parameter_dt *dtp, cons
  updown:

  rchar = '0';
-  if  (ft != FMT_F && 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++)
@@ -1153,17 +1149,39 @@  OUTPUT_FLOAT_FMT_G(16,L)
/* EN format is tricky since the number of significant digits depends
   on the magnitude.  Solve it by first printing a temporary value and
   figure out the number of significant digits from the printed
-   exponent.  */
-
-#define EN_PREC(x,y)\
-{\
-    GFC_REAL_ ## x tmp;				\
-    tmp = * (GFC_REAL_ ## x *)source;				\
-    if (ISFINITE (y,tmp))					\
-      nprinted = DTOA(y,0,tmp);					\
-    else\
-      nprinted = -1;\
-}\
+   exponent.  Values y, 0.95*10.0**e <= y <10.0**e, are rounded to
+   10.0**e even when the final result will not be rounded to 10.0**e.
+   For these values the exponent returned by atoi has to be decremented
+   by one. The values y in the ranges
+       (1000.0-0.5*10.0**(-d))*10.0**(3*n) <= y < 10.0*(3*(n+1))  
+        (100.0-0.5*10.0**(-d))*10.0**(3*n) <= y < 10.0*(3*n+2)
+         (10.0-0.5*10.0**(-d))*10.0**(3*n) <= y < 10.0*(3*n+1)
+   are correctly rounded respectively to 1.0...0*10.0*(3*(n+1)),
+   100.0...0*10.0*(3*n), and 10.0...0*10.0*(3*n), where 0...0
+   represents d zeroes, by the lines 279 to 297. */
+
+#define EN_PREC(x,y)					\
+{							\
+    volatile GFC_REAL_ ## x tmp, one = 1.0;		\
+    tmp = * (GFC_REAL_ ## x *)source;			\
+    if (ISFINITE (y,tmp))				\
+      {							\
+	nprinted = DTOA(y,0,tmp);			\
+	int e = atoi (&buffer[4]);			\
+	if (buffer[1] == '1')				\
+	  {						\
+	    tmp = (calculate_exp_ ## x (-e)) * tmp;	\
+	    tmp = one - (tmp < 0 ? -tmp : tmp);		\
+	    if (tmp > 0)				\
+	      e = e - 1;				\
+	  }						\
+	nbefore = e%3;					\
+	if (nbefore < 0)				\
+	  nbefore = 3 + nbefore;			\
+      }							\
+    else						\
+      nprinted = -1;					\
+}							\

static int
determine_en_precision (st_parameter_dt *dtp, const fnode *f, 
@@ -1172,6 +1190,7 @@  determine_en_precision (st_parameter_dt 
  int nprinted;
  char buffer[10];
  const size_t size = 10;
+  int nbefore; /* digits before decimal point - 1.  */

  switch (len)
    {
@@ -1204,16 +1223,6 @@  determine_en_precision (st_parameter_dt 
  if (nprinted == -1)
    return -1;

-  int e = atoi (&buffer[5]);
-  int nbefore; /* digits before decimal point - 1.  */
-  if (e >= 0)
-    nbefore = e % 3;
-  else
-    {
-      nbefore = (-e) % 3;
-      if (nbefore != 0)
-	nbefore = 3 - nbefore;
-    }
  int prec = f->u.real.d + nbefore;
  if (dtp->u.p.current_unit->round_status != ROUND_UNSPECIFIED
      && dtp->u.p.current_unit->round_status != ROUND_PROCDEFINED)

--- ../4.8_clean/libgfortran/io/write_float.def	2014-02-15 16:51:18.000000000 +0100
+++ libgfortran/io/write_float.def	2014-03-04 17:27:50.000000000 +0100
@@ -125,8 +125,6 @@  output_float (st_parameter_dt *dtp, cons
  int nzero;
  /* Number of digits after the decimal point.  */
  int nafter;
-  /* Number of zeros after the decimal point, whatever the precision.  */
-  int nzero_real;
  int leadzero;
  int nblanks;
  int ndigits, edigits;
@@ -138,7 +136,6 @@  output_float (st_parameter_dt *dtp, cons
  p = dtp->u.p.scale_factor;

  rchar = '5';
-  nzero_real = -1;

  /* We should always know the field width and precision.  */
  if (d < 0)
@@ -191,7 +188,7 @@  output_float (st_parameter_dt *dtp, cons
	      if (nafter < 0)
		nafter = 0;
	      nafter = d;
-	      nzero = nzero_real = 0;
+	      nzero = 0;
	    }
	  else /* p < 0  */
	    {
@@ -211,14 +208,13 @@  output_float (st_parameter_dt *dtp, cons
		  nafter = d + nbefore;
		  nbefore = 0;
		}
-	      nzero_real = nzero;
	      if (nzero > d)
		nzero = d;
	    }
	}
      else
	{
-	  nzero = nzero_real = 0;
+	  nzero = 0;
	  nafter = d;
	}

@@ -373,7 +369,7 @@  output_float (st_parameter_dt *dtp, cons
  updown:

  rchar = '0';
-  if  (ft != FMT_F && 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++)
@@ -1125,17 +1121,39 @@  OUTPUT_FLOAT_FMT_G(16,L)
/* EN format is tricky since the number of significant digits depends
   on the magnitude.  Solve it by first printing a temporary value and
   figure out the number of significant digits from the printed
-   exponent.  */
-
-#define EN_PREC(x,y)\
-{\
-    GFC_REAL_ ## x tmp;				\
-    tmp = * (GFC_REAL_ ## x *)source;				\
-    if (isfinite (tmp))						\
-      nprinted = DTOA(y,0,tmp);					\
-    else\
-      nprinted = -1;\
-}\
+   exponent.  Values y, 0.95*10.0**e <= y <10.0**e, are rounded to
+   10.0**e even when the final result will not be rounded t 10.0**e.
+   For these values the exponent returned by atoi has to be decremented
+   by one. The values y in the ranges
+       (1000.0-0.5*10.0**(-d))*10.0**(3*n) <= y < 10.0*(3*(n+1))  
+        (100.0-0.5*10.0**(-d))*10.0**(3*n) <= y < 10.0*(3*n+2)
+         (10.0-0.5*10.0**(-d))*10.0**(3*n) <= y < 10.0*(3*n+1)
+   are correctly rounded respectively to 1.0...0*10.0*(3*(n+1)),
+   100.0...0*10.0*(3*n), and 10.0...0*10.0*(3*n), where 0...0
+   represents d zeroes, by the lines 279 to 297. */
+
+#define EN_PREC(x,y)					\
+{							\
+    volatile GFC_REAL_ ## x tmp, one = 1.0;		\
+    tmp = * (GFC_REAL_ ## x *)source;			\
+    if (isfinite (tmp))					\
+      {							\
+	nprinted = DTOA(y,0,tmp);			\
+	int e = atoi (&buffer[4]);			\
+	if (buffer[1] == '1')				\
+	  {						\
+	    tmp = (calculate_exp_ ## x (-e)) * tmp;	\
+	    tmp = one - (tmp < 0 ? -tmp : tmp);		\
+	    if (tmp > 0)				\
+	      e = e - 1;				\
+	  }						\
+	nbefore = e%3;					\
+	if (nbefore < 0)				\
+	  nbefore = 3 + nbefore;			\
+      }							\
+    else						\
+      nprinted = -1;					\
+}							\

static int
determine_en_precision (st_parameter_dt *dtp, const fnode *f, 
@@ -1144,6 +1162,7 @@  determine_en_precision (st_parameter_dt 
  int nprinted;
  char buffer[10];
  const size_t size = 10;
+  int nbefore; /* digits before decimal point - 1.  */

  switch (len)
    {
@@ -1176,16 +1195,6 @@  determine_en_precision (st_parameter_dt 
  if (nprinted == -1)
    return -1;

-  int e = atoi (&buffer[5]);
-  int nbefore; /* digits before decimal point - 1.  */
-  if (e >= 0)
-    nbefore = e % 3;
-  else
-    {
-      nbefore = (-e) % 3;
-      if (nbefore != 0)
-	nbefore = 3 - nbefore;
-    }
  int prec = f->u.real.d + nbefore;
  if (dtp->u.p.current_unit->round_status != ROUND_UNSPECIFIED
      && dtp->u.p.current_unit->round_status != ROUND_PROCDEFINED)