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

3 files changed, 24 insertions, 4 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 12606ff..d92a88f 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,10 +1,19 @@
 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.
 	* expr.c (gfc_check_vardef_context): Fix context == NULL case.
-	* trans-expr.c (get_scalar_to_descriptor_type): Handle pointer arguments.
-	* trans-intrinsic.c (gfc_conv_intrinsic_caf_get): Fix generation of temporary
-	strings.
+	* trans-expr.c (get_scalar_to_descriptor_type): Handle pointer
+	arguments.
+	* trans-intrinsic.c (gfc_conv_intrinsic_caf_get): Fix generation of
+	temporary strings.
 
 2014-06-25  Jakub Jelinek  <jakub@redhat.com>
 
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 48b3a40..ca20c29 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -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.
      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
-     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
       && (lhs_coindexed
 	  || (code->expr2->expr_type == EXPR_FUNCTION
 	      && code->expr2->value.function.isym
 	      && code->expr2->value.function.isym->id == GFC_ISYM_CAF_GET
+	      && (code->expr1->rank == 0 || code->expr2->rank != 0)
 	      && !gfc_expr_attr (rhs).allocatable
               && !gfc_has_vector_subscript (rhs))))
     {
diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c
index a0c7421..a1dfdfb 100644
--- a/gcc/fortran/trans-intrinsic.c
+++ b/gcc/fortran/trans-intrinsic.c
@@ -1349,6 +1349,7 @@ conv_caf_send (gfc_code *code) {
   gfc_se lhs_se, rhs_se;
   stmtblock_t block;
   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;
 
   gcc_assert (gfc_option.coarray == GFC_FCOARRAY_LIB);
@@ -1364,6 +1365,7 @@ conv_caf_send (gfc_code *code) {
       symbol_attribute attr;
       gfc_clear_attr (&attr);
       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_build_addr_expr (NULL_TREE, lhs_se.expr);
     }
@@ -1385,6 +1387,7 @@ conv_caf_send (gfc_code *code) {
 	}
       lhs_se.want_pointer = 1;
       gfc_conv_expr_descriptor (&lhs_se, lhs_expr);
+      lhs_type = gfc_get_element_type (TREE_TYPE (TREE_TYPE (lhs_se.expr)));
       if (has_vector)
 	{
 	  vec = conv_caf_vector_subscript (&block, lhs_se.expr, ar);
@@ -1418,11 +1421,16 @@ conv_caf_send (gfc_code *code) {
 
   /* RHS.  */
   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)
     {
       symbol_attribute attr;
       gfc_clear_attr (&attr);
       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_build_addr_expr (NULL_TREE, rhs_se.expr);
     }