Fortran2003：指向函数的过程指针，返回指向多态类型的指针

Question

对于新项目，我正在考虑使用Fortran2003的面向对象功能。我尝试过的一件事涉及一个指向函数（而不是子例程）的过程指针，它返回一个指向多态类型的指针。我不知道这样的构造是否合法，因为我得到不同编译器的混合结果（见下文）。

作为一个具体的例子，考虑下面的函数接口：

abstract interface 
    function if_new_test(lbls) result(t) 
     import :: test_t 
     class(test_t),pointer  :: t 
     character(len=*),intent(in) :: lbls(:) 
    end function if_new_test 
end interface 

而且使用的代码应该有一个过程的指针可以指向函数与此接口：

procedure(if_new_test),pointer :: nt 

我询问这是否合法，因为gfortran（4.7.2）抱怨此程序指针声明与消息：

Error: CLASS variable 'nt' at (1) must be dummy, allocatable or pointer

我不明白这个错误信息，因为nt本身就是一个指针，它指向的函数返回的也是一个指针。

仅供参考，示例的完整源代码如下。拳头，含有我的派生类型，接口和功能/子程序模块：

module test_m 

    implicit none 

    type :: test_t 
     character(len=10) :: label 
     contains 
     procedure :: print => print_test 
    end type test_t 

    type,extends(test_t) :: test2_t 
     character(len=10) :: label2 
     contains 
     procedure :: print => print_test2 
    end type test2_t 

    abstract interface 
     function if_new_test(lbls) result(t) 
     import :: test_t 
     class(test_t),pointer  :: t 
     character(len=*),intent(in) :: lbls(:) 
     end function if_new_test 
     subroutine if_make_test(t,lbls) 
     import :: test_t 
     class(test_t),pointer  :: t 
     character(len=*),intent(in) :: lbls(:) 
     end subroutine if_make_test 
    end interface 

    contains 

    subroutine print_test(self) 
     implicit none 
     class(test_t),intent(in) :: self 
     print *, self%label 
    end subroutine print_test 

    subroutine print_test2(self) 
     implicit none 
     class(test2_t),intent(in) :: self 
     print *, self%label, self%label2 
    end subroutine print_test2 

    function new_test(lbls) result(t) 
     implicit none 
     class(test_t),pointer  :: t 
     character(len=*),intent(in) :: lbls(:) 
     call make_test(t,lbls) 
    end function new_test 

    function new_test2(lbls) result(t) 
     implicit none 
     class(test_t),pointer  :: t 
     character(len=*),intent(in) :: lbls(:) 
     call make_test2(t,lbls) 
    end function new_test2 

    subroutine make_test(t,lbls) 
     implicit none 
     class(test_t),pointer  :: t 
     character(len=*),intent(in) :: lbls(:) 
     allocate(test_t::t) 
     t%label = lbls(1) 
    end subroutine make_test 

    subroutine make_test2(t,lbls) 
     implicit none 
     class(test_t),pointer  :: t 
     character(len=*),intent(in) :: lbls(:) 
     allocate(test2_t::t) 
     select type(t) ! so the compiler knows the actual type 
     type is(test2_t) 
      t%label = lbls(1) 
      t%label2 = lbls(2) 
     class default 
      stop 1 
     end select 
    end subroutine make_test2 

end module test_m 

并使用该模块的主要程序：通过子程序make_test和make_test2

program test 

    use test_m 
    implicit none 

    class(test_t),pointer   :: p 
    procedure(if_make_test),pointer :: mt 
    procedure(if_new_test),pointer :: nt 

    mt => make_test 
    call mt(p,["foo"]) 
    call p%print 
    deallocate(p) 

    mt => make_test2 
    call mt(p,["bar","baz"]) 
    call p%print 
    deallocate(p) 

    p => new_test(["foo"]) 
    call p%print 
    deallocate(p) 

    p => new_test2(["bar","baz"]) 
    call p%print 
    deallocate(p) 

    nt => new_test 
    p => nt(["foo"]) 
    call p%print 
    deallocate(p) 

    nt => new_test2 
    p => nt(["bar","baz"]) 
    call p%print 
    deallocate(p) 

end program test 

该程序首先创建对象，并在我的测试中，这与我尝试过的所有编译器一起工作。接下来，通过直接调用函数new_test和new_test2来创建对象，这也适用于我的测试。最后，应该再次通过这些函数创建对象，但通过过程指针nt间接创建对象。

如上所述，gfortran（4.7.2）不编译nt的声明。

ifort（12.0.4.191）在行nt => new_test上产生内部编译器错误。

pgfortran（12.9）在没有警告的情况下编译，并且可执行文件产生预期的结果。

那么，我试图根据Fortran2003做非法，还是编译器支持这些功能仍然不足？我应该使用子程序而不是函数（因为这似乎工作）？

Answer 1

你的代码似乎很好。我可以在没有任何问题的情况下使用Intel 13.0.1和NAG 5.3.1进行编译。较旧的编译器可能在Fortran 2003的“花哨”功能方面存在问题。

根据问题，还可以使用可分配类型而不是指针。应该更多的内存，防漏，在另一方面，你将无法返回多态的类型作为函数的结果：

module test_m 
    implicit none 

    type :: test_t 
    character(len=10) :: label 
    contains 
    procedure :: print => print_test 
    end type test_t 

    type,extends(test_t) :: test2_t 
    character(len=10) :: label2 
    contains 
    procedure :: print => print_test2 
    end type test2_t 

    abstract interface 
    function if_new_test(lbls) result(t) 
     import :: test_t 
     class(test_t), allocatable :: t 
     character(len=*),intent(in) :: lbls(:) 
    end function if_new_test 

    subroutine if_make_test(t,lbls) 
     import :: test_t 
     class(test_t), allocatable :: t 
     character(len=*),intent(in) :: lbls(:) 
    end subroutine if_make_test 
    end interface 

contains 

    subroutine print_test(self) 
    class(test_t), intent(in) :: self 
    print *, self%label 
    end subroutine print_test 

    subroutine print_test2(self) 
    class(test2_t), intent(in) :: self 
    print *, self%label, self%label2 
    end subroutine print_test2 

    subroutine make_test(t,lbls) 
    class(test_t), allocatable :: t 
    character(len=*),intent(in) :: lbls(:) 
    allocate(test_t::t) 
    t%label = lbls(1) 
    end subroutine make_test 

    subroutine make_test2(t,lbls) 
    class(test_t), allocatable :: t 
    character(len=*),intent(in) :: lbls(:) 
    allocate(test2_t::t) 
    select type(t) ! so the compiler knows the actual type 
    type is(test2_t) 
     t%label = lbls(1) 
     t%label2 = lbls(2) 
    class default 
     stop 1 
    end select 
    end subroutine make_test2 

end module test_m 


program test 
    use test_m 
    implicit none 

    class(test_t), allocatable :: p 
    procedure(if_make_test), pointer :: mt 

    mt => make_test 
    call mt(p, ["foo"]) 
    call p%print 
    deallocate(p) 

    mt => make_test2 
    call mt(p, ["bar","baz"]) 
    call p%print 
    deallocate(p) 

end program test 

还有一个备注：在模块级隐含没有声明是由模块过程“继承”的，所以您不必在每个子程序中额外发布它。