gcc/testsuite/gfortran.dg/c_funloc_tests_4.f03

   1 ! { dg-do run }
   2 ! { dg-additional-sources c_funloc_tests_4_driver.c }
   3 ! Test that the inlined c_funloc works.
   4 module 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
  16 contains
  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
  38 end module c_funloc_tests_4