I discovered a memory leak in a program I compiled with GFortran. Basically it contains the following pattern:
MODULE leaky_m
IMPLICIT NONE (type, external)
PRIVATE
TYPE :: leaky_t
LOGICAL :: is_init = .FALSE.
INTEGER :: i = 0
CONTAINS
PROCEDURE :: finish
PROCEDURE :: dosomething
FINAL :: destructor
END TYPE leaky_t
INTERFACE leaky_t
MODULE PROCEDURE :: constructor
END INTERFACE leaky_t
PUBLIC :: leaky_t
CONTAINS
FUNCTION constructor(i) RESULT(this)
! Function arguments
INTEGER, INTENT(in) :: i
TYPE(leaky_t) :: this
WRITE(*,*) "Initializing i = ", i
this%is_init = .TRUE.
this%i = i
END FUNCTION constructor
SUBROUTINE dosomething(this)
! Subroutine arguments
CLASS(leaky_t), INTENT(inout) :: this
WRITE(*,*) "Working on i = ", this%i
END SUBROUTINE dosomething
IMPURE ELEMENTAL SUBROUTINE finish(this)
! Subroutine arguments
CLASS(leaky_t), INTENT(inout) :: this
WRITE(*,*) "Finishing i = ", this%i
this%is_init = .FALSE.
this%i = 0
END SUBROUTINE finish
IMPURE ELEMENTAL SUBROUTINE destructor(this)
! Subroutine arguments
TYPE(leaky_t), INTENT(inout) :: this
CALL this%finish()
END SUBROUTINE destructor
END MODULE leaky_m
PROGRAM test
USE leaky_m
IMPLICIT NONE (type, external)
INTEGER :: i
TYPE(leaky_t) :: banana
DO i = 1, 10
banana = leaky_t(i)
CALL banana%dosomething()
WRITE(*, '()')
! Gfortran can call this to avoid the leak
! CALL banana%finish()
END DO
END PROGRAM test
The problem is that the FINAL routine (the destructor) is not called at all in this case when using GFortran. Intel behaves different and calls it twice…
I copied a full working program here: Compiler Explorer where one can experiment with various compilers etc. Basically Gfortran gives:
Initializing i = 1
Working on i = 1
Initializing i = 2
Working on i = 2
Initializing i = 3
Working on i = 3
Initializing i = 4
Working on i = 4
Initializing i = 5
Working on i = 5
Initializing i = 6
Working on i = 6
Initializing i = 7
Working on i = 7
Initializing i = 8
Working on i = 8
Initializing i = 9
Working on i = 9
Initializing i = 10
Working on i = 10
i.e. the FINAL is never called. Intel (both classic and ifx) on the other hand gives:
Initializing i = 1
Finishing i = 0
Finishing i = 1
Working on i = 1
Initializing i = 2
Finishing i = 1
Finishing i = 2
Working on i = 2
Initializing i = 3
Finishing i = 2
Finishing i = 3
Working on i = 3
Initializing i = 4
Finishing i = 3
Finishing i = 4
Working on i = 4
Initializing i = 5
Finishing i = 4
Finishing i = 5
Working on i = 5
Initializing i = 6
Finishing i = 5
Finishing i = 6
Working on i = 6
Initializing i = 7
Finishing i = 6
Finishing i = 7
Working on i = 7
Initializing i = 8
Finishing i = 7
Finishing i = 8
Working on i = 8
Initializing i = 9
Finishing i = 8
Finishing i = 9
Working on i = 9
Initializing i = 10
Finishing i = 9
Finishing i = 10
Working on i = 10
notice how each element is created once and finished twice…
This inconsistency makes me to wonder:
- Am I doing something illegal w.r.t the Fortran standard?
- Is it a gfortran bug that the FINAL routine is never called?
- Is it correct that Intel calls the FINAL routine twice?
- Can this be written in a way such that there is a consistent behavior (created once and destroyed once) among compilers, without using a manual cleanup?
The purpose I am using this pattern for is to manage some external resource (MPI shared memory for instance). Therefore I must make absolutely sure that each instance of the type is created only once and destroyed only once (and not twice).