aboutsummaryrefslogtreecommitdiff
path: root/gcc/fortran/interface.c
diff options
context:
space:
mode:
Diffstat (limited to 'gcc/fortran/interface.c')
-rw-r--r--gcc/fortran/interface.c20
1 files changed, 10 insertions, 10 deletions
diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c
index 93e3657..7c86279 100644
--- a/gcc/fortran/interface.c
+++ b/gcc/fortran/interface.c
@@ -1241,7 +1241,10 @@ compare_actual_formal (gfc_actual_arglist ** ap,
}
if (!compare_parameter
- (f->sym, a->expr, ranks_must_agree, is_elemental))
+ (f->sym, a->expr,
+ ranks_must_agree && f->sym->as
+ && f->sym->as->type == AS_ASSUMED_SHAPE,
+ is_elemental))
{
if (where)
gfc_error ("Type/rank mismatch in argument '%s' at %L",
@@ -1563,6 +1566,10 @@ check_intents (gfc_formal_arglist * f, gfc_actual_arglist * a)
void
gfc_procedure_use (gfc_symbol * sym, gfc_actual_arglist ** ap, locus * where)
{
+ int ranks_must_agree;
+ ranks_must_agree = !sym->attr.elemental && (sym->attr.contained
+ || sym->attr.if_source == IFSRC_IFBODY);
+
/* Warn about calls with an implicit interface. */
if (gfc_option.warn_implicit_interface
&& sym->attr.if_source == IFSRC_UNKNOWN)
@@ -1570,8 +1577,8 @@ gfc_procedure_use (gfc_symbol * sym, gfc_actual_arglist ** ap, locus * where)
sym->name, where);
if (sym->attr.if_source == IFSRC_UNKNOWN
- || !compare_actual_formal (ap, sym->formal, 0,
- sym->attr.elemental, where))
+ || !compare_actual_formal (ap, sym->formal, ranks_must_agree,
+ sym->attr.elemental, where))
return;
check_intents (sym->formal, *ap);
@@ -1796,13 +1803,6 @@ gfc_extend_assign (gfc_code * c, gfc_namespace * ns)
c->expr2 = NULL;
c->ext.actual = actual;
- if (gfc_pure (NULL) && !gfc_pure (sym))
- {
- gfc_error ("Subroutine '%s' called in lieu of assignment at %L must be "
- "PURE", sym->name, &c->loc);
- return FAILURE;
- }
-
return SUCCESS;
}