Merge branch 'master' into stop-quiet

Author: zbeekman

CMakeLists.txt

@@ -657,8 +657,8 @@ if(opencoarrays_aware_compiler)
     add_caf_test(comp_allocated_2 2 comp_allocated_2)
     add_caf_test(alloc_comp_get_convert_nums 2 alloc_comp_get_convert_nums)
     if(NOT CMAKE_Fortran_COMPILER_VERSION VERSION_LESS 8)
-      add_caf_test(team_number 2 ${tests_root}/unit/teams/team_number)
-      add_caf_test(get_communicator 3 ${tests_root}/unit/teams/get_communicator)
+      add_caf_test(team_number 2 team_number)
+      add_caf_test(get_communicator 3  get_communicator)
     endif()
   endif()
 

src/mpi/mpi_caf.c

@@ -4629,10 +4629,13 @@ PREFIX (get_by_ref) (caf_token_t token, int image_index,
                         }
                     }
 
-                  /* Only increase the dim counter, when in an array ref, and
-                     MODE != CAF_ARR_REF_SINGLE (delta == 1) see caf_array_ref_t. */
-                  if (in_array_ref && dst_cur_dim < dst_rank && delta != 1)
-                    ++dst_cur_dim;
+                  /* Only increase the dim counter, when in an array ref */
+                  if (in_array_ref && dst_cur_dim < dst_rank)
+                  {
+                    // Mode != CAF_ARR_REF_SINGLE (delta == 1), and no rank reduction
+                    if (!(delta == 1 && dst_rank != GFC_DESCRIPTOR_RANK(src)))
+                      ++dst_cur_dim;
+                  }
                 }
               size *= (ptrdiff_t)delta;
             }
@@ -4778,10 +4781,13 @@ PREFIX (get_by_ref) (caf_token_t token, int image_index,
                           dst->dim[dst_cur_dim]._stride = size;
                         }
                     }
-                  /* Only increase the dim counter, when in an array ref, and
-                     MODE != CAF_ARR_REF_SINGLE (delta == 1) see caf_array_ref_t. */
-                  if (in_array_ref && dst_cur_dim < dst_rank && delta != 1)
-                    ++dst_cur_dim;
+                  /* Only increase the dim counter, when in an array ref */
+                  if (in_array_ref && dst_cur_dim < dst_rank)
+                  {
+                    // Mode != CAF_ARR_REF_SINGLE (delta == 1), and no rank reduction
+                    if (!(delta == 1 && dst_rank != GFC_DESCRIPTOR_RANK(src)))
+                      ++dst_cur_dim;
+                  }
                 }
               size *= (ptrdiff_t)delta;
             }
@@ -5352,7 +5358,7 @@ PREFIX (send_by_ref) (caf_token_t token, int image_index,
                                   "rank out of range.\n";
     const char extentoutofrange[] = "libcaf_mpi::caf_send_by_ref(): "
                                     "extent out of range.\n";
-    const char cannotallocdst[] = "libcaf_mpi::caf_get_by_ref(): "
+    const char cannotallocdst[] = "libcaf_mpi::caf_send_by_ref(): "
                                   "can not allocate %d bytes of memory.\n";
     const char unabletoallocdst[] = "libcaf_mpi::caf_send_by_ref(): "
                                   "unable to allocate memory on remote image.\n";

src/tests/regression/reported/issue-493-coindex-slice.f90

@@ -5,7 +5,9 @@ program slice
 
    type(coarr) :: co
    integer :: nimg, me, z, nx, ny, nz, north, south, mex, mey, mez, coords(3)
-   real, allocatable :: bufxz(:, :) ! a plane (2d) slice, normal in the y direction
+   integer :: shape2d(2), shape3d(3)
+   real, allocatable :: buf3d(:, :, :) ! a plane slice as a rank 3 array with a single transverse layer
+   real, allocatable :: buf2d(:, :) ! a plane (2d) slice, normal in the y direction
 
    nx = 6
    ny = 4
@@ -17,7 +19,12 @@ program slice
    if (nimg /= 8) stop
 
    allocate(co % a(nx, ny, nz)[1:2, 1:2, *])
-   allocate(bufxz(nx, nz))
+   allocate(buf2d(nx, nz), buf3d(nx, 1, nz))
+
+   ! this example should NOT reallocate buf2d nor buf3d
+   ! compare shapes before and after syncing
+   shape2d = shape(buf2d)
+   shape3d = shape(buf3d)
 
    co % a = reshape([(z, z=1, nx * ny * nz)], shape(co % a))
 
@@ -33,19 +40,34 @@ program slice
    if (north <= 2) then
       z = image_index(co % a, [mex, north, mez])
       sync images(z)
-      bufxz = co % a(1:nx, 1, 1:nz)[mex, north, mez]
-      co % a(1:nx, ny, 1:nz) = bufxz
+      ! no reduction on rank
+      buf3d = co % a(1:nx, 1:1, 1:nz)[mex, north, mez]
+      co % a(1:nx, ny:ny, 1:nz) = buf3d
+
+      ! reduction along dim 2
+      buf2d = co % a(1:nx, 1, 1:nz)[mex, north, mez]
+      co % a(1:nx, ny, 1:nz) = buf2d
    end if
    if (south >= 1) then
       z = image_index(co % a, [mex, south, mez])
       sync images(z)
-      bufxz = co % a(1:nx, 1, 1:nz)[mex, south, mez]
-      co % a(1:nx, ny, 1:nz) = bufxz
+      buf3d = co % a(1:nx, ny:ny, 1:nz)[mex, south, mez]
+      co % a(1:nx, 1:1, 1:nz) = buf3d
+
+      buf2d = co % a(1:nx, ny, 1:nz)[mex, south, mez]
+      co % a(1:nx, 1, 1:nz) = buf2d
    end if
    sync all
 
-   deallocate(co % a, bufxz)
-   if(this_image() == 1) write(*,*) "Test passed."
+   deallocate(co % a, buf2d, buf3d)
+   
+   if (any(shape2d /= shape(buf2d)) .or. any(shape3d /= shape(buf3d))) then
+      write(*, *) 'Test failed!'
+      error stop 5
+   else
+      write(*, *) 'Test passed.'
+   end if
+
    ! Regression would cause error message:
    ! Fortran runtime error on image <...>: libcaf_mpi::caf_get_by_ref(): rank out of range.
- end program
+end program

src/tests/unit/teams/CMakeLists.txt

@@ -1,9 +1,2 @@
-add_executable(team_number team-number.f90)
-target_link_libraries(team_number OpenCoarrays)
-#TODO: Remove when gfortran supports team_number()
-target_include_directories(team_number PRIVATE ${CMAKE_BINARY_DIR}/include)
-
-#add_executable(get_communicator get-communicator.f90)
-#target_link_libraries(get_communicator OpenCoarrays)
-#TODO: Remove when gfortran supports team_number()
-#target_include_directories(get_communicator PRIVATE ${CMAKE_BINARY_DIR}/include)
+caf_compile_executable(team_number team-number.f90)
+caf_compile_executable(get_communicator get-communicator.f90)

src/tests/unit/teams/get-communicator.f90

@@ -1,6 +1,6 @@
 ! BSD 3-Clause License
 !
-! Copyright (c) 2016, Sourcery Institute
+! Copyright (c) 2018, Sourcery Institute
 ! All rights reserved.
 !
 ! Redistribution and use in source and binary forms, with or without
@@ -83,6 +83,7 @@ pure function destination_team(image,numTeams) result(team)
    end function
 
   subroutine mpi_matches_caf(comm)
+    use mpi
     use iso_c_binding, only : c_int
     integer(c_int), intent(in) :: comm
       !! MPI communicator

src/tests/unit/teams/team-number.f90

@@ -1,6 +1,6 @@
 ! BSD 3-Clause License
 !
-! Copyright (c) 2016, Sourcery Institute
+! Copyright (c) 2018, Sourcery Institute
 ! All rights reserved.
 !
 ! Redistribution and use in source and binary forms, with or without