https://gcc.gnu.org/g:1fe80b2edf859d7bc66207d32d7ba1213f406799
commit r17-5275-g1fe80b2edf859d7bc66207d32d7ba1213f406799 Author: Jerry DeLisle <[email protected]> Date: Fri Oct 16 11:14:56 2026 -0700 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. Diff: --- 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(-) diff --git a/gcc/fortran/trans-stmt.cc b/gcc/fortran/trans-stmt.cc index 1fc996d7739d..224d359c0e71 100644 --- a/gcc/fortran/trans-stmt.cc +++ b/gcc/fortran/trans-stmt.cc @@ -8010,8 +8010,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)) { @@ -8058,16 +8067,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 36c1245ccdd8..71f9068f3ea5 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 000000000000..1ff3c4a34b0e --- /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
