diff options
Diffstat (limited to 'gcc/fortran/parse.c')
-rw-r--r-- | gcc/fortran/parse.c | 37 |
1 files changed, 18 insertions, 19 deletions
diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c index 9ec376a..c5493df 100644 --- a/gcc/fortran/parse.c +++ b/gcc/fortran/parse.c @@ -372,6 +372,7 @@ decode_statement (void) break; case 'g': + match ("generic", gfc_match_generic, ST_GENERIC); match ("go to", gfc_match_goto, ST_GOTO); break; @@ -1195,6 +1196,9 @@ gfc_ascii_statement (gfc_statement st) case ST_FUNCTION: p = "FUNCTION"; break; + case ST_GENERIC: + p = "GENERIC"; + break; case ST_GOTO: p = "GOTO"; break; @@ -1691,21 +1695,10 @@ unexpected_eof (void) } -/* Set the default access attribute for a typebound procedure; this is used - as callback for gfc_traverse_symtree. */ - -static gfc_access typebound_default_access; - -static void -set_typebound_default_access (gfc_symtree* stree) -{ - if (stree->typebound && stree->typebound->access == ACCESS_UNKNOWN) - stree->typebound->access = typebound_default_access; -} - - /* Parse the CONTAINS section of a derived type definition. */ +gfc_access gfc_typebound_default_access; + static bool parse_derived_contains (void) { @@ -1730,6 +1723,8 @@ parse_derived_contains (void) accept_statement (ST_CONTAINS); push_state (&s, COMP_DERIVED_CONTAINS, NULL); + gfc_typebound_default_access = ACCESS_PUBLIC; + to_finish = false; while (!to_finish) { @@ -1755,6 +1750,15 @@ parse_derived_contains (void) seen_comps = true; break; + case ST_GENERIC: + if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: GENERIC binding" + " at %C") == FAILURE) + error_flag = true; + + accept_statement (ST_GENERIC); + seen_comps = true; + break; + case ST_FINAL: if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: FINAL procedure declaration" @@ -1801,6 +1805,7 @@ parse_derived_contains (void) } accept_statement (ST_PRIVATE); + gfc_typebound_default_access = ACCESS_PRIVATE; seen_private = true; break; @@ -1823,12 +1828,6 @@ parse_derived_contains (void) pop_state (); gcc_assert (gfc_current_state () == COMP_DERIVED); - /* Walk the parsed type-bound procedures and set ACCESS_UNKNOWN attributes - to PUBLIC or PRIVATE depending on seen_private. */ - typebound_default_access = (seen_private ? ACCESS_PRIVATE : ACCESS_PUBLIC); - gfc_traverse_symtree (gfc_current_block ()->f2k_derived->sym_root, - &set_typebound_default_access); - return error_flag; } |