public inbox for gcc-cvs@sourceware.org
help / color / mirror / Atom feed
* [gcc r13-8321] libgfortran: EN0.0E0 and ES0.0E0 format editing.
@ 2024-02-13  0:42 Jerry DeLisle
  0 siblings, 0 replies; only message in thread
From: Jerry DeLisle @ 2024-02-13  0:42 UTC (permalink / raw)
  To: gcc-cvs

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

commit r13-8321-gfbe5e908de76aa240bbcd2f144c156eccc863604
Author: Jerry DeLisle <jvdelisle@gcc.gnu.org>
Date:   Fri Feb 2 18:12:33 2024 -0800

    libgfortran: EN0.0E0 and ES0.0E0 format editing.
    
    F2018 and F2023 standards added zero width exponents. This required
    additional special handing in the process of building formatted
    floating point strings.
    
    G formatting uses either F or E formatting as documented in
    write_float.def comments. This logic changes the format token from FMT_G
    to FMT_F or FMT_E. The new formatting requirements interfere with this
    process when a FMT_G float string is being built.  To avoid this, a new
    component called 'pushed' is added to the fnode structure to save this
    condition.  The 'pushed' condition is then used to bypass portions of
    the new ES,E,EN, and D formatting, falling through to the existing
    default formatting which is retained.
    
    libgfortran/ChangeLog:
            PR libfortran/111022
            * io/format.c (get_fnode): Update initialization of fnode.
            (parse_format_list): Initialization.
            * io/format.h (struct fnode): Added the new 'pushed' component.
            * io/write.c (select_buffer): Whitespace.
            (write_real): Whitespace.
            (write_real_w0): Adjust logic for the d == 0 condition.
            * io/write_float.def (determine_precision): Whitespace.
            (build_float_string): Calculate width of ..E0 exponents and
            adjust logic accordingly.
            (build_infnan_string): Whitespace.
            (CALCULATE_EXP): Whitespace.
            (quadmath_snprintf): Whitespace.
            (determine_en_precision): Whitespace.
    
    gcc/testsuite/ChangeLog:
            PR libfortran/111022
            * gfortran.dg/fmt_error_10.f: Show D+0 exponent.
            * gfortran.dg/pr96436_4.f90: Show E+0 exponent.
            * gfortran.dg/pr96436_5.f90: Show E+0 exponent.
            * gfortran.dg/pr111022.f90: New test.
    
    (cherry picked from commit d436e8e70dacd9c06247bb56d0abeded8fcb4242)

Diff:
---
 gcc/testsuite/gfortran.dg/fmt_error_10.f |   2 +-
 gcc/testsuite/gfortran.dg/pr111022.f90   |  72 +++++++++++
 gcc/testsuite/gfortran.dg/pr96436_4.f90  |   4 +-
 gcc/testsuite/gfortran.dg/pr96436_5.f90  |   4 +-
 libgfortran/io/format.c                  |   4 +-
 libgfortran/io/format.h                  |   1 +
 libgfortran/io/write.c                   |  12 +-
 libgfortran/io/write_float.def           | 199 ++++++++++++++++++++-----------
 8 files changed, 219 insertions(+), 79 deletions(-)

diff --git a/gcc/testsuite/gfortran.dg/fmt_error_10.f b/gcc/testsuite/gfortran.dg/fmt_error_10.f
index 6e1a5f60beaa..fc6620a60a6a 100644
--- a/gcc/testsuite/gfortran.dg/fmt_error_10.f
+++ b/gcc/testsuite/gfortran.dg/fmt_error_10.f
@@ -18,7 +18,7 @@
 
       str = '(1pd0.15)'
       write (line,str,iostat=istat, iomsg=msg) 1.0d0
-      if (line.ne."1.000000000000000") STOP 5
+      if (line.ne."1.000000000000000D+0") STOP 5
       read (*,str,iostat=istat, iomsg=msg) x
       if (istat.ne.5006 .or. msg(1:10).ne."Zero width") STOP 6
       if (x.ne.555.25) STOP 7
diff --git a/gcc/testsuite/gfortran.dg/pr111022.f90 b/gcc/testsuite/gfortran.dg/pr111022.f90
new file mode 100644
index 000000000000..eef55ff5ce08
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr111022.f90
@@ -0,0 +1,72 @@
+! { dg-do run }
+program pr111022
+  character(20) :: buffer
+  write(buffer,"(EN0.3E0)") .6660_4
+  if (buffer.ne."666.000E-3") stop 1
+  write(buffer,"(EN0.3E0)") 6.660_4
+  if (buffer.ne."6.660E+0") stop 2
+  write(buffer,"(EN0.3E0)") 66.60_4
+  if (buffer.ne."66.600E+0") stop 3
+  write(buffer,"(EN0.3E0)") 666.0_4
+  if (buffer.ne."666.000E+0") stop 4
+  write(buffer,"(EN0.3E0)") 6660.0_4
+  if (buffer.ne."6.660E+3") stop 5
+  write(buffer,"(EN0.3E0)") 66600.0_4
+  if (buffer.ne."66.600E+3") stop 6
+  
+  write(buffer,"(EN0.0E0)") 666.0_4
+  if (buffer.ne."666.E+0") stop 7
+  write(buffer,"(EN0.0E1)") 666.0_4
+  if (buffer.ne."666.E+0") stop 8
+  write(buffer,"(EN0.0E2)") 666.0_4
+  if (buffer.ne."666.E+00") stop 9
+  write(buffer,"(EN0.0E3)") 666.0_4
+  if (buffer.ne."666.E+000") stop 10
+  write(buffer,"(EN0.0E4)") 666.0_4
+  if (buffer.ne."666.E+0000") stop 11
+  write(buffer,"(EN0.0E5)") 666.0_4
+  if (buffer.ne."666.E+00000") stop 12
+  write(buffer,"(EN0.0E6)") 666.0_4
+  if (buffer.ne."666.E+000000") stop 13
+  
+  write(buffer,"(ES0.3E0)") .6660_4
+  if (buffer.ne."6.660E-1") stop 14
+  write(buffer,"(ES0.3E0)") 6.660_4
+  if (buffer.ne."6.660E+0") stop 15
+  write(buffer,"(ES0.3E0)") 66.60_4
+  if (buffer.ne."6.660E+1") stop 16
+  write(buffer,"(ES0.3E0)") 666.0_4
+  if (buffer.ne."6.660E+2") stop 17
+  write(buffer,"(ES0.3E0)") 6660.0_4
+  if (buffer.ne."6.660E+3") stop 18
+  write(buffer,"(ES0.3E0)") 66600.0_4
+  if (buffer.ne."6.660E+4") stop 19
+  
+  write(buffer,"(ES0.0E0)") 666.0_4
+  if (buffer.ne."7.E+2") stop 20
+  write(buffer,"(ES0.0E1)") 666.0_4
+  if (buffer.ne."7.E+2") stop 21
+  write(buffer,"(ES0.0E2)") 666.0_4
+  if (buffer.ne."7.E+02") stop 22
+  write(buffer,"(ES0.0E3)") 666.0_4
+  if (buffer.ne."7.E+002") stop 23
+  write(buffer,"(ES0.0E4)") 666.0_4
+  if (buffer.ne."7.E+0002") stop 24
+  write(buffer,"(ES0.0E5)") 666.0_4
+  if (buffer.ne."7.E+00002") stop 25
+  write(buffer,"(ES0.0E6)") 666.0_4
+  if (buffer.ne."7.E+000002") stop 26
+  
+  write(buffer,"(E0.3E0)") .6660_4
+  if (buffer.ne."0.666E+0") stop 27
+  write(buffer,"(E0.3)") .6660_4
+  if (buffer.ne."0.666E+0") stop 28
+  write(buffer,"(E0.1E0)") .6660_4
+  if (buffer.ne."0.7E+0") stop 29
+  write(buffer,"(E0.1)") .6660_4
+  if (buffer.ne."0.7E+0") stop 30
+  write(buffer,"(E0.5E0)") .6660_4
+  if (buffer.ne."0.66600E+0") stop 31
+  write(buffer,"(E0.5)") .6660_4
+  if (buffer.ne."0.66600E+0") stop 32
+end program pr111022
diff --git a/gcc/testsuite/gfortran.dg/pr96436_4.f90 b/gcc/testsuite/gfortran.dg/pr96436_4.f90
index 335ce5fb009f..7d2cfef0ef87 100644
--- a/gcc/testsuite/gfortran.dg/pr96436_4.f90
+++ b/gcc/testsuite/gfortran.dg/pr96436_4.f90
@@ -17,9 +17,9 @@ write(buffer,fmt) ">", 3.0, "<"
 if (buffer.ne.">0.30E+1<") stop 4
 fmt = "(1a1,en0.2,1a1)"
 write(buffer,fmt) ">", 3.0, "<"
-if (buffer.ne.">3.00<") stop 5
+if (buffer.ne.">3.00E+0<") stop 5
 fmt = "(1a1,es0.2,1a1)"
 write(buffer,fmt) ">", 3.0, "<"
-if (buffer.ne.">3.00<") stop 6
+if (buffer.ne.">3.00E+0<") stop 6
 end
 
diff --git a/gcc/testsuite/gfortran.dg/pr96436_5.f90 b/gcc/testsuite/gfortran.dg/pr96436_5.f90
index a45df8963c85..3870d988f97c 100644
--- a/gcc/testsuite/gfortran.dg/pr96436_5.f90
+++ b/gcc/testsuite/gfortran.dg/pr96436_5.f90
@@ -17,9 +17,9 @@ write(buffer,fmt) ">", 3.0, "<"
 if (buffer.ne.">0.30E+1<") stop 4
 fmt = "(1a1,en0.2,1a1)"
 write(buffer,fmt) ">", 3.0, "<"
-if (buffer.ne.">3.00<") stop 5
+if (buffer.ne.">3.00E+0<") stop 5
 fmt = "(1a1,es0.2,1a1)"
 write(buffer,fmt) ">", 3.0, "<"
-if (buffer.ne.">3.00<") stop 6
+if (buffer.ne.">3.00E+0<") stop 6
 end
 
diff --git a/libgfortran/io/format.c b/libgfortran/io/format.c
index 9e06902ddb7b..3531fb20ddb1 100644
--- a/libgfortran/io/format.c
+++ b/libgfortran/io/format.c
@@ -32,7 +32,7 @@ see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
 #include <string.h>
 
 
-static const fnode colon_node = { FMT_COLON, 0, NULL, NULL, {{ 0, 0, 0 }}, 0,
+static const fnode colon_node = { FMT_COLON, FMT_NONE, 0, NULL, NULL, {{ 0, 0, 0 }}, 0,
 				  NULL };
 
 /* Error messages. */
@@ -225,6 +225,7 @@ get_fnode (format_data *fmt, fnode **head, fnode **tail, format_token t)
     }
   f = fmt->avail++;
   memset (f, '\0', sizeof (fnode));
+  f->pushed = FMT_NONE;
 
   if (*head == NULL)
     *head = *tail = f;
@@ -923,6 +924,7 @@ parse_format_list (st_parameter_dt *dtp, bool *seen_dd)
       *seen_dd = true;
       get_fnode (fmt, &head, &tail, t);
       tail->repeat = repeat;
+      tail->pushed = FMT_NONE;
 
       u = format_lex (fmt);
       
diff --git a/libgfortran/io/format.h b/libgfortran/io/format.h
index aa1eb48d0e7e..1c51be297b00 100644
--- a/libgfortran/io/format.h
+++ b/libgfortran/io/format.h
@@ -33,6 +33,7 @@ see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
 struct fnode
 {
   format_token format;
+  format_token pushed;
   int repeat;
   struct fnode *next;
   char *source;
diff --git a/libgfortran/io/write.c b/libgfortran/io/write.c
index 519c99b4a874..78a790d756b9 100644
--- a/libgfortran/io/write.c
+++ b/libgfortran/io/write.c
@@ -1573,7 +1573,7 @@ select_buffer (st_parameter_dt *dtp, const fnode *f, int precision,
 	       char *buf, size_t *size, int kind)
 {
   char *result;
-  
+
   /* The buffer needs at least one more byte to allow room for
      normalizing and 1 to hold null terminator.  */
   *size = size_from_kind (dtp, f, kind) + precision + 1 + 1;
@@ -1756,7 +1756,7 @@ write_real (st_parameter_dt *dtp, const char *source, int kind)
 
   /* Scratch buffer to hold final result.  */
   buffer = select_buffer (dtp, &f, precision, buf_stack, &buf_size, kind);
-  
+
   get_float_string (dtp, &f, source , kind, 1, buffer,
                            precision, buf_size, result, &flt_str_len);
   write_float_string (dtp, result, flt_str_len);
@@ -1784,8 +1784,6 @@ write_real_w0 (st_parameter_dt *dtp, const char *source, int kind,
 
   set_fnode_default (dtp, &ff, kind);
 
-  if (f->u.real.d > 0)
-    ff.u.real.d = f->u.real.d;
   ff.format = f->format;
 
   /* For FMT_G, Compensate for extra digits when using scale factor, d
@@ -1793,11 +1791,17 @@ write_real_w0 (st_parameter_dt *dtp, const char *source, int kind,
      is used.  */
   if (f->format == FMT_G)
     {
+      if (f->u.real.d > 0)
+	ff.u.real.d = f->u.real.d;
       if (dtp->u.p.scale_factor > 0 && f->u.real.d == 0)
 	comp_d = 1;
       else
 	comp_d = 0;
     }
+  else
+    if (f->u.real.d >= 0)
+      ff.u.real.d = f->u.real.d;
+
 
   if (f->u.real.e >= 0)
     ff.u.real.e = f->u.real.e;
diff --git a/libgfortran/io/write_float.def b/libgfortran/io/write_float.def
index 559cd3137f3d..947a10f849cf 100644
--- a/libgfortran/io/write_float.def
+++ b/libgfortran/io/write_float.def
@@ -1,6 +1,6 @@
 /* Copyright (C) 2007-2023 Free Software Foundation, Inc.
    Contributed by Andy Vaught
-   Write float code factoring to this file by Jerry DeLisle   
+   Write float code factoring to this file by Jerry DeLisle
    F2003 I/O support contributed by Jerry DeLisle
 
 This file is part of the GNU Fortran runtime library (libgfortran).
@@ -89,8 +89,8 @@ determine_precision (st_parameter_dt * dtp, const fnode * f, int len)
   /* If the scale factor has a large negative value, we must do our
      own rounding? Use ROUND='NEAREST', which should be what snprintf
      is using as well.  */
-  if (precision < 0 && 
-      (dtp->u.p.current_unit->round_status == ROUND_UNSPECIFIED 
+  if (precision < 0 &&
+      (dtp->u.p.current_unit->round_status == ROUND_UNSPECIFIED
        || dtp->u.p.current_unit->round_status == ROUND_PROCDEFINED))
     dtp->u.p.current_unit->round_status = ROUND_NEAREST;
 
@@ -154,7 +154,7 @@ build_float_string (st_parameter_dt *dtp, const fnode *f, char *buffer,
     internal_error (&dtp->common, "Unspecified precision");
 
   sign = calculate_sign (dtp, sign_bit);
-  
+
   /* Calculate total number of digits.  */
   if (ft == FMT_F)
     ndigits = nprinted - 2;
@@ -351,7 +351,7 @@ build_float_string (st_parameter_dt *dtp, const fnode *f, char *buffer,
 	 let snprintf handle the rounding.  On system claiming support
 	 for IEEE 754, this ought to be round to nearest, ties to
 	 even, corresponding to the Fortran ROUND='NEAREST'.  */
-      case ROUND_PROCDEFINED: 
+      case ROUND_PROCDEFINED:
       case ROUND_UNSPECIFIED:
       case ROUND_ZERO: /* Do nothing and truncation occurs.  */
 	goto skip;
@@ -409,9 +409,9 @@ build_float_string (st_parameter_dt *dtp, const fnode *f, char *buffer,
 	goto do_rnd;
     }
   goto skip;
-    
+
   do_rnd:
- 
+
   if (nbefore + nafter == 0)
     /* Handle the case Fw.0 and value < 1.0 */
     {
@@ -476,49 +476,71 @@ build_float_string (st_parameter_dt *dtp, const fnode *f, char *buffer,
 
   skip:
 
-  /* Calculate the format of the exponent field.  */
-  if (expchar && !(dtp->u.p.g0_no_blanks && e == 0))
+  /* Calculate the format of the exponent field.  The number of exponent digits
+     required is needed to determine padding of the float string before the
+     expenent is written down. */
+  edigits = 0; // Assume there is no exponent character set.
+  if (expchar)
     {
-      edigits = 1;
-      for (i = abs (e); i >= 10; i /= 10)
-	edigits++;
-
-      if (f->u.real.e < 0)
-	{
-	  /* Width not specified.  Must be no more than 3 digits.  */
-	  if (e > 999 || e < -999)
-	    edigits = -1;
-	  else
+      switch (ft)
+      {
+	case FMT_D:
+	case FMT_E:
+	case FMT_EN:
+	case FMT_ES:
+	  if (f->pushed == FMT_NONE)
 	    {
-	      edigits = 4;
-	      if (e > 99 || e < -99)
-		expchar = ' ';
+	      if (f->u.real.e == 0 && e == 0)
+		{
+		  edigits = 3;
+		  break;
+		}
+	      else if (f->u.real.e > 0)
+		edigits = f->u.real.e + 2;
 	    }
-	}
-      else if (f->u.real.e == 0)
-	{
-	  /* Zero width specified, no leading zeros in exponent  */
-	  if (e > 999 || e < -999)
-	    edigits = 6;
-	  else if (e > 99 || e < -99)
-	    edigits = 5;
-	  else if (e > 9 || e < -9)
-	    edigits = 4;
-	  else
-	    edigits = 3;
-	}
-      else
-	{
-	  /* Exponent width specified, check it is wide enough.  */
-	  if (edigits > f->u.real.e)
-	    edigits = -1;
-	  else
-	    edigits = f->u.real.e + 2;
-	}
-    }
-  else
-    edigits = 0;
+	/* Fall through.  */
+	default:
+	  if (!(dtp->u.p.g0_no_blanks && e == 0))
+	    {
+	      edigits = 1;
+	      for (i = abs (e); i >= 10; i /= 10)
+		edigits++;
 
+	      if (f->u.real.e < 0)
+		{
+		  /* Width not specified.  Must be no more than 3 digits.  */
+		  if (e > 999 || e < -999)
+		    edigits = -1;
+		  else
+		    {
+		      edigits = 4;
+		      if (e > 99 || e < -99)
+			expchar = ' ';
+		    }
+		}
+	      else if (f->u.real.e == 0)
+		{
+		  /* Zero width specified, no leading zeros in exponent  */
+		  if (e > 999 || e < -999)
+		    edigits = 6;
+		  else if (e > 99 || e < -99)
+		    edigits = 5;
+		  else if (e > 9 || e < -9)
+		    edigits = 4;
+		  else
+		    edigits = 3;
+		}
+	      else
+		{
+		  /* Exponent width specified, check it is wide enough.  */
+		  if (edigits > f->u.real.e)
+		    edigits = -1;
+		  else
+		    edigits = f->u.real.e + 2;
+		}
+	    }
+      }
+  }
   /* Scan the digits string and count the number of zeros.  If we make it
      all the way through the loop, we know the value is zero after the
      rounding completed above.  */
@@ -631,7 +653,7 @@ build_float_string (st_parameter_dt *dtp, const fnode *f, char *buffer,
   /* Set the decimal point.  */
   *(put++) = dtp->u.p.current_unit->decimal_status == DECIMAL_POINT ? '.' : ',';
   if (ft == FMT_F
-	  && (dtp->u.p.current_unit->round_status == ROUND_UNSPECIFIED 
+	  && (dtp->u.p.current_unit->round_status == ROUND_UNSPECIFIED
 	      || dtp->u.p.current_unit->round_status == ROUND_PROCDEFINED))
     digits++;
 
@@ -661,16 +683,49 @@ build_float_string (st_parameter_dt *dtp, const fnode *f, char *buffer,
     }
 
   /* Set the exponent.  */
-  if (expchar && !(dtp->u.p.g0_no_blanks && e == 0))
+  if (expchar)
     {
-      if (expchar != ' ')
-	{
-	  *(put++) = expchar;
-	  edigits--;
+      switch (ft)
+      {
+	case FMT_D:
+	case FMT_E:
+	case FMT_EN:
+	case FMT_ES:
+	if (f->pushed == FMT_NONE)
+	  {
+	    if ((f->u.real.e == 0) && (e == 0))
+	      {
+		*(put++) = expchar;
+		edigits--;
+		snprintf (buffer, size, "%+0*d", edigits, e);
+		memcpy (put, buffer, edigits);
+		put += edigits;
+		break;
+	      }
+	    if (f->u.real.e > 0)
+	      {
+		*(put++) = expchar;
+		edigits--;
+		snprintf (buffer, size, "%+0*d", edigits, e);
+		memcpy (put, buffer, edigits);
+		put += edigits;
+		break;
+	      }
+	  }
+	  /* Fall through.  */
+	default:
+	  if (!(dtp->u.p.g0_no_blanks && e == 0))
+	    {
+	      if (expchar != ' ')
+		{
+		  *(put++) = expchar;
+		  edigits--;
+		}
+	      snprintf (buffer, size, "%+0*d", edigits, e);
+	      memcpy (put, buffer, edigits);
+	      put += edigits;
+	    }
 	}
-      snprintf (buffer, size, "%+0*d", edigits, e);
-      memcpy (put, buffer, edigits);
-      put += edigits;
     }
 
   if (dtp->u.p.no_leading_blank)
@@ -688,7 +743,7 @@ build_float_string (st_parameter_dt *dtp, const fnode *f, char *buffer,
 
   /* NULL terminate the string.  */
   *put = '\0';
-  
+
   return;
 }
 
@@ -712,9 +767,9 @@ build_infnan_string (st_parameter_dt *dtp, const fnode *f, int isnan_flag,
       nb =  f->u.real.w;
       *len = nb;
 
-      /* If the field width is zero, the processor must select a width 
+      /* If the field width is zero, the processor must select a width
 	 not zero.  4 is chosen to allow output of '-Inf' or '+Inf' */
-     
+
       if ((nb == 0) || dtp->u.p.g0_no_blanks)
 	{
 	  if (isnan_flag)
@@ -746,12 +801,12 @@ build_infnan_string (st_parameter_dt *dtp, const fnode *f, int isnan_flag,
 		}
 	      /* The negative sign is mandatory */
 	      fin = '-';
-	    }    
+	    }
 	  else
 	    /* The positive sign is optional, but we output it for
 	       consistency */
 	    fin = '+';
-	    
+
 	  if (nb > mark)
 	    /* We have room, so output 'Infinity' */
 	    memcpy(p + nb - 8, "Infinity", 8);
@@ -809,7 +864,7 @@ CALCULATE_EXP(17)
 /* Define macros to build code for format_float.  */
 
   /* Note: Before output_float is called, snprintf is used to print to buffer the
-     number in the format +D.DDDDe+ddd. 
+     number in the format +D.DDDDe+ddd.
 
      #   The result will always contain a decimal point, even if no
 	 digits follow it
@@ -932,7 +987,7 @@ quadmath_snprintf (buffer, size, "%+-#.*Qf", (prec), (val))
    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))  
+       (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)),
@@ -962,7 +1017,7 @@ quadmath_snprintf (buffer, size, "%+-#.*Qf", (prec), (val))
 }\
 
 static int
-determine_en_precision (st_parameter_dt *dtp, const fnode *f, 
+determine_en_precision (st_parameter_dt *dtp, const fnode *f,
 			const char *source, int len)
 {
   int nprinted;
@@ -1012,7 +1067,7 @@ determine_en_precision (st_parameter_dt *dtp, const fnode *f,
     prec += 2 * len + 4;
   return prec;
 }
-  
+
 
 /* Generate corresponding I/O format. and output.
    The rules to translate FMT_G to FMT_E or FMT_F from DEC fortran
@@ -1045,12 +1100,12 @@ determine_en_precision (st_parameter_dt *dtp, const fnode *f,
     }\
   m = sign_bit ? -m : m;\
   zero_flag = (m == 0.0);\
+  fnode newf;\
+  int e = f->u.real.e;\
+  int d = f->u.real.d;\
+  int w = f->u.real.w;\
   if (f->format == FMT_G)\
     {\
-      int e = f->u.real.e;\
-      int d = f->u.real.d;\
-      int w = f->u.real.w;\
-      fnode newf;\
       GFC_REAL_ ## x exp_d, r = 0.5, r_sc;\
       int low, high, mid;\
       int ubound, lbound;\
@@ -1140,6 +1195,7 @@ determine_en_precision (st_parameter_dt *dtp, const fnode *f,
 	  precision = determine_precision (dtp, &newf, x);\
 	  nprinted = FDTOA(y,precision,m);\
 	}\
+      newf.pushed = FMT_G;\
       build_float_string (dtp, &newf, buffer, size, nprinted, precision,\
 				   sign_bit, zero_flag, npad, default_width,\
 				   result, res_len);\
@@ -1147,11 +1203,16 @@ determine_en_precision (st_parameter_dt *dtp, const fnode *f,
     }\
   else\
     {\
+      newf.format = f->format;\
+      newf.u.real.w = w;\
+      newf.u.real.d = d;\
+      newf.u.real.e = e;\
+      newf.pushed = FMT_NONE;\
       if (f->format == FMT_F)\
 	nprinted = FDTOA(y,precision,m);\
       else\
 	nprinted = DTOA(y,precision,m);\
-      build_float_string (dtp, f, buffer, size, nprinted, precision,\
+      build_float_string (dtp, &newf, buffer, size, nprinted, precision,\
 				   sign_bit, zero_flag, npad, default_width,\
 				   result, res_len);\
     }\

^ permalink raw reply	[flat|nested] only message in thread

only message in thread, other threads:[~2024-02-13  0:42 UTC | newest]

Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2024-02-13  0:42 [gcc r13-8321] libgfortran: EN0.0E0 and ES0.0E0 format editing Jerry DeLisle

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).