Is deallocation needed within a program?

I’ve had a question for a long time;) Is deallocation really necessary within a program?

Without deallocation:

program test
implicit none
real, allocatable :: a(:)
allocate(a(1))
! deallocate(a)
end program

Running with Valgrind:

gfortran -g test.f90 && valgrind -s --leak-check=full --show-leak-kinds=all --track-origins=yes ./a.out

Results:

==1484510== Memcheck, a memory error detector
==1484510== Copyright (C) 2002-2024, and GNU GPL'd, by Julian Seward et al.
==1484510== Using Valgrind-3.24.0.GIT and LibVEX; rerun with -h for copyright info
==1484510== Command: ./a.out
==1484510== 
==1484510== 
==1484510== HEAP SUMMARY:
==1484510==     in use at exit: 4 bytes in 1 blocks
==1484510==   total heap usage: 18 allocs, 17 frees, 5,448 bytes allocated
==1484510== 
==1484510== 4 bytes in 1 blocks are definitely lost in loss record 1 of 1
==1484510==    at 0x484B77B: malloc (vg_replace_malloc.c:446)
==1484510==    by 0x401210: MAIN__ (test.f90:5)
==1484510==    by 0x401295: main (test.f90:7)
==1484510== 
==1484510== LEAK SUMMARY:
==1484510==    definitely lost: 4 bytes in 1 blocks
==1484510==    indirectly lost: 0 bytes in 0 blocks
==1484510==      possibly lost: 0 bytes in 0 blocks
==1484510==    still reachable: 0 bytes in 0 blocks
==1484510==         suppressed: 0 bytes in 0 blocks
==1484510== 
==1484510== ERROR SUMMARY: 1 errors from 1 contexts (suppressed: 0 from 0)

With deallocation:

program test
implicit none
real, allocatable :: a(:)
allocate(a(1))
deallocate(a)
end program

Results:

==1500356== Memcheck, a memory error detector
==1500356== Copyright (C) 2002-2024, and GNU GPL'd, by Julian Seward et al.
==1500356== Using Valgrind-3.24.0.GIT and LibVEX; rerun with -h for copyright info
==1500356== Command: ./a.out
==1500356== 
==1500356== 
==1500356== HEAP SUMMARY:
==1500356==     in use at exit: 0 bytes in 0 blocks
==1500356==   total heap usage: 18 allocs, 18 frees, 5,448 bytes allocated
==1500356== 
==1500356== All heap blocks were freed -- no leaks are possible
==1500356== 
==1500356== ERROR SUMMARY: 0 errors from 0 contexts (suppressed: 0 from 0)

The same question arises when using derived types: is it really necessary to call t%deallocate() in the following example?

module mod_test
    implicit none
    type type_t
        real, allocatable :: a(:)
    contains
        procedure :: set
        procedure :: deallocate
    end type

contains

    subroutine set(this, a)
        class(type_t), intent(inout) :: this
        real, intent(in) :: a(:)
        this%a = a
    end subroutine

    subroutine deallocate(this)
        class(type_t), intent(inout) :: this
        if (allocated(this%a)) deallocate(this%a)
    end subroutine
end module


program test
    use mod_test
    implicit none
    type(type_t) :: t
    real, allocatable :: a(:)
    allocate(a(1), source=0.0)
    call t%set(a)
    deallocate(a)
    call t%deallocate()
end program
1 Like

The short answer is IT DEPENDS. (Initially, I wrote YES, but I’ve changed opinion meanwhile.)

A previous discussion can be found here: Automatic finalization of derived types. To summarize that discussion, variables in the main program scope have the implicit save attribute, and the standard states that such variables are not finalized as a result of an end [program] statement.

If you want automatic deallocation to take place, you can wrap the contents of the main program in a subroutine or a block construct:

! DEALLOCATION VIA BLOCK
program test
implicit none
block
    use mod_test
    type(type_t) :: t
    real, allocatable :: a(:)
    allocate(a(1), source=0.0)
    call t%set(a)
end block
end program
! DEALLOCATION VIA SUBROUTINE
program test
implicit none
call run
contains
    subroutine run()
       use mod_test
       type(type_t) :: t
       real, allocatable :: a(:)
       allocate(a(1), source=0.0)
       call t%set(a)
   end subroutine
end program

Whether this is really necessary or not seems to be a matter of taste. At least for memory, on systems providing virtual memory, after termination the operating system will reclaim the memory belonging to the process anyways.

But if your derived type handles some other type of “resource”, for example related to IPC such as a pipe, socket, etc., then closing it correctly so that the other communicating process can respond correctly, would be the right thing to do.

3 Likes

Thanks for your answer. This is exactly what I needed to know!

As a side question: Why do programmers need to care about deallocation in this case? Are there any cases where allocatable variables do not need to be deallocated after end program?

1 Like

This will depend on the application. As mentioned previously, if you need the deallocation triggers some kind of communication protocol, I believe it’s still important. Also if you need to flush some file buffers. But if it’s just memory you’d like to free, or shared libraries you need to close, it’s not as critical and may even be detrimental, as the operating system will generally take care of it by itself. Quoting Raymond Chen of Microsoft:

The building is being demolished. Don’t bother sweeping the floor and emptying the trash cans and erasing the whiteboards. And don’t line up at the exit to the building so everybody can move their in/out magnet to out. All you’re doing is making the demolition team wait for you to finish these pointless housecleaning tasks.

(Note: the link in the quote is dead, but I found a copy here: The building is being demolished | Wayback Machine)

According to the thread I linked above, the implicit save and lack of finalization is a remnant from the past, when you would just reboot the computer after program termination. There appear to be some valid reasons why it’s still this way, for instance:

I’d be interested in reading responses from other members with experience other than x86, and before the introduction of the Intel 80286 and Intel 80386 which introduced a memory management unit (MMU).

1 Like

As a counterpoint to the other replies, I’ve recently encountered a situation at $DAYJOB where it would have been really nice if our application had been written with some thought to cleaning up. We’ve added a new memory-intensive task that occurs at the end of the application. To make room for the new task, we have to audit the code to clean up memory that isn’t needed anymore. If more thought had been given to cleanup, we wouldn’t be stuck now with the task of doing cleanup.

If one sticks to a programming style based on local variables, minimizes the use of dynamically-allocated module variables (globals) and uses allocatable arrays over other means of memory allocation, then most of the cleanup occurs automatically.

But I know that many application-specific PDE solvers are not like this, often due to historical reasons.

Just to illustrate what I mean:

! GLOBAL APPROACH
module fluid
   implicit none
   ! Fluid fields
   real(dp), allocatable, dimension(:,:,:) :: u, v, w, p
contains
   subroutine step_navier_stokes(nx,ny,nz)
       integer, intent(in) :: nx, ny, nz      
       allocate(u(nx,ny,nz), v(nx,ny,nz), w(nx,ny,nz), p(nx,ny,nz))
       ! ... perform integration
   end subroutine ! memory remains allocated
end module

program main
use fluid
! ... read input file ...
call step_navier_stokes(nx,ny,nz) ! large allocation
! ... post-process
end program
! LOCAL APPROACH
module fluid
   implicit none
   ! Fluid fields
   type :: fields(nx,ny,nz)
      integer, len :: nx, ny, nz
      real(dp), dimension(nx,ny,nz) :: u, v, w, p
   end type
contains
   subroutine step_navier_stokes(f)
       type(fields(*,*,*)), intent(inout) :: f    
       ! ... perform integration
   end subroutine
end module

program main
implicit none
! ... initialize ...
call heavy_computation
! ... other stuff
contains
   subroutine heavy_computation
      use fluid
      type(fields(:,:,:)), allocatable :: f
      allocate(fields(nx,ny,nz) :: f)
      call step_navier_stokes(f)
      ! ... post-process
   end subroutine   ! memory freed here
end program
2 Likes

which version of gfortran are you using. A few years ago, I had an issue with a deferred length string (aka allocatable) referenced in the main program not being deallocated upon program termination. This might be a gfortran bug. I would have thought those kind of bugs would have been detected and fixed by now. I think the problem I had was with gfortran 11 (or maybe 10). Did you try it with another compiler.

Here are the results from different compilers. They all have the same issue, but each compiler behaves differently:

gfortran:
definitely lost: 4 bytes in 1 blocks

ifx:
possibly lost: 44 bytes in 1 blocks

ifort:
possibly lost: 44 bytes in 1 blocks

nvfortran:
definitely lost: 32 bytes in 1 blocks
still reachable: 12,288 bytes in 1 blocks

lfortran:
still reachable: 19 bytes in 2 blocks
GNU Fortran (GCC) 14.1.0
Copyright (C) 2024 Free Software Foundation, Inc.
This is free software; see the source for copying conditions.  There is NO
warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.

==40389== Memcheck, a memory error detector
==40389== Copyright (C) 2002-2024, and GNU GPL'd, by Julian Seward et al.
==40389== Using Valgrind-3.24.0.GIT and LibVEX; rerun with -h for copyright info
==40389== Command: ./a.out
==40389== 
==40389== 
==40389== HEAP SUMMARY:
==40389==     in use at exit: 4 bytes in 1 blocks
==40389==   total heap usage: 18 allocs, 17 frees, 5,448 bytes allocated
==40389== 
==40389== 4 bytes in 1 blocks are definitely lost in loss record 1 of 1
==40389==    at 0x484B77B: malloc (vg_replace_malloc.c:446)
==40389==    by 0x401210: MAIN__ (test.f90:4)
==40389==    by 0x401295: main (test.f90:6)
==40389== 
==40389== LEAK SUMMARY:
==40389==    definitely lost: 4 bytes in 1 blocks
==40389==    indirectly lost: 0 bytes in 0 blocks
==40389==      possibly lost: 0 bytes in 0 blocks
==40389==    still reachable: 0 bytes in 0 blocks
==40389==         suppressed: 0 bytes in 0 blocks
==40389== 
==40389== ERROR SUMMARY: 1 errors from 1 contexts (suppressed: 0 from 0)
ifx (IFX) 2024.1.0 20240308
==49874== Memcheck, a memory error detector
==49874== Copyright (C) 2002-2024, and GNU GPL'd, by Julian Seward et al.
==49874== Using Valgrind-3.24.0.GIT and LibVEX; rerun with -h for copyright info
==49874== Command: ./a.out
==49874== 
==49874== 
==49874== HEAP SUMMARY:
==49874==     in use at exit: 44 bytes in 1 blocks
==49874==   total heap usage: 2 allocs, 1 frees, 60 bytes allocated
==49874== 
==49874== 44 bytes in 1 blocks are possibly lost in loss record 1 of 1
==49874==    at 0x484B77B: malloc (vg_replace_malloc.c:446)
==49874==    by 0x458AE4: _mm_malloc (in a.out)
==49874==    by 0x409CC5: for_allocate_handle (in a.out)
==49874==    by 0x4052E3: MAIN__ (test.f90:4)
==49874==    by 0x40515C: main (in a.out)
==49874== 
==49874== LEAK SUMMARY:
==49874==    definitely lost: 0 bytes in 0 blocks
==49874==    indirectly lost: 0 bytes in 0 blocks
==49874==      possibly lost: 44 bytes in 1 blocks
==49874==    still reachable: 0 bytes in 0 blocks
==49874==         suppressed: 0 bytes in 0 blocks
==49874== 
==49874== ERROR SUMMARY: 1 errors from 1 contexts (suppressed: 0 from 0)
ifort (IFORT) 2021.12.0 20240222
==56318== Memcheck, a memory error detector
==56318== Copyright (C) 2002-2024, and GNU GPL'd, by Julian Seward et al.
==56318== Using Valgrind-3.24.0.GIT and LibVEX; rerun with -h for copyright info
==56318== Command: ./a.out
==56318== 
==56318== 
==56318== HEAP SUMMARY:
==56318==     in use at exit: 44 bytes in 1 blocks
==56318==   total heap usage: 2 allocs, 1 frees, 60 bytes allocated
==56318== 
==56318== 44 bytes in 1 blocks are possibly lost in loss record 1 of 1
==56318==    at 0x484B77B: malloc (vg_replace_malloc.c:446)
==56318==    by 0x454D44: _mm_malloc (in a.out)
==56318==    by 0x408CD5: for_allocate_handle (in a.out)
==56318==    by 0x4042E8: MAIN__ (test.f90:4)
==56318==    by 0x40415C: main (in a.out)
==56318== 
==56318== LEAK SUMMARY:
==56318==    definitely lost: 0 bytes in 0 blocks
==56318==    indirectly lost: 0 bytes in 0 blocks
==56318==      possibly lost: 44 bytes in 1 blocks
==56318==    still reachable: 0 bytes in 0 blocks
==56318==         suppressed: 0 bytes in 0 blocks
==56318== 
==56318== ERROR SUMMARY: 1 errors from 1 contexts (suppressed: 0 from 0)
nvfortran 24.3-0 64-bit target on x86-64 Linux -tp haswell
==75169== Memcheck, a memory error detector
==75169== Copyright (C) 2002-2024, and GNU GPL'd, by Julian Seward et al.
==75169== Using Valgrind-3.24.0.GIT and LibVEX; rerun with -h for copyright info
==75169== Command: ./a.out
==75169== 
==75169== 
==75169== HEAP SUMMARY:
==75169==     in use at exit: 12,320 bytes in 2 blocks
==75169==   total heap usage: 3 allocs, 1 frees, 12,712 bytes allocated
==75169== 
==75169== 32 bytes in 1 blocks are definitely lost in loss record 1 of 2
==75169==    at 0x484B77B: malloc (vg_replace_malloc.c:446)
==75169==    by 0x4C361D0: __fort_gmalloc_without_abort (in /prf/prg/lin/x86-x64/nvidia/hpc_sdk/Linux_x86_64/24.3/compilers/lib/libnvf.so)
==75169== 
==75169== 12,288 bytes in 1 blocks are still reachable in loss record 2 of 2
==75169==    at 0x484B77B: malloc (vg_replace_malloc.c:446)
==75169==    by 0x4C36010: __fort_malloc (in /prf/prg/lin/x86-x64/nvidia/hpc_sdk/Linux_x86_64/24.3/compilers/lib/libnvf.so)
==75169==    by 0x4C287CA: __fort_entry_init (in /prf/prg/lin/x86-x64/nvidia/hpc_sdk/Linux_x86_64/24.3/compilers/lib/libnvf.so)
==75169==    by 0x4C33C20: pghpf_init (in /prf/prg/lin/x86-x64/nvidia/hpc_sdk/Linux_x86_64/24.3/compilers/lib/libnvf.so)
==75169==    by 0x40125B: MAIN_ (test.f90:1)
==75169==    by 0x4011F0: main (in a.out)
==75169== 
==75169== LEAK SUMMARY:
==75169==    definitely lost: 32 bytes in 1 blocks
==75169==    indirectly lost: 0 bytes in 0 blocks
==75169==      possibly lost: 0 bytes in 0 blocks
==75169==    still reachable: 12,288 bytes in 1 blocks
==75169==         suppressed: 0 bytes in 0 blocks
==75169== 
==75169== ERROR SUMMARY: 1 errors from 1 contexts (suppressed: 0 from 0)
LFortran version: 0.34.0
==103721== Memcheck, a memory error detector
==103721== Copyright (C) 2002-2024, and GNU GPL'd, by Julian Seward et al.
==103721== Using Valgrind-3.24.0.GIT and LibVEX; rerun with -h for copyright info
==103721== Command: ./test.out
==103721== 
==103721== 
==103721== HEAP SUMMARY:
==103721==     in use at exit: 19 bytes in 2 blocks
==103721==   total heap usage: 3 allocs, 1 frees, 23 bytes allocated
==103721== 
==103721== 8 bytes in 1 blocks are still reachable in loss record 1 of 2
==103721==    at 0x484B77B: malloc (vg_replace_malloc.c:446)
==103721==    by 0x486E954: _lpython_set_argv (in lfortran/lib/liblfortran_runtime.so.0.34.0)
==103721==    by 0x40112D: main (in test.out)
==103721== 
==103721== 11 bytes in 1 blocks are still reachable in loss record 2 of 2
==103721==    at 0x484B77B: malloc (vg_replace_malloc.c:446)
==103721==    by 0x4A3558E: strdup (strdup.c:42)
==103721==    by 0x486E983: _lpython_set_argv (in lfortran/lib/liblfortran_runtime.so.0.34.0)
==103721==    by 0x40112D: main (in test.out)
==103721== 
==103721== LEAK SUMMARY:
==103721==    definitely lost: 0 bytes in 0 blocks
==103721==    indirectly lost: 0 bytes in 0 blocks
==103721==      possibly lost: 0 bytes in 0 blocks
==103721==    still reachable: 19 bytes in 2 blocks
==103721==         suppressed: 0 bytes in 0 blocks
==103721== 
==103721== ERROR SUMMARY: 0 errors from 0 contexts (suppressed: 0 from 0)
1 Like

Wow thats interesting. I always assumed that Fortran was required to deallocate all allocatable objects (except for pointers I guess) at program termination. Maybe I’m wrong. Just curious, what does adding an explicit STOP statement in your example do. I’m guessing nothing but you never know.

Also, I’m not sure if valgrind plays nice with anything other than gcc compilers but again I could be wrong. Might be wise to take the other compiler results with a grain of salt.

2 Likes

For Intel, the preferred method for finding memory leaks with ifx is to use the LLVM sanitizers. It used to be the Intel Inspector tool but Intel is no longer shipping that with the Intel HPC toolkit. ifx man pages on linux says to use the following.

ifx -O0 -g -fsanitize=address test.f90
a.out


This runs on my Linux system with ifx 2024.1 without any error output.

Note you can also use this to find uninitialized variables by using the memory sanitizer

ifx -O0 -g -fsanitize=memory test.f90
a.out



Running your program gives

ifx -g -O0 -fsanitize=memory test.f90 
./a.out
==19839==WARNING: MemorySanitizer: use-of-uninitialized-value
    #0 0x40cdf2 in _GLOBAL__sub_I_fast_mem_ops.c fast_mem_ops.c
    #1 0x5dbdfc in __libc_csu_init (/home/rweed/a.out+0x5dbdfc) (BuildId: a58e81397b31b8b627057de635934a9e02bd1c45)
    #2 0x7f9c9fa1d00f in __libc_start_main /build/glibc-e2p3jK/glibc-2.31/csu/../csu/libc-start.c:264:6
    #3 0x40ce6d in _start (/home/rweed/a.out+0x40ce6d) (BuildId: a58e81397b31b8b627057de635934a9e02bd1c45)

  Uninitialized value was created by an allocation of 'a.i.i' in the stack frame
    #0 0x40c380 in _GLOBAL__sub_I_fast_mem_ops.c fast_mem_ops.c

SUMMARY: MemorySanitizer: use-of-uninitialized-value fast_mem_ops.c in _GLOBAL__sub_I_fast_mem_ops.c
Exiting

As you expected adding a STOP statement has no effect.

Interesting! On my Ubuntu system, I get no output for -fsanitize=address and -fsanitize=memory with ifx 2024.1.

I tried with an explicit save attribute using -fsanitize. This also gives no output.

program test
implicit none
real, save, allocatable :: a(:)
allocate(a(1))
! deallocate(a)
end program

What compiler options did you use. I think you have to use -g -O0 to turn off optimization. I run Linux MInt which is Ubuntu based. I still believe what you are seeing with gfortran is either a gfortran bug or valgrind giving a false positive which it is known to do.

Also, I think the issue with the SAVE attribute pointed out by @ivanpribec only applies to subprograms not the main program. It would make no sense for any program to not free memory upon program termination just because it is implicitly saved in the main program. That would show up in a lot of programs as an enormous memory leak. One reason things were implicitly saved when referenced in the main program was that COMMON blocks without a SAVE attribute could become undefined in some situations when only referenced in subprograms and not the main program. The same thing could also happen with modules prior to recent changes to automatically SAVE all module variables.

1 Like

That’s the operating system’s job.

A stop statement does not cause any deallocation by the program no matter where it appears. Any unreleased memory is reclaimed by the OS when the program is terminated.

The only memory management that Fortran is required to do for you is to clean up local, unsaved variables when exiting a procedure or block. That means deallocating any allocated allocatable variables, calling final subroutines (if any), and deallocating any allocated components. Variables with the save attribute are never cleaned up. Module variables and variables declared in the main program implicitly have the save attribute.

This is (partly) why valgrind often reports “false positives” for memory leaks for Fortran programs. The saved variables really are not deallocated. If you really care about not showing those false positives you can just put the entirety of your main program in a subroutine (so all those variables are local), and not use module variables (which I contend is risky behavior anyways).

5 Likes

Regarding the valgrind output, there appears to be some disagreement in various online discussions about when the “Still reachable” output in the leak summary actually signals a memory problem. I can see for something like shared objects/DLLS they could but for variables in the main program I’m not sure its something to really worry about assuming as @everythingfunctional points out the OS will reclaim the memory.

I meant the main program. Thanks to @everythingfunctional for explaining it a second time. I fully agree with what he just wrote. The only thing I might add is to this piece of advice,

This is not a problem if the module variables are parameter’s and slightly less so if they can be protected. The protected attribute can be used for the purpose of the singleton pattern, but since these are still globals at the end of the day, they don’t help to reduce dependencies. Some authors prefer to view them just as an implementation pattern, and not a design pattern.

Subtle distinction in terminology, an entity with the parameter attribute is a named constant, not a variable.

This alleviates some of the dangers of module variables, but does not solve the original problem of “how do I clean up all my allocated memory when a program ends to prevent false positives from memory leak detectors”.

1 Like

I’ve tried this program to compare different arrays (allocatable vs pointer etc):

!! test1.f90
module test_mod
    integer, allocatable :: arr_mod(:) 
    !! --> 4000 bytes : "still reacheable"
end

subroutine sub_alloc()
    integer, save, allocatable :: arr_sub(:)
    allocate( arr_sub(100), source=0 )
    !! --> 400 bytes : "still reacheable"
end

subroutine sub_ptr()
    integer, pointer :: arr_ptr(:)
    allocate( arr_ptr(20), source=0 )
    !! --> 80 bytes : "definitely lost"
end

program main
!!subroutine f_main()
    use test_mod
    implicit none
    integer, allocatable :: arr_main(:) 
    !! --> 8000 bytes : "definitely lost"

    call sub_alloc()
    call sub_ptr()

    allocate( arr_mod (1000), source=0 )   !! (4000 bytes)
    allocate( arr_main(2000), source=0 )   !! (8000 bytes)
end

!!program main
!!    call f_main()
!!end

and the result with gfortran-12 + valgrind (on Ubuntu22) is like this:

$ gfortran -g test1.f90
$ valgrind --leak-check=full --show-leak-kinds=all ./a.out 

==32378== HEAP SUMMARY:
==32378==     in use at exit: 12,480 bytes in 4 blocks
==32378==   total heap usage: 25 allocs, 21 frees, 26,064 bytes allocated
==32378== 
==32378== 80 bytes in 1 blocks are definitely lost in loss record 1 of 4
==32378==    at 0x4848899: malloc (in /usr/libexec/valgrind/vgpreload_memcheck-amd64-linux.so)
==32378==    by 0x1091FF: sub_ptr_ (test1.f90:13)
==32378==    by 0x109409: MAIN__ (test1.f90:23)
==32378==    by 0x109675: main (test1.f90:18)
==32378== 
==32378== 400 bytes in 1 blocks are still reachable in loss record 2 of 4
==32378==    at 0x4848899: malloc (in /usr/libexec/valgrind/vgpreload_memcheck-amd64-linux.so)
==32378==    by 0x10932D: sub_alloc_ (test1.f90:8)
==32378==    by 0x109404: MAIN__ (test1.f90:22)
==32378==    by 0x109675: main (test1.f90:18)
==32378== 
==32378== 4,000 bytes in 1 blocks are still reachable in loss record 3 of 4
==32378==    at 0x4848899: malloc (in /usr/libexec/valgrind/vgpreload_memcheck-amd64-linux.so)
==32378==    by 0x10949D: MAIN__ (test1.f90:25)
==32378==    by 0x109675: main (test1.f90:18)
==32378== 
==32378== 8,000 bytes in 1 blocks are definitely lost in loss record 4 of 4
==32378==    at 0x4848899: malloc (in /usr/libexec/valgrind/vgpreload_memcheck-amd64-linux.so)
==32378==    by 0x1095BB: MAIN__ (test1.f90:26)
==32378==    by 0x109675: main (test1.f90:18)
==32378== 
==32378== LEAK SUMMARY:
==32378==    definitely lost: 8,080 bytes in 2 blocks
==32378==    indirectly lost: 0 bytes in 0 blocks
==32378==      possibly lost: 0 bytes in 0 blocks
==32378==    still reachable: 4,400 bytes in 2 blocks
==32378==         suppressed: 0 bytes in 0 blocks

So, apart from the memory management of OS after the program terminatation, I feel what is confusing here is the message of the valgrind that “the allocatable array in the main program is definitely lost rather than still reacheable”, even though the user is able to access the array for the entire duration of the program (unlike the arr_prt(:), for which I think the memory is really “lost” because of a pointer and we lose access to the allocated memory).

(If I modify the main program to a subroutine (f_main()), the “definitely lost” memory of 8000 bytes disappears, as expected.)

I’ve also tried several codes (please see below), and from the output of gfortran -fdump-tree-original, I guess the reason for “definitely lost” may be something like this…

  • The fortran main routine is just a usual function (MAIN__) inside the GCC “intermediate” code;
  • Gfortran uses the same internal array type for both allocatable and pointer arrays;
  • An allocatable array in MAIN__ is treated like a pointer in terms of memory management (with no explicit deallocation);
  • So, when viewed from the true “main” routine in the entire GCC code, it is the same as
    pointer allocation without deallocation, so regarded as the “definitely lost” memory.

Overall, I think it’s best to use the Fortran main program only for calling other entry routines (in which “real” calculations start). Because future modification of a code may need explicit deallocation (eg, for finalization), I think it is safest to avoid allocatable variables in the main program even if it is no problem at the moment (assuming it is essentially the same as pointers without deallocation…).

!! test2a.f90
program main
    implicit none
    integer, allocatable :: arr(:)  !! "definitely lost"
    allocate( arr(2000), source=777 )
end

!! test2p.f90
program main
    implicit none
    integer, pointer :: arr(:)  !! "definitely lost"
    allocate( arr(2000), source=777 )
end

!! test3a.f90
subroutine mysub()
    implicit none
    integer, allocatable :: arr(:)   !! no leak
    allocate( arr(2000), source=777 )
end

program main
    call mysub()
end

!! test3p.f90
subroutine mysub()
    implicit none
    integer, pointer :: arr(:)   !! "definitely lost"
    allocate( arr(2000), source=777 )
end

program main
    call mysub()
end

!! test4a.f90
subroutine mysub()
    implicit none
    integer, save, allocatable :: arr(:)   !! "still reachable"
    allocate( arr(2000), source=777 )
end

program main
    call mysub()
end

!! test4p.f90
subroutine mysub()
    implicit none
    integer, save, pointer :: arr(:)   !! "still reachable"
    allocate( arr(2000), source=777 )
end

program main
    call mysub()
end

!! test5a.f90
program main
    implicit none
    integer, save, allocatable :: arr(:)  !! "still reachable"
    allocate( arr(2000), source=777 )
end

Compile:

for ver in 2a 2p 3a 3p 4a 4p 5a; do
    gfortran-12 -fdump-tree-original test${ver}.f90
done

Output of test2a.f90 (much simplified & arrow attached by me)

void MAIN__ ()
{
  struct array01_integer(kind=4) arr;   <---

  arr.data = (void * restrict) __builtin_malloc (8000);   <---
  /* fill array */
  /* no deallocation --> "definitely lost" */
}

integer(kind=4) main (integer(kind=4) argc, character(kind=1) * * argv)
{
  _gfortran_set_args (argc, argv);
  _gfortran_set_options (7, &options.3[0]);

  MAIN__ ();
  return 0;
}

Output of test2p.f90

void MAIN__ ()
{
  struct array01_integer(kind=4) arr;   <---

  arr.data = __builtin_malloc (8000);   <---
  /* fill array */
  /* no deallocation --> "definitely lost" */
}

integer(kind=4) main (integer(kind=4) argc, character(kind=1) * * argv)
{
  _gfortran_set_args (argc, argv);
  _gfortran_set_options (7, &options.2[0]);

  MAIN__ ();
  return 0;
}

Output of test3a.f90

void mysub ()
{
  struct array01_integer(kind=4) arr;  <---

  try
  {
    arr.data = (void * restrict) __builtin_malloc (8000);  <---
    /* fill array */
  }
  finally
  {
    if ((integer(kind=4)[0:] * restrict) arr.data != 0B)
    {
       __builtin_free ((void *) arr.data);   <--- explicit deallocation

       (integer(kind=4)[0:] * restrict) arr.data = 0B;
    }
  }
}

void MAIN__ ()
{
  mysub ();
}

integer(kind=4) main (integer(kind=4) argc, character(kind=1) * * argv)
{
  _gfortran_set_args (argc, argv);
  _gfortran_set_options (7, &options.3[0]);

  MAIN__ ();
  return 0;
}

Output of test3p.f90

void mysub ()
{
  struct array01_integer(kind=4) arr;   <---

  arr.data = __builtin_malloc (8000);  <---
  /* fill array */
  /* no deallocation --> "definitely lost" */
}

void MAIN__ ()
{
  mysub ();
}

integer(kind=4) main (integer(kind=4) argc, character(kind=1) * * argv)
{
  _gfortran_set_args (argc, argv);
  _gfortran_set_options (7, &options.2[0]);

  MAIN__ ();
  return 0;
}

Output of test4a.f90

void mysub ()
{
  static struct array01_integer(kind=4) arr = {.data=0B};  <---
  /* static -> "still reachable" */

  if (arr allocated)
  {
     /* Error: Attempting to allocate already allocated variable */
  }
  else
  {
    arr.data = (void * restrict) __builtin_malloc (8000);  <---
    /* fill array */
  }
}

void MAIN__ ()
{
  mysub ();
}

integer(kind=4) main (integer(kind=4) argc, character(kind=1) * * argv)
{
  _gfortran_set_args (argc, argv);
  _gfortran_set_options (7, &options.3[0]);

  MAIN__ ();
  return 0;
}

Output of test4p.f90

void mysub ()
{
  static struct array01_integer(kind=4) arr = {.data=0B};   <---
  /* static -> "still reachable" */

  arr.data = __builtin_malloc (8000);   <---
  /* fill array */
}

void MAIN__ ()
{
  mysub ();
}

integer(kind=4) main (integer(kind=4) argc, character(kind=1) * * argv)
{
  _gfortran_set_args (argc, argv);
  _gfortran_set_options (7, &options.2[0]);

  MAIN__ ();
  return 0;
}

Output of test5a.f90

void MAIN__ ()
{
  static struct array01_integer(kind=4) arr = {.data=0B};  <---
  /* static -> "still reachable" */

  arr.data = (void * restrict) __builtin_malloc (8000);  <---
  /* fill array */
}

integer(kind=4) main (integer(kind=4) argc, character(kind=1) * * argv)
{
  _gfortran_set_args (argc, argv);
  _gfortran_set_options (7, &options.3[0]);

  MAIN__ ();
  return 0;
}

EDIT: Another observation is that, if I attach save explicitly to the allocatable array in the main program (as in test5a.f90), the internal array variable becomes static, and the memory is now regarded as “still reachable” by valgrind. This is in contrast to test2a.f90, where save is not attached explicitly. So, the output of valgrind depends on whether save is used in the main program…

1 Like

On my system using gfortran 13.1 and valgrind-3.15. I get the following output. This combination does not show any “definitely lost” memory. Only “still reachable”. So I take this to reinforce my earlier comments about taking valgrind output for Fortran programs with a grain of salt. The results appear to be dependent on the version of gfortran you are using, the version of valgrind you are using, or both (and using -O0 -g to compile instead of just -g).

gfortran-13 -O0 -g test.f90
valgrind -s --leak-check=full --show-leak-kinds=all --track-origins=yes ./a.out
==3417== Memcheck, a memory error detector
==3417== Copyright (C) 2002-2017, and GNU GPL'd, by Julian Seward et al.
==3417== Using Valgrind-3.15.0 and LibVEX; rerun with -h for copyright info
==3417== Command: ./a.out
==3417== 
==3417== 
==3417== HEAP SUMMARY:
==3417==     in use at exit: 4 bytes in 1 blocks
==3417==   total heap usage: 18 allocs, 17 frees, 5,448 bytes allocated
==3417== 
==3417== 4 bytes in 1 blocks are still reachable in loss record 1 of 1
==3417==    at 0x483B7F3: malloc (in /usr/lib/x86_64-linux-gnu/valgrind/vgpreload_memcheck-amd64-linux.so)
==3417==    by 0x109247: MAIN__ (test.f90:4)
==3417==    by 0x1092EC: main (test.f90:7)
==3417== 
==3417== LEAK SUMMARY:
==3417==    definitely lost: 0 bytes in 0 blocks
==3417==    indirectly lost: 0 bytes in 0 blocks
==3417==      possibly lost: 0 bytes in 0 blocks
==3417==    still reachable: 4 bytes in 1 blocks
==3417==         suppressed: 0 bytes in 0 blocks
==3417== 
==3417== ERROR SUMMARY: 0 errors from 0 contexts (suppressed: 0 from 0)
1 Like

Normally, a programmer would not want any deallocations of allocatable or automatic arrays to occur before program termination. As described above, that is wasted effort not unlike polishing the floors and vacuuming the carpets in a building that is going to be demolished the moment you walk out the door. However, during the debugging stage, particularly when using tools like valgrind to track down memory allocation errors, it seems like this would be a useful task to perform nonetheless. So it seems like the best option for the programmer would be a compiler option, or perhaps overloading an existing debug option, to perform this task before program exit.

1 Like