Dear All,
The comment in the patch more than adequately describes how this patch
works. The first testcase checks that correctly functioning code is
produced, when the spurious error is suppressed, and the second checks
that genuine errors are caught.
Bootstraps and regtests on FC21/x86_64 - OK for trunk and, in a week
or so time, 6-branch?
I intend to commit as 'obvious' at 17:00 CET today if there are no objections.
Best regards
Paul
2016-10-26 Paul Thomas <pa...@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 <pa...@gcc.gnu.org>
PR fortran/78108
* gfortran.dg/submodule_18.f08: New test.
* gfortran.dg/submodule_19.f08: New test.
Index: gcc/fortran/resolve.c
===================================================================
*** gcc/fortran/resolve.c (revision 241539)
--- gcc/fortran/resolve.c (working copy)
*************** resolve_typebound_intrinsic_op (gfc_symb
*** 12797,12803 ****
&& 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))
return false;
head = derived->ns->op[op];
intr = gfc_get_interface ();
--- 12797,12813 ----
&& p->access != ACCESS_PRIVATE && derived->ns == gfc_current_ns)
{
gfc_interface *head, *intr;
!
! /* 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 ();
Index: gcc/testsuite/gfortran.dg/submodule_18.f08
===================================================================
*** gcc/testsuite/gfortran.dg/submodule_18.f08 (revision 0)
--- gcc/testsuite/gfortran.dg/submodule_18.f08 (working copy)
***************
*** 0 ****
--- 1,49 ----
+ ! { 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 <dam...@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
Index: gcc/testsuite/gfortran.dg/submodule_19.f08
===================================================================
*** gcc/testsuite/gfortran.dg/submodule_19.f08 (revision 0)
--- gcc/testsuite/gfortran.dg/submodule_19.f08 (working copy)
***************
*** 0 ****
--- 1,59 ----
+ ! { 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 <dam...@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
