Commit f82f425b by Paul Thomas

re PR fortran/49636 ([F03] ASSOCIATE construct confused with slightly complicated case)

2018-05-20  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/49636
	* trans-array.c (gfc_get_array_span): Renamed from
	'get_array_span'.
	(gfc_conv_expr_descriptor): Change references to above.
	* trans-array.h : Add prototype for 'gfc_get_array_span'.
	* trans-stmt.c (trans_associate_var): If the associate name is
	a subref array pointer, use gfc_get_array_span for the span.

2018-05-20  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/49636
	* gfortran.dg/associate_38.f90: New test.

From-SVN: r260414
parent 7c71e796
2018-05-20 Paul Thomas <pault@gcc.gnu.org>
PR fortran/49636
* trans-array.c (gfc_get_array_span): Renamed from
'get_array_span'.
(gfc_conv_expr_descriptor): Change references to above.
* trans-array.h : Add prototype for 'gfc_get_array_span'.
* trans-stmt.c (trans_associate_var): If the associate name is
a subref array pointer, use gfc_get_array_span for the span.
2018-05-20 Paul Thomas <pault@gcc.gnu.org>
PR fortran/82275
* match.c (gfc_match_type_spec): Go through the array ref and
decrement 'rank' for every dimension that is an element.
......
......@@ -817,8 +817,8 @@ is_pointer_array (tree expr)
/* Return the span of an array. */
static tree
get_array_span (tree desc, gfc_expr *expr)
tree
gfc_get_array_span (tree desc, gfc_expr *expr)
{
tree tmp;
......@@ -7061,7 +7061,7 @@ gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr)
subref_array_target, expr);
/* ....and set the span field. */
tmp = get_array_span (desc, expr);
tmp = gfc_get_array_span (desc, expr);
gfc_conv_descriptor_span_set (&se->pre, se->expr, tmp);
}
else if (se->want_pointer)
......@@ -7334,7 +7334,7 @@ gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr)
parmtype = TREE_TYPE (parm);
/* ....and set the span field. */
tmp = get_array_span (desc, expr);
tmp = gfc_get_array_span (desc, expr);
gfc_conv_descriptor_span_set (&loop.pre, parm, tmp);
}
else
......
......@@ -136,6 +136,8 @@ void gfc_conv_tmp_array_ref (gfc_se * se);
/* Translate a reference to an array temporary. */
void gfc_conv_tmp_ref (gfc_se *);
/* Obtain the span of an array. */
tree gfc_get_array_span (tree, gfc_expr *);
/* Evaluate an array expression. */
void gfc_conv_expr_descriptor (gfc_se *, gfc_expr *);
/* Convert an array for passing as an actual function parameter. */
......
......@@ -4966,7 +4966,7 @@ gfc_conv_intrinsic_minmaxloc (gfc_se * se, gfc_expr * expr, enum tree_code op)
else
{
tree ifbody2, elsebody2;
/* We switch to > or >= depending on the value of the BACK argument. */
cond = gfc_create_var (logical_type_node, "cond");
......@@ -7900,15 +7900,17 @@ gfc_conv_associated (gfc_se *se, gfc_expr *expr)
logical_type_node, tmp,
build_int_cst (TREE_TYPE (tmp), 0));
/* A pointer to an array, call library function _gfor_associated. */
arg1se.want_pointer = 1;
gfc_conv_expr_descriptor (&arg1se, arg1->expr);
/* A pointer to an array, call library function _gfor_associated. */
arg1se.want_pointer = 1;
gfc_conv_expr_descriptor (&arg1se, arg1->expr);
gfc_add_block_to_block (&se->pre, &arg1se.pre);
gfc_add_block_to_block (&se->post, &arg1se.post);
arg2se.want_pointer = 1;
gfc_conv_expr_descriptor (&arg2se, arg2->expr);
gfc_add_block_to_block (&se->pre, &arg2se.pre);
gfc_add_block_to_block (&se->post, &arg2se.post);
se->expr = build_call_expr_loc (input_location,
arg2se.want_pointer = 1;
gfc_conv_expr_descriptor (&arg2se, arg2->expr);
gfc_add_block_to_block (&se->pre, &arg2se.pre);
gfc_add_block_to_block (&se->post, &arg2se.post);
se->expr = build_call_expr_loc (input_location,
gfor_fndecl_associated, 2,
arg1se.expr, arg2se.expr);
se->expr = convert (logical_type_node, se->expr);
......
......@@ -1735,11 +1735,8 @@ trans_associate_var (gfc_symbol *sym, gfc_wrapped_block *block)
if (sym->attr.subref_array_pointer)
{
gcc_assert (e->expr_type == EXPR_VARIABLE);
tmp = e->symtree->n.sym->ts.type == BT_CLASS
? gfc_class_data_get (e->symtree->n.sym->backend_decl)
: e->symtree->n.sym->backend_decl;
tmp = gfc_get_element_type (TREE_TYPE (tmp));
tmp = fold_convert (gfc_array_index_type, size_in_bytes (tmp));
tmp = gfc_get_array_span (se.expr, e);
gfc_conv_descriptor_span_set (&se.pre, desc, tmp);
}
......
2018-05-20 Paul Thomas <pault@gcc.gnu.org>
PR fortran/49636
* gfortran.dg/associate_38.f90: New test.
2018-05-20 Paul Thomas <pault@gcc.gnu.org>
PR fortran/82923
* gfortran.dg/select_type_42.f90: New test.
......
! { dg-do run }
!
! Test the fix for PR49636 in which the 'span' of 'ty1' was not used
! in the descriptor of 'i'.
!
! Contributed by Fred Krogh <fkrogh#gcc@mathalacarte.com>
!
program test
type ty1
integer :: k
integer :: i
end type ty1
type ty2
type(ty1) :: j(3)
end type ty2
type(ty2) t2
t2%j(1:3)%i = [ 1, 3, 5 ]
associate (i=>t2%j%i)
if (any (t2%j(1:3)%i .ne. i(1:3))) stop 1
end associate
end program test
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment