diff options
Diffstat (limited to 'gcc/fortran/trans-array.c')
| -rw-r--r-- | gcc/fortran/trans-array.c | 33 |
1 files changed, 26 insertions, 7 deletions
diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index 87e37ea6308..fabbef99dc9 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -2342,7 +2342,7 @@ gfc_conv_resolve_dependencies (gfc_loopinfo * loop, gfc_ss * dest, loop->temp_ss->type = GFC_SS_TEMP; loop->temp_ss->data.temp.type = gfc_get_element_type (TREE_TYPE (dest->data.info.descriptor)); - loop->temp_ss->string_length = NULL_TREE; + loop->temp_ss->string_length = dest->string_length; loop->temp_ss->data.temp.dimen = loop->dimen; loop->temp_ss->next = gfc_ss_terminator; gfc_add_ss_to_loop (loop, loop->temp_ss); @@ -3616,11 +3616,23 @@ gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss) loop.temp_ss = gfc_get_ss (); loop.temp_ss->type = GFC_SS_TEMP; loop.temp_ss->next = gfc_ss_terminator; - loop.temp_ss->data.temp.type = gfc_typenode_for_spec (&expr->ts); + if (expr->ts.type == BT_CHARACTER) + { + gcc_assert (expr->ts.cl && expr->ts.cl->length + && expr->ts.cl->length->expr_type == EXPR_CONSTANT); + loop.temp_ss->string_length = gfc_conv_mpz_to_tree + (expr->ts.cl->length->value.integer, + expr->ts.cl->length->ts.kind); + expr->ts.cl->backend_decl = loop.temp_ss->string_length; + } + loop.temp_ss->data.temp.type = gfc_typenode_for_spec (&expr->ts); + /* ... which can hold our string, if present. */ if (expr->ts.type == BT_CHARACTER) - se->string_length = loop.temp_ss->string_length - = TYPE_SIZE_UNIT (loop.temp_ss->data.temp.type); + { + loop.temp_ss->string_length = TYPE_SIZE_UNIT (loop.temp_ss->data.temp.type); + se->string_length = loop.temp_ss->string_length; + } else loop.temp_ss->string_length = NULL; loop.temp_ss->data.temp.dimen = loop.dimen; @@ -3652,7 +3664,13 @@ gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss) rse.ss = ss; gfc_conv_scalarized_array_ref (&lse, NULL); - gfc_conv_expr_val (&rse, expr); + if (expr->ts.type == BT_CHARACTER) + { + gfc_conv_expr (&rse, expr); + rse.expr = gfc_build_indirect_ref (rse.expr); + } + else + gfc_conv_expr_val (&rse, expr); gfc_add_block_to_block (&block, &rse.pre); gfc_add_block_to_block (&block, &lse.pre); @@ -4000,7 +4018,8 @@ gfc_trans_deferred_array (gfc_symbol * sym, tree body) deallocate = gfc_array_deallocate (descriptor); tmp = gfc_conv_descriptor_data (descriptor); - tmp = build2 (NE_EXPR, boolean_type_node, tmp, integer_zero_node); + tmp = build2 (NE_EXPR, boolean_type_node, tmp, + build_int_cst (TREE_TYPE (tmp), 0)); tmp = build3_v (COND_EXPR, tmp, deallocate, build_empty_stmt ()); gfc_add_expr_to_block (&block, tmp); @@ -4349,7 +4368,7 @@ gfc_walk_array_constructor (gfc_ss * ss, gfc_expr * expr) /* Walk an expression. Add walked expressions to the head of the SS chain. - A wholy scalar expression will not be added. */ + A wholly scalar expression will not be added. */ static gfc_ss * gfc_walk_subexpr (gfc_ss * ss, gfc_expr * expr) |