diff options
Diffstat (limited to 'gcc/fortran/trans-expr.c')
| -rw-r--r-- | gcc/fortran/trans-expr.c | 33 |
1 files changed, 32 insertions, 1 deletions
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index 1a6b734..863e2aa 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -5942,6 +5942,9 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, tmp = len; if (TREE_CODE (tmp) != VAR_DECL) tmp = gfc_evaluate_now (len, &se->pre); + TREE_STATIC (tmp) = 1; + gfc_add_modify (&se->pre, tmp, + build_int_cst (TREE_TYPE (tmp), 0)); tmp = gfc_build_addr_expr (NULL_TREE, tmp); vec_safe_push (retargs, tmp); } @@ -9263,7 +9266,10 @@ gfc_trans_assignment_1 (gfc_expr * expr1, gfc_expr * expr2, bool init_flag, } /* Stabilize a string length for temporaries. */ - if (expr2->ts.type == BT_CHARACTER && !expr2->ts.deferred) + if (expr2->ts.type == BT_CHARACTER && !expr1->ts.deferred + && !(TREE_CODE (rse.string_length) == VAR_DECL + || TREE_CODE (rse.string_length) == PARM_DECL + || TREE_CODE (rse.string_length) == INDIRECT_REF)) string_length = gfc_evaluate_now (rse.string_length, &rse.pre); else if (expr2->ts.type == BT_CHARACTER) string_length = rse.string_length; @@ -9277,7 +9283,32 @@ gfc_trans_assignment_1 (gfc_expr * expr1, gfc_expr * expr2, bool init_flag, lse.string_length = string_length; } else + { gfc_conv_expr (&lse, expr1); + if (gfc_option.rtcheck & GFC_RTCHECK_MEM + && gfc_expr_attr (expr1).allocatable + && expr1->rank + && !expr2->rank) + { + tree cond; + const char* msg; + + tmp = expr1->symtree->n.sym->backend_decl; + if (POINTER_TYPE_P (TREE_TYPE (tmp))) + tmp = build_fold_indirect_ref_loc (input_location, tmp); + + if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (tmp))) + tmp = gfc_conv_descriptor_data_get (tmp); + else + tmp = TREE_OPERAND (lse.expr, 0); + + cond = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node, + tmp, build_int_cst (TREE_TYPE (tmp), 0)); + msg = _("Assignment of scalar to unallocated array"); + gfc_trans_runtime_check (true, false, cond, &loop.pre, + &expr1->where, msg); + } + } /* Assignments of scalar derived types with allocatable components to arrays must be done with a deep copy and the rhs temporary |