diff options
Diffstat (limited to 'gcc')
| -rw-r--r-- | gcc/fortran/trans-array.c | 21 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/char_length_23.f90 | 25 |
2 files changed, 44 insertions, 2 deletions
diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index 73a45cd..0e3495d 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 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 |