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;
/* Eat up the spaces and return a character. */
static char
-next_char_not_space (void)
+next_char_not_space (bool *error)
{
char c;
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;
char c, delim;
int zflag;
int negative_flag;
+ bool error = false;
if (saved_token != FMT_NONE)
{
return token;
}
- c = next_char_not_space ();
+ c = next_char_not_space (&error);
negative_flag = 0;
switch (c)
case '-':
negative_flag = 1;
case '+':
- c = next_char_not_space ();
+ c = next_char_not_space (&error);
if (!ISDIGIT (c))
{
token = FMT_UNKNOWN;
do
{
- c = next_char_not_space ();
+ c = next_char_not_space (&error);
if (ISDIGIT (c))
value = 10 * value + c - '0';
}
do
{
- c = next_char_not_space ();
+ c = next_char_not_space (&error);
if (ISDIGIT (c))
{
value = 10 * value + c - '0';
break;
case 'T':
- c = next_char_not_space ();
+ c = next_char_not_space (&error);
if (c != 'L' && c != 'R')
unget_char ();
break;
case 'S':
- c = next_char_not_space ();
+ c = next_char_not_space (&error);
if (c != 'P' && c != 'S')
unget_char ();
break;
case 'B':
- c = next_char_not_space ();
+ c = next_char_not_space (&error);
if (c == 'N' || c == 'Z')
token = FMT_BLANK;
else
break;
case 'E':
- c = next_char_not_space ();
+ c = next_char_not_space (&error);
if (c == 'N' || c == 'S')
token = FMT_EXT;
else
break;
}
+ if (error)
+ return FMT_ERROR;
+
return token;
}
rv = SUCCESS;
t = format_lex ();
+ if (t == FMT_ERROR)
+ goto fail;
if (t != FMT_LPAREN)
{
error = _("Missing leading left parenthesis");
}
t = format_lex ();
+ if (t == FMT_ERROR)
+ goto fail;
if (t == FMT_RPAREN)
goto finished; /* Empty format is legal */
saved_token = t;
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++;
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");
case FMT_DOLLAR:
t = format_lex ();
+ if (t == FMT_ERROR)
+ goto fail;
if (gfc_notify_std (GFC_STD_GNU, "Extension: $ descriptor at %C")
== FAILURE)
if (pedantic)
{
t = format_lex ();
+ if (t == FMT_ERROR)
+ goto fail;
if (t == FMT_POSINT)
{
error = _("Repeat count cannot follow P descriptor");
case FMT_POS:
case FMT_L:
t = format_lex ();
+ if (t == FMT_ERROR)
+ goto fail;
if (t == FMT_POSINT)
break;
case FMT_A:
t = format_lex ();
+ if (t == FMT_ERROR)
+ goto fail;
if (t != FMT_POSINT)
saved_token = t;
break;
case FMT_G:
case FMT_EXT:
u = format_lex ();
+ if (u == FMT_ERROR)
+ goto fail;
if (u != FMT_POSINT)
{
error = posint_required;
}
u = format_lex ();
+ if (u == FMT_ERROR)
+ goto fail;
if (u != FMT_PERIOD)
{
/* Warn if -std=legacy, otherwise error. */
}
u = format_lex ();
+ if (u == FMT_ERROR)
+ goto fail;
if (u != FMT_ZERO && u != FMT_POSINT)
{
error = nonneg_required;
/* Look for optional exponent. */
u = format_lex ();
+ if (u == FMT_ERROR)
+ goto fail;
if (u != FMT_E)
{
saved_token = u;
else
{
u = format_lex ();
+ if (u == FMT_ERROR)
+ goto fail;
if (u != FMT_POSINT)
{
error = _("Positive exponent width required");
case FMT_F:
t = format_lex ();
+ if (t == FMT_ERROR)
+ goto fail;
if (t != FMT_ZERO && t != FMT_POSINT)
{
error = nonneg_required;
}
t = format_lex ();
+ if (t == FMT_ERROR)
+ goto fail;
if (t != FMT_PERIOD)
{
/* Warn if -std=legacy, otherwise error. */
}
t = format_lex ();
+ if (t == FMT_ERROR)
+ goto fail;
if (t != FMT_ZERO && t != FMT_POSINT)
{
error = nonneg_required;
case FMT_IBOZ:
t = format_lex ();
+ if (t == FMT_ERROR)
+ goto fail;
if (t != FMT_ZERO && t != FMT_POSINT)
{
error = nonneg_required;
}
t = format_lex ();
+ if (t == FMT_ERROR)
+ goto fail;
if (t != FMT_PERIOD)
{
saved_token = t;
else
{
t = format_lex ();
+ if (t == FMT_ERROR)
+ goto fail;
if (t != FMT_ZERO && t != FMT_POSINT)
{
error = nonneg_required;
between_desc:
/* Between a descriptor and what comes next. */
t = format_lex ();
+ if (t == FMT_ERROR)
+ goto fail;
switch (t)
{
/* 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)
{
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:
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;