gcc/testsuite/gfortran.dg/c_f_pointer_tests.f90

   1 ! { dg-do run }
   2 ! { dg-additional-sources c_f_tests_driver.c }
   3 module 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
  68 end module c_f_pointer_tests