}
+static void resolve_symbol (gfc_symbol *sym);
+static gfc_try resolve_intrinsic (gfc_symbol *sym, locus *loc);
+
+
+/* Resolve the interface for a PROCEDURE declaration or procedure pointer. */
+
+static gfc_try
+resolve_procedure_interface (gfc_symbol *sym)
+{
+ if (sym->ts.interface == sym)
+ {
+ gfc_error ("PROCEDURE '%s' at %L may not be used as its own interface",
+ sym->name, &sym->declared_at);
+ return FAILURE;
+ }
+ if (sym->ts.interface->attr.procedure)
+ {
+ gfc_error ("Interface '%s', used by procedure '%s' at %L, is declared "
+ "in a later PROCEDURE statement", sym->ts.interface->name,
+ sym->name, &sym->declared_at);
+ return FAILURE;
+ }
+
+ /* Get the attributes from the interface (now resolved). */
+ if (sym->ts.interface->attr.if_source || sym->ts.interface->attr.intrinsic)
+ {
+ gfc_symbol *ifc = sym->ts.interface;
+ resolve_symbol (ifc);
+
+ if (ifc->attr.intrinsic)
+ resolve_intrinsic (ifc, &ifc->declared_at);
+
+ if (ifc->result)
+ sym->ts = ifc->result->ts;
+ else
+ sym->ts = ifc->ts;
+ sym->ts.interface = ifc;
+ sym->attr.function = ifc->attr.function;
+ sym->attr.subroutine = ifc->attr.subroutine;
+ gfc_copy_formal_args (sym, ifc);
+
+ sym->attr.allocatable = ifc->attr.allocatable;
+ sym->attr.pointer = ifc->attr.pointer;
+ sym->attr.pure = ifc->attr.pure;
+ sym->attr.elemental = ifc->attr.elemental;
+ sym->attr.dimension = ifc->attr.dimension;
+ sym->attr.contiguous = ifc->attr.contiguous;
+ sym->attr.recursive = ifc->attr.recursive;
+ sym->attr.always_explicit = ifc->attr.always_explicit;
+ sym->attr.ext_attr |= ifc->attr.ext_attr;
+ /* Copy array spec. */
+ sym->as = gfc_copy_array_spec (ifc->as);
+ if (sym->as)
+ {
+ int i;
+ for (i = 0; i < sym->as->rank; i++)
+ {
+ gfc_expr_replace_symbols (sym->as->lower[i], sym);
+ gfc_expr_replace_symbols (sym->as->upper[i], sym);
+ }
+ }
+ /* Copy char length. */
+ if (ifc->ts.type == BT_CHARACTER && ifc->ts.u.cl)
+ {
+ sym->ts.u.cl = gfc_new_charlen (sym->ns, ifc->ts.u.cl);
+ gfc_expr_replace_symbols (sym->ts.u.cl->length, sym);
+ if (sym->ts.u.cl->length && !sym->ts.u.cl->resolved
+ && gfc_resolve_expr (sym->ts.u.cl->length) == FAILURE)
+ return FAILURE;
+ }
+ }
+ else if (sym->ts.interface->name[0] != '\0')
+ {
+ gfc_error ("Interface '%s' of procedure '%s' at %L must be explicit",
+ sym->ts.interface->name, sym->name, &sym->declared_at);
+ return FAILURE;
+ }
+
+ return SUCCESS;
+}
+
+
/* Resolve types of formal argument lists. These have to be done early so that
the formal argument lists of module procedures can be copied to the
containing module before the individual procedures are resolved
&proc->declared_at);
continue;
}
+ else if (sym->attr.procedure && sym->ts.interface
+ && sym->attr.if_source != IFSRC_DECL)
+ resolve_procedure_interface (sym);
if (sym->attr.if_source != IFSRC_UNKNOWN)
resolve_formal_arglist (sym);
}
-static void resolve_symbol (gfc_symbol *sym);
-
-
/* Resolve the components of a derived type. */
static gfc_try
gfc_component *c;
/* Avoid double resolution of function result symbols. */
- if ((sym->result || sym->attr.result) && (sym->ns != gfc_current_ns))
+ if ((sym->result || sym->attr.result) && !sym->attr.dummy
+ && (sym->ns != gfc_current_ns))
return;
if (sym->attr.flavor == FL_UNKNOWN)
gfc_add_function (&sym->attr, sym->name, &sym->declared_at);
if (sym->attr.procedure && sym->ts.interface
- && sym->attr.if_source != IFSRC_DECL)
- {
- if (sym->ts.interface == sym)
- {
- gfc_error ("PROCEDURE '%s' at %L may not be used as its own "
- "interface", sym->name, &sym->declared_at);
- return;
- }
- if (sym->ts.interface->attr.procedure)
- {
- gfc_error ("Interface '%s', used by procedure '%s' at %L, is declared"
- " in a later PROCEDURE statement", sym->ts.interface->name,
- sym->name,&sym->declared_at);
- return;
- }
-
- /* Get the attributes from the interface (now resolved). */
- if (sym->ts.interface->attr.if_source
- || sym->ts.interface->attr.intrinsic)
- {
- gfc_symbol *ifc = sym->ts.interface;
- resolve_symbol (ifc);
-
- if (ifc->attr.intrinsic)
- resolve_intrinsic (ifc, &ifc->declared_at);
-
- if (ifc->result)
- sym->ts = ifc->result->ts;
- else
- sym->ts = ifc->ts;
- sym->ts.interface = ifc;
- sym->attr.function = ifc->attr.function;
- sym->attr.subroutine = ifc->attr.subroutine;
- gfc_copy_formal_args (sym, ifc);
-
- sym->attr.allocatable = ifc->attr.allocatable;
- sym->attr.pointer = ifc->attr.pointer;
- sym->attr.pure = ifc->attr.pure;
- sym->attr.elemental = ifc->attr.elemental;
- sym->attr.dimension = ifc->attr.dimension;
- sym->attr.contiguous = ifc->attr.contiguous;
- sym->attr.recursive = ifc->attr.recursive;
- sym->attr.always_explicit = ifc->attr.always_explicit;
- sym->attr.ext_attr |= ifc->attr.ext_attr;
- /* Copy array spec. */
- sym->as = gfc_copy_array_spec (ifc->as);
- if (sym->as)
- {
- int i;
- for (i = 0; i < sym->as->rank; i++)
- {
- gfc_expr_replace_symbols (sym->as->lower[i], sym);
- gfc_expr_replace_symbols (sym->as->upper[i], sym);
- }
- }
- /* Copy char length. */
- if (ifc->ts.type == BT_CHARACTER && ifc->ts.u.cl)
- {
- sym->ts.u.cl = gfc_new_charlen (sym->ns, ifc->ts.u.cl);
- gfc_expr_replace_symbols (sym->ts.u.cl->length, sym);
- if (sym->ts.u.cl->length && !sym->ts.u.cl->resolved
- && gfc_resolve_expr (sym->ts.u.cl->length) == FAILURE)
- return;
- }
- }
- else if (sym->ts.interface->name[0] != '\0')
- {
- gfc_error ("Interface '%s' of procedure '%s' at %L must be explicit",
- sym->ts.interface->name, sym->name, &sym->declared_at);
- return;
- }
- }
+ && sym->attr.if_source != IFSRC_DECL
+ && resolve_procedure_interface (sym) == FAILURE)
+ return;
if (sym->attr.is_protected && !sym->attr.proc_pointer
&& (sym->attr.procedure || sym->attr.external))