diff options
Diffstat (limited to 'gcc/fortran/interface.c')
-rw-r--r-- | gcc/fortran/interface.c | 20 |
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; } |