This is the mail archive of the
gcc-patches@gcc.gnu.org
mailing list for the GCC project.
Re: [Patch, Fortran] PR32987 - Allow TAB in FORMAT statements as extension and warn with -std=f*
- From: Tobias Burnus <burnus at net-b dot de>
- To: Jerry DeLisle <jvdelisle at verizon dot net>
- Cc: "'fortran at gcc dot gnu dot org'" <fortran at gcc dot gnu dot org>, gcc-patches <gcc-patches at gcc dot gnu dot org>
- Date: Sat, 04 Aug 2007 22:29:48 +0200
- Subject: Re: [Patch, Fortran] PR32987 - Allow TAB in FORMAT statements as extension and warn with -std=f*
- References: <46B4B951.2050501@net-b.de> <46B4BFB2.3080909@verizon.net>
Jerry DeLisle schrieb:
> I think everyone is in agreement that a compile time diagnostic should
> be given:
> I think the default behavior, without -std=XXX, should give the
> warning at compile.
> I think that for -std=f95 or -std=f2003, an error should be given at
> compile time.
> At runtime, quiet acceptance for default, there is no runtime for -std=
I'm fine with that solution. How about the following patch?
Build and regression tested on x86-64-linux.
OK for the trunk?
Tobias
2007-08-04 Tobias Burnus <burnus@net-b.de>
PR fortran/32987
* io.c (format_token): Add FMT_ERROR.
(next_char_not_space): Print error/warning when
'\t' are used in format specifications.
(format_lex): Propagate error.
(check_format): Ditto.
2007-08-04 Tobias Burnus <burnus@net-b.de>
PR fortran/32987
* io/format.c (next_char): Treat '\t' as ' ' in format specification.
2007-08-04 Tobias Burnus <burnus@net-b.de>
PR fortran/32987
* gfortran.dg/fmt_tab_1.f90: New.
* gfortran.dg/fmt_tab_2.f90: New.
Index: gcc/fortran/io.c
===================================================================
--- gcc/fortran/io.c (revision 127211)
+++ gcc/fortran/io.c (working copy)
@@ -97,7 +97,7 @@ typedef enum
FMT_NONE, FMT_UNKNOWN, FMT_SIGNED_INT, FMT_ZERO, FMT_POSINT, FMT_PERIOD,
FMT_COMMA, FMT_COLON, FMT_SLASH, FMT_DOLLAR, FMT_POS, FMT_LPAREN,
FMT_RPAREN, FMT_X, FMT_SIGN, FMT_BLANK, FMT_CHAR, FMT_P, FMT_IBOZ, FMT_F,
- FMT_E, FMT_EXT, FMT_G, FMT_L, FMT_A, FMT_D, FMT_H, FMT_END
+ FMT_E, FMT_EXT, FMT_G, FMT_L, FMT_A, FMT_D, FMT_H, FMT_END, FMT_ERROR
}
format_token;
@@ -175,12 +175,24 @@ unget_char (void)
/* Eat up the spaces and return a character. */
static char
-next_char_not_space (void)
+next_char_not_space (bool *error)
{
char c;
+ *error = false;
do
{
c = next_char (0);
+ if (c == '\t')
+ {
+ if (gfc_option.allow_std & GFC_STD_GNU)
+ gfc_warning ("Extension: Tab character in format at %C");
+ else
+ {
+ gfc_error ("Extension: Tab character in format at %C");
+ *error = true;
+ return c;
+ }
+ }
}
while (gfc_is_whitespace (c));
return c;
@@ -198,6 +210,7 @@ format_lex (void)
char c, delim;
int zflag;
int negative_flag;
+ bool error;
if (saved_token != FMT_NONE)
{
@@ -206,7 +219,9 @@ format_lex (void)
return token;
}
- c = next_char_not_space ();
+ c = next_char_not_space (&error);
+ if (error)
+ return FMT_ERROR;
negative_flag = 0;
switch (c)
@@ -214,7 +229,9 @@ format_lex (void)
case '-':
negative_flag = 1;
case '+':
- c = next_char_not_space ();
+ c = next_char_not_space (&error);
+ if (error)
+ return FMT_ERROR;
if (!ISDIGIT (c))
{
token = FMT_UNKNOWN;
@@ -225,7 +242,9 @@ format_lex (void)
do
{
- c = next_char_not_space ();
+ c = next_char_not_space (&error);
+ if (error)
+ return FMT_ERROR;
if (ISDIGIT (c))
value = 10 * value + c - '0';
}
@@ -255,7 +274,9 @@ format_lex (void)
do
{
- c = next_char_not_space ();
+ c = next_char_not_space (&error);
+ if (error)
+ return FMT_ERROR;
if (ISDIGIT (c))
{
value = 10 * value + c - '0';
@@ -290,7 +311,9 @@ format_lex (void)
break;
case 'T':
- c = next_char_not_space ();
+ c = next_char_not_space (&error);
+ if (error)
+ return FMT_ERROR;
if (c != 'L' && c != 'R')
unget_char ();
@@ -310,7 +333,9 @@ format_lex (void)
break;
case 'S':
- c = next_char_not_space ();
+ c = next_char_not_space (&error);
+ if (error)
+ return FMT_ERROR;
if (c != 'P' && c != 'S')
unget_char ();
@@ -318,7 +343,9 @@ format_lex (void)
break;
case 'B':
- c = next_char_not_space ();
+ c = next_char_not_space (&error);
+ if (error)
+ return FMT_ERROR;
if (c == 'N' || c == 'Z')
token = FMT_BLANK;
else
@@ -380,7 +407,9 @@ format_lex (void)
break;
case 'E':
- c = next_char_not_space ();
+ c = next_char_not_space (&error);
+ if (error)
+ return FMT_ERROR;
if (c == 'N' || c == 'S')
token = FMT_EXT;
else
@@ -450,6 +479,8 @@ check_format (bool is_input)
rv = SUCCESS;
t = format_lex ();
+ if (t == FMT_ERROR)
+ goto fail;
if (t != FMT_LPAREN)
{
error = _("Missing leading left parenthesis");
@@ -457,6 +488,8 @@ check_format (bool is_input)
}
t = format_lex ();
+ if (t == FMT_ERROR)
+ goto fail;
if (t == FMT_RPAREN)
goto finished; /* Empty format is legal */
saved_token = t;
@@ -464,12 +497,16 @@ check_format (bool is_input)
format_item:
/* In this state, the next thing has to be a format item. */
t = format_lex ();
+ if (t == FMT_ERROR)
+ goto fail;
format_item_1:
switch (t)
{
case FMT_POSINT:
repeat = value;
t = format_lex ();
+ if (t == FMT_ERROR)
+ goto fail;
if (t == FMT_LPAREN)
{
level++;
@@ -489,6 +526,8 @@ format_item_1:
case FMT_ZERO:
/* Signed integer can only precede a P format. */
t = format_lex ();
+ if (t == FMT_ERROR)
+ goto fail;
if (t != FMT_P)
{
error = _("Expected P edit descriptor");
@@ -523,6 +562,8 @@ format_item_1:
case FMT_DOLLAR:
t = format_lex ();
+ if (t == FMT_ERROR)
+ goto fail;
if (gfc_notify_std (GFC_STD_GNU, "Extension: $ descriptor at %C")
== FAILURE)
@@ -570,6 +611,8 @@ data_desc:
if (pedantic)
{
t = format_lex ();
+ if (t == FMT_ERROR)
+ goto fail;
if (t == FMT_POSINT)
{
error = _("Repeat count cannot follow P descriptor");
@@ -584,6 +627,8 @@ data_desc:
case FMT_POS:
case FMT_L:
t = format_lex ();
+ if (t == FMT_ERROR)
+ goto fail;
if (t == FMT_POSINT)
break;
@@ -610,6 +655,8 @@ data_desc:
case FMT_A:
t = format_lex ();
+ if (t == FMT_ERROR)
+ goto fail;
if (t != FMT_POSINT)
saved_token = t;
break;
@@ -619,6 +666,8 @@ data_desc:
case FMT_G:
case FMT_EXT:
u = format_lex ();
+ if (u == FMT_ERROR)
+ goto fail;
if (u != FMT_POSINT)
{
error = posint_required;
@@ -626,6 +675,8 @@ data_desc:
}
u = format_lex ();
+ if (u == FMT_ERROR)
+ goto fail;
if (u != FMT_PERIOD)
{
/* Warn if -std=legacy, otherwise error. */
@@ -638,6 +689,8 @@ data_desc:
}
u = format_lex ();
+ if (u == FMT_ERROR)
+ goto fail;
if (u != FMT_ZERO && u != FMT_POSINT)
{
error = nonneg_required;
@@ -649,6 +702,8 @@ data_desc:
/* Look for optional exponent. */
u = format_lex ();
+ if (u == FMT_ERROR)
+ goto fail;
if (u != FMT_E)
{
saved_token = u;
@@ -656,6 +711,8 @@ data_desc:
else
{
u = format_lex ();
+ if (u == FMT_ERROR)
+ goto fail;
if (u != FMT_POSINT)
{
error = _("Positive exponent width required");
@@ -667,6 +724,8 @@ data_desc:
case FMT_F:
t = format_lex ();
+ if (t == FMT_ERROR)
+ goto fail;
if (t != FMT_ZERO && t != FMT_POSINT)
{
error = nonneg_required;
@@ -679,6 +738,8 @@ data_desc:
}
t = format_lex ();
+ if (t == FMT_ERROR)
+ goto fail;
if (t != FMT_PERIOD)
{
/* Warn if -std=legacy, otherwise error. */
@@ -691,6 +752,8 @@ data_desc:
}
t = format_lex ();
+ if (t == FMT_ERROR)
+ goto fail;
if (t != FMT_ZERO && t != FMT_POSINT)
{
error = nonneg_required;
@@ -721,6 +784,8 @@ data_desc:
case FMT_IBOZ:
t = format_lex ();
+ if (t == FMT_ERROR)
+ goto fail;
if (t != FMT_ZERO && t != FMT_POSINT)
{
error = nonneg_required;
@@ -733,6 +798,8 @@ data_desc:
}
t = format_lex ();
+ if (t == FMT_ERROR)
+ goto fail;
if (t != FMT_PERIOD)
{
saved_token = t;
@@ -740,6 +807,8 @@ data_desc:
else
{
t = format_lex ();
+ if (t == FMT_ERROR)
+ goto fail;
if (t != FMT_ZERO && t != FMT_POSINT)
{
error = nonneg_required;
@@ -757,6 +826,8 @@ data_desc:
between_desc:
/* Between a descriptor and what comes next. */
t = format_lex ();
+ if (t == FMT_ERROR)
+ goto fail;
switch (t)
{
@@ -788,6 +859,8 @@ optional_comma:
/* Optional comma is a weird between state where we've just finished
reading a colon, slash, dollar or P descriptor. */
t = format_lex ();
+ if (t == FMT_ERROR)
+ goto fail;
optional_comma_1:
switch (t)
{
@@ -811,6 +884,8 @@ optional_comma_1:
extension_optional_comma:
/* As a GNU extension, permit a missing comma after a string literal. */
t = format_lex ();
+ if (t == FMT_ERROR)
+ goto fail;
switch (t)
{
case FMT_COMMA:
@@ -842,7 +917,7 @@ extension_optional_comma:
syntax:
gfc_error ("%s in format string at %C", error);
-
+fail:
/* TODO: More elaborate measures are needed to show where a problem
is within a format string that has been calculated. */
rv = FAILURE;
Index: libgfortran/io/format.c
===================================================================
--- libgfortran/io/format.c (revision 127208)
+++ libgfortran/io/format.c (working copy)
@@ -92,7 +92,7 @@ next_char (format_data *fmt, int literal
fmt->format_string_len--;
c = toupper (*fmt->format_string++);
}
- while (c == ' ' && !literal);
+ while ((c == ' ' || c == '\t') && !literal);
return c;
}
Index: gcc/testsuite/gfortran.dg/fmt_tab_1.f90
===================================================================
--- gcc/testsuite/gfortran.dg/fmt_tab_1.f90 (revision 0)
+++ gcc/testsuite/gfortran.dg/fmt_tab_1.f90 (revision 0)
@@ -0,0 +1,6 @@
+! { dg-do run }
+! PR fortran/32987
+ program TestFormat
+ write (*, 10)
+ 10 format ('Hello ', 'bug!') ! { dg-warning "Extension: Tab character in format" }
+ end
Index: gcc/testsuite/gfortran.dg/fmt_tab_2.f90
===================================================================
--- gcc/testsuite/gfortran.dg/fmt_tab_2.f90 (revision 0)
+++ gcc/testsuite/gfortran.dg/fmt_tab_2.f90 (revision 0)
@@ -0,0 +1,7 @@
+! { dg-do compile }
+! { dg-options "-std=f2003" }
+! PR fortran/32987
+ program TestFormat
+ write (*, 10) ! { dg-error "FORMAT label 10 at .1. not defined" }
+ 10 format ('Hello ', 'bug!') ! { dg-error "Extension: Tab character in format" }
+ end