1! { dg-do compile } 2! 3! PR fortran/37829 4! 5! Contributed by James Van Buskirk and Jerry DeLisle. 6! 7! Fix derived-type loading with ISO_BIND_C's C_PTR/C_FUNPTR. 8 9module m3 10 use ISO_C_BINDING 11 implicit none 12 private 13 14 public kill_C_PTR 15 interface 16 function kill_C_PTR() bind(C) 17 import 18 implicit none 19 type(C_PTR) kill_C_PTR 20 end function kill_C_PTR 21 end interface 22 23 public kill_C_FUNPTR 24 interface 25 function kill_C_FUNPTR() bind(C) 26 import 27 implicit none 28 type(C_FUNPTR) kill_C_FUNPTR 29 end function kill_C_FUNPTR 30 end interface 31end module m3 32 33module m1 34 use m3 35end module m1 36 37program X 38 use m1 39 use ISO_C_BINDING 40 implicit none 41 type(C_PTR) cp 42 type(C_FUNPTR) fp 43 integer(C_INT),target :: i 44 interface 45 function fun() bind(C) 46 use ISO_C_BINDING 47 implicit none 48 real(C_FLOAT) fun 49 end function fun 50 end interface 51 52 cp = C_NULL_PTR 53 cp = C_LOC(i) 54 fp = C_NULL_FUNPTR 55 fp = C_FUNLOC(fun) 56end program X 57 58function fun() bind(C) 59 use ISO_C_BINDING 60 implicit none 61 real(C_FLOAT) fun 62 fun = 1.0 63end function fun 64 65function kill_C_PTR() bind(C) 66 use ISO_C_BINDING 67 implicit none 68 type(C_PTR) kill_C_PTR 69 integer(C_INT), pointer :: p 70 allocate(p) 71 kill_C_PTR = C_LOC(p) 72end function kill_C_PTR 73 74function kill_C_FUNPTR() bind(C) 75 use ISO_C_BINDING 76 implicit none 77 type(C_FUNPTR) kill_C_FUNPTR 78 interface 79 function fun() bind(C) 80 use ISO_C_BINDING 81 implicit none 82 real(C_FLOAT) fun 83 end function fun 84 end interface 85 kill_C_FUNPTR = C_FUNLOC(fun) 86end function kill_C_FUNPTR 87