Fortran子例程留给用户

Question

我正在尝试以一种面向对象的方式来实现一种类型，该类型可以实现所有功能，但用户应实现的功能除外。

假设我有两个具有类型的模块，一个animal和一个扩展cat的animal。现在，我想实现一种将自定义过程传递给任何动物的方法。我不知道实现这种功能的最佳方法是什么。现在，我已经成功让所有cat对象都有一个函数调用程序，该函数调用程序将子例程作为参数，但是仅当类型是显式时，换句话说，如果类型不是animal，然后在运行时创建一个cat：

动物

module animal_module
    implicit none

    type, abstract :: animal
        private
        integer, public :: nlegs = -1
    contains
        procedure :: legs
        procedure :: speak
    end type animal

    interface animal
        module procedure init_animal
    end interface animal

contains

    type(animal) function init_animal(this)
        class(animal), intent(inout) :: this
        print *, "Animal!"
        this%nlegs = -4
    end function init_animal

    function legs(this) result(n)
        class(animal), intent(in) :: this
        integer :: n
        n = this%nlegs
    end function legs

    subroutine speak(this, ntimes)
        class(animal), intent(in) :: this
        integer, intent(in) :: ntimes
        integer :: i

        do i = 1, ntimes
            print *, "generic animal :: speak"
        end do
    end subroutine speak

end module animal_module

cat

module cat_module
    use animal_module, only : animal
    implicit none

    type, extends(animal) :: cat
        private
        real :: hidden = 23.
    contains
        ! something like this? maybe a pointer?
        procedure :: caller
        procedure :: speak
    end type cat

    interface cat
        module procedure init_cat
    end interface cat

    abstract interface
        subroutine sub_interface
        end subroutine
    end interface

contains

    type(cat) function init_cat()
        print *, "Cat!"
        init_cat%nlegs = 4
    end function init_cat

    subroutine caller(this, sub)
        class(cat), intent(inout) :: this
        procedure(sub_interface) :: sub

        print *, "caller begin", this%nlegs
        call sub()
        print *, "caller ended", this%nlegs
    end subroutine caller

    subroutine speak(this, ntimes)
        class(cat), intent(in) :: this
        integer, intent(in) :: ntimes
        integer :: i

        do i = 1, ntimes
            print *, "cat :: meow"
        end do
    end subroutine speak

end module cat_module

主程序

subroutine ahoy
    print *, "ahoy"
end subroutine ahoy

program oo
    use animal_module
    use cat_module
    use bee_module
    implicit none

    class(animal), allocatable :: q
    procedure(sub_interface) :: ahoy
    class(cat), allocatable :: p

    ! THIS WON'T WORK
    allocate(cat :: q)
    q = cat()
    call q%caller(ahoy)

    ! no problem with this
    allocate(cat :: p)
    p = cat()
    call p%caller(ahoy)
end program

我从caller调用animal时遇到的错误是

/oo/main.F90(28): error #6460: This is not a field name that is defined in the encompassing structure.   [CALLER]
    call q%caller(ahoy)
-----------^

据我所知，这应该是正常的：由于animal没有任何线索，cat包含caller，因此它将不起作用。我说的对吗？

我如何让用户实现将由caller函数调用的子例程？所调用的函数应该有权访问类型，用户提供的函数应该能够修改hidden对象中的cat整数。

Answer 1

一种方法可能是定义接收ahoy()的animal_t，然后在该例程中使用select type访问动态类型的所需组件。修改后的代码可能看起来像这样...

animal.f90

module animal_mod
    implicit none

    type, abstract :: animal_t
    contains
        procedure :: caller
        procedure :: show
    end type

    abstract interface
        subroutine sub_interface( ani )
            import
            class(animal_t) :: ani
        end
    end interface

contains

    subroutine caller( this, sub )
        class(animal_t) :: this
        procedure(sub_interface) :: sub

        print *, "animal: caller()"
        call sub( this )
    end

    subroutine show( this )
        class(animal_t) :: this
    end
end

cat.f90

module cat_mod
    use animal_mod, only: animal_t
    implicit none

    type, extends(animal_t) :: cat_t
        real :: sleep = 0    !! hours/day
    contains
        procedure :: show    !! override
    end type

contains
    subroutine show( this )
        class(cat_t) :: this
        print *, "cat: sleep = ", this% sleep
    end
end

dog.f90

module dog_mod
    use animal_mod, only: animal_t
    implicit none

    type, extends(animal_t) :: dog_t
        real :: speed = 0    !! km/h
    contains
        procedure :: show    !! override
    end type

contains
    subroutine show( this )
        class(dog_t) :: this
        print *, "dog: speed = ", this% speed
    end
end

user.f90

module user_mod
    use animal_mod, only: animal_t
    use cat_mod,    only: cat_t
    use dog_mod,    only: dog_t
    implicit none
contains

    subroutine ahoy( chip )
        class(animal_t) :: chip
        print *, "ahoy():"

        select type ( chip )
        type is ( cat_t )
            chip% sleep = 23

        type is ( dog_t )
            chip% speed = 345
        endselect
    end
end

main.f90

program main
    use user_mod, only: animal_t, cat_t, dog_t, ahoy
    implicit none
    class(animal_t), allocatable :: a1, a2

    print *, "[ a1 ]"
    a1 = cat_t()   !! or allocate( a1, source=cat_t() ) for old compilers

    call a1 % show()
    call a1 % caller( ahoy )
    call a1 % show()

    print *, "[ a2 ]"
    a2 = dog_t()

    call a2 % show()
    call a2 % caller( ahoy )
    call a2 % show()
end

编译和结果

$ gfortran animal.f90 cat.f90 dog.f90 user.f90 main.f90   # using GCC 8 or 9
$ ./a.out
 [ a1 ]
 cat: sleep =    0.00000000    
 animal: caller()
 ahoy():
 cat: sleep =    23.0000000    
 [ a2 ]
 dog: speed =    0.00000000    
 animal: caller()
 ahoy():
 dog: speed =    345.000000