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.