Commit fb3f5eae by Thomas Koenig

re PR fortran/90561 (ICE in gimplify_var_or_parm_decl, at gimplify.c:2747)

2019-08-13  Thomas Koenig  <tkoenig@gcc.gnu.org>

	PR fortran/90561
	* trans.h (gfc_evaluate_now_function_scope): New function.
	* trans.c (gfc_evaluate_now_function_scope): New function.
	* trans-expr.c (gfc_trans_assignment): Use it.

2019-08-13  Thomas Koenig  <tkoenig@gcc.gnu.org>

	PR fortran/90561
	* gfortran.dg/deferred_character_34.f90: New test.

From-SVN: r274383
parent cb0a83f3
...@@ -10796,7 +10796,8 @@ gfc_trans_assignment_1 (gfc_expr * expr1, gfc_expr * expr2, bool init_flag, ...@@ -10796,7 +10796,8 @@ gfc_trans_assignment_1 (gfc_expr * expr1, gfc_expr * expr2, bool init_flag,
if (expr1->ts.deferred if (expr1->ts.deferred
&& gfc_expr_attr (expr1).allocatable && gfc_expr_attr (expr1).allocatable
&& gfc_check_dependency (expr1, expr2, true)) && gfc_check_dependency (expr1, expr2, true))
rse.string_length = gfc_evaluate_now (rse.string_length, &rse.pre); rse.string_length =
gfc_evaluate_now_function_scope (rse.string_length, &rse.pre);
string_length = rse.string_length; string_length = rse.string_length;
} }
else else
......
...@@ -118,6 +118,19 @@ gfc_evaluate_now (tree expr, stmtblock_t * pblock) ...@@ -118,6 +118,19 @@ gfc_evaluate_now (tree expr, stmtblock_t * pblock)
return gfc_evaluate_now_loc (input_location, expr, pblock); return gfc_evaluate_now_loc (input_location, expr, pblock);
} }
/* Like gfc_evaluate_now, but add the created variable to the
function scope. */
tree
gfc_evaluate_now_function_scope (tree expr, stmtblock_t * pblock)
{
tree var;
var = gfc_create_var_np (TREE_TYPE (expr), NULL);
gfc_add_decl_to_function (var);
gfc_add_modify (pblock, var, expr);
return var;
}
/* Build a MODIFY_EXPR node and add it to a given statement block PBLOCK. /* Build a MODIFY_EXPR node and add it to a given statement block PBLOCK.
A MODIFY_EXPR is an assignment: A MODIFY_EXPR is an assignment:
......
...@@ -507,6 +507,7 @@ void gfc_conv_label_variable (gfc_se * se, gfc_expr * expr); ...@@ -507,6 +507,7 @@ void gfc_conv_label_variable (gfc_se * se, gfc_expr * expr);
/* If the value is not constant, Create a temporary and copy the value. */ /* If the value is not constant, Create a temporary and copy the value. */
tree gfc_evaluate_now_loc (location_t, tree, stmtblock_t *); tree gfc_evaluate_now_loc (location_t, tree, stmtblock_t *);
tree gfc_evaluate_now (tree, stmtblock_t *); tree gfc_evaluate_now (tree, stmtblock_t *);
tree gfc_evaluate_now_function_scope (tree, stmtblock_t *);
/* Find the appropriate variant of a math intrinsic. */ /* Find the appropriate variant of a math intrinsic. */
tree gfc_builtin_decl_for_float_kind (enum built_in_function, int); tree gfc_builtin_decl_for_float_kind (enum built_in_function, int);
......
! { dg-do run }
! PR fortran/90561
! This used to ICE.
! Original test case by Gerhard Steinmetz.
program p
character(:), allocatable :: z(:)
z = [character(2):: 'ab', 'xy']
z = z(2)
if (any(z /= 'xy')) stop 1
end
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