1! { dg-do run } 2! { dg-additional-sources c_funloc_tests_4_driver.c } 3! Test that the inlined c_funloc works. 4module c_funloc_tests_4 5 use, intrinsic :: iso_c_binding, only: c_funloc, c_funptr 6 interface 7 subroutine c_sub0(fsub_ptr) bind(c) 8 use, intrinsic :: iso_c_binding, only: c_funptr 9 type(c_funptr), value :: fsub_ptr 10 end subroutine c_sub0 11 subroutine c_sub1(ffunc_ptr) bind(c) 12 use, intrinsic :: iso_c_binding, only: c_funptr 13 type(c_funptr), value :: ffunc_ptr 14 end subroutine c_sub1 15 end interface 16contains 17 subroutine sub0() bind(c) 18 type(c_funptr) :: my_c_funptr 19 20 my_c_funptr = c_funloc(sub1) 21 call c_sub0(my_c_funptr) 22 23 my_c_funptr = c_funloc(func0) 24 call c_sub1(my_c_funptr) 25 end subroutine sub0 26 27 subroutine sub1() bind(c) 28 print *, 'hello from sub1' 29 end subroutine sub1 30 31 function func0(desired_retval) bind(c) 32 use, intrinsic :: iso_c_binding, only: c_int 33 integer(c_int), value :: desired_retval 34 integer(c_int) :: func0 35 print *, 'hello from func0' 36 func0 = desired_retval 37 end function func0 38end module c_funloc_tests_4 39