1! { dg-do run } 2! { dg-additional-sources c_f_tests_driver.c } 3module c_f_pointer_tests 4 use, intrinsic :: iso_c_binding 5 6 type myF90Derived 7 integer(c_int) :: cInt 8 real(c_double) :: cDouble 9 real(c_float) :: cFloat 10 integer(c_short) :: cShort 11 type(c_funptr) :: myFunPtr 12 end type myF90Derived 13 14 type dummyDerived 15 integer(c_int) :: myInt 16 end type dummyDerived 17 18 contains 19 20 subroutine testDerivedPtrs(myCDerived, derivedArray, arrayLen, & 21 derived2DArray, dim1, dim2) & 22 bind(c, name="testDerivedPtrs") 23 implicit none 24 type(c_ptr), value :: myCDerived 25 type(c_ptr), value :: derivedArray 26 integer(c_int), value :: arrayLen 27 type(c_ptr), value :: derived2DArray 28 integer(c_int), value :: dim1 29 integer(c_int), value :: dim2 30 type(myF90Derived), pointer :: myF90Type 31 type(myF90Derived), dimension(:), pointer :: myF90DerivedArray 32 type(myF90Derived), dimension(:,:), pointer :: derivedArray2D 33 ! one dimensional array coming in (derivedArray) 34 integer(c_int), dimension(1:1) :: shapeArray 35 integer(c_int), dimension(1:2) :: shapeArray2 36 type(myF90Derived), dimension(1:10), target :: tmpArray 37 38 call c_f_pointer(myCDerived, myF90Type) 39 ! make sure numbers are ok. initialized in c_f_tests_driver.c 40 if(myF90Type%cInt .ne. 1) then 41 call abort() 42 endif 43 if(myF90Type%cDouble .ne. 2.0d0) then 44 call abort() 45 endif 46 if(myF90Type%cFloat .ne. 3.0) then 47 call abort() 48 endif 49 if(myF90Type%cShort .ne. 4) then 50 call abort() 51 endif 52 53 shapeArray(1) = arrayLen 54 call c_f_pointer(derivedArray, myF90DerivedArray, shapeArray) 55 56 ! upper bound of each dim is arrayLen2 57 shapeArray2(1) = dim1 58 shapeArray2(2) = dim2 59 call c_f_pointer(derived2DArray, derivedArray2D, shapeArray2) 60 ! make sure the last element is ok 61 if((derivedArray2D(dim1, dim2)%cInt .ne. 4) .or. & 62 (derivedArray2D(dim1, dim2)%cDouble .ne. 4.0d0) .or. & 63 (derivedArray2D(dim1, dim2)%cFloat .ne. 4.0) .or. & 64 (derivedArray2D(dim1, dim2)%cShort .ne. 4)) then 65 call abort() 66 endif 67 end subroutine testDerivedPtrs 68end module c_f_pointer_tests 69