https://gcc.gnu.org/g:7660e3067481159acc3ad76cfae22f71606670c7
commit r16-8479-g7660e3067481159acc3ad76cfae22f71606670c7 Author: Christopher Albert <[email protected]> Date: Fri Apr 3 12:45:57 2026 +0200 fortran: Clean up charlens after rejected parameter arrays [PR79524] When a parameter array declaration such as character(*), parameter :: z(2) = [character(n) :: 'x', 'y'] is rejected, declaration-local charlen nodes from that statement can remain on cl_list and later be resolved again. The charlen's length expression still references the symbol 'n' whose symtree was already freed by gfc_undo_symbols, causing a heap-use-after-free in resolve_charlen. Clean up those statement-local charlens at the rejection point in decl.cc, after clearing the surviving owners in that path. PR fortran/79524 gcc/fortran/ChangeLog: PR fortran/79524 * decl.cc (discard_pending_charlens): New helper. (add_init_expr_to_sym): Drop statement-local charlens when rejecting variable-length parameter arrays. (variable_decl, do_parm, enumerator_decl): Save the current namespace charlen list before parsing declarations with initializers. (match_procedure_decl): Adjust call to add_init_expr_to_sym. gcc/testsuite/ChangeLog: PR fortran/79524 * gfortran.dg/pr79524.f90: New test. Signed-off-by: Christopher Albert <[email protected]> Diff: --- gcc/fortran/decl.cc | 54 +++++++++++++++++++++++++++++++---- gcc/testsuite/gfortran.dg/pr79524.f90 | 9 ++++++ 2 files changed, 58 insertions(+), 5 deletions(-) diff --git a/gcc/fortran/decl.cc b/gcc/fortran/decl.cc index f585800d9c95..6e48909c43a9 100644 --- a/gcc/fortran/decl.cc +++ b/gcc/fortran/decl.cc @@ -131,6 +131,27 @@ discard_pending_charlen (gfc_charlen *cl) free (cl); } +/* Drop the charlen nodes created while matching a declaration that is about + to be rejected. Callers must clear any surviving owners before using this + helper, so only the statement-local nodes remain on the namespace list. */ + +static void +discard_pending_charlens (gfc_charlen *saved_cl) +{ + if (!gfc_current_ns) + return; + + while (gfc_current_ns->cl_list != saved_cl) + { + gfc_charlen *cl = gfc_current_ns->cl_list; + + gcc_assert (cl); + gfc_current_ns->cl_list = cl->next; + gfc_free_expr (cl->length); + free (cl); + } +} + /********************* DATA statement subroutines *********************/ static bool in_match_data = false; @@ -2107,7 +2128,8 @@ fix_initializer_charlen (gfc_typespec *ts, gfc_expr *init) expression to a symbol. */ static bool -add_init_expr_to_sym (const char *name, gfc_expr **initp, locus *var_locus) +add_init_expr_to_sym (const char *name, gfc_expr **initp, locus *var_locus, + gfc_charlen *saved_cl_list) { symbol_attribute attr; gfc_symbol *sym; @@ -2195,6 +2217,16 @@ add_init_expr_to_sym (const char *name, gfc_expr **initp, locus *var_locus) "at %L " "with variable length elements", &sym->declared_at); + + /* This rejection path can leave several + declaration-local charlens on cl_list, + including the replacement symbol charlen and + the array-constructor typespec charlen. + Clear the surviving owners first, then drop + only the nodes created by this declaration. */ + sym->ts.u.cl = NULL; + init->ts.u.cl = NULL; + discard_pending_charlens (saved_cl_list); return false; } clen = mpz_get_si (length->value.integer); @@ -2725,6 +2757,7 @@ variable_decl (int elem) gfc_array_spec *as; gfc_array_spec *cp_as; /* Extra copy for Cray Pointees. */ gfc_charlen *cl; + gfc_charlen *saved_cl_list; bool cl_deferred; locus var_locus; match m; @@ -2735,6 +2768,7 @@ variable_decl (int elem) initializer = NULL; as = NULL; cp_as = NULL; + saved_cl_list = gfc_current_ns->cl_list; /* When we get here, we've just matched a list of attributes and maybe a type and a double colon. The next thing we expect to see @@ -3284,7 +3318,8 @@ variable_decl (int elem) NULL here, because we sometimes also need to check if a declaration *must* have an initialization expression. */ if (!gfc_comp_struct (gfc_current_state ())) - t = add_init_expr_to_sym (name, &initializer, &var_locus); + t = add_init_expr_to_sym (name, &initializer, &var_locus, + saved_cl_list); else { if (current_ts.type == BT_DERIVED @@ -7882,7 +7917,9 @@ match_procedure_decl (void) if (m != MATCH_YES) goto cleanup; - if (!add_init_expr_to_sym (sym->name, &initializer, &gfc_current_locus)) + if (!add_init_expr_to_sym (sym->name, &initializer, + &gfc_current_locus, + gfc_current_ns->cl_list)) goto cleanup; } @@ -10167,9 +10204,12 @@ do_parm (void) { gfc_symbol *sym; gfc_expr *init; + gfc_charlen *saved_cl_list; match m; bool t; + saved_cl_list = gfc_current_ns->cl_list; + m = gfc_match_symbol (&sym, 0); if (m == MATCH_NO) gfc_error ("Expected variable name at %C in PARAMETER statement"); @@ -10210,7 +10250,8 @@ do_parm (void) goto cleanup; } - t = add_init_expr_to_sym (sym->name, &init, &gfc_current_locus); + t = add_init_expr_to_sym (sym->name, &init, &gfc_current_locus, + saved_cl_list); return (t) ? MATCH_YES : MATCH_ERROR; cleanup: @@ -11630,6 +11671,7 @@ enumerator_decl (void) char name[GFC_MAX_SYMBOL_LEN + 1]; gfc_expr *initializer; gfc_array_spec *as = NULL; + gfc_charlen *saved_cl_list; gfc_symbol *sym; locus var_locus; match m; @@ -11637,6 +11679,7 @@ enumerator_decl (void) locus old_locus; initializer = NULL; + saved_cl_list = gfc_current_ns->cl_list; old_locus = gfc_current_locus; /* When we get here, we've just matched a list of attributes and @@ -11693,7 +11736,8 @@ enumerator_decl (void) to be parsed. add_init_expr_to_sym() zeros initializer, so we use last_initializer below. */ last_initializer = initializer; - t = add_init_expr_to_sym (name, &initializer, &var_locus); + t = add_init_expr_to_sym (name, &initializer, &var_locus, + saved_cl_list); /* Maintain enumerator history. */ gfc_find_symbol (name, NULL, 0, &sym); diff --git a/gcc/testsuite/gfortran.dg/pr79524.f90 b/gcc/testsuite/gfortran.dg/pr79524.f90 new file mode 100644 index 000000000000..0b2bfe092adf --- /dev/null +++ b/gcc/testsuite/gfortran.dg/pr79524.f90 @@ -0,0 +1,9 @@ +! { dg-do compile } +! { dg-set-target-env-var MALLOC_PERTURB_ "165" } +! PR fortran/79524 +! Reject parameter arrays with variable-length CHARACTER elements without +! leaving the temporary charlen from the failed declaration on cl_list. +program p + character(*), parameter :: z(2) = [character(n) :: 'x', 'y'] ! { dg-error "Cannot initialize parameter array" } + character(*), parameter :: w(2) = [character(n+1) :: 'a', 'b'] ! { dg-error "Cannot initialize parameter array" } +end
