TeamHeptaMirrors/gcc
1
0
Fork 1
mirror of https://github.com/gcc-mirror/gcc.git synced 2026-05-06 14:59:39 +02:00
Code Issues Packages Projects Releases Wiki Activity

This patch fixes PRs 96100 and 96101.

Browse Source 
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.
This commit is contained in:
Paul Thomas
2020-08-20 18:17:59 +01:00
parent d241134695
commit 300ef2fcc1
2 changed files with 44 additions and 2 deletions
Download Patch File Download Diff File Expand all files Collapse all files

21
gcc/fortran/trans-array.c
View 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");

25
gcc/testsuite/gfortran.dg/char_length_23.f90 Normal file
View File

@@ -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