Fortran2003: procedure pointer to a function returning a pointer to a polymorphic type

Question

For a new project, I am considering using the object-oriented features of Fortran2003. One thing I tried involves a procedure pointer which points to a function (not subroutine) which returns a pointer to a polymorphic type. I wonder if such a construct is legal, as I get mixed results from different compilers (see below).

As a specific example, consider the following function interface:

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

And the using code should have a procedure pointer that can point to functions with this interface:

procedure(if_new_test),pointer :: nt

I'm asking whether this is legal because gfortran (4.7.2) complains about this procedure pointer declaration with the message:

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

I don't understand this error message, as nt is itself a pointer, and what the function it points to returns is also a pointer.

For reference, the full source code for the example follows. Fist, the module containing my derived types, interfaces, and functions/subroutines:

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

And the main program using this module:

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

The program first creates objects via subroutines make_test and make_test2, and in my testing this works with all compilers I tried. Next, objects are created by directly calling functions new_test and new_test2, which also works in my tests. Finally, objects should again be created via these functions, but indirectly via the procedure pointer nt.

As stated above, gfortran (4.7.2) doesn't compile the declaration of nt.

ifort (12.0.4.191) produces an internal compiler error on the line nt => new_test.

pgfortran (12.9) compiles without warning, and the executable produces the expected results.

So, is what I'm trying to do illegal according to Fortran2003, or is the compiler support for such features still insufficient? Should I just use subroutines instead of functions (as that seems to work)?

Answer 1

Your code seems to be fine. I could compile it with both Intel 13.0.1 and NAG 5.3.1 without any problems. Older compiler may have their problems with the more "fancy" features of Fortran 2003.

Depending on the problem, you could also use allocatable types instead of pointers. Should be more memory-leak proof, on the other hand, you won't be able to return the polymorphic type as a result of a function:

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

One more remark: The implicit none statement on the module level is "inherited" by the module procedures, so you do not have to issue it in every subroutine extra.