See attached patch. The finalization wrapper of a CLASS object
deallocates the allocatable components of a non-allocatable array
component with expressions like ptr2%entries(:)%children.
gfc_trans_deallocate already has a branch for that form, but the
generic allocatable-component branch before it also ran, using the type
of children for the elements of entries, so it freed whatever lay at
the offset of a component of the wrong type. The fix computes the
test for that form once and skips the generic branch for it; the
special branch already frees all allocatable components of the
elements.
The fix is in gfc_trans_deallocate in trans-stmt.cc.
allocate_with_source_14.f03 counted the bogus free, so its expected
__builtin_free count drops from 29 to 28; finalize_64.f90 is the new
test.
Regression tested on x86_64.
OK for mainline?
Regards,
Jerry
---
fortran: [PR127941] Fix invalid free in CLASS finalization wrapper
Deallocating a CLASS object whose type has a non-allocatable derived
type array component with nested allocatable components freed an
invalid pointer. For such a component the finalization wrapper
deallocates an expression like ptr%entries(:)%children, and
gfc_trans_deallocate already handles that form by deallocating the
allocatable components of the array elements. It also ran the generic
allocatable-component cleanup with the type of the last component,
which applied that type's components to the array elements. The patch
skips the generic cleanup for this form.
Assisted-by: Claude Opus 5.5
PR fortran/127941
gcc/fortran/ChangeLog:
* trans-stmt.cc (gfc_trans_deallocate): Do not deallocate the
allocatable components of the last component's type when the
expression is a non-allocatable array component generated by
finalize_component.
gcc/testsuite/ChangeLog:
* gfortran.dg/allocate_with_source_14.f03: Expect one fewer call
to __builtin_free.
* gfortran.dg/finalize_64.f90: New test.
>From eb1c4944e1fb9f745229cbb2ca6cca21b5172aee Mon Sep 17 00:00:00 2001
From: Jerry DeLisle <[email protected]>
Date: Fri, 16 Oct 2026 11:14:56 -0700
Subject: [PATCH] fortran: [PR127941] Fix invalid free in CLASS finalization
wrapper
Deallocating a CLASS object whose type has a non-allocatable derived
type array component with nested allocatable components freed an
invalid pointer. For such a component the finalization wrapper
deallocates an expression like ptr%entries(:)%children, and
gfc_trans_deallocate already handles that form by deallocating the
allocatable components of the array elements. It also ran the generic
allocatable-component cleanup with the type of the last component,
which applied that type's components to the array elements. The patch
skips the generic cleanup for this form.
Assisted-by: Claude Opus 5.5
PR fortran/127941
gcc/fortran/ChangeLog:
* trans-stmt.cc (gfc_trans_deallocate): Do not deallocate the
allocatable components of the last component's type when the
expression is a non-allocatable array component generated by
finalize_component.
gcc/testsuite/ChangeLog:
* gfortran.dg/allocate_with_source_14.f03: Expect one fewer call
to __builtin_free.
* gfortran.dg/finalize_64.f90: New test.
---
gcc/fortran/trans-stmt.cc | 25 +++++-----
.../gfortran.dg/allocate_with_source_14.f03 | 2 +-
gcc/testsuite/gfortran.dg/finalize_64.f90 | 49 +++++++++++++++++++
3 files changed, 64 insertions(+), 12 deletions(-)
create mode 100644 gcc/testsuite/gfortran.dg/finalize_64.f90
diff --git a/gcc/fortran/trans-stmt.cc b/gcc/fortran/trans-stmt.cc
index 5b20dd3550d..9b8100496ab 100644
--- a/gcc/fortran/trans-stmt.cc
+++ b/gcc/fortran/trans-stmt.cc
@@ -8129,8 +8129,17 @@ gfc_trans_deallocate (gfc_code *code)
if (expr->rank || is_coarray_array)
{
gfc_ref *ref;
-
- if (gfc_bt_struct (expr->ts.type)
+ /* class.cc(finalize_component) generates these, when a
+ finalizable entity has a non-allocatable derived type array
+ component, which has allocatable components. EXPR then has the
+ type of its last component, not of the array elements. */
+ bool fini_comp_array
+ = (TREE_CODE (se.expr) == COMPONENT_REF
+ && TREE_CODE (TREE_TYPE (se.expr)) == ARRAY_TYPE
+ && TREE_CODE (TREE_TYPE (TREE_TYPE (se.expr))) == RECORD_TYPE);
+
+ if (!fini_comp_array
+ && gfc_bt_struct (expr->ts.type)
&& expr->ts.u.derived->attr.alloc_comp
&& !gfc_is_finalizable (expr->ts.u.derived, NULL))
{
@@ -8177,16 +8186,10 @@ gfc_trans_deallocate (gfc_code *code)
caf_dtype);
gfc_add_expr_to_block (&se.pre, tmp);
}
- else if (TREE_CODE (se.expr) == COMPONENT_REF
- && TREE_CODE (TREE_TYPE (se.expr)) == ARRAY_TYPE
- && TREE_CODE (TREE_TYPE (TREE_TYPE (se.expr)))
- == RECORD_TYPE)
+ else if (fini_comp_array)
{
- /* class.cc(finalize_component) generates these, when a
- finalizable entity has a non-allocatable derived type array
- component, which has allocatable components. Obtain the
- derived type of the array and deallocate the allocatable
- components. */
+ /* Obtain the derived type of the array and deallocate the
+ allocatable components. */
for (ref = expr->ref; ref; ref = ref->next)
{
if (ref->u.c.component->attr.dimension
diff --git a/gcc/testsuite/gfortran.dg/allocate_with_source_14.f03 b/gcc/testsuite/gfortran.dg/allocate_with_source_14.f03
index 36c1245ccdd..71f9068f3ea 100644
--- a/gcc/testsuite/gfortran.dg/allocate_with_source_14.f03
+++ b/gcc/testsuite/gfortran.dg/allocate_with_source_14.f03
@@ -211,4 +211,4 @@ program main
deallocate(av)
end program
! { dg-final { scan-tree-dump-times "__builtin_malloc" 23 "original" } }
-! { dg-final { scan-tree-dump-times "__builtin_free" 29 "original" } }
+! { dg-final { scan-tree-dump-times "__builtin_free" 28 "original" } }
diff --git a/gcc/testsuite/gfortran.dg/finalize_64.f90 b/gcc/testsuite/gfortran.dg/finalize_64.f90
new file mode 100644
index 00000000000..1ff3c4a34b0
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/finalize_64.f90
@@ -0,0 +1,49 @@
+! { dg-do run }
+!
+! PR 127941
+!
+! Deallocating a CLASS object whose type has a non-allocatable derived
+! type array component with nested allocatable components freed an
+! invalid pointer in the finalization wrapper.
+
+module m
+ type leaf
+ real, allocatable :: value
+ end type
+ type item
+ integer :: tag = 1
+ type(leaf), allocatable :: children(:)
+ end type
+ type container
+ type(item) :: entries(1)
+ end type
+ type, extends(container) :: ext
+ type(item) :: more(2,3)
+ end type
+end module
+
+program p
+ use m
+ class(container), allocatable :: x, y(:)
+
+ allocate (x)
+ deallocate (x)
+
+ allocate (x)
+ allocate (x%entries(1)%children(2))
+ allocate (x%entries(1)%children(2)%value, source = 1.0)
+ deallocate (x)
+
+ allocate (ext :: x)
+ select type (x)
+ type is (ext)
+ allocate (x%more(2,3)%children(1))
+ allocate (x%more(2,3)%children(1)%value, source = 2.0)
+ end select
+ deallocate (x)
+
+ allocate (y(3))
+ allocate (y(2)%entries(1)%children(4))
+ allocate (y(2)%entries(1)%children(3)%value, source = 3.0)
+ deallocate (y)
+end program
--
2.56.0
