Mercurial > hg > CbC > CbC_gcc
comparison gcc/testsuite/gfortran.dg/c_loc_tests_11.f03 @ 111:04ced10e8804
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 |