Type constructor and final behavior

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:

  1. Am I doing something illegal w.r.t the Fortran standard?
  2. Is it a gfortran bug that the FINAL routine is never called?
  3. Is it correct that Intel calls the FINAL routine twice?
  4. 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).

Apparently not. An answer can be found in the thread Automatic finalization of derived types. Quoting the answer there:

7.5.6.4 Entities that are not finalized

If image execution is terminated, either by an error (e.g. an allocation failure) or by execution of a stop-stmt, error-stop-stmt, or end-program-stmt, entities existing immediately prior to termination are not finalized.

NOTE 1
A nonpointer, nonallocatable object that has the SAVE attribute is never finalized as a direct consequence of the execution of a RETURN or END statement.

According to thread I just mentioned, your options are to wrap the contents of the main program in a block or a subroutine.

This has to do with intrinsic assignment of polymorphic entities. See Finalization/Copy in intrinsic polymorphic assignment. I’ve only skimmed that thread, but according to my understanding, the banana on the left-hand side is finalized before assignment, after assignment, the leaky_t temporary object is also finalized. No finalization is performed at the end due to point 7.5.6.4.

1 Like

I updated the code: Compiler Explorer and the only difference is that the last entry (10) is finalized in the end.

I believe that this bugzilla: https://gcc.gnu.org/bugzilla/show_bug.cgi?id=80524 entry is relevant, because it explains the behaviour (and confirm gfortran have problem with this). Altough I do not understand the purpose of the standard not the behavior in this case.

I cannot have a situation where the FINAL is called before I’m finished with the instance I’m working on, like this:

Initializing i =            2
 Finishing i =            1
 Finishing i =            2
 Working on i =            2

(intel compiler behavior).

When the instance wraps around some external memory allocations I cannot have it free’d (Finishing i = 2) before I’m finished using it (Working on i = 2)…

When I do the following:

DO i = 1, 10
    BLOCK
        TYPE(leaky_t) :: banana
        banana = leaky_t(i)
        CALL banana%dosomething()
    END BLOCK
    WRITE(*, '()')
END DO

gfortran behaves like I would like it to:

 Initializing i =            5
 Working on i =            5
 Finishing i =            5

However, Intel still behave strange:

 Initializing i =            5
 Finishing i =            0
 Finishing i =            5
 Working on i =            5
 Finishing i =            5

Here, the finalization of a non-initialized instance ( Finishing i = 0) is no problem, that can easily be handled. However, two times finalization of an initialized instance ( Finishing i = 5) is not desired…

See: Compiler Explorer

What Intel does is the following:

  1. leaky_t(i) is initialized as a temporary
  2. The uninitialized value of banana is finalized
  3. banana is assigned to the temporary (copied)
  4. The temporary is finalized
  5. When the block ends, the initialized banana is finalized

I believe this is the correct way. Not sure why gfortran does it differently

1 Like

gfortran has quite a few problems still with finalization. Here is their list of individual issues. It’s worth perusing the issues that are still open to learn what one needs to avoid (or workarounds) in order to prevent memory leaks.

1 Like

A pragmatic solution would be to use an initalization subroutine (or a type-bound procedure) to avoid the pitfalls of overloaded structure constructors and intrinsic assignment.

If you want to use the overloaded-structure constructor for some reason, you could add a variable to your derived type, marking if it’s a temporary. The full pattern is explained in:

Avoiding memory leaks with derived types by Arjen Markus (@Arjen)

This may or may not be suitable because it relies upon using defined assignment (see Should we avoid assignment of derived types in robust programs?).

There is a follow-up article to the one by @Arjen, which also covers nested sub-program invocation:

Stewart, G. W. (2003, December). Memory leaks in derived types revisited. In ACM SIGPLAN Fortran Forum (Vol. 22, No. 3, pp. 25-27). New York, NY, USA: ACM.

As you’ve already noticed, if you’d like to have finalization after each loop iteration, you either need to do it explicitly, or limit the scope of the banana instance to a block within the do construct. The finalization upon assignment is currently not reliable enough if you plan to use multiple compilers.

In case you’re familiar with constructor/destructor semantics in C++, don’t make the assumption that Fortran works similarly.

1 Like

Ah, that’s great to see that Paul has found the time to work on finalization again.

1 Like

A critical thing for people to note. The in-place constructor in C++ is quite nice, but that’s not at all what Fortran constructors do. Much better to use a type-bound init procedure as Ivan says.

That’s certainly the case when it comes to extended types and their parent. There was an unfortunate (imo) interp that addressed an ambiguity/contradiction in the standard. It fixed things by allowing a processor a lot of latitude in how finalization proceeds, including ways that some of us find to be quite surprising and undesired (I’m looking at you NAG :wink:)

I have to admit I’m surprised on how awkward Fortran is designed to behave some times…

What do you think of something like this:

MODULE leaky_m
    IMPLICIT NONE (type, external)
    PRIVATE

    TYPE :: leaky_t
        LOGICAL :: is_init = .FALSE.
        INTEGER :: i = 0
    CONTAINS
        PROCEDURE :: init
        PROCEDURE :: finish
        PROCEDURE :: dosomething
        FINAL :: destructor
    END TYPE leaky_t

    PUBLIC :: leaky_t
CONTAINS
    SUBROUTINE init(this, i)
        ! Function arguments
        CLASS(leaky_t), INTENT(inout) :: this
        INTEGER, INTENT(in) :: i

        IF (this%is_init) CALL this%finish()

        WRITE(*,*) "Initializing i = ", i
        this%is_init = .TRUE.
        this%i = i
    END SUBROUTINE init


    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


    SUBROUTINE work(leaky)
        ! Subroutine arguments
        TYPE(leaky_t) :: leaky

        CALL leaky%dosomething()
    END SUBROUTINE work
END MODULE leaky_m


PROGRAM test
    USE leaky_m
    IMPLICIT NONE (type, external)

    INTEGER :: i

    BLOCK
        TYPE(leaky_t) :: banana
        DO i = 1, 10
            CALL banana%init(i)
            CALL banana%dosomething()
            WRITE(*, '()')
        END DO
    END BLOCK
END PROGRAM test

Also check it out in the Compiler Explorer

With this design I get a consistent behavior between currently released GNU and Intel compilers, which is nice. The initialization happens once and the finalization likewise. The last element is finished by the automatic FINAL routine, the others are “destroyed” by an explicit call to the final-routine in the init-routine when they are re-initialized.

In my opinion, this is less elegant, require more useless boilerplate code and is more prone to errors (and thus more likely to cause memory leaks in complex applications) than the original design if it had worked…

An update to my own suggestion:

MODULE leaky_m
    IMPLICIT NONE (type, external)
    PRIVATE

    TYPE :: leaky_t
        LOGICAL :: is_init = .FALSE.
        INTEGER :: i = 0
    CONTAINS
        PROCEDURE :: init
        PROCEDURE :: finish
        PROCEDURE :: dosomething
        FINAL :: destructor
    END TYPE leaky_t

    PUBLIC :: leaky_t
CONTAINS
    SUBROUTINE init(this, i)
        ! Function arguments
        CLASS(leaky_t), INTENT(out) :: this
        INTEGER, INTENT(in) :: i

        IF (this%is_init) ERROR STOP

        WRITE(*,*) "Initializing i = ", i
        this%is_init = .TRUE.
        this%i = i
    END SUBROUTINE init

    SUBROUTINE dosomething(this)
        ! Subroutine arguments
        CLASS(leaky_t), INTENT(inout) :: this

        IF (.NOT. this%is_init) ERROR STOP

        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

    BLOCK
        TYPE(leaky_t) :: banana
        DO i = 1, 10
            CALL banana%init(i)
            CALL banana%dosomething()
            WRITE(*, '()')
        END DO
    END BLOCK
END PROGRAM test

By declaring the this argument of the init routine INTENT(out) it seems that the finalization happens automatically for all elements.

Check it out in Compiler Explorer

I just wanted to suggest this. I think the test for is_init is superfluous, as the semantics of intent(out) will force the derived type components to take on the default values. I’m not sure however what happens with an associated shared pointer component. You probably need to handle it (deallocate it) explicitly in your finalizer?

Edit: a second thing I was wondering about is why are only part of your procedures elemental if you are only using a scalar instance. You could make all the procedures elemental, and have:

block
  integer :: i
  type(leaky_t) :: banana(10)
  call banana%init([(i,i=1,10)])
  call banana%dosomething()
end block

Sadly, the number of pitfalls in this part of Fortran is immense :frowning:

If you want to be completely safe, note that your type can still be initialized with the default initializer like this

type(leaky_t) :: banana
banana = leaky_t(.false., 1)

To guard against this, make some data private, for example:

type :: leaky_t
    logical, private :: is_init = .false.
    integer :: i = 0
end type

If you want all data to be public (which is fair in many situations) then I think you’d have to add some dummy private data to guard against use of the default initializer.

1 Like

Just a remark: the article you refer to was based on Fortran 90 - so before the automatic deallocation introduced in Fortran 95.