See attached.
I plan to commit this as obvious/simple.
Regression tested on X86_64
Best regards
Jerry
Author: Jerry DeLisle <[email protected]>
Date: Sat Jun 13 19:10:04 2026 -0700
fortran: Fix double free for ASSOCIATE over allocatable character 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.
commit 35617021d57cea3bfdaa9dad372ec9114aeb395f
Author: Jerry DeLisle <[email protected]>
Date: Sat Jun 13 19:10:04 2026 -0700
fortran: Fix double free for ASSOCIATE over allocatable character 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 --git a/gcc/fortran/trans-stmt.cc b/gcc/fortran/trans-stmt.cc
index 35dcfc1cf29..0b1a8fa6b14 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 00000000000..762a0844c0a
--- /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
