diff options
author | Tobias Schlüter <tobi@gcc.gnu.org> | 2004-06-29 23:22:18 +0200 |
---|---|---|
committer | Tobias Schlüter <tobi@gcc.gnu.org> | 2004-06-29 23:22:18 +0200 |
commit | 439251f70ba52a1b5ebb078ccd87d9e996e2328a (patch) | |
tree | 9f9208e2e36459be4ab63eec75b266de54c37221 /gcc/fortran/decl.c | |
parent | fbc9b4531337a13e969472e6a53187b36b73c4aa (diff) | |
download | gcc-439251f70ba52a1b5ebb078ccd87d9e996e2328a.zip gcc-439251f70ba52a1b5ebb078ccd87d9e996e2328a.tar.gz gcc-439251f70ba52a1b5ebb078ccd87d9e996e2328a.tar.bz2 |
Revert previous accidental commit.
From-SVN: r83875
Diffstat (limited to 'gcc/fortran/decl.c')
-rw-r--r-- | gcc/fortran/decl.c | 223 |
1 files changed, 8 insertions, 215 deletions
diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c index e4cbe15..fab762f 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 (<len>) (<range>) */ - m = match_char_spec (&ts); - } - - if (m == MATCH_YES) - { - /* Looks like we have the <TYPE> (<RANGE>). */ - gfc_gobble_whitespace (); - c = gfc_next_char (); - if ((c == '\n') || (c == ',')) - continue; - - gfc_current_locus = cur_loc; - } - - /* Last chance -- check <TYPE> (<KIND>) (<RANGE>). */ - 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) { |