aboutsummaryrefslogtreecommitdiff
path: root/gcc/fortran/decl.c
diff options
context:
space:
mode:
Diffstat (limited to 'gcc/fortran/decl.c')
-rw-r--r--gcc/fortran/decl.c95
1 files changed, 93 insertions, 2 deletions
diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c
index 6c5cfcc..ae4271c 100644
--- a/gcc/fortran/decl.c
+++ b/gcc/fortran/decl.c
@@ -1220,7 +1220,8 @@ variable_decl (int elem)
if (current_ts.type == BT_DERIVED
&& gfc_current_ns->proc_name
&& gfc_current_ns->proc_name->attr.if_source == IFSRC_IFBODY
- && current_ts.derived->ns != gfc_current_ns)
+ && current_ts.derived->ns != gfc_current_ns
+ && !gfc_current_ns->has_import_set)
{
gfc_error ("the type of '%s' at %C has not been declared within the "
"interface", name);
@@ -1483,7 +1484,7 @@ gfc_match_kind_spec (gfc_typespec * ts)
if (gfc_match_char (')') != MATCH_YES)
{
- gfc_error ("Missing right paren at %C");
+ gfc_error ("Missing right parenthesis at %C");
goto no_match;
}
@@ -2005,6 +2006,96 @@ error:
return MATCH_ERROR;
}
+match
+gfc_match_import (void)
+{
+ char name[GFC_MAX_SYMBOL_LEN + 1];
+ match m;
+ gfc_symbol *sym;
+ gfc_symtree *st;
+
+ if (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;
+ }
+
+ if (gfc_notify_std (GFC_STD_F2003,
+ "Fortran 2003: IMPORT statement at %C")
+ == FAILURE)
+ return MATCH_ERROR;
+
+ if (gfc_match_eos () == MATCH_YES)
+ {
+ /* All host variables should be imported. */
+ gfc_current_ns->has_import_set = 1;
+ return MATCH_YES;
+ }
+
+ if (gfc_match (" ::") == MATCH_YES)
+ {
+ if (gfc_match_eos () == MATCH_YES)
+ {
+ gfc_error ("Expecting list of named entities at %C");
+ return MATCH_ERROR;
+ }
+ }
+
+ for(;;)
+ {
+ m = gfc_match (" %n", name);
+ switch (m)
+ {
+ case MATCH_YES:
+ if (gfc_find_symbol (name, gfc_current_ns->parent, 1, &sym))
+ {
+ gfc_error ("Type name '%s' at %C is ambiguous", name);
+ return MATCH_ERROR;
+ }
+
+ if (sym == NULL)
+ {
+ gfc_error ("Cannot IMPORT '%s' from host scoping unit "
+ "at %C - does not exist.", name);
+ return MATCH_ERROR;
+ }
+
+ if (gfc_find_symtree (gfc_current_ns->sym_root,name))
+ {
+ gfc_warning ("'%s' is already IMPORTed from host scoping unit "
+ "at %C.", name);
+ goto next_item;
+ }
+
+ st = gfc_new_symtree (&gfc_current_ns->sym_root, name);
+ st->n.sym = sym;
+ sym->refs++;
+ sym->ns = gfc_current_ns;
+
+ goto next_item;
+
+ case MATCH_NO:
+ break;
+
+ case MATCH_ERROR:
+ return MATCH_ERROR;
+ }
+
+ next_item:
+ if (gfc_match_eos () == MATCH_YES)
+ break;
+ if (gfc_match_char (',') != MATCH_YES)
+ goto syntax;
+ }
+
+ return MATCH_YES;
+
+syntax:
+ gfc_error ("Syntax error in IMPORT statement at %C");
+ return MATCH_ERROR;
+}
/* Matches an attribute specification including array specs. If
successful, leaves the variables current_attr and current_as