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