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.c21
1 files changed, 19 insertions, 2 deletions
diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index b885fe6..2527950 100644
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -5736,6 +5736,7 @@ gfc_array_allocate (gfc_se * se, gfc_expr * expr, tree status, tree errmsg,
tree var_overflow = NULL_TREE;
tree cond;
tree set_descriptor;
+ tree not_prev_allocated = NULL_TREE;
tree element_size = NULL_TREE;
stmtblock_t set_descriptor_block;
stmtblock_t elseblock;
@@ -5882,8 +5883,6 @@ gfc_array_allocate (gfc_se * se, gfc_expr * expr, tree status, tree errmsg,
}
}
- gfc_start_block (&elseblock);
-
/* Allocate memory to store the data. */
if (POINTER_TYPE_P (TREE_TYPE (se->expr)))
se->expr = build_fold_indirect_ref_loc (input_location, se->expr);
@@ -5899,6 +5898,19 @@ gfc_array_allocate (gfc_se * se, gfc_expr * expr, tree status, tree errmsg,
pointer = gfc_conv_descriptor_data_get (se->expr);
STRIP_NOPS (pointer);
+ if (allocatable)
+ {
+ not_prev_allocated = gfc_create_var (logical_type_node,
+ "not_prev_allocated");
+ tmp = fold_build2_loc (input_location, EQ_EXPR,
+ logical_type_node, pointer,
+ build_int_cst (TREE_TYPE (pointer), 0));
+
+ gfc_add_modify (&se->pre, not_prev_allocated, tmp);
+ }
+
+ gfc_start_block (&elseblock);
+
/* The allocatable variant takes the old pointer as first argument. */
if (allocatable)
gfc_allocate_allocatable (&elseblock, pointer, size, token,
@@ -5939,6 +5951,11 @@ gfc_array_allocate (gfc_se * se, gfc_expr * expr, tree status, tree errmsg,
cond = fold_build2_loc (input_location, EQ_EXPR,
logical_type_node, status,
build_int_cst (TREE_TYPE (status), 0));
+
+ if (not_prev_allocated != NULL_TREE)
+ cond = fold_build2_loc (input_location, TRUTH_OR_EXPR,
+ logical_type_node, cond, not_prev_allocated);
+
gfc_add_expr_to_block (&se->pre,
fold_build3_loc (input_location, COND_EXPR, void_type_node,
cond,