While tracking down unexpected large memory consumption of our code I think I found a bug in gfortran which I could reproduce with versions 7.5.0, 9.4.0, and 10.3.0. The error does not appear in ifort 19.1.1.217.
In summary: If a factory function returns an allocatable (not a pointer) instance of a virtual class, then it is apparently not correctly destroyed, when it should be.
This applies to cases, where (1) the result is used in an expression and should be immediately deleted, or (2) the result is assigned to a variable of class(...), allocatable type and the variable is allocated via automatic allocation upon assignment.
The following minimal examples demonstrate the problem. In my understanding all these examples should work. So my question is two-fold: Is it actually standard-conforming code, or does it fail because of my coding error? How should I use runtime-polymorphism in practice if this does not work?
All examples use the following module file
module shapes_mod
implicit none
private
public :: Shape_t, Rectangle_t, Circle_t, PI, get_shape, get_volume
real, parameter :: PI = atan(1.0) * 4.0
type, abstract :: Shape_t
contains
procedure(get_area_t), deferred :: get_area
end type
abstract interface
elemental real function get_area_t(this)
import :: Shape_t
class(Shape_t), intent(in) :: this
end function
end interface
type, extends(Shape_t) :: Circle_t
real :: r
contains
procedure :: get_area => get_area_Circle_t
end type
type, extends(Shape_t) :: Rectangle_t
real :: a, b
contains
procedure :: get_area => get_area_Rectangle_t
end type
contains
elemental function get_area_Circle_t(this) result(res)
class(Circle_t), intent(in) :: this
real :: res
res = this%r**2 * PI
end function
elemental function get_area_Rectangle_t(this) result(res)
class(Rectangle_t), intent(in) :: this
real :: res
res = this%a * this%b
end function
pure function get_shape(arg1, arg2) result(res)
!! Contrived constructor, that gives a circle for one and a rectangle for two arguments.
real, intent(in) :: arg1
real, intent(in), optional :: arg2
class(Shape_t), allocatable :: res
if (present(arg2)) then
res = Rectangle_t(arg1, arg2)
else
res = Circle_t(arg1)
end if
end function
elemental function get_volume(base, h) result(res)
!! Get the volume of a prism of the 2D shape base and height h.
class(Shape_t), intent(in) :: base
real, intent(in) :: h
real :: res
res = h * base%get_area()
end function
end module
The following program works correctly as expected:
program main
use shapes_mod, only: Shape_t, Rectangle_t, Circle_t, get_shape, get_volume
implicit none
block
integer :: i
integer, parameter :: n = 4
real, allocatable :: volumes(:)
allocate(volumes(N))
do i = 1, n
if (mod(i, 2) == 0) then
volumes(i) = get_volume(Rectangle_t(1., 2.), 5.)
else
volumes(i) = get_volume(Circle_t(2.), 5.)
end if
end do
write(*, *) volumes
end block
end program
The following program uses a temporary class, allocatable variable.
When running with valgrind I get Invalid write of size 4 and Invalid write of size 8.
program main
use shapes_mod, only: Shape_t, Rectangle_t, Circle_t, get_shape, get_volume
implicit none
block
integer :: i
integer, parameter :: n = 4
real, allocatable :: volumes(:)
class(Shape_t), allocatable :: shape
allocate(volumes(N))
do i = 1, n
if (mod(i, 2) == 0) then
shape = Rectangle_t(1., 2.)
else
shape = Circle_t(3.)
end if
volumes(i) = get_volume(shape, 5.)
end do
write(*, *) volumes
end block
end program
The next example uses the result of factory function directly without assignment.
This example is closest to our actual problem in our large code.
It does memory leak and if the system size parameter n is high enough, one eventually runs out of memory (confirmed with valgrind).
program main
use shapes_mod, only: Shape_t, Rectangle_t, Circle_t, get_shape, get_volume
implicit none
block
integer :: i
integer, parameter :: n = 20
real, allocatable :: volumes(:)
allocate(volumes(N))
do i = 1, n
if (mod(i, 2) == 0) then
volumes(i) = get_volume(get_shape(1., 2.), 5.)
else
volumes(i) = get_volume(get_shape(2.), 5.)
end if
end do
write(*, *) volumes
end block
end program
After playing around for some time and incorporating some of the comments given, I think I solved the problem. Thanks to @PierU, @Vladimir F Героям слава, @Ian Bush for their comments! What was still missing from the comments was a reasonably clean workaround. Hence I will write my own answer now. If there are better ones, I am happy to accept them instead.
As pointed out by @PierU, pure functions may not return polymorphic allocatables and pure subroutines may not have them as intent(out) arguments. That is good to know, but did not fix the problem.
It is actually a bug in gfortran as found by @IanBush here.
The first example where one gets Invalid write of size 4 and Invalid write of size 8 in valgrind is fixed, if one adds an explicit deallocation.
So it has to become
! ...
volumes(i) = get_volume(shape, 5.)
deallocate(shape)
Using a factory subroutine and giving the shape a name instead of reusing the result in an expression solves then the problem.
program main
use shapes_mod, only: Shape_t, Rectangle_t, Circle_t, get_shape, get_volume
implicit none
block
integer :: i
integer, parameter :: n = 20
real, allocatable :: volumes(:)
class(Shape_t), allocatable :: shape
allocate(volumes(N))
do i = 1, n
if (mod(i, 2) == 0) then
call construct_shape(shape, 1., 2.)
else
call construct_shape(shape, 3.)
end if
volumes(i) = get_volume(shape, 5.)
end do
write(*, *) volumes
end block
contains
subroutine construct_shape(shape, arg1, arg2)
!! Contrived constructor, that gives a circle for one and a rectangle for two arguments.
class(Shape_t), allocatable, intent(out) :: shape
real, intent(in) :: arg1
real, intent(in), optional :: arg2
if (present(arg2)) then
shape = Rectangle_t(arg1, arg2)
else
shape = Circle_t(arg1)
end if
end subroutine
end program
Note that shape is of intent(out), allocatable in the factory subroutine, so it is automatically deallocated. (This now actually works in the gfortran implementation.)
So the explicit deallocation is not required.
With this code it cleanly passes valgrind.