From: Tobias Burnus <burnus@net-b.de>
Date: Mon, 22 Dec 2014 21:53:53 +0000 (+0100)
Subject: trans-intrinsic.c (gfc_conv_intrinsic_caf_get, [...]): Fix vector handling.
X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=69859058c7b1bc5ae64131a661aa2973a23cc719;p=gcc.git

trans-intrinsic.c (gfc_conv_intrinsic_caf_get, [...]): Fix vector handling.

2014-12-22  Tobias Burnus  <burnus@net-b.de>

        * trans-intrinsic.c (gfc_conv_intrinsic_caf_get, conv_caf_send):
        Fix vector handling.

From-SVN: r219034
---

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 3b8ebdfeff9..58b2554334b 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,8 @@
+2014-12-22  Tobias Burnus  <burnus@net-b.de>
+
+	* trans-intrinsic.c (gfc_conv_intrinsic_caf_get, conv_caf_send):
+	Fix vector handling.
+
 2014-12-22  Janus Weil  <janus@gcc.gnu.org>
 
 	PR fortran/63363
diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c
index 0cce3cb3980..31cb6c74168 100644
--- a/gcc/fortran/trans-intrinsic.c
+++ b/gcc/fortran/trans-intrinsic.c
@@ -1122,6 +1122,8 @@ gfc_conv_intrinsic_caf_get (gfc_se *se, gfc_expr *expr, tree lhs, tree lhs_kind,
   res_var = lhs;
   dst_var = lhs;
 
+  vec = null_pointer_node;
+
   gfc_init_se (&argse, NULL);
   if (array_expr->rank == 0)
     {
@@ -1164,10 +1166,12 @@ gfc_conv_intrinsic_caf_get (gfc_se *se, gfc_expr *expr, tree lhs, tree lhs_kind,
       /* Using gfc_conv_expr_descriptor, we only get the descriptor, but that
          has the wrong type if component references are done.  */
       gfc_add_modify (&argse.pre, gfc_conv_descriptor_dtype (argse.expr),
-                      gfc_get_dtype_rank_type (array_expr->rank, type));
+                      gfc_get_dtype_rank_type (has_vector ? ar2.dimen
+							  : array_expr->rank,
+					       type));
       if (has_vector)
 	{
-	  vec = conv_caf_vector_subscript (&argse.pre, argse.expr, ar);
+	  vec = conv_caf_vector_subscript (&argse.pre, argse.expr, &ar2);
 	  *ar = ar2;
 	}
 
@@ -1195,8 +1199,6 @@ gfc_conv_intrinsic_caf_get (gfc_se *se, gfc_expr *expr, tree lhs, tree lhs_kind,
   if (lhs_kind == NULL_TREE)
     lhs_kind = kind;
 
-  vec = null_pointer_node;
-
   gfc_add_block_to_block (&se->pre, &argse.pre);
   gfc_add_block_to_block (&se->post, &argse.post);
 
@@ -1278,10 +1280,12 @@ conv_caf_send (gfc_code *code) {
       lhs_type = gfc_typenode_for_spec (&lhs_expr->ts);
       tmp = build_fold_indirect_ref_loc (input_location, lhs_se.expr);
       gfc_add_modify (&lhs_se.pre, gfc_conv_descriptor_dtype (tmp),
-                      gfc_get_dtype_rank_type (lhs_expr->rank, lhs_type));
+                      gfc_get_dtype_rank_type (has_vector ? ar2.dimen
+							  : lhs_expr->rank,
+		      lhs_type));
       if (has_vector)
 	{
-	  vec = conv_caf_vector_subscript (&block, lhs_se.expr, ar);
+	  vec = conv_caf_vector_subscript (&block, lhs_se.expr, &ar2);
 	  *ar = ar2;
 	}
     }
@@ -1350,10 +1354,12 @@ conv_caf_send (gfc_code *code) {
       tmp = build_fold_indirect_ref_loc (input_location, rhs_se.expr);
       tmp2 = gfc_typenode_for_spec (&rhs_expr->ts);
       gfc_add_modify (&rhs_se.pre, gfc_conv_descriptor_dtype (tmp),
-                      gfc_get_dtype_rank_type (rhs_expr->rank, tmp2));
+                      gfc_get_dtype_rank_type (has_vector ? ar2.dimen
+							  : rhs_expr->rank,
+		      tmp2));
       if (has_vector)
 	{
-	  rhs_vec = conv_caf_vector_subscript (&block, rhs_se.expr, ar);
+	  rhs_vec = conv_caf_vector_subscript (&block, rhs_se.expr, &ar2);
 	  *ar = ar2;
 	}
     }