diff options
Diffstat (limited to 'gcc/fortran/trans-expr.c')
| -rw-r--r-- | gcc/fortran/trans-expr.c | 93 |
1 files changed, 52 insertions, 41 deletions
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index e1a3a8c..fce6159 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -2973,65 +2973,68 @@ gfc_trans_subcomponent_assign (tree dest, gfc_component * cm, gfc_expr * expr) if (cm->allocatable && expr->expr_type == EXPR_NULL) gfc_conv_descriptor_data_set (&block, dest, null_pointer_node); else if (cm->allocatable) - { - tree tmp2; + { + tree tmp2; gfc_init_se (&se, NULL); rss = gfc_walk_expr (expr); - se.want_pointer = 0; - gfc_conv_expr_descriptor (&se, expr, rss); + se.want_pointer = 0; + gfc_conv_expr_descriptor (&se, expr, rss); gfc_add_block_to_block (&block, &se.pre); tmp = fold_convert (TREE_TYPE (dest), se.expr); gfc_add_modify_expr (&block, dest, tmp); - if (cm->ts.type == BT_DERIVED && cm->ts.derived->attr.alloc_comp) + if (cm->ts.type == BT_DERIVED && cm->ts.derived->attr.alloc_comp) tmp = gfc_copy_alloc_comp (cm->ts.derived, se.expr, dest, cm->as->rank); else - tmp = gfc_duplicate_allocatable (dest, se.expr, + tmp = gfc_duplicate_allocatable (dest, se.expr, TREE_TYPE(cm->backend_decl), cm->as->rank); - gfc_add_expr_to_block (&block, tmp); - - gfc_add_block_to_block (&block, &se.post); - gfc_conv_descriptor_data_set (&block, se.expr, null_pointer_node); + gfc_add_expr_to_block (&block, tmp); - /* Shift the lbound and ubound of temporaries to being unity, rather - than zero, based. Calculate the offset for all cases. */ - offset = gfc_conv_descriptor_offset (dest); - gfc_add_modify_expr (&block, offset, gfc_index_zero_node); - tmp2 =gfc_create_var (gfc_array_index_type, NULL); - for (n = 0; n < expr->rank; n++) - { - if (expr->expr_type != EXPR_VARIABLE - && expr->expr_type != EXPR_CONSTANT) - { - tmp = gfc_conv_descriptor_ubound (dest, gfc_rank_cst[n]); - gfc_add_modify_expr (&block, tmp, - fold_build2 (PLUS_EXPR, - gfc_array_index_type, - tmp, gfc_index_one_node)); - tmp = gfc_conv_descriptor_lbound (dest, gfc_rank_cst[n]); - gfc_add_modify_expr (&block, tmp, gfc_index_one_node); - } - tmp = fold_build2 (MULT_EXPR, gfc_array_index_type, - gfc_conv_descriptor_lbound (dest, + gfc_add_block_to_block (&block, &se.post); + gfc_conv_descriptor_data_set (&block, se.expr, null_pointer_node); + + /* Shift the lbound and ubound of temporaries to being unity, rather + than zero, based. Calculate the offset for all cases. */ + offset = gfc_conv_descriptor_offset (dest); + gfc_add_modify_expr (&block, offset, gfc_index_zero_node); + tmp2 =gfc_create_var (gfc_array_index_type, NULL); + for (n = 0; n < expr->rank; n++) + { + if (expr->expr_type != EXPR_VARIABLE + && expr->expr_type != EXPR_CONSTANT) + { + tree span; + tmp = gfc_conv_descriptor_ubound (dest, gfc_rank_cst[n]); + span = fold_build2 (MINUS_EXPR, gfc_array_index_type, tmp, + gfc_conv_descriptor_lbound (dest, gfc_rank_cst[n])); + gfc_add_modify_expr (&block, tmp, + fold_build2 (PLUS_EXPR, + gfc_array_index_type, + span, gfc_index_one_node)); + tmp = gfc_conv_descriptor_lbound (dest, gfc_rank_cst[n]); + gfc_add_modify_expr (&block, tmp, gfc_index_one_node); + } + tmp = fold_build2 (MULT_EXPR, gfc_array_index_type, + gfc_conv_descriptor_lbound (dest, gfc_rank_cst[n]), - gfc_conv_descriptor_stride (dest, + gfc_conv_descriptor_stride (dest, gfc_rank_cst[n])); - gfc_add_modify_expr (&block, tmp2, tmp); - tmp = fold_build2 (MINUS_EXPR, gfc_array_index_type, offset, tmp2); - gfc_add_modify_expr (&block, offset, tmp); - } - } + gfc_add_modify_expr (&block, tmp2, tmp); + tmp = fold_build2 (MINUS_EXPR, gfc_array_index_type, offset, tmp2); + gfc_add_modify_expr (&block, offset, tmp); + } + } else - { + { tmp = gfc_trans_subarray_assign (dest, cm, expr); gfc_add_expr_to_block (&block, tmp); - } + } } else if (expr->ts.type == BT_DERIVED) { @@ -3497,9 +3500,17 @@ gfc_trans_scalar_assign (gfc_se * lse, gfc_se * rse, gfc_typespec ts, tmp = build3_v (COND_EXPR, cond, build_empty_stmt (), tmp); gfc_add_expr_to_block (&lse->pre, tmp); } - - gfc_add_block_to_block (&block, &lse->pre); - gfc_add_block_to_block (&block, &rse->pre); + + if (r_is_var) + { + gfc_add_block_to_block (&block, &lse->pre); + gfc_add_block_to_block (&block, &rse->pre); + } + else + { + gfc_add_block_to_block (&block, &rse->pre); + gfc_add_block_to_block (&block, &lse->pre); + } gfc_add_modify_expr (&block, lse->expr, fold_convert (TREE_TYPE (lse->expr), rse->expr)); |