summaryrefslogtreecommitdiff
path: root/gcc/testsuite/gfortran.dg/c_loc_tests_2.f03
diff options
context:
space:
mode:
Diffstat (limited to 'gcc/testsuite/gfortran.dg/c_loc_tests_2.f03')
-rw-r--r--gcc/testsuite/gfortran.dg/c_loc_tests_2.f0388
1 files changed, 88 insertions, 0 deletions
diff --git a/gcc/testsuite/gfortran.dg/c_loc_tests_2.f03 b/gcc/testsuite/gfortran.dg/c_loc_tests_2.f03
new file mode 100644
index 000000000..4bdf395d1
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/c_loc_tests_2.f03
@@ -0,0 +1,88 @@
+! { 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
+ call abort()
+ end if
+ if(test_scalar_address(my_c_ptr_2) .ne. 1) then
+ call abort()
+ end if
+ end subroutine test0
+
+ subroutine test1() bind(c)
+ integer, 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
+ my_c_ptr_1 = c_loc(int_array_tar)
+ if(test_array_address(my_c_ptr_1, 100) .ne. 1) then
+ call abort()
+ 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
+ call abort()
+ end if
+ if(test_type_address(my_c_ptr_2) .ne. 1) then
+ call abort()
+ 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
+! { dg-final { cleanup-modules "c_loc_tests_2" } }