This patch fixes PRs 96100 and 96101.
authorPaul Thomas <pault@gcc.gnu.org>
Thu, 20 Aug 2020 17:17:59 +0000 (18:17 +0100)
committerPaul Thomas <pault@gcc.gnu.org>
Thu, 20 Aug 2020 17:17:59 +0000 (18:17 +0100)
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.

gcc/fortran/trans-array.c
gcc/testsuite/gfortran.dg/char_length_23.f90 [new file with mode: 0644]

index 73a45cd2dcfce6292fcde568bf4815f845b84684..0e3495d59cc6f96e82e89beace25fca1c3beb20b 100644 (file)
@@ -7018,7 +7018,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);
@@ -7036,14 +7041,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
@@ -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