Jerry,

The patch looks good to me, but please give Harald a chance
to comment.

-- 
steve

On Fri, Feb 02, 2024 at 07:17:55PM -0800, Jerry D wrote:
> On 1/30/24 12:36 PM, Harald Anlauf wrote:
> > Hi Jerry,
> > 
> > Am 30.01.24 um 19:15 schrieb Jerry D:
> > > The attached patch attempts to fix the handling of the EN0.0E0 and
> > > ES0.0E0 formatting by correctly calculating the number of digits needed
> > > for the exponents and building those exponents into the float string.
> > 
> > while your patch addresses ENw.dE0 and ESw.dE0 formatting,
> > it does not fix Ew.dE0, which can be seen with the following test:
> > 
> >    write(buffer,"(E0.3E0)") .6660_4
> >    print *, buffer
> >    write(buffer,"(E0.3)") .6660_4
> >    print *, buffer
> > 
> > I get even with your patch:
> > 
> >   0.666
> >   0.666
> > 
> > but would have expected:
> > 
> >   0.666E+0   ! F2018 & F2023, table 13.1
> >   0.666E+0   ! F2023, table 13.1
> > 
> 
> Tha attached file shows the complete revised patch and git log generated by
> using the 'git show' command. I only just discovered that one. (eye roll).
> 
> Regressions tested on x86-64.  OK for trunk?
> 
> Regards,
> 
> Jerry

> commit 95c878a97944f952aef226ff0224b2198abfbe0f
> Author: Jerry DeLisle <jvdeli...@gcc.gnu.org>
> Date:   Fri Feb 2 18:12:33 2024 -0800
> 
>     libgfortran: EN0.0E0 and ES0.0E0 format editing.
>     
>             PR libgfortran/111022
>     
>     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:
>     
>             * 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:
>     
>             * 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.
> 
> diff --git a/gcc/testsuite/gfortran.dg/fmt_error_10.f 
> b/gcc/testsuite/gfortran.dg/fmt_error_10.f
> index 6e1a5f60bea..fc6620a60a6 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 00000000000..eef55ff5ce0
> --- /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 335ce5fb009..7d2cfef0ef8 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 a45df8963c8..3870d988f97 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 ac92acc175c..f39d6ecc65b 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;
> @@ -922,6 +923,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 9e1e902b944..2d5ea7d4d2c 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 49beaee4724..1a7c12345f9 100644
> --- a/libgfortran/io/write.c
> +++ b/libgfortran/io/write.c
> @@ -1574,7 +1574,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;
> @@ -1757,7 +1757,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);
> @@ -1785,8 +1785,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
> @@ -1794,11 +1792,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 1f843914563..2d68b1d353c 100644
> --- a/libgfortran/io/write_float.def
> +++ b/libgfortran/io/write_float.def
> @@ -1,6 +1,6 @@
>  /* Copyright (C) 2007-2024 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);\
>      }\


-- 
Steve

Reply via email to