https://gcc.gnu.org/g:e002a4e17481c1a083e2b49374565dbb2621aef8
commit r17-1552-ge002a4e17481c1a083e2b49374565dbb2621aef8 Author: Jerry DeLisle <[email protected]> Date: Sat Jun 13 19:10:04 2026 -0700 fortran: Fix double free in ASSOCIATE over allocatable char function [PR125782] When an ASSOCIATE selector is a function call returning an allocatable deferred-length character, trans_associate_var unconditionally added an extra free of the associate-name's backend decl. That free was added in 2017 (PR60458/77296) to release the result of a POINTER-valued character function, which is not otherwise freed. For an ALLOCATABLE-valued character function, however, the result temporary is already freed by the procedure call's own cleanup code, and the associate name aliases that same temporary, so the extra free caused a double free at the end of the ASSOCIATE block. Restrict the extra free to POINTER-valued function results, where it is still needed. Assisted by: Claude Sonnet 4.6 PR fortran/125782 gcc/fortran/ChangeLog: * trans-stmt.cc (trans_associate_var): Only free the associate name's backend decl for a deferred-length character function result when the result is a POINTER, not when it is ALLOCATABLE, since the latter is already freed by the procedure call's cleanup. gcc/testsuite/ChangeLog: * gfortran.dg/associate_82.f90: New test. Diff: --- gcc/fortran/trans-stmt.cc | 6 +++++- gcc/testsuite/gfortran.dg/associate_82.f90 | 25 +++++++++++++++++++++++++ 2 files changed, 30 insertions(+), 1 deletion(-) diff --git a/gcc/fortran/trans-stmt.cc b/gcc/fortran/trans-stmt.cc index 35dcfc1cf294..0b1a8fa6b140 100644 --- a/gcc/fortran/trans-stmt.cc +++ b/gcc/fortran/trans-stmt.cc @@ -2368,8 +2368,12 @@ trans_associate_var (gfc_symbol *sym, gfc_wrapped_block *block) gfc_add_modify (&se.pre, sym->ts.u.cl->backend_decl, fold_convert (TREE_TYPE (sym->ts.u.cl->backend_decl), se.string_length)); - if (e->expr_type == EXPR_FUNCTION) + if (e->expr_type == EXPR_FUNCTION && gfc_expr_attr (e).pointer) { + /* For an allocatable function result, the result temporary + is already freed by the procedure call's cleanup code; + freeing it again here would be a double free. A pointer + result is not freed there, so do it here. */ tmp = gfc_call_free (sym->backend_decl); gfc_add_expr_to_block (&se.post, tmp); } diff --git a/gcc/testsuite/gfortran.dg/associate_82.f90 b/gcc/testsuite/gfortran.dg/associate_82.f90 new file mode 100644 index 000000000000..762a0844c0af --- /dev/null +++ b/gcc/testsuite/gfortran.dg/associate_82.f90 @@ -0,0 +1,25 @@ +! { dg-do run } +! +! Test the fix for a double free when an ASSOCIATE selector is a function +! returning an allocatable deferred-length character. The cleanup code +! for the associate name freed the result a second time, after the +! procedure call's own cleanup had already freed it. + +module m + implicit none +contains + function get_string () result(val) + character(len=:), allocatable :: val + val = "needle" + end function +end module + +program main + use m + implicit none + + associate (search_string => get_string ()) + if (len (search_string) == 0) STOP 1 + if (search_string // "!" /= "needle!") STOP 2 + end associate +end program
