gcc/testsuite/gfortran.dg/unlimited_polymorphic_21.f90

! { 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