From: Paul Thomas Date: Wed, 26 Oct 2016 14:48:02 +0000 (+0000) Subject: re PR fortran/78108 (Generic type-bound operator conflicts) X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=cd612e8a0124c51cd7bc3d18a1cba6c2d4e144c4;p=gcc.git re PR fortran/78108 (Generic type-bound operator conflicts) 2016-10-26 Paul Thomas 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 PR fortran/78108 * gfortran.dg/submodule_18.f08: New test. * gfortran.dg/submodule_19.f08: New test. From-SVN: r241555 --- diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 65911dc7302..bae08b8c8ac 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,10 @@ +2016-10-26 Paul Thomas + + 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 * frontend-passes.c (gfc_code_walker): Add SHARE and CARRIAGECONTROL. diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 785203b4dc2..fe966aa537d 100644 --- a/gcc/fortran/resolve.c +++ b/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 (); diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index a5049cf89cd..84dc56df113 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,9 @@ +2016-10-26 Paul Thomas + + PR fortran/78108 + * gfortran.dg/submodule_18.f08: New test. + * gfortran.dg/submodule_19.f08: New test. + 2016-10-26 Michael Matz * g++.dg/pr78060.C: New test. diff --git a/gcc/testsuite/gfortran.dg/submodule_18.f08 b/gcc/testsuite/gfortran.dg/submodule_18.f08 new file mode 100644 index 00000000000..14fac75635c --- /dev/null +++ b/gcc/testsuite/gfortran.dg/submodule_18.f08 @@ -0,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 +! +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 diff --git a/gcc/testsuite/gfortran.dg/submodule_19.f08 b/gcc/testsuite/gfortran.dg/submodule_19.f08 new file mode 100644 index 00000000000..bc840081436 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/submodule_19.f08 @@ -0,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 +! +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