From: Tobias Schlüter Date: Wed, 30 Jun 2004 12:48:51 +0000 (+0200) Subject: re PR fortran/16161 ([gfortran] IMPLICIT CHARACTER not implemented) X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=e5ddaa24beae8ae06e2a8e962131a1bc55f7146e;p=gcc.git 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 --- diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 4c56afb9982..8e65b697e04 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,23 @@ +2004-06-30 Tobias Schlueter + + 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. + 2004-06-29 Tobias Schlueter * decl.c, interface.c, symbol.c, trans-common.c: Add 2004 to diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c index cc65d071df1..5c5b7281115 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) { diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c index d605361ec03..9bc1f4fbe63 100644 --- a/gcc/fortran/match.c +++ b/gcc/fortran/match.c @@ -2048,204 +2048,6 @@ 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 85729ec0ae8..4b8f87232ec 100644 --- a/gcc/fortran/match.h +++ b/gcc/fortran/match.h @@ -75,8 +75,6 @@ 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); @@ -98,7 +96,6 @@ 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); @@ -108,6 +105,9 @@ 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); diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index d9572251abf..e043aaac3d6 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,4 +1,10 @@ - 2004-06-30 David Billinghurst (David.Billinghurst@riotinto.com) +2004-06-30 Tobias Schlueter + + PR fortran/16161 + * gfortran.fortran-torture/compile/implicit.f90: Add test + for implicit character. + +2004-06-30 David Billinghurst (David.Billinghurst@riotinto.com) PR fortran/16289 * gfortran.fortran-torture/execute/intrinsic_nearest.f90 diff --git a/gcc/testsuite/gfortran.fortran-torture/compile/implicit.f90 b/gcc/testsuite/gfortran.fortran-torture/compile/implicit.f90 index 296821e8983..8a6c4f56d16 100644 --- a/gcc/testsuite/gfortran.fortran-torture/compile/implicit.f90 +++ b/gcc/testsuite/gfortran.fortran-torture/compile/implicit.f90 @@ -6,3 +6,8 @@ d = 1.0e2 y = d z = a end +! test prompted by PR 16161 +! we used to match "character (c)" wrongly in the below, confusing the parser +subroutine b +implicit character (c) +end