From 6f3ab30d8b7bfa0ab2e5a370f1196602960c271c Mon Sep 17 00:00:00 2001 From: Janus Weil Date: Fri, 22 Jun 2012 23:05:51 +0200 Subject: re PR fortran/47710 ([OOP] Improve ambiguity check for GENERIC TBP w/ PASS and NOPASS) 2012-06-22 Janus Weil PR fortran/47710 PR fortran/53328 * interface.c (count_types_test, generic_correspondence, gfc_compare_interfaces): Ignore PASS arguments. (check_interface1, compare_parameter): Pass NULL arguments to gfc_compare_interfaces. * gfortran.h (gfc_compare_interfaces): Modified prototype. * expr.c (gfc_check_pointer_assign): Pass NULL arguments to gfc_compare_interfaces. * resolve.c (resolve_structure_cons): Ditto. (check_generic_tbp_ambiguity): Determine PASS arguments and pass them to gfc_compare_interfaces. 2012-06-22 Janus Weil PR fortran/47710 PR fortran/53328 * gfortran.dg/typebound_generic_12.f03: New. * gfortran.dg/typebound_generic_13.f03: New. From-SVN: r188902 --- gcc/fortran/resolve.c | 20 ++++++++++++++++---- 1 file changed, 16 insertions(+), 4 deletions(-) (limited to 'gcc/fortran/resolve.c') diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index d09cb11..4595f76 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -1152,7 +1152,7 @@ resolve_structure_cons (gfc_expr *expr, int init) } if (s2 && !gfc_compare_interfaces (comp->ts.interface, s2, name, 0, 1, - err, sizeof (err))) + err, sizeof (err), NULL, NULL)) { gfc_error ("Interface mismatch for procedure-pointer component " "'%s' in structure constructor at %L: %s", @@ -11020,8 +11020,8 @@ static gfc_try check_generic_tbp_ambiguity (gfc_tbp_generic* t1, gfc_tbp_generic* t2, const char* generic_name, locus where) { - gfc_symbol* sym1; - gfc_symbol* sym2; + gfc_symbol *sym1, *sym2; + const char *pass1, *pass2; gcc_assert (t1->specific && t2->specific); gcc_assert (!t1->specific->is_generic); @@ -11045,8 +11045,20 @@ check_generic_tbp_ambiguity (gfc_tbp_generic* t1, gfc_tbp_generic* t2, } /* Compare the interfaces. */ + if (t1->specific->nopass) + pass1 = NULL; + else if (t1->specific->pass_arg) + pass1 = t1->specific->pass_arg; + else + pass1 = t1->specific->u.specific->n.sym->formal->sym->name; + if (t2->specific->nopass) + pass2 = NULL; + else if (t2->specific->pass_arg) + pass2 = t2->specific->pass_arg; + else + pass2 = t2->specific->u.specific->n.sym->formal->sym->name; if (gfc_compare_interfaces (sym1, sym2, sym2->name, !t1->is_operator, 0, - NULL, 0)) + NULL, 0, pass1, pass2)) { gfc_error ("'%s' and '%s' for GENERIC '%s' at %L are ambiguous", sym1->name, sym2->name, generic_name, &where); -- cgit v1.1