diff options
Diffstat (limited to 'gcc/fortran/match.c')
| -rw-r--r-- | gcc/fortran/match.c | 165 |
1 files changed, 97 insertions, 68 deletions
diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c index 8512d03..8c83615 100644 --- a/gcc/fortran/match.c +++ b/gcc/fortran/match.c @@ -111,8 +111,8 @@ match 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; @@ -126,7 +126,7 @@ gfc_match_parens (void) break; if (quote == ' ' && ((c == '\'') || (c == '"'))) { - quote = (char) c; + quote = c; instring = 1; continue; } @@ -170,42 +170,66 @@ gfc_match_parens (void) 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; @@ -223,14 +247,14 @@ match 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; @@ -251,7 +275,8 @@ match gfc_match_eos (void) { locus old_loc; - int flag, c; + int flag; + char c; flag = 0; @@ -260,13 +285,13 @@ gfc_match_eos (void) 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'); @@ -302,8 +327,9 @@ gfc_match_small_literal_int (int *value, int *cnt) old_loc = gfc_current_locus; + *value = -1; gfc_gobble_whitespace (); - c = gfc_next_char (); + c = gfc_next_ascii_char (); if (cnt) *cnt = 0; @@ -319,7 +345,7 @@ gfc_match_small_literal_int (int *value, int *cnt) for (;;) { old_loc = gfc_current_locus; - c = gfc_next_char (); + c = gfc_next_ascii_char (); if (!ISDIGIT (c)) break; @@ -488,12 +514,13 @@ match 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 != '(') @@ -515,13 +542,14 @@ gfc_match_name (char *buffer) } 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; } @@ -551,7 +579,7 @@ gfc_match_name_C (char *buffer) { locus old_loc; int i = 0; - int c; + gfc_char_t c; old_loc = gfc_current_locus; gfc_gobble_whitespace (); @@ -579,7 +607,9 @@ gfc_match_name_C (char *buffer) /* 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. @@ -606,7 +636,7 @@ gfc_match_name_C (char *buffer) 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"); @@ -679,10 +709,10 @@ match 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 '+': @@ -696,7 +726,7 @@ gfc_match_intrinsic_op (gfc_intrinsic_op *result) return MATCH_YES; case '=': - if (gfc_next_char () == '=') + if (gfc_next_ascii_char () == '=') { /* Matched "==". */ *result = INTRINSIC_EQ; @@ -705,10 +735,10 @@ gfc_match_intrinsic_op (gfc_intrinsic_op *result) 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; } @@ -717,10 +747,10 @@ gfc_match_intrinsic_op (gfc_intrinsic_op *result) 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; } @@ -729,10 +759,10 @@ gfc_match_intrinsic_op (gfc_intrinsic_op *result) 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; } @@ -741,18 +771,18 @@ gfc_match_intrinsic_op (gfc_intrinsic_op *result) 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; } @@ -761,13 +791,13 @@ gfc_match_intrinsic_op (gfc_intrinsic_op *result) 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; @@ -776,9 +806,9 @@ gfc_match_intrinsic_op (gfc_intrinsic_op *result) 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.". */ @@ -787,7 +817,7 @@ gfc_match_intrinsic_op (gfc_intrinsic_op *result) } else if (ch == 'v') { - if (gfc_next_char () == '.') + if (gfc_next_ascii_char () == '.') { /* Matched ".eqv.". */ *result = INTRINSIC_EQV; @@ -798,10 +828,10 @@ gfc_match_intrinsic_op (gfc_intrinsic_op *result) 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; @@ -810,7 +840,7 @@ gfc_match_intrinsic_op (gfc_intrinsic_op *result) } else if (ch == 't') { - if (gfc_next_char () == '.') + if (gfc_next_ascii_char () == '.') { /* Matched ".gt.". */ *result = INTRINSIC_GT_OS; @@ -820,10 +850,10 @@ gfc_match_intrinsic_op (gfc_intrinsic_op *result) 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; @@ -832,7 +862,7 @@ gfc_match_intrinsic_op (gfc_intrinsic_op *result) } else if (ch == 't') { - if (gfc_next_char () == '.') + if (gfc_next_ascii_char () == '.') { /* Matched ".lt.". */ *result = INTRINSIC_LT_OS; @@ -842,10 +872,10 @@ gfc_match_intrinsic_op (gfc_intrinsic_op *result) 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.". */ @@ -854,8 +884,8 @@ gfc_match_intrinsic_op (gfc_intrinsic_op *result) } 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; @@ -865,8 +895,8 @@ gfc_match_intrinsic_op (gfc_intrinsic_op *result) } 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; @@ -876,8 +906,8 @@ gfc_match_intrinsic_op (gfc_intrinsic_op *result) 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; @@ -1007,7 +1037,7 @@ gfc_match_char (char c) 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; @@ -1157,7 +1187,7 @@ loop: } default: - if (c == gfc_next_char ()) + if (c == gfc_next_ascii_char ()) goto loop; break; } @@ -2414,7 +2444,6 @@ gfc_match_return (void) gfc_expr *e; match m; gfc_compile_state s; - int c; e = NULL; if (gfc_match_eos () == MATCH_YES) @@ -2433,7 +2462,7 @@ gfc_match_return (void) RETURN keyword: return+1 return(1) */ - c = gfc_peek_char (); + char c = gfc_peek_ascii_char (); if (ISALPHA (c) || ISDIGIT (c)) return MATCH_NO; } @@ -2868,12 +2897,12 @@ gfc_match_common (void) 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; } } |