From: Mikael Morin <[email protected]>
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