re PR fortran/78108 (Generic type-bound operator conflicts)

2016-10-26  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/78108
	* resolve.c (resolve_typebound_intrinsic_op): For submodules
	suppress the error and return if the same procedure symbol
	is added more than once to the interface.

2016-10-26  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/78108
	* gfortran.dg/submodule_18.f08: New test.
	* gfortran.dg/submodule_19.f08: New test.

From-SVN: r241555

gcc/fortran/ChangeLog

+2016-10-26  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/78108
+	* resolve.c (resolve_typebound_intrinsic_op): For submodules
+	suppress the error and return if the same procedure symbol
+	is added more than once to the interface.
+
 2016-10-26  Fritz Reese <fritzoreese@gmail.com>
 
 	* frontend-passes.c (gfc_code_walker): Add SHARE and CARRIAGECONTROL.

gcc/fortran/resolve.c

@@ -12797,7 +12797,17 @@ resolve_typebound_intrinsic_op (gfc_symbol* derived, gfc_intrinsic_op op,
 	  && p->access != ACCESS_PRIVATE && derived->ns == gfc_current_ns)
 	{
 	  gfc_interface *head, *intr;
-	  if (!gfc_check_new_interface (derived->ns->op[op], target_proc, p->where))
+
+	  /* Preempt 'gfc_check_new_interface' for submodules, where the
+	     mechanism for handling module procedures winds up resolving
+	     operator interfaces twice and would otherwise cause an error.  */
+	  for (intr = derived->ns->op[op]; intr; intr = intr->next)
+	    if (intr->sym == target_proc
+		&& target_proc->attr.used_in_submodule)
+	      return true;
+
+	  if (!gfc_check_new_interface (derived->ns->op[op],
+					target_proc, p->where))
 	    return false;
 	  head = derived->ns->op[op];
 	  intr = gfc_get_interface ();

gcc/testsuite/ChangeLog

+2016-10-26  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/78108
+	* gfortran.dg/submodule_18.f08: New test.
+	* gfortran.dg/submodule_19.f08: New test.
+
 2016-10-26  Michael Matz  <matz@suse.de>
 
 	* g++.dg/pr78060.C: New test.

gcc/testsuite/gfortran.dg/submodule_18.f08

+! { dg-do run }
+!
+! Tests the fix for PR78108 in which an error was
+! triggered by the module procedures being added twice
+! to the operator interfaces.
+!
+! Contributed by Damian Rouson  <damian@sourceryinstitute.org>
+!
+module foo_interface
+  implicit none
+  type foo
+    integer :: x
+  contains
+    procedure :: add
+    generic :: operator(+) => add
+    procedure :: mult
+    generic :: operator(*) => mult
+  end type
+  interface
+    integer module function add(lhs,rhs)
+      implicit none
+      class(foo), intent(in) :: lhs,rhs
+    end function
+    integer module function mult(lhs,rhs)
+      implicit none
+      class(foo), intent(in) :: lhs,rhs
+    end function
+  end interface
+end module
+submodule(foo_interface) foo_implementation
+contains
+    integer module function add(lhs,rhs)
+      implicit none
+      class(foo), intent(in) :: lhs,rhs
+      add = lhs % x + rhs % x
+    end function
+    integer module function mult(lhs,rhs)
+      implicit none
+      class(foo), intent(in) :: lhs,rhs
+      mult = lhs % x * rhs % x
+    end function
+end submodule
+
+  use foo_interface
+  type(foo) :: a = foo (42)
+  type(foo) :: b = foo (99)
+  if (a + b .ne. 141) call abort
+  if (a * b .ne. 4158) call abort
+end

gcc/testsuite/gfortran.dg/submodule_19.f08

+! { dg-do compile }
+!
+! Tests the fix for PR78108 in which an error was triggered by the
+! generic operator being resolved more than once in submodules. This
+! test checks that the error is triggered when the specific procedure
+! really is inserted more than once in the interface.
+!
+! Note that adding the extra interface to the module produces two
+! errors; the one below and 'Duplicate EXTERNAL attribute specified at (1)'
+!
+! Contributed by Damian Rouson  <damian@sourceryinstitute.org>
+!
+module foo_interface
+  implicit none
+  type foo
+    integer :: x
+  contains
+    procedure :: add
+    generic :: operator(+) => add
+    procedure :: mult
+    generic :: operator(*) => mult
+  end type
+  interface
+    integer module function add(lhs,rhs)
+      implicit none
+      class(foo), intent(in) :: lhs,rhs
+    end function
+    integer module function mult(lhs,rhs)
+      implicit none
+      class(foo), intent(in) :: lhs,rhs
+    end function
+  end interface
+end module
+submodule(foo_interface) foo_implementation
+  interface operator (+)
+    integer module function add(lhs,rhs)
+      implicit none
+      class(foo), intent(in) :: lhs,rhs
+    end function    ! { dg-error "is already present in the interface" }
+  end interface
+contains
+    integer module function add(lhs,rhs)
+      implicit none
+      class(foo), intent(in) :: lhs,rhs
+      add = lhs % x + rhs % x
+    end function
+    integer module function mult(lhs,rhs)
+      implicit none
+      class(foo), intent(in) :: lhs,rhs
+      mult = lhs % x * rhs % x
+    end function
+end submodule
+
+  use foo_interface
+  type(foo) :: a = foo (42)
+  type(foo) :: b = foo (99)
+  if (a + b .ne. 141) call abort
+  if (a * b .ne. 4158) call abort
+end