Merge pull request #255 from sourceryinstitute/bugfix-strided_sendget

Bugfix strided sendget

Fixes #254

Author: zbeekman

CMakeLists.txt

@@ -370,6 +370,7 @@ if(opencoarrays_aware_compiler)
   add_mpi_test(get_with_offset_1d 2 ${tests_root}/unit/send-get/get_with_offset_1d)
   add_mpi_test(whole_get_array 2 ${tests_root}/unit/send-get/whole_get_array)
   add_mpi_test(strided_get 2 ${tests_root}/unit/send-get/strided_get)
+  add_mpi_test(strided_sendget 3 ${tests_root}/unit/send-get/strided_sendget)
   add_mpi_test(co_sum 4 ${tests_root}/unit/collectives/co_sum_test)
   add_mpi_test(co_broadcast 4 ${tests_root}/unit/collectives/co_broadcast_test)
   add_mpi_test(co_min 4 ${tests_root}/unit/collectives/co_min_test)

src/mpi/mpi_caf.c

@@ -912,37 +912,39 @@ PREFIX (sendget) (caf_token_t token_s, size_t offset_s, int image_index_s,
           ptrdiff_t array_offset_dst = 0;
           ptrdiff_t stride = 1;
           ptrdiff_t extent = 1;
+	  ptrdiff_t tot_ext = 1;
           for (j = 0; j < rank-1; j++)
             {
-              array_offset_dst += ((i / (extent*stride))
+              array_offset_dst += ((i / tot_ext)
                                    % (dest->dim[j]._ubound
                                       - dest->dim[j].lower_bound + 1))
                 * dest->dim[j]._stride;
               extent = (dest->dim[j]._ubound - dest->dim[j].lower_bound + 1);
               stride = dest->dim[j]._stride;
+	      tot_ext *= extent;
             }
 
-	  extent = (dest->dim[rank-1]._ubound - dest->dim[rank-1].lower_bound + 1);
-          array_offset_dst += (i / extent) * dest->dim[rank-1]._stride;
+	  array_offset_dst += (i / tot_ext) * dest->dim[rank-1]._stride;
           dst_offset = offset_s + array_offset_dst*GFC_DESCRIPTOR_SIZE (dest);
 
           ptrdiff_t array_offset_sr = 0;
           if (GFC_DESCRIPTOR_RANK (src) != 0)
             {
               stride = 1;
               extent = 1;
+	      tot_ext = 1;
               for (j = 0; j < GFC_DESCRIPTOR_RANK (src)-1; j++)
                 {
-                  array_offset_sr += ((i / (extent*stride))
+                  array_offset_sr += ((i / tot_ext)
                                       % (src->dim[j]._ubound
                                          - src->dim[j].lower_bound + 1))
                     * src->dim[j]._stride;
                   extent = (src->dim[j]._ubound - src->dim[j].lower_bound + 1);
                   stride = src->dim[j]._stride;
+		  tot_ext *= extent;
                 }
 
-	      extent = (src->dim[rank-1]._ubound - src->dim[rank-1].lower_bound + 1);
-              array_offset_sr += (i / extent) * src->dim[rank-1]._stride;
+              array_offset_sr += (i / tot_ext) * src->dim[rank-1]._stride;
               array_offset_sr *= GFC_DESCRIPTOR_SIZE (src);
             }
           src_offset = offset_g + array_offset_sr;

src/tests/unit/send-get/CMakeLists.txt

@@ -18,3 +18,6 @@ target_link_libraries(whole_get_array OpenCoarrays)
 
 add_executable(strided_get strided_get.f90)
 target_link_libraries(strided_get OpenCoarrays)
+
+add_executable(strided_sendget strided_sendget.f90)
+target_link_libraries(strided_sendget OpenCoarrays)

src/tests/unit/send-get/strided_sendget.f90

@@ -0,0 +1,109 @@
+! Test that sendget with strides on either side (of the assignment) works
+! as expected.
+!
+! This test needs at least three images, because sendget has the potential
+! to check whether on image used in the communication is the current one.
+! More than three images do not pay, because there is no general code in
+! this test.
+!
+! Written by Andre Vehreschild
+
+program stridedsendgettest
+
+  implicit none
+
+  integer, parameter :: src_image = 2, dst_image = 3, master_image = 1
+  integer, save, dimension(4,6) :: srcmat[*], dstmat[*]
+  integer, save, dimension(6) :: srcvec[*], dstvec[*]
+  integer :: i
+  logical :: test_passed = .true.
+
+  ! Make sure that enough images are available for this test.
+  ! Everything less than dst_image == 3 may make sendget use an
+  ! optimized version saving a part of the communication, which is
+  ! not what the test should test.
+  if (num_images() < dst_image) then
+     print*, "Pretend that the test was run and passed, even though there are too few images to perform test:"
+     print*, "Test passed"
+     error stop "Need at least three images."
+  end if
+
+  ! On the src_image, set some defined values, to be able to distinguish
+  ! strides going wrong.
+  if (this_image() == src_image) then
+    srcvec = [(2 * i, i = 1, 6)]
+    srcmat = reshape([(i * 2, i = 1, 4*6)], [4,6])
+  ! On the dst_image set values that enable to recognize unset values.
+  elseif (this_image() == dst_image) then
+    dstmat = -1
+    dstvec = -2
+  end if
+
+  ! Make sure data is valid on all images.
+  sync all
+
+  ! master_image is the controller in this communication and therefore needs
+  ! to initiate the communication.
+  if (this_image() == master_image) then
+    ! Transfer data from the src-vector to the dst-vector on image
+    ! dst_image.  This is a transfer of a contingous block of data and here for
+    ! completeness only.
+    dstvec(:)[dst_image] = srcvec(:)[src_image]
+    ! This statement uses a stride in the send phase of the communication.
+    dstmat(3,:)[dst_image] = srcvec(:)[src_image]
+  end if
+
+  ! Make sure the communication has completed.
+  sync all
+
+  ! Check the result of communication on the dst_image.
+  if (this_image() == dst_image) then
+    ! Check that transfering to the vector has succeeded.
+    if (any(dstvec /= [2, 4, 6, 8, 10, 12])) error stop "SendGet vec/vec does not match."
+
+    ! Check that transfering a vector into a matrix changes only the
+    ! values desired.
+    if (any(dstmat /= reshape([-1, -1,  2, -1, &
+                               -1, -1,  4, -1, &
+                               -1, -1,  6, -1, &
+                               -1, -1,  8, -1, &
+                               -1, -1, 10, -1, &
+                               -1, -1, 12, -1], [4, 6]))) then
+      error stop "SendGet matrow/vec does not match."
+    end if
+    ! Reset the dst-buffers to enable new test.
+    dstvec = -2
+    dstmat = -1
+  end if
+
+  ! Wait for dst having done its tests.
+  sync all
+  if (this_image() == master_image) then
+    ! Execute strided get in sendget and store in a vector to just
+    ! test the get.
+    dstvec(:)[dst_image] = srcmat(2,:)[src_image]
+    ! Test both strided get and strided send at once.
+    dstmat(3,:)[dst_image] = srcmat(2,:)[src_image]
+  end if
+
+  ! Ensure that the communication is all done.
+  sync all
+  if (this_image() == dst_image) then
+    ! Check, that the strided get has the expected result.
+    if (any(dstvec /= [4, 12, 20, 28, 36, 44])) error stop "SendGet vec/matrow does not match."
+
+    ! And that both communications with stride work as expected.
+    if (any(dstmat /= reshape([-1, -1,  4, -1, &
+                               -1, -1, 12, -1, &
+                               -1, -1, 20, -1, &
+                               -1, -1, 28, -1, &
+                               -1, -1, 36, -1, &
+                               -1, -1, 44, -1], [4, 6]))) then
+      error stop "SendGet matrow/matrow does not match."
+    end if
+
+    ! Above checks would stop with an error on failure, so its save
+    ! to unguardedly print here, when all tests pass.
+    print *, "Test passed"
+  end if
+end program