From 300ef2fcc10e98359d14654be23bbb84a5d141e1 Mon Sep 17 00:00:00 2001 From: Paul Thomas Date: Thu, 20 Aug 2020 18:17:59 +0100 Subject: [PATCH] This patch fixes PRs 96100 and 96101. 2020-08-20 Paul Thomas 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 | 21 ++++++++++++++-- gcc/testsuite/gfortran.dg/char_length_23.f90 | 25 ++++++++++++++++++++ 2 files changed, 44 insertions(+), 2 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/char_length_23.f90 diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index 73a45cd2dcf..0e3495d59cc 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -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 index 00000000000..e9ddbc7b8fd --- /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 +! +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 -- 2.30.2