gcc/testsuite/gfortran.dg/c_ptr_tests.f03

   1 ! { dg-do run }
   2 ! { dg-additional-sources c_ptr_tests_driver.c }
   3 module c_ptr_tests
   4   use, intrinsic :: iso_c_binding
   5
   6   ! TODO::
   7   ! in order to be associated with a C address,
   8   ! the derived type needs to be C interoperable,
   9   ! which requires bind(c) and all fields interoperable.
  10   type, bind(c) :: myType
  11      type(c_ptr) :: myServices
  12      type(c_funptr) :: mySetServices
  13      type(c_ptr) :: myPort
  14   end type myType
  15
  16   type, bind(c) :: f90Services
  17      integer(c_int) :: compId
  18      type(c_ptr) :: globalServices = c_null_ptr
  19   end type f90Services
  20
  21   contains
  22
  23     subroutine sub0(c_self, services) bind(c)
  24       use, intrinsic :: iso_c_binding
  25       implicit none
  26       type(c_ptr), value :: c_self, services
  27       type(myType), pointer :: self
  28       type(f90Services), pointer :: localServices
  29 !      type(c_ptr) :: my_cptr
  30       type(c_ptr), save :: my_cptr = c_null_ptr
  31
  32       call c_f_pointer(c_self, self)
  33       if(.not. associated(self)) then
  34          print *, 'self is not associated'
  35       end if
  36       self%myServices = services
  37
  38       ! c_null_ptr is defined in iso_c_binding
  39       my_cptr = c_null_ptr
  40
  41       ! get access to the local services obj from C
  42       call c_f_pointer(self%myServices, localServices)
  43     end subroutine sub0
  44 end module c_ptr_tests
  45
  46 ! { dg-final { cleanup-modules "c_ptr_tests" } }