diff options
Diffstat (limited to 'gcc/fortran/parse.c')
| -rw-r--r-- | gcc/fortran/parse.c | 192 |
1 files changed, 143 insertions, 49 deletions
diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c index f9c3705..4bf1b81 100644 --- a/gcc/fortran/parse.c +++ b/gcc/fortran/parse.c @@ -1691,13 +1691,143 @@ 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. */ + +static bool +parse_derived_contains (void) +{ + gfc_state_data s; + bool seen_private = false; + bool seen_comps = false; + bool error_flag = false; + bool to_finish; + + accept_statement (ST_CONTAINS); + gcc_assert (gfc_current_state () == COMP_DERIVED); + push_state (&s, COMP_DERIVED_CONTAINS, NULL); + + to_finish = false; + while (!to_finish) + { + gfc_statement st; + st = next_statement (); + switch (st) + { + case ST_NONE: + unexpected_eof (); + break; + + case ST_DATA_DECL: + gfc_error ("Components in TYPE at %C must precede CONTAINS"); + error_flag = true; + break; + + case ST_PROCEDURE: + if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: Type-bound" + " procedure at %C") == FAILURE) + error_flag = true; + + accept_statement (ST_PROCEDURE); + seen_comps = true; + break; + + case ST_FINAL: + if (gfc_notify_std (GFC_STD_F2003, + "Fortran 2003: FINAL procedure declaration" + " at %C") == FAILURE) + error_flag = true; + + accept_statement (ST_FINAL); + seen_comps = true; + break; + + case ST_END_TYPE: + to_finish = true; + + if (!seen_comps + && (gfc_notify_std (GFC_STD_F2008, "Fortran 2008: Derived type " + "definition at %C with empty CONTAINS " + "section") == FAILURE)) + error_flag = true; + + /* ST_END_TYPE is accepted by parse_derived after return. */ + break; + + case ST_PRIVATE: + if (gfc_find_state (COMP_MODULE) == FAILURE) + { + gfc_error ("PRIVATE statement in TYPE at %C must be inside " + "a MODULE"); + error_flag = true; + break; + } + + if (seen_comps) + { + gfc_error ("PRIVATE statement at %C must precede procedure" + " bindings"); + error_flag = true; + break; + } + + if (seen_private) + { + gfc_error ("Duplicate PRIVATE statement at %C"); + error_flag = true; + } + + accept_statement (ST_PRIVATE); + seen_private = true; + break; + + case ST_SEQUENCE: + gfc_error ("SEQUENCE statement at %C must precede CONTAINS"); + error_flag = true; + break; + + case ST_CONTAINS: + gfc_error ("Already inside a CONTAINS block at %C"); + error_flag = true; + break; + + default: + unexpected_statement (st); + break; + } + } + + 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; +} + + /* Parse a derived type. */ static void parse_derived (void) { int compiling_type, seen_private, seen_sequence, seen_component, error_flag; - int seen_contains, seen_contains_comp; gfc_statement st; gfc_state_data s; gfc_symbol *derived_sym = NULL; @@ -1713,8 +1843,6 @@ parse_derived (void) seen_private = 0; seen_sequence = 0; seen_component = 0; - seen_contains = 0; - seen_contains_comp = 0; compiling_type = 1; @@ -1727,34 +1855,22 @@ parse_derived (void) unexpected_eof (); case ST_DATA_DECL: - case ST_PROCEDURE: - if (seen_contains) - { - gfc_error ("Components in TYPE at %C must precede CONTAINS"); - error_flag = 1; - } - accept_statement (st); seen_component = 1; break; - case ST_FINAL: - if (!seen_contains) - { - gfc_error ("FINAL declaration at %C must be inside CONTAINS"); - error_flag = 1; - } - - if (gfc_notify_std (GFC_STD_F2003, - "Fortran 2003: FINAL procedure declaration" - " at %C") == FAILURE) - error_flag = 1; + case ST_PROCEDURE: + gfc_error ("PROCEDURE binding at %C must be inside CONTAINS"); + error_flag = 1; + break; - accept_statement (ST_FINAL); - seen_contains_comp = 1; + case ST_FINAL: + gfc_error ("FINAL declaration at %C must be inside CONTAINS"); + error_flag = 1; break; case ST_END_TYPE: +endType: compiling_type = 0; if (!seen_component @@ -1763,22 +1879,10 @@ parse_derived (void) == FAILURE)) error_flag = 1; - if (seen_contains && !seen_contains_comp - && (gfc_notify_std (GFC_STD_F2008, "Fortran 2008: Derived type " - "definition at %C with empty CONTAINS " - "section") == FAILURE)) - error_flag = 1; - accept_statement (ST_END_TYPE); break; case ST_PRIVATE: - if (seen_contains) - { - gfc_error ("PRIVATE statement at %C must precede CONTAINS"); - error_flag = 1; - } - if (gfc_find_state (COMP_MODULE) == FAILURE) { gfc_error ("PRIVATE statement in TYPE at %C must be inside " @@ -1802,17 +1906,12 @@ parse_derived (void) } s.sym->component_access = ACCESS_PRIVATE; + accept_statement (ST_PRIVATE); seen_private = 1; break; case ST_SEQUENCE: - if (seen_contains) - { - gfc_error ("SEQUENCE statement at %C must precede CONTAINS"); - error_flag = 1; - } - if (seen_component) { gfc_error ("SEQUENCE statement at %C must precede " @@ -1842,15 +1941,10 @@ parse_derived (void) " definition at %C") == FAILURE) error_flag = 1; - if (seen_contains) - { - gfc_error ("Already inside a CONTAINS block at %C"); - error_flag = 1; - } - - seen_contains = 1; accept_statement (ST_CONTAINS); - break; + if (parse_derived_contains ()) + error_flag = 1; + goto endType; default: unexpected_statement (st); |