指针 – Fortran2003:指向函数的过程指针,返回指向多态类型的指针

对于一个新项目,我正在考虑使用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本身就是一个指针,它指向返回的函数也是一个指针.

作为参考,下面是该示例的完整源代码. Fist,包含我的派生类型,接口和函数/子例程的模块:

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

以及使用此模块的主程序:

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

程序首先通过子程序make_test和make_test2创建对象,在我的测试中,这适用于我尝试过的所有编译器.接下来,通过直接调用函数new_test和new_test2来创建对象,这也可以在我的测试中使用.最后,应该通过这些函数再次创建对象,但是通过过程指针nt间接创建.

如上所述,gfortran(4.7.2)不编译nt的声明.

ifort(12.0.4.191)在行nt =>上产生内部编译器错误new_test.

pgfortran(12.9)在没有警告的情况下编译,可执行文件产生预期的结果.

那么,根据Fortran2003,我正在尝试做什么非法,或者这些功能的编译器支持仍然不足?我应该只使用子程序而不是函数(因为这似乎工作)?

最佳答案
你的代码似乎没问题.我可以用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

还有一点说明:模块级别的隐式none语句是由模块过程“继承”的,因此您不必在每个子例程中发出它.

转载注明原文:指针 – Fortran2003:指向函数的过程指针,返回指向多态类型的指针 - 代码日志