@@ -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;
With array constructors, there is the same type problem as with structure constructor: we don't know whether we want the non-restricted or the restricted variant. Array constructors are translated from somewhere deep inside the scalarizer, so we have to pass the information there down to gfc_conv_expr (which is now able to handle it thanks to the previous patch). A new flag is added to the gfc_ss_info structure to store that information. As most of the time the restrict variant is needed, the flag is set to true by default. A new function is added (gfc_ss_set_restricted) to set it to false in the one (for now) case it is useful. As before, new flags have to be added to function prototypes to transfer that flag's information. The call graph is as follows (to be seen with a fixed font): gfc_add_loop_ss_code [set restricted] \ +-> trans_array_constructor \ +-> gfc_trans_array_constructor_value <--+ |\ | | +----------------------------------+ |\ | +-> gfc_trans_array_constructor_subarray \ \ +-------+-> gfc_trans_array_ctor_element \ +-> gfc_conv_expr [propagate restricted] gfc_trans_array_ctor_element is changed to use gfc_trans_scalar_assign, which is able to handle incompatible types thanks to patch number 1. OK? 2012-08-22 Mikael Morin <mikael@gcc.gnu.org> * trans.h (struct gfc_ss_info): New field RESTRICTED. * trans-array.h (gfc_ss_set_restricted): New declaration. * trans-expr.c (gfc_trans_assignment_1): Call gfc_ss_set_restricted. * trans-array.c (gfc_ss_set_restricted): New function. (gfc_get_array_ss, gfc_get_scalar_ss, gfc_get_temp_ss): Set the RESTRICTED field by default. (gfc_trans_array_ctor_element): Use gfc_trans_scalar_assign. (gfc_trans_array_constructor_subarray, gfc_trans_array_constructor_value): Add argument RESTRICTED. Pass it down. (trans_array_constructor): Update call to gfc_trans_array_constructor_value. Choose the variant type that is wanted.