Hi all,
The attached patch includes adjustments to the test case.
The Fortran Standard states the exponent width when using the e0
exponent specfier results in the smallest possible exponent width. This
patch implements that case.
I got frustrated with trying to re-understand this code segment and even
found some dead code in there. As a result I did some major refactoring
of the code and separated out the zero width, positive width, and no
width DEC extensions into their own chunks. I also added comments in
hopes of helping others follow what this is doing and how it works.
This patch resolves some parsing issues currently on trunk where a
format specifier following the e0.d.e specifier would result in an error
(comments 12 and 20 of the PR). These are fixed.
The patch, as it is, passes regression testing but I must confess I may
not have all the DEC stuff right yet and I propose we commit the patch
here and address any DEC stuff as a follow up. (I will be looking at the
DEC stuff in the next few days.)
OK for trunk?
Regards,
Jerry
diff --git a/gcc/testsuite/gfortran.dg/fmt_zero_width.f90 b/gcc/testsuite/gfortran.dg/fmt_zero_width.f90
index 640b6735c65..db2cca6e28a 100644
--- a/gcc/testsuite/gfortran.dg/fmt_zero_width.f90
+++ b/gcc/testsuite/gfortran.dg/fmt_zero_width.f90
@@ -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.313928E-02") stop 15
+ if (aresult /= "0.313928E-2") stop 15
afmt = "(ES0.10)"
write (aresult,fmt=afmt) rn
- if (aresult /= "3.139280E-03") stop 18
+ if (aresult /= "3.139280E-3") stop 18
afmt = "(EN0.10)"
write (aresult,fmt=afmt) rn
- if (aresult /= "3.139280E-03") stop 21
+ if (aresult /= "3.139280E-3") stop 21
afmt = "(G0.10)"
write (aresult,fmt=afmt) rn
- if (aresult /= "0.313928E-02") stop 24
+ if (aresult /= "0.313928E-2") stop 24
afmt = "(E0.10e0)"
write (aresult,fmt=afmt) rn
- if (aresult /= "0.313928E-02") stop 27
+ if (aresult /= "0.313928E-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.313928E-02") stop 31
+ if (aresult /= "0.313928E-2") stop 31
write (aresult,fmt="(ES0.10)") rn
- if (aresult /= "3.139280E-03") stop 33
+ if (aresult /= "3.139280E-3") stop 33
write (aresult,fmt="(EN0.10)") rn
- if (aresult /= "3.139280E-03") stop 35
+ if (aresult /= "3.139280E-3") stop 35
write (aresult,fmt="(G0.10)") rn
- if (aresult /= "0.313928E-02") stop 37
+ if (aresult /= "0.313928E-2") stop 37
write (aresult,fmt="(E0.10e0)") rn
- if (aresult /= "0.313928E-02") stop 39
+ if (aresult /= "0.313928E-2") stop 39
+ write (aresult,fmt="(E0.10e3)") rn
+ if (aresult /= ".313928E-002") stop 41
end
diff --git a/libgfortran/io/format.c b/libgfortran/io/format.c
index 0b23721c055..1406e46693a 100644
--- a/libgfortran/io/format.c
+++ b/libgfortran/io/format.c
@@ -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",
@@ -925,6 +925,8 @@ 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;
@@ -935,6 +937,8 @@ parse_format_list (st_parameter_dt *dtp, bool *seen_dd)
goto finished;
}
tail->u.real.w = 0;
+
+ /* Look for the dot seperator. */
u = format_lex (fmt);
if (u != FMT_PERIOD)
{
@@ -942,108 +946,120 @@ parse_format_list (st_parameter_dt *dtp, bool *seen_dd)
break;
}
+ /* Look for the precision. */
u = format_lex (fmt);
- if (u != FMT_POSINT)
- notify_std (>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;
-
