! { dg-do run }
!
! Test for the fix for PR34640. In this case, final testing of the
! patch revealed that in some cases the actual descriptor was not
! being passed to procedure dummy pointers.
!
! Contributed by Thomas Koenig  <tkoenig@netcologne.de>
!
module x
  use iso_c_binding
  implicit none
  type foo
     complex :: c
     integer :: i
  end type foo
contains
  subroutine printit(c, a)
    complex, pointer, dimension(:) :: c
    integer :: i
    integer(kind=c_intptr_t) :: a
    a = transfer(c_loc(c(2)),a)
  end subroutine printit
end module x

program main
  use x
  use iso_c_binding
  implicit none
  type(foo), dimension(5), target :: a
  integer :: i
  complex, dimension(:), pointer :: pc
  integer(kind=c_intptr_t) :: s1, s2, s3
  a%i = 0
  do i=1,5
     a(i)%c = cmplx(i**2,i)
  end do
  pc => a%c
  call printit(pc, s3)

  s1 = transfer(c_loc(a(2)%c),s1)
  if (s1 /= s3) STOP 1

  s2 = transfer(c_loc(pc(2)),s2)
  if (s2 /= s3) STOP 2

end program main