gcc/testsuite/gfortran.dg/c_loc_tests_11.f03

   1 ! { dg-do compile }
   2 ! Test argument checking for C_LOC with subcomponent parameters.
   3 module c_vhandle_mod
   4   use iso_c_binding
   5
   6   type double_vector_item
   7     real(kind(1.d0)), allocatable :: v(:)
   8   end type double_vector_item
   9   type(double_vector_item), allocatable, target :: dbv_pool(:)
  10   real(kind(1.d0)), allocatable, target :: vv(:)
  11
  12   type foo
  13      integer :: i
  14   end type foo
  15   type foo_item
  16      type(foo), pointer  :: v => null()
  17   end type foo_item
  18   type(foo_item), allocatable :: foo_pool(:)
  19
  20   type foo_item2
  21      type(foo), pointer  :: v(:) => null()
  22   end type foo_item2
  23   type(foo_item2), allocatable :: foo_pool2(:)
  24
  25
  26 contains
  27
  28   type(c_ptr) function get_double_vector_address(handle)
  29     integer(c_int), intent(in) :: handle
  30
  31     if (.true.) then   ! The ultimate component is an allocatable target
  32       get_double_vector_address = c_loc(dbv_pool(handle)%v)
  33     else
  34       get_double_vector_address = c_loc(vv)
  35     endif
  36
  37   end function get_double_vector_address
  38
  39
  40   type(c_ptr) function get_foo_address(handle)
  41     integer(c_int), intent(in) :: handle
  42     get_foo_address = c_loc(foo_pool(handle)%v)
  43
  44     get_foo_address = c_loc(foo_pool2(handle)%v) ! { dg-error "must be a scalar" }
  45   end function get_foo_address
  46
  47
  48 end module c_vhandle_mod
  49