Merge pull request #741 from sourceryinstitute/issue-739-fix-seg-fault

Issue 739 fix seg fault

Author: Damian Rouson

CMakeLists.txt

@@ -795,6 +795,7 @@ if(opencoarrays_aware_compiler)
   add_caf_test(get_with_offset_1d 2 get_with_offset_1d)
   add_caf_test(whole_get_array 2 whole_get_array)
   add_caf_test(strided_get 2 strided_get)
+  add_caf_test(get_static_array 2 get_static_array)
 
   # Pure send tests
   add_caf_test(send_array 2 send_array)

src/mpi/mpi_caf.c

@@ -4673,8 +4673,8 @@ PREFIX(get_by_ref) (caf_token_t token, int image_index,
   size = 1;
   while (riter)
   {
-    dprint("caf_ref = %p, offset = %zd, remote_mem = %p, global_win(data, desc)) = (%d, %d)\n",
-           riter, data_offset, remote_memptr, access_data_through_global_win,
+    dprint("caf_ref = %p, type = %d,  offset = %zd, remote_mem = %p, global_win(data, desc)) = (%d, %d)\n",
+           riter, riter->type, data_offset, remote_memptr, access_data_through_global_win,
            access_desc_through_global_win);
     switch (riter->type)
     {
@@ -4996,7 +4996,7 @@ case kind:                                                              \
               delta = riter->u.a.dim[i].v.nvec;
 #define KINDCASE(kind, type)                                    \
 case kind:                                                      \
-  remote_memptr +=                                              \
+  data_offset +=                                                \
     ((type *)riter->u.a.dim[i].v.vector)[0] * riter->item_size; \
   break
 
@@ -5026,15 +5026,14 @@ case kind:                                                      \
                                 riter->u.a.dim[i].s.stride,
                                 riter->u.a.dim[i].s.start,
                                 riter->u.a.dim[i].s.end);
-              remote_memptr += riter->u.a.dim[i].s.start
-                               * riter->u.a.dim[i].s.stride
-                               * riter->item_size;
+              data_offset += riter->u.a.dim[i].s.start
+                             * riter->u.a.dim[i].s.stride
+                             * riter->item_size;
               break;
             case CAF_ARR_REF_SINGLE:
               delta = 1;
-              remote_memptr += riter->u.a.dim[i].s.start
-                               * riter->u.a.dim[i].s.stride
-                               * riter->item_size;
+              data_offset += riter->u.a.dim[i].s.start
+                             * riter->item_size;
               break;
             case CAF_ARR_REF_OPEN_END:
               /* This and OPEN_START are mapped to a RANGE and therefore can

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

@@ -13,6 +13,7 @@ caf_compile_executable(strided_get strided_get.f90)
 caf_compile_executable(get_with_vector_index get_with_vector_index.f90)
 ## Inquiry functions (these are gets that could be optimized in the future to communicate only the descriptors)
 caf_compile_executable(alloc_comp_multidim_shape alloc_comp_multidim_shape.F90)
+caf_compile_executable(get_static_array get_static_array.f90)
 
 ## Pure send() tests
 caf_compile_executable(send_array send_array_test.f90)

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

@@ -0,0 +1,23 @@
+program get_static_array
+    type :: container
+        integer, allocatable :: stuff(:)
+    end type
+
+    type(container) :: co_containers(10)[*]
+
+    if (this_image() == 1) then
+        allocate(co_containers(2)%stuff(4))
+        co_containers(2)%stuff = [1,2,3,4]
+    end if
+
+    sync all
+
+    if (this_image() == 2) then
+        if (any(co_containers(2)[1]%stuff /= [1,2,3,4])) then
+          error stop "Test failed."
+        else
+          print *, "Test passed."
+        end if
+    end if
+end program
+