/* Matching subroutines in all sizes, shapes and colors.
- Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007
+ Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008
Free Software Foundation, Inc.
Contributed by Andy Vaught
gfc_match_parens (void)
{
locus old_loc, where;
- int c, count, instring;
- char quote;
+ int count, instring;
+ gfc_char_t c, quote;
old_loc = gfc_current_locus;
count = 0;
break;
if (quote == ' ' && ((c == '\'') || (c == '"')))
{
- quote = (char) c;
+ quote = c;
instring = 1;
continue;
}
if (count > 0)
{
- gfc_error ("Missing ')' in statement before %L", &where);
+ gfc_error ("Missing ')' in statement at or before %L", &where);
return MATCH_ERROR;
}
if (count < 0)
{
- gfc_error ("Missing '(' in statement before %L", &where);
+ gfc_error ("Missing '(' in statement at or before %L", &where);
return MATCH_ERROR;
}
escaped by a \ via the -fbackslash option. */
match
-gfc_match_special_char (int *c)
+gfc_match_special_char (gfc_char_t *res)
{
-
+ int len, i;
+ gfc_char_t c, n;
match m;
m = MATCH_YES;
- switch (gfc_next_char_literal (1))
+ switch ((c = gfc_next_char_literal (1)))
{
case 'a':
- *c = '\a';
+ *res = '\a';
break;
case 'b':
- *c = '\b';
+ *res = '\b';
break;
case 't':
- *c = '\t';
+ *res = '\t';
break;
case 'f':
- *c = '\f';
+ *res = '\f';
break;
case 'n':
- *c = '\n';
+ *res = '\n';
break;
case 'r':
- *c = '\r';
+ *res = '\r';
break;
case 'v':
- *c = '\v';
+ *res = '\v';
break;
case '\\':
- *c = '\\';
+ *res = '\\';
break;
case '0':
- *c = '\0';
+ *res = '\0';
+ break;
+
+ case 'x':
+ case 'u':
+ case 'U':
+ /* Hexadecimal form of wide characters. */
+ len = (c == 'x' ? 2 : (c == 'u' ? 4 : 8));
+ n = 0;
+ for (i = 0; i < len; i++)
+ {
+ char buf[2] = { '\0', '\0' };
+
+ c = gfc_next_char_literal (1);
+ if (!gfc_wide_fits_in_byte (c)
+ || !gfc_check_digit ((unsigned char) c, 16))
+ return MATCH_NO;
+
+ buf[0] = (unsigned char) c;
+ n = n << 4;
+ n += strtol (buf, NULL, 16);
+ }
+ *res = n;
break;
+
default:
/* Unknown backslash codes are simply not expanded. */
m = MATCH_NO;
gfc_match_space (void)
{
locus old_loc;
- int c;
+ char c;
if (gfc_current_form == FORM_FIXED)
return MATCH_YES;
old_loc = gfc_current_locus;
- c = gfc_next_char ();
+ c = gfc_next_ascii_char ();
if (!gfc_is_whitespace (c))
{
gfc_current_locus = old_loc;
gfc_match_eos (void)
{
locus old_loc;
- int flag, c;
+ int flag;
+ char c;
flag = 0;
old_loc = gfc_current_locus;
gfc_gobble_whitespace ();
- c = gfc_next_char ();
+ c = gfc_next_ascii_char ();
switch (c)
{
case '!':
do
{
- c = gfc_next_char ();
+ c = gfc_next_ascii_char ();
}
while (c != '\n');
old_loc = gfc_current_locus;
+ *value = -1;
gfc_gobble_whitespace ();
- c = gfc_next_char ();
+ c = gfc_next_ascii_char ();
if (cnt)
*cnt = 0;
for (;;)
{
old_loc = gfc_current_locus;
- c = gfc_next_char ();
+ c = gfc_next_ascii_char ();
if (!ISDIGIT (c))
break;
gfc_match_name (char *buffer)
{
locus old_loc;
- int i, c;
+ int i;
+ char c;
old_loc = gfc_current_locus;
gfc_gobble_whitespace ();
- c = gfc_next_char ();
+ c = gfc_next_ascii_char ();
if (!(ISALPHA (c) || (c == '_' && gfc_option.flag_allow_leading_underscore)))
{
if (gfc_error_flag_test() == 0 && c != '(')
}
old_loc = gfc_current_locus;
- c = gfc_next_char ();
+ c = gfc_next_ascii_char ();
}
while (ISALNUM (c) || c == '_' || (gfc_option.flag_dollar_ok && c == '$'));
if (c == '$' && !gfc_option.flag_dollar_ok)
{
- gfc_error ("Invalid character '$' at %C. Use -fdollar-ok to allow it as an extension");
+ gfc_error ("Invalid character '$' at %C. Use -fdollar-ok to allow it "
+ "as an extension");
return MATCH_ERROR;
}
-
buffer[i] = '\0';
gfc_current_locus = old_loc;
{
locus old_loc;
int i = 0;
- int c;
+ gfc_char_t c;
old_loc = gfc_current_locus;
gfc_gobble_whitespace ();
/* Continue to read valid variable name characters. */
do
{
- buffer[i++] = c;
+ gcc_assert (gfc_wide_fits_in_byte (c));
+
+ buffer[i++] = (unsigned char) c;
/* C does not define a maximum length of variable names, to my
knowledge, but the compiler typically places a limit on them.
if (c == ' ')
{
gfc_gobble_whitespace ();
- c = gfc_peek_char ();
+ c = gfc_peek_ascii_char ();
if (c != '"' && c != '\'')
{
gfc_error ("Embedded space in NAME= specifier at %C");
gfc_match_intrinsic_op (gfc_intrinsic_op *result)
{
locus orig_loc = gfc_current_locus;
- int ch;
+ char ch;
gfc_gobble_whitespace ();
- ch = gfc_next_char ();
+ ch = gfc_next_ascii_char ();
switch (ch)
{
case '+':
return MATCH_YES;
case '=':
- if (gfc_next_char () == '=')
+ if (gfc_next_ascii_char () == '=')
{
/* Matched "==". */
*result = INTRINSIC_EQ;
break;
case '<':
- if (gfc_peek_char () == '=')
+ if (gfc_peek_ascii_char () == '=')
{
/* Matched "<=". */
- gfc_next_char ();
+ gfc_next_ascii_char ();
*result = INTRINSIC_LE;
return MATCH_YES;
}
return MATCH_YES;
case '>':
- if (gfc_peek_char () == '=')
+ if (gfc_peek_ascii_char () == '=')
{
/* Matched ">=". */
- gfc_next_char ();
+ gfc_next_ascii_char ();
*result = INTRINSIC_GE;
return MATCH_YES;
}
return MATCH_YES;
case '*':
- if (gfc_peek_char () == '*')
+ if (gfc_peek_ascii_char () == '*')
{
/* Matched "**". */
- gfc_next_char ();
+ gfc_next_ascii_char ();
*result = INTRINSIC_POWER;
return MATCH_YES;
}
return MATCH_YES;
case '/':
- ch = gfc_peek_char ();
+ ch = gfc_peek_ascii_char ();
if (ch == '=')
{
/* Matched "/=". */
- gfc_next_char ();
+ gfc_next_ascii_char ();
*result = INTRINSIC_NE;
return MATCH_YES;
}
else if (ch == '/')
{
/* Matched "//". */
- gfc_next_char ();
+ gfc_next_ascii_char ();
*result = INTRINSIC_CONCAT;
return MATCH_YES;
}
return MATCH_YES;
case '.':
- ch = gfc_next_char ();
+ ch = gfc_next_ascii_char ();
switch (ch)
{
case 'a':
- if (gfc_next_char () == 'n'
- && gfc_next_char () == 'd'
- && gfc_next_char () == '.')
+ if (gfc_next_ascii_char () == 'n'
+ && gfc_next_ascii_char () == 'd'
+ && gfc_next_ascii_char () == '.')
{
/* Matched ".and.". */
*result = INTRINSIC_AND;
break;
case 'e':
- if (gfc_next_char () == 'q')
+ if (gfc_next_ascii_char () == 'q')
{
- ch = gfc_next_char ();
+ ch = gfc_next_ascii_char ();
if (ch == '.')
{
/* Matched ".eq.". */
}
else if (ch == 'v')
{
- if (gfc_next_char () == '.')
+ if (gfc_next_ascii_char () == '.')
{
/* Matched ".eqv.". */
*result = INTRINSIC_EQV;
break;
case 'g':
- ch = gfc_next_char ();
+ ch = gfc_next_ascii_char ();
if (ch == 'e')
{
- if (gfc_next_char () == '.')
+ if (gfc_next_ascii_char () == '.')
{
/* Matched ".ge.". */
*result = INTRINSIC_GE_OS;
}
else if (ch == 't')
{
- if (gfc_next_char () == '.')
+ if (gfc_next_ascii_char () == '.')
{
/* Matched ".gt.". */
*result = INTRINSIC_GT_OS;
break;
case 'l':
- ch = gfc_next_char ();
+ ch = gfc_next_ascii_char ();
if (ch == 'e')
{
- if (gfc_next_char () == '.')
+ if (gfc_next_ascii_char () == '.')
{
/* Matched ".le.". */
*result = INTRINSIC_LE_OS;
}
else if (ch == 't')
{
- if (gfc_next_char () == '.')
+ if (gfc_next_ascii_char () == '.')
{
/* Matched ".lt.". */
*result = INTRINSIC_LT_OS;
break;
case 'n':
- ch = gfc_next_char ();
+ ch = gfc_next_ascii_char ();
if (ch == 'e')
{
- ch = gfc_next_char ();
+ ch = gfc_next_ascii_char ();
if (ch == '.')
{
/* Matched ".ne.". */
}
else if (ch == 'q')
{
- if (gfc_next_char () == 'v'
- && gfc_next_char () == '.')
+ if (gfc_next_ascii_char () == 'v'
+ && gfc_next_ascii_char () == '.')
{
/* Matched ".neqv.". */
*result = INTRINSIC_NEQV;
}
else if (ch == 'o')
{
- if (gfc_next_char () == 't'
- && gfc_next_char () == '.')
+ if (gfc_next_ascii_char () == 't'
+ && gfc_next_ascii_char () == '.')
{
/* Matched ".not.". */
*result = INTRINSIC_NOT;
break;
case 'o':
- if (gfc_next_char () == 'r'
- && gfc_next_char () == '.')
+ if (gfc_next_ascii_char () == 'r'
+ && gfc_next_ascii_char () == '.')
{
/* Matched ".or.". */
*result = INTRINSIC_OR;
where = gfc_current_locus;
gfc_gobble_whitespace ();
- if (gfc_next_char () == c)
+ if (gfc_next_ascii_char () == c)
return MATCH_YES;
gfc_current_locus = where;
}
default:
- if (c == gfc_next_char ())
+ if (c == gfc_next_ascii_char ())
goto loop;
break;
}
match ("return", gfc_match_return, ST_RETURN)
match ("rewind", gfc_match_rewind, ST_REWIND)
match ("stop", gfc_match_stop, ST_STOP)
+ match ("wait", gfc_match_wait, ST_WAIT)
match ("where", match_simple_where, ST_WHERE)
match ("write", gfc_match_write, ST_WRITE)
if (gfc_match_char (',') != MATCH_YES && gfc_match ("% ") != MATCH_YES)
return MATCH_NO;
+ /* Check for balanced parens. */
+
+ if (gfc_match_parens () == MATCH_ERROR)
+ return MATCH_ERROR;
+
/* See if we have a DO WHILE. */
if (gfc_match (" while ( %e )%t", &iter.end) == MATCH_YES)
{
gfc_expr *e;
match m;
gfc_compile_state s;
- int c;
e = NULL;
if (gfc_match_eos () == MATCH_YES)
RETURN keyword:
return+1
return(1) */
- c = gfc_peek_char ();
+ char c = gfc_peek_ascii_char ();
if (ISALPHA (c) || ISDIGIT (c))
return MATCH_NO;
}
gfc_gobble_whitespace ();
if (gfc_match_eos () == MATCH_YES)
goto done;
- if (gfc_peek_char () == '/')
+ if (gfc_peek_ascii_char () == '/')
break;
if (gfc_match_char (',') != MATCH_YES)
goto syntax;
gfc_gobble_whitespace ();
- if (gfc_peek_char () == '/')
+ if (gfc_peek_ascii_char () == '/')
break;
}
}
OSDN Git Service
