From: Steve Kargl <sgk@troutmask.apl.washington.edu>
To: Jerry D <jvdelisle2@gmail.com>
Cc: Harald Anlauf <anlauf@gmx.de>, gfortran <fortran@gcc.gnu.org>,
gcc-patches <gcc-patches@gcc.gnu.org>
Subject: Re: [patch, libgfortran] PR111022 ES0.0E0 format gave ES0.dE0 output with d too high.
Date: Fri, 2 Feb 2024 19:24:12 -0800 [thread overview]
Message-ID: <Zb2x3Ebz84EYl_na@troutmask.apl.washington.edu> (raw)
In-Reply-To: <86b7aa32-db1e-4717-af28-4b7ba9c42e36@gmail.com>
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 <jvdelisle@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
next prev parent reply other threads:[~2024-02-03 3:24 UTC|newest]
Thread overview: 7+ messages / expand[flat|nested] mbox.gz Atom feed top
2024-01-30 18:15 Jerry D
2024-01-30 20:36 ` Harald Anlauf
2024-01-31 0:11 ` Jerry D
2024-02-02 2:42 ` Jerry D
2024-02-03 3:17 ` Jerry D
2024-02-03 3:24 ` Steve Kargl [this message]
2024-02-03 15:01 ` Harald Anlauf
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=Zb2x3Ebz84EYl_na@troutmask.apl.washington.edu \
--to=sgk@troutmask.apl.washington.edu \
--cc=anlauf@gmx.de \
--cc=fortran@gcc.gnu.org \
--cc=gcc-patches@gcc.gnu.org \
--cc=jvdelisle2@gmail.com \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
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).