diff options
Diffstat (limited to 'gcc/fortran/interface.c')
| -rw-r--r-- | gcc/fortran/interface.c | 26 |
1 files changed, 18 insertions, 8 deletions
diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c index f2d1465..48c026c 100644 --- a/gcc/fortran/interface.c +++ b/gcc/fortran/interface.c @@ -873,23 +873,32 @@ count_types_test (gfc_formal_arglist *f1, gfc_formal_arglist *f2) which makes this test much easier than that for generic tests. This subroutine is also used when comparing a formal and actual - argument list when an actual parameter is a dummy procedure. At - that point, two formal interfaces must be compared for equality - which is what happens here. */ + argument list when an actual parameter is a dummy procedure, and in + procedure pointer assignments. In these cases, two formal interfaces must be + compared for equality which is what happens here. 'intent_flag' specifies + whether the intents of the arguments are required to match, which is not the + case for ambiguity checks. */ static int -operator_correspondence (gfc_formal_arglist *f1, gfc_formal_arglist *f2) +operator_correspondence (gfc_formal_arglist *f1, gfc_formal_arglist *f2, + int intent_flag) { for (;;) { + /* Check existence. */ if (f1 == NULL && f2 == NULL) break; if (f1 == NULL || f2 == NULL) return 1; + /* Check type and rank. */ if (!compare_type_rank (f1->sym, f2->sym)) return 1; + /* Check intent. */ + if (intent_flag && (f1->sym->attr.intent != f2->sym->attr.intent)) + return 1; + f1 = f1->next; f2 = f2->next; } @@ -961,7 +970,8 @@ generic_correspondence (gfc_formal_arglist *f1, gfc_formal_arglist *f2) would be ambiguous between the two interfaces, zero otherwise. */ int -gfc_compare_interfaces (gfc_symbol *s1, gfc_symbol *s2, int generic_flag) +gfc_compare_interfaces (gfc_symbol *s1, gfc_symbol *s2, int generic_flag, + int intent_flag) { gfc_formal_arglist *f1, *f2; @@ -1001,7 +1011,7 @@ gfc_compare_interfaces (gfc_symbol *s1, gfc_symbol *s2, int generic_flag) } else { - if (operator_correspondence (f1, f2)) + if (operator_correspondence (f1, f2, intent_flag)) return 0; } @@ -1080,7 +1090,7 @@ check_interface1 (gfc_interface *p, gfc_interface *q0, if (p->sym->name == q->sym->name && p->sym->module == q->sym->module) continue; - if (gfc_compare_interfaces (p->sym, q->sym, generic_flag)) + if (gfc_compare_interfaces (p->sym, q->sym, generic_flag, 0)) { if (referenced) { @@ -1362,7 +1372,7 @@ compare_parameter (gfc_symbol *formal, gfc_expr *actual, || actual->symtree->n.sym->attr.external) return 1; /* Assume match. */ - if (!gfc_compare_interfaces (formal, actual->symtree->n.sym, 0)) + if (!gfc_compare_interfaces (formal, actual->symtree->n.sym, 0, 1)) goto proc_fail; return 1; |