Commit 97561cdc by Andre Vehreschild

re PR fortran/66927 (ICE in gfc_conf_procedure_call)

gcc/fortran/ChangeLog:

2015-10-26  Andre Vehreschild  <vehre@gcc.gnu.org>

	PR fortran/66927
	* trans-array.c (evaluate_bound): For deferred length arrays get the
	bounds directly from the descriptor, i.e., prevent using constant
	zero lower bound from the gfc_conv_array_lbound () routine.
	(gfc_conv_section_startstride): Hand deferred array status to
	evaluate_bound ().
	(gfc_conv_expr_descriptor): Same.

From-SVN: r229353
parent 9bdc432a
2015-10-26 Andre Vehreschild <vehre@gcc.gnu.org>
PR fortran/66927
* trans-array.c (evaluate_bound): For deferred length arrays get the
bounds directly from the descriptor, i.e., prevent using constant
zero lower bound from the gfc_conv_array_lbound () routine.
(gfc_conv_section_startstride): Hand deferred array status to
evaluate_bound ().
(gfc_conv_expr_descriptor): Same.
2015-01-25 Paul Thomas <pault@gcc.gnu.org> 2015-01-25 Paul Thomas <pault@gcc.gnu.org>
PR fortran/67171 PR fortran/67171
......
...@@ -3809,7 +3809,7 @@ gfc_trans_scalarized_loop_boundary (gfc_loopinfo * loop, stmtblock_t * body) ...@@ -3809,7 +3809,7 @@ gfc_trans_scalarized_loop_boundary (gfc_loopinfo * loop, stmtblock_t * body)
static void static void
evaluate_bound (stmtblock_t *block, tree *bounds, gfc_expr ** values, evaluate_bound (stmtblock_t *block, tree *bounds, gfc_expr ** values,
tree desc, int dim, bool lbound) tree desc, int dim, bool lbound, bool deferred)
{ {
gfc_se se; gfc_se se;
gfc_expr * input_val = values[dim]; gfc_expr * input_val = values[dim];
...@@ -3824,6 +3824,17 @@ evaluate_bound (stmtblock_t *block, tree *bounds, gfc_expr ** values, ...@@ -3824,6 +3824,17 @@ evaluate_bound (stmtblock_t *block, tree *bounds, gfc_expr ** values,
gfc_add_block_to_block (block, &se.pre); gfc_add_block_to_block (block, &se.pre);
*output = se.expr; *output = se.expr;
} }
else if (deferred)
{
/* The gfc_conv_array_lbound () routine returns a constant zero for
deferred length arrays, which in the scalarizer wrecks havoc, when
copying to a (newly allocated) one-based array.
Keep returning the actual result in sync for both bounds. */
*output = lbound ? gfc_conv_descriptor_lbound_get (desc,
gfc_rank_cst[dim]):
gfc_conv_descriptor_ubound_get (desc,
gfc_rank_cst[dim]);
}
else else
{ {
/* No specific bound specified so use the bound of the array. */ /* No specific bound specified so use the bound of the array. */
...@@ -3864,14 +3875,18 @@ gfc_conv_section_startstride (stmtblock_t * block, gfc_ss * ss, int dim) ...@@ -3864,14 +3875,18 @@ gfc_conv_section_startstride (stmtblock_t * block, gfc_ss * ss, int dim)
desc = info->descriptor; desc = info->descriptor;
stride = ar->stride[dim]; stride = ar->stride[dim];
/* Calculate the start of the range. For vector subscripts this will /* Calculate the start of the range. For vector subscripts this will
be the range of the vector. */ be the range of the vector. */
evaluate_bound (block, info->start, ar->start, desc, dim, true); evaluate_bound (block, info->start, ar->start, desc, dim, true,
ar->as->type == AS_DEFERRED);
/* Similarly calculate the end. Although this is not used in the /* Similarly calculate the end. Although this is not used in the
scalarizer, it is needed when checking bounds and where the end scalarizer, it is needed when checking bounds and where the end
is an expression with side-effects. */ is an expression with side-effects. */
evaluate_bound (block, info->end, ar->end, desc, dim, false); evaluate_bound (block, info->end, ar->end, desc, dim, false,
ar->as->type == AS_DEFERRED);
/* Calculate the stride. */ /* Calculate the stride. */
if (stride == NULL) if (stride == NULL)
...@@ -6965,7 +6980,8 @@ gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr) ...@@ -6965,7 +6980,8 @@ gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr)
gcc_assert (n == codim - 1); gcc_assert (n == codim - 1);
evaluate_bound (&loop.pre, info->start, ar->start, evaluate_bound (&loop.pre, info->start, ar->start,
info->descriptor, n + ndim, true); info->descriptor, n + ndim, true,
ar->as->type == AS_DEFERRED);
loop.from[n + loop.dimen] = info->start[n + ndim]; loop.from[n + loop.dimen] = info->start[n + ndim];
} }
else else
......
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