https://gcc.gnu.org/bugzilla/show_bug.cgi?id=117730
Bug ID: 117730
Summary: Wrong code with non_overridable typebound procedure
Product: gcc
Version: 15.0
Status: UNCONFIRMED
Keywords: wrong-code
Severity: normal
Priority: P3
Component: fortran
Assignee: pault at gcc dot gnu.org
Reporter: pault at gcc dot gnu.org
Target Milestone: ---
Extracted from comment #4 in PR84674 and posted by [email protected]
With a debugger, I could see: in test.f90, F%get() is called (line 8), the
program then moves into child_get() in module2.f90 (line 35) as it should.
However, stepping into this%calc() (line 39), it moves to child_reset() in
module1.f90 (line 31) instead of child2_calc() in module2.f90 (line 15).
There are two ways to get this program to work, which are both quite weird:
1. (correct version of this in comment #5)remove "non_overridable" from line 13
in module1.f90
s/procedure, pass, non_overridable :: reset => child_reset/procedure, pass ::
get => child_reset/
2. merge module1 and module2 into one module.
3. added by pault: delete line 13 in module1.f90
d/procedure, pass :: reset => parent_reset/
FILES:
***module1.f90:
module module1
implicit none
private
public :: child
type, abstract :: parent
contains
procedure, pass :: reset => parent_reset
end type parent
type, extends(parent), abstract :: child
contains
procedure, pass, non_overridable :: reset => child_reset
procedure, pass, non_overridable :: get => child_get
procedure(calc_i), pass, deferred :: calc
end type child
abstract interface
pure function calc_i(this) result(value)
import :: child
class(child), intent(in) :: this
integer :: value
end function calc_i
end interface
contains
pure subroutine parent_reset(this)
class(parent), intent(inout) :: this
end subroutine parent_reset
pure subroutine child_reset(this)
class(child), intent(inout) :: this
end subroutine child_reset
function child_get(this) result(value)
class(child), intent(inout) :: this
integer :: value
value = this%calc()
end function child_get
end module module1
***module2.f90:
module module2
use module1, only: child
implicit none
private
public :: child2
type, extends(child) :: child2
contains
procedure, pass :: calc => child2_calc
end type child2
contains
pure function child2_calc(this) result(value)
class(child2), intent(in) :: this
integer :: value
value = 1
end function child2_calc
end module module2
***test.f90:
program test
use module2, only: child2
implicit none
type(child2) :: F
if (F%get() /= 1) stop ': FAILED'
end program test
