FIX issue 503

Author: neok-m4700

CMakeLists.txt

@@ -775,6 +775,7 @@ if(opencoarrays_aware_compiler)
   # issues reported by @neok-m4700
   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)
 
   # IMAGE FAIL tests
   if(NOT CMAKE_Fortran_COMPILER_VERSION VERSION_LESS 7.0.0)

src/mpi/mpi_caf.c

@@ -6921,7 +6921,7 @@ PREFIX (co_broadcast) (gfc_descriptor_t *a, int source_image, int *stat, char *e
           extent = (a->dim[j]._ubound - a->dim[j].lower_bound + 1);
           stride = a->dim[j]._stride;
         }
-      array_offset_sr += (i / extent) * a->dim[rank-1]._stride;
+      array_offset_sr += (i / (extent * stride)) * a->dim[rank-1]._stride;
       void *sr = (void *)((char *) a->base_addr
                           + array_offset_sr*GFC_DESCRIPTOR_SIZE (a));
 

src/tests/regression/reported/CMakeLists.txt

@@ -7,3 +7,4 @@ caf_compile_executable(issue-493-coindex-slice issue-493-coindex-slice.f90)
 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)

src/tests/regression/reported/issue-503-multidim-array-broadcast.f90

@@ -0,0 +1,43 @@
+! caf -o bcast bcast.f90
+! cafrun -np 2 ./bcast
+! mwe for issue github.com/sourceryinstitute/OpenCoarrays/issues/503
+
+program main
+   real, allocatable, dimension(:, :, :) :: arr1, arr2
+   integer :: i, me, nimg
+   real :: red1, sum1, red2, sum2
+   
+   allocate(arr1(10, 20, 8))
+   allocate(arr2(10, 20, 30))
+
+   me = this_image()
+   nimg = num_images()
+
+   if (me == 1) then
+      arr1 = reshape([(i, i=1, size(arr1))], shape(arr1))
+      arr2 = reshape([(i, i=1, size(arr2))], shape(arr2))
+   end if
+
+   call co_broadcast(arr1, source_image=1)
+   call co_broadcast(arr2, source_image=1)
+
+   sum1 = sum(arr1)
+   sum2 = sum(arr2)
+
+   red1 = sum1
+   red2 = sum2
+
+   call co_sum(red1)
+   call co_sum(red2)
+
+   sync all
+   print *, me, ' sum1=', sum1, ' red1=', red1
+   print *, me, ' sum2=', sum2, ' red2=', red2
+
+   if (abs(red1 - nimg * sum1) > epsilon(0.) .or. abs(red2 - nimg * sum2) > epsilon(0.)) then
+      write(*,*) 'Test failed!'
+   else
+      write(*,*) 'Test passed.'
+   end if
+   deallocate(arr1, arr2)
+end program