This patch fixes PRs 96100 and 96101.

2020-08-20  Paul Thomas  <pault@gcc.gnu.org>

gcc/fortran
	PR fortran/96100
	PR fortran/96101
	* trans-array.c (get_array_charlen): Tidy up the evaluation of
	the string length for array constructors. Avoid trailing array
	references. Ensure string lengths of deferred length components
	are set. For parentheses operator apply string  length to both
	the primary expression and the enclosed expression.

gcc/testsuite/
	PR fortran/96100
	PR fortran/96101
	* gfortran.dg/char_length_23.f90: New test.

(cherry picked from commit 300ef2fcc10e98359d14654be23bbb84a5d141e1)

diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index befe7bb06ee3af7090d0d3f4ae48c6ddf232ebad..ad8772932e9a4693e3f0aa872ce4f5ebf527ce84 100644 (file)
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -7019,7 +7019,12 @@ get_array_charlen (gfc_expr *expr, gfc_se *se)
       e = gfc_constructor_first (expr->value.constructor)->expr;
 
       gfc_init_se (&tse, NULL);
+
+      /* Avoid evaluating trailing array references since all we need is
+        the string length.  */
       if (e->rank)
+       tse.descriptor_only = 1;
+      if (e->rank && e->expr_type != EXPR_VARIABLE)
        gfc_conv_expr_descriptor (&tse, e);
       else
        gfc_conv_expr (&tse, e);
@@ -7037,14 +7042,26 @@ get_array_charlen (gfc_expr *expr, gfc_se *se)
       gfc_add_modify (&se->pre, expr->ts.u.cl->backend_decl,
                      tse.string_length);
 
+      /* Make sure that deferred length components point to the hidden
+        string_length component.  */
+      if (TREE_CODE (tse.expr) == COMPONENT_REF
+         && TREE_CODE (tse.string_length) == COMPONENT_REF
+         && TREE_OPERAND (tse.expr, 0) == TREE_OPERAND (tse.string_length, 0))
+       e->ts.u.cl->backend_decl = expr->ts.u.cl->backend_decl;
+
       return;
 
     case EXPR_OP:
       get_array_charlen (expr->value.op.op1, se);
 
-      /* For parentheses the expression ts.u.cl is identical.  */
+      /* For parentheses the expression ts.u.cl should be identical.  */
       if (expr->value.op.op == INTRINSIC_PARENTHESES)
-       return;
+       {
+         if (expr->value.op.op1->ts.u.cl != expr->ts.u.cl)
+           expr->ts.u.cl->backend_decl
+                       = expr->value.op.op1->ts.u.cl->backend_decl;
+         return;
+       }
 
       expr->ts.u.cl->backend_decl =
                gfc_create_var (gfc_charlen_type_node, "sln");

diff --git a/gcc/testsuite/gfortran.dg/char_length_23.f90 b/gcc/testsuite/gfortran.dg/char_length_23.f90
new file mode 100644 (file)
index 0000000..e9ddbc7
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/char_length_23.f90
@@ -0,0 +1,25 @@
+! { dg-do compile }
+!
+! Test the fix for PRs 96100 and 96101.
+!
+! Contributed by Gerhardt Steinmetz  <gscfq@t-online.de>
+!
+program p
+   type t
+      character(:), allocatable :: c(:)
+   end type
+   type(t) :: x
+   character(:), allocatable :: w
+
+! PR96100
+   allocate(x%c(2), source = 'def')
+   associate (y => [x%c(1:1)])       ! ICE
+     print *,y
+   end associate
+
+! PR96101
+   associate (y => ([w(:)]))
+      print *, y                     ! ICE
+   end associate
+
+end