|
111
|
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
|
