diff options
| author | Tobias Burnus <burnus@net-b.de> | 2012-06-18 20:15:51 +0200 |
|---|---|---|
| committer | Tobias Burnus <burnus@gcc.gnu.org> | 2012-06-18 20:15:51 +0200 |
| commit | c1fb34c3ae740ed96d771e3f2b009e3bf3278242 (patch) | |
| tree | 74ac355b6b05c8451b36d64d22d6cf6bc1142534 /gcc/fortran | |
| parent | 284943b0226b75d81e80cc2713cf0e0044a2d21f (diff) | |
| download | gcc-c1fb34c3ae740ed96d771e3f2b009e3bf3278242.zip gcc-c1fb34c3ae740ed96d771e3f2b009e3bf3278242.tar.gz gcc-c1fb34c3ae740ed96d771e3f2b009e3bf3278242.tar.bz2 | |
re PR fortran/53526 ([Coarray] (lib) Properly handle MOVE_ALLOC for coarrays)
2012-06-18 Tobias Burnus <burnus@net-b.de>
PR fortran/53526
* trans-intrinsic.c (conv_intrinsic_move_alloc): Handle
* coarrays.
2012-06-18 Tobias Burnus <burnus@net-b.de>
PR fortran/53526
* gfortran.dg/coarray_lib_move_alloc_1.f90: New.
From-SVN: r188748
Diffstat (limited to 'gcc/fortran')
| -rw-r--r-- | gcc/fortran/ChangeLog | 5 | ||||
| -rw-r--r-- | gcc/fortran/trans-intrinsic.c | 51 |
2 files changed, 49 insertions, 7 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 6469d67..8be7142 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,6 +1,11 @@ 2012-06-18 Tobias Burnus <burnus@net-b.de> PR fortran/53526 + * trans-intrinsic.c (conv_intrinsic_move_alloc): Handle coarrays. + +2012-06-18 Tobias Burnus <burnus@net-b.de> + + PR fortran/53526 * check.c (gfc_check_move_alloc): Reject coindexed actual arguments and those with different corank. diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c index 04d6caa..8cce427 100644 --- a/gcc/fortran/trans-intrinsic.c +++ b/gcc/fortran/trans-intrinsic.c @@ -7243,6 +7243,7 @@ conv_intrinsic_move_alloc (gfc_code *code) gfc_se from_se, to_se; gfc_ss *from_ss, *to_ss; tree tmp; + bool coarray; gfc_start_block (&block); @@ -7254,8 +7255,9 @@ conv_intrinsic_move_alloc (gfc_code *code) gcc_assert (from_expr->ts.type != BT_CLASS || to_expr->ts.type == BT_CLASS); + coarray = gfc_get_corank (from_expr) != 0; - if (from_expr->rank == 0) + if (from_expr->rank == 0 && !coarray) { if (from_expr->ts.type != BT_CLASS) from_expr2 = from_expr; @@ -7366,15 +7368,50 @@ conv_intrinsic_move_alloc (gfc_code *code) } /* Deallocate "to". */ - to_ss = gfc_walk_expr (to_expr); - from_ss = gfc_walk_expr (from_expr); + if (from_expr->rank != 0) + { + to_ss = gfc_walk_expr (to_expr); + from_ss = gfc_walk_expr (from_expr); + } + else + { + to_ss = walk_coarray (to_expr); + from_ss = walk_coarray (from_expr); + } gfc_conv_expr_descriptor (&to_se, to_expr, to_ss); gfc_conv_expr_descriptor (&from_se, from_expr, from_ss); - 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); - gfc_add_expr_to_block (&block, tmp); + /* For coarrays, call SYNC ALL if TO is already deallocated as MOVE_ALLOC + is an image control "statement", cf. IR F08/0040 in 12-006A. */ + if (coarray && gfc_option.coarray == GFC_FCOARRAY_LIB) + { + tree cond; + + tmp = gfc_deallocate_with_status (to_se.expr, NULL_TREE, NULL_TREE, + NULL_TREE, NULL_TREE, true, to_expr, + true); + gfc_add_expr_to_block (&block, tmp); + + tmp = gfc_conv_descriptor_data_get (to_se.expr); + cond = fold_build2_loc (input_location, EQ_EXPR, + boolean_type_node, tmp, + fold_convert (TREE_TYPE (tmp), + null_pointer_node)); + tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_sync_all, + 3, null_pointer_node, null_pointer_node, + build_int_cst (integer_type_node, 0)); + + tmp = fold_build3_loc (input_location, COND_EXPR, void_type_node, cond, + tmp, build_empty_stmt (input_location)); + gfc_add_expr_to_block (&block, tmp); + } + else + { + 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); + gfc_add_expr_to_block (&block, tmp); + } /* Move the pointer and update the array descriptor data. */ gfc_add_modify_loc (input_location, &block, to_se.expr, from_se.expr); |