* [patch, libgfortran] PR111022 ES0.0E0 format gave ES0.dE0 output with d too high.
@ 2024-01-30 18:15 Jerry D
2024-01-30 20:36 ` Harald Anlauf
0 siblings, 1 reply; 7+ messages in thread
From: Jerry D @ 2024-01-30 18:15 UTC (permalink / raw)
To: gfortran, gcc-patches
[-- Attachment #1: Type: text/plain, Size: 1648 bytes --]
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.
My editor judiciously deleted trailing blank spaces in a number of
places. I apologize for the clutter, but we might as well get rid of it
now.
Two existing test cases needed to be adjusted and I am adding one new
test case to capture the changes in our testsuite.
Regression tested on X86_64.
OK for trunk? Do we need to backport this?
Regards,
Jerry
Author: Jerry DeLisle <jvdelisle@gcc.gnu.org>
Date: Tue Jan 30 09:45:49 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.
libgfortran/ChangeLog:
* io/write.c (select_buffer): Whitespace.
(write_real): Whitespace.
(write_real_w0): Adjust logic for d==0.
* io/write_float.def (determine_precision): Whitespace.
(build_float_string): Calculate the width of the E0 exponents.
(build_infnan_string): Whitespace.
(CALCULATE_EXP): Whitespace
(quadmath_snprintf): Whitespace.
(determine_en_precision): Whitespace.
gcc/testsuite/ChangeLog:
* gfortran.dg/pr96436_4.f90: Changed for ES0 and EN0.
* gfortran.dg/pr96436_5.f90: Changed for ES0 and EN0.
* gfortran.dg/pr111022.f90: New test.
[-- Attachment #2: submit.diff --]
[-- Type: text/x-patch, Size: 13828 bytes --]
diff --git a/gcc/testsuite/gfortran.dg/pr111022.f90 b/gcc/testsuite/gfortran.dg/pr111022.f90
new file mode 100644
index 00000000000..d7e8edf2d19
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr111022.f90
@@ -0,0 +1,60 @@
+! { dg-do run }
+program case2
+ 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
+
+end program case2
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/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..d6f5b1547b1 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,67 @@ 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_EN:
+ case FMT_ES:
+ if (f->u.real.e == 0 && e == 0)
{
- edigits = 4;
- if (e > 99 || e < -99)
- expchar = ' ';
+ edigits = 3;
+ break;
}
- }
- 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
+ else if (f->u.real.e > 0)
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 +649,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 +679,44 @@ 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_EN:
+ case FMT_ES:
+ 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 +734,7 @@ build_float_string (st_parameter_dt *dtp, const fnode *f, char *buffer,
/* NULL terminate the string. */
*put = '\0';
-
+
return;
}
@@ -712,9 +758,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 +792,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 +855,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 +978,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 +1008,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 +1058,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
^ permalink raw reply [flat|nested] 7+ messages in thread
* Re: [patch, libgfortran] PR111022 ES0.0E0 format gave ES0.dE0 output with d too high.
2024-01-30 18:15 [patch, libgfortran] PR111022 ES0.0E0 format gave ES0.dE0 output with d too high Jerry D
@ 2024-01-30 20:36 ` Harald Anlauf
2024-01-31 0:11 ` Jerry D
` (2 more replies)
0 siblings, 3 replies; 7+ messages in thread
From: Harald Anlauf @ 2024-01-30 20:36 UTC (permalink / raw)
To: Jerry D, gfortran, gcc-patches
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
The latter one is a bit ambiguous in F2018, but certainly gfortran's
current output in wrong.
Can you please check, and if you can fix that too, it would be great.
And if we do not want to be dependent on the standard version at
runtime, I'd rather go for F2023.
> My editor judiciously deleted trailing blank spaces in a number of
> places. I apologize for the clutter, but we might as well get rid of it
> now.
>
> Two existing test cases needed to be adjusted and I am adding one new
> test case to capture the changes in our testsuite.
>
> Regression tested on X86_64.
>
> OK for trunk? Do we need to backport this?
If the above is fixed, I would not object a backport to the 13-branch,
but only if that change has sinked in for a while, and someone else
agrees on it.
Thanks so far!
Harald
> Regards,
>
> Jerry
>
> Author: Jerry DeLisle <jvdelisle@gcc.gnu.org>
> Date: Tue Jan 30 09:45:49 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.
>
> libgfortran/ChangeLog:
>
> * io/write.c (select_buffer): Whitespace.
> (write_real): Whitespace.
> (write_real_w0): Adjust logic for d==0.
> * io/write_float.def (determine_precision): Whitespace.
> (build_float_string): Calculate the width of the E0 exponents.
> (build_infnan_string): Whitespace.
> (CALCULATE_EXP): Whitespace
> (quadmath_snprintf): Whitespace.
> (determine_en_precision): Whitespace.
>
> gcc/testsuite/ChangeLog:
>
> * gfortran.dg/pr96436_4.f90: Changed for ES0 and EN0.
> * gfortran.dg/pr96436_5.f90: Changed for ES0 and EN0.
> * gfortran.dg/pr111022.f90: New test.
^ permalink raw reply [flat|nested] 7+ messages in thread
* Re: [patch, libgfortran] PR111022 ES0.0E0 format gave ES0.dE0 output with d too high.
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
2 siblings, 0 replies; 7+ messages in thread
From: Jerry D @ 2024-01-31 0:11 UTC (permalink / raw)
To: Harald Anlauf, gfortran
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
>
> The latter one is a bit ambiguous in F2018, but certainly gfortran's
> current output in wrong.
>
> Can you please check, and if you can fix that too, it would be great.
> And if we do not want to be dependent on the standard version at
> runtime, I'd rather go for F2023.
>
Certainly will look. This is why we need others checking. Corner cases
abound.
Cheers,
Jerry
^ permalink raw reply [flat|nested] 7+ messages in thread
* Re: [patch, libgfortran] PR111022 ES0.0E0 format gave ES0.dE0 output with d too high.
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
2 siblings, 0 replies; 7+ messages in thread
From: Jerry D @ 2024-02-02 2:42 UTC (permalink / raw)
To: Harald Anlauf, gfortran
[-- Attachment #1: Type: text/plain, Size: 950 bytes --]
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
>
An updated patch is attached and gives the expected result.
$ gfc example.f90
$ ./a.out
0.666E+0
0.666E+0
I will update the commit log and test cases and re-submit for approval.
Regards,
Jerry
[-- Attachment #2: cleanupreview.diff --]
[-- Type: text/x-patch, Size: 17288 bytes --]
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..d7e8edf2d19
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr111022.f90
@@ -0,0 +1,60 @@
+! { dg-do run }
+program case2
+ 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
+
+end program case2
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);\
}\
^ permalink raw reply [flat|nested] 7+ messages in thread
* Re: [patch, libgfortran] PR111022 ES0.0E0 format gave ES0.dE0 output with d too high.
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
2 siblings, 1 reply; 7+ messages in thread
From: Jerry D @ 2024-02-03 3:17 UTC (permalink / raw)
To: Harald Anlauf, gfortran, gcc-patches
[-- Attachment #1: Type: text/plain, Size: 966 bytes --]
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
[-- Attachment #2: submitlog.diff --]
[-- Type: text/x-patch, Size: 19710 bytes --]
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);\
}\
^ permalink raw reply [flat|nested] 7+ messages in thread
* Re: [patch, libgfortran] PR111022 ES0.0E0 format gave ES0.dE0 output with d too high.
2024-02-03 3:17 ` Jerry D
@ 2024-02-03 3:24 ` Steve Kargl
2024-02-03 15:01 ` Harald Anlauf
0 siblings, 1 reply; 7+ messages in thread
From: Steve Kargl @ 2024-02-03 3:24 UTC (permalink / raw)
To: Jerry D; +Cc: Harald Anlauf, gfortran, gcc-patches
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
^ permalink raw reply [flat|nested] 7+ messages in thread
* Re: [patch, libgfortran] PR111022 ES0.0E0 format gave ES0.dE0 output with d too high.
2024-02-03 3:24 ` Steve Kargl
@ 2024-02-03 15:01 ` Harald Anlauf
0 siblings, 0 replies; 7+ messages in thread
From: Harald Anlauf @ 2024-02-03 15:01 UTC (permalink / raw)
To: sgk, Jerry D; +Cc: gfortran, gcc-patches
Jerry, Steve,
Am 03.02.24 um 04:24 schrieb Steve Kargl:
> Jerry,
>
> The patch looks good to me, but please give Harald a chance
> to comment.
>
I just tested it a little, and it looked good.
We even get a runtime error on E0.0 now as required. :-)
Thanks for the patch!
Harald
^ permalink raw reply [flat|nested] 7+ messages in thread
end of thread, other threads:[~2024-02-03 15:02 UTC | newest]
Thread overview: 7+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2024-01-30 18:15 [patch, libgfortran] PR111022 ES0.0E0 format gave ES0.dE0 output with d too high 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
2024-02-03 15:01 ` Harald Anlauf
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).