ユーザー派生型階層を実装する前に、Fortran2003の機能を使用して多態的な割り当て解除を理解しようとしています。理想的な目標は、他の互換性のある子型を指す可能性のある宣言された親型ポインターの割り当てを解除する方法を理解することです。
次のコードが示すように、ファイルは基本型と継承型をliboo.f90宣言します。どちらのタイプも、それぞれスカラーと配列の両方の状況に対応しています。このファイルは、18個の異なるサブルーチンを使用して異なる割り当て解除を試みます。ParentChildFINALtest_liboo.f90
サブルーチン、、、、、、、は
TestParent_3_POINTER_CLASSすべてセグメンテーション違反を引き起こします
。
のエラーメッセージを以下に示します。TestParent_7_array_POINTER_CLASSTestChild_3_POINTER_CLASSTestChild_7_array_POINTER_CLASSTestPolymorph_3_array_Pointer_TypeForChildren_ClassForParentsTestPolymorph_4_array_Pointer_ClassForChildren_ClassForParentsTestParent_3_POINTER_CLASS
サブルーチンTestPolymorph_1_Pointer_TypeForChild_ClassForParentは言うforrtl: severe (173): A pointer passed to DEALLOCATE points to an array that cannot be deallocated。
理由をコメントしていただけませんか？
TestPolymorph_2_Pointer_ClassForChild_ClassForParentセグメンテーション違反は発生しませんが、子を呼び出すだけですが、Finalなどは子と親のTestChild_1両方を呼び出すことができます。これは望ましいことです。FinalFinal
Fortran 2003で継承された型を実際に保持する宣言された親型の割り当てを解除する方法を知りたいですか？どんな洞察も高く評価されます！
PS：コンパイラーはIntel Fortranコンパイラーであり、バージョンは次のとおりです。
[root@localhost new]# ifort --version
ifort (IFORT) 12.1.0 20111011
Copyright (C) 1985-2011 Intel Corporation. All rights reserved.
エラーメッセージの1つ
[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]#
Makefile
# 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
liboo.f90
!***|****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**
test_liboo.f90
!***|****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**