https://gcc.gnu.org/g:9579e3eb64ec89c4c0781bb0a59409f15c997213
commit r17-1786-g9579e3eb64ec89c4c0781bb0a59409f15c997213 Author: Jerry DeLisle <[email protected]> Date: Fri Jun 19 14:54:00 2026 -0700 fortran: Fix memory leak for array structure-constructor element [PR121972] Fix the remaining leak in pdt_86.f03. Added a new test in asan to avoid it. PR fortran/121972 gcc/fortran/ChangeLog: * trans-array.cc (has_class_alloc_comp): New helper; returns true if derived type DER has any CLASS component. (gfc_trans_array_ctor_element): Also free allocatable components when the element expression is EXPR_STRUCTURE, skipping types that contain CLASS components to avoid freeing stack-allocated _data pointers. (gfc_constructor_is_owned_alloc_comp): Likewise treat EXPR_STRUCTURE elements as owned only when the derived type has no CLASS components. * trans-expr.cc (gfc_trans_alloc_subarray_assign): Free allocatable components of the component's temporary descriptor before nulling its data pointer, for non-variable source expressions. gcc/testsuite/ChangeLog: * gfortran.dg/class_array_15.f03: Adjust expected free count. * gfortran.dg/derived_constructor_comps_6.f90: Adjust expected free count. * gfortran.dg/asan/structure_constructor_alloc_comp_leak_1.f90: New test. Diff: --- gcc/fortran/trans-array.cc | 29 ++++++++++++++--- gcc/fortran/trans-expr.cc | 11 +++++-- .../structure_constructor_alloc_comp_leak_1.f90 | 36 ++++++++++++++++++++++ gcc/testsuite/gfortran.dg/class_array_15.f03 | 2 +- .../gfortran.dg/derived_constructor_comps_6.f90 | 2 +- 5 files changed, 71 insertions(+), 9 deletions(-) diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc index 9d8e913a84a9..cde5d3e4b32a 100644 --- a/gcc/fortran/trans-array.cc +++ b/gcc/fortran/trans-array.cc @@ -1967,6 +1967,20 @@ static bool first_len; static tree first_len_val; static bool typespec_chararray_ctor; +/* Return true if DER has any CLASS allocatable component. Such components + are initialised by VIEW_CONVERT in structure constructors (a bitwise copy + of the class descriptor), so their _data pointer may refer to a non-heap + object and must not be passed to gfc_deallocate_alloc_comp_no_caf. */ + +static bool +has_class_alloc_comp (gfc_symbol *der) +{ + for (gfc_component *c = der->components; c; c = c->next) + if (c->ts.type == BT_CLASS && !c->attr.pointer) + return true; + return false; +} + static void gfc_trans_array_ctor_element (stmtblock_t * pblock, tree desc, tree offset, gfc_se * se, gfc_expr * expr) @@ -1978,12 +1992,15 @@ gfc_trans_array_ctor_element (stmtblock_t * pblock, tree desc, /* Store the value. */ tmp = build_fold_indirect_ref_loc (input_location, gfc_conv_descriptor_data_get (desc)); - /* The offset may change, so get its value now and use that to free memory. - */ + + /* The offset may change, so get its value now and use that to free memory. */ offset_eval = gfc_evaluate_now (offset, &se->pre); tmp = gfc_build_array_ref (tmp, offset_eval, NULL); - if (expr->expr_type == EXPR_FUNCTION && expr->ts.type == BT_DERIVED + if (expr->ts.type == BT_DERIVED + && (expr->expr_type == EXPR_FUNCTION + || (expr->expr_type == EXPR_STRUCTURE + && !has_class_alloc_comp (expr->ts.u.derived))) && expr->ts.u.derived->attr.alloc_comp) gfc_add_expr_to_block (&se->finalblock, gfc_deallocate_alloc_comp_no_caf (expr->ts.u.derived, @@ -2168,8 +2185,10 @@ gfc_constructor_is_owned_alloc_comp (gfc_constructor_base base, if (!gfc_constructor_is_owned_alloc_comp (e->value.constructor, der)) return false; } - else if (!(e->expr_type == EXPR_FUNCTION - && e->ts.type == BT_DERIVED + else if (!(e->ts.type == BT_DERIVED + && (e->expr_type == EXPR_FUNCTION + || (e->expr_type == EXPR_STRUCTURE + && !has_class_alloc_comp (e->ts.u.derived))) && e->ts.u.derived == der)) return false; } diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc index 6e3661a09224..9108e92b4468 100644 --- a/gcc/fortran/trans-expr.cc +++ b/gcc/fortran/trans-expr.cc @@ -9855,8 +9855,15 @@ gfc_trans_alloc_subarray_assign (tree dest, gfc_component * cm, gfc_add_block_to_block (final_block, &se.finalblock); if (expr->expr_type != EXPR_VARIABLE) - gfc_conv_descriptor_data_set (&block, se.expr, - null_pointer_node); + { + if (gfc_bt_struct (cm->ts.type) && cm->ts.u.derived->attr.alloc_comp) + { + tmp = gfc_deallocate_alloc_comp_no_caf (cm->ts.u.derived, + se.expr, cm->as->rank, true); + gfc_add_expr_to_block (&block, tmp); + } + gfc_conv_descriptor_data_set (&block, se.expr, null_pointer_node); + } /* We need to know if the argument of a conversion function is a variable, so that the correct lower bound can be used. */ diff --git a/gcc/testsuite/gfortran.dg/asan/structure_constructor_alloc_comp_leak_1.f90 b/gcc/testsuite/gfortran.dg/asan/structure_constructor_alloc_comp_leak_1.f90 new file mode 100644 index 000000000000..5144c83aa365 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/asan/structure_constructor_alloc_comp_leak_1.f90 @@ -0,0 +1,36 @@ +! { dg-do run } + +! PR fortran/121972 + +! A structure constructor used as an array-constructor element whose type has +! allocatable components leaked those components. gfc_trans_array_ctor_element +! freed alloc comps only for EXPR_FUNCTION elements; EXPR_STRUCTURE was missed. +! gfc_trans_alloc_subarray_assign also nulled the temp descriptor data pointer +! without first freeing the element alloc comps. Checked under -fsanitize=address. + +module m + implicit none + type string_t + character(len=:), allocatable :: s + end type + type file_t + type(string_t), allocatable :: lines(:) + end type +contains + subroutine check (line) + character(len=*), intent(in) :: line + type(file_t) :: f + f = file_t([string_t(line)]) + if (.not. allocated (f%lines)) stop 1 + if (size (f%lines) /= 1) stop 2 + if (.not. allocated (f%lines(1)%s)) stop 3 + if (f%lines(1)%s /= line) stop 4 + end subroutine +end module + +program structure_constructor_alloc_comp_leak_1 + use m + call check ('hello') + call check ('world') + call check ('a longer string value') +end program diff --git a/gcc/testsuite/gfortran.dg/class_array_15.f03 b/gcc/testsuite/gfortran.dg/class_array_15.f03 index f53b2356952a..c726e6e8acb3 100644 --- a/gcc/testsuite/gfortran.dg/class_array_15.f03 +++ b/gcc/testsuite/gfortran.dg/class_array_15.f03 @@ -115,4 +115,4 @@ subroutine pr54992 ! This test remains as the original. bh => bhGet(b,instance=2) if (loc (b) .ne. loc(bh%hostNode)) STOP 8 end -! { dg-final { scan-tree-dump-times "builtin_free" 16 "original" } } +! { dg-final { scan-tree-dump-times "builtin_free" 17 "original" } } diff --git a/gcc/testsuite/gfortran.dg/derived_constructor_comps_6.f90 b/gcc/testsuite/gfortran.dg/derived_constructor_comps_6.f90 index 406e031456ff..09cb9946bbf3 100644 --- a/gcc/testsuite/gfortran.dg/derived_constructor_comps_6.f90 +++ b/gcc/testsuite/gfortran.dg/derived_constructor_comps_6.f90 @@ -130,4 +130,4 @@ contains end function new_prt_spec3 end program main ! { dg-final { scan-tree-dump-times "__builtin_malloc" 16 "original" } } -! { dg-final { scan-tree-dump-times "__builtin_free" 33 "original" } } +! { dg-final { scan-tree-dump-times "__builtin_free" 35 "original" } }
