diff mbox series

[fortran] PR64120

Message ID CAGkQGiLdhdtfA6upoYzmaHj29bc1GaR=nDhpWhryKgJp=seFrQ@mail.gmail.com
State New
Headers show
Series [fortran] PR64120 | expand

Commit Message

Paul Richard Thomas Oct. 31, 2023, 2:11 p.m. UTC 
I found this 'obvious' fix, while going through PRs assigned to me.

Regtests. OK for mainline?

Cheers

Paul


Fortran: Allocatable automatic charlen must not be saved [PR64120].

2023-10-31  Paul Thomas  <pault@gcc.gnu.org>

gcc/fortran
PR fortran/64120
* trans-decl.cc (gfc_trans_deferred_vars): Detect automatic
character length and allow allocatable variants to be nullified
on scope entry and freed on scope exit. Remove trailing white
space.

gcc/testsuite/
PR fortran/64120
* gfortran.dg/pr64120_2.f90: New test.

Comments

Steve Kargl Oct. 31, 2023, 4:38 p.m. UTC | #1 
On Tue, Oct 31, 2023 at 02:11:08PM +0000, Paul Richard Thomas wrote:
> I found this 'obvious' fix, while going through PRs assigned to me.
> 
> Regtests. OK for mainline?
> 

Yes.  Fell free to backport if you have time and desire.
diff mbox series

Patch

diff --git a/gcc/fortran/trans-decl.cc b/gcc/fortran/trans-decl.cc
index a3f037bd07b..5e0e78ace40 100644
--- a/gcc/fortran/trans-decl.cc
+++ b/gcc/fortran/trans-decl.cc
@@ -4689,9 +4689,14 @@  gfc_trans_deferred_vars (gfc_symbol * proc_sym, gfc_wrapped_block * block)
 				&& (sym->ts.u.derived->attr.alloc_comp
 				    || gfc_is_finalizable (sym->ts.u.derived,
 							   NULL));
+      bool automatic_char_len;
       if (sym->assoc)
 	continue;
 
+      automatic_char_len = sym->ts.type == BT_CHARACTER
+			   && sym->ts.u.cl && sym->ts.u.cl->length
+			   && sym->ts.u.cl->length->expr_type == EXPR_VARIABLE;
+
       /* Set the vptr of unlimited polymorphic pointer variables so that
 	 they do not cause segfaults in select type, when the selector
 	 is an intrinsic type.  */
@@ -4951,7 +4956,8 @@  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)
+	  if ((!sym->attr.save || automatic_char_len)
+	       && flag_max_stack_var_size != 0)
 	    {
 	      tree descriptor = NULL_TREE;
 
@@ -5210,8 +5216,8 @@  gfc_trans_deferred_vars (gfc_symbol * proc_sym, gfc_wrapped_block * block)
 	tree tmp = lookup_attribute ("omp allocate",
 				     DECL_ATTRIBUTES (n->sym->backend_decl));
 	tmp = TREE_VALUE (tmp);
-	TREE_PURPOSE (tmp) = se.expr;	
-	TREE_VALUE (tmp) = align;	
+	TREE_PURPOSE (tmp) = se.expr;
+	TREE_VALUE (tmp) = align;
 	TREE_PURPOSE (TREE_CHAIN (tmp)) = init_stmtlist;
 	TREE_VALUE (TREE_CHAIN (tmp)) = cleanup_stmtlist;
       }