mirror of
https://github.com/autc04/Retro68.git
synced 2024-09-28 18:56:06 +00:00
36 lines
934 B
Fortran
36 lines
934 B
Fortran
! { dg-do run }
|
|
! Tests the fix for PR64578.
|
|
!
|
|
! Contributed by Damian Rouson <damian@sourceryinstitute.org>
|
|
!
|
|
type foo
|
|
real, allocatable :: component(:)
|
|
end type
|
|
type (foo), target :: f
|
|
class(*), pointer :: ptr(:)
|
|
allocate(f%component(1),source=[0.99])
|
|
call associate_pointer(f,ptr)
|
|
select type (ptr)
|
|
type is (real)
|
|
if (abs (ptr(1) - 0.99) > 1e-5) STOP 1
|
|
end select
|
|
ptr => return_pointer(f) ! runtime segmentation fault
|
|
if (associated(return_pointer(f)) .neqv. .true.) STOP 2
|
|
select type (ptr)
|
|
type is (real)
|
|
if (abs (ptr(1) - 0.99) > 1e-5) STOP 3
|
|
end select
|
|
contains
|
|
subroutine associate_pointer(this, item)
|
|
class(foo), target :: this
|
|
class(*), pointer :: item(:)
|
|
item => this%component
|
|
end subroutine
|
|
function return_pointer(this)
|
|
class(foo), target :: this
|
|
class(*), pointer :: return_pointer(:)
|
|
return_pointer => this%component
|
|
end function
|
|
end
|
|
|