From patchwork Sun Feb 18 15:39:00 2018 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Andre Vehreschild X-Patchwork-Id: 874879 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Authentication-Results: ozlabs.org; spf=pass (mailfrom) smtp.mailfrom=gcc.gnu.org (client-ip=209.132.180.131; helo=sourceware.org; envelope-from=gcc-patches-return-473503-incoming=patchwork.ozlabs.org@gcc.gnu.org; receiver=) Authentication-Results: ozlabs.org; dkim=pass (1024-bit key; unprotected) header.d=gcc.gnu.org header.i=@gcc.gnu.org header.b="Gd9f6TKR"; dkim-atps=neutral Received: from sourceware.org (server1.sourceware.org [209.132.180.131]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by ozlabs.org (Postfix) with ESMTPS id 3zkrf44tvRz9sWx for ; Mon, 19 Feb 2018 02:39:21 +1100 (AEDT) DomainKey-Signature: a=rsa-sha1; c=nofws; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:date :from:to:subject:message-id:mime-version:content-type; q=dns; s= default; b=a6r+b1/MnRGVHwh0/F70OGevflzlvSB+oVCw6Tr95FvCXbt6LTc7o 85WRhZgw4b6gZRTUVwo6OH1G2EfUl/VbcxACKO0n46O1NRMxwmI3aolQNb1X/C+c E/6jcivf0NmJMbKL78EQ5a+FvMk94wuckzJJOGHd7HTokEGpq7u9QQ= DKIM-Signature: v=1; a=rsa-sha1; c=relaxed; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:date :from:to:subject:message-id:mime-version:content-type; s= default; bh=j2f2M4cnFsYVGVdnTMYTHPdh8/I=; b=Gd9f6TKRweo4J6dKEpW7 nBqA1Gp/QC+kkz1meu3msDholPChLOMMEMUeFgDVB3KNtLOpTp2Te9uU5xxSOkE0 NHiohQ0mJpe08ONQFVmYBeW1G1MrtTi8GVhjzC+YPshdknH5CG1ucge//f8dKZvw 9VAGxKibFw8JXFbUdku+kno= Received: (qmail 92552 invoked by alias); 18 Feb 2018 15:39:12 -0000 Mailing-List: contact gcc-patches-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Unsubscribe: List-Archive: List-Post: List-Help: Sender: gcc-patches-owner@gcc.gnu.org Delivered-To: mailing list gcc-patches@gcc.gnu.org Received: (qmail 92524 invoked by uid 89); 18 Feb 2018 15:39:10 -0000 Authentication-Results: sourceware.org; auth=none X-Virus-Found: No X-Spam-SWARE-Status: No, score=-25.9 required=5.0 tests=AWL, BAYES_00, FREEMAIL_FROM, GIT_PATCH_0, GIT_PATCH_1, GIT_PATCH_2, GIT_PATCH_3, RCVD_IN_DNSWL_LOW, SPF_PASS autolearn=ham version=3.3.2 spammy=Intentionally X-Spam-User: qpsmtpd, 2 recipients X-HELO: mout.gmx.net Received: from mout.gmx.net (HELO mout.gmx.net) (212.227.17.21) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with ESMTP; Sun, 18 Feb 2018 15:39:05 +0000 Received: from vepi2 ([92.76.207.44]) by mail.gmx.com (mrgmx103 [212.227.17.168]) with ESMTPSA (Nemesis) id 0LaGfK-1eMMyh1R5K-00m5Cy; Sun, 18 Feb 2018 16:39:02 +0100 Date: Sun, 18 Feb 2018 16:39:00 +0100 From: Andre Vehreschild To: GCC-Patches-ML , GCC-Fortran-ML Subject: [Fortran, PATCH, coarray, v1] Extend caf_*_by_ref () API by a type specifier Message-ID: <20180218163900.095f4a86@vepi2> MIME-Version: 1.0 X-UI-Out-Filterresults: notjunk:1; V01:K0:cK15X1FbGis=:zQl/sb47EiM4D+NoRu4SVV jEwIgkVuTOq1huKb1B3u7L2O9kqYQxStInBaSPRhdAoSonv0DPG7J/OLzqZWx3ju0zsY87onP HEXTqtwsYGIWexjJo3Vfzt0Y8WJlph/r1qS1YeRCDFXvKa+3ZzqlhvGGNSUQz/DTbKkkXnYHH UI29uVoDDsSOklf9IBTkQkO5tBM+WVWkLKDGlj4iqfQNj7Jf4EMWy5jnjI/DnQgzBIeMsvqKZ 2mKHh+XHXqRpWM0/nkVbhriFf9vHPSO1UViNfMCqPZLkedxHgi0+XazlNUqu/fqweD/XAgIx6 I+KcXmp7u0VtN/hyi1LlFyUYjVRx+sMpk0vhMGIZIfKWT9ggzFbYbi3ysLqKXBL/BjiW1g+78 SySi6riyMUseGLFBUp9cHXhGRNsvr00vUO1tZ+NHYgZQ01HwEpMJuWkzJ3M95IO+RgoeYx2Rd JXJQJdU9DHAlGx2u+1IQuXNqMU9NkV+TQLqfHA+rd2JH8HYTG168zTFUN0sYNCbRBPAvphVH/ 6wMy0dA3neLMFdKgLf34rKmYWayNJ8Y6yZ2Mj62W9/ybfDHXu01iiNcpm/q55VxMTBCzuq5de 1WvLxXvV9Vdkij5vymLEvZ4A8VOl+RtLMC4L1QS8sZMlRUKmxXEAJfCu7zJkKo0IUj5KXz8fq +l7Lnzm9Aci9tFX+qsm278UtxE1nS3yOTWoFKMbK6V36KM/WmcWIcXmFleiG8L9UvTPzRJGZW Qsmb/YU28PV4Lh1kWHTo+RLDxNJo9RJ/RrbdL/TI9bh3vaciZJftSCZSugQ1CMgZvKvlUU177 ULIJR3xXyMmi0wST4Qpv9Jnd91U4Q== 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 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)); }