Mercurial > hg > CbC > CbC_gcc

comparison gcc/testsuite/gfortran.dg/c_loc_tests_11.f03 @ 111:04ced10e8804

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
gcc 7
author kono
date Fri, 27 Oct 2017 22:46:09 +0900
parents
children 84e7813d76e9
comparison
equal deleted inserted replaced
68:561a7518be6b 111:04ced10e8804
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