Bugfix for strided_sendget and testcase

Author: Alessandro Fanfarillo

CMakeLists.txt

@@ -213,6 +213,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 4 ${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,42 @@ 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;
             }
 
+	  array_offset_dst += (i / tot_ext) * dest->dim[rank-1]._stride;
+	  
 	  extent = (dest->dim[rank-1]._ubound - dest->dim[rank-1].lower_bound + 1);
-          array_offset_dst += (i / extent) * 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;
+	      /* extent = (src->dim[rank-1]._ubound - src->dim[rank-1].lower_bound + 1); */
+              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,66 @@
+program stridedsendgettest
+
+  implicit none
+
+  integer, save, dimension(4,6) :: srcmat[*], dstmat[*]
+  integer, save, dimension(6) :: srcvec[*], dstvec[*]
+  integer :: i
+  logical :: test_passed = .true.
+
+  if (this_image() == 2) then
+    srcvec = [(2 * i, i = 1, 6)]
+    srcmat = reshape([(i * 2, i = 1, 4*6)], [4,6])
+  elseif (this_image() == 3) then
+    dstmat = -1
+    dstvec = -2
+  end if
+
+  sync all
+  if (this_image() == 1) then
+    dstvec(:)[3] = srcvec(:)[2]
+    dstmat(3,:)[3] = srcvec(:)[2]
+  end if
+
+  sync all
+  if (this_image() == 3) then
+    if (any(dstvec(:) /= [2, 4, 6, 8, 10, 12])) then
+      print *, dstvec(:)
+      print *, "SendGet vec/vec does not match."
+!      error stop "SendGet vec/vec does not match."
+      test_passed = .false.
+    end if
+
+    if (any(dstmat(3,:) /= [2, 4, 6, 8, 10, 12])) then
+      print *, dstmat(3,:)
+      print *, "SendGet matrow/vec does not match."
+!      error stop "SendGet matrow/vec does not match."
+      test_passed = .false.
+    end if
+  end if
+
+  sync all
+  if (this_image() == 1) then
+    dstvec(:)[3] = srcmat(2,:)[2]
+    dstmat(3,:)[3] = srcmat(2,:)[2]
+  end if
+
+  sync all
+  if (this_image() == 3) then
+    if (any(dstvec(:) /= [4, 12, 20, 28, 36, 44])) then
+      print *, dstvec(:)
+      print *, "SendGet vec/matrow does not match."
+!      error stop "SendGet vec/matrow does not match."
+      test_passed = .false.
+    end if
+
+    if (any(dstmat(3,:) /= [4, 12, 20, 28, 36, 44])) then
+      print *, dstmat(3,:)
+      print *, "SendGet matrow/matrow does not match."
+!      error stop "SendGet matrow/matrow does not match."
+      test_passed = .false.
+    end if
+
+    if (test_passed) print *, "Test passed"
+  end if
+
+end program