diff mbox

[Fortran] PR 52024 - Fix ambiguity check for type-bound GENERICs

Message ID 4F23F503.7000705@net-b.de
State New
Headers show

Commit Message

Tobias Burnus Jan. 28, 2012, 1:15 p.m. UTC
For generics, one needs to distinguish between operators and other generics.

Assume:
   function t_equal_i( t, i ) result(res)
   function i_equal_t( i, t ) result(res)

For generic operators, those are not ambiguous as <integer> <derived 
type> can not be confused with the reversed order.

For a generic function, those are ambiguous as <generic_name>(t=x, i=5) 
will match both functions.

Build and regtested on x86-64-linux.
OK for the trunk?

Tobias

Comments

Paul Richard Thomas Jan. 31, 2012, 12:40 p.m. UTC | #1
Hi Tobias,

> Build and regtested on x86-64-linux.
> OK for the trunk?

That looks like a neat way to solve the problem.  OK for trunk.

Thanks for the patch.

Paul
diff mbox

Patch

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.

Index: gcc/fortran/gfortran.h
===================================================================
--- gcc/fortran/gfortran.h	(Revision 183664)
+++ gcc/fortran/gfortran.h	(Arbeitskopie)
@@ -1118,2 +1118,3 @@  typedef struct gfc_tbp_generic
   struct gfc_tbp_generic* next;
+  bool is_operator;
 }
Index: gcc/fortran/resolve.c
===================================================================
--- gcc/fortran/resolve.c	(Revision 183664)
+++ gcc/fortran/resolve.c	(Arbeitskopie)
@@ -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))
     {
Index: gcc/fortran/decl.c
===================================================================
--- gcc/fortran/decl.c	(Revision 183664)
+++ gcc/fortran/decl.c	(Arbeitskopie)
@@ -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;
Index: gcc/testsuite/gfortran.dg/typebound_generic_11.f90
===================================================================
--- gcc/testsuite/gfortran.dg/typebound_generic_11.f90	(Revision 0)
+++ gcc/testsuite/gfortran.dg/typebound_generic_11.f90	(Arbeitskopie)
@@ -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" } }