http://gcc.gnu.org/bugzilla/show_bug.cgi?id=46196
Dominique d'Humieres <dominiq at lps dot ens.fr> changed:
What |Removed |Added
----------------------------------------------------------------------------
CC| |bur...@net-b.de
--- Comment #8 from Dominique d'Humieres <dominiq at lps dot ens.fr> 2010-10-29
16:00:57 UTC ---
I have successfully regtested the following patch, i.e., the patch in
comment #2 and the fix for the typos reported in comment #5, on top of
revision 166058 (plus a few unrelated patches). I also noticed that the
fix for pr46067 use the asymmetry of gfc_compare_interfaces!-)
------------------------------------------------------------------------
--- ../_clean/gcc/fortran/interface.c 2010-10-27 23:47:20.000000000 +0200
+++ gcc/fortran/interface.c 2010-10-29 10:55:07.000000000 +0200
@@ -445,16 +445,16 @@ gfc_compare_derived_types (gfc_symbol *d
/* Make sure that link lists do not put this function into an
endless recursive loop! */
if (!(dt1->ts.type == BT_DERIVED && derived1 == dt1->ts.u.derived)
- && !(dt1->ts.type == BT_DERIVED && derived1 == dt1->ts.u.derived)
+ && !(dt2->ts.type == BT_DERIVED && derived2 == dt2->ts.u.derived)
&& gfc_compare_types (&dt1->ts, &dt2->ts) == 0)
return 0;
else if ((dt1->ts.type == BT_DERIVED && derived1 == dt1->ts.u.derived)
- && !(dt1->ts.type == BT_DERIVED && derived1 == dt1->ts.u.derived))
+ && !(dt2->ts.type == BT_DERIVED && derived2 == dt2->ts.u.derived))
return 0;
else if (!(dt1->ts.type == BT_DERIVED && derived1 == dt1->ts.u.derived)
- && (dt1->ts.type == BT_DERIVED && derived1 == dt1->ts.u.derived))
+ && (dt2->ts.type == BT_DERIVED && derived2 == dt2->ts.u.derived))
return 0;
dt1 = dt1->next;
@@ -872,7 +872,8 @@ count_types_test (gfc_formal_arglist *f1
/* Find other nonoptional arguments of the same type/rank. */
for (j = i + 1; j < n1; j++)
if ((arg[j].sym == NULL || !arg[j].sym->attr.optional)
- && compare_type_rank_if (arg[i].sym, arg[j].sym))
+ && (compare_type_rank_if (arg[i].sym, arg[j].sym)
+ || compare_type_rank_if (arg[j].sym, arg[i].sym)))
arg[j].flag = k;
k++;
@@ -897,7 +898,8 @@ count_types_test (gfc_formal_arglist *f1
ac2 = 0;
for (f = f2; f; f = f->next)
- if (compare_type_rank_if (arg[i].sym, f->sym))
+ if (compare_type_rank_if (arg[i].sym, f->sym)
+ || compare_type_rank_if (f->sym, arg[i].sym))
ac2++;
if (ac1 > ac2)
@@ -948,7 +950,8 @@ generic_correspondence (gfc_formal_argli
if (f1->sym->attr.optional)
goto next;
- if (f2 != NULL && compare_type_rank (f1->sym, f2->sym))
+ if (f2 != NULL && (compare_type_rank (f1->sym, f2->sym)
+ || compare_type_rank (f2->sym, f1->sym)))
goto next;
/* Now search for a disambiguating keyword argument starting at
------------------------------------------------------------------------
This has disturbed my bug collection for the following tests:
*Code in (1) pr41951_3.f90:21.32:
generic :: operator(.gt.) => gt_cmp_int
1
Error: 'gt_cmp_int' and 'gt_cmp' for GENERIC '.gt.' at (1) are ambiguous
*Code in comment #24 pr42274_5.f90:14.33:
generic, public :: extract => make_integer_2
1
Error: 'make_integer_2' and 'make_integer' for GENERIC 'extract' at (1) are
ambiguous
*Code in comment #0 with !!$ removed pr43945_2.f90:30.29:
generic, public :: do => doit
1
Error: 'doit2' and 'doit' for GENERIC 'do' at (1) are ambiguous
pr43945_2.f90:31.29:
generic, public :: get => getit
1
Error: 'getit2' and 'getit' for GENERIC 'get' at (1) are ambiguous
*Expected pr44917.f90, pr44917_1.f90, oop.f90
oop.f90:22.33:
generic, public :: extract => real, make_integer_2
1
Error: 'make_integer_2' and 'make_integer' for GENERIC 'extract' at (1) are
ambiguous
*Expected pr44926.f90:33.35:
generic, public :: csget => d_get
1
Error: 'd_get' and 'base_csgetp' for GENERIC 'csget' at (1) are ambiguous
*Expected pr46196.f90:9.24:
generic :: g_sub => a_subroutine,b_subroutine
1
Error: 'a_subroutine' and 'b_subroutine' for GENERIC 'g_sub' at (1) are
ambiguous
------------------------------------------------------------------------
(1) code for pr41951_3.f90:
module m_sort
implicit none
type, abstract :: sort_t
contains
generic :: operator(.gt.) => gt_cmp
procedure :: gt_cmp
end type sort_t
contains
logical function gt_cmp(a,b)
class(sort_t), intent(in) :: a, b
gt_cmp = .true.
end function gt_cmp
end module
module test
use m_sort
implicit none
type, extends(sort_t) :: sort_int_t
integer :: i
contains
generic :: operator(.gt.) => gt_cmp_int
procedure :: gt_cmp_int
end type
contains
logical function gt_cmp_int(a,b) result(cmp)
class(sort_int_t), intent(in) :: a, b
if (a%i > b%i) then
cmp = .true.
else
cmp = .false.
end if
end function gt_cmp_int
end module
end
I am pretty bad with such ambiguous stuff, especially with classes, so I
let the experts check that there is no false positive.
