1! { dg-do run }
2!
3! Test for the fix for PR34640. In this case, final testing of the
4! patch revealed that in some cases the actual descriptor was not
5! being passed to procedure dummy pointers.
6!
7! Contributed by Thomas Koenig  <tkoenig@netcologne.de>
8!
9module x
10  use iso_c_binding
11  implicit none
12  type foo
13     complex :: c
14     integer :: i
15  end type foo
16contains
17  subroutine printit(c, a)
18    complex, pointer, dimension(:) :: c
19    integer :: i
20    integer(kind=c_intptr_t) :: a
21    a = transfer(c_loc(c(2)),a)
22  end subroutine printit
23end module x
24
25program main
26  use x
27  use iso_c_binding
28  implicit none
29  type(foo), dimension(5), target :: a
30  integer :: i
31  complex, dimension(:), pointer :: pc
32  integer(kind=c_intptr_t) :: s1, s2, s3
33  a%i = 0
34  do i=1,5
35     a(i)%c = cmplx(i**2,i)
36  end do
37  pc => a%c
38  call printit(pc, s3)
39
40  s1 = transfer(c_loc(a(2)%c),s1)
41  if (s1 /= s3) STOP 1
42
43  s2 = transfer(c_loc(pc(2)),s2)
44  if (s2 /= s3) STOP 2
45
46end program main
47