Commit b823d9eb by Jerry DeLisle

re PR fortran/41075 ([F2008] Implement unlimited format item)

2009-08-17  Jerry DeLisle  <jvdelisle@gcc.gnu.org>

	PR fortran/41075
	* scanner.c (gfc_next_char_literal): Add comment to improve 
	readability.
	* io.c (enum format_token): Add FMT_STAR. (format_lex): Add case
	for '*'. (check_format): Check for left paren after '*'.  Change
	format checks to use %L to improve format string error locus.

From-SVN: r150843
parent dee28509
2009-08-17 Jerry DeLisle <jvdelisle@gcc.gnu.org>
PR fortran/41075
* scanner.c (gfc_next_char_literal): Add comment to improve
readability.
* io.c (enum format_token): Add FMT_STAR. (format_lex): Add case
for '*'. (check_format): Check for left paren after '*'. Change
format checks to use %L to improve format string error locus.
2009-08-17 Janus Weil <janus@gcc.gnu.org> 2009-08-17 Janus Weil <janus@gcc.gnu.org>
PR fortran/40877 PR fortran/40877
......
...@@ -111,7 +111,7 @@ typedef enum ...@@ -111,7 +111,7 @@ typedef enum
FMT_COMMA, FMT_COLON, FMT_SLASH, FMT_DOLLAR, FMT_LPAREN, FMT_COMMA, FMT_COLON, FMT_SLASH, FMT_DOLLAR, FMT_LPAREN,
FMT_RPAREN, FMT_X, FMT_SIGN, FMT_BLANK, FMT_CHAR, FMT_P, FMT_IBOZ, FMT_F, 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_ERROR, FMT_DC, FMT_E, FMT_EXT, FMT_G, FMT_L, FMT_A, FMT_D, FMT_H, FMT_END, FMT_ERROR, FMT_DC,
FMT_DP, FMT_T, FMT_TR, FMT_TL FMT_DP, FMT_T, FMT_TR, FMT_TL, FMT_STAR
} }
format_token; format_token;
...@@ -469,6 +469,10 @@ format_lex (void) ...@@ -469,6 +469,10 @@ format_lex (void)
token = FMT_END; token = FMT_END;
break; break;
case '*':
token = FMT_STAR;
break;
default: default:
token = FMT_UNKNOWN; token = FMT_UNKNOWN;
break; break;
...@@ -533,6 +537,19 @@ format_item: ...@@ -533,6 +537,19 @@ format_item:
format_item_1: format_item_1:
switch (t) switch (t)
{ {
case FMT_STAR:
repeat = -1;
t = format_lex ();
if (t == FMT_ERROR)
goto fail;
if (t == FMT_LPAREN)
{
level++;
goto format_item;
}
error = _("Left parenthesis required after '*'");
goto syntax;
case FMT_POSINT: case FMT_POSINT:
repeat = value; repeat = value;
t = format_lex (); t = format_lex ();
...@@ -575,7 +592,7 @@ format_item_1: ...@@ -575,7 +592,7 @@ format_item_1:
case FMT_X: case FMT_X:
/* X requires a prior number if we're being pedantic. */ /* X requires a prior number if we're being pedantic. */
if (gfc_notify_std (GFC_STD_GNU, "Extension: X descriptor " if (gfc_notify_std (GFC_STD_GNU, "Extension: X descriptor "
"requires leading space count at %C") "requires leading space count at %L", &format_locus)
== FAILURE) == FAILURE)
return FAILURE; return FAILURE;
goto between_desc; goto between_desc;
...@@ -598,12 +615,13 @@ format_item_1: ...@@ -598,12 +615,13 @@ format_item_1:
if (t == FMT_ERROR) if (t == FMT_ERROR)
goto fail; goto fail;
if (gfc_notify_std (GFC_STD_GNU, "Extension: $ descriptor at %C") if (gfc_notify_std (GFC_STD_GNU, "Extension: $ descriptor at %L",
== FAILURE) &format_locus) == FAILURE)
return FAILURE; return FAILURE;
if (t != FMT_RPAREN || level > 0) if (t != FMT_RPAREN || level > 0)
{ {
gfc_warning ("$ should be the last specifier in format at %C"); gfc_warning ("$ should be the last specifier in format at %L",
&format_locus);
goto optional_comma_1; goto optional_comma_1;
} }
...@@ -682,8 +700,10 @@ data_desc: ...@@ -682,8 +700,10 @@ data_desc:
switch (gfc_notification_std (GFC_STD_GNU)) switch (gfc_notification_std (GFC_STD_GNU))
{ {
case WARNING: case WARNING:
if (mode != MODE_FORMAT)
format_locus.nextc += format_string_pos;
gfc_warning ("Extension: Missing positive width after L " gfc_warning ("Extension: Missing positive width after L "
"descriptor at %C"); "descriptor at %L", &format_locus);
saved_token = t; saved_token = t;
break; break;
...@@ -726,7 +746,7 @@ data_desc: ...@@ -726,7 +746,7 @@ data_desc:
goto syntax; goto syntax;
} }
if (gfc_notify_std (GFC_STD_F2008, "Fortran 2008: 'G0' in " if (gfc_notify_std (GFC_STD_F2008, "Fortran 2008: 'G0' in "
"format at %C") == FAILURE) "format at %L", &format_locus) == FAILURE)
return FAILURE; return FAILURE;
u = format_lex (); u = format_lex ();
if (u != FMT_PERIOD) if (u != FMT_PERIOD)
...@@ -756,10 +776,14 @@ data_desc: ...@@ -756,10 +776,14 @@ data_desc:
if (u != FMT_PERIOD) if (u != FMT_PERIOD)
{ {
/* Warn if -std=legacy, otherwise error. */ /* Warn if -std=legacy, otherwise error. */
if (mode != MODE_FORMAT)
format_locus.nextc += format_string_pos;
if (gfc_option.warn_std != 0) if (gfc_option.warn_std != 0)
gfc_error_now ("Period required in format specifier at %C"); gfc_error_now ("Period required in format specifier at %L",
&format_locus);
else else
gfc_warning ("Period required in format specifier at %C"); gfc_warning ("Period required in format specifier at %L",
&format_locus);
saved_token = u; saved_token = u;
break; break;
} }
...@@ -819,10 +843,15 @@ data_desc: ...@@ -819,10 +843,15 @@ data_desc:
if (t != FMT_PERIOD) if (t != FMT_PERIOD)
{ {
/* Warn if -std=legacy, otherwise error. */ /* Warn if -std=legacy, otherwise error. */
if (mode != MODE_FORMAT)
format_locus.nextc += format_string_pos;
if (gfc_option.warn_std != 0) if (gfc_option.warn_std != 0)
gfc_error_now ("Period required in format specifier at %C"); {
else error = _("Period required in format specifier at %L");
gfc_warning ("Period required in format specifier at %C"); goto syntax;
}
gfc_warning ("Period required in format specifier at %L",
&format_locus);
saved_token = t; saved_token = t;
break; break;
} }
...@@ -840,8 +869,12 @@ data_desc: ...@@ -840,8 +869,12 @@ data_desc:
case FMT_H: case FMT_H:
if (!(gfc_option.allow_std & GFC_STD_GNU) && !inhibit_warnings) if (!(gfc_option.allow_std & GFC_STD_GNU) && !inhibit_warnings)
gfc_warning ("The H format specifier at %C is" {
" a Fortran 95 deleted feature"); if (mode != MODE_FORMAT)
format_locus.nextc += format_string_pos;
gfc_warning ("The H format specifier at %L is"
" a Fortran 95 deleted feature", &format_locus);
}
if (mode == MODE_STRING) if (mode == MODE_STRING)
{ {
...@@ -925,8 +958,10 @@ between_desc: ...@@ -925,8 +958,10 @@ between_desc:
goto syntax; goto syntax;
default: default:
if (gfc_notify_std (GFC_STD_GNU, "Extension: Missing comma at %C") if (mode != MODE_FORMAT)
== FAILURE) format_locus.nextc += format_string_pos;
if (gfc_notify_std (GFC_STD_GNU, "Extension: Missing comma at %L",
&format_locus) == FAILURE)
return FAILURE; return FAILURE;
goto format_item_1; goto format_item_1;
} }
...@@ -982,8 +1017,10 @@ extension_optional_comma: ...@@ -982,8 +1017,10 @@ extension_optional_comma:
goto syntax; goto syntax;
default: default:
if (gfc_notify_std (GFC_STD_GNU, "Extension: Missing comma at %C") if (mode != MODE_FORMAT)
== FAILURE) format_locus.nextc += format_string_pos;
if (gfc_notify_std (GFC_STD_GNU, "Extension: Missing comma at %L",
&format_locus) == FAILURE)
return FAILURE; return FAILURE;
saved_token = t; saved_token = t;
break; break;
......
...@@ -1139,7 +1139,7 @@ restart: ...@@ -1139,7 +1139,7 @@ restart:
} }
} }
} }
else else /* Fixed form. */
{ {
/* Fixed form continuation. */ /* Fixed form continuation. */
if (!in_string && c == '!') if (!in_string && c == '!')
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment