procyberian/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

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

Browse source 
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
This commit is contained in:
Jerry DeLisle 2009-08-17 14:25:38 +00:00
parent dee285096f
commit b823d9ebdf
3 changed files with 66 additions and 20 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

9
gcc/fortran/ChangeLog
View file

@ -1,3 +1,12 @@
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>
PR fortran/40877

75
gcc/fortran/io.c
View file

@ -111,7 +111,7 @@ typedef enum
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_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;
@ -469,6 +469,10 @@ format_lex (void)
token = FMT_END;
break;
case '*':
token = FMT_STAR;
break;
default:
token = FMT_UNKNOWN;
break;
@ -533,6 +537,19 @@ format_item:
format_item_1:
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:
repeat = value;
t = format_lex ();
@ -575,7 +592,7 @@ format_item_1:
case FMT_X:
/* X requires a prior number if we're being pedantic. */
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)
return FAILURE;
goto between_desc;
@ -598,12 +615,13 @@ format_item_1:
if (t == FMT_ERROR)
goto fail;
if (gfc_notify_std (GFC_STD_GNU, "Extension: $ descriptor at %C")
== FAILURE)
if (gfc_notify_std (GFC_STD_GNU, "Extension: $ descriptor at %L",
&format_locus) == FAILURE)
return FAILURE;
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;
}
@ -682,8 +700,10 @@ data_desc:
switch (gfc_notification_std (GFC_STD_GNU))
{
case WARNING:
if (mode != MODE_FORMAT)
format_locus.nextc += format_string_pos;
gfc_warning ("Extension: Missing positive width after L "
"descriptor at %C");
"descriptor at %L", &format_locus);
saved_token = t;
break;
@ -726,7 +746,7 @@ data_desc:
goto syntax;
}
if (gfc_notify_std (GFC_STD_F2008, "Fortran 2008: 'G0' in "
"format at %C") == FAILURE)
"format at %L", &format_locus) == FAILURE)
return FAILURE;
u = format_lex ();
if (u != FMT_PERIOD)
@ -756,10 +776,14 @@ data_desc:
if (u != FMT_PERIOD)
{
/* Warn if -std=legacy, otherwise error. */
if (mode != MODE_FORMAT)
format_locus.nextc += format_string_pos;
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
gfc_warning ("Period required in format specifier at %C");
gfc_warning ("Period required in format specifier at %L",
&format_locus);
saved_token = u;
break;
}
@ -819,10 +843,15 @@ data_desc:
if (t != FMT_PERIOD)
{
/* Warn if -std=legacy, otherwise error. */
if (mode != MODE_FORMAT)
format_locus.nextc += format_string_pos;
if (gfc_option.warn_std != 0)
gfc_error_now ("Period required in format specifier at %C");
else
gfc_warning ("Period required in format specifier at %C");
{
error = _("Period required in format specifier at %L");
goto syntax;
}
gfc_warning ("Period required in format specifier at %L",
&format_locus);
saved_token = t;
break;
}
@ -840,8 +869,12 @@ data_desc:
case FMT_H:
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)
{
@ -925,8 +958,10 @@ between_desc:
goto syntax;
default:
if (gfc_notify_std (GFC_STD_GNU, "Extension: Missing comma at %C")
== FAILURE)
if (mode != MODE_FORMAT)
format_locus.nextc += format_string_pos;
if (gfc_notify_std (GFC_STD_GNU, "Extension: Missing comma at %L",
&format_locus) == FAILURE)
return FAILURE;
goto format_item_1;
}
@ -982,15 +1017,17 @@ extension_optional_comma:
goto syntax;
default:
if (gfc_notify_std (GFC_STD_GNU, "Extension: Missing comma at %C")
== FAILURE)
if (mode != MODE_FORMAT)
format_locus.nextc += format_string_pos;
if (gfc_notify_std (GFC_STD_GNU, "Extension: Missing comma at %L",
&format_locus) == FAILURE)
return FAILURE;
saved_token = t;
break;
}
goto format_item;
syntax:
if (mode != MODE_FORMAT)
format_locus.nextc += format_string_pos;

2
gcc/fortran/scanner.c
View file

@ -1139,7 +1139,7 @@ restart:
}
}
}
else
else /* Fixed form. */
{
/* Fixed form continuation. */
if (!in_string && c == '!')