With 13.0.1 (and earlier...) I've got an issue with a memory leak using allocatables that I strongly suspect is due to erroneous handling of INTENT(OUT) arguments of derived type with allocatable polymorphic components. I thought I had a reproducer, but relevant to my circumstances, but some recent mods to that reproducer now make me think that the problem is with structure constructors.
MODULE m20121031
IMPLICIT NONE
PRIVATE
! Our bug demonstration/workaround option. This was just a sequence number,
! but then we started to get fancy, then we started to get confused.
!
! Bit 0 - false for non-polymorphic container,
! true for polymorphic
! Bit 1 - false for CopyA (INTENT(OUT) dummy),
! true for CopyB (INOUT).
! Bit 2 - false for init using SOURCE=structure constructor,
! true for ye-olde 11.x or whatever bug workaround.
! Bit 3 - false for non-polymorphic dummy in Copy*.
! - true for polymorphic dummy in Copy*.
INTEGER, PUBLIC :: option
INTEGER, PUBLIC, PARAMETER :: bit_polycontainer = 0
INTEGER, PUBLIC, PARAMETER :: bit_inout = 1
INTEGER, PUBLIC, PARAMETER :: bit_strcons = 2
INTEGER, PUBLIC, PARAMETER :: bit_polydummy = 3
PUBLIC :: Init
PUBLIC :: CopyOut
PUBLIC :: CopyOutP
PUBLIC :: CopyInOut
PUBLIC :: CopyInOutP
TYPE, PUBLIC :: Parent
END TYPE Parent
TYPE, PUBLIC :: Container
CLASS(Parent), ALLOCATABLE :: item
END TYPE Container
TYPE, PUBLIC, EXTENDS(Parent) :: Extension
INTEGER, ALLOCATABLE :: large(:)
END TYPE Extension
CONTAINS
! Allocate an object for each item in the container array.
SUBROUTINE Init(c)
TYPE(Container), INTENT(OUT) :: c(:)
INTEGER :: i
!***************************************************************************
DO i = 1, SIZE(c)
! Set each item to be an Extension object, with an array that requires
! 400 kB or so, assuming four bytes per array element.
IF (BTEST(option, bit_strcons)) THEN
! The following makes ifort 13.0.1 babble "error #6593: The number of
! expressions in a structure constructor differs from the number of
! components of the derived type."
! ALLOCATE(c(i)%item, SOURCE=Extension(SPREAD(0.0, 1, 100*1000)))
! So lets do...
ALLOCATE(c(i)%item, SOURCE=Extension(LARGE=SPREAD(0.0, 1, 100*1000)))
! The above seems to be the source of evil? How??? It's only called
! "once", and I'm pretty sure this shortcut wasn't part of my initial
! testing.
ELSE
! This is what we used to (still?) do...
ALLOCATE(Extension :: c(i)%item)
SELECT TYPE (item => c(i)%item)
TYPE IS (Extension)
ALLOCATE(item%large(100*1000))
END SELECT
! but this branch doesn't seem to leak now.
END IF
END DO
END SUBROUTINE init
! The straight forward approach - INTENT(OUT) argument "should" result
! in deallocation of the contents of `to` when this routine is called.
SUBROUTINE CopyOut(from, to)
TYPE(Container), INTENT(IN) :: from(:)
TYPE(Container), INTENT(OUT) :: to(:)
INTEGER :: i
!***************************************************************************
DO i = 1, SIZE(from)
ALLOCATE(to(i)%item, SOURCE=from(i)%item)
END DO
END SUBROUTINE CopyOut
! INTENT(OUT), polymorphic dummy argument.
SUBROUTINE CopyOutP(from, to)
CLASS(Container), INTENT(IN) :: from(:)
CLASS(Container), INTENT(OUT) :: to(:)
INTEGER :: i
!***************************************************************************
DO i = 1, SIZE(from)
ALLOCATE(to(i)%item, SOURCE=from(i)%item)
END DO
END SUBROUTINE CopyOutP
! Let us do some of the compilers work for it.
SUBROUTINE CopyInOut(from, to)
TYPE(Container), INTENT(IN) :: from(:)
TYPE(Container), INTENT(INOUT) :: to(:)
INTEGER :: i
!***************************************************************************
DO i = 1, SIZE(from)
! In larger examples we seen the ALLOCATED test returning true and
! then the deallocate failing because the object wasn't allocated???
IF (ALLOCATED(to(i)%item)) DEALLOCATE(to(i)%item)
ALLOCATE(to(i)%item, SOURCE=from(i)%item)
END DO
END SUBROUTINE CopyInOut
! Let us do some of the compilers work for it, polymorphic dummy.
SUBROUTINE CopyInOutP(from, to)
CLASS(Container), INTENT(IN) :: from(:)
CLASS(Container), INTENT(INOUT) :: to(:)
INTEGER :: i
!***************************************************************************
DO i = 1, SIZE(from)
IF (ALLOCATED(to(i)%item)) DEALLOCATE(to(i)%item)
ALLOCATE(to(i)%item, SOURCE=from(i)%item)
END DO
END SUBROUTINE CopyInOutP
END MODULE m20121031
PROGRAM Leak
USE m20121031
IMPLICIT NONE
! Container size. Just needs to be big enough such that (when combined
! with the size of an individual item in the container) memory
! leakage becomes bleedingly obvious.
INTEGER, PARAMETER :: container_size = 20
! Odd options use the non-polymorphic pair, even options use the
! polymorphic pair.
TYPE(Container), ALLOCATABLE :: ta(:), tb(:)
CLASS(Container), ALLOCATABLE :: ca(:), cb(:)
INTEGER :: i ! Container index.
CHARACTER(4) :: arg ! Command line argument.
!*****************************************************************************
!-----------------------------------------------------------------------------
! Get the workaround option.
IF (COMMAND_ARGUMENT_COUNT() == 0) THEN
PRINT "(A)", 'First command line argument specifies the test option as a &
&bit string.'
PRINT "(A)", 'For a string dcba:'
PRINT "(A)", ' - d: 0 for non-polymorphic dummy in Copy*.'
PRINT "(A)", ' 1 for polymorphic dummy in Copy*.'
PRINT "(A)", ' - c: 0 for ye-olde work around init.'
PRINT "(A)", ' 1 for structure constructor init.'
PRINT "(A)", ' - b: 0 for INTENT(OUT) dummy.'
PRINT "(A)", ' 1 for INTENT(INOUT) dummy.'
PRINT "(A)", ' - a: 0 for non-polymorphic container.'
PRINT "(A)", ' 1 for polymorphic container.'
STOP
END IF
CALL GET_COMMAND_ARGUMENT(1,arg)
READ (arg,"(B4)") option
PRINT "('option is ',B4.4)", option
!-----------------------------------------------------------------------------
! Some setup.
! 20 items in the array means that we need about 8 MB.
IF (BTEST(option, bit_polycontainer)) THEN
ALLOCATE(ca(container_size), cb(container_size))
CALL init(ca)
ELSE
ALLOCATE(ta(container_size), tb(container_size))
CALL init(ta)
END IF
!-----------------------------------------------------------------------------
! Our leaky loop.
! If we leak 8 MB each iteration, then one thousand iterations comfortably
! blows virtual address space on my pathetic little laptop.
DO i = 1, 1000
IF (MOD(i, 10) == 0) PRINT *, i
IF (BTEST(option, bit_polydummy)) THEN
IF (BTEST(option, bit_inout)) THEN
IF (BTEST(option, bit_polycontainer)) THEN
CALL CopyInOutP(ca, cb)
ELSE
CALL CopyInOutP(ta, tb)
END IF
ELSE
IF (BTEST(option, bit_polycontainer)) THEN
CALL CopyOutP(ca, cb)
ELSE
CALL CopyOutP(ta, tb)
END IF
END IF
ELSE
IF (BTEST(option, bit_inout)) THEN
IF (BTEST(option, bit_polycontainer)) THEN
CALL CopyInOut(ca, cb)
ELSE
CALL CopyInOut(ta, tb)
END IF
ELSE
IF (BTEST(option, bit_polycontainer)) THEN
CALL CopyOut(ca, cb)
ELSE
CALL CopyOut(ta, tb)
END IF
END IF
END IF
END DO
END PROGRAM Leak
Build....
>ifort /check:all /warn:all /standard-semantics /Od /traceback /stand:f03 "20121031 leak.f90" Intel(R) Visual Fortran Compiler XE for applications running on IA-32, Version 13.0.1.119 Build 20121008 Copyright (C) 1985-2012 Intel Corporation. All rights reserved. Microsoft (R) Incremental Linker Version 10.00.40219.01 Copyright (C) Microsoft Corporation. All rights reserved. "-out:20121031 leak.exe" -subsystem:console -incremental:no "20121031 leak.obj"
Any option where structure constructors are used (now) seems to trigger the leak, i.e. run with any command line argument that has a bit pattern like "x1xx".
>"20121031 leak.exe" 0100 option is 0100 10 20 30 40 50 60 70 80 90 100 110 120 130 140 150 160 170 180 190 200 210 220 230 240 250 260 forrtl: severe (41): insufficient virtual memory
The speed of execution of the non-structure constructor options "x0xx" makes me wonder whether the leak test is real, but I've not yet looked at the disassembly.
This is a problem I really need to resolve, but a quick review indicates that structure constructors are probably the cause of the issue for me - as I don't seem to use them in the full code. It may be that I need another level of component-ness before the problem manifests, or perhaps my testing above has gone astray. Anyway, something still ain't right with INTENT(OUT) and polymorphic things.



