libgfortran: EN0.0E0 and ES0.0E0 format editing.
F2018 and F2023 standards added zero width exponents. This required additional special handing in the process of building formatted floating point strings. G formatting uses either F or E formatting as documented in write_float.def comments. This logic changes the format token from FMT_G to FMT_F or FMT_E. The new formatting requirements interfere with this process when a FMT_G float string is being built. To avoid this, a new component called 'pushed' is added to the fnode structure to save this condition. The 'pushed' condition is then used to bypass portions of the new ES,E,EN, and D formatting, falling through to the existing default formatting which is retained. libgfortran/ChangeLog: PR libfortran/111022 * io/format.c (get_fnode): Update initialization of fnode. (parse_format_list): Initialization. * io/format.h (struct fnode): Added the new 'pushed' component. * io/write.c (select_buffer): Whitespace. (write_real): Whitespace. (write_real_w0): Adjust logic for the d == 0 condition. * io/write_float.def (determine_precision): Whitespace. (build_float_string): Calculate width of ..E0 exponents and adjust logic accordingly. (build_infnan_string): Whitespace. (CALCULATE_EXP): Whitespace. (quadmath_snprintf): Whitespace. (determine_en_precision): Whitespace. gcc/testsuite/ChangeLog: PR libfortran/111022 * gfortran.dg/fmt_error_10.f: Show D+0 exponent. * gfortran.dg/pr96436_4.f90: Show E+0 exponent. * gfortran.dg/pr96436_5.f90: Show E+0 exponent. * gfortran.dg/pr111022.f90: New test.
This commit is contained in:
Jerry DeLisle
parent
266354012e
commit
d436e8e70d
8 changed files with 219 additions and 79 deletions
|
|
@ -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
|
||||
|
|
|
|||
72
gcc/testsuite/gfortran.dg/pr111022.f90
Normal file
72
gcc/testsuite/gfortran.dg/pr111022.f90
Normal file
|
|
@ -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
|
||||
|
|
@ -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
|
||||
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
||||
|
|
|
|||
|
|
@ -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);
|
||||
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
|
|
|||
|
|
@ -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);\
|
||||
}\
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue