1! { dg-lto-do run } 2! This testcase tests c_funloc and c_funptr from iso_c_binding. It uses 3! functions defined in c_funloc_tests_3_funcs.c. 4module c_funloc_tests_3 5 implicit none 6contains 7 function ffunc(j) bind(c) 8 use iso_c_binding, only: c_funptr, c_int 9 integer(c_int) :: ffunc 10 integer(c_int), value :: j 11 ffunc = -17*j 12 end function ffunc 13end module c_funloc_tests_3 14program main 15 use iso_c_binding, only: c_funptr, c_funloc 16 use c_funloc_tests_3, only: ffunc 17 implicit none 18 interface 19 function returnFunc() bind(c,name="returnFunc") 20 use iso_c_binding, only: c_funptr 21 type(c_funptr) :: returnFunc 22 end function returnFunc 23 subroutine callFunc(func,pass,compare) bind(c,name="callFunc") 24 use iso_c_binding, only: c_funptr, c_int 25 type(c_funptr), value :: func 26 integer(c_int), value :: pass,compare 27 end subroutine callFunc 28 end interface 29 type(c_funptr) :: p 30 p = returnFunc() 31 call callFunc(p, 13,3*13) 32 p = c_funloc(ffunc) 33 call callFunc(p, 21,-17*21) 34end program main 35