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 

還有一個備註：在模塊級隱含沒有聲明是由模塊過程「繼承」的，所以您不必在每個子程序中額外發布它。