procyberian/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

re PR fortran/88247 (ICE in get_array_ctor_var_strlen, at fortran/trans-array.c:2068)

Browse source 
2019-03-27  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/88247
	* expr.c (is_subref_array): Permit substrings to be detected
	as subref arrays.
	* trans-array.c (get_array_ctor_var_strlen): Obtain the length
	of deferred length strings. Handle substrings with a NULL end
	expression.
	(trans_array_constructor): Remove an unnecessary blank line.
	(gfc_conv_scalarized_array_ref): Skip to label 'done' if 'decl'
	is a pointer array.
	(get_array_charlen): If the expression is an array, convert the
	first element of the constructor and use its string length. Get
	a new charlen if necessary.
	(gfc_conv_expr_descriptor): Call 'get_array_charlen' for array
	constructor expressions. If the ss_info string length is
	available, use that to set the span of character arrays.
	* trans-expr.c (gfc_get_expr_charlen): Handle substrings
	* trans-stmt.c (trans_associate_var): Set the pointer array
	flag for variable targets and constant array constructors. Take
	care not to reset the string length or the span in the case of
	expressions that are not converted as direct by reference.

2019-03-27  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/88247
	* gfortran.dg/associate_47.f90: New test.

From-SVN: r269962
This commit is contained in:
Paul Thomas 2019-03-27 12:51:43 +00:00
parent 6461f211e0
commit d5f48c7c62
7 changed files with 173 additions and 11 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

23
gcc/fortran/ChangeLog
View file

@ -1,3 +1,26 @@
2019-03-27 Paul Thomas <pault@gcc.gnu.org>
PR fortran/88247
* expr.c (is_subref_array): Permit substrings to be detected
as subref arrays.
* trans-array.c (get_array_ctor_var_strlen): Obtain the length
of deferred length strings. Handle substrings with a NULL end
expression.
(trans_array_constructor): Remove an unnecessary blank line.
(gfc_conv_scalarized_array_ref): Skip to label 'done' if 'decl'
is a pointer array.
(get_array_charlen): If the expression is an array, convert the
first element of the constructor and use its string length. Get
a new charlen if necessary.
(gfc_conv_expr_descriptor): Call 'get_array_charlen' for array
constructor expressions. If the ss_info string length is
available, use that to set the span of character arrays.
* trans-expr.c (gfc_get_expr_charlen): Handle substrings
* trans-stmt.c (trans_associate_var): Set the pointer array
flag for variable targets and constant array constructors. Take
care not to reset the string length or the span in the case of
expressions that are not converted as direct by reference.
2019-03-25 Kyrylo Tkachov <kyrylo.tkachov@arm.com>
* intrinsic.texi (MINLOC): Fix typo in BACK argument documentation.

4
gcc/fortran/expr.c
View file

@ -1080,8 +1080,10 @@ is_subref_array (gfc_expr * e)
for (ref = e->ref; ref; ref = ref->next)
{
/* If we haven't seen the array reference and this is an intrinsic,
what follows cannot be a subreference array. */
what follows cannot be a subreference array, unless there is a
substring reference. */
if (!seen_array && ref->type == REF_COMPONENT
&& ref->u.c.component->ts.type != BT_CHARACTER
&& ref->u.c.component->ts.type != BT_CLASS
&& !gfc_bt_struct (ref->u.c.component->ts.type))
return false;

61
gcc/fortran/trans-array.c
View file

@ -2099,6 +2099,8 @@ get_array_ctor_var_strlen (stmtblock_t *block, gfc_expr * expr, tree * len)
{
case REF_ARRAY:
/* Array references don't change the string length. */
if (ts->deferred)
get_array_ctor_all_strlen (block, expr, len);
break;
case REF_COMPONENT:
@ -2107,7 +2109,8 @@ get_array_ctor_var_strlen (stmtblock_t *block, gfc_expr * expr, tree * len)
break;
case REF_SUBSTRING:
if (ref->u.ss.start->expr_type != EXPR_CONSTANT
if (ref->u.ss.end == NULL
|| ref->u.ss.start->expr_type != EXPR_CONSTANT
|| ref->u.ss.end->expr_type != EXPR_CONSTANT)
{
/* Note that this might evaluate expr. */
@ -2507,7 +2510,6 @@ trans_array_constructor (gfc_ss * ss, locus * where)
ss_info->string_length);
ss_info->string_length = gfc_evaluate_now (ss_info->string_length,
&length_se.pre);
gfc_add_block_to_block (&outer_loop->pre, &length_se.pre);
gfc_add_block_to_block (&outer_loop->post, &length_se.post);
}
@ -3470,6 +3472,9 @@ gfc_conv_scalarized_array_ref (gfc_se * se, gfc_array_ref * ar)
|| expr->expr_type == EXPR_FUNCTION))))
decl = expr->symtree->n.sym->backend_decl;
if (decl && GFC_DECL_PTR_ARRAY_P (decl))
goto done;
/* A pointer array component can be detected from its field decl. Fix
the descriptor, mark the resulting variable decl and pass it to
gfc_build_array_ref. */
@ -3486,6 +3491,7 @@ gfc_conv_scalarized_array_ref (gfc_se * se, gfc_array_ref * ar)
decl = info->descriptor;
}
done:
se->expr = gfc_build_array_ref (base, index, decl);
}
@ -6929,6 +6935,7 @@ get_array_charlen (gfc_expr *expr, gfc_se *se)
gfc_formal_arglist *formal;
gfc_actual_arglist *arg;
gfc_se tse;
gfc_expr *e;
if (expr->ts.u.cl->length
&& gfc_is_constant_expr (expr->ts.u.cl->length))
@ -6940,6 +6947,34 @@ get_array_charlen (gfc_expr *expr, gfc_se *se)
switch (expr->expr_type)
{
case EXPR_ARRAY:
/* This is somewhat brutal. The expression for the first
element of the array is evaluated and assigned to a
new string length for the original expression. */
e = gfc_constructor_first (expr->value.constructor)->expr;
gfc_init_se (&tse, NULL);
if (e->rank)
gfc_conv_expr_descriptor (&tse, e);
else
gfc_conv_expr (&tse, e);
gfc_add_block_to_block (&se->pre, &tse.pre);
gfc_add_block_to_block (&se->post, &tse.post);
if (!expr->ts.u.cl->backend_decl || !VAR_P (expr->ts.u.cl->backend_decl))
{
expr->ts.u.cl = gfc_new_charlen (gfc_current_ns, NULL);
expr->ts.u.cl->backend_decl =
gfc_create_var (gfc_charlen_type_node, "sln");
}
gfc_add_modify (&se->pre, expr->ts.u.cl->backend_decl,
tse.string_length);
return;
case EXPR_OP:
get_array_charlen (expr->value.op.op1, se);
@ -6947,7 +6982,7 @@ get_array_charlen (gfc_expr *expr, gfc_se *se)
if (expr->value.op.op == INTRINSIC_PARENTHESES)
return;
expr->ts.u.cl->backend_decl =
expr->ts.u.cl->backend_decl =
gfc_create_var (gfc_charlen_type_node, "sln");
if (expr->value.op.op2)
@ -7325,7 +7360,8 @@ gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr)
if (need_tmp)
{
if (expr->ts.type == BT_CHARACTER && !expr->ts.u.cl->backend_decl)
if (expr->ts.type == BT_CHARACTER
&& (!expr->ts.u.cl->backend_decl || expr->expr_type == EXPR_ARRAY))
get_array_charlen (expr, se);
/* Tell the scalarizer to make a temporary. */
@ -7447,7 +7483,17 @@ gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr)
/* Set the string_length for a character array. */
if (expr->ts.type == BT_CHARACTER)
se->string_length = gfc_get_expr_charlen (expr);
{
se->string_length = gfc_get_expr_charlen (expr);
if (VAR_P (se->string_length)
&& expr->ts.u.cl->backend_decl == se->string_length)
tmp = ss_info->string_length;
else
tmp = se->string_length;
if (expr->ts.deferred)
gfc_add_modify (&se->pre, expr->ts.u.cl->backend_decl, tmp);
}
/* If we have an array section or are assigning make sure that
the lower bound is 1. References to the full
@ -7509,7 +7555,10 @@ gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr)
}
/* Set the span field. */
tmp = gfc_get_array_span (desc, expr);
if (expr->ts.type == BT_CHARACTER && ss_info->string_length)
tmp = ss_info->string_length;
else
tmp = gfc_get_array_span (desc, expr);
if (tmp != NULL_TREE)
gfc_conv_descriptor_span_set (&loop.pre, parm, tmp);

16
gcc/fortran/trans-expr.c
View file

@ -1824,6 +1824,7 @@ gfc_get_expr_charlen (gfc_expr *e)
{
gfc_ref *r;
tree length;
gfc_se se;
gcc_assert (e->expr_type == EXPR_VARIABLE
&& e->ts.type == BT_CHARACTER);
@ -1859,9 +1860,20 @@ gfc_get_expr_charlen (gfc_expr *e)
/* Do nothing. */
break;
case REF_SUBSTRING:
gfc_init_se (&se, NULL);
gfc_conv_expr_type (&se, r->u.ss.start, gfc_charlen_type_node);
length = se.expr;
gfc_conv_expr_type (&se, r->u.ss.end, gfc_charlen_type_node);
length = fold_build2_loc (input_location, MINUS_EXPR,
gfc_charlen_type_node,
se.expr, length);
length = fold_build2_loc (input_location, PLUS_EXPR,
gfc_charlen_type_node, length,
gfc_index_one_node);
break;
default:
/* We should never got substring references here. These will be
broken down by the scalarizer. */
gcc_unreachable ();
break;
}

6
gcc/fortran/trans-stmt.c
View file

@ -1707,17 +1707,19 @@ trans_associate_var (gfc_symbol *sym, gfc_wrapped_block *block)
/* If association is to an expression, evaluate it and create temporary.
Otherwise, get descriptor of target for pointer assignment. */
gfc_init_se (&se, NULL);
if (sym->assoc->variable || cst_array_ctor)
{
se.direct_byref = 1;
se.use_offset = 1;
se.expr = desc;
GFC_DECL_PTR_ARRAY_P (sym->backend_decl) = 1;
}
gfc_conv_expr_descriptor (&se, e);
if (sym->ts.type == BT_CHARACTER
&& sym->ts.deferred
&& !se.direct_byref && sym->ts.deferred
&& !sym->attr.select_type_temporary
&& VAR_P (sym->ts.u.cl->backend_decl)
&& se.string_length != sym->ts.u.cl->backend_decl)
@ -1746,7 +1748,7 @@ trans_associate_var (gfc_symbol *sym, gfc_wrapped_block *block)
/* If this is a subreference array pointer associate name use the
associate variable element size for the value of 'span'. */
if (sym->attr.subref_array_pointer)
if (sym->attr.subref_array_pointer && !se.direct_byref)
{
gcc_assert (e->expr_type == EXPR_VARIABLE);
tmp = gfc_get_array_span (se.expr, e);

5
gcc/testsuite/ChangeLog
View file

@ -1,3 +1,8 @@
2019-03-27 Paul Thomas <pault@gcc.gnu.org>
PR fortran/88247
* gfortran.dg/associate_47.f90: New test.
2019-03-27 Richard Biener <rguenther@suse.de>
PR tree-optimization/89463

69
gcc/testsuite/gfortran.dg/associate_47.f90 Normal file
View file

@ -0,0 +1,69 @@
! { dg-do run }
!
! Test the fix for PR88247 and more besides :-)
!
! Contributed by Gerhard Steinmetz <gscfq@t-online.de>
!
program p
type t
character(:), allocatable :: c
character(:), dimension(:), allocatable :: d
end type
type(t), allocatable :: x
call foo ('abcdef','ghijkl')
associate (y => [x%c(:)])
if (y(1) .ne. 'abcdef') stop 1
end associate
call foo ('ghi','ghi')
associate (y => [x%c(2:)])
if (y(1) .ne. 'hi') stop 2
end associate
call foo ('lmnopq','ghijkl')
associate (y => [x%c(:3)])
if (y(1) .ne. 'lmn') stop 3
end associate
call foo ('abcdef','ghijkl')
associate (y => [x%c(2:4)])
if (y(1) .ne. 'bcd') stop 4
end associate
call foo ('lmnopqrst','ghijklmno')
associate (y => x%d(:))
if (len(y) .ne. 9) stop 5
if (any (y .ne. ['lmnopqrst','ghijklmno'])) stop 5
y(1) = 'zqrtyd'
end associate
if (x%d(1) .ne. 'zqrtyd') stop 5
! Substrings of arrays still do not work correctly.
call foo ('lmnopqrst','ghijklmno')
associate (y => x%d(:)(2:4))
! if (any (y .ne. ['mno','hij'])) stop 6
end associate
call foo ('abcdef','ghijkl')
associate (y => [x%d(:)])
if (len(y) .ne. 6) stop 7
if (any (y .ne. ['abcdef','ghijkl'])) stop 7
end associate
call foo ('lmnopqrst','ghijklmno')
associate (y => [x%d(2:1:-1)])
if (len(y) .ne. 9) stop 8
if (any (y .ne. ['ghijklmno','lmnopqrst'])) stop 8
end associate
deallocate (x)
contains
subroutine foo (c1, c2)
character(*) :: c1, c2
if (allocated (x)) deallocate (x)
allocate (x)
x%c = c1
x%d = [c1, c2]
end subroutine foo
end