Hi All, The fix for PR9601 is rather trivial and is the last chunk of the patch. Finding the fix for PR96100 took a silly amount of time but it now looks rather obvious. Trying to evaluate the string length by calling gfc_conv_expr_descriptor, when this function is already failing to find it is kind of doomed to failure :-) Therefore, gfc_conv_expr is used with tse.descriptor_only set. This has the effect of ignoring trailing array references and making use of gfc_conv_component_ref's being able to extract the hidden string length for deferred length components. Finally, the string length of the first element in the array constructor is set if this is a deferred length component.
Regtests OK on FC31/x86_64 - OK for master? Paul This patch fixes PR96100 and PR96101 by making some minor changes to the evaluation of string lengths for gfc_conv_expr_descriptor. 2020-08-13 Paul Thomas <pa...@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.
diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index 8f93b43bafb..ad3286487e8 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");
! { dg-do compile } ! ! Test the fix for PRs 96100 and 96101. ! ! Contributed by Gerhardt Steinmetz <gs...@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 w = 'abc' associate (y => ([w(:)])) print *, y ! ICE end associate end