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