Merge remote-tracking branch 'neo/gatherv'

Author: zbeekman

CMakeLists.txt

@@ -776,6 +776,9 @@ 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)
+  if((gfortran_compiler AND (NOT CMAKE_Fortran_COMPILER_VERSION VERSION_LESS 7.0.0)) OR (CAF_RUN_DEVELOPER_TESTS OR $ENV{OPENCOARRAYS_DEVELOPER}))
+    add_caf_test(issue-515-mimic-mpi-gatherv 2 issue-515-mimic-mpi-gatherv)
+  endif()
 
   # IMAGE FAIL tests
   if(NOT CMAKE_Fortran_COMPILER_VERSION VERSION_LESS 7.0.0)

src/mpi/mpi_caf.c

@@ -4626,6 +4626,8 @@ PREFIX (get_by_ref) (caf_token_t token, int image_index,
                           dst->dim[dst_cur_dim].lower_bound = 1;
                           dst->dim[dst_cur_dim]._ubound = delta;
                           dst->dim[dst_cur_dim]._stride = size;
+                          if (realloc_required)
+                            dst->offset = -1;
                         }
                     }
 
@@ -4779,6 +4781,8 @@ PREFIX (get_by_ref) (caf_token_t token, int image_index,
                           dst->dim[dst_cur_dim].lower_bound = 1;
                           dst->dim[dst_cur_dim]._ubound = delta;
                           dst->dim[dst_cur_dim]._stride = size;
+                          if (realloc_required)
+                            dst->offset = -1;
                         }
                     }
                   /* Only increase the dim counter, when in an array ref */

src/tests/regression/reported/CMakeLists.txt

@@ -8,3 +8,6 @@ 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)
+if (gfortran_compiler AND (NOT CMAKE_Fortran_COMPILER_VERSION VERSION_LESS 7.0.0))
+	caf_compile_executable(issue-515-mimic-mpi-gatherv issue-515-mimic-mpi-gatherv.f90)
+endif()

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