@@ -557,6 +557,7 @@ gfc_get_array_ss (gfc_ss *next, gfc_expr *expr, int dimen, gfc_ss_type type)
ss_info->refcount++;
ss_info->type = type;
ss_info->expr = expr;
+ ss_info->restricted = 1;
ss = gfc_get_ss ();
ss->info = ss_info;
@@ -583,6 +584,7 @@ gfc_get_temp_ss (tree type, tree string_length, int dimen)
ss_info->type = GFC_SS_TEMP;
ss_info->string_length = string_length;
ss_info->data.temp.type = type;
+ ss_info->restricted = 1;
ss = gfc_get_ss ();
ss->info = ss_info;
@@ -593,7 +595,7 @@ gfc_get_temp_ss (tree type, tree string_length, int dimen)
return ss;
}
-
+
/* Creates and initializes a scalar type gfc_ss struct. */
@@ -607,6 +609,7 @@ gfc_get_scalar_ss (gfc_ss *next, gfc_expr *expr)
ss_info->refcount++;
ss_info->type = GFC_SS_SCALAR;
ss_info->expr = expr;
+ ss_info->restricted = 1;
ss = gfc_get_ss ();
ss->info = ss_info;
@@ -616,6 +619,23 @@ gfc_get_scalar_ss (gfc_ss *next, gfc_expr *expr)
}
+/* Sets SS's restricted attribute if needed according to WANT_RESTRICTED.
+ WANT_RESTRICTED is typically the lhs's target attribute in an assignment. */
+
+void
+gfc_ss_set_restricted (gfc_ss *ss, bool want_restricted)
+{
+ gcc_assert (ss != gfc_ss_terminator);
+
+ if (!want_restricted
+ && (ss->info->expr->ts.type == BT_DERIVED
+ || ss->info->expr->ts.type == BT_CLASS))
+ ss->info->restricted = 0;
+ else
+ ss->info->restricted = 1;
+}
+
+
/* Free all the SS associated with a loop. */
void
@@ -1432,9 +1452,14 @@ gfc_trans_array_ctor_element (stmtblock_t * pblock, tree desc,
}
else
{
- /* TODO: Should the frontend already have done this conversion? */
- se->expr = fold_convert (TREE_TYPE (tmp), se->expr);
- gfc_add_modify (&se->pre, tmp, se->expr);
+ gfc_se tmp_se;
+ tree code;
+
+ gfc_init_se (&tmp_se, NULL);
+ tmp_se.expr = tmp;
+ code = gfc_trans_scalar_assign (&tmp_se, se, expr->ts, true, false,
+ false);
+ gfc_add_expr_to_block (pblock, code);
}
gfc_add_block_to_block (pblock, &se->pre);
@@ -1450,7 +1475,7 @@ gfc_trans_array_constructor_subarray (stmtblock_t * pblock,
tree type ATTRIBUTE_UNUSED,
tree desc, gfc_expr * expr,
tree * poffset, tree * offsetvar,
- bool dynamic)
+ bool dynamic, bool restricted)
{
gfc_se se;
gfc_ss *ss;
@@ -1464,6 +1489,7 @@ gfc_trans_array_constructor_subarray (stmtblock_t * pblock,
gfc_put_offset_into_var (pblock, poffset, offsetvar);
gfc_init_se (&se, NULL);
+ se.want_restricted_types = restricted;
/* Walk the array expression. */
ss = gfc_walk_expr (expr);
@@ -1527,7 +1553,7 @@ static void
gfc_trans_array_constructor_value (stmtblock_t * pblock, tree type,
tree desc, gfc_constructor_base base,
tree * poffset, tree * offsetvar,
- bool dynamic)
+ bool dynamic, bool restricted)
{
tree tmp;
tree start = NULL_TREE;
@@ -1591,12 +1617,14 @@ gfc_trans_array_constructor_value (stmtblock_t * pblock, tree type,
/* Array constructors can be nested. */
gfc_trans_array_constructor_value (&body, type, desc,
c->expr->value.constructor,
- poffset, offsetvar, dynamic);
+ poffset, offsetvar, dynamic,
+ restricted);
}
else if (c->expr->rank > 0)
{
gfc_trans_array_constructor_subarray (&body, type, desc, c->expr,
- poffset, offsetvar, dynamic);
+ poffset, offsetvar, dynamic,
+ restricted);
}
else
{
@@ -1616,6 +1644,7 @@ gfc_trans_array_constructor_value (stmtblock_t * pblock, tree type,
{
/* Scalar values. */
gfc_init_se (&se, NULL);
+ se.want_restricted_types = restricted;
gfc_trans_array_ctor_element (&body, desc, *poffset,
&se, c->expr);
@@ -2249,7 +2278,11 @@ trans_array_constructor (gfc_ss * ss, locus * where)
type = build_pointer_type (type);
}
else
- type = gfc_typenode_for_spec (&expr->ts);
+ {
+ type = gfc_typenode_for_spec (&expr->ts);
+ if (!ss_info->restricted)
+ type = gfc_nonrestricted_type (type);
+ }
/* See if the constructor determines the loop bounds. */
dynamic = false;
@@ -2320,8 +2353,8 @@ trans_array_constructor (gfc_ss * ss, locus * where)
offsetvar = gfc_create_var_np (gfc_array_index_type, "offset");
TREE_NO_WARNING (offsetvar) = 1;
TREE_USED (offsetvar) = 0;
- gfc_trans_array_constructor_value (&outer_loop->pre, type, desc, c,
- &offset, &offsetvar, dynamic);
+ gfc_trans_array_constructor_value (&outer_loop->pre, type, desc, c, &offset,
+ &offsetvar, dynamic, ss_info->restricted);
/* If the array grows dynamically, the upper bound of the loop variable
is determined by the array's final upper bound. */
@@ -99,6 +99,8 @@ gfc_ss *gfc_get_array_ss (gfc_ss *, gfc_expr *, int, gfc_ss_type);
gfc_ss *gfc_get_temp_ss (tree, tree, int);
/* Allocate a new scalar type ss. */
gfc_ss *gfc_get_scalar_ss (gfc_ss *, gfc_expr *);
+/* Set the restrict attribute if needed for the ss. */
+void gfc_ss_set_restricted (gfc_ss *, bool);
/* Calculates the lower bound and stride of array sections. */
void gfc_conv_ss_startstride (gfc_loopinfo *);
@@ -7260,6 +7260,9 @@ gfc_trans_assignment_1 (gfc_expr * expr1, gfc_expr * expr2, bool init_flag,
if (rss == gfc_ss_terminator)
/* The rhs is scalar. Add a ss for the expression. */
rss = gfc_get_scalar_ss (gfc_ss_terminator, expr2);
+ else if (rss->next == gfc_ss_terminator
+ && rss->info->type == GFC_SS_CONSTRUCTOR)
+ gfc_ss_set_restricted (rss, !(gfc_expr_attr (expr1).target));
/* Associate the SS with the loop. */
gfc_add_ss_to_loop (&loop, lss);
@@ -228,7 +228,9 @@ typedef struct gfc_ss_info
/* Tells whether the SS is for an actual argument which can be a NULL
reference. In other words, the associated dummy argument is OPTIONAL.
Used to handle elemental procedures. */
- bool can_be_null_ref;
+ unsigned can_be_null_ref:1;
+
+ unsigned restricted:1;
}
gfc_ss_info;