* [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
* Re: [Fortran, PATCH, coarray, v1] Extend caf_*_by_ref () API by a type specifier
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
0 siblings, 1 reply; 7+ messages in thread
From: Jerry DeLisle @ 2018-02-18 16:53 UTC (permalink / raw)
To: Andre Vehreschild, GCC-Patches-ML, GCC-Fortran-ML
On 02/18/2018 07:39 AM, Andre Vehreschild wrote:
> 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
>
This is OK from the Fortranners perspective. Should touch base with
release manager. It looks harmless though it changes coarray API, which
is hidden behind -fcoarray=
Regards,
Jerry
^ permalink raw reply [flat|nested] 7+ messages in thread
* Re: [Fortran, PATCH, coarray, v1] Extend caf_*_by_ref () API by a type specifier
2018-02-18 16:53 ` Jerry DeLisle
@ 2018-02-18 17:07 ` Andre Vehreschild
2018-02-18 17:33 ` Andre Vehreschild
0 siblings, 1 reply; 7+ messages in thread
From: Andre Vehreschild @ 2018-02-18 17:07 UTC (permalink / raw)
To: Richard Biener; +Cc: Jerry DeLisle, GCC-Patches-ML, GCC-Fortran-ML
Dear release managers,
this patch (for reference https://gcc.gnu.org/ml/fortran/2018-02/msg00124.html)
fixes a regression in the coarray api by extending three relatively new
functions with one or two arguments, respectively. The patch has been approved
by gfortran devs. Asking your approval to merge it: Ok to merge to trunk?
Regards,
Andre
On Sun, 18 Feb 2018 08:53:41 -0800
Jerry DeLisle <jvdelisle@charter.net> wrote:
> On 02/18/2018 07:39 AM, Andre Vehreschild wrote:
> > 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
> >
>
> This is OK from the Fortranners perspective. Should touch base with
> release manager. It looks harmless though it changes coarray API, which
> is hidden behind -fcoarray=
>
> Regards,
>
> Jerry
--
Andre Vehreschild * Email: vehre ad gmx dot de
^ permalink raw reply [flat|nested] 7+ messages in thread
* Re: [Fortran, PATCH, coarray, v1] Extend caf_*_by_ref () API by a type specifier
2018-02-18 17:07 ` Andre Vehreschild
@ 2018-02-18 17:33 ` Andre Vehreschild
2018-02-19 17:32 ` Andre Vehreschild
0 siblings, 1 reply; 7+ messages in thread
From: Andre Vehreschild @ 2018-02-18 17:33 UTC (permalink / raw)
To: Richard Biener; +Cc: Jerry DeLisle, GCC-Patches-ML, GCC-Fortran-ML
Well, after discussing on IRC whether RM should be bothered, I was asked to
simplify release managers lives and propose, that if no one objects within one
day, I will merge the patch. So any objections?
- Andre
On Sun, 18 Feb 2018 18:07:28 +0100
Andre Vehreschild <vehre@gmx.de> wrote:
> Dear release managers,
>
> this patch (for reference
> https://gcc.gnu.org/ml/fortran/2018-02/msg00124.html) fixes a regression in
> the coarray api by extending three relatively new functions with one or two
> arguments, respectively. The patch has been approved by gfortran devs. Asking
> your approval to merge it: Ok to merge to trunk?
>
> Regards,
> Andre
>
> On Sun, 18 Feb 2018 08:53:41 -0800
> Jerry DeLisle <jvdelisle@charter.net> wrote:
>
> > On 02/18/2018 07:39 AM, Andre Vehreschild wrote:
> > > 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
> > >
> >
> > This is OK from the Fortranners perspective. Should touch base with
> > release manager. It looks harmless though it changes coarray API, which
> > is hidden behind -fcoarray=
> >
> > Regards,
> >
> > Jerry
>
>
--
Andre Vehreschild * Email: vehre ad gmx dot de
^ permalink raw reply [flat|nested] 7+ messages in thread
* Re: [Fortran, PATCH, coarray, v1] Extend caf_*_by_ref () API by a type specifier
2018-02-18 17:33 ` Andre Vehreschild
@ 2018-02-19 17:32 ` Andre Vehreschild
2018-02-20 18:24 ` Damian Rouson
0 siblings, 1 reply; 7+ messages in thread
From: Andre Vehreschild @ 2018-02-19 17:32 UTC (permalink / raw)
To: GCC-Patches-ML, GCC-Fortran-ML
[-- Attachment #1: Type: text/plain, Size: 2862 bytes --]
Hi all,
no objections received therefore committed as r257813. Thanks for fast review
Jerry.
- Andre
On Sun, 18 Feb 2018 18:33:07 +0100
Andre Vehreschild <vehre@gmx.de> wrote:
> Well, after discussing on IRC whether RM should be bothered, I was asked to
> simplify release managers lives and propose, that if no one objects within one
> day, I will merge the patch. So any objections?
>
> - Andre
>
> On Sun, 18 Feb 2018 18:07:28 +0100
> Andre Vehreschild <vehre@gmx.de> wrote:
>
> > Dear release managers,
> >
> > this patch (for reference
> > https://gcc.gnu.org/ml/fortran/2018-02/msg00124.html) fixes a regression in
> > the coarray api by extending three relatively new functions with one or two
> > arguments, respectively. The patch has been approved by gfortran devs.
> > Asking your approval to merge it: Ok to merge to trunk?
> >
> > Regards,
> > Andre
> >
> > On Sun, 18 Feb 2018 08:53:41 -0800
> > Jerry DeLisle <jvdelisle@charter.net> wrote:
> >
> > > On 02/18/2018 07:39 AM, Andre Vehreschild wrote:
> > > > 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
> > > >
> > >
> > > This is OK from the Fortranners perspective. Should touch base with
> > > release manager. It looks harmless though it changes coarray API, which
> > > is hidden behind -fcoarray=
> > >
> > > Regards,
> > >
> > > Jerry
> >
> >
>
>
--
Andre Vehreschild * Email: vehre ad gmx dot de
[-- Attachment #2: submit.diff --]
[-- Type: text/x-patch, Size: 35268 bytes --]
Index: gcc/fortran/ChangeLog
===================================================================
--- gcc/fortran/ChangeLog (Revision 257812)
+++ gcc/fortran/ChangeLog (Arbeitskopie)
@@ -1,3 +1,13 @@
+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 ().
+
2018-02-18 Jerry DeLisle <jvdelisle@gcc.gnu.org>
PR fortran/84389
Index: gcc/fortran/gfortran.texi
===================================================================
--- gcc/fortran/gfortran.texi (Revision 257812)
+++ gcc/fortran/gfortran.texi (Arbeitskopie)
@@ -4750,7 +4750,7 @@
@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 @@
@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 @@
@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 @@
@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 @@
@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 @@
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}
Index: gcc/fortran/trans-decl.c
===================================================================
--- gcc/fortran/trans-decl.c (Revision 257812)
+++ gcc/fortran/trans-decl.c (Arbeitskopie)
@@ -3662,24 +3662,25 @@
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,
Index: gcc/fortran/trans-intrinsic.c
===================================================================
--- gcc/fortran/trans-intrinsic.c (Revision 257812)
+++ gcc/fortran/trans-intrinsic.c (Arbeitskopie)
@@ -1709,12 +1709,13 @@
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 @@
: 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 @@
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
{
Index: gcc/testsuite/ChangeLog
===================================================================
--- gcc/testsuite/ChangeLog (Revision 257812)
+++ gcc/testsuite/ChangeLog (Arbeitskopie)
@@ -1,3 +1,9 @@
+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.
+
2018-02-19 Carl Love <cel@us.ibm.com>
* gcc.target/powerpc/fold-vec-neg-int.p7.c: Remove test file.
Index: gcc/testsuite/gfortran.dg/coarray_alloc_comp_6.f08
===================================================================
--- gcc/testsuite/gfortran.dg/coarray_alloc_comp_6.f08 (nicht existent)
+++ gcc/testsuite/gfortran.dg/coarray_alloc_comp_6.f08 (Arbeitskopie)
@@ -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
+
Index: gcc/testsuite/gfortran.dg/coarray_alloc_comp_7.f08
===================================================================
--- gcc/testsuite/gfortran.dg/coarray_alloc_comp_7.f08 (nicht existent)
+++ gcc/testsuite/gfortran.dg/coarray_alloc_comp_7.f08 (Arbeitskopie)
@@ -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
+
Index: gcc/testsuite/gfortran.dg/coarray_alloc_comp_8.f08
===================================================================
--- gcc/testsuite/gfortran.dg/coarray_alloc_comp_8.f08 (nicht existent)
+++ gcc/testsuite/gfortran.dg/coarray_alloc_comp_8.f08 (Arbeitskopie)
@@ -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
+
Index: libgfortran/ChangeLog
===================================================================
--- libgfortran/ChangeLog (Revision 257812)
+++ libgfortran/ChangeLog (Arbeitskopie)
@@ -1,3 +1,15 @@
+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.
+
2018-02-14 Igor Tsimbalist <igor.v.tsimbalist@intel.com>
PR target/84148
Index: libgfortran/caf/libcaf.h
===================================================================
--- libgfortran/caf/libcaf.h (Revision 257812)
+++ libgfortran/caf/libcaf.h (Arbeitskopie)
@@ -226,15 +226,17 @@
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);
Index: libgfortran/caf/single.c
===================================================================
--- libgfortran/caf/single.c (Revision 257812)
+++ libgfortran/caf/single.c (Arbeitskopie)
@@ -1194,7 +1194,7 @@
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 @@
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 @@
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,16 +1250,32 @@
{
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)
@@ -1268,7 +1282,7 @@
{
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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 @@
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 @@
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 @@
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 @@
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 @@
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 @@
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 @@
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 @@
{
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 @@
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 @@
{
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,15 +2152,23 @@
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)
@@ -2138,7 +2175,7 @@
{
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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 @@
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 @@
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 @@
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
* Re: [Fortran, PATCH, coarray, v1] Extend caf_*_by_ref () API by a type specifier
2018-02-19 17:32 ` Andre Vehreschild
@ 2018-02-20 18:24 ` Damian Rouson
2018-04-08 17:23 ` Andre Vehreschild
0 siblings, 1 reply; 7+ messages in thread
From: Damian Rouson @ 2018-02-20 18:24 UTC (permalink / raw)
To: Andre Vehreschild, GCC-Patches-ML, GCC-Fortran-ML
Hi Andre,
Thanks for your latest work on CAF features. Could you let us know whether this commit should be tested against the OpenCoarrays master branch or another branch? With the master branch, I get one test failure (not counting two known teams failures that are actually false negatives that I need to fix):
lib_caf_mpi::sendget_by_ref(): Warning ! sendget_by_ref() is mostly unfunctional due to a design error. Split up your statement with coarray refs on both sides of the assignment when the datatype transfered is non 4-byte-integer compatible.
libcaf_mpi RUNTIME ERROR: Cannot convert type 1 kind 4 to type 0 kind 4
Is the above expected? Also, because the message comes from sendget, does that mean it only affects lines that involve three images such as the following:
if (this_image()==1) x[2] = x[3]
Damian
On February 19, 2018 at 9:32:06 AM, Andre Vehreschild (vehre@gmx.de) wrote:
Hi all,
no objections received therefore committed as r257813. Thanks for fast review
Jerry.
- Andre
On Sun, 18 Feb 2018 18:33:07 +0100
Andre Vehreschild <vehre@gmx.de> wrote:
> Well, after discussing on IRC whether RM should be bothered, I was asked to
> simplify release managers lives and propose, that if no one objects within one
> day, I will merge the patch. So any objections?
>
> - Andre
>
> On Sun, 18 Feb 2018 18:07:28 +0100
> Andre Vehreschild <vehre@gmx.de> wrote:
>
> > Dear release managers,
> >
> > this patch (for reference
> > https://gcc.gnu.org/ml/fortran/2018-02/msg00124.html) fixes a regression in
> > the coarray api by extending three relatively new functions with one or two
> > arguments, respectively. The patch has been approved by gfortran devs.
> > Asking your approval to merge it: Ok to merge to trunk?
> >
> > Regards,
> > Andre
> >
> > On Sun, 18 Feb 2018 08:53:41 -0800
> > Jerry DeLisle <jvdelisle@charter.net> wrote:
> >
> > > On 02/18/2018 07:39 AM, Andre Vehreschild wrote:
> > > > 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
> > > >
> > >
> > > This is OK from the Fortranners perspective. Should touch base with
> > > release manager. It looks harmless though it changes coarray API, which
> > > is hidden behind -fcoarray=
> > >
> > > Regards,
> > >
> > > Jerry
> >
> >
>
>
--
Andre Vehreschild * Email: vehre ad gmx dot de
^ permalink raw reply [flat|nested] 7+ messages in thread
* Re: [Fortran, PATCH, coarray, v1] Extend caf_*_by_ref () API by a type specifier
2018-02-20 18:24 ` Damian Rouson
@ 2018-04-08 17:23 ` Andre Vehreschild
0 siblings, 0 replies; 7+ messages in thread
From: Andre Vehreschild @ 2018-04-08 17:23 UTC (permalink / raw)
To: Damian Rouson; +Cc: GCC-Patches-ML, GCC-Fortran-ML
Whoops, hi Damian,
sorry for my late reply. I just saw your mail. I am still hanging ~2000
Fortran-Mailinglist mails back and because you copied the mailing list, your
mail got filtered to the mailing list folder and I didn't see it in the vast
number or unread mails.
> Thanks for your latest work on CAF features. Could you let us know whether
> this commit should be tested against the OpenCoarrays master branch or
> another branch? With the master branch, I get one test failure (not counting
> two known teams failures that are actually false negatives that I need to
> fix):
>
> lib_caf_mpi::sendget_by_ref(): Warning ! sendget_by_ref() is mostly
> unfunctional due to a design error. Split up your statement with coarray refs
> on both sides of the assignment when the datatype transfered is non
> 4-byte-integer compatible. libcaf_mpi RUNTIME ERROR: Cannot convert type 1
> kind 4 to type 0 kind 4
>
> Is the above expected? Also, because the message comes from sendget, does
> that mean it only affects lines that involve three images such as the
> following:
>
> if (this_image()==1) x[2] = x[3]
You may test this patch against OpenCoarrays, but without having OC patched it
will not benefit from it. I prepared the gfortran patch to fix exactly the
above error, but haven't had the time to fix Opencoarrays, too. I'd rather get
a better gfortran-8 up and therefore am trying to get pr81773 and 83606 fixed
and get them merged into gfortran-8.
I follow this strategy, because gcc release cycles are less flexible then OCs.
So as soon as I get 81773 and 83606 fixed, I will come back to OC fixing the
type issues.
Sorry for the delayed response. My time is very limited and this last gfortran
fix involved the scalarizer which is a very complicated concept in the gfortran
and I haven't worked with before, therefore a steep learning curve. I hope to
be on track more often soon.
- Andre
>
>
> Damian
>
> On February 19, 2018 at 9:32:06 AM, Andre Vehreschild (vehre@gmx.de) wrote:
>
> Hi all,
>
> no objections received therefore committed as r257813. Thanks for fast
> review Jerry.
>
> - Andre
>
> On Sun, 18 Feb 2018 18:33:07 +0100
> Andre Vehreschild <vehre@gmx.de> wrote:
>
> > Well, after discussing on IRC whether RM should be bothered, I was asked
> > to simplify release managers lives and propose, that if no one objects
> > within one day, I will merge the patch. So any objections?
> >
> > - Andre
> >
> > On Sun, 18 Feb 2018 18:07:28 +0100
> > Andre Vehreschild <vehre@gmx.de> wrote:
> >
> > > Dear release managers,
> > >
> > > this patch (for reference
> > > https://gcc.gnu.org/ml/fortran/2018-02/msg00124.html) fixes a regression
> > > in the coarray api by extending three relatively new functions with one
> > > or two arguments, respectively. The patch has been approved by gfortran
> > > devs. Asking your approval to merge it: Ok to merge to trunk?
> > >
> > > Regards,
> > > Andre
> > >
> > > On Sun, 18 Feb 2018 08:53:41 -0800
> > > Jerry DeLisle <jvdelisle@charter.net> wrote:
> > >
> > > > On 02/18/2018 07:39 AM, Andre Vehreschild wrote:
> > > > > 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
> > > > >
> > > >
> > > > This is OK from the Fortranners perspective. Should touch base with
> > > > release manager. It looks harmless though it changes coarray API,
> > > > which is hidden behind -fcoarray=
> > > >
> > > > Regards,
> > > >
> > > > Jerry
> > >
> > >
> >
> >
>
>
> --
> Andre Vehreschild * Email: vehre ad gmx dot de
--
Andre Vehreschild * Email: vehre ad gmx dot de
^ 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).