Class 如何在Fortran 2003中以多态方式解除分配？
在尝试实现用户派生的类型层次结构之前，我试图了解使用Fortran 2003特性的多态释放。理想的目标是找出如何取消分配声明的父类型指针，该指针可能指向任何其他兼容的子类型 如下面的代码所示，文件Class 如何在Fortran 2003中以多态方式解除分配？,class,memory-management,fortran,final,fortran2003,Class,Memory Management,Fortran,Final,Fortran2003,在尝试实现用户派生的类型层次结构之前，我试图了解使用Fortran 2003特性的多态释放。理想的目标是找出如何取消分配声明的父类型指针，该指针可能指向任何其他兼容的子类型 如下面的代码所示，文件liboo.f90声明了一个基类型父类型和一个继承类型子类型。对于标量和数组位置，这两种类型分别具有FINAL。文件test_liboo.f90使用18个不同的子例程尝试不同的释放 子例程TestParent\u 3\u POINTER\u CLASS，TestParent\u 7\u array\u
liboo.f90父类型子类型FINALtest_liboo.f90TestParent\u 3\u POINTER\u CLASSTestParent\u 7\u array\u POINTER\u CLASSTestChild\u 3\u POINTER\u CLASSTestChild\u 7\u array\u POINTER\u CLASSTestPolymorph\u 3\u数组\u指针\u儿童类型\u家长类TestPolymorph\u 4\u array\u Pointer\u ClassForChildren\u ClassForParentsTestParent\u 3\u POINTER\u CLASSTestPolymorph\u 1\u Pointer\u TypeForChild\u ClassForParentforrtl:severe（173）：传递给解除分配的指针指向无法解除分配的数组
你能解释一下原因吗
TestPolymorph\u 2\u Pointer\u ClassForChild\u ClassForParent
不提供分段错误，只调用Child的Final
，而TestChild\u 1
等可以调用Child的Final
和父级的Final
，这应该是可取的
我想知道如何在Fortran 2003中取消分配一个实际包含继承类型的已声明父类型？任何见解将不胜感激
PS：编译器为英特尔Fortran编译器，版本如下：
[root@localhost new]# ifort --version
ifort (IFORT) 12.1.0 20111011
Copyright (C) 1985-2011 Intel Corporation. All rights reserved.
其中一条错误消息
生成文件
test_liboo.f90
您没有做错任何事情-您正在使用的英特尔Fortran版本有一个bug。我在当前版本（13.1.3）中复制了它，但在最新的14.0测试版中没有，所以看起来这个bug已经被修复了。新版本将于9月初发布。很抱歉，使用大写和无缩进阅读代码确实很困难，但我会尝试一下。我不知道，但如果没有最终确定过程，所有的非阵列测试对于gfortran和Solaris Studio都能很好地工作。没有生成分段错误，valgrind也没有发现任何内存泄漏。@VladimirF非常感谢您宝贵的时间和努力！即使但没有完成过程，…，valgrind也没有发现任何内存泄漏。
，原因可能是用户派生类型的其他指针/可分配组件不复杂吗？我希望我能遵循在fortran中使用OO风格的最佳实践。PS：很抱歉给您带来了关于CAP的麻烦！真的很困惑应该遵循哪本书的哪种编码风格…谢谢-不知道为什么我以前从未研究过StackOverflow。。。。我希望能对你有所帮助。非常感谢你的评论！我会尝试14版本来检查！
[root@localhost new]# make clean
rm -rf liboo.mod liboo.o test_liboo.o test_liboo
[root@localhost new]# make
ifort -c -O0 -check -g -traceback -openmp liboo.f90
ifort -c -O0 -check -g -traceback -openmp test_liboo.f90
ifort -o test_liboo liboo.o test_liboo.o -static -openmp
[root@localhost new]# ./test_liboo
TestParent_1 begins.
DestroyParent
TestParent_1 ends.
TestParent_2_POINTER_TYPE begins.
DestroyParent
TestParent_2_POINTER_TYPE ends.
TestParent_3_POINTER_CLASS begins.
DestroyParent
forrtl: severe (174): SIGSEGV, segmentation fault occurred
Image PC Routine Line Source
test_liboo 0000000000404B9C Unknown Unknown Unknown
test_liboo 0000000000404A9F Unknown Unknown Unknown
test_liboo 0000000000401ED5 test_liboo_IP_tes 140 test_liboo.f90
test_liboo 0000000000400829 MAIN__ 20 test_liboo.f90
test_liboo 00000000004002EC Unknown Unknown Unknown
test_liboo 00000000004F4B90 Unknown Unknown Unknown
test_liboo 00000000004001B9 Unknown Unknown Unknown
[root@localhost new]#
# Compiler
FC = ifort
# Linker
LINKER = ${FC}
# Compiler flags
FCFLAGS = -c -O0 -check -g -traceback
FCFLAGS2 = -openmp
# Linker flags
FLFLAGS = -static
FLFLAGS2 = -openmp
# Utilities
RM = rm -rf
ECHO = echo
SHELL = /bin/sh
# clear out all suffixes
.SUFFIXES:
# list only those we use
.SUFFIXES: .o .f90 .f
# define a suffix rule for .f90 -> .o
.f90.o:
${FC} ${FCFLAGS} ${FCFLAGS2} $<
# define a suffix rule for .f -> .o
.f.o:
${FC} ${FCFLAGS} ${FCFLAGS2} $<
#
test_liboo: liboo.o test_liboo.o
${LINKER} -o test_liboo liboo.o test_liboo.o ${FLFLAGS} ${FLFLAGS2}
#
clean:
${RM} liboo.mod liboo.o test_liboo.o test_liboo
!***|****1****|****2****|****3****|****4****|****5****|****6****|****7**
MODULE LibOO
!***|****1****|****2****|****3****|****4****|****5****|****6****|****7**
TYPE :: Parent
INTEGER :: a
CONTAINS
FINAL :: DestroyParent
FINAL :: DestroyParents
END TYPE
!***|****1****|****2****|****3****|****4****|****5****|****6****|****7**
TYPE, EXTENDS (Parent) :: child
INTEGER :: b
CONTAINS
FINAL :: DestroyChild
FINAL :: DestroyChildren
END TYPE
CONTAINS
!***|****1****|****2****|****3****|****4****|****5****|****6****|****7**
SUBROUTINE DestroyParent(this)
TYPE(Parent) :: this
WRITE (*,*) 'DestroyParent'
END SUBROUTINE
!***|****1****|****2****|****3****|****4****|****5****|****6****|****7**
SUBROUTINE DestroyParents(this)
TYPE(Parent), DIMENSION(:) :: this
WRITE (*,*) 'DestroyParents'
END SUBROUTINE
!***|****1****|****2****|****3****|****4****|****5****|****6****|****7**
SUBROUTINE DestroyChild(this)
TYPE(Child) :: this
WRITE (*,*) 'DestroyChild'
END SUBROUTINE
!***|****1****|****2****|****3****|****4****|****5****|****6****|****7**
SUBROUTINE DestroyChildren(this)
TYPE(Child), DIMENSION(:) :: this
WRITE (*,*) 'DestroyChildren'
END SUBROUTINE
END MODULE
!***|****1****|****2****|****3****|****4****|****5****|****6****|****7**
!***|****1****|****2****|****3****|****4****|****5****|****6****|****7**
PROGRAM test_liboo
USE LibOO
IMPLICIT NONE
!***|****1****|****2****|****3****|****4****|****5****|****6****|****7**
WRITE (*,*) 'TestParent_1 begins.'
CALL TestParent_1
WRITE (*,*) 'TestParent_1 ends.'
READ (*,*)
WRITE (*,*) 'TestParent_2_POINTER_TYPE begins.'
CALL TestParent_2_POINTER_TYPE
WRITE (*,*) 'TestParent_2_POINTER_TYPE ends.'
READ (*,*)
WRITE (*,*) 'TestParent_3_POINTER_CLASS begins.'
CALL TestParent_3_POINTER_CLASS
WRITE (*,*) 'TestParent_3_POINTER_CLASS ends.'
READ (*,*)
WRITE (*,*) 'TestParent_4_array begins.'
CALL TestParent_4_array
WRITE (*,*) 'TestParent_4_array ends.'
READ (*,*)
WRITE (*,*) 'TestParent_5_array_ALLOCATABLE begins.'
CALL TestParent_5_array_ALLOCATABLE
WRITE (*,*) 'TestParent_5_array_ALLOCATABLE ends.'
READ (*,*)
WRITE (*,*) 'TestParent_6_array_POINTER_TYPE begins.'
CALL TestParent_6_array_POINTER_TYPE
WRITE (*,*) 'TestParent_6_array_POINTER_TYPE ends.'
READ (*,*)
WRITE (*,*) 'TestParent_7_array_POINTER_CLASS begins.'
CALL TestParent_7_array_POINTER_CLASS
WRITE (*,*) 'TestParent_7_array_POINTER_CLASS ends.'
READ (*,*)
!***|****1****|****2****|****3****|****4****|****5****|****6****|****7**
WRITE (*,*) 'TestChild_1 begins.'
CALL TestChild_1
WRITE (*,*) 'TestChild_1 ends.'
READ (*,*)
WRITE (*,*) 'TestChild_2_POINTER_TYPE begins.'
CALL TestChild_2_POINTER_TYPE
WRITE (*,*) 'TestChild_2_POINTER_TYPE ends.'
READ (*,*)
WRITE (*,*) 'TestChild_3_POINTER_CLASS begins.'
CALL TestChild_3_POINTER_CLASS
WRITE (*,*) 'TestChild_3_POINTER_CLASS ends.'
READ (*,*)
WRITE (*,*) 'TestChild_4_array begins.'
CALL TestChild_4_array
WRITE (*,*) 'TestChild_4_array ends.'
READ (*,*)
WRITE (*,*) 'TestChild_5_array_ALLOCATABLE begins.'
CALL TestChild_5_array_ALLOCATABLE
WRITE (*,*) 'TestChild_5_array_ALLOCATABLE ends.'
READ (*,*)
WRITE (*,*) 'TestChild_6_array_POINTER_TYPE begins.'
CALL TestChild_6_array_POINTER_TYPE
WRITE (*,*) 'TestChild_6_array_POINTER_TYPE ends.'
READ (*,*)
WRITE (*,*) 'TestChild_7_array_POINTER_CLASS begins.'
CALL TestChild_7_array_POINTER_CLASS
WRITE (*,*) 'TestChild_7_array_POINTER_CLASS ends.'
READ (*,*)
!***|****1****|****2****|****3****|****4****|****5****|****6****|****7**
WRITE (*,*) 'TestPolymorph_1_Pointer_TypeForChild_ClassForParent begins.'
CALL TestPolymorph_1_Pointer_TypeForChild_ClassForParent
WRITE (*,*) 'TestPolymorph_1_Pointer_TypeForChild_ClassForParent ends.'
READ (*,*)
WRITE (*,*) 'TestPolymorph_2_Pointer_ClassForChild_ClassForParent begins.'
CALL TestPolymorph_2_Pointer_ClassForChild_ClassForParent
WRITE (*,*) 'TestPolymorph_2_Pointer_ClassForChild_ClassForParent ends.'
READ (*,*)
WRITE (*,*) 'TestPolymorph_3_array_Pointer_TypeForChildren_ClassForParents begins.'
CALL TestPolymorph_3_array_Pointer_TypeForChildren_ClassForParents
WRITE (*,*) 'TestPolymorph_3_array_Pointer_TypeForChildren_ClassForParents ends.'
READ (*,*)
WRITE (*,*) 'TestPolymorph_4_array_Pointer_ClassForChildren_ClassForParents begins.'
CALL TestPolymorph_4_array_Pointer_ClassForChildren_ClassForParents
WRITE (*,*) 'TestPolymorph_4_array_Pointer_ClassForChildren_ClassForParents ends.'
READ (*,*)
CONTAINS
!***|****1****|****2****|****3****|****4****|****5****|****6****|****7**
SUBROUTINE TestParent_1
USE LibOO
IMPLICIT NONE
TYPE(Parent) :: myParent
myParent%a = 6
END SUBROUTINE TestParent_1
!***|****1****|****2****|****3****|****4****|****5****|****6****|****7**
SUBROUTINE TestParent_2_POINTER_TYPE
USE LibOO
IMPLICIT NONE
TYPE(Parent), POINTER :: pMyParent
ALLOCATE(pMyParent)
pMyParent%a = 6
DEALLOCATE(pMyParent)
END SUBROUTINE TestParent_2_POINTER_TYPE
!***|****1****|****2****|****3****|****4****|****5****|****6****|****7**
SUBROUTINE TestParent_3_POINTER_CLASS
USE LibOO
IMPLICIT NONE
CLASS(Parent), POINTER :: pMyParent
ALLOCATE(pMyParent)
pMyParent%a = 6
DEALLOCATE(pMyParent)
END SUBROUTINE TestParent_3_POINTER_CLASS
!***|****1****|****2****|****3****|****4****|****5****|****6****|****7**
SUBROUTINE TestParent_4_array
USE LibOO
IMPLICIT NONE
TYPE(Parent), DIMENSION(3) :: myParents
myParents(1)%a = 6
END SUBROUTINE TestParent_4_array
!***|****1****|****2****|****3****|****4****|****5****|****6****|****7**
SUBROUTINE TestParent_5_array_ALLOCATABLE
USE LibOO
IMPLICIT NONE
TYPE(Parent), DIMENSION(:), ALLOCATABLE :: myParents
ALLOCATE(myParents(3))
myParents(1)%a = 6
DEALLOCATE(myParents)
END SUBROUTINE TestParent_5_array_ALLOCATABLE
!***|****1****|****2****|****3****|****4****|****5****|****6****|****7**
SUBROUTINE TestParent_6_array_POINTER_TYPE
USE LibOO
IMPLICIT NONE
TYPE(Parent), DIMENSION(:), POINTER :: pMyParents
ALLOCATE(pMyParents(3))
pMyParents(1)%a = 6
DEALLOCATE(pMyParents)
END SUBROUTINE TestParent_6_array_POINTER_TYPE
!***|****1****|****2****|****3****|****4****|****5****|****6****|****7**
SUBROUTINE TestParent_7_array_POINTER_CLASS
USE LibOO
IMPLICIT NONE
CLASS(Parent), DIMENSION(:), POINTER :: pMyParents
ALLOCATE(pMyParents(3))
pMyParents(1)%a = 6
DEALLOCATE(pMyParents)
END SUBROUTINE TestParent_7_array_POINTER_CLASS
!***|****1****|****2****|****3****|****4****|****5****|****6****|****7**
SUBROUTINE TestChild_1
USE LibOO
IMPLICIT NONE
TYPE(child) :: myChild
myChild%b = 6
END SUBROUTINE TestChild_1
!***|****1****|****2****|****3****|****4****|****5****|****6****|****7**
SUBROUTINE TestChild_2_POINTER_TYPE
USE LibOO
IMPLICIT NONE
TYPE(child), POINTER :: pMyChild
ALLOCATE(pMyChild)
pMyChild%b = 6
DEALLOCATE(pMyChild)
END SUBROUTINE TestChild_2_POINTER_TYPE
!***|****1****|****2****|****3****|****4****|****5****|****6****|****7**
SUBROUTINE TestChild_3_POINTER_CLASS
USE LibOO
IMPLICIT NONE
CLASS(child), POINTER :: pMyChild
ALLOCATE(pMyChild)
pMyChild%b = 6
DEALLOCATE(pMyChild)
END SUBROUTINE TestChild_3_POINTER_CLASS
!***|****1****|****2****|****3****|****4****|****5****|****6****|****7**
SUBROUTINE TestChild_4_array
USE LibOO
IMPLICIT NONE
TYPE(child), DIMENSION(3) :: myChild
myChild(1)%b = 6
END SUBROUTINE TestChild_4_array
!***|****1****|****2****|****3****|****4****|****5****|****6****|****7**
SUBROUTINE TestChild_5_array_ALLOCATABLE
USE LibOO
IMPLICIT NONE
TYPE(child), DIMENSION(:), ALLOCATABLE :: myChildren
ALLOCATE(myChildren(3))
myChildren(1)%b = 6
DEALLOCATE(myChildren)
END SUBROUTINE TestChild_5_array_ALLOCATABLE
!***|****1****|****2****|****3****|****4****|****5****|****6****|****7**
SUBROUTINE TestChild_6_array_POINTER_TYPE
USE LibOO
IMPLICIT NONE
TYPE(child), DIMENSION(:), POINTER :: pMyChildren
ALLOCATE(pMyChildren(3))
pMyChildren(1)%b = 6
DEALLOCATE(pMyChildren)
END SUBROUTINE TestChild_6_array_POINTER_TYPE
!***|****1****|****2****|****3****|****4****|****5****|****6****|****7**
SUBROUTINE TestChild_7_array_POINTER_CLASS
USE LibOO
IMPLICIT NONE
CLASS(child), DIMENSION(:), POINTER :: pMyChildren
ALLOCATE(pMyChildren(3))
pMyChildren(1)%b = 6
DEALLOCATE(pMyChildren)
END SUBROUTINE TestChild_7_array_POINTER_CLASS
!***|****1****|****2****|****3****|****4****|****5****|****6****|****7**
SUBROUTINE TestPolymorph_1_Pointer_TypeForChild_ClassForParent
USE LibOO
IMPLICIT NONE
TYPE(child), POINTER :: pMyChild
CLASS(parent), POINTER :: pMyParent
ALLOCATE(pMyChild)
pMyChild%b = 6
pMyParent => pMyChild
DEALLOCATE(pMyParent)
END SUBROUTINE TestPolymorph_1_Pointer_TypeForChild_ClassForParent
!***|****1****|****2****|****3****|****4****|****5****|****6****|****7**
SUBROUTINE TestPolymorph_2_Pointer_ClassForChild_ClassForParent
USE LibOO
IMPLICIT NONE
CLASS(child), POINTER :: pMyChild
CLASS(parent), POINTER :: pMyParent
ALLOCATE(pMyChild)
pMyChild%b = 6
pMyParent => pMyChild
DEALLOCATE(pMyParent)
END SUBROUTINE TestPolymorph_2_Pointer_ClassForChild_ClassForParent
!***|****1****|****2****|****3****|****4****|****5****|****6****|****7**
SUBROUTINE TestPolymorph_3_array_Pointer_TypeForChildren_ClassForParents
USE LibOO
IMPLICIT NONE
TYPE(child), DIMENSION(:), POINTER :: pMyChildren
CLASS(parent), DIMENSION(:), POINTER :: pMyParents
ALLOCATE(pMyChildren(3))
pMyChildren(1)%b = 6
pMyParents => pMyChildren
DEALLOCATE(pMyParents)
END SUBROUTINE TestPolymorph_3_array_Pointer_TypeForChildren_ClassForParents
!***|****1****|****2****|****3****|****4****|****5****|****6****|****7**
SUBROUTINE TestPolymorph_4_array_Pointer_ClassForChildren_ClassForParents
USE LibOO
IMPLICIT NONE
CLASS(child), DIMENSION(:), POINTER :: pMyChildren
CLASS(parent), DIMENSION(:), POINTER :: pMyParents
ALLOCATE(pMyChildren(3))
pMyChildren(1)%b = 6
pMyParents => pMyChildren
DEALLOCATE(pMyParents)
END SUBROUTINE TestPolymorph_4_array_Pointer_ClassForChildren_ClassForParents
END PROGRAM test_liboo
!***|****1****|****2****|****3****|****4****|****5****|****6****|****7**