[PATCH] Fix Bug 79524 - [Regression] valgrind error for gcc/testsuite/gfortran.dg/fimplicit_none_2.f90

From 3f500986c7fa6e8a437689a532ec8b5da65a530b Mon Sep 17 00:00:00 2001
From: Christopher Albert <[email protected]>
Date: Fri, 3 Apr 2026 12:45:57 +0200
Subject: [PATCH] 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]>
---
 gcc/fortran/decl.cc                   | 54 ++++++++++++++++++++++++---
 gcc/testsuite/gfortran.dg/pr79524.f90 |  9 +++++
 2 files changed, 58 insertions(+), 5 deletions(-)
 create mode 100644 gcc/testsuite/gfortran.dg/pr79524.f90

diff --git a/gcc/fortran/decl.cc b/gcc/fortran/decl.cc
index f585800d9c9..6e48909c43a 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 00000000000..0b2bfe092ad
--- /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
-- 
2.53.0