pointers - que - punteros void lenguaje c

Fortran2003: puntero de procedimiento a una función que devuelve un puntero a un tipo polimórfico

Question

Para un nuevo proyecto, estoy considerando usar las características orientadas a objetos de Fortran2003. Una cosa que probé implica un puntero de procedimiento que apunta a una función (no una subrutina) que devuelve un puntero a un tipo polimórfico. Me pregunto si tal construcción es legal, ya que obtengo resultados mixtos de diferentes compiladores (ver abajo).

Como ejemplo específico, considere la siguiente interfaz de función:

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

Y el código de uso debe tener un puntero de procedimiento que pueda apuntar a funciones con esta interfaz:

procedure(if_new_test),pointer :: nt

Pregunto si esto es legal porque gfortran (4.7.2) se queja de esta declaración de puntero de procedimiento con el mensaje:

Error: la variable CLASE ''nt'' en (1) debe ser ficticia, asignable o puntero

No entiendo este mensaje de error, ya que nt es en sí mismo un puntero y la función a la que apunta devuelve también un puntero.

Como referencia, sigue el código fuente completo para el ejemplo. Puño, el módulo que contiene mis tipos derivados, interfaces y funciones / subrutinas:

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

Y el programa principal que usa este módulo:

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

El programa primero crea objetos a través de las subrutinas make_test y make_test2 , y en mi prueba esto funciona con todos los compiladores que probé. A continuación, los objetos se crean llamando directamente a las funciones new_test y new_test2 , que también funciona en mis pruebas. Finalmente, los objetos deberían volver a crearse a través de estas funciones, pero indirectamente mediante el puntero de procedimiento nt .

Como se indicó anteriormente, gfortran (4.7.2) no compila la declaración de nt .

ifort (12.0.4.191) produce un error de compilador interno en la línea nt => new_test .

pgfortran (12.9) compila sin previo aviso, y el ejecutable produce los resultados esperados.

Entonces, ¿qué es lo que estoy tratando de hacer ilegal según Fortran2003, o es el soporte del compilador para tales características aún insuficiente? ¿Debo simplemente usar subrutinas en lugar de funciones (ya que eso parece funcionar)?

Answer 1

Tu código parece estar bien. Podría compilarlo con Intel 13.0.1 y NAG 5.3.1 sin ningún problema. El compilador antiguo puede tener sus problemas con las características más "sofisticadas" de Fortran 2003.

Dependiendo del problema, también puede usar tipos asignados en lugar de punteros. Debería ser más resistente a la pérdida de memoria, por otro lado, no podrá devolver el tipo polimórfico como resultado de una función:

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

Una observación más: la instrucción none implícita en el nivel del módulo es "heredada" por los procedimientos del módulo, por lo que no tiene que emitirla en cada subrutina adicional.