public inbox for gcc-patches@gcc.gnu.org
 help / color / mirror / Atom feed
* [Fortran, PATCH, coarray, v1] Extend caf_*_by_ref () API by a type specifier
@ 2018-02-18 15:39 Andre Vehreschild
  2018-02-18 16:53 ` Jerry DeLisle
  0 siblings, 1 reply; 7+ messages in thread
From: Andre Vehreschild @ 2018-02-18 15:39 UTC (permalink / raw)
  To: GCC-Patches-ML, GCC-Fortran-ML

[-- Attachment #1: Type: text/plain, Size: 1346 bytes --]

Hi all,

attached patch fixes an issue with the coarray API. When a component of a
derived type coarray was referenced using a caf_*_by_ref () function and that
component was not an array with a descriptor, then the type of the component was
not known. Which additionally meant, that type conversion was not applied as
required. This patch fixes that issue by adding type specifiers to the three
caf_*_by_ref-calls and implements the functionality for libcaf_single. This is
harmless because other coarray libraries that do not expect this argument just
ignore it.
Additionally does this patch also provide the first working version of
caf_sendget_by_ref in libcaf_single, which previously only lead to a stack
corruption and was not usable since the array descriptor rework (nice job, btw).

I would like to have this patch in trunk knowing that I am somewhat late, but
it would be quite necessary, because as it is now, the coarray feature for
derived types is hardly usable. Furthermore do some people name this a
regression, because the caf_*_by_ref are also used when the lhs of a
caf_get_by_ref() is allocatable which now does not work as expected anymore but
before gcc-6 using caf_get() (w/o reallocation) did.

Bootstrapped and regtested ok on x86_64-linux/f27. Ok for trunk?

- Andre
-- 
Andre Vehreschild * Email: vehre ad gmx dot de 

[-- Attachment #2: caf_extend_api.clog --]
[-- Type: text/plain, Size: 1292 bytes --]

gcc/fortran/ChangeLog:

2018-02-18  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-18  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-18  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.


[-- Attachment #3: caf_extend_api.patch --]
[-- Type: text/x-patch, Size: 35876 bytes --]

diff --git a/gcc/fortran/gfortran.texi b/gcc/fortran/gfortran.texi
index 9ffe6ade661..db48a713661 100644
--- a/gcc/fortran/gfortran.texi
+++ b/gcc/fortran/gfortran.texi
@@ -4750,7 +4750,7 @@ remote image identified by the @var{image_index}.
 @item @emph{Syntax}:
 @code{void _gfortran_caf_send_by_ref (caf_token_t token, int image_index,
 gfc_descriptor_t *src, caf_reference_t *refs, int dst_kind, int src_kind,
-bool may_require_tmp, bool dst_reallocatable, int *stat)}
+bool may_require_tmp, bool dst_reallocatable, int *stat, int dst_type)}
 
 @item @emph{Arguments}:
 @multitable @columnfractions .15 .70
@@ -4774,6 +4774,9 @@ is a full array or component ref.
 @item @var{stat} @tab intent(out) When non-@code{NULL} give the result of the
 operation, i.e., zero on success and non-zero on error.  When @code{NULL} and
 an error occurs, then an error message is printed and the program is terminated.
+@item @var{dst_type} @tab intent(in)  Give the type of the destination.  When
+the destination is not an array, than the precise type, e.g. of a component in
+a derived type, is not known, but provided here.
 @end multitable
 
 @item @emph{NOTES}
@@ -4808,7 +4811,7 @@ identified by the @var{image_index}.
 @item @emph{Syntax}:
 @code{void _gfortran_caf_get_by_ref (caf_token_t token, int image_index,
 caf_reference_t *refs, gfc_descriptor_t *dst, int dst_kind, int src_kind,
-bool may_require_tmp, bool dst_reallocatable, int *stat)}
+bool may_require_tmp, bool dst_reallocatable, int *stat, int src_type)}
 
 @item @emph{Arguments}:
 @multitable @columnfractions .15 .70
@@ -4833,6 +4836,9 @@ array or a component is referenced.
 @item @var{stat} @tab intent(out) When non-@code{NULL} give the result of the
 operation, i.e., zero on success and non-zero on error.  When @code{NULL} and an
 error occurs, then an error message is printed and the program is terminated.
+@item @var{src_type} @tab intent(in)  Give the type of the source.  When the
+source is not an array, than the precise type, e.g. of a component in a
+derived type, is not known, but provided here.
 @end multitable
 
 @item @emph{NOTES}
@@ -4868,7 +4874,8 @@ identified by the @var{src_image_index} to a remote image identified by the
 @code{void _gfortran_caf_sendget_by_ref (caf_token_t dst_token,
 int dst_image_index, caf_reference_t *dst_refs,
 caf_token_t src_token, 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 dst_kind, int src_kind, bool may_require_tmp, int *dst_stat,
+int *src_stat, int dst_type, int src_type)}
 
 @item @emph{Arguments}:
 @multitable @columnfractions .15 .70
@@ -4899,6 +4906,12 @@ program is terminated.
 the get-operation, i.e., zero on success and non-zero on error.  When
 @code{NULL} and an error occurs, then an error message is printed and the
 program is terminated.
+@item @var{dst_type} @tab intent(in)  Give the type of the destination.  When
+the destination is not an array, than the precise type, e.g. of a component in
+a derived type, is not known, but provided here.
+@item @var{src_type} @tab intent(in)  Give the type of the source.  When the
+source is not an array, than the precise type, e.g. of a component in a
+derived type, is not known, but provided here.
 @end multitable
 
 @item @emph{NOTES}
diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index 4fc07b61c68..51de933e82d 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -3662,24 +3662,25 @@ gfc_build_builtin_function_decls (void)
 	integer_type_node, boolean_type_node, integer_type_node);
 
       gfor_fndecl_caf_get_by_ref = gfc_build_library_function_decl_with_spec (
-	get_identifier (PREFIX("caf_get_by_ref")), ".RWRRRRRW", void_type_node,
-	9, pvoid_type_node, integer_type_node, pvoid_type_node, pvoid_type_node,
-	integer_type_node, integer_type_node, boolean_type_node,
-	boolean_type_node, pint_type);
+	get_identifier (PREFIX("caf_get_by_ref")), ".RWRRRRRWR", void_type_node,
+	10, pvoid_type_node, integer_type_node, pvoid_type_node,
+	pvoid_type_node, integer_type_node, integer_type_node,
+	boolean_type_node, boolean_type_node, pint_type, integer_type_node);
 
       gfor_fndecl_caf_send_by_ref = gfc_build_library_function_decl_with_spec (
-	get_identifier (PREFIX("caf_send_by_ref")), ".RRRRRRRW", void_type_node,
-	9, pvoid_type_node, integer_type_node, pvoid_type_node, pvoid_type_node,
-	integer_type_node, integer_type_node, boolean_type_node,
-	boolean_type_node, pint_type);
+	get_identifier (PREFIX("caf_send_by_ref")), ".RRRRRRRWR",
+	void_type_node,	10, pvoid_type_node, integer_type_node, pvoid_type_node,
+	pvoid_type_node, integer_type_node, integer_type_node,
+	boolean_type_node, boolean_type_node, pint_type, integer_type_node);
 
       gfor_fndecl_caf_sendget_by_ref
 	  = gfc_build_library_function_decl_with_spec (
-	    get_identifier (PREFIX("caf_sendget_by_ref")), ".RR.RRRRRWW",
-	    void_type_node, 11, pvoid_type_node, integer_type_node,
+	    get_identifier (PREFIX("caf_sendget_by_ref")), ".RR.RRRRRWWRR",
+	    void_type_node, 13, pvoid_type_node, integer_type_node,
 	    pvoid_type_node, pvoid_type_node, integer_type_node,
 	    pvoid_type_node, integer_type_node, integer_type_node,
-	    boolean_type_node, pint_type, pint_type);
+	    boolean_type_node, pint_type, pint_type, integer_type_node,
+	    integer_type_node);
 
       gfor_fndecl_caf_sync_all = gfc_build_library_function_decl_with_spec (
 	get_identifier (PREFIX("caf_sync_all")), ".WW", void_type_node,
diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c
index 337227d3c08..dd4921681fc 100644
--- a/gcc/fortran/trans-intrinsic.c
+++ b/gcc/fortran/trans-intrinsic.c
@@ -1709,12 +1709,13 @@ gfc_conv_intrinsic_caf_get (gfc_se *se, gfc_expr *expr, tree lhs, tree lhs_kind,
 	  gfc_add_expr_to_block (&se->pre, tmp);
 
 	  tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_get_by_ref,
-				     9, token, image_index, dst_var,
+				     10, token, image_index, dst_var,
 				     caf_reference, lhs_kind, kind,
 				     may_require_tmp,
 				     may_realloc ? boolean_true_node :
 						   boolean_false_node,
-				     stat);
+				     stat, build_int_cst (integer_type_node,
+							  array_expr->ts.type));
 
 	  gfc_add_expr_to_block (&se->pre, tmp);
 
@@ -2100,9 +2101,11 @@ conv_caf_send (gfc_code *code) {
 					     : boolean_false_node;
 	  tmp = build_call_expr_loc (input_location,
 				     gfor_fndecl_caf_send_by_ref,
-				     9, token, image_index, rhs_se.expr,
+				     10, token, image_index, rhs_se.expr,
 				     reference, lhs_kind, rhs_kind,
-				     may_require_tmp, dst_realloc, src_stat);
+				     may_require_tmp, dst_realloc, src_stat,
+				     build_int_cst (integer_type_node,
+						    lhs_expr->ts.type));
 	  }
       else
 	tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_send, 11,
@@ -2147,11 +2150,15 @@ conv_caf_send (gfc_code *code) {
 	  lhs_reference = conv_expr_ref_to_caf_ref (&block, lhs_expr);
 	  rhs_reference = conv_expr_ref_to_caf_ref (&block, rhs_expr);
 	  tmp = build_call_expr_loc (input_location,
-				     gfor_fndecl_caf_sendget_by_ref, 11,
+				     gfor_fndecl_caf_sendget_by_ref, 13,
 				     token, image_index, lhs_reference,
 				     rhs_token, rhs_image_index, rhs_reference,
 				     lhs_kind, rhs_kind, may_require_tmp,
-				     dst_stat, src_stat);
+				     dst_stat, src_stat,
+				     build_int_cst (integer_type_node,
+						    lhs_expr->ts.type),
+				     build_int_cst (integer_type_node,
+						    rhs_expr->ts.type));
 	}
       else
 	{
diff --git a/gcc/testsuite/gfortran.dg/coarray_alloc_comp_6.f08 b/gcc/testsuite/gfortran.dg/coarray_alloc_comp_6.f08
new file mode 100644
index 00000000000..a37554ffc1b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray_alloc_comp_6.f08
@@ -0,0 +1,55 @@
+! { dg-do run }
+! { dg-options "-fcoarray=lib -lcaf_single" }
+! { dg-additional-options "-latomic" { target libatomic_available } }
+
+! Check that type conversion during caf_get_by_ref is done for components.
+
+program main
+
+  implicit none
+
+  type :: mytype
+    integer :: i
+    integer :: i4 
+    integer(kind=1) :: i1
+    real :: r8
+    real(kind=4) :: r4
+    integer :: arr_i4(4)
+    integer(kind=1) :: arr_i1(4)
+    real :: arr_r8(4)
+    real(kind=4) :: arr_r4(4)
+  end type
+
+  type T
+    type(mytype), allocatable :: obj
+  end type T
+
+  type(T), save :: bar[*]
+  integer :: i4, arr_i4(4)
+  integer(kind=1) :: i1, arr_i1(4)
+  real :: r8, arr_r8(4)
+  real(kind=4) :: r4, arr_r4(4)
+
+  bar%obj = mytype(42, 4, INT(1, 1), 8.0, REAL(4.0, 4), (/ 1,2,3,4 /), &
+  &       INT((/ 5,6,7,8 /), 1), (/ 1.2,3.4,5.6,7.8 /), REAL( &
+  &       (/ 8.7,6.5,4.3,2.1 /), 4))
+
+  i1 = bar[1]%obj%r4
+  if (i1 /= 4) stop 1
+  i4 = bar[1]%obj%r8
+  if (i4 /= 8) stop 2
+  r4 = bar[1]%obj%i1
+  if (abs(r4 - 1.0) > 1E-4) stop 3
+  r8 = bar[1]%obj%i4
+  if (abs(r8 - 4.0) > 1E-6) stop 4
+
+  arr_i1 = bar[1]%obj%arr_r4
+  if (any(arr_i1 /= INT((/ 8,6,4,2 /), 1))) stop 5
+  arr_i4 = bar[1]%obj%arr_r8
+  if (any(arr_i4 /= (/ 1,3,5,7 /))) stop 6
+  arr_r4 = bar[1]%obj%arr_i1
+  if (any(abs(arr_r4 - REAL((/ 5,6,7,8 /), 4)) > 1E-4)) stop 7
+  arr_r8 = bar[1]%obj%arr_i4
+  if (any(abs(arr_r8 - (/ 1,2,3,4 /)) > 1E-6)) stop 8
+end program
+
diff --git a/gcc/testsuite/gfortran.dg/coarray_alloc_comp_7.f08 b/gcc/testsuite/gfortran.dg/coarray_alloc_comp_7.f08
new file mode 100644
index 00000000000..93925828da1
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray_alloc_comp_7.f08
@@ -0,0 +1,62 @@
+! { dg-do run }
+! { dg-options "-fcoarray=lib -lcaf_single" }
+! { dg-additional-options "-latomic" { target libatomic_available } }
+
+! Check that type conversion during caf_send_by_ref is done for components.
+
+program main
+
+  implicit none
+
+  type :: mytype
+    integer :: i
+    integer :: i4 
+    integer(kind=1) :: i1
+    real :: r8
+    real(kind=4) :: r4
+    integer :: arr_i4(4)
+    integer(kind=1) :: arr_i1(4)
+    real :: arr_r8(4)
+    real(kind=4) :: arr_r4(4)
+  end type
+
+  type T
+    type(mytype), allocatable :: obj
+  end type T
+
+  type(T), save :: bar[*]
+  integer :: i4, arr_i4(4)
+  integer(kind=1) :: i1, arr_i1(4)
+  real :: r8, arr_r8(4)
+  real(kind=4) :: r4, arr_r4(4)
+
+  allocate(bar%obj)
+  i1 = INT(1, 1)
+  i4 = 4
+  r4 = REAL(4.0, 4)
+  r8 = 8.0
+  arr_i1 = INT((/ 5,6,7,8 /), 1)
+  arr_i4 = (/ 1,2,3,4 /)
+  arr_r8 = (/ 1.2,3.4,5.6,7.8 /)
+  arr_r4 = REAL((/ 8.7,6.5,4.3,2.1 /), 4)
+
+  bar[1]%obj%r4 = i1
+  if (abs(bar%obj%r4 - 1.0) > 1E-4) stop 1
+  bar[1]%obj%r8 = i4
+  if (abs(bar%obj%r8 - 4.0) > 1E-6) stop 2
+  bar[1]%obj%i1 = r4
+  if (bar%obj%i1 /= 4) stop 3
+  bar[1]%obj%i4 = r8
+  if (bar%obj%i4 /= 8) stop 4
+
+  bar[1]%obj%arr_r4 = arr_i1
+  print *, bar%obj%arr_r4
+  if (any(abs(bar%obj%arr_r4 - REAL((/ 5,6,7,8 /), 4)) > 1E-4)) stop 5
+  bar[1]%obj%arr_r8 = arr_i4
+  if (any(abs(bar%obj%arr_r8 - (/ 1,2,3,4 /)) > 1E-6)) stop 6
+  bar[1]%obj%arr_i1 = arr_r4
+  if (any(bar%obj%arr_i1 /= INT((/ 8,6,4,2 /), 1))) stop 7
+  bar[1]%obj%arr_i4 = arr_r8
+  if (any(bar%obj%arr_i4 /= (/ 1,3,5,7 /))) stop 8
+end program
+
diff --git a/gcc/testsuite/gfortran.dg/coarray_alloc_comp_8.f08 b/gcc/testsuite/gfortran.dg/coarray_alloc_comp_8.f08
new file mode 100644
index 00000000000..679bec32902
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray_alloc_comp_8.f08
@@ -0,0 +1,59 @@
+! { dg-do run }
+! { dg-options "-fcoarray=lib -lcaf_single" }
+! { dg-additional-options "-latomic" { target libatomic_available } }
+
+! Check that type conversion during caf_sendget_by_ref is done for components.
+
+program main
+
+  implicit none
+
+  type :: mytype
+    integer :: i
+    integer :: i4 
+    integer(kind=1) :: i1
+    real :: r8
+    real(kind=4) :: r4
+    integer :: arr_i4(4)
+    integer(kind=1) :: arr_i1(4)
+    real :: arr_r8(4)
+    real(kind=4) :: arr_r4(4)
+  end type
+
+  type T
+    type(mytype), allocatable :: obj
+  end type T
+
+  type(T), save :: bar[*]
+  integer :: i4, arr_i4(4)
+  integer(kind=1) :: i1, arr_i1(4)
+  real :: r8, arr_r8(4)
+  real(kind=4) :: r4, arr_r4(4)
+
+  bar%obj = mytype(42, 4, INT(1, 1), 8.0, REAL(4.0, 4), (/ 1,2,3,4 /), &
+  &       INT((/ 5,6,7,8 /), 1), (/ 1.2,3.4,5.6,7.8 /), REAL( &
+  &       (/ 8.7,6.5,4.3,2.1 /), 4))
+
+  bar[1]%obj%i1 = bar[1]%obj%r4
+  if (bar%obj%i1 /= 4) stop 1
+  bar[1]%obj%i4 = bar[1]%obj%r8
+  if (bar%obj%i4 /= 8) stop 2
+  bar[1]%obj%arr_i1 = bar[1]%obj%arr_r4
+  if (any(bar%obj%arr_i1 /= (/ 8,6,4,2 /))) stop 3
+  bar[1]%obj%arr_i4 = bar[1]%obj%arr_r8
+  if (any(bar%obj%arr_i4 /= (/ 1,3,5,7 /))) stop 4
+
+  bar%obj%i1 = INT(1, 1)
+  bar%obj%i4 = 4
+  bar%obj%arr_i1 = INT((/ 5,6,7,8 /), 1)
+  bar%obj%arr_i4 = (/ 1,2,3,4 /)
+  bar[1]%obj%r4 = bar[1]%obj%i1
+  if (abs(bar%obj%r4 - 1.0) > 1E-4) stop 5
+  bar[1]%obj%r8 = bar[1]%obj%i4
+  if (abs(bar%obj%r8 - 4.0) > 1E-6) stop 6
+  bar[1]%obj%arr_r4 = bar[1]%obj%arr_i1
+  if (any(abs(bar%obj%arr_r4 - REAL((/ 5,6,7,8 /), 4)) > 1E-4)) stop 7
+  bar[1]%obj%arr_r8 = bar[1]%obj%arr_i4
+  if (any(abs(bar%obj%arr_r8 - (/ 1,2,3,4 /)) > 1E-6)) stop 8
+end program
+
diff --git a/libgfortran/caf/libcaf.h b/libgfortran/caf/libcaf.h
index 12c73de8479..f3428a63fae 100644
--- a/libgfortran/caf/libcaf.h
+++ b/libgfortran/caf/libcaf.h
@@ -226,15 +226,17 @@ void _gfortran_caf_sendget (caf_token_t, size_t, int, gfc_descriptor_t *,
 
 void _gfortran_caf_get_by_ref (caf_token_t token, int image_idx,
 	gfc_descriptor_t *dst, caf_reference_t *refs, int dst_kind,
-	int src_kind, bool may_require_tmp, bool dst_reallocatable, int *stat);
+	int src_kind, bool may_require_tmp, bool dst_reallocatable, int *stat,
+	int src_type);
 void _gfortran_caf_send_by_ref (caf_token_t token, int image_index,
 	gfc_descriptor_t *src, caf_reference_t *refs, int dst_kind,
-	int src_kind, bool may_require_tmp, bool dst_reallocatable, int *stat);
+	int src_kind, bool may_require_tmp, bool dst_reallocatable, int *stat,
+	int dst_type);
 void _gfortran_caf_sendget_by_ref (
 	caf_token_t dst_token, int dst_image_index, caf_reference_t *dst_refs,
 	caf_token_t src_token, 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);
 
 void _gfortran_caf_atomic_define (caf_token_t, size_t, int, void *, int *,
 				  int, int);
diff --git a/libgfortran/caf/single.c b/libgfortran/caf/single.c
index bead09a386f..18906e99a94 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));
 }

^ permalink raw reply	[flat|nested] 7+ messages in thread
end of thread, other threads:[~2018-04-08 17:23 UTC | newest]

Thread overview: 7+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2018-02-18 15:39 [Fortran, PATCH, coarray, v1] Extend caf_*_by_ref () API by a type specifier Andre Vehreschild
2018-02-18 16:53 ` Jerry DeLisle
2018-02-18 17:07   ` Andre Vehreschild
2018-02-18 17:33     ` Andre Vehreschild
2018-02-19 17:32       ` Andre Vehreschild
2018-02-20 18:24         ` Damian Rouson
2018-04-08 17:23           ` Andre Vehreschild

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).