gfortran.texi: Document additional src/dst_type.

gcc/fortran/ChangeLog:

2018-02-19  Andre Vehreschild  <vehre@gcc.gnu.org>

	* gfortran.texi: Document additional src/dst_type.  Fix some typos.
	* trans-decl.c (gfc_build_builtin_function_decls): Declare the new
	argument of _caf_*_by_ref () with * e { get, send, sendget }.
	* trans-intrinsic.c (gfc_conv_intrinsic_caf_get): Add the type of the
	data referenced when generating a call to caf_get_by_ref ().
	(conv_caf_send): Same but for caf_send_by_ref () and
	caf_sendget_by_ref ().

gcc/testsuite/ChangeLog:

2018-02-19  Andre Vehreschild  <vehre@gcc.gnu.org>

	* gfortran.dg/coarray_alloc_comp_6.f08: New test.
	* gfortran.dg/coarray_alloc_comp_7.f08: New test.
	* gfortran.dg/coarray_alloc_comp_8.f08: New test.

libgfortran/ChangeLog:

2018-02-19  Andre Vehreschild  <vehre@gcc.gnu.org>

	* caf/libcaf.h: Add type parameters to the caf_*_by_ref prototypes.
	* caf/single.c (get_for_ref): Simplifications and now respecting
	the type argument.
	(_gfortran_caf_get_by_ref): Added source type handing to get_for_ref().
	(send_by_ref): Simplifications and respecting the dst_type now.
	(_gfortran_caf_send_by_ref): Added destination type hand over to
	send_by_ref().
	(_gfortran_caf_sendget_by_ref): Added general support and fixed stack
	corruption.  The function is now really usable.

From-SVN: r257813

1 files changed, 113 insertions, 73 deletions

diff --git a/libgfortran/caf/single.c b/libgfortran/caf/single.c
index bead09a..18906e9 100644
--- a/libgfortran/caf/single.c
+++ b/libgfortran/caf/single.c
@@ -1194,7 +1194,7 @@ get_for_ref (caf_reference_t *ref, size_t *i, size_t *dst_index,
 	     caf_single_token_t single_token, gfc_descriptor_t *dst,
 	     gfc_descriptor_t *src, void *ds, void *sr,
 	     int dst_kind, int src_kind, size_t dst_dim, size_t src_dim,
-	     size_t num, int *stat)
+	     size_t num, int *stat, int src_type)
 {
   ptrdiff_t extent_src = 1, array_offset_src = 0, stride_src;
   size_t next_dst_dim;
@@ -1209,25 +1209,24 @@ get_for_ref (caf_reference_t *ref, size_t *i, size_t *dst_index,
       size_t dst_size = GFC_DESCRIPTOR_SIZE (dst);
       ptrdiff_t array_offset_dst = 0;;
       size_t dst_rank = GFC_DESCRIPTOR_RANK (dst);
-      int src_type = -1;
 
       switch (ref->type)
 	{
 	case CAF_REF_COMPONENT:
 	  /* Because the token is always registered after the component, its
-	     offset is always greater zeor.  */
+	     offset is always greater zero.  */
 	  if (ref->u.c.caf_token_offset > 0)
+	    /* Note, that sr is dereffed here.  */
 	    copy_data (ds, *(void **)(sr + ref->u.c.offset),
-		       GFC_DESCRIPTOR_TYPE (dst), GFC_DESCRIPTOR_TYPE (dst),
+		       GFC_DESCRIPTOR_TYPE (dst), src_type,
 		       dst_kind, src_kind, dst_size, ref->item_size, 1, stat);
 	  else
 	    copy_data (ds, sr + ref->u.c.offset,
-		       GFC_DESCRIPTOR_TYPE (dst), GFC_DESCRIPTOR_TYPE (src),
+		       GFC_DESCRIPTOR_TYPE (dst), src_type,
 		       dst_kind, src_kind, dst_size, ref->item_size, 1, stat);
 	  ++(*i);
 	  return;
 	case CAF_REF_STATIC_ARRAY:
-	  src_type = ref->u.a.static_array_type;
 	  /* Intentionally fall through.  */
 	case CAF_REF_ARRAY:
 	  if (ref->u.a.mode[src_dim] == CAF_ARR_REF_NONE)
@@ -1235,8 +1234,7 @@ get_for_ref (caf_reference_t *ref, size_t *i, size_t *dst_index,
 	      for (size_t d = 0; d < dst_rank; ++d)
 		array_offset_dst += dst_index[d];
 	      copy_data (ds + array_offset_dst * dst_size, sr,
-			 GFC_DESCRIPTOR_TYPE (dst),
-			 src_type == -1 ? GFC_DESCRIPTOR_TYPE (src) : src_type,
+			 GFC_DESCRIPTOR_TYPE (dst), src_type,
 			 dst_kind, src_kind, dst_size, ref->item_size, num,
 			 stat);
 	      *i += num;
@@ -1252,23 +1250,39 @@ get_for_ref (caf_reference_t *ref, size_t *i, size_t *dst_index,
     {
     case CAF_REF_COMPONENT:
       if (ref->u.c.caf_token_offset > 0)
-	get_for_ref (ref->next, i, dst_index,
-		    *(caf_single_token_t*)(sr + ref->u.c.caf_token_offset), dst,
-		 (*(caf_single_token_t*)(sr + ref->u.c.caf_token_offset))->desc,
-		     ds, sr + ref->u.c.offset, dst_kind, src_kind, dst_dim, 0,
-		     1, stat);
+	{
+	  single_token = *(caf_single_token_t*)(sr + ref->u.c.caf_token_offset);
+
+	  if (ref->next && ref->next->type == CAF_REF_ARRAY)
+	    src = single_token->desc;
+	  else
+	    src = NULL;
+
+	  if (ref->next && ref->next->type == CAF_REF_COMPONENT)
+	    /* The currently ref'ed component was allocatabe (caf_token_offset
+	       > 0) and the next ref is a component, too, then the new sr has to
+	       be dereffed.  (static arrays can not be allocatable or they
+	       become an array with descriptor.  */
+	    sr = *(void **)(sr + ref->u.c.offset);
+	  else
+	    sr += ref->u.c.offset;
+
+	  get_for_ref (ref->next, i, dst_index, single_token, dst, src,
+		       ds, sr, dst_kind, src_kind, dst_dim, 0,
+		       1, stat, src_type);
+	}
       else
 	get_for_ref (ref->next, i, dst_index, single_token, dst,
 		     (gfc_descriptor_t *)(sr + ref->u.c.offset), ds,
 		     sr + ref->u.c.offset, dst_kind, src_kind, dst_dim, 0, 1,
-		     stat);
+		     stat, src_type);
       return;
     case CAF_REF_ARRAY:
       if (ref->u.a.mode[src_dim] == CAF_ARR_REF_NONE)
 	{
 	  get_for_ref (ref->next, i, dst_index, single_token, dst,
 		       src, ds, sr, dst_kind, src_kind,
-		       dst_dim, 0, 1, stat);
+		       dst_dim, 0, 1, stat, src_type);
 	  return;
 	}
       /* Only when on the left most index switch the data pointer to
@@ -1311,7 +1325,7 @@ get_for_ref (caf_reference_t *ref, size_t *i, size_t *dst_index,
 	      get_for_ref (ref, i, dst_index, single_token, dst, src,
 			   ds, sr + array_offset_src * ref->item_size,
 			   dst_kind, src_kind, dst_dim + 1, src_dim + 1,
-			   1, stat);
+			   1, stat, src_type);
 	      dst_index[dst_dim]
 		  += GFC_DIMENSION_STRIDE (dst->dim[dst_dim]);
 	    }
@@ -1331,7 +1345,7 @@ get_for_ref (caf_reference_t *ref, size_t *i, size_t *dst_index,
 	      get_for_ref (ref, i, dst_index, single_token, dst, src,
 			   ds, sr + array_offset_src * ref->item_size,
 			   dst_kind, src_kind, dst_dim + 1, src_dim + 1,
-			   1, stat);
+			   1, stat, src_type);
 	      dst_index[dst_dim]
 		  += GFC_DIMENSION_STRIDE (dst->dim[dst_dim]);
 	    }
@@ -1358,7 +1372,7 @@ get_for_ref (caf_reference_t *ref, size_t *i, size_t *dst_index,
 	      get_for_ref (ref, i, dst_index, single_token, dst, src,
 			   ds, sr + array_offset_src * ref->item_size,
 			   dst_kind, src_kind, next_dst_dim, src_dim + 1,
-			   1, stat);
+			   1, stat, src_type);
 	      dst_index[dst_dim]
 		  += GFC_DIMENSION_STRIDE (dst->dim[dst_dim]);
 	      array_offset_src += stride_src;
@@ -1372,7 +1386,7 @@ get_for_ref (caf_reference_t *ref, size_t *i, size_t *dst_index,
 	  get_for_ref (ref, i, dst_index, single_token, dst, src, ds,
 		       sr + array_offset_src * ref->item_size,
 		       dst_kind, src_kind, dst_dim, src_dim + 1, 1,
-		       stat);
+		       stat, src_type);
 	  return;
 	case CAF_ARR_REF_OPEN_END:
 	  COMPUTE_NUM_ITEMS (extent_src,
@@ -1390,7 +1404,7 @@ get_for_ref (caf_reference_t *ref, size_t *i, size_t *dst_index,
 	      get_for_ref (ref, i, dst_index, single_token, dst, src,
 			   ds, sr + array_offset_src * ref->item_size,
 			   dst_kind, src_kind, dst_dim + 1, src_dim + 1,
-			   1, stat);
+			   1, stat, src_type);
 	      dst_index[dst_dim]
 		  += GFC_DIMENSION_STRIDE (dst->dim[dst_dim]);
 	      array_offset_src += stride_src;
@@ -1410,7 +1424,7 @@ get_for_ref (caf_reference_t *ref, size_t *i, size_t *dst_index,
 	      get_for_ref (ref, i, dst_index, single_token, dst, src,
 			   ds, sr + array_offset_src * ref->item_size,
 			   dst_kind, src_kind, dst_dim + 1, src_dim + 1,
-			   1, stat);
+			   1, stat, src_type);
 	      dst_index[dst_dim]
 		  += GFC_DIMENSION_STRIDE (dst->dim[dst_dim]);
 	      array_offset_src += stride_src;
@@ -1425,7 +1439,7 @@ get_for_ref (caf_reference_t *ref, size_t *i, size_t *dst_index,
 	{
 	  get_for_ref (ref->next, i, dst_index, single_token, dst,
 		       NULL, ds, sr, dst_kind, src_kind,
-		       dst_dim, 0, 1, stat);
+		       dst_dim, 0, 1, stat, src_type);
 	  return;
 	}
       switch (ref->u.a.mode[src_dim])
@@ -1460,7 +1474,7 @@ get_for_ref (caf_reference_t *ref, size_t *i, size_t *dst_index,
 	      get_for_ref (ref, i, dst_index, single_token, dst, NULL,
 			   ds, sr + array_offset_src * ref->item_size,
 			   dst_kind, src_kind, dst_dim + 1, src_dim + 1,
-			   1, stat);
+			   1, stat, src_type);
 	      dst_index[dst_dim]
 		  += GFC_DIMENSION_STRIDE (dst->dim[dst_dim]);
 	    }
@@ -1474,7 +1488,7 @@ get_for_ref (caf_reference_t *ref, size_t *i, size_t *dst_index,
 	      get_for_ref (ref, i, dst_index, single_token, dst, NULL,
 			   ds, sr + array_offset_src * ref->item_size,
 			   dst_kind, src_kind, dst_dim + 1, src_dim + 1,
-			   1, stat);
+			   1, stat, src_type);
 	      dst_index[dst_dim]
 		  += GFC_DIMENSION_STRIDE (dst->dim[dst_dim]);
 	    }
@@ -1491,7 +1505,7 @@ get_for_ref (caf_reference_t *ref, size_t *i, size_t *dst_index,
 	      get_for_ref (ref, i, dst_index, single_token, dst, NULL,
 			   ds, sr + array_offset_src * ref->item_size,
 			   dst_kind, src_kind, dst_dim + 1, src_dim + 1,
-			   1, stat);
+			   1, stat, src_type);
 	      dst_index[dst_dim]
 		  += GFC_DIMENSION_STRIDE (dst->dim[dst_dim]);
 	      array_offset_src += ref->u.a.dim[src_dim].s.stride;
@@ -1502,7 +1516,7 @@ get_for_ref (caf_reference_t *ref, size_t *i, size_t *dst_index,
 	  get_for_ref (ref, i, dst_index, single_token, dst, NULL, ds,
 		       sr + array_offset_src * ref->item_size,
 		       dst_kind, src_kind, dst_dim, src_dim + 1, 1,
-		       stat);
+		       stat, src_type);
 	  return;
 	/* The OPEN_* are mapped to a RANGE and therefore can not occur.  */
 	case CAF_ARR_REF_OPEN_END:
@@ -1523,7 +1537,8 @@ _gfortran_caf_get_by_ref (caf_token_t token,
 			  gfc_descriptor_t *dst, caf_reference_t *refs,
 			  int dst_kind, int src_kind,
 			  bool may_require_tmp __attribute__ ((unused)),
-			  bool dst_reallocatable, int *stat)
+			  bool dst_reallocatable, int *stat,
+			  int src_type)
 {
   const char vecrefunknownkind[] = "libcaf_single::caf_get_by_ref(): "
 				   "unknown kind in vector-ref.\n";
@@ -1585,7 +1600,13 @@ _gfortran_caf_get_by_ref (caf_token_t token,
 	  else
 	    {
 	      memptr += riter->u.c.offset;
-	      src = (gfc_descriptor_t *)memptr;
+	      /* When the next ref is an array ref, assume there is an
+		 array descriptor at memptr.  Note, static arrays do not have
+		 a descriptor.  */
+	      if (riter->next && riter->next->type == CAF_REF_ARRAY)
+		src = (gfc_descriptor_t *)memptr;
+	      else
+		src = NULL;
 	    }
 	  break;
 	case CAF_REF_ARRAY:
@@ -1677,6 +1698,13 @@ _gfortran_caf_get_by_ref (caf_token_t token,
 		  caf_internal_error (extentoutofrange, stat, NULL, 0);
 		  return;
 		}
+	      /* Special mode when called by __caf_sendget_by_ref ().  */
+	      if (dst_rank == -1 && GFC_DESCRIPTOR_DATA (dst) == NULL)
+		{
+		  dst_rank = dst_cur_dim + 1;
+		  GFC_DESCRIPTOR_RANK (dst) = dst_rank;
+		  GFC_DESCRIPTOR_SIZE (dst) = dst_kind;
+		}
 	      /* When dst is an array.  */
 	      if (dst_rank > 0)
 		{
@@ -1845,6 +1873,13 @@ _gfortran_caf_get_by_ref (caf_token_t token,
 		  caf_internal_error (extentoutofrange, stat, NULL, 0);
 		  return;
 		}
+	      /* Special mode when called by __caf_sendget_by_ref ().  */
+	      if (dst_rank == -1 && GFC_DESCRIPTOR_DATA (dst) == NULL)
+		{
+		  dst_rank = dst_cur_dim + 1;
+		  GFC_DESCRIPTOR_RANK (dst) = dst_rank;
+		  GFC_DESCRIPTOR_SIZE (dst) = dst_kind;
+		}
 	      /* When dst is an array.  */
 	      if (dst_rank > 0)
 		{
@@ -1946,6 +1981,13 @@ _gfortran_caf_get_by_ref (caf_token_t token,
       if (!array_extent_fixed)
 	{
 	  assert (size == 1);
+	  /* Special mode when called by __caf_sendget_by_ref ().  */
+	  if (dst_rank == -1 && GFC_DESCRIPTOR_DATA (dst) == NULL)
+	    {
+	      dst_rank = dst_cur_dim + 1;
+	      GFC_DESCRIPTOR_RANK (dst) = dst_rank;
+	      GFC_DESCRIPTOR_SIZE (dst) = dst_kind;
+	    }
 	  /* This can happen only, when the result is scalar.  */
 	  for (dst_cur_dim = 0; dst_cur_dim < dst_rank; ++dst_cur_dim)
 	    GFC_DIMENSION_SET (dst->dim[dst_cur_dim], 1, 1, 1);
@@ -1967,7 +2009,7 @@ _gfortran_caf_get_by_ref (caf_token_t token,
   i = 0;
   get_for_ref (refs, &i, dst_index, single_token, dst, src,
 	       GFC_DESCRIPTOR_DATA (dst), memptr, dst_kind, src_kind, 0, 0,
-	       1, stat);
+	       1, stat, src_type);
 }
 
 
@@ -1976,7 +2018,7 @@ send_by_ref (caf_reference_t *ref, size_t *i, size_t *src_index,
 	     caf_single_token_t single_token, gfc_descriptor_t *dst,
 	     gfc_descriptor_t *src, void *ds, void *sr,
 	     int dst_kind, int src_kind, size_t dst_dim, size_t src_dim,
-	     size_t num, size_t size, int *stat)
+	     size_t num, size_t size, int *stat, int dst_type)
 {
   const char vecrefunknownkind[] = "libcaf_single::caf_send_by_ref(): "
       "unknown kind in vector-ref.\n";
@@ -1992,7 +2034,6 @@ send_by_ref (caf_reference_t *ref, size_t *i, size_t *src_index,
     {
       size_t src_size = GFC_DESCRIPTOR_SIZE (src);
       ptrdiff_t array_offset_src = 0;;
-      int dst_type = -1;
 
       switch (ref->type)
 	{
@@ -2036,26 +2077,18 @@ send_by_ref (caf_reference_t *ref, size_t *i, size_t *src_index,
 		      dst_type = GFC_DESCRIPTOR_TYPE (dst);
 		    }
 		  else
-		    {
-		      /* When no destination descriptor is present, assume that
-			 source and dest type are identical.  */
-		      dst_type = GFC_DESCRIPTOR_TYPE (src);
-		      ds = *(void **)(ds + ref->u.c.offset);
-		    }
+		    ds = *(void **)(ds + ref->u.c.offset);
 		}
 	      copy_data (ds, sr, dst_type, GFC_DESCRIPTOR_TYPE (src),
 			 dst_kind, src_kind, ref->item_size, src_size, 1, stat);
 	    }
 	  else
-	    copy_data (ds + ref->u.c.offset, sr,
-		       dst != NULL ? GFC_DESCRIPTOR_TYPE (dst)
-				   : GFC_DESCRIPTOR_TYPE (src),
+	    copy_data (ds + ref->u.c.offset, sr, dst_type,
 		       GFC_DESCRIPTOR_TYPE (src),
 		       dst_kind, src_kind, ref->item_size, src_size, 1, stat);
 	  ++(*i);
 	  return;
 	case CAF_REF_STATIC_ARRAY:
-	  dst_type = ref->u.a.static_array_type;
 	  /* Intentionally fall through.  */
 	case CAF_REF_ARRAY:
 	  if (ref->u.a.mode[dst_dim] == CAF_ARR_REF_NONE)
@@ -2064,18 +2097,14 @@ send_by_ref (caf_reference_t *ref, size_t *i, size_t *src_index,
 		{
 		  for (size_t d = 0; d < src_rank; ++d)
 		    array_offset_src += src_index[d];
-		  copy_data (ds, sr + array_offset_src * ref->item_size,
-			     dst_type == -1 ? GFC_DESCRIPTOR_TYPE (dst)
-					    : dst_type,
-			     GFC_DESCRIPTOR_TYPE (src), dst_kind, src_kind,
-			     ref->item_size, src_size, num, stat);
+		  copy_data (ds, sr + array_offset_src * src_size,
+			     dst_type, GFC_DESCRIPTOR_TYPE (src), dst_kind,
+			     src_kind, ref->item_size, src_size, num, stat);
 		}
 	      else
-		copy_data (ds, sr,
-			   dst_type == -1 ? GFC_DESCRIPTOR_TYPE (dst)
-					  : dst_type,
-			   GFC_DESCRIPTOR_TYPE (src), dst_kind, src_kind,
-			   ref->item_size, src_size, num, stat);
+		copy_data (ds, sr, dst_type, GFC_DESCRIPTOR_TYPE (src),
+			   dst_kind, src_kind, ref->item_size, src_size, num,
+			   stat);
 	      *i += num;
 	      return;
 	    }
@@ -2123,22 +2152,30 @@ send_by_ref (caf_reference_t *ref, size_t *i, size_t *src_index,
 		return;
 	    }
 	  single_token = *(caf_single_token_t*)(ds + ref->u.c.caf_token_offset);
+	  /* When a component is allocatable (caf_token_offset != 0) and not an
+	     array (ref->next->type == CAF_REF_COMPONENT), then ds has to be
+	     dereffed.  */
+	  if (ref->next && ref->next->type == CAF_REF_COMPONENT)
+	    ds = *(void **)(ds + ref->u.c.offset);
+	  else
+	    ds += ref->u.c.offset;
+
 	  send_by_ref (ref->next, i, src_index, single_token,
-		       single_token->desc, src, ds + ref->u.c.offset, sr,
-		       dst_kind, src_kind, 0, src_dim, 1, size, stat);
+		       single_token->desc, src, ds, sr,
+		       dst_kind, src_kind, 0, src_dim, 1, size, stat, dst_type);
 	}
       else
 	send_by_ref (ref->next, i, src_index, single_token,
 		     (gfc_descriptor_t *)(ds + ref->u.c.offset), src,
 		     ds + ref->u.c.offset, sr, dst_kind, src_kind, 0, src_dim,
-		     1, size, stat);
+		     1, size, stat, dst_type);
       return;
     case CAF_REF_ARRAY:
       if (ref->u.a.mode[dst_dim] == CAF_ARR_REF_NONE)
 	{
 	  send_by_ref (ref->next, i, src_index, single_token,
 		       (gfc_descriptor_t *)ds, src, ds, sr, dst_kind, src_kind,
-		       0, src_dim, 1, size, stat);
+		       0, src_dim, 1, size, stat, dst_type);
 	  return;
 	}
       /* Only when on the left most index switch the data pointer to
@@ -2180,7 +2217,7 @@ send_by_ref (caf_reference_t *ref, size_t *i, size_t *src_index,
 	      send_by_ref (ref, i, src_index, single_token, dst, src,
 			   ds + array_offset_dst * ref->item_size, sr,
 			   dst_kind, src_kind, dst_dim + 1, src_dim + 1,
-			   1, size, stat);
+			   1, size, stat, dst_type);
 	      if (src_rank > 0)
 		src_index[src_dim]
 		    += GFC_DIMENSION_STRIDE (src->dim[src_dim]);
@@ -2201,7 +2238,7 @@ send_by_ref (caf_reference_t *ref, size_t *i, size_t *src_index,
 	      send_by_ref (ref, i, src_index, single_token, dst, src,
 			   ds + array_offset_dst * ref->item_size, sr,
 			   dst_kind, src_kind, dst_dim + 1, src_dim + 1,
-			   1, size, stat);
+			   1, size, stat, dst_type);
 	      if (src_rank > 0)
 		src_index[src_dim]
 		    += GFC_DIMENSION_STRIDE (src->dim[src_dim]);
@@ -2222,7 +2259,7 @@ send_by_ref (caf_reference_t *ref, size_t *i, size_t *src_index,
 	      send_by_ref (ref, i, src_index, single_token, dst, src,
 			   ds + array_offset_dst * ref->item_size, sr,
 			   dst_kind, src_kind, dst_dim + 1, src_dim + 1,
-			   1, size, stat);
+			   1, size, stat, dst_type);
 	      if (src_rank > 0)
 		src_index[src_dim]
 		    += GFC_DIMENSION_STRIDE (src->dim[src_dim]);
@@ -2236,7 +2273,7 @@ send_by_ref (caf_reference_t *ref, size_t *i, size_t *src_index,
 	  send_by_ref (ref, i, src_index, single_token, dst, src, ds
 		       + array_offset_dst * ref->item_size, sr,
 		       dst_kind, src_kind, dst_dim + 1, src_dim, 1,
-		       size, stat);
+		       size, stat, dst_type);
 	  return;
 	case CAF_ARR_REF_OPEN_END:
 	  COMPUTE_NUM_ITEMS (extent_dst,
@@ -2253,7 +2290,7 @@ send_by_ref (caf_reference_t *ref, size_t *i, size_t *src_index,
 	      send_by_ref (ref, i, src_index, single_token, dst, src,
 			   ds + array_offset_dst * ref->item_size, sr,
 			   dst_kind, src_kind, dst_dim + 1, src_dim + 1,
-			   1, size, stat);
+			   1, size, stat, dst_type);
 	      if (src_rank > 0)
 		src_index[src_dim]
 		    += GFC_DIMENSION_STRIDE (src->dim[src_dim]);
@@ -2274,7 +2311,7 @@ send_by_ref (caf_reference_t *ref, size_t *i, size_t *src_index,
 	      send_by_ref (ref, i, src_index, single_token, dst, src,
 			   ds + array_offset_dst * ref->item_size, sr,
 			   dst_kind, src_kind, dst_dim + 1, src_dim + 1,
-			   1, size, stat);
+			   1, size, stat, dst_type);
 	      if (src_rank > 0)
 		src_index[src_dim]
 		    += GFC_DIMENSION_STRIDE (src->dim[src_dim]);
@@ -2290,7 +2327,7 @@ send_by_ref (caf_reference_t *ref, size_t *i, size_t *src_index,
 	{
 	  send_by_ref (ref->next, i, src_index, single_token, NULL,
 		       src, ds, sr, dst_kind, src_kind,
-		       0, src_dim, 1, size, stat);
+		       0, src_dim, 1, size, stat, dst_type);
 	  return;
 	}
       switch (ref->u.a.mode[dst_dim])
@@ -2325,7 +2362,7 @@ send_by_ref (caf_reference_t *ref, size_t *i, size_t *src_index,
 	      send_by_ref (ref, i, src_index, single_token, NULL, src,
 			   ds + array_offset_dst * ref->item_size, sr,
 			   dst_kind, src_kind, dst_dim + 1, src_dim + 1,
-			   1, size, stat);
+			   1, size, stat, dst_type);
 	      src_index[src_dim]
 		  += GFC_DIMENSION_STRIDE (src->dim[src_dim]);
 	    }
@@ -2339,7 +2376,7 @@ send_by_ref (caf_reference_t *ref, size_t *i, size_t *src_index,
 	      send_by_ref (ref, i, src_index, single_token, NULL, src,
 			   ds + array_offset_dst * ref->item_size, sr,
 			   dst_kind, src_kind, dst_dim + 1, src_dim + 1,
-			   1, size, stat);
+			   1, size, stat, dst_type);
 	      if (src_rank > 0)
 		src_index[src_dim]
 		    += GFC_DIMENSION_STRIDE (src->dim[src_dim]);
@@ -2357,7 +2394,7 @@ send_by_ref (caf_reference_t *ref, size_t *i, size_t *src_index,
 	      send_by_ref (ref, i, src_index, single_token, NULL, src,
 			   ds + array_offset_dst * ref->item_size, sr,
 			   dst_kind, src_kind, dst_dim + 1, src_dim + 1,
-			   1, size, stat);
+			   1, size, stat, dst_type);
 	      if (src_rank > 0)
 		src_index[src_dim]
 		    += GFC_DIMENSION_STRIDE (src->dim[src_dim]);
@@ -2369,7 +2406,7 @@ send_by_ref (caf_reference_t *ref, size_t *i, size_t *src_index,
 	  send_by_ref (ref, i, src_index, single_token, NULL, src,
 		       ds + array_offset_dst * ref->item_size, sr,
 		       dst_kind, src_kind, dst_dim + 1, src_dim, 1,
-		       size, stat);
+		       size, stat, dst_type);
 	  return;
 	/* The OPEN_* are mapped to a RANGE and therefore can not occur.  */
 	case CAF_ARR_REF_OPEN_END:
@@ -2390,7 +2427,7 @@ _gfortran_caf_send_by_ref (caf_token_t token,
 			   gfc_descriptor_t *src, caf_reference_t *refs,
 			   int dst_kind, int src_kind,
 			   bool may_require_tmp __attribute__ ((unused)),
-			   bool dst_reallocatable, int *stat)
+			   bool dst_reallocatable, int *stat, int dst_type)
 {
   const char vecrefunknownkind[] = "libcaf_single::caf_get_by_ref(): "
 				   "unknown kind in vector-ref.\n";
@@ -2748,7 +2785,7 @@ _gfortran_caf_send_by_ref (caf_token_t token,
   i = 0;
   send_by_ref (refs, &i, dst_index, single_token, dst, src,
 	       memptr, GFC_DESCRIPTOR_DATA (src), dst_kind, src_kind, 0, 0,
-	       1, size, stat);
+	       1, size, stat, dst_type);
   assert (i == size);
 }
 
@@ -2759,20 +2796,23 @@ _gfortran_caf_sendget_by_ref (caf_token_t dst_token, int dst_image_index,
 			      int src_image_index,
 			      caf_reference_t *src_refs, int dst_kind,
 			      int src_kind, bool may_require_tmp, int *dst_stat,
-			      int *src_stat)
+			      int *src_stat, int dst_type, int src_type)
 {
-  gfc_array_void temp;
+  GFC_FULL_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, void) temp;
+  GFC_DESCRIPTOR_DATA (&temp) = NULL;
+  GFC_DESCRIPTOR_RANK (&temp) = -1;
+  GFC_DESCRIPTOR_TYPE (&temp) = dst_type;
 
   _gfortran_caf_get_by_ref (src_token, src_image_index, &temp, src_refs,
 			    dst_kind, src_kind, may_require_tmp, true,
-			    src_stat);
+			    src_stat, src_type);
 
   if (src_stat && *src_stat != 0)
     return;
 
   _gfortran_caf_send_by_ref (dst_token, dst_image_index, &temp, dst_refs,
-			     dst_kind, src_kind, may_require_tmp, true,
-			     dst_stat);
+			     dst_kind, dst_kind, may_require_tmp, true,
+			     dst_stat, dst_type);
   if (GFC_DESCRIPTOR_DATA (&temp))
     free (GFC_DESCRIPTOR_DATA (&temp));
 }