From: Tobias Schlüter Date: Tue, 29 Jun 2004 21:22:18 +0000 (+0200) Subject: Revert previous accidental commit. X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=439251f70ba52a1b5ebb078ccd87d9e996e2328a;p=gcc.git Revert previous accidental commit. From-SVN: r83875 --- diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c index e4cbe15a42b..fab762fc63e 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 implicit_flag is nonzero, then we don't check for the optional - kind specification. Not doing so is needed for matching an IMPLICIT + If kind_flag is nonzero, then we check for the optional kind + specification. Not doing so is needed for matching an IMPLICIT statement correctly. */ -static match -match_type_spec (gfc_typespec * ts, int implicit_flag) +match +gfc_match_type_spec (gfc_typespec * ts, int kind_flag) { char name[GFC_MAX_SYMBOL_LEN + 1]; gfc_symbol *sym; @@ -898,10 +898,7 @@ match_type_spec (gfc_typespec * ts, int implicit_flag) if (gfc_match (" character") == MATCH_YES) { ts->type = BT_CHARACTER; - if (implicit_flag == 0) - return match_char_spec (ts); - else - return MATCH_YES; + return match_char_spec (ts); } if (gfc_match (" real") == MATCH_YES) @@ -963,7 +960,7 @@ match_type_spec (gfc_typespec * ts, int implicit_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 (implicit_flag == 1) + if (kind_flag == 0) return MATCH_YES; if (gfc_current_form == FORM_FREE) @@ -985,210 +982,6 @@ 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 @@ -1449,7 +1242,7 @@ gfc_match_data_decl (void) gfc_symbol *sym; match m; - m = match_type_spec (¤t_ts, 0); + m = gfc_match_type_spec (¤t_ts, 1); if (m != MATCH_YES) return m; @@ -1539,7 +1332,7 @@ match_prefix (gfc_typespec * ts) loop: if (!seen_type && ts != NULL - && match_type_spec (ts, 0) == MATCH_YES + && gfc_match_type_spec (ts, 1) == MATCH_YES && gfc_match_space () == MATCH_YES) { diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c index 9bc1f4fbe63..d605361ec03 100644 --- a/gcc/fortran/match.c +++ b/gcc/fortran/match.c @@ -2048,6 +2048,204 @@ cleanup: } +/* 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 = gfc_match_type_spec (&ts, 0); + 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) + { + /* 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; +} + + /* Given a name, return a pointer to the common head structure, creating it if it does not exist. TODO: Add to global symbol tree. */ diff --git a/gcc/fortran/match.h b/gcc/fortran/match.h index 4b8f87232ec..85729ec0ae8 100644 --- a/gcc/fortran/match.h +++ b/gcc/fortran/match.h @@ -75,6 +75,8 @@ match gfc_match_deallocate (void); match gfc_match_return (void); match gfc_match_call (void); match gfc_match_common (void); +match gfc_match_implicit_none (void); +match gfc_match_implicit (void); match gfc_match_block_data (void); match gfc_match_namelist (void); match gfc_match_module (void); @@ -96,6 +98,7 @@ gfc_common_head *gfc_get_common (char *); match gfc_match_null (gfc_expr **); match gfc_match_kind_spec (gfc_typespec *); match gfc_match_old_kind_spec (gfc_typespec *); +match gfc_match_type_spec (gfc_typespec *, int); match gfc_match_end (gfc_statement *); match gfc_match_data_decl (void); @@ -105,9 +108,6 @@ match gfc_match_entry (void); match gfc_match_subroutine (void); match gfc_match_derived_decl (void); -match gfc_match_implicit_none (void); -match gfc_match_implicit (void); - /* Matchers for attribute declarations */ match gfc_match_allocatable (void); match gfc_match_dimension (void);