aboutsummaryrefslogtreecommitdiff
path: root/gcc/fortran/trans-array.c
diff options
context:
space:
mode:
Diffstat (limited to 'gcc/fortran/trans-array.c')
-rw-r--r--gcc/fortran/trans-array.c58
1 files changed, 37 insertions, 21 deletions
diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index f8d9082..1718ba9 100644
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -951,18 +951,25 @@ gfc_put_offset_into_var (stmtblock_t * pblock, tree * poffset,
/* Assign an element of an array constructor. */
+static bool first_len;
+static tree first_len_val;
static void
gfc_trans_array_ctor_element (stmtblock_t * pblock, tree desc,
tree offset, gfc_se * se, gfc_expr * expr)
{
tree tmp;
+ tree esize;
gfc_conv_expr (se, expr);
/* Store the value. */
tmp = build_fold_indirect_ref (gfc_conv_descriptor_data_get (desc));
tmp = gfc_build_array_ref (tmp, offset, NULL);
+
+ esize = size_in_bytes (gfc_get_element_type (TREE_TYPE (desc)));
+ esize = fold_convert (gfc_charlen_type_node, esize);
+
if (expr->ts.type == BT_CHARACTER)
{
gfc_conv_string_parameter (se);
@@ -978,9 +985,30 @@ gfc_trans_array_ctor_element (stmtblock_t * pblock, tree desc,
tmp = gfc_build_addr_expr (pchar_type_node, tmp);
/* We know the temporary and the value will be the same length,
so can use memcpy. */
- tmp = build_call_expr (built_in_decls[BUILT_IN_MEMCPY], 3,
- tmp, se->expr, se->string_length);
- gfc_add_expr_to_block (&se->pre, tmp);
+ gfc_trans_string_copy (&se->pre, esize, tmp,
+ se->string_length,
+ se->expr);
+ }
+ if (flag_bounds_check)
+ {
+ if (first_len)
+ {
+ gfc_add_modify_expr (&se->pre, first_len_val,
+ se->string_length);
+ first_len = false;
+ }
+ else
+ {
+ /* Verify that all constructor elements are of the same
+ length. */
+ tree cond = fold_build2 (NE_EXPR, boolean_type_node,
+ first_len_val, se->string_length);
+ gfc_trans_runtime_check
+ (cond, &se->pre, &expr->where,
+ "Different CHARACTER lengths (%ld/%ld) in array constructor",
+ fold_convert (long_integer_type_node, first_len_val),
+ fold_convert (long_integer_type_node, se->string_length));
+ }
}
}
else
@@ -1425,7 +1453,6 @@ bool
get_array_ctor_strlen (stmtblock_t *block, gfc_constructor * c, tree * len)
{
bool is_const;
- tree first_len = NULL_TREE;
is_const = TRUE;
@@ -1460,23 +1487,6 @@ get_array_ctor_strlen (stmtblock_t *block, gfc_constructor * c, tree * len)
get_array_ctor_all_strlen (block, c->expr, len);
break;
}
- if (flag_bounds_check)
- {
- if (!first_len)
- first_len = *len;
- else
- {
- /* Verify that all constructor elements are of the same
- length. */
- tree cond = fold_build2 (NE_EXPR, boolean_type_node,
- first_len, *len);
- gfc_trans_runtime_check
- (cond, block, &c->expr->where,
- "Different CHARACTER lengths (%ld/%ld) in array constructor",
- fold_convert (long_integer_type_node, first_len),
- fold_convert (long_integer_type_node, *len));
- }
- }
}
return is_const;
@@ -1660,6 +1670,12 @@ gfc_trans_array_constructor (gfc_loopinfo * loop, gfc_ss * ss)
tree type;
bool dynamic;
+ if (flag_bounds_check && ss->expr->ts.type == BT_CHARACTER)
+ {
+ first_len_val = gfc_create_var (gfc_charlen_type_node, "len");
+ first_len = true;
+ }
+
ss->data.info.dimen = loop->dimen;
c = ss->expr->value.constructor;