Commit 5c75088c by Tobias Burnus Committed by Tobias Burnus

resolve.c (resolve_ordinary_assign): Don't invoke caf_send when assigning a…

resolve.c (resolve_ordinary_assign): Don't invoke caf_send when assigning a coindexed RHS scalar to a noncoindexed...

2014-06-25  Tobias Burnus  <burnus@net-b.de>

fortran/
        * resolve.c (resolve_ordinary_assign): Don't invoke caf_send
        when assigning a coindexed RHS scalar to a noncoindexed LHS
        array.
        * trans-intrinsic.c (conv_caf_send): Do numeric type conversion
        for a noncoindexed scalar RHS.

gcc/testsuite/
        * gfortran.dg/coarray/coindexed_1.f90: New.

libgfortran/
        * caf/single.c (assign_char4_from_char1,
        * assign_char1_from_char4,
        convert_type): New static functions.
        (_gfortran_caf_get, _gfortran_caf_send): Use them.

From-SVN: r211993
parent aa9ca5ca
2014-06-25 Tobias Burnus <burnus@net-b.de> 2014-06-25 Tobias Burnus <burnus@net-b.de>
* resolve.c (resolve_ordinary_assign): Don't invoke caf_send
when assigning a coindexed RHS scalar to a noncoindexed LHS
array.
* trans-intrinsic.c (conv_caf_send): Do numeric type conversion
for a noncoindexed scalar RHS.
2014-06-25 Tobias Burnus <burnus@net-b.de>
* check.c (check_co_minmaxsum): Add definable check. * check.c (check_co_minmaxsum): Add definable check.
* expr.c (gfc_check_vardef_context): Fix context == NULL case. * expr.c (gfc_check_vardef_context): Fix context == NULL case.
* trans-expr.c (get_scalar_to_descriptor_type): Handle pointer arguments. * trans-expr.c (get_scalar_to_descriptor_type): Handle pointer
* trans-intrinsic.c (gfc_conv_intrinsic_caf_get): Fix generation of temporary arguments.
strings. * trans-intrinsic.c (gfc_conv_intrinsic_caf_get): Fix generation of
temporary strings.
2014-06-25 Jakub Jelinek <jakub@redhat.com> 2014-06-25 Jakub Jelinek <jakub@redhat.com>
......
...@@ -9300,12 +9300,15 @@ resolve_ordinary_assign (gfc_code *code, gfc_namespace *ns) ...@@ -9300,12 +9300,15 @@ resolve_ordinary_assign (gfc_code *code, gfc_namespace *ns)
/* Insert a GFC_ISYM_CAF_SEND intrinsic, when the LHS is a coindexed variable. /* Insert a GFC_ISYM_CAF_SEND intrinsic, when the LHS is a coindexed variable.
Additionally, insert this code when the RHS is a CAF as we then use the Additionally, insert this code when the RHS is a CAF as we then use the
GFC_ISYM_CAF_SEND intrinsic just to avoid a temporary; but do not do so if GFC_ISYM_CAF_SEND intrinsic just to avoid a temporary; but do not do so if
the LHS is (re)allocatable or has a vector subscript. */ the LHS is (re)allocatable or has a vector subscript. If the LHS is a
noncoindexed array and the RHS is a coindexed scalar, use the normal code
path. */
if (gfc_option.coarray == GFC_FCOARRAY_LIB if (gfc_option.coarray == GFC_FCOARRAY_LIB
&& (lhs_coindexed && (lhs_coindexed
|| (code->expr2->expr_type == EXPR_FUNCTION || (code->expr2->expr_type == EXPR_FUNCTION
&& code->expr2->value.function.isym && code->expr2->value.function.isym
&& code->expr2->value.function.isym->id == GFC_ISYM_CAF_GET && code->expr2->value.function.isym->id == GFC_ISYM_CAF_GET
&& (code->expr1->rank == 0 || code->expr2->rank != 0)
&& !gfc_expr_attr (rhs).allocatable && !gfc_expr_attr (rhs).allocatable
&& !gfc_has_vector_subscript (rhs)))) && !gfc_has_vector_subscript (rhs))))
{ {
......
...@@ -1349,6 +1349,7 @@ conv_caf_send (gfc_code *code) { ...@@ -1349,6 +1349,7 @@ conv_caf_send (gfc_code *code) {
gfc_se lhs_se, rhs_se; gfc_se lhs_se, rhs_se;
stmtblock_t block; stmtblock_t block;
tree caf_decl, token, offset, image_index, tmp, lhs_kind, rhs_kind; tree caf_decl, token, offset, image_index, tmp, lhs_kind, rhs_kind;
tree lhs_type = NULL_TREE;
tree vec = null_pointer_node, rhs_vec = null_pointer_node; tree vec = null_pointer_node, rhs_vec = null_pointer_node;
gcc_assert (gfc_option.coarray == GFC_FCOARRAY_LIB); gcc_assert (gfc_option.coarray == GFC_FCOARRAY_LIB);
...@@ -1364,6 +1365,7 @@ conv_caf_send (gfc_code *code) { ...@@ -1364,6 +1365,7 @@ conv_caf_send (gfc_code *code) {
symbol_attribute attr; symbol_attribute attr;
gfc_clear_attr (&attr); gfc_clear_attr (&attr);
gfc_conv_expr (&lhs_se, lhs_expr); gfc_conv_expr (&lhs_se, lhs_expr);
lhs_type = TREE_TYPE (lhs_se.expr);
lhs_se.expr = gfc_conv_scalar_to_descriptor (&lhs_se, lhs_se.expr, attr); lhs_se.expr = gfc_conv_scalar_to_descriptor (&lhs_se, lhs_se.expr, attr);
lhs_se.expr = gfc_build_addr_expr (NULL_TREE, lhs_se.expr); lhs_se.expr = gfc_build_addr_expr (NULL_TREE, lhs_se.expr);
} }
...@@ -1385,6 +1387,7 @@ conv_caf_send (gfc_code *code) { ...@@ -1385,6 +1387,7 @@ conv_caf_send (gfc_code *code) {
} }
lhs_se.want_pointer = 1; lhs_se.want_pointer = 1;
gfc_conv_expr_descriptor (&lhs_se, lhs_expr); gfc_conv_expr_descriptor (&lhs_se, lhs_expr);
lhs_type = gfc_get_element_type (TREE_TYPE (TREE_TYPE (lhs_se.expr)));
if (has_vector) if (has_vector)
{ {
vec = conv_caf_vector_subscript (&block, lhs_se.expr, ar); vec = conv_caf_vector_subscript (&block, lhs_se.expr, ar);
...@@ -1418,11 +1421,16 @@ conv_caf_send (gfc_code *code) { ...@@ -1418,11 +1421,16 @@ conv_caf_send (gfc_code *code) {
/* RHS. */ /* RHS. */
gfc_init_se (&rhs_se, NULL); gfc_init_se (&rhs_se, NULL);
if (rhs_expr->expr_type == EXPR_FUNCTION && rhs_expr->value.function.isym
&& rhs_expr->value.function.isym->id == GFC_ISYM_CONVERSION)
rhs_expr = rhs_expr->value.function.actual->expr;
if (rhs_expr->rank == 0) if (rhs_expr->rank == 0)
{ {
symbol_attribute attr; symbol_attribute attr;
gfc_clear_attr (&attr); gfc_clear_attr (&attr);
gfc_conv_expr (&rhs_se, rhs_expr); gfc_conv_expr (&rhs_se, rhs_expr);
if (!gfc_is_coindexed (rhs_expr) && rhs_expr->ts.type != BT_CHARACTER)
rhs_se.expr = fold_convert (lhs_type , rhs_se.expr);
rhs_se.expr = gfc_conv_scalar_to_descriptor (&rhs_se, rhs_se.expr, attr); rhs_se.expr = gfc_conv_scalar_to_descriptor (&rhs_se, rhs_se.expr, attr);
rhs_se.expr = gfc_build_addr_expr (NULL_TREE, rhs_se.expr); rhs_se.expr = gfc_build_addr_expr (NULL_TREE, rhs_se.expr);
} }
......
2014-06-25 Tobias Burnus <burnus@net-b.de> 2014-06-25 Tobias Burnus <burnus@net-b.de>
* gfortran.dg/coarray/coindexed_1.f90: New.
2014-06-25 Tobias Burnus <burnus@net-b.de>
* gfortran.dg/coarray_collectives_7.f90: New. * gfortran.dg/coarray_collectives_7.f90: New.
2014-06-25 Bernd Edlinger <bernd.edlinger@hotmail.de> 2014-06-25 Bernd Edlinger <bernd.edlinger@hotmail.de>
......
2014-06-25 Tobias Burnus <burnus@net-b.de>
* caf/single.c (assign_char4_from_char1, assign_char1_from_char4,
convert_type): New static functions.
(_gfortran_caf_get, _gfortran_caf_send): Use them.
2014-06-19 Tobias Burnus <burnus@net-b.de> 2014-06-19 Tobias Burnus <burnus@net-b.de>
* caf/single.c (_gfortran_caf_co_sum, _gfortran_caf_co_max, * caf/single.c (_gfortran_caf_co_sum, _gfortran_caf_co_max,
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment