Skip to content

Commit

Permalink
PR 90374 d0.d, e0.d, es0.d, en0.d, g0.d and ew.d edit descriptors.
Browse files Browse the repository at this point in the history 
        PR libfortran/90274
        * io/format.c (parse_format_list): Implement the E0 exponent
        width to provide smallest possible width for exponent fields.
        Refactor code for correct parsing and better readability of the
        code.
        * io/io.h (write_real_w0): Change interface to pass in pointer
        to fnode.
        * io/transfer.c: Update all calls to write_real_w0 to use the
        new interface.
        * io/write.c ((write_real_w0): Use the new interface with fnode
        to access both the decimal precision and exponent widths used in
        build_float_string.
        * io/write_float.def (build_float_string): Use the passed in
        exponent width to calculate the used width in the case of E0.

From-SVN: r279828
  • Loading branch information
Jerry DeLisle committed Jan 2, 2020
1 parent a7ff7c7 commit 2b70275
Show file tree
Hide file tree
Showing 8 changed files with 161 additions and 109 deletions.
5 changes: 5 additions & 0 deletions gcc/testsuite/ChangeLog
View file
Original file line number Diff line number Diff line change
@@ -1,3 +1,8 @@
2020-01-01 Jerry DeLisle <[email protected]>

PR libfortran/90374
* gfortran.dg/fmt_zero_width.f90: Update test case.

2020-01-01 Thomas Koenig <[email protected]>

PR fortran/93113
Expand Down
26 changes: 14 additions & 12 deletions gcc/testsuite/gfortran.dg/fmt_zero_width.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -9,32 +9,34 @@ program pr90374
rn = 0.00314_4
afmt = "(D0.3)"
write (aresult,fmt=afmt) rn
if (aresult /= "0.314D-02") stop 12
if (aresult /= "0.314D-2") stop 12
afmt = "(E0.10)"
write (aresult,fmt=afmt) rn
if (aresult /= "0.3139999928E-02") stop 15
if (aresult /= "0.3139999928E-2") stop 15
afmt = "(ES0.10)"
write (aresult,fmt=afmt) rn
if (aresult /= "3.1399999280E-03") stop 18
if (aresult /= "3.1399999280E-3") stop 18
afmt = "(EN0.10)"
write (aresult,fmt=afmt) rn
if (aresult /= "3.1399999280E-03") stop 21
if (aresult /= "3.1399999280E-3") stop 21
afmt = "(G0.10)"
write (aresult,fmt=afmt) rn
if (aresult /= "0.3139999928E-02") stop 24
if (aresult /= "0.3139999928E-2") stop 24
afmt = "(E0.10e0)"
write (aresult,fmt=afmt) rn
if (aresult /= "0.3139999928E-02") stop 27
if (aresult /= "0.3139999928E-2") stop 27
write (aresult,fmt="(D0.3)") rn
if (aresult /= "0.314D-02") stop 29
if (aresult /= "0.314D-2") stop 29
write (aresult,fmt="(E0.10)") rn
if (aresult /= "0.3139999928E-02") stop 31
if (aresult /= "0.3139999928E-2") stop 31
write (aresult,fmt="(ES0.10)") rn
if (aresult /= "3.1399999280E-03") stop 33
if (aresult /= "3.1399999280E-3") stop 33
write (aresult,fmt="(EN0.10)") rn
if (aresult /= "3.1399999280E-03") stop 35
if (aresult /= "3.1399999280E-3") stop 35
write (aresult,fmt="(G0.10)") rn
if (aresult /= "0.3139999928E-02") stop 37
if (aresult /= "0.3139999928E-2") stop 37
write (aresult,fmt="(E0.10e0)") rn
if (aresult /= "0.3139999928E-02") stop 39
if (aresult /= "0.3139999928E-2") stop 39
write (aresult,fmt="(E0.10e3)") rn
if (aresult /= ".3139999928E-002") stop 41
end
17 changes: 17 additions & 0 deletions libgfortran/ChangeLog
View file
Original file line number Diff line number Diff line change
@@ -1,3 +1,20 @@
2020-01-01 Jerry DeLisle <[email protected]>

PR libfortran/90374
* io/format.c (parse_format_list): Implement the E0 exponent
width to provide smallest possible width for exponent fields.
Refactor code for correct parsing and better readability of the
code.
* io/io.h (write_real_w0): Change interface to pass in pointer
to fnode.
* io/transfer.c: Update all calls to write_real_w0 to use the
new interface.
* io/write.c ((write_real_w0): Use the new interface with fnode
to access both the decimal precision and exponent widths used in
build_float_string.
* io/write_float.def (build_float_string): Use the passed in
exponent width to calculate the used width in the case of E0.

2020-01-01 Jakub Jelinek <[email protected]>

Update copyright years.
Expand Down
168 changes: 91 additions & 77 deletions libgfortran/io/format.c
View file
Original file line number Diff line number Diff line change
Expand Up @@ -38,7 +38,7 @@ static const fnode colon_node = { FMT_COLON, 0, NULL, NULL, {{ 0, 0, 0 }}, 0,

/* Error messages. */

static const char posint_required[] = "Positive width required in format",
static const char posint_required[] = "Positive integer required in format",
period_required[] = "Period required in format",
nonneg_required[] = "Nonnegative width required in format",
unexpected_element[] = "Unexpected element '%c' in format\n",
Expand Down Expand Up @@ -925,125 +925,139 @@ parse_format_list (st_parameter_dt *dtp, bool *seen_dd)
tail->repeat = repeat;

u = format_lex (fmt);

/* Processing for zero width formats. */
if (u == FMT_ZERO)
{
*seen_dd = true;
if (notification_std (GFC_STD_F2008) == NOTIFICATION_ERROR
|| dtp->u.p.mode == READING)
{
fmt->error = zero_width;
goto finished;
}
tail->u.real.w = 0;

/* Look for the dot seperator. */
u = format_lex (fmt);
if (u != FMT_PERIOD)
{
fmt->saved_token = u;
break;
}

/* Look for the precision. */
u = format_lex (fmt);
if (u != FMT_POSINT)
notify_std (&dtp->common, GFC_STD_F2003,
"Positive width required");
if (u != FMT_ZERO && u != FMT_POSINT)
{
fmt->error = nonneg_required;
goto finished;
}
tail->u.real.d = fmt->value;
break;
}
if (t == FMT_F && dtp->u.p.mode == WRITING)
{
*seen_dd = true;
if (u != FMT_POSINT && u != FMT_ZERO)

/* Look for optional exponent */
u = format_lex (fmt);
if (u != FMT_E)
fmt->saved_token = u;
else
{
if (dtp->common.flags & IOPARM_DT_DEC_EXT)
u = format_lex (fmt);
if (u != FMT_POSINT)
{
tail->u.real.w = DEFAULT_WIDTH;
tail->u.real.d = 0;
tail->u.real.e = -1;
fmt->saved_token = u;
break;
if (u == FMT_ZERO)
{
notify_std (&dtp->common, GFC_STD_F2018,
"Positive exponent width required");
}
else
{
fmt->error = "Positive exponent width required in "
"format string at %L";
goto finished;
}
}
fmt->error = nonneg_required;
goto finished;
tail->u.real.e = fmt->value;
}
break;
}
else if (u == FMT_ZERO)
{
fmt->error = posint_required;
goto finished;
}
else if (u != FMT_POSINT)

/* Processing for positive width formats. */
if (u == FMT_POSINT)
{
if (dtp->common.flags & IOPARM_DT_DEC_EXT)
tail->u.real.w = fmt->value;

/* Look for the dot separator. Because of legacy behaviors
we do some look ahead for missing things. */
t2 = t;
t = format_lex (fmt);
if (t != FMT_PERIOD)
{
tail->u.real.w = DEFAULT_WIDTH;
/* We treat a missing decimal descriptor as 0. Note: This is only
allowed if -std=legacy, otherwise an error occurs. */
if (compile_options.warn_std != 0)
{
fmt->error = period_required;
goto finished;
}
fmt->saved_token = t;
tail->u.real.d = 0;
tail->u.real.e = -1;
fmt->saved_token = u;
break;
}
fmt->error = posint_required;
goto finished;
}

tail->u.real.w = fmt->value;
t2 = t;
t = format_lex (fmt);
if (t != FMT_PERIOD)
{
/* We treat a missing decimal descriptor as 0. Note: This is only
allowed if -std=legacy, otherwise an error occurs. */
if (compile_options.warn_std != 0)
/* If we made it here, we should have the dot so look for the
precision. */
t = format_lex (fmt);
if (t != FMT_ZERO && t != FMT_POSINT)
{
fmt->error = period_required;
fmt->error = nonneg_required;
goto finished;
}
fmt->saved_token = t;
tail->u.real.d = 0;
tail->u.real.d = fmt->value;
tail->u.real.e = -1;
break;
}

t = format_lex (fmt);
if (t != FMT_ZERO && t != FMT_POSINT)
{
fmt->error = nonneg_required;
goto finished;
}

tail->u.real.d = fmt->value;
tail->u.real.e = -1;

if (t2 == FMT_D || t2 == FMT_F)
{
*seen_dd = true;
break;
}
/* Done with D and F formats. */
if (t2 == FMT_D || t2 == FMT_F)
{
*seen_dd = true;
break;
}

/* Look for optional exponent */
t = format_lex (fmt);
if (t != FMT_E)
fmt->saved_token = t;
else
{
t = format_lex (fmt);
if (t != FMT_POSINT)
/* Look for optional exponent */
u = format_lex (fmt);
if (u != FMT_E)
fmt->saved_token = u;
else
{
if (t == FMT_ZERO)
u = format_lex (fmt);
if (u != FMT_POSINT)
{
notify_std (&dtp->common, GFC_STD_F2018,
"Positive exponent width required");
}
else
{
fmt->error = "Positive exponent width required in "
"format string at %L";
goto finished;
if (u == FMT_ZERO)
{
notify_std (&dtp->common, GFC_STD_F2018,
"Positive exponent width required");
}
else
{
fmt->error = "Positive exponent width required in "
"format string at %L";
goto finished;
}
}
tail->u.real.e = fmt->value;
}
tail->u.real.e = fmt->value;
break;
}

/* Old DEC codes may not have width or precision specified. */
if (dtp->u.p.mode == WRITING && (dtp->common.flags & IOPARM_DT_DEC_EXT))
{
tail->u.real.w = DEFAULT_WIDTH;
tail->u.real.d = 0;
tail->u.real.e = -1;
fmt->saved_token = u;
}
break;

case FMT_DT:
*seen_dd = true;
get_fnode (fmt, &head, &tail, t);
Expand Down
2 changes: 1 addition & 1 deletion libgfortran/io/io.h
View file
Original file line number Diff line number Diff line change
Expand Up @@ -942,7 +942,7 @@ internal_proto(write_o);
extern void write_real (st_parameter_dt *, const char *, int);
internal_proto(write_real);

extern void write_real_w0 (st_parameter_dt *, const char *, int, format_token, int);
extern void write_real_w0 (st_parameter_dt *, const char *, int, const fnode*);
internal_proto(write_real_w0);

extern void write_x (st_parameter_dt *, int, int);
Expand Down
10 changes: 5 additions & 5 deletions libgfortran/io/transfer.c
View file
Original file line number Diff line number Diff line change
Expand Up @@ -2009,7 +2009,7 @@ formatted_transfer_scalar_write (st_parameter_dt *dtp, bt type, void *p, int kin
if (require_type (dtp, BT_REAL, type, f))
return;
if (f->u.real.w == 0)
write_real_w0 (dtp, p, kind, FMT_D, f->u.real.d);
write_real_w0 (dtp, p, kind, f);
else
write_d (dtp, f, p, kind);
break;
Expand Down Expand Up @@ -2075,7 +2075,7 @@ formatted_transfer_scalar_write (st_parameter_dt *dtp, bt type, void *p, int kin
if (require_type (dtp, BT_REAL, type, f))
return;
if (f->u.real.w == 0)
write_real_w0 (dtp, p, kind, FMT_E, f->u.real.d);
write_real_w0 (dtp, p, kind, f);
else
write_e (dtp, f, p, kind);
break;
Expand All @@ -2086,7 +2086,7 @@ formatted_transfer_scalar_write (st_parameter_dt *dtp, bt type, void *p, int kin
if (require_type (dtp, BT_REAL, type, f))
return;
if (f->u.real.w == 0)
write_real_w0 (dtp, p, kind, FMT_EN, f->u.real.d);
write_real_w0 (dtp, p, kind, f);
else
write_en (dtp, f, p, kind);
break;
Expand All @@ -2097,7 +2097,7 @@ formatted_transfer_scalar_write (st_parameter_dt *dtp, bt type, void *p, int kin
if (require_type (dtp, BT_REAL, type, f))
return;
if (f->u.real.w == 0)
write_real_w0 (dtp, p, kind, FMT_ES, f->u.real.d);
write_real_w0 (dtp, p, kind, f);
else
write_es (dtp, f, p, kind);
break;
Expand Down Expand Up @@ -2129,7 +2129,7 @@ formatted_transfer_scalar_write (st_parameter_dt *dtp, bt type, void *p, int kin
break;
case BT_REAL:
if (f->u.real.w == 0)
write_real_w0 (dtp, p, kind, FMT_G, f->u.real.d);
write_real_w0 (dtp, p, kind, f);
else
write_d (dtp, f, p, kind);
break;
Expand Down
Loading

0 comments on commit 2b70275

Please sign in to comment.