Skip to content

Commit a54df7f

Browse files
committed
Add tests for issue #493 fixed by PR #495
Ensures no regressions of #493 are encountered when slicing multi- codimensioned coarrays
1 parent 7b6da6a commit a54df7f

File tree

3 files changed

+54
-0
lines changed

3 files changed

+54
-0
lines changed

CMakeLists.txt

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -760,6 +760,8 @@ if(opencoarrays_aware_compiler)
760760
# Fixed GCC 7 regressions, should run on GCC 6 and 7
761761
add_caf_test(static_event_post_issue_293 3 static_event_post_issue_293)
762762

763+
add_caf_test(issue-493-coindex-slice 8 issue-493-coindex-slice) # Contributed by @neok-m4700 in #493
764+
763765
# These co_reduce (#172, fixed by PR #332, addl discussion in PR
764766
# #331) tests are for bugs not regressions. Should be fixed in all
765767
# version of GCC, I beleive

src/tests/regression/reported/CMakeLists.txt

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -3,6 +3,7 @@ caf_compile_executable(co_reduce-factorial-int8 issue-172-wrong-co_reduce-int8.f
33
caf_compile_executable(co_reduce-factorial-int64 issue-172-wrong-co_reduce-int64.f90)
44
caf_compile_executable(source-alloc-sync issue-243-source-allocation-no-sync.f90)
55
caf_compile_executable(convert-before-put issue-292-convert-type-before-put.f90)
6+
caf_compile_executable(issue-493-coindex-slice issue-493-coindex-slice.f90)
67
caf_compile_executable(issue-422-send issue-422-send.F90)
78
caf_compile_executable(issue-422-send-get issue-422-send-get.F90)
89
caf_compile_executable(issue-488-multi-dim-cobounds issue-488-multi-dim-cobounds.f90)
Lines changed: 51 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,51 @@
1+
program slice
2+
type coarr
3+
real, allocatable :: a(:, :, :)[:, :, :]
4+
end type
5+
6+
type(coarr) :: co
7+
integer :: nimg, me, z, nx, ny, nz, north, south, mex, mey, mez, coords(3)
8+
real, allocatable :: bufxz(:, :) ! a plane (2d) slice, normal in the y direction
9+
10+
nx = 6
11+
ny = 4
12+
nz = 2
13+
14+
me = this_image()
15+
nimg = num_images()
16+
17+
if (nimg /= 8) stop
18+
19+
allocate(co % a(nx, ny, nz)[1:2, 1:2, *])
20+
allocate(bufxz(nx, nz))
21+
22+
co % a = reshape([(z, z=1, nx * ny * nz)], shape(co % a))
23+
24+
coords = this_image(co % a)
25+
mex = coords(1)
26+
mey = coords(2)
27+
mez = coords(3)
28+
29+
north = mey + 1
30+
south = mey - 1
31+
32+
sync all
33+
if (north <= 2) then
34+
z = image_index(co % a, [mex, north, mez])
35+
sync images(z)
36+
bufxz = co % a(1:nx, 1, 1:nz)[mex, north, mez]
37+
co % a(1:nx, ny, 1:nz) = bufxz
38+
end if
39+
if (south >= 1) then
40+
z = image_index(co % a, [mex, south, mez])
41+
sync images(z)
42+
bufxz = co % a(1:nx, 1, 1:nz)[mex, south, mez]
43+
co % a(1:nx, ny, 1:nz) = bufxz
44+
end if
45+
sync all
46+
47+
deallocate(co % a, bufxz)
48+
if(this_image() == 1) write(*,*) "Test passed."
49+
! Regression would cause error message:
50+
! Fortran runtime error on image <...>: libcaf_mpi::caf_get_by_ref(): rank out of range.
51+
end program

0 commit comments

Comments
 (0)