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 <pa...@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.
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; }
! { dg-do compile } ! { dg-options "-fdump-tree-original" } ! ! Test fix of second testcase in PR64120. ! The first testcase is allocatable_scalar_14.f90. ! ! Contributed by Francois-Xavier Coudert <fxcoud...@gcc.gnu.org> ! program test logical :: L L = g(1) write(*,*) L L = g(2) write(*,*) L contains logical function g(x) integer :: x character(len=x), allocatable :: s save if(.NOT.allocated(s)) then allocate(s) g = .FALSE. else g = .TRUE. end if write(*,*) len(s) end function g end ! { dg-final { scan-tree-dump-times "s = 0B;" 2 "original" } } ! { dg-final { scan-tree-dump-times "__builtin_free" 1 "original" } }