问题
I would like to implement a generic double linked list in Fortran for saving codes, using PGI Fortran compiler version 12.10-0 in Mac OS X 10.8.2. Here is my prototype, including 3 files:
---> File 1:
! ----------------------------------------------------------------------------
! Description:
!
! This module provides several basic data structures, e.g. double linked list.
!
! Authors:
!
! Li Dong <dongli@lasg.iap.ac.cn> - 2012-11-11
! ----------------------------------------------------------------------------
module basic_data_structure
implicit none
private
public list_elem_t, list_t
type list_elem_t
class(list_elem_t), pointer :: prev, next
end type list_elem_t
type list_t
integer :: num_elem = 0
class(list_elem_t), pointer :: head, tail
contains
procedure :: append => list_append
procedure :: insert => list_insert
procedure :: final => list_final
end type list_t
contains
! ------------------------------------------------------------------------
! Description:
!
! The following list_* are the type-bound procedures of double linked
! list data structure.
!
! Authors:
!
! Li Dong - <dongli@lasg.iap.ac.cn> - 2012-11-11
! ------------------------------------------------------------------------
subroutine list_append(this, elem)
class(list_t), intent(inout) :: this
class(list_elem_t), intent(out), pointer :: elem
character(50), parameter :: sub_name = "list_append"
allocate(elem)
if (this%num_elem == 0) then
this%head => elem
nullify(this%head%prev)
this%tail => this%head
else
this%tail%next => elem
elem%prev => this%tail
this%tail => elem
end if
nullify(this%tail%next)
this%num_elem = this%num_elem+1
end subroutine list_append
subroutine list_insert(this, existed_elem, elem)
class(list_t), intent(inout) :: this
class(list_elem_t), intent(inout), pointer :: existed_elem
class(list_elem_t), intent(out), pointer :: elem
character(50), parameter :: sub_name = "list_insert"
! TODO: Check existed_elem is allocated.
! TODO: Check existed_elem is one element of this.
allocate(elem)
elem%prev => existed_elem
elem%next => existed_elem%next
if (associated(existed_elem%next)) then
existed_elem%next%prev => elem
existed_elem%next => elem
end if
this%num_elem = this%num_elem+1
end subroutine list_insert
subroutine list_final(this)
class(list_t), intent(inout) :: this
class(list_elem_t), pointer :: elem
integer i
elem => this%head
do i = 1, this%num_elem-1
elem => elem%next
if (associated(elem%prev)) deallocate(elem%prev)
end do
deallocate(this%tail)
end subroutine list_final
end module basic_data_structure
---> File 2
! ----------------------------------------------------------------------------
! Description:
!
! This module manages the model variables.
!
! Authors:
!
! Li Dong <dongli@lasg.iap.ac.cn> - 2012-11-11
! ----------------------------------------------------------------------------
module variable
use basic_data_structure
implicit none
private
public variable_register
public variable_final
public var_t, var_1d_t
integer, parameter :: A_GRID = 1
integer, parameter :: B_GRID = 2
integer, parameter :: C_GRID = 3
type, extends(list_elem_t) :: var_t
character(10) name
character(50) long_name
character(20) units
integer grid_type
end type var_t
type, extends(var_t) :: var_1d_t
real(8), allocatable :: array(:)
end type var_1d_t
type, extends(var_t) :: var_2d_t
real(8), allocatable :: array(:,:)
end type var_2d_t
type(list_t) var_list
contains
! ------------------------------------------------------------------------
! Description:
!
! Register a variable.
!
! Authors:
!
! Li Dong <dongli@lasg.iap.ac.cn> - 2012-11-11
! ------------------------------------------------------------------------
subroutine variable_register(name, var)
character(*), intent(in) :: name
class(var_t), intent(inout), pointer :: var
character(50), parameter :: sub_name = "variable_register"
select type (var)
type is (var_1d_t)
print *, "---> Register a 1D variable """//trim(name)//"""."
type is (var_2d_t)
print *, "---> Register a 2D variable """//trim(name)//"""."
type is (var_t)
print *, "---> Oh, no!"
class default
print *, "---> Unknown variable type """//trim(name)//"""."
end select
call var_list%append(var)
! -------------------------------> PROBLEM IS HERE
select type (var)
type is (var_1d_t)
print *, "---> Register a 1D variable """//trim(name)//"""."
type is (var_2d_t)
print *, "---> Register a 2D variable """//trim(name)//"""."
type is (var_t)
print *, "---> Oh, no!"
class default
print *, "---> Unknown variable type """//trim(name)//"""."
end select
end subroutine variable_register
! ------------------------------------------------------------------------
! Description:
!
! Clean the registered variables.
!
! Authors:
!
! Li Dong <dongli@lasg.iap.ac.cn> - 2012-11-11
! ------------------------------------------------------------------------
subroutine variable_final()
character(50), parameter :: sub_name = "variable_final"
call var_list%final()
end subroutine variable_final
end module variable
---> File 3:
program test_variable
use variable
implicit none
type(var_1d_t), pointer :: a
call variable_register("a", a)
call variable_final()
end program test_variable
The running result is:
MacBook-Pro:sandbox dongli$ ./test_variable
---> Register a 1D variable "a".
---> Unknown variable type "a".
Why after appending a list, the type of var is changed into a type that is unknown, and how could I achieve the expected functionality?
回答1:
F2008 12.5.2.5 p2 says in terms of pointer and allocatable dummy arguments: "The actual argument shall be polymorphic if and only if the associated dummy argument is polymorphic...".
The dummy argument var in variable_register is a polymorphic pointer. The actual argument a in the main program is not. Your program is in error and the Fortran processor is not required to diagnose this error (though it should be easy enough for it to detect this in this particular case).
The same paragraph in F2008 12.5.2.5 then goes on to say "...the declared type of the actual argument shall be the same as the declared type of the dummy argument." The dummy argument in list_append is a polymorphic pointer of declared type list_elem_t. The actual argument is a polymorphic pointer of declared type var_t. They are not the same - your program is even more in error. Again, the Fortran processor is not required to diagnose this, but it should be easy enough for it to do so in this case.
Because your program is in error anything can happen, but on a related note - the elem argument to list_append is declared INTENT(OUT). That means that at the start of that procedure, the pointer association status of elem is undefined - you don't know what it is pointing at (or its dynamic type). The allocate statement in list_append then allocates an object of the declared type of elem, i.e. list_elem_t (the fact that the pointer that is the ultimate argument and the pointer that is the "intermediate" argument have now been pointed at a parent of their respective declared types is the reason that the restrictions quoted above in 12.5.2.5 exist - read Note 12.27 in F2008). Your select type doesn't check for that option.
来源：https://stackoverflow.com/questions/13329622/double-linked-list-in-fortran-type-is-not-judged-correctly