diff options
Diffstat (limited to 'gcc/fortran/decl.cc')
| -rw-r--r-- | gcc/fortran/decl.cc | 199 |
1 files changed, 184 insertions, 15 deletions
diff --git a/gcc/fortran/decl.cc b/gcc/fortran/decl.cc index 69acd2d..111ebc5 100644 --- a/gcc/fortran/decl.cc +++ b/gcc/fortran/decl.cc @@ -1723,13 +1723,17 @@ build_sym (const char *name, int elem, gfc_charlen *cl, bool cl_deferred, symbol_attribute attr; gfc_symbol *sym; int upper; - gfc_symtree *st; + gfc_symtree *st, *host_st = NULL; /* Symbols in a submodule are host associated from the parent module or submodules. Therefore, they can be overridden by declarations in the submodule scope. Deal with this by attaching the existing symbol to a new symtree and recycling the old symtree with a new symbol... */ st = gfc_find_symtree (gfc_current_ns->sym_root, name); + if (((st && st->import_only) || (gfc_current_ns->import_state == IMPORT_ALL)) + && gfc_current_ns->parent) + host_st = gfc_find_symtree (gfc_current_ns->parent->sym_root, name); + if (st != NULL && gfc_state_stack->state == COMP_SUBMODULE && st->n.sym != NULL && st->n.sym->attr.host_assoc && st->n.sym->attr.used_in_submodule) @@ -1742,6 +1746,20 @@ build_sym (const char *name, int elem, gfc_charlen *cl, bool cl_deferred, sym->refs++; gfc_set_sym_referenced (sym); } + /* ...Check that F2018 IMPORT, ONLY and IMPORT, ALL statements, within the + current scope are not violated by local redeclarations. Note that there is + no need to guard for std >= F2018 because import_only and IMPORT_ALL are + only set for these standards. */ + else if (host_st && host_st->n.sym + && host_st->n.sym != gfc_current_ns->proc_name + && !(st && st->n.sym + && (st->n.sym->attr.dummy || st->n.sym->attr.result))) + { + gfc_error ("F2018: C8102 %s at %L is already imported by an %s " + "statement and must not be re-declared", name, var_locus, + (st && st->import_only) ? "IMPORT, ONLY" : "IMPORT, ALL"); + return false; + } /* ...Otherwise generate a new symtree and new symbol. */ else if (gfc_get_symbol (name, NULL, &sym, var_locus)) return false; @@ -5100,6 +5118,54 @@ error: } +/* Match the IMPORT statement. IMPORT was added to F2003 as + + R1209 import-stmt is IMPORT [[ :: ] import-name-list ] + + C1210 (R1209) The IMPORT statement is allowed only in an interface-body. + + C1211 (R1209) Each import-name shall be the name of an entity in the + host scoping unit. + + under the description of an interface block. Under F2008, IMPORT was + split out of the interface block description to 12.4.3.3 and C1210 + became + + C1210 (R1209) The IMPORT statement is allowed only in an interface-body + that is not a module procedure interface body. + + Finally, F2018, section 8.8, has changed the IMPORT statement to + + R867 import-stmt is IMPORT [[ :: ] import-name-list ] + or IMPORT, ONLY : import-name-list + or IMPORT, NONE + or IMPORT, ALL + + C896 (R867) An IMPORT statement shall not appear in the scoping unit of + a main-program, external-subprogram, module, or block-data. + + C897 (R867) Each import-name shall be the name of an entity in the host + scoping unit. + + C898 If any IMPORT statement in a scoping unit has an ONLY specifier, + all IMPORT statements in that scoping unit shall have an ONLY + specifier. + + C899 IMPORT, NONE shall not appear in the scoping unit of a submodule. + + C8100 If an IMPORT, NONE or IMPORT, ALL statement appears in a scoping + unit, no other IMPORT statement shall appear in that scoping unit. + + C8101 Within an interface body, an entity that is accessed by host + association shall be accessible by host or use association within + the host scoping unit, or explicitly declared prior to the interface + body. + + C8102 An entity whose name appears as an import-name or which is made + accessible by an IMPORT, ALL statement shall not appear in any + context described in 19.5.1.4 that would cause the host entity + of that name to be inaccessible. */ + match gfc_match_import (void) { @@ -5107,16 +5173,28 @@ gfc_match_import (void) match m; gfc_symbol *sym; gfc_symtree *st; + bool f2018_allowed = gfc_option.allow_std & ~GFC_STD_OPT_F08;; + importstate current_import_state = gfc_current_ns->import_state; - if (gfc_current_ns->proc_name == NULL - || gfc_current_ns->proc_name->attr.if_source != IFSRC_IFBODY) + if (!f2018_allowed + && (gfc_current_ns->proc_name == NULL + || gfc_current_ns->proc_name->attr.if_source != IFSRC_IFBODY)) { gfc_error ("IMPORT statement at %C only permitted in " "an INTERFACE body"); return MATCH_ERROR; } + else if (f2018_allowed + && (!gfc_current_ns->parent || gfc_current_ns->is_block_data)) + goto C897; + + if (f2018_allowed + && (current_import_state == IMPORT_ALL + || current_import_state == IMPORT_NONE)) + goto C8100; - if (gfc_current_ns->proc_name->attr.module_procedure) + if (gfc_current_ns->proc_name + && gfc_current_ns->proc_name->attr.module_procedure) { gfc_error ("F2008: C1210 IMPORT statement at %C is not permitted " "in a module procedure interface body"); @@ -5126,20 +5204,65 @@ gfc_match_import (void) if (!gfc_notify_std (GFC_STD_F2003, "IMPORT statement at %C")) return MATCH_ERROR; + gfc_current_ns->import_state = IMPORT_NOT_SET; + if (f2018_allowed) + { + if (gfc_match (" , none") == MATCH_YES) + { + if (current_import_state == IMPORT_ONLY) + goto C898; + if (gfc_current_state () == COMP_SUBMODULE) + goto C899; + gfc_current_ns->import_state = IMPORT_NONE; + } + else if (gfc_match (" , only :") == MATCH_YES) + { + if (current_import_state != IMPORT_NOT_SET + && current_import_state != IMPORT_ONLY) + goto C898; + gfc_current_ns->import_state = IMPORT_ONLY; + } + else if (gfc_match (" , all") == MATCH_YES) + { + if (current_import_state == IMPORT_ONLY) + goto C898; + gfc_current_ns->import_state = IMPORT_ALL; + } + + if (current_import_state != IMPORT_NOT_SET + && (gfc_current_ns->import_state == IMPORT_NONE + || gfc_current_ns->import_state == IMPORT_ALL)) + goto C8100; + } + + /* F2008 IMPORT<eos> is distinct from F2018 IMPORT, ALL. */ if (gfc_match_eos () == MATCH_YES) { - /* All host variables should be imported. */ - gfc_current_ns->has_import_set = 1; + /* This is the F2008 variant. */ + if (gfc_current_ns->import_state == IMPORT_NOT_SET) + { + if (current_import_state == IMPORT_ONLY) + goto C898; + gfc_current_ns->import_state = IMPORT_F2008; + } + + /* Host variables should be imported. */ + if (gfc_current_ns->import_state != IMPORT_NONE) + gfc_current_ns->has_import_set = 1; return MATCH_YES; } - if (gfc_match (" ::") == MATCH_YES) + if (gfc_match (" ::") == MATCH_YES + && gfc_current_ns->import_state != IMPORT_ONLY) { if (gfc_match_eos () == MATCH_YES) - { - gfc_error ("Expecting list of named entities at %C"); - return MATCH_ERROR; - } + goto expecting_list; + gfc_current_ns->import_state = IMPORT_F2008; + } + else if (gfc_current_ns->import_state == IMPORT_ONLY) + { + if (gfc_match_eos () == MATCH_YES) + goto expecting_list; } for(;;) @@ -5166,12 +5289,28 @@ gfc_match_import (void) if (sym == NULL) { - gfc_error ("Cannot IMPORT %qs from host scoping unit " - "at %C - does not exist.", name); - return MATCH_ERROR; + if (gfc_current_ns->proc_name->attr.if_source == IFSRC_IFBODY) + { + gfc_error ("Cannot IMPORT %qs from host scoping unit " + "at %C - does not exist.", name); + return MATCH_ERROR; + } + else + { + /* This might be a procedure that has not yet been parsed. If + so gfc_fixup_sibling_symbols will replace this symbol with + that of the procedure. */ + gfc_get_sym_tree (name, gfc_current_ns, &st, false, + &gfc_current_locus); + st->n.sym->refs++; + st->n.sym->attr.imported = 1; + st->import_only = 1; + goto next_item; + } } - if (gfc_find_symtree (gfc_current_ns->sym_root, name)) + st = gfc_find_symtree (gfc_current_ns->sym_root, name); + if (st && st->n.sym && st->n.sym->attr.imported) { gfc_warning (0, "%qs is already IMPORTed from host scoping unit " "at %C", name); @@ -5182,6 +5321,7 @@ gfc_match_import (void) st->n.sym = sym; sym->refs++; sym->attr.imported = 1; + st->import_only = 1; if (sym->attr.generic && (sym = gfc_find_dt_in_generic (sym))) { @@ -5193,6 +5333,7 @@ gfc_match_import (void) st->n.sym = sym; sym->refs++; sym->attr.imported = 1; + st->import_only = 1; } goto next_item; @@ -5216,6 +5357,34 @@ gfc_match_import (void) syntax: gfc_error ("Syntax error in IMPORT statement at %C"); return MATCH_ERROR; + +C897: + gfc_error ("F2018: C897 IMPORT statement at %C cannot appear in a main " + "program, an external subprogram, a module or block data"); + return MATCH_ERROR; + +C898: + gfc_error ("F2018: C898 IMPORT statement at %C is not permitted because " + "a scoping unit has an ONLY specifier, can only have IMPORT " + "with an ONLY specifier"); + return MATCH_ERROR; + +C899: + gfc_error ("F2018: C899 IMPORT, NONE shall not appear in the scoping unit" + " of a submodule as at %C"); + return MATCH_ERROR; + +C8100: + gfc_error ("F2018: C8100 IMPORT statement at %C is not permitted because " + "%s has already been declared, which must be unique in the " + "scoping unit", + gfc_current_ns->import_state == IMPORT_ALL ? "IMPORT, ALL" : + "IMPORT, NONE"); + return MATCH_ERROR; + +expecting_list: + gfc_error ("Expecting list of named entities at %C"); + return MATCH_ERROR; } |