This patch is relatively trivial. This initialization of the string
length was not being done.
Bootstraps and regtests on FC28/x86_64. OK for trunk?
Paul
2018-09-17 Paul Thomas <[email protected]>
PR fortran/64120
* trans-decl.c (gfc_get_symbol_decl): Flag allocatable, scalar
characters with a variable length expression for deferred init.
(gfc_trans_deferred_vars): Perform the assignment for these
symbols by calling gfc_conv_string_length.
2018-09-17 Paul Thomas <[email protected]>
PR fortran/64120
* gfortran.dg/allocatable_scalar_14.f90 : New test.
Index: gcc/fortran/trans-decl.c
===================================================================
*** gcc/fortran/trans-decl.c (revision 264358)
--- gcc/fortran/trans-decl.c (working copy)
*************** gfc_get_symbol_decl (gfc_symbol * sym)
*** 1745,1750 ****
--- 1745,1757 ----
&& !(sym->attr.use_assoc && !intrinsic_array_parameter)))
gfc_defer_symbol_init (sym);
+ if (sym->ts.type == BT_CHARACTER
+ && sym->attr.allocatable
+ && !sym->attr.dimension
+ && sym->ts.u.cl && sym->ts.u.cl->length
+ && sym->ts.u.cl->length->expr_type == EXPR_VARIABLE)
+ gfc_defer_symbol_init (sym);
+
/* Associate names can use the hidden string length variable
of their associated target. */
if (sym->ts.type == BT_CHARACTER
*************** gfc_trans_deferred_vars (gfc_symbol * pr
*** 4603,4608 ****
--- 4610,4622 ----
gfc_set_backend_locus (&sym->declared_at);
gfc_start_block (&init);
+ if (sym->ts.type == BT_CHARACTER
+ && sym->attr.allocatable
+ && !sym->attr.dimension
+ && sym->ts.u.cl && sym->ts.u.cl->length
+ && sym->ts.u.cl->length->expr_type == EXPR_VARIABLE)
+ gfc_conv_string_length (sym->ts.u.cl, NULL, &init);
+
if (!sym->attr.pointer)
{
/* Nullify and automatic deallocation of allocatable
Index: gcc/testsuite/gfortran.dg/allocatable_scalar_14.f90
===================================================================
*** gcc/testsuite/gfortran.dg/allocatable_scalar_14.f90 (nonexistent)
--- gcc/testsuite/gfortran.dg/allocatable_scalar_14.f90 (working copy)
***************
*** 0 ****
--- 1,17 ----
+ ! { dg-do run }
+ !
+ ! Test the fix for PR64120 in which the initialisation of the
+ ! string length of 's' was not being done.
+ !
+ ! Contributed by Francois-Xavier Coudert <[email protected]>
+ !
+ call g(1)
+ call g(2)
+ contains
+ subroutine g(x)
+ integer :: x
+ character(len=x), allocatable :: s
+ allocate(s)
+ if (len(s) .ne. x) stop x
+ end subroutine
+ end
