Hi All,
This PR was fixed by the patch for PR109066. I have had the attached
testcase in my tree for more than a week now and I propose to push it
tomorrow, unless there are any objections.
The reporter has requested that the patch be backported. Neither PR is a
regression and component defined assignment is so wrongly implemented that
it will have to be reworked in 16. However, I am perfectly prepared to do
the backport, which should keep at least two customers happy :-) Thoughts?
Regards
Paul
! { dg-do run }
!
! PR115265 was fixed by the patch for PR109066. This testcase makes sure
! that it stays that way :-)
!
! Contributed by Matthew Krupcale <[email protected]>
!
module t_mod
implicit none
private
public :: t, my_f, extract_y_
type t
procedure(t_f), pointer, nopass :: f
integer, dimension(:), allocatable :: x
integer, private, dimension(:), allocatable :: y_
contains
final :: t_destructor
procedure :: y => t_y
end type t
interface t
module procedure t_constructor
end interface t
abstract interface
subroutine t_f(x, y)
integer, intent(in) :: x(:)
integer, intent(out) :: y(:)
end subroutine t_f
end interface
contains
function t_constructor(f, x)
implicit none
procedure(t_f), pointer, intent(in) :: f
integer, dimension(:), intent(in) :: x
type(t) :: t_constructor
integer :: n
n = size(x)
allocate(t_constructor%x(n))
allocate(t_constructor%y_(n))
t_constructor%f => f
t_constructor%x = x
end function t_constructor
subroutine t_destructor(this)
implicit none
type(t), intent(inout) :: this
if (allocated(this%x)) deallocate(this%x)
if (allocated(this%y_)) deallocate(this%y_)
end subroutine t_destructor
subroutine t_y(this)
implicit none
class(t), intent(inout) :: this
call this%f(this%x, this%y_)
end subroutine t_y
subroutine my_f(x, y)
implicit none
integer, intent(in) :: x(:)
integer, intent(out) :: y(:)
y = 2 * x ! Runtime segfault here
end subroutine my_f
function extract_y_ (arg) result (res)
integer, dimension(:), allocatable :: res
type(t) :: arg
res = arg%y_
end function extract_y_
end module t_mod
program main
use t_mod
implicit none
type(t) :: my_t, res
my_t = t(my_f, [1, 2, 3])
call my_t%y()
if (any (extract_y_ (my_t) .ne. [2,4,6])) stop 1
end program main
