Mercurial > hg > CbC > CbC_gcc
view gcc/testsuite/gfortran.dg/pointer_array_7.f90 @ 128:fe568345ddd5
fix CbC-example
author | mir3636 |
---|---|
date | Wed, 11 Apr 2018 19:32:28 +0900 |
parents | 04ced10e8804 |
children | 84e7813d76e9 |
line wrap: on
line source
! { 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) call abort s2 = transfer(c_loc(pc(2)),s2) if (s2 /= s3) call abort end program main