diff options
| author | Janus Weil <janus@gcc.gnu.org> | 2012-06-22 23:05:51 +0200 |
|---|---|---|
| committer | Janus Weil <janus@gcc.gnu.org> | 2012-06-22 23:05:51 +0200 |
| commit | 6f3ab30d8b7bfa0ab2e5a370f1196602960c271c (patch) | |
| tree | 39c3ebe36c82e2ea4b612953d5ff90a3518c0b65 /gcc/fortran/resolve.c | |
| parent | 42533d77ac86ef73fe89ec5daf9c5d7fbb59cf55 (diff) | |
| download | gcc-6f3ab30d8b7bfa0ab2e5a370f1196602960c271c.zip gcc-6f3ab30d8b7bfa0ab2e5a370f1196602960c271c.tar.gz gcc-6f3ab30d8b7bfa0ab2e5a370f1196602960c271c.tar.bz2 | |
re PR fortran/47710 ([OOP] Improve ambiguity check for GENERIC TBP w/ PASS and NOPASS)
2012-06-22 Janus Weil <janus@gcc.gnu.org>
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 <janus@gcc.gnu.org>
PR fortran/47710
PR fortran/53328
* gfortran.dg/typebound_generic_12.f03: New.
* gfortran.dg/typebound_generic_13.f03: New.
From-SVN: r188902
Diffstat (limited to 'gcc/fortran/resolve.c')
| -rw-r--r-- | gcc/fortran/resolve.c | 20 |
1 files changed, 16 insertions, 4 deletions
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); |