https://gcc.gnu.org/bugzilla/show_bug.cgi?id=93691
Bug ID: 93691
Summary: Type bound assignment causes too many finalization of
derived type when part of other type
Product: gcc
Version: 9.2.0
Status: UNCONFIRMED
Severity: normal
Priority: P3
Component: fortran
Assignee: unassigned at gcc dot gnu.org
Reporter: floschiffmann at gmail dot com
Target Milestone: ---
Good morning,
when writing a reference counting scheme, I cam across this slightly intricate
bug. I suspect this is related to a problem in the type bound assignment but I
could not pin it down.
The problem:
Type(Inner) has type bound assignment and Final.
-assignment associates output reference counter to input reference counter
and incrments
-final decrements reference counter and deallocates reference count pointer
when 0
Type(outer) has type(inner) as member.
If Type(inner) is used by itself everything works correctly
However, if assignment of type(outer) to type(outer) is made, an additional
finalization is invoked (the third with an unassociated reference counter).
Here is the simplest test code I could produce:
! ============================== BEGIN TEST CODE ========================
MODULE Classes
IMPLICIT NONE
TYPE :: Inner
INTEGER, POINTER :: icount
CONTAINS
PROCEDURE :: init
PROCEDURE :: assignMe
GENERIC :: assignment(=) => assignMe
FINAL :: deleteIt
END TYPE
TYPE Outer
TYPE(Inner) :: ext
END TYPE
CONTAINS
SUBROUTINE init(self)
CLASS(Inner), INTENT(INOUT) :: self
ALLOCATE(self%icount)
self%icount=1
END SUBROUTINE
! Destrutor, if data is assigned decrement counter and delete once we reach 0
SUBROUTINE deleteIt(self)
TYPE(Inner) :: self
WRITE(*,*)"FINAL CALLED with icount =", self%icount, "LOC =",LOC(self%icount)
self%icount=self%icount-1
IF(self%icount<=0)THEN ! usually == 0 but <=0 better shows the problem
self%icount=-100
WRITE(*,*)" DEALLOCATING ICOUNT at LOC=", LOC(self%icount)
DEALLOCATE(self%icount)
END IF
END SUBROUTINE
! The basic assigment routine, set pointer to input data pointer and increment
counter
SUBROUTINE assignMe(self, input)
CLASS(Inner), INTENT(INOUT) :: self
CLASS(Inner), INTENT(IN) :: input
self%icount => input%icount
self%icount=self%icount+1
END SUBROUTINE
END MODULE
PROGRAM test
USE Classes
IMPLICIT NONE
WRITE(*,*)"Direct Call on inner performs only 2 FINALIZATIONS"
BLOCK
TYPE(Inner) :: inner1, inner2
CALL inner1%init()
inner2=inner1
END BLOCK
WRITE(*,*)
WRITE(*,*)"Indirect Call, 3 FINALIZATIONS, last with dangling pointer on
TYPE(inner)%icount"
BLOCK
TYPE(Outer) :: Outer1, Outer2
CALL Outer1%ext%init()
Outer2=Outer1
END BLOCK
END
!========================= END TEST CODE ================================
Note: in Final comparison is for <= 0 to cause double free
best regards
Flo
