| ! { dg-do run } |
| ! { dg-additional-sources c_loc_tests_2_funcs.c } |
| module c_loc_tests_2 |
| use, intrinsic :: iso_c_binding |
| implicit none |
| |
| interface |
| function test_scalar_address(cptr) bind(c) |
| use, intrinsic :: iso_c_binding, only: c_ptr, c_int |
| type(c_ptr), value :: cptr |
| integer(c_int) :: test_scalar_address |
| end function test_scalar_address |
| |
| function test_array_address(cptr, num_elements) bind(c) |
| use, intrinsic :: iso_c_binding, only: c_ptr, c_int |
| type(c_ptr), value :: cptr |
| integer(c_int), value :: num_elements |
| integer(c_int) :: test_array_address |
| end function test_array_address |
| |
| function test_type_address(cptr) bind(c) |
| use, intrinsic :: iso_c_binding, only: c_ptr, c_int |
| type(c_ptr), value :: cptr |
| integer(c_int) :: test_type_address |
| end function test_type_address |
| end interface |
| |
| contains |
| subroutine test0() bind(c) |
| integer, target :: xtar |
| integer, pointer :: xptr |
| type(c_ptr) :: my_c_ptr_1 = c_null_ptr |
| type(c_ptr) :: my_c_ptr_2 = c_null_ptr |
| xtar = 100 |
| xptr => xtar |
| my_c_ptr_1 = c_loc(xtar) |
| my_c_ptr_2 = c_loc(xptr) |
| if(test_scalar_address(my_c_ptr_1) .ne. 1) then |
| STOP 1 |
| end if |
| if(test_scalar_address(my_c_ptr_2) .ne. 1) then |
| STOP 2 |
| end if |
| end subroutine test0 |
| |
| subroutine test1() bind(c) |
| integer(c_int), target, dimension(100) :: int_array_tar |
| type(c_ptr) :: my_c_ptr_1 = c_null_ptr |
| type(c_ptr) :: my_c_ptr_2 = c_null_ptr |
| |
| int_array_tar = 100_c_int |
| my_c_ptr_1 = c_loc(int_array_tar) |
| if(test_array_address(my_c_ptr_1, 100_c_int) .ne. 1) then |
| STOP 3 |
| end if |
| end subroutine test1 |
| |
| subroutine test2() bind(c) |
| type, bind(c) :: f90type |
| integer(c_int) :: i |
| real(c_double) :: x |
| end type f90type |
| type(f90type), target :: type_tar |
| type(f90type), pointer :: type_ptr |
| type(c_ptr) :: my_c_ptr_1 = c_null_ptr |
| type(c_ptr) :: my_c_ptr_2 = c_null_ptr |
| |
| type_ptr => type_tar |
| type_tar%i = 100 |
| type_tar%x = 1.0d0 |
| my_c_ptr_1 = c_loc(type_tar) |
| my_c_ptr_2 = c_loc(type_ptr) |
| if(test_type_address(my_c_ptr_1) .ne. 1) then |
| STOP 4 |
| end if |
| if(test_type_address(my_c_ptr_2) .ne. 1) then |
| STOP 5 |
| end if |
| end subroutine test2 |
| end module c_loc_tests_2 |
| |
| program driver |
| use c_loc_tests_2 |
| call test0() |
| call test1() |
| call test2() |
| end program driver |