1! { dg-do run } 2! { dg-additional-sources test_c_assoc.c } 3module c_assoc 4 use, intrinsic :: iso_c_binding 5 implicit none 6 7contains 8 9 function test_c_assoc_0(my_c_ptr) bind(c) 10 use, intrinsic :: iso_c_binding, only: c_ptr, c_int, c_associated 11 integer(c_int) :: test_c_assoc_0 12 type(c_ptr), value :: my_c_ptr 13 14 if(c_associated(my_c_ptr)) then 15 test_c_assoc_0 = 1 16 else 17 test_c_assoc_0 = 0 18 endif 19 end function test_c_assoc_0 20 21 function test_c_assoc_1(my_c_ptr_1, my_c_ptr_2) bind(c) 22 use, intrinsic :: iso_c_binding, only: c_ptr, c_int, c_associated 23 integer(c_int) :: test_c_assoc_1 24 type(c_ptr), value :: my_c_ptr_1 25 type(c_ptr), value :: my_c_ptr_2 26 27 if(c_associated(my_c_ptr_1, my_c_ptr_2)) then 28 test_c_assoc_1 = 1 29 else 30 test_c_assoc_1 = 0 31 endif 32 end function test_c_assoc_1 33 34 function test_c_assoc_2(my_c_ptr_1, my_c_ptr_2, num_ptrs) bind(c) 35 integer(c_int) :: test_c_assoc_2 36 type(c_ptr), value :: my_c_ptr_1 37 type(c_ptr), value :: my_c_ptr_2 38 integer(c_int), value :: num_ptrs 39 40 if(num_ptrs .eq. 1) then 41 if(c_associated(my_c_ptr_1)) then 42 test_c_assoc_2 = 1 43 else 44 test_c_assoc_2 = 0 45 endif 46 else 47 if(c_associated(my_c_ptr_1, my_c_ptr_2)) then 48 test_c_assoc_2 = 1 49 else 50 test_c_assoc_2 = 0 51 endif 52 endif 53 end function test_c_assoc_2 54 55 subroutine verify_assoc(my_c_ptr_1, my_c_ptr_2) bind(c) 56 type(c_ptr), value :: my_c_ptr_1 57 type(c_ptr), value :: my_c_ptr_2 58 59 if(.not. c_associated(my_c_ptr_1)) then 60 STOP 1 61 else if(.not. c_associated(my_c_ptr_2)) then 62 STOP 2 63 else if(.not. c_associated(my_c_ptr_1, my_c_ptr_2)) then 64 STOP 3 65 endif 66 end subroutine verify_assoc 67 68end module c_assoc 69