Прежде чем пытаться реализовать пользовательскую иерархию типов, я пытаюсь понять полиморфное освобождение, используя функции Fortran 2003.Идеальная цель - выяснить, как освободить указатель объявленного родительского типа, который может указывать на любые другие совместимые дочерние типы.
Как показывает следующий код, файл liboo.f90 объявляет базовый тип Parent и унаследованный тип Child.Оба типа имеют FINAL для скалярных и массивных ситуаций соответственно.Файл test_liboo.f90 пробует другое освобождение, используя 18 различных подпрограмм.
Подпрограммы TestParent_3_POINTER_CLASS, TestParent_7_array_POINTER_CLASS, TestChild_3_POINTER_CLASS, TestChild_7_array_POINTER_CLASS, TestPolymorph_3_array_Pointer_TypeForChildren_ClassForParents, TestPolymorph_4_array_Pointer_ClassForChildren_ClassForParents, все дают ошибки сегментации.Сообщения об ошибках TestParent_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 не дает ошибки сегментации, а только вызывает Child's Final, тогда как TestChild_1 и т. Д. Могут вызывать как Final Child, так и Final Parent, что должно быть желательно.
Мне интересно, как освободить объявленный тип-родитель, который на самом деле содержитунаследованный тип в Fortran 2003?Будем благодарны за любые идеи!
PS: Компилятор - Intel Fortran Compiler, и его версия выглядит следующим образом:
[root@localhost new]# ifort --version
ifort (IFORT) 12.1.0 20111011
Copyright (C) 1985-2011 Intel Corporation. All rights reserved.
Одно из сообщений об ошибках
[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**