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.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@183771 138bc75d-0d04-0410-961f-82ee72b054a4

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index a0397cc3c7d2ab8815606e190c1844039223519b..fbbfccf813ce6e67d056355e8fc7d157662d6ca1 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/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

diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c
index c87fc1b1ac4d8f67cfb80b52764b5235cac2820d..43c558a55718765cc8aaba780f7bfe3fbbf97e8e 100644 (file)
--- a/gcc/fortran/decl.c
+++ b/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);

diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 6f49d6146bae92c7fd1f66d63484a945485e5ff4..757a4e524d8cf9231031cac3f6648eea1bb146b6 100644 (file)
--- a/gcc/fortran/gfortran.h
+++ b/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;
 

diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 0560261be8d3bdcb430d0211b72932717a08a719..4dcf9b1b07ce998dc63d034e130414a98a39edcb 100644 (file)
--- a/gcc/fortran/resolve.c
+++ b/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);

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 8eb797e19a94519ac7cc37d0dd396f263056c23c..23a0ef48be6e8d9b12f2d0e8c503778b66806170 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/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

diff --git a/gcc/testsuite/gfortran.dg/typebound_generic_11.f90 b/gcc/testsuite/gfortran.dg/typebound_generic_11.f90
new file mode 100644 (file)
index 0000000..eb89d0d
--- /dev/null
+++ b/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" } }