diff options
author | Paul Thomas <pault@gcc.gnu.org> | 2015-10-18 09:31:21 +0000 |
---|---|---|
committer | Paul Thomas <pault@gcc.gnu.org> | 2015-10-18 09:31:21 +0000 |
commit | 38217d3ee7c6e1fee58331f10e5c78e40441009b (patch) | |
tree | a0441a3335a1f9021773ff84b515947483dce8b6 /gcc/fortran/trans-intrinsic.c | |
parent | 2fe7f26c18c36933430add48d1139030c4a2f8d4 (diff) | |
download | gcc-38217d3ee7c6e1fee58331f10e5c78e40441009b.zip gcc-38217d3ee7c6e1fee58331f10e5c78e40441009b.tar.gz gcc-38217d3ee7c6e1fee58331f10e5c78e40441009b.tar.bz2 |
re PR fortran/67177 (MOVE_ALLOC not automatically allocating deferred character arrays in derived types)
2015-10-18 Paul Thomas <pault@gcc.gnu.org>
PR fortran/67177
PR fortran/67977
* primary.c (match_substring): Add an argument 'deferred' to
flag that a substring reference with null start and end should
not be optimized away for deferred length strings.
(match_string_constant, gfc_match_rvalue): Set the argument.
* trans-expr.c (alloc_scalar_allocatable_for_assignment): If
there is a substring reference return.
* trans-intrinsic.c (conv_intrinsic_move_alloc): For deferred
characters, assign the 'from' string length to the 'to' string
length. If the 'from' expression is deferred, set its string
length to zero. If the 'to' expression has allocatable
components, deallocate them.
2015-10-18 Paul Thomas <pault@gcc.gnu.org>
PR fortran/67177
* gfortran.dg/move_alloc_15.f90: New test
* gfortran.dg/move_alloc_16.f90: New test
PR fortran/67977
* gfortran.dg/deferred_character_assignment_1.f90: New test
From-SVN: r228940
Diffstat (limited to 'gcc/fortran/trans-intrinsic.c')
-rw-r--r-- | gcc/fortran/trans-intrinsic.c | 29 |
1 files changed, 29 insertions, 0 deletions
diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c index 15ef560..d72ea98 100644 --- a/gcc/fortran/trans-intrinsic.c +++ b/gcc/fortran/trans-intrinsic.c @@ -9414,6 +9414,16 @@ conv_intrinsic_move_alloc (gfc_code *code) } } + if (to_expr->ts.type == BT_CHARACTER && to_expr->ts.deferred) + { + gfc_add_modify_loc (input_location, &block, to_se.string_length, + fold_convert (TREE_TYPE (to_se.string_length), + from_se.string_length)); + if (from_expr->ts.deferred) + gfc_add_modify_loc (input_location, &block, from_se.string_length, + build_int_cst (TREE_TYPE (from_se.string_length), 0)); + } + return gfc_finish_block (&block); } @@ -9513,6 +9523,14 @@ conv_intrinsic_move_alloc (gfc_code *code) } else { + if (to_expr->ts.type == BT_DERIVED + && to_expr->ts.u.derived->attr.alloc_comp) + { + tmp = gfc_deallocate_alloc_comp (to_expr->ts.u.derived, + to_se.expr, to_expr->rank); + gfc_add_expr_to_block (&block, tmp); + } + tmp = gfc_conv_descriptor_data_get (to_se.expr); tmp = gfc_deallocate_with_status (tmp, NULL_TREE, NULL_TREE, NULL_TREE, NULL_TREE, true, to_expr, false); @@ -9527,6 +9545,17 @@ conv_intrinsic_move_alloc (gfc_code *code) gfc_add_modify_loc (input_location, &block, tmp, fold_convert (TREE_TYPE (tmp), null_pointer_node)); + + if (to_expr->ts.type == BT_CHARACTER && to_expr->ts.deferred) + { + gfc_add_modify_loc (input_location, &block, to_se.string_length, + fold_convert (TREE_TYPE (to_se.string_length), + from_se.string_length)); + if (from_expr->ts.deferred) + gfc_add_modify_loc (input_location, &block, from_se.string_length, + build_int_cst (TREE_TYPE (from_se.string_length), 0)); + } + return gfc_finish_block (&block); } |