2012-01-28 Tobias Burnus <burnus@net-b.de>
PR fortran/52024
* gfortran.h (gfc_tbp_generic): Store whether the
generic is an operator.
* decl.c (gfc_match_generic): Set that flag.
* resolve.c (check_generic_tbp_ambiguity): Use it in the
gfc_compare_interfaces check.
2012-01-28 Tobias Burnus <burnus@net-b.de>
PR fortran/52024
* gfortran.dg/typebound_generic_11.f90: New.
===================================================================
@@ -1118,2 +1118,3 @@ typedef struct gfc_tbp_generic
struct gfc_tbp_generic* next;
+ bool is_operator;
}
===================================================================
@@ -10966,2 +10995,3 @@ check_generic_tbp_ambiguity (gfc_tbp_gen
gcc_assert (!t2->specific->is_generic);
+ gcc_assert (t1->is_operator == t2->is_operator);
@@ -10984,3 +11014,4 @@ check_generic_tbp_ambiguity (gfc_tbp_gen
/* Compare the interfaces. */
- if (gfc_compare_interfaces (sym1, sym2, sym2->name, 1, 0, NULL, 0))
+ if (gfc_compare_interfaces (sym1, sym2, sym2->name, !t1->is_operator, 0,
+ NULL, 0))
{
===================================================================
@@ -8394,2 +8394,4 @@ gfc_match_generic (void)
target->next = tb->u.generic;
+ target->is_operator = ((op_type == INTERFACE_USER_OP)
+ || (op_type == INTERFACE_INTRINSIC_OP));
tb->u.generic = target;
===================================================================
@@ -0,0 +1,63 @@
+! { dg-do compile }
+!
+! PR fortran/52024
+!
+! Contributed by Fran Martinez Fadrique
+!
+module m_test
+ type t_test
+ integer :: i = 0
+ contains
+ generic :: operator(==) => t_equal_i, i_equal_t ! OK
+ procedure, private :: t_equal_i
+ procedure, private, pass(t) :: i_equal_t
+ end type t_test
+contains
+ function t_equal_i (t, i) result(res)
+ class(t_test), intent(in) :: t
+ integer, intent(in) :: i
+ logical :: res
+
+ print *, 't_equal_i', t%i, i
+ res = ( t%i == i )
+ end function t_equal_i
+
+ function i_equal_t (i, t) result(res)
+ integer, intent(in) :: i
+ class(t_test), intent(in) :: t
+ logical :: res
+
+ print *, 'i_equal_t', i, t%i
+ res = ( t%i == i )
+ end function i_equal_t
+end module m_test
+
+module m_test2
+ type t2_test
+ integer :: i = 0
+ contains
+ generic :: gen => t2_equal_i, i_equal_t2 ! { dg-error "'t2_equal_i' and 'i_equal_t2' for GENERIC 'gen' at .1. are ambiguous" }
+ procedure, private :: t2_equal_i
+ procedure, private, pass(t) :: i_equal_t2
+ end type t2_test
+contains
+ function t2_equal_i (t, i) result(res)
+ class(t2_test), intent(in) :: t
+ integer, intent(in) :: i
+ logical :: res
+
+ print *, 't2_equal_i', t%i, i
+ res = ( t%i == i )
+ end function t2_equal_i
+
+ function i_equal_t2 (i, t) result(res)
+ integer, intent(in) :: i
+ class(t2_test), intent(in) :: t
+ logical :: res
+
+ print *, 'i_equal_t2', i, t%i
+ res = ( t%i == i )
+ end function i_equal_t2
+end module m_test2
+
+! { dg-final { cleanup-modules "m_test m_test2" } }