[PATCH] Fortran: deferred-length character results and -fno-automatic [PR78187]

From 2a57ad4fc46d6182c29137e3632a5a58496a97ba Mon Sep 17 00:00:00 2001
From: Harald Anlauf <[email protected]>
Date: Tue, 24 Feb 2026 20:58:53 +0100
Subject: [PATCH] Fortran: deferred-length character results and -fno-automatic
 [PR78187]

As the SAVE attribute cannot be specified for dummy variables and function
results (F2023:C862), the option -fno-automatic should not treat them as
automatically saved.

	PR fortran/78187

gcc/fortran/ChangeLog:

	* trans-decl.cc (gfc_trans_deferred_vars): An initialization block
	shall be generated for deferred-length character results even
	when -fno-automatic is given.

gcc/testsuite/ChangeLog:

	* gfortran.dg/deferred_character_40.f90: New test.
---
 gcc/fortran/trans-decl.cc                     |  8 +-
 .../gfortran.dg/deferred_character_40.f90     | 81 +++++++++++++++++++
 2 files changed, 88 insertions(+), 1 deletion(-)
 create mode 100644 gcc/testsuite/gfortran.dg/deferred_character_40.f90

diff --git a/gcc/fortran/trans-decl.cc b/gcc/fortran/trans-decl.cc
index 851ccc45263..f80e7241577 100644
--- a/gcc/fortran/trans-decl.cc
+++ b/gcc/fortran/trans-decl.cc
@@ -5220,7 +5220,13 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, gfc_wrapped_block * block)
 		    || (sym->ts.type == BT_CLASS
 			&& CLASS_DATA (sym)->attr.allocatable)))
 	{
-	  if (!sym->attr.save && flag_max_stack_var_size != 0)
+	  /* Ensure that the initialization block may be generated also for
+	     dummy and result variables when -fno-automatic is specified, which
+	     sets flag_max_stack_var_size=0.  */
+	  if (!sym->attr.save
+	      && (flag_max_stack_var_size != 0
+		  || sym->attr.dummy
+		  || sym->attr.result))
 	    {
 	      tree descriptor = NULL_TREE;
 
diff --git a/gcc/testsuite/gfortran.dg/deferred_character_40.f90 b/gcc/testsuite/gfortran.dg/deferred_character_40.f90
new file mode 100644
index 00000000000..69283441396
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/deferred_character_40.f90
@@ -0,0 +1,81 @@
+! { dg-do run }
+! { dg-options "-O2 -fno-automatic" }
+!
+! PR fortran/78187 - deferred-length character results and -fno-automatic
+
+program pr78187
+  implicit none
+  character(len=:), allocatable :: a, b, c, d
+  save :: b,c,d
+  c = scalar()
+  d = scalar_with_result()
+  if (len (c) /= 6) stop 11
+  if (len (d) /= 6) stop 12
+  deallocate (c,d)
+  c = pass_scalar()
+  d = pass_scalar_with_result()
+  if (len (c) /= 6) stop 13
+  if (len (d) /= 6) stop 14
+  deallocate (c,d)
+  call sub (c,d)
+  if (len (c) /= 6) stop 15
+  if (len (d) /= 6) stop 16
+  deallocate (c,d)
+  call sub2 (c,d)
+  if (len (c) /= 3) stop 17
+  if (len (d) /= 6) stop 18
+  deallocate (c,d)
+  a = concat ("abc","def")
+  b = concat ("abc","def")
+  if (len (a) /= 6) stop 19
+  if (len (b) /= 6) stop 20
+contains
+  function concat(a, b) result(c)
+    character(len=*), intent(in) :: a, b
+    character(len=:), allocatable :: c
+    c = trim(a)//trim(b)
+  end function concat
+
+  function scalar()
+    character(len=:), allocatable :: scalar
+    scalar = "abcdef"
+    if (len(scalar) /= 6) stop 1
+  end function scalar
+
+  function scalar_with_result() result(s)
+    character(len=:), allocatable :: s
+    s = "abcdef"
+    if (len(s) /= 6) stop 2
+  end function scalar_with_result
+
+  function pass_scalar ()
+    character(len=:), allocatable :: pass_scalar
+    pass_scalar = scalar ()
+    if (len(pass_scalar) /= 6) stop 3
+  end function pass_scalar
+
+  function pass_scalar_with_result() result(s)
+    character(len=:), allocatable :: s
+    s = scalar_with_result ()
+    if (len(s) /= 6) stop 4
+  end function pass_scalar_with_result
+
+  subroutine sub (s1, s2)
+    character(len=:), allocatable :: s1, s2
+    s1 = scalar ()
+    s2 = scalar_with_result ()
+    if (len(s1) /= 6) stop 5
+    if (len(s2) /= 6) stop 6
+  end subroutine sub
+
+  subroutine sub2 (s1, s2)
+    character(len=:), allocatable :: s1, s2
+    character(len=:), allocatable :: s
+    s  = "abc"
+    s1 = s
+    s  = scalar_with_result ()
+    s2 = s
+    if (len(s1) /= 3) stop 7
+    if (len(s2) /= 6) stop 8
+  end subroutine sub2
+end program
-- 
2.51.0