===================================================================
@@ -1858,29 +1858,6 @@ resolve_global_procedure (gfc_symbol *sy
}
}
- if (gsym->ns->proc_name->attr.function
- && gsym->ns->proc_name->as
- && gsym->ns->proc_name->as->rank
- && (!sym->as || sym->as->rank != gsym->ns->proc_name->as->rank))
- gfc_error ("The reference to function '%s' at %L either needs an "
- "explicit INTERFACE or the rank is incorrect", sym->name,
- where);
-
- /* Non-assumed length character functions. */
- if (sym->attr.function && sym->ts.type == BT_CHARACTER
- && gsym->ns->proc_name->ts.u.cl->length != NULL)
- {
- gfc_charlen *cl = sym->ts.u.cl;
-
- if (!sym->attr.entry_master && sym->attr.if_source == IFSRC_UNKNOWN
- && cl && cl->length && cl->length->expr_type != EXPR_CONSTANT)
- {
- gfc_error ("Nonconstant character-length function '%s' at %L "
- "must have an explicit interface", sym->name,
- &sym->declared_at);
- }
- }
-
/* Differences in constant character lengths. */
if (sym->attr.function && sym->ts.type == BT_CHARACTER)
{
@@ -1911,26 +1888,108 @@ resolve_global_procedure (gfc_symbol *sy
sym->name, &sym->declared_at, gfc_typename (&sym->ts),
gfc_typename (&gsym->ns->proc_name->ts));
- /* Assumed shape arrays as dummy arguments. */
if (gsym->ns->proc_name->formal)
{
gfc_formal_arglist *arg = gsym->ns->proc_name->formal;
for ( ; arg; arg = arg->next)
- if (arg->sym && arg->sym->as
- && arg->sym->as->type == AS_ASSUMED_SHAPE)
+ if (!arg->sym)
+ continue;
+ /* F2003, 12.3.1.1 (2a); F2008, 12.4.2.2 (2a) */
+ else if (arg->sym->attr.allocatable
+ || arg->sym->attr.asynchronous
+ || arg->sym->attr.optional
+ || arg->sym->attr.pointer
+ || arg->sym->attr.target
+ || arg->sym->attr.value
+ || arg->sym->attr.volatile_)
+ {
+ gfc_error ("Dummy argument '%s' of procedure '%s' at %L "
+ "has an attribute that requires an explicit "
+ "interface for this procedure", arg->sym->name,
+ sym->name, &sym->declared_at);
+ break;
+ }
+ /* F2003, 12.3.1.1 (2b); F2008, 12.4.2.2 (2b) */
+ else if (arg->sym && arg->sym->as
+ && arg->sym->as->type == AS_ASSUMED_SHAPE)
{
gfc_error ("Procedure '%s' at %L with assumed-shape dummy "
- "'%s' argument must have an explicit interface",
+ "argument '%s' must have an explicit interface",
sym->name, &sym->declared_at, arg->sym->name);
break;
}
- else if (arg->sym && arg->sym->attr.optional)
+ /* F2008, 12.4.2.2 (2c) */
+ else if (arg->sym->attr.codimension)
{
- gfc_error ("Procedure '%s' at %L with optional dummy argument "
+ gfc_error ("Procedure '%s' at %L with coarray dummy argument "
"'%s' must have an explicit interface",
sym->name, &sym->declared_at, arg->sym->name);
break;
}
+ /* F2003, 12.3.1.1 (2c); F2008, 12.4.2.2 (2d) */
+ else if (false) /* TODO: is a parametrized derived type */
+ {
+ gfc_error ("Procedure '%s' at %L with parametrized derived "
+ "type argument '%s' must have an explicit "
+ "interface", sym->name, &sym->declared_at,
+ arg->sym->name);
+ break;
+ }
+ /* F2003, 12.3.1.1 (2d); F2008, 12.4.2.2 (2e) */
+ else if (arg->sym->ts.type == BT_CLASS)
+ {
+ gfc_error ("Procedure '%s' at %L with polymorphic dummy "
+ "argument '%s' must have an explicit interface",
+ sym->name, &sym->declared_at, arg->sym->name);
+ break;
+ }
+ }
+
+ if (gsym->ns->proc_name->attr.function)
+ {
+ /* F2003, 12.3.1.1 (3a); F2008, 12.4.2.2 (3a) */
+ if (gsym->ns->proc_name->as
+ && gsym->ns->proc_name->as->rank
+ && (!sym->as || sym->as->rank != gsym->ns->proc_name->as->rank))
+ gfc_error ("The reference to function '%s' at %L either needs an "
+ "explicit INTERFACE or the rank is incorrect", sym->name,
+ where);
+
+ /* F2003, 12.3.1.1 (3b); F2008, 12.4.2.2 (3b) */
+ if (gsym->ns->proc_name->result->attr.pointer
+ || gsym->ns->proc_name->result->attr.allocatable)
+ gfc_error ("Function '%s' at %L with a POINTER or ALLOCATABLE "
+ "result must have an explicit interface", sym->name,
+ where);
+
+ /* F2003, 12.3.1.1 (3c); F2008, 12.4.2.2 (3c) */
+ if (sym->ts.type == BT_CHARACTER
+ && gsym->ns->proc_name->ts.u.cl->length != NULL)
+ {
+ gfc_charlen *cl = sym->ts.u.cl;
+
+ if (!sym->attr.entry_master && sym->attr.if_source == IFSRC_UNKNOWN
+ && cl && cl->length && cl->length->expr_type != EXPR_CONSTANT)
+ {
+ gfc_error ("Nonconstant character-length function '%s' at %L "
+ "must have an explicit interface", sym->name,
+ &sym->declared_at);
+ }
+ }
+ }
+
+ /* F2003, 12.3.1.1 (4); F2008, 12.4.2.2 (4) */
+ if (gsym->ns->proc_name->attr.elemental)
+ {
+ gfc_error ("ELEMENTAL procedure '%s' at %L must have an explicit "
+ "interface", sym->name, &sym->declared_at);
+ }
+
+ /* F2003, 12.3.1.1 (5); F2008, 12.4.2.2 (5) */
+ if (gsym->ns->proc_name->attr.is_bind_c)
+ {
+ gfc_error ("Procedure '%s' at %L with BIND(C) attribute must have "
+ "an explicit interface", sym->name, &sym->declared_at);
}
if (gfc_option.flag_whole_file == 1