! { dg-do run }
! { dg-options "-fcoarray=single" }
!
! Contributed by Gerhard Steinmetz  <gerhard.steinmetz.fortran@t-online.de>
!               Andre Vehreschild <vehre@gcc.gnu.org>
! Check that PR fortran/69451 is fixed.

program main

implicit none

type foo
end type

class(foo), allocatable :: p[:]
class(foo), pointer :: r
class(*), allocatable, target :: z

allocate(p[*])

call s(p, z)
select type (z)
  class is (foo) 
        r => z
  class default
     STOP 1
end select

if (.not. associated(r)) STOP 2

deallocate(r)
deallocate(p)

contains

subroutine s(x, z) 
   class(*) :: x[*]
   class(*), allocatable:: z
   allocate (z, source=x)
end

end