Nopass procedure pointer passed between derived types causes Segmentation fault

Question

I want to pass a procedure pointer between two classes in modern Fortran. this procedure pointer should

1. be called from within the second object
2. access the first ojects' components, without having it as dummy argument.

A clear example is here, imagine doing an object-oriented wrapper of an ODE solver:

module test_funptr
    implicit none
    public

    type, public :: ode_solver
        integer :: NEQ = 0
        procedure(ode_api), pointer, nopass :: f => null()
    contains
        procedure :: run
    end type ode_solver

    type, public :: ode_problem
        integer :: NEQ = 10
        procedure(ode_api), pointer, nopass :: yprime => null()
    contains
        procedure :: init
    end type ode_problem

    abstract interface
        subroutine ode_api(NEQ,YDOT)
            integer, intent(in) :: NEQ
            real(8), intent(inout) :: YDOT(NEQ)
        end subroutine ode_api
    end interface
contains
    ! Initialize problem variables
    subroutine init(this,NEQ)
        class(ode_problem), intent(inout) :: this
        integer, intent(in) :: NEQ

        ! Associate function pointer
        this%yprime => problem_api
    contains
        ! nopass ODE solver API
        subroutine problem_api(NEQ,YDOT)
            integer, intent(in) :: NEQ
            real(8), intent(inout) :: YDOT(NEQ)

            integer :: i

            print *, 'entered problem API with NEQ=',NEQ
            forall(i=1:NEQ) YDOT(i) = real(i,8)
        end subroutine
    end subroutine init

    subroutine run(this)
        class(ode_solver), intent(inout) :: this

        real(8) :: ydot(this%neq)

        ydot = 0.0

        print *, 'enter solver run with NEQ=',this%NEQ
        print *, 'is function associated? ',associated(this%f)

        call this%f(this%neq,ydot)
    end subroutine run
end module test_funptr

program test
    use test_funptr

    type(ode_solver) :: solver
    type(ode_problem) :: prob

    call prob%init(10)

    ! Associate ode solver
    solver%neq = prob%NEQ
    solver%f => prob%yprime

    call solver%run()
end program test

This program returns with gfortran-10:

 enter solver run with NEQ=          10
 is function associated?  T

Program received signal SIGILL: Illegal instruction.

The procedure seems properly associated, but it can't be called. Am I doing something wrong passing the procedure pointers, or I'm doing something out-of-standard? I'm concerned the contained subroutine may go out of scope, but if so, how can I achieve this behavior?

The tricky part is of course that the function should access data from the other variable instance.

Answer 1

As pointed out, internal (contained) procedures are not the way to go, as they cannot be targets to procedure pointers. Hopefully this will be catched by the compilers.

I've figured out an elegant way to accomplish the aim to pass an interfaced procedure between two classes this way:

1. class 1 needs to call that function: it must contain a pointer to class 2

• The nopass function should be inside this class, as an internal procedure (this way, it'll never go out of scope)
• This class must contain a (polymorphic) pointer to the instantiated object from class 2

2. class 2 contains the actual implementation, it should instantiate an abstract type that contains the same interfaced function, but with the derived type as dummy argument

Here I'm providing an implementation that works:

module odes 
    implicit none

    type, abstract, public :: ode_problem
           integer :: NEQ
       contains
           procedure(ode_api), deferred :: fun
    end type ode_problem

    type, public :: ode_solver
         integer :: NEQ
         class(ode_problem), pointer :: problem => null()
         contains
             procedure :: init
             procedure :: run
    end type ode_solver

    abstract interface
       subroutine ode_api(this,YDOT)
           import ode_problem
           class(ode_problem), intent(inout) :: this
           real(8), intent(out) :: YDOT(this%NEQ)
       end subroutine ode_api
    end interface

    contains

    ! Associate problem to ODE solver
    subroutine init(this,my_problem)
        class(ode_solver), intent(inout) :: this
        class(ode_problem), intent(in), target :: my_problem

        this%neq = my_problem%NEQ
        this%problem => my_problem

    end subroutine init

    ! call the nopass f77 interface function
    subroutine run(this)
       class(ode_solver), intent(inout) :: this
       real(8) :: YDOT(this%NEQ)
       integer :: i 

       if (.not.associated(this%problem)) stop 'solver not associated to a problem'

       ! This will be in general passed to another function as an argument 
       call ode_f77_api(this%NEQ,YDOT)

       contains

         subroutine ode_f77_api(NEQ,YDOT)
             integer, intent(in) :: NEQ
             real(8), intent(out) :: YDOT(NEQ)

             ! This is just a nopass interface to this problem's function that can
             ! access internal storage
             call this%problem%fun(YDOT)
         end subroutine ode_f77_api

    end subroutine run    

end module odes

! Provide an actual implementation
module my_ode_problem
   use odes
   implicit none

        type, public, extends(ode_problem) :: exp_kinetics
            real(8) :: k = -0.5d0
            contains
               procedure :: fun => exp_fun
        end type exp_kinetics

   contains

        subroutine exp_fun(this,YDOT) 
            class(exp_kinetics), intent(inout) :: this
            real(8), intent(out) :: YDOT(this%NEQ)
            integer :: i

            forall(I=1:this%NEQ) YDOT(i) = this%k*real(i,8)
            print 1, this%NEQ,(i,YDOT(i),i=1,this%NEQ)

            1 format('test fun! N=',i0,': ',*(/,10x,' ydot(',i0,')=',f5.2,:))

        end subroutine exp_fun

end module my_ode_problem

program test_fun_nopass
        use odes
        use my_ode_problem
        implicit none

        type(exp_kinetics) :: prob
        type(ode_solver) :: ode

        prob%NEQ = 10
        call ode%init(prob)

        call ode%run()

        stop 'success!'
end program test_fun_nopass          

This program returns:

test fun! N=10: 
           ydot(1)=-0.50
           ydot(2)=-1.00
           ydot(3)=-1.50
           ydot(4)=-2.00
           ydot(5)=-2.50
           ydot(6)=-3.00
           ydot(7)=-3.50
           ydot(8)=-4.00
           ydot(9)=-4.50
           ydot(10)=-5.00
STOP success!

Answer 2

It is illegal to invoke a procedure pointer to an internal procedure, after the host procedure gets out of scope.

The draft of Fortran 2015 N2123 mentions this in NOTE 15.17

NOTE 15.17
An internal procedure cannot be invoked using a procedure pointer from either Fortran or C after the host instance completes execution, because the pointer is then undefined. While the host instance is active, however, if an internal procedure was passed as an actual argument or is the target of a procedure pointer, it could be invoked from outside of the host subprogram.

... an example follows

Often, internal procedures are implemented using trampolines. That is, a piece of executable code placed on the stack, that enables accessing the local scope and calls the procedure itself. The pointer is then a pointer to the trampoline. Once the host function gets out of scope, the pointer to the stack is invalid.