Skip to content

Commit 7be68ad

Browse files
author
neok-m4700
committed
Checkpoint
co % a(1, :, :) => CAF_ARR_REF_SINGLE, test still failing co % a(1:1, :, :) => CAF_ARR_REF_RANGE, test passes
1 parent 86c6450 commit 7be68ad

File tree

2 files changed

+87
-62
lines changed

2 files changed

+87
-62
lines changed

‎src/mpi/mpi_caf.c‎

Lines changed: 75 additions & 49 deletions
Original file line numberDiff line numberDiff line change
@@ -1595,9 +1595,13 @@ assign_char4_from_char1(size_t dst_size, size_t src_size, uint32_t *dst,
15951595
size_t i, n;
15961596
n = (dst_size > src_size) ? src_size : dst_size;
15971597
for (i = 0; i < n; ++i)
1598+
{
15981599
dst[i] = (int32_t) src[i];
1600+
}
15991601
for (; i < dst_size; ++i)
1602+
{
16001603
dst[i] = (int32_t) ' ';
1604+
}
16011605
}
16021606

16031607

@@ -4251,12 +4255,13 @@ case kind: \
42514255
* src->dim[src_dim]._stride;
42524256
stride_src =
42534257
src->dim[src_dim]._stride * ref->u.a.dim[src_dim].s.stride;
4254-
/* Increase the dst_dim only, when the src_extent is greater one
4255-
* or src and dst extent are both one. Don't increase when the scalar
4258+
/* Increase the dst_dim only, when the src_extent is greater than one
4259+
* or src and dst extent are both one. Don't increase when the scalar
42564260
* source is not present in the dst. */
4257-
next_dst_dim = extent_src > 1 ||
4258-
(GFC_DESCRIPTOR_EXTENT(dst, dst_dim) == 1 && extent_src == 1) ?
4259-
(dst_dim + 1) : dst_dim;
4261+
next_dst_dim = (
4262+
(extent_src > 1) ||
4263+
(GFC_DESCRIPTOR_EXTENT(dst, dst_dim) == 1 && extent_src == 1)
4264+
) ? (dst_dim + 1) : dst_dim;
42604265
for (ptrdiff_t idx = 0; idx < extent_src; ++idx)
42614266
{
42624267
get_for_ref(ref, i, dst_index, mpi_token, dst, src, ds, sr,
@@ -5010,7 +5015,7 @@ put_data(mpi_caf_token_t *token, MPI_Aint offset, void *sr, int dst_type,
50105015
{
50115016
size_t k;
50125017
int ierr;
5013-
MPI_Win win = token == NULL ? global_dynamic_win : token->memptr_win;
5018+
MPI_Win win = (token == NULL) ? global_dynamic_win : token->memptr_win;
50145019
#ifdef EXTRA_DEBUG_OUTPUT
50155020
if (token)
50165021
dprint("(win: %d, image: %d, offset: %zd) <- %p, "
@@ -5028,7 +5033,8 @@ put_data(mpi_caf_token_t *token, MPI_Aint offset, void *sr, int dst_type,
50285033
size_t sz = (dst_size > src_size ? src_size : dst_size) * num;
50295034
ierr = MPI_Put(sr, sz, MPI_BYTE, image_index, offset, sz, MPI_BYTE, win);
50305035
chk_err(ierr);
5031-
dprint("sr[] = %d, count = %zd\n", (int)((char*)sr)[0], sz);
5036+
dprint("sr[] = %d, num = %zd, num bytes = %zd\n",
5037+
(int)((char*)sr)[0], num, sz);
50325038
if ((dst_type == BT_CHARACTER || src_type == BT_CHARACTER)
50335039
&& dst_size > src_size)
50345040
{
@@ -5041,7 +5047,9 @@ put_data(mpi_caf_token_t *token, MPI_Aint offset, void *sr, int dst_type,
50415047
else /* dst_kind == 4. */
50425048
{
50435049
for (k = 0; k < trans_size; ++k)
5050+
{
50445051
((int32_t*) pad)[k] = (int32_t) ' ';
5052+
}
50455053
}
50465054
ierr = MPI_Put(pad, trans_size * dst_kind, MPI_BYTE, image_index,
50475055
offset + (src_size / src_kind) * dst_kind,
@@ -5108,7 +5116,6 @@ send_for_ref(caf_reference_t *ref, size_t *i, size_t src_index,
51085116
caf_ref_type_t ref_type = ref->type;
51095117
caf_array_ref_t array_ref_src = ref->u.a.mode[src_dim];
51105118
caf_array_ref_t array_ref_dst = ref->u.a.mode[dst_dim];
5111-
size_t src_size = 0;
51125119
int ierr;
51135120

51145121
if (unlikely(ref == NULL))
@@ -5118,13 +5125,18 @@ send_for_ref(caf_reference_t *ref, size_t *i, size_t src_index,
51185125
return;
51195126
}
51205127

5121-
dprint("Entering send_for_ref: "
5128+
dprint("Entering send_for_ref: [i = %zd] src_index = %zd, "
51225129
"dst_offset = %zd, desc_offset = %zd, ds_glb = %d, desc_glb = %d\n",
5123-
dst_byte_offset, desc_byte_offset, ds_global, desc_global);
5130+
*i, src_index, dst_byte_offset, desc_byte_offset,
5131+
ds_global, desc_global);
51245132

51255133
if (ref->next == NULL)
51265134
{
5127-
src_size = GFC_DESCRIPTOR_SIZE(src);
5135+
size_t src_size = GFC_DESCRIPTOR_SIZE(src);
5136+
dprint("[next == NULL]: src_size = %zd, ref_type = %s, "
5137+
"array_ref_src = %s\n",
5138+
src_size, caf_ref_type_str[ref_type],
5139+
caf_array_ref_str[array_ref_src]);
51285140

51295141
switch (ref_type)
51305142
{
@@ -5182,7 +5194,7 @@ send_for_ref(caf_reference_t *ref, size_t *i, size_t src_index,
51825194
{
51835195
if (ds_global)
51845196
{
5185-
put_data(NULL, MPI_Aint_add((MPI_Aint)ds, dst_byte_offset),
5197+
put_data(NULL, MPI_Aint_add((MPI_Aint)ds, dst_byte_offset),
51865198
sr + src_index * src_size,
51875199
#ifdef GCC_GE_8
51885200
dst_type, GFC_DESCRIPTOR_TYPE(src),
@@ -5214,10 +5226,9 @@ send_for_ref(caf_reference_t *ref, size_t *i, size_t src_index,
52145226
}
52155227
}
52165228

5217-
dprint("image_index = %d, num = %zd, src_size = %zd, "
5229+
dprint("image_index = %d, num = %zd, "
52185230
"src_dim = %zd, dst_dim = %zd, ref_type = %s\n",
5219-
image_index, num, src_size, src_dim, dst_dim,
5220-
caf_ref_type_str[ref_type]);
5231+
image_index, num, src_dim, dst_dim, caf_ref_type_str[ref_type]);
52215232

52225233
switch (ref_type)
52235234
{
@@ -5312,8 +5323,8 @@ send_for_ref(caf_reference_t *ref, size_t *i, size_t src_index,
53125323
}
53135324
#endif
53145325
}
5315-
dprint("array_ref_dst[%zd] = %s := array_ref_src[%zd] = %s\n",
5316-
dst_dim, caf_array_ref_str[array_ref_dst],
5326+
dprint("array_ref_dst[%zd] = %s := array_ref_src[%zd] = %s",
5327+
dst_dim, caf_array_ref_str[array_ref_dst],
53175328
src_dim, caf_array_ref_str[array_ref_src]);
53185329
switch (array_ref_dst)
53195330
{
@@ -5372,19 +5383,21 @@ case kind: \
53725383
src_stride, dst_stride);
53735384
for (ptrdiff_t idx = 0; idx < extent_dst;
53745385
++idx, array_offset_dst += dst_stride)
5375-
{
5376-
send_for_ref(ref, i, src_index, mpi_token, dst, src, ds, sr,
5377-
dst_byte_offset + array_offset_dst * ref->item_size,
5378-
desc_byte_offset + array_offset_dst * ref->item_size,
5379-
dst_kind, src_kind, dst_dim + 1, src_dim + 1,
5380-
1, stat, image_index, ds_global, desc_global
5386+
{
5387+
send_for_ref(ref, i, src_index, mpi_token, dst, src, ds, sr,
5388+
dst_byte_offset + array_offset_dst * ref->item_size,
5389+
desc_byte_offset + array_offset_dst * ref->item_size,
5390+
dst_kind, src_kind, dst_dim + 1, src_dim + 1,
5391+
1, stat, image_index, ds_global, desc_global
53815392
#ifdef GCC_GE_8
5382-
, dst_type
5393+
, dst_type
53835394
#endif
5384-
);
5385-
src_index += src_stride;
5386-
}
5395+
);
5396+
src_index += src_stride;
5397+
}
5398+
// dprint("CAF_ARR_REF_FULL: return, i = %zd\n", *i);
53875399
return;
5400+
53885401
case CAF_ARR_REF_RANGE:
53895402
COMPUTE_NUM_ITEMS(extent_dst,
53905403
ref->u.a.dim[dst_dim].s.stride,
@@ -5397,18 +5410,19 @@ case kind: \
53975410
* ref->u.a.dim[dst_dim].s.stride;
53985411
src_stride = (GFC_DESCRIPTOR_RANK(src) > 0) ?
53995412
src->dim[src_dim]._stride : 0;
5400-
/* Increase the dst_dim only, when the src_extent is greater one
5401-
* or src and dst extent are both one. Don't increase when the
5413+
/* Increase the dst_dim only, when the src_extent is greater than one
5414+
* or src and dst extent are both one. Don't increase when the
54025415
* scalar source is not present in the dst. */
5403-
next_dst_dim = (extent_dst > 1) ||
5404-
(GFC_DESCRIPTOR_EXTENT(dst, dst_dim) == 1 && extent_dst == 1) ?
5405-
(dst_dim + 1) : dst_dim;
5416+
next_dst_dim = (
5417+
(extent_dst > 1) ||
5418+
(GFC_DESCRIPTOR_EXTENT(src, src_dim) == 1 && extent_dst == 1)
5419+
) ? (dst_dim + 1) : dst_dim;
54065420
for (ptrdiff_t idx = 0; idx < extent_dst; ++idx)
54075421
{
54085422
send_for_ref(ref, i, src_index, mpi_token, dst, src, ds, sr,
54095423
dst_byte_offset + array_offset_dst * ref->item_size,
54105424
desc_byte_offset + array_offset_dst * ref->item_size,
5411-
dst_kind, src_kind, next_dst_dim, src_dim + 1,
5425+
dst_kind, src_kind, next_dst_dim, src_dim + 1,
54125426
1, stat, image_index, ds_global, desc_global
54135427
#ifdef GCC_GE_8
54145428
, dst_type
@@ -5417,20 +5431,30 @@ case kind: \
54175431
src_index += src_stride;
54185432
array_offset_dst += dst_stride;
54195433
}
5434+
// dprint("CAF_ARR_REF_RANGE: return, i = %zd\n", *i);
54205435
return;
5436+
54215437
case CAF_ARR_REF_SINGLE:
54225438
array_offset_dst =
54235439
(ref->u.a.dim[dst_dim].s.start - dst->dim[dst_dim].lower_bound)
54245440
* dst->dim[dst_dim]._stride;
5441+
// FIXME: issue #552
5442+
// next_dst_dim = (
5443+
// (extent_dst > 1) ||
5444+
// (GFC_DESCRIPTOR_EXTENT(src, src_dim) == 1 && extent_dst == 1)
5445+
// ) ? (dst_dim + 1) : dst_dim;
5446+
next_dst_dim = dst_dim;
54255447
send_for_ref(ref, i, src_index, mpi_token, dst, src, ds, sr,
54265448
dst_byte_offset + array_offset_dst * ref->item_size,
54275449
desc_byte_offset + array_offset_dst * ref->item_size,
5428-
dst_kind, src_kind, dst_dim, src_dim + 1, 1,
5429-
stat, image_index, ds_global, desc_global
5450+
dst_kind, src_kind, next_dst_dim, src_dim + 1,
5451+
1, stat, image_index, ds_global, desc_global
54305452
#ifdef GCC_GE_8
54315453
, dst_type
54325454
#endif
54335455
);
5456+
5457+
// dprint("CAF_ARR_REF_SINGLE: return, i = %zd\n", *i);
54345458
return;
54355459
case CAF_ARR_REF_OPEN_END:
54365460
COMPUTE_NUM_ITEMS(extent_dst,
@@ -5544,18 +5568,18 @@ case kind: \
55445568
for (array_offset_dst = 0 ;
55455569
array_offset_dst <= ref->u.a.dim[dst_dim].s.end;
55465570
array_offset_dst += ref->u.a.dim[dst_dim].s.stride)
5547-
{
5548-
send_for_ref(ref, i, src_index, mpi_token, dst, NULL, ds, sr,
5549-
dst_byte_offset + array_offset_dst * ref->item_size,
5550-
desc_byte_offset + array_offset_dst * ref->item_size,
5551-
dst_kind, src_kind, dst_dim + 1, src_dim + 1,
5552-
1, stat, image_index, ds_global, desc_global
5571+
{
5572+
send_for_ref(ref, i, src_index, mpi_token, dst, NULL, ds, sr,
5573+
dst_byte_offset + array_offset_dst * ref->item_size,
5574+
desc_byte_offset + array_offset_dst * ref->item_size,
5575+
dst_kind, src_kind, dst_dim + 1, src_dim + 1,
5576+
1, stat, image_index, ds_global, desc_global
55535577
#ifdef GCC_GE_8
5554-
, dst_type
5578+
, dst_type
55555579
#endif
5556-
);
5557-
src_index += src_stride;
5558-
}
5580+
);
5581+
src_index += src_stride;
5582+
}
55595583
return;
55605584
case CAF_ARR_REF_RANGE:
55615585
COMPUTE_NUM_ITEMS(extent_dst,
@@ -5585,8 +5609,8 @@ case kind: \
55855609
send_for_ref(ref, i, src_index, mpi_token, dst, NULL, ds, sr,
55865610
dst_byte_offset + array_offset_dst * ref->item_size,
55875611
desc_byte_offset + array_offset_dst * ref->item_size,
5588-
dst_kind, src_kind, dst_dim, src_dim + 1, 1,
5589-
stat, image_index, ds_global, desc_global
5612+
dst_kind, src_kind, dst_dim, src_dim + 1,
5613+
1, stat, image_index, ds_global, desc_global
55905614
#ifdef GCC_GE_8
55915615
, dst_type
55925616
#endif
@@ -6456,8 +6480,8 @@ case kind: \
64566480
CAF_Win_lock(MPI_LOCK_EXCLUSIVE, dst_remote_image, dst_mpi_token->memptr_win);
64576481
send_for_ref(dst_refs, &i, src_index, dst_mpi_token, dst_mpi_token->desc,
64586482
(gfc_descriptor_t *)&temp_src_desc, dst_mpi_token->memptr,
6459-
temp_src_desc.base.base_addr, 0, 0, dst_kind, src_kind,
6460-
0, 0, 1, dst_stat, dst_image_index - 1, false, false
6483+
temp_src_desc.base.base_addr, 0, 0, dst_kind, src_kind, 0, 0,
6484+
1, dst_stat, dst_image_index - 1, false, false
64616485
#ifdef GCC_GE_8
64626486
, dst_type
64636487
#endif
@@ -6767,13 +6791,15 @@ sync_images_internal(int count, int images[], int *stat, char *errmsg,
67676791
for (i = 0; i < count; ++i)
67686792
{
67696793
for (j = 0; j < i; ++j)
6794+
{
67706795
if (images[i] == images[j])
67716796
{
67726797
ierr = STAT_DUP_SYNC_IMAGES;
67736798
if (stat)
67746799
*stat = ierr;
67756800
goto sync_images_err_chk;
67766801
}
6802+
}
67776803
}
67786804

67796805
#ifdef GFC_CAF_CHECK

‎src/tests/regression/reported/issue-552-send_by_ref-singleton.f90‎

Lines changed: 12 additions & 13 deletions
Original file line numberDiff line numberDiff line change
@@ -15,7 +15,7 @@ program main
1515

1616
if (nimg /= 2) error stop 1
1717

18-
ni = 1
18+
ni = 2
1919
nj = 8
2020
nk = 4
2121
allocate(co % a(ni, nj, nk)[*])
@@ -35,7 +35,15 @@ program main
3535

3636
sync all
3737
! singleton on the 1st dimension (delta == 1), triggers the bug
38-
co % a(1, :, :)[remote] = co % b(1, :, :) ! setter
38+
39+
! FIXME: NOK, test FAILS
40+
! co % a(1, :, :)[remote] = co % b(1, :, :) ! setter, (CAF_ARR_REF_SINGLE, CAF_ARR_REF_FULL, CAF_ARR_REF_FULL)
41+
42+
! OK, test pass, with patch
43+
co % a(1:1, :, :)[remote] = co % b(1:1, :, :) ! setter, (CAF_ARR_REF_RANGE, CAF_ARR_REF_FULL, CAF_ARR_REF_FULL)
44+
45+
! OK, test pass, without patch
46+
! co % a(1:2, :, :)[remote] = co % b(1:2, :, :) ! setter, (CAF_ARR_REF_FULL,) * 3
3947

4048
sync all
4149
co % d(1, :, :) = co % a(1, :, :)[remote] ! check
@@ -51,15 +59,15 @@ program main
5159
do j = 1, nj; write(*, *) co % b(1, j, :); end do
5260
write(*, *) ': : (what I see on remote) : :', me
5361
do j = 1, nj; write(*, *) co % d(1, j, :); end do
54-
write(*, *) ': : (what I sent on remote) : :', me
62+
write(*, *) ': : (initial local coarray) : :', me
5563
do j = 1, nj; write(*, *) co % e(1, j, :); end do
5664
write(*, *) ': : : :', me
5765
if (me == 1) sync images(2)
5866

5967
sync all
6068

6169
fail = any(abs(co % b(1, :, :) - co % d(1, :, :)) > epsilon(0.))
62-
fail = .false. ! <== FIXME: this test is still failing, comment when bug in put_data is found !
70+
! fail = .false. ! <== FIXME: this test is still failing, comment when bug in put_data is found !
6371

6472
if (fail) then
6573
write(*, *) 'Test failed!'
@@ -70,12 +78,3 @@ program main
7078

7179
end program
7280

73-
! icar output
74-
! 3/4: Entering send_by_ref(may_require_tmp = 1, dst_type = 3).
75-
! 3/4: _gfortran_caf_send_by_ref() remote_image = 3, offset = 0, remote_mem = 0x7f4a29422060
76-
! 3/4: _gfortran_caf_send_by_ref() remote desc rank: 3 (ref_rank: 7297736)
77-
! 3/4: _gfortran_caf_send_by_ref() remote desc dim[0] = (lb = 1, ub = 1, stride = 1)
78-
! 3/4: _gfortran_caf_send_by_ref() remote desc dim[1] = (lb = 1, ub = 20, stride = 1)
79-
! 3/4: _gfortran_caf_send_by_ref() remote desc dim[2] = (lb = 1, ub = 103, stride = 20)
80-
! 3/4: _gfortran_caf_send_by_ref() extent(dst, 0): 1 != delta: 20. ! <====== mistmatch src_cur_dim not incremented
81-
! 3/4: _gfortran_caf_send_by_ref() extent(dst, 1): 20 != delta: 101.

0 commit comments

Comments
 (0)