mirror of
https://gcc.gnu.org/git/gcc.git
synced 2026-02-21 19:35:28 -05:00
Fortran: Fix PR123868
When copying derived types with allocatable array components where the array element type also has allocatable components, the condition at line 11071 was incorrectly triggering a call to gfc_duplicate_allocatable. However, for allocatable arrays with nested allocatables (where cmp_has_alloc_comps && c->as is true), the add_when_allocated code already includes a gfc_duplicate_allocatable call (generated by the recursive structure_alloc_comps call at lines 10290-10293). This caused the outer array to be allocated twice: first by the explicit gfc_duplicate_allocatable call at line 11099, and then again by the gfc_duplicate_allocatable embedded in add_when_allocated. The first allocation was leaked when the second allocation overwrote the data pointer. PR121628 added "add_when_allocated != NULL_TREE ||" to the condition, which was redundant for scalars (already handled by !c->as) and wrong for arrays (caused double allocation). Simply removing this clause restores the correct pre-PR121628 behavior. PR fortran/123868 gcc/fortran/ChangeLog: * trans-array.cc (structure_alloc_comps): For COPY_ALLOC_COMP, remove the add_when_allocated != NULL_TREE clause that PR121628 added. This clause was redundant for scalars and caused double allocation for arrays with nested allocatable components. gcc/testsuite/ChangeLog: * gfortran.dg/array_memcpy_2.f90: Update expected memcpy count from 4 to 3, as the double allocation bug is now fixed. * gfortran.dg/pr123868.f90: New test. Signed-off-by: Christopher Albert <albert@alumni.tugraz.at>
This commit is contained in:
@@ -11063,9 +11063,14 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl, tree dest,
|
||||
copy_wrapper);
|
||||
gfc_add_expr_to_block (&fnblock, call);
|
||||
}
|
||||
/* For allocatable arrays with nested allocatable components,
|
||||
add_when_allocated already includes gfc_duplicate_allocatable
|
||||
(from the recursive structure_alloc_comps call at line 10290-10293),
|
||||
so we must not call it again here. PR121628 added an
|
||||
add_when_allocated != NULL clause that was redundant for scalars
|
||||
(already handled by !c->as) and wrong for arrays (double alloc). */
|
||||
else if (c->attr.allocatable && !c->attr.proc_pointer
|
||||
&& (add_when_allocated != NULL_TREE
|
||||
|| !cmp_has_alloc_comps
|
||||
&& (!cmp_has_alloc_comps
|
||||
|| !c->as
|
||||
|| c->attr.codimension
|
||||
|| caf_in_coarray (caf_mode)))
|
||||
|
||||
@@ -1,11 +1,12 @@
|
||||
! This checks that the "z = y" assignment is not considered copyable, as the
|
||||
! array is of a derived type containing allocatable components. Hence, we
|
||||
! we should expand the scalarized loop, which contains *two* memcpy calls
|
||||
! should expand the scalarized loop, which contains *two* memcpy calls
|
||||
! for the assignment itself, plus one for initialization.
|
||||
! { dg-do compile }
|
||||
! { dg-options "-O2 -fdump-tree-original" }
|
||||
!
|
||||
! PR 121628
|
||||
! PR 123868 - fixed double allocation that caused 4 memcpy instead of 3
|
||||
!
|
||||
type :: a
|
||||
integer, allocatable :: i(:)
|
||||
@@ -26,4 +27,4 @@
|
||||
|
||||
z = y
|
||||
end
|
||||
! { dg-final { scan-tree-dump-times "__builtin_memcpy" 4 "original" } }
|
||||
! { dg-final { scan-tree-dump-times "__builtin_memcpy" 3 "original" } }
|
||||
|
||||
34
gcc/testsuite/gfortran.dg/pr123868.f90
Normal file
34
gcc/testsuite/gfortran.dg/pr123868.f90
Normal file
@@ -0,0 +1,34 @@
|
||||
! { dg-do run }
|
||||
! PR fortran/123868 - Memory leak on assignment with nested allocatable
|
||||
! components. Regression introduced by PR121628 commit which caused
|
||||
! gfc_duplicate_allocatable to be called twice for allocatable array
|
||||
! components with nested allocatable components.
|
||||
|
||||
module bugMod
|
||||
|
||||
type :: vs
|
||||
character(len=1), allocatable :: s
|
||||
end type vs
|
||||
|
||||
type :: ih
|
||||
type(vs), allocatable, dimension(:) :: hk
|
||||
end type ih
|
||||
|
||||
end module bugMod
|
||||
|
||||
program bugProg
|
||||
use bugMod
|
||||
|
||||
block
|
||||
type(ih) :: c, d
|
||||
|
||||
allocate(d%hk(1))
|
||||
allocate(d%hk(1)%s)
|
||||
d%hk(1)%s='z'
|
||||
c=d
|
||||
if (c%hk(1)%s /= 'z') stop 1
|
||||
if (d%hk(1)%s /= 'z') stop 2
|
||||
|
||||
end block
|
||||
|
||||
end program bugProg
|
||||
Reference in New Issue
Block a user