FIX: issue 515

Author: neok-m4700

CMakeLists.txt

@@ -776,6 +776,7 @@ if(opencoarrays_aware_compiler)
   add_caf_test(issue-488-multi-dim-cobounds-true  8 issue-488-multi-dim-cobounds true)
   add_caf_test(issue-488-multi-dim-cobounds-false 8 issue-488-multi-dim-cobounds false)
   add_caf_test(issue-503-multidim-array-broadcast 2 issue-503-multidim-array-broadcast)
+  add_caf_test(issue-515-mimic-mpi-gatherv 2 issue-515-mimic-mpi-gatherv)
 
   # IMAGE FAIL tests
   if(NOT CMAKE_Fortran_COMPILER_VERSION VERSION_LESS 7.0.0)

src/tests/regression/reported/CMakeLists.txt

@@ -8,3 +8,4 @@ caf_compile_executable(issue-422-send issue-422-send.F90)
 caf_compile_executable(issue-422-send-get issue-422-send-get.F90)
 caf_compile_executable(issue-488-multi-dim-cobounds issue-488-multi-dim-cobounds.f90)
 caf_compile_executable(issue-503-multidim-array-broadcast issue-503-multidim-array-broadcast.f90)
+caf_compile_executable(issue-515-mimic-mpi-gatherv issue-515-mimic-mpi-gatherv.f90)

src/tests/regression/reported/issue-515-mimic-mpi-gatherv.f90

@@ -0,0 +1,55 @@
+! caf -o gather gather.f90
+! cafrun -np 2 ./gather
+! this example mimics a mpi_gatherv with root=1, and variable size chunks
+! gather into specified locations from all processes in a group
+
+program gather
+   implicit none
+
+   type gvec ! a global vector
+      real, allocatable :: a(:)
+   end type
+
+   type(gvec) :: gc[*]
+   real, allocatable :: gv(:), tmp(:)
+   integer :: me, nimg, gsize, i, lo, hi
+   logical :: fail = .false.
+
+   me = this_image()
+   nimg = num_images()
+
+   allocate(gc % a(2 * me)) ! variable size data in container
+   gc % a = [(me * i, i=1, 2 * me)] ! assignement
+
+   ! collect the global vector size by summing local sizes
+   gsize = size(gc % a)
+   call co_sum(gsize, result_image=1)
+   sync all
+
+   if (me == 1) then
+      if (gsize /= 6) error stop 1
+      allocate(gv(gsize)) ! allocate a global vector of size 6 on img 1
+      lo = 1
+      do i = 1, nimg
+         tmp = gc[i] % a ! note: automatic reallocation of tmp
+         hi = lo + size(tmp) - 1
+         gv(lo:hi) = tmp
+         lo = hi + 1 ! start of next chunk
+      end do
+      print *, 'gv=', gv, ' sum=', sum(gv)
+
+      if (abs(sum(gv) - 23.) > epsilon(0.)) fail = .true.
+   end if
+
+   sync all
+
+   ! CMake test output handler
+   call co_broadcast(fail, source_image=1)
+   if (fail) then
+      write(*, *) 'Test failed!'
+      error stop 5
+   else
+      write(*, *) 'Test passed.'
+   end if
+
+end program