From: Mikael Morin <mik...@gcc.gnu.org> Regression-tested on x86_64-pc-linux-gnu. OK for master?
-- >8 -- gcc/fortran/ChangeLog: * trans-array.cc (gfc_trans_deferred_array): Statically initialize deferred length variable for SAVEd character arrays. gcc/testsuite/ChangeLog: * gfortran.dg/save_alloc_character_1.f90: New test. --- gcc/fortran/trans-array.cc | 12 ++++++++-- .../gfortran.dg/save_alloc_character_1.f90 | 22 +++++++++++++++++++ 2 files changed, 32 insertions(+), 2 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/save_alloc_character_1.f90 diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc index 960613167f7..3d274439895 100644 --- a/gcc/fortran/trans-array.cc +++ b/gcc/fortran/trans-array.cc @@ -12067,8 +12067,16 @@ gfc_trans_deferred_array (gfc_symbol * sym, gfc_wrapped_block * block) && !INTEGER_CST_P (sym->ts.u.cl->backend_decl)) { if (sym->ts.deferred && !sym->ts.u.cl->length && !sym->attr.dummy) - gfc_add_modify (&init, sym->ts.u.cl->backend_decl, - build_zero_cst (TREE_TYPE (sym->ts.u.cl->backend_decl))); + { + tree len_expr = sym->ts.u.cl->backend_decl; + tree init_val = build_zero_cst (TREE_TYPE (len_expr)); + if (VAR_P (len_expr) + && sym->attr.save + && !DECL_INITIAL (len_expr)) + DECL_INITIAL (len_expr) = init_val; + else + gfc_add_modify (&init, len_expr, init_val); + } gfc_conv_string_length (sym->ts.u.cl, NULL, &init); gfc_trans_vla_type_sizes (sym, &init); diff --git a/gcc/testsuite/gfortran.dg/save_alloc_character_1.f90 b/gcc/testsuite/gfortran.dg/save_alloc_character_1.f90 new file mode 100644 index 00000000000..ac16e77a01f --- /dev/null +++ b/gcc/testsuite/gfortran.dg/save_alloc_character_1.f90 @@ -0,0 +1,22 @@ +! { dg-do run } +! +! Check that the length variable of SAVEd allocatable character arrays are +! not initialized at function entry. + +program p + implicit none + call s(1) + call s(2) +contains + subroutine s(i) + integer, intent(in) :: i + character(len=:), allocatable, save :: a(:) + integer :: j + if (i == 1) then + allocate(a, source= [ ('x' // achar(ichar('0') + j), j=1,7) ]) + else + if (len(a) /= 2) error stop 1 + if (any(a /= ['x1','x2','x3','x4','x5','x6','x7'])) error stop 2 + end if + end subroutine s +end program p -- 2.47.2