From e5ddaa24beae8ae06e2a8e962131a1bc55f7146e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Tobias=20Schl=C3=BCter?= Date: Wed, 30 Jun 2004 14:48:51 +0200 Subject: re PR fortran/16161 ([gfortran] IMPLICIT CHARACTER not implemented) fortran/ PR fortran/16161 * decl.c (gfc_match_type_spec): Rename second argument to 'implicit_flag', reverse meaning. Don't match_char_spec if 'implicit_flag' is set. Rename to ... (match_type_spec): ... this. (gfc_match_implicit_none, match_implicit_range): Move here from match.c. (gfc_match_implicit): Move here from match.c, try to match_char_len if match_implicit_range doesn't succeed for CHARACTER implicits. Call renamed fucntion match_type_spec. (gfc_match_data_decl, match_prefix): Call renamed function match_type_spec. * match.c (gfc_match_implicit_none, match_implicit_range, gfc_match_implicit): Move to decl.c. * match.h (gfc_match_implicit_none, gfc_match_implicit): Move protoypes to section 'decl.c'. (gfc_match_type_spec): Remove prototype. testsuite/ PR fortran/16161 * gfortran.fortran-torture/compile/implicit.f90: Add test for implicit character. From-SVN: r83907 --- gcc/fortran/decl.c | 223 +++++++++++++++++++++++++++++++++++++++++++++++++++-- 1 file changed, 215 insertions(+), 8 deletions(-) (limited to 'gcc/fortran/decl.c') diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c index cc65d07..5c5b728 100644 --- a/gcc/fortran/decl.c +++ b/gcc/fortran/decl.c @@ -874,12 +874,12 @@ done: to the matched specification. This is necessary for FUNCTION and IMPLICIT statements. - If kind_flag is nonzero, then we check for the optional kind - specification. Not doing so is needed for matching an IMPLICIT + If implicit_flag is nonzero, then we don't check for the optional + kind specification. Not doing so is needed for matching an IMPLICIT statement correctly. */ -match -gfc_match_type_spec (gfc_typespec * ts, int kind_flag) +static match +match_type_spec (gfc_typespec * ts, int implicit_flag) { char name[GFC_MAX_SYMBOL_LEN + 1]; gfc_symbol *sym; @@ -898,7 +898,10 @@ gfc_match_type_spec (gfc_typespec * ts, int kind_flag) if (gfc_match (" character") == MATCH_YES) { ts->type = BT_CHARACTER; - return match_char_spec (ts); + if (implicit_flag == 0) + return match_char_spec (ts); + else + return MATCH_YES; } if (gfc_match (" real") == MATCH_YES) @@ -960,7 +963,7 @@ gfc_match_type_spec (gfc_typespec * ts, int kind_flag) get_kind: /* For all types except double, derived and character, look for an optional kind specifier. MATCH_NO is actually OK at this point. */ - if (kind_flag == 0) + if (implicit_flag == 1) return MATCH_YES; if (gfc_current_form == FORM_FREE) @@ -982,6 +985,210 @@ get_kind: } +/* Match an IMPLICIT NONE statement. Actually, this statement is + already matched in parse.c, or we would not end up here in the + first place. So the only thing we need to check, is if there is + trailing garbage. If not, the match is successful. */ + +match +gfc_match_implicit_none (void) +{ + + return (gfc_match_eos () == MATCH_YES) ? MATCH_YES : MATCH_NO; +} + + +/* Match the letter range(s) of an IMPLICIT statement. */ + +static match +match_implicit_range (gfc_typespec * ts) +{ + int c, c1, c2, inner; + locus cur_loc; + + cur_loc = gfc_current_locus; + + gfc_gobble_whitespace (); + c = gfc_next_char (); + if (c != '(') + { + gfc_error ("Missing character range in IMPLICIT at %C"); + goto bad; + } + + inner = 1; + while (inner) + { + gfc_gobble_whitespace (); + c1 = gfc_next_char (); + if (!ISALPHA (c1)) + goto bad; + + gfc_gobble_whitespace (); + c = gfc_next_char (); + + switch (c) + { + case ')': + inner = 0; /* Fall through */ + + case ',': + c2 = c1; + break; + + case '-': + gfc_gobble_whitespace (); + c2 = gfc_next_char (); + if (!ISALPHA (c2)) + goto bad; + + gfc_gobble_whitespace (); + c = gfc_next_char (); + + if ((c != ',') && (c != ')')) + goto bad; + if (c == ')') + inner = 0; + + break; + + default: + goto bad; + } + + if (c1 > c2) + { + gfc_error ("Letters must be in alphabetic order in " + "IMPLICIT statement at %C"); + goto bad; + } + + /* See if we can add the newly matched range to the pending + implicits from this IMPLICIT statement. We do not check for + conflicts with whatever earlier IMPLICIT statements may have + set. This is done when we've successfully finished matching + the current one. */ + if (gfc_add_new_implicit_range (c1, c2, ts) != SUCCESS) + goto bad; + } + + return MATCH_YES; + +bad: + gfc_syntax_error (ST_IMPLICIT); + + gfc_current_locus = cur_loc; + return MATCH_ERROR; +} + + +/* Match an IMPLICIT statement, storing the types for + gfc_set_implicit() if the statement is accepted by the parser. + There is a strange looking, but legal syntactic construction + possible. It looks like: + + IMPLICIT INTEGER (a-b) (c-d) + + This is legal if "a-b" is a constant expression that happens to + equal one of the legal kinds for integers. The real problem + happens with an implicit specification that looks like: + + IMPLICIT INTEGER (a-b) + + In this case, a typespec matcher that is "greedy" (as most of the + matchers are) gobbles the character range as a kindspec, leaving + nothing left. We therefore have to go a bit more slowly in the + matching process by inhibiting the kindspec checking during + typespec matching and checking for a kind later. */ + +match +gfc_match_implicit (void) +{ + gfc_typespec ts; + locus cur_loc; + int c; + match m; + + /* We don't allow empty implicit statements. */ + if (gfc_match_eos () == MATCH_YES) + { + gfc_error ("Empty IMPLICIT statement at %C"); + return MATCH_ERROR; + } + + /* First cleanup. */ + gfc_clear_new_implicit (); + + do + { + /* A basic type is mandatory here. */ + m = match_type_spec (&ts, 1); + if (m == MATCH_ERROR) + goto error; + if (m == MATCH_NO) + goto syntax; + + cur_loc = gfc_current_locus; + m = match_implicit_range (&ts); + + if (m != MATCH_YES && ts.type == BT_CHARACTER) + { + /* looks like we are matching CHARACTER () () */ + m = match_char_spec (&ts); + } + + if (m == MATCH_YES) + { + /* Looks like we have the (). */ + gfc_gobble_whitespace (); + c = gfc_next_char (); + if ((c == '\n') || (c == ',')) + continue; + + gfc_current_locus = cur_loc; + } + + /* Last chance -- check () (). */ + m = gfc_match_kind_spec (&ts); + if (m == MATCH_ERROR) + goto error; + if (m == MATCH_NO) + { + m = gfc_match_old_kind_spec (&ts); + if (m == MATCH_ERROR) + goto error; + if (m == MATCH_NO) + goto syntax; + } + + m = match_implicit_range (&ts); + if (m == MATCH_ERROR) + goto error; + if (m == MATCH_NO) + goto syntax; + + gfc_gobble_whitespace (); + c = gfc_next_char (); + if ((c != '\n') && (c != ',')) + goto syntax; + + } + while (c == ','); + + /* All we need to now is try to merge the new implicit types back + into the existing types. This will fail if another implicit + type is already defined for a letter. */ + return (gfc_merge_new_implicit () == SUCCESS) ? + MATCH_YES : MATCH_ERROR; + +syntax: + gfc_syntax_error (ST_IMPLICIT); + +error: + return MATCH_ERROR; +} + + /* Matches an attribute specification including array specs. If successful, leaves the variables current_attr and current_as holding the specification. Also sets the colon_seen variable for @@ -1242,7 +1449,7 @@ gfc_match_data_decl (void) gfc_symbol *sym; match m; - m = gfc_match_type_spec (¤t_ts, 1); + m = match_type_spec (¤t_ts, 0); if (m != MATCH_YES) return m; @@ -1332,7 +1539,7 @@ match_prefix (gfc_typespec * ts) loop: if (!seen_type && ts != NULL - && gfc_match_type_spec (ts, 1) == MATCH_YES + && match_type_spec (ts, 0) == MATCH_YES && gfc_match_space () == MATCH_YES) { -- cgit v1.1