gcc/testsuite/gfortran.dg/c_loc_tests_11.f03

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