Question

I am modifying fgsl so I can pass a function pointer instead of the name of a function. To do this I use a Fortran bind(c) function, call c_funloc, call the C function and assign that to a derived type(c_ptr). However, the C code gives me segfaults depending on how I implement the code.

C Code:

#include <stdio.h>
#include <stdlib.h>
struct function_struct 
{
  double (* function) (double x);
};

typedef struct function_struct gsl_function;

gsl_function *function_cinit(double (*func)(double x)) {

    gsl_function *result;

     if (func) {
      printf("Passed Function Not Null\n");
    }

    printf("The size of gsl_function is %zu\n", sizeof(gsl_function));
    result = (gsl_function *) malloc(sizeof(gsl_function));
    result->function = func;

    printf("Res: %f\n", (*func)(2.0));

    if (result) {
      printf("Result Not Null\n");
    }

    return result;
}

Now my main program/module:

module integral
  use, intrinsic :: iso_c_binding
  implicit none

  !Interface to call C function
  interface
     function function_cinit(func) bind(c)
       import
       type(c_funptr), value :: func
       type(c_ptr) :: function_cinit
     end function function_cinit
  end interface

 !Proc pointer interface for arbitrary math function f(x) which is passed to the C function so it can be used in a library that requires
 ! a pointer to a function
  abstract interface
     function rhox(r) bind(c)
       use, intrinsic :: iso_c_binding
       real(c_double), value :: r
       real(c_double) :: rhox
     end function rhox
  end interface

contains
  ! Arbitary function f(x) = x
  function f(x) bind(c)
    use, intrinsic :: iso_c_binding
    real(c_double) :: f
    real(c_double), value :: x
    f = x
  end function f

 !Function passed by name
  function func_init(func)
    interface
       function func(x) bind(c)
         use, intrinsic :: iso_c_binding
         real(c_double), value :: x
         real(c_double) :: func
       end function func
    end interface

    type(c_ptr) :: func_init
    type(c_funptr) :: fp

    fp = c_funloc(func)
    func_init = function_cinit(fp)
  end function func_init

  !Function passed with procedure pointer
  function fp_init(fun)
    procedure(rhox), pointer :: fun
    type(c_ptr) :: fp_init
    type(c_funptr) :: fp

    fp = c_funloc(fun)

    call c_f_procpointer(fp, fun)

    fp_init = function_cinit(fp)
  end function fp_init

  !C_funptr passed directly
  function cfun_ptr_init(fun)
    type(c_funptr) :: fun
    type(c_ptr) cfun_ptr_init

    cfun_ptr_init = function_cinit(fun)
  end function cfun_ptr_init


end module integral


program bsp
  use integral
  use, intrinsic :: iso_c_binding
  implicit none

  procedure(rhox), pointer :: fptr
  type(c_funptr) :: cptr
  type(c_ptr) :: c_result

  fptr => f

  cptr = c_funloc(fptr)


  call c_f_procpointer(cptr, fptr)

  !This works, calling the cptr after calling c_f_procpointer on c_funptr obtained by using c_funloc
  print *, "Evaluate C Function: ", fptr(2.0_c_double)
  print *, ""

  !This Works f(2.0) = 2.0, valid pointer
  c_result = func_init(f)
  print *,"Passing Function Directly Successful"
  print *, " "

  !This works, calling C function directly from main program passing it the c_funloc of the procedure8
  c_result = function_cinit(cptr)
  print *,"Calling C Function  Directly Successful"
  print *, " "

  c_result = cfun_ptr_init(cptr)
  print *,"Calling C function by Passing c_funptr Successful"
  print *, " "

  !Segmentation Fault 11, calling C function indirectly from function which I pass the Fortran Proc pointer
  c_result = fp_init(fptr)

end program bsp
Was it helpful?

Solution

Found the answer! Turns out I didn't have to change a thing to allow the code to accept procedure pointers.

!Function passed with procedure pointer
  function fp_init(fun)
    !Changed from:
    !procedure(rhox), pointer :: fun
    procedure(rhox):: fun
    type(c_ptr) :: fp_init
    type(c_funptr) :: fp

    fp = c_funloc(fun)

    call c_f_procpointer(fp, fun)

    fp_init = function_cinit(fp)
  end function fp_init

I removed the "pointer" attribute from the dummy argument and now it works. I'm not sure why though.

Licensed under: CC-BY-SA with attribution
Not affiliated with StackOverflow
scroll top