[gcc r17-2625] fortran: [PR53296] Fix character array-ctor function called twice

https://gcc.gnu.org/g:f764d7111a29d8323e49a87a8321072295c73244

commit r17-2625-gf764d7111a29d8323e49a87a8321072295c73244
Author: Jerry DeLisle <[email protected]>
Date:   Tue Jul 21 09:15:50 2026 -0700

    fortran: [PR53296] Fix character array-ctor function called twice
    
    Avoid the redundant generated call to the pre chain when
    no_function_call is set.
    
    Also fix a related stack-buffer-overflow: gfc_conv_array_parameter
    wrote over the array constructor's. The specified length was to short.
    Use the explicit character type-spec length instead.
    
            PR fortran/53296
    
    gcc/fortran/ChangeLog:
    
            * trans-expr.cc (gfc_conv_procedure_call): Skip the redundant
            function call added to the pre chain when no_function_call is
            set and the character result length was already determined
            without running the callee.
            * trans-array.cc (gfc_conv_array_parameter): Convert an array
            constructor's explicit character type-spec length directly
            instead of using the first elements length.
    
    gcc/testsuite/ChangeLog:
    
            * gfortran.dg/array_constructor_59.f90: New test.

Diff:
---
 gcc/fortran/trans-array.cc                         | 15 +++++++++++++-
 gcc/fortran/trans-expr.cc                          |  9 ++++++++-
 gcc/testsuite/gfortran.dg/array_constructor_59.f90 | 23 ++++++++++++++++++++++
 3 files changed, 45 insertions(+), 2 deletions(-)

diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 6d73b2370e90..91fa43b26831 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -8892,7 +8892,20 @@ gfc_conv_array_parameter (gfc_se *se, gfc_expr *expr, bool g77,
 
   if (expr->expr_type == EXPR_ARRAY && expr->ts.type == BT_CHARACTER)
     {
-      get_array_ctor_strlen (&se->pre, expr->value.constructor, &tmp);
+      if (expr->ts.u.cl->length_from_typespec && expr->ts.u.cl->length)
+	{
+	  /* The constructor has an explicit character type-spec length
+	     so convert it directly.  */
+	  gfc_se cse;
+	  gfc_init_se (&cse, NULL);
+	  gfc_conv_expr_type (&cse, expr->ts.u.cl->length,
+			      gfc_charlen_type_node);
+	  gfc_add_block_to_block (&se->pre, &cse.pre);
+	  tmp = cse.expr;
+	}
+      else
+	get_array_ctor_strlen (&se->pre, expr->value.constructor, &tmp);
+
       expr->ts.u.cl->backend_decl = tmp;
       se->string_length = tmp;
     }
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 1083ea3fbbd2..33b7838f74ac 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -6996,6 +6996,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
   int arglen;
   unsigned int argc;
   tree arg1_cntnr = NULL_TREE;
+  bool call_needed_for_length = true;
   arglist = NULL;
   retargs = NULL;
   stringargs = NULL;
@@ -8695,6 +8696,10 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
 				 fold_convert (gfc_charlen_type_node, tmp),
 				 build_zero_cst (gfc_charlen_type_node));
 	  cl.backend_decl = tmp;
+
+	  /* The length was fully computed above from the specification
+	     expression, without needing the callee to actually run.  */
+	  call_needed_for_length = false;
 	}
 
       /* Set up a charlen structure for it.  */
@@ -9004,7 +9009,9 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
   if (byref)
     {
       /* Add the function call to the pre chain.  There is no expression.  */
-      gfc_add_expr_to_block (&se->pre, se->expr);
+      if (!se->no_function_call || call_needed_for_length)
+	gfc_add_expr_to_block (&se->pre, se->expr);
+
       se->expr = NULL_TREE;
 
       if (!se->direct_byref)
diff --git a/gcc/testsuite/gfortran.dg/array_constructor_59.f90 b/gcc/testsuite/gfortran.dg/array_constructor_59.f90
new file mode 100644
index 000000000000..31169163a3e4
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/array_constructor_59.f90
@@ -0,0 +1,23 @@
+! { dg-do run }
+! PR fortran/53296
+! Test case based on the test case from Steve Kargl
+program pr53296
+  implicit none
+  character(len=128) :: str(2)
+  integer :: ncalls = 0
+
+  str = [ucase("abcde"), ucase("ghij")]
+  if (ncalls /= 2) stop 1
+  if (trim (str(1)) /= "abcde") stop 2
+  if (trim (str(2)) /= "ghij") stop 3
+
+contains
+
+  function ucase(s)
+    character(*), intent(in) :: s
+    character(len(s)) :: ucase
+    ncalls = ncalls + 1
+    ucase = s
+  end function ucase
+
+end program pr53296