Convert remaining tests to Fortuno

test/unit/CMakeLists.txt

@@ -14,14 +14,25 @@ set(
 )
 set(
   sources-fypp
+  test_allgather.fpp
+  test_allgatherv.fpp
+  test_allreduce.fpp
   test_bcast.fpp
+  test_comm_split_type.fpp
+  test_comm_split.fpp
+  test_gather.fpp
+  test_gatherv.fpp
+  test_reduce.fpp
+  test_scatter.fpp
+  test_scatterv.fpp
+  test_send_recv.fpp
 )
 fypp_preprocess("${fypp_flags}" "${sources-fypp}" sources-fypp-f90)
 
 set(testapp "testapp")
 add_executable(${testapp})
 target_sources(${testapp} PRIVATE ${sources-f90} ${sources-fypp-f90})
-target_link_libraries(${testapp} mpifx Fortuno::fortuno_mpi)
+target_link_libraries(${testapp} mpifx Fortuno::fortuno_mpi MPI::MPI_Fortran)
 add_test(
   NAME ${unit-test-prefix}
   COMMAND

test/unit/test_allgather.fpp

@@ -0,0 +1,68 @@
+!> Test various patterns of allgather
+#:include "fortuno_mpi.fypp"
+
+module test_allgather
+  use libmpifx_module, only : mpifx_comm, mpifx_allgather
+  use fortuno_mpi, only : global_comm_id, suite => mpi_suite_item, test_item, is_equal
+  $:FORTUNO_MPI_IMPORTS()
+  implicit none
+
+  private
+  public :: allgather_test_items
+
+contains
+
+  $:TEST("I0_to_I1")
+    type(mpifx_comm) :: mycomm
+    integer :: send0
+    integer, allocatable :: recv1(:)
+
+    call mycomm%init(global_comm_id())
+    send0 = mycomm%rank * 2
+    allocate(recv1(1 * mycomm%size), source = 0)
+    call mpifx_allgather(mycomm, send0, recv1)
+
+    @:ASSERT(is_equal(sum(recv1), mycomm%size * (mycomm%size-1)))
+  $:END_TEST()
+
+  $:TEST("I1_to_I1")
+    type(mpifx_comm) :: mycomm
+    integer, allocatable :: send1(:)
+    integer, allocatable :: recv1(:)
+
+    call mycomm%init(global_comm_id())
+    allocate(send1(2), source = 0)
+    allocate(recv1(size(send1) * mycomm%size), source = 0)
+    send1(:) = [ mycomm%rank, mycomm%rank + 1 ]
+    call mpifx_allgather(mycomm, send1, recv1)
+
+    @:ASSERT(is_equal(sum(recv1), mycomm%size**2))
+  $:END_TEST()
+
+  $:TEST("I1_to_I2")
+    type(mpifx_comm) :: mycomm
+    integer, allocatable :: send1(:)
+    integer, allocatable :: recv2(:,:)
+
+    call mycomm%init(global_comm_id())
+    allocate(send1(2), source = 0)
+    allocate(recv2(size(send1), mycomm%size), source = 0)
+    send1(:) = [ mycomm%rank, mycomm%rank + 1 ]
+    call mpifx_allgather(mycomm, send1, recv2)
+
+    @:ASSERT(is_equal(sum(recv2), mycomm%size**2))
+  $:END_TEST()
+
+  function allgather_test_items() result(testitems)
+    type(test_item), allocatable :: testitems(:)
+
+    testitems = [&
+        suite("allgather", [&
+            $:TEST_ITEMS()
+        ])&
+    ]
+    @:STOP_ON_MISSING_TEST_ITEMS()
+
+  end function allgather_test_items
+
+end module test_allgather

test/unit/test_allgatherv.fpp

@@ -0,0 +1,101 @@
+!> Test various patterns of allgatherv
+#:include "fortuno_mpi.fypp"
+
+module test_allgatherv
+  use libmpifx_module, only : mpifx_comm, mpifx_allgatherv
+  use fortuno_mpi, only : global_comm_id, suite => mpi_suite_item, test_item, is_equal
+  $:FORTUNO_MPI_IMPORTS()
+  implicit none
+
+  private
+  public :: allgatherv_test_items
+
+contains
+
+  $:TEST("R1_to_R1")
+    type(mpifx_comm) :: mycomm
+    integer, parameter :: sp = kind(1.0)
+    real(sp), allocatable :: send1(:)
+    real(sp), allocatable :: recv1(:)
+    integer, allocatable :: recvcounts(:)
+    integer :: ii, nrecv
+
+    call mycomm%init(global_comm_id())
+    allocate(send1(mycomm%rank+1), source = 0.0_sp)
+    send1 = real(mycomm%rank+1, sp)
+    ! recv1 size is 1+2+3+...+mycomm%size
+    nrecv = mycomm%size*(mycomm%size+1)/2
+    allocate(recv1(nrecv), source = 0.0_sp)
+    allocate(recvcounts(mycomm%size), source = 0)
+    do ii = 1, mycomm%size
+      recvcounts(ii) = ii
+    end do
+    call mpifx_allgatherv(mycomm, send1, recv1, recvcounts)
+
+    @:ASSERT(is_equal(nint(sum(recv1)), (2*mycomm%size**3+3*mycomm%size**2+mycomm%size)/6))
+    @:ASSERT((abs(sum(recv1)-nint(sum(recv1))) < epsilon(1.0_sp)))
+  $:END_TEST()
+
+  $:TEST("R2_to_R2")
+    type(mpifx_comm) :: mycomm
+    integer, parameter :: sp = kind(1.0)
+    real(sp), allocatable :: send2(:,:)
+    real(sp), allocatable :: recv2(:,:)
+    integer, allocatable :: recvcounts(:)
+    integer :: ii, nrecv, nCol
+
+    call mycomm%init(global_comm_id())
+    nCol = 5
+    allocate(send2(nCol, mycomm%rank+1), source = 0.0_sp)
+    send2 = real(mycomm%rank + 1, sp)
+    nrecv = mycomm%size*(mycomm%size+1)/2
+    allocate(recv2(nCol, nrecv), source = 0.0_sp)
+    allocate(recvcounts(mycomm%size), source = 0)
+    do ii = 1, mycomm%size
+      recvcounts(ii) = nCol*ii
+    end do
+    call mpifx_allgatherv(mycomm, send2, recv2, recvcounts)
+
+    @:ASSERT(is_equal(nint(sum(recv2)), nCol*mycomm%size*(mycomm%size+1)*(2*mycomm%size+1)/6))
+    @:ASSERT((abs(sum(recv2)-nint(sum(recv2))) < epsilon(1.0_sp)))
+  $:END_TEST()
+
+  $:TEST("R0_to_R1")
+    ! R0 -> R1 with specified receive pattern
+    type(mpifx_comm) :: mycomm
+    integer, parameter :: sp = kind(1.0)
+    real(sp), allocatable :: recv1(:)
+    real(sp) :: send0
+    integer, allocatable :: recvcounts(:)
+    integer, allocatable :: displs(:)
+    integer :: ii, nrecv
+
+    call mycomm%init(global_comm_id())
+    send0 = real(mycomm%rank + 1, sp)
+    nrecv = mycomm%size
+    allocate(recv1(nrecv), source = 0.0_sp)
+    allocate(recvcounts(mycomm%size), source = 1)
+    allocate(displs(mycomm%size), source = 0)
+    ! set a non trivial displs vector
+    do ii = 1, mycomm%size
+      displs(ii) = mycomm%size - ii
+    end do
+    call mpifx_allgatherv(mycomm, send0, recv1, recvcounts, displs)
+
+    @:ASSERT(is_equal(nint(sum(recv1)), (mycomm%size*(mycomm%size+1))/2))
+    @:ASSERT((abs(sum(recv1)-nint(sum(recv1))) < epsilon(1.0_sp)))
+  $:END_TEST()
+
+  function allgatherv_test_items() result(testitems)
+    type(test_item), allocatable :: testitems(:)
+
+    testitems = [&
+        suite("allgatherv", [&
+            $:TEST_ITEMS()
+        ])&
+    ]
+    @:STOP_ON_MISSING_TEST_ITEMS()
+
+  end function allgatherv_test_items
+
+end module test_allgatherv