re PR fortran/52024 ([OOP] GENERIC operator cannot be resolved)

2012-01-31  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-31  Tobias Burnus  <burnus@net-b.de>

        PR fortran/52024
        * gfortran.dg/typebound_generic_11.f90: New.

From-SVN: r183771

gcc/fortran/ChangeLog

@@ -1,3 +1,12 @@
+2012-01-31  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-31  Tobias Burnus  <burnus@net-b.de>
 
 	PR fortran/52029

gcc/fortran/decl.c

@@ -8391,6 +8391,8 @@ gfc_match_generic (void)
       target->specific_st = target_st;
       target->specific = NULL;
       target->next = tb->u.generic;
+      target->is_operator = ((op_type == INTERFACE_USER_OP)
+			     || (op_type == INTERFACE_INTRINSIC_OP));
       tb->u.generic = target;
     }
   while (gfc_match (" ,") == MATCH_YES);

gcc/fortran/gfortran.h

@@ -1115,6 +1115,7 @@ typedef struct gfc_tbp_generic
   struct gfc_typebound_proc* specific;
 
   struct gfc_tbp_generic* next;
+  bool is_operator;
 }
 gfc_tbp_generic;
 

gcc/fortran/resolve.c

@@ -10950,6 +10950,7 @@ check_generic_tbp_ambiguity (gfc_tbp_generic* t1, gfc_tbp_generic* t2,
   gcc_assert (t1->specific && t2->specific);
   gcc_assert (!t1->specific->is_generic);
   gcc_assert (!t2->specific->is_generic);
+  gcc_assert (t1->is_operator == t2->is_operator);
 
   sym1 = t1->specific->u.specific->n.sym;
   sym2 = t2->specific->u.specific->n.sym;
@@ -10968,7 +10969,8 @@ check_generic_tbp_ambiguity (gfc_tbp_generic* t1, gfc_tbp_generic* t2,
     }
 
   /* 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))
     {
       gfc_error ("'%s' and '%s' for GENERIC '%s' at %L are ambiguous",
 		 sym1->name, sym2->name, generic_name, &where);

gcc/testsuite/ChangeLog

@@ -1,3 +1,8 @@
+2012-01-31  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/52024
+	* gfortran.dg/typebound_generic_11.f90: New.
+
 2012-01-31  Tobias Burnus  <burnus@net-b.de>
 
 	PR fortran/52029

gcc/testsuite/gfortran.dg/typebound_generic_11.f90

@@ -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" } }