Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Jump to bottom

Fix sending data to self. #786

Merged
merged 1 commit into from
Oct 11, 2024
Merged

Fix sending data to self. #786

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
27 changes: 16 additions & 11 deletions src/runtime-libraries/mpi/mpi_caf.c
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -2026,25 +2026,30 @@ copy_char_to_self(void *src, int src_type, int src_size, int src_kind,

static void
copy_to_self(gfc_descriptor_t *src, int src_kind,
gfc_descriptor_t *dest, int dst_kind, size_t size, int *stat)
gfc_descriptor_t *dst, int dst_kind, size_t elem_size, int *stat)
{
const int src_size = GFC_DESCRIPTOR_SIZE(src),
dst_size = GFC_DESCRIPTOR_SIZE(dst);
const int src_type = GFC_DESCRIPTOR_TYPE(src),
dst_type = GFC_DESCRIPTOR_TYPE(dst);
const int src_rank = GFC_DESCRIPTOR_RANK(src),
dst_rank = GFC_DESCRIPTOR_RANK(dst);
#ifdef GFC_CAF_CHECK
if (GFC_DESCRIPTOR_TYPE(dest) == BT_CHARACTER
|| GFC_DESCRIPTOR_TYPE(src) == BT_CHARACTER)
if (dst_type == BT_CHARACTER || src_type == BT_CHARACTER)
caf_runtime_error("internal error: copy_to_self() for char types called.");
#endif
/* The address of dest passed by the compiler points on the right
* memory location. No offset summation is needed. */
if (dst_kind == src_kind)
memmove(dest->base_addr, src->base_addr, size * GFC_DESCRIPTOR_SIZE(dest));
* memory location. No offset summation is needed. Use the convert with
* strides when src is a scalar. */
if (dst_kind == src_kind && dst_size == src_size && dst_type == src_type
&& src_rank == dst_rank)
memmove(dst->base_addr, src->base_addr, elem_size * dst_size);
else
/* When the rank is 0 then a scalar is copied to a vector and the stride
* is zero. */
convert_with_strides(dest->base_addr, GFC_DESCRIPTOR_TYPE(dest), dst_kind,
GFC_DESCRIPTOR_SIZE(dest), src->base_addr,
GFC_DESCRIPTOR_TYPE(src), src_kind,
(GFC_DESCRIPTOR_RANK(src) > 0)
? GFC_DESCRIPTOR_SIZE(src) : 0, size, stat);
convert_with_strides(dst->base_addr, dst_type, dst_kind,
dst_size, src->base_addr, src_type, src_kind,
src_rank > 0 ? src_size : 0, elem_size, stat);
}

/* token: The token of the array to be written to.
Expand Down
2 changes: 1 addition & 1 deletion src/tests/unit/send-get/send_convert_nums.f90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -364,7 +364,7 @@ program send_convert_nums
& call print_and_register( 'send strided int kind=1 to kind=1 self failed.')

co_int_k4 = -1
co_int_k4(::2)[1] = int_k4
co_int_k4(::2)[1] = int_k4(1:3)
print *, co_int_k4
if (any(co_int_k4 /= [int_k4(1), -1, int_k4(2), -1, int_k4(3)])) &
call print_and_register( 'send strided int kind=4 to kind=4 self failed.')
Expand Down
Loading