Add adjustable exchangers to parallel redist collection tests.

tests/test_redist_collection_parallel.c

@@ -67,28 +67,29 @@ enum {
 };
 
 static void
-test_4redist(MPI_Comm comm);
+test_4redist(MPI_Comm comm, Xt_config config);
 
 static void
-test_rr_redist(MPI_Comm comm);
+test_rr_redist(MPI_Comm comm, Xt_config config);
 
-int main(void) {
+int main(int argc, char **argv) {
 
   // init mpi
 
   xt_mpi_call(MPI_Init(NULL, NULL), MPI_COMM_WORLD);
 
   xt_initialize(MPI_COMM_WORLD);
+  Xt_config config = redist_exchanger_option(&argc, &argv);
   int comm_size;
   xt_mpi_call(MPI_Comm_size(MPI_COMM_WORLD, &comm_size), MPI_COMM_WORLD);
 
   if (comm_size > 1) {
+    test_4redist(MPI_COMM_WORLD, config);
 
-    test_4redist(MPI_COMM_WORLD);
-
-    test_rr_redist(MPI_COMM_WORLD);
+    test_rr_redist(MPI_COMM_WORLD, config);
   }
 
+  xt_config_delete(config);
   xt_finalize();
   MPI_Finalize();
 
@@ -103,7 +104,7 @@ exchange_4redist(Xt_redist redist, MPI_Comm comm,
                  int sync);
 
 static void
-test_4redist(MPI_Comm comm)
+test_4redist(MPI_Comm comm, Xt_config config)
 {
   int comm_rank, comm_size;
   xt_mpi_call(MPI_Comm_rank(comm, &comm_rank), comm);
@@ -122,16 +123,15 @@ test_4redist(MPI_Comm comm)
       = { (Xt_int)((Xt_int)2 * comm_size), (Xt_int)((Xt_int)comm_size_sq) };
     int local_size[2] = { comm_size, comm_size };
     Xt_int local_start[2][2] = {
-      {0, (Xt_int)((Xt_int)comm_rank * comm_size)},
+      { 0, (Xt_int)((Xt_int)comm_rank * comm_size) },
       { (Xt_int)comm_size,
         (Xt_int)((Xt_int)comm_size_sq - (Xt_int)(comm_rank+1) * comm_size) }
     };
 
-    Xt_idxlist indices_a_[2]
-      = { [0] = xt_idxsection_new(start, 2, global_size, local_size,
-                                  local_start[0]),
-          [1] = xt_idxsection_new(start, 2, global_size, local_size,
-                                  local_start[1]) };
+    Xt_idxlist indices_a_[2];
+    for (size_t i = 0; i < 2; ++i)
+      indices_a_[i] = xt_idxsection_new(start, 2, global_size, local_size,
+                                        local_start[i]);
 
     indices_a = xt_idxlist_collection_new(indices_a_, 2);
 
@@ -185,8 +185,8 @@ test_4redist(MPI_Comm comm)
   for (size_t i = 0; i < num_redists; ++i)
     xt_xmap_delete(xmaps[i]);
 
-  Xt_redist redist = xt_redist_collection_new(redists, num_redists, -1,
-                                              comm);
+  Xt_redist redist = xt_redist_collection_custom_new(redists, num_redists, -1,
+                                                     comm, config);
 
   // test communicator of redist
 
@@ -298,7 +298,7 @@ check_4redist_result(int comm_size, void *results[4],
 enum { elems_per_rank = 5, };
 
 static void
-test_rr_redist(MPI_Comm comm)
+test_rr_redist(MPI_Comm comm, Xt_config config)
 {
   int comm_rank, comm_size;
   xt_mpi_call(MPI_Comm_rank(comm, &comm_rank), comm);
@@ -327,7 +327,8 @@ test_rr_redist(MPI_Comm comm)
     xt_xmap_delete(xmap);
   }
   xt_idxlist_delete(src_indices);
-  Xt_redist redist = xt_redist_collection_new(redists, 2, -1, comm);
+  Xt_redist redist = xt_redist_collection_custom_new(redists, 2, -1, comm,
+                                                     config);
 
   // test communicator of redist
   if (!communicators_are_congruent(xt_redist_get_MPI_Comm(redist), comm))

tests/test_redist_collection_parallel_f.f90

@@ -56,12 +56,12 @@ PROGRAM test_redist_collection_parallel
        xt_redist, xt_redist_p2p_new, xt_redist_collection_new, &
        xt_redist_copy, xt_redist_delete, xt_redist_s_exchange, &
        xt_idxlist_get_indices, xt_int_mpidt, &
-       xt_request, xt_redist_a_exchange
+       xt_request, xt_redist_a_exchange, xt_config, xt_config_delete
   ! older PGI compilers do not handle generic interface correctly
 #if defined __PGI && (__PGIC__ < 12 || (__PGIC__ ==  12 && __PGIC_MINOR__ <= 10))
   USE xt_redist_base, ONLY: xt_redist_s_exchange, xt_redist_a_exchange
 #endif
-  USE test_redist_common, ONLY: check_wait_request
+  USE test_redist_common, ONLY: check_wait_request, redist_exchanger_option
   USE iso_c_binding, ONLY: c_loc, c_ptr
 #include "xt_slice_c_loc.inc"
   IMPLICIT NONE
@@ -70,9 +70,11 @@ PROGRAM test_redist_collection_parallel
        filename = 'test_redist_collection_parallel_f.f90'
   CHARACTER(len=*), PARAMETER :: err_msg(2) = &
        (/ "error in xt_redist_s_exchange", "error in xt_redist_a_exchange" /)
+  TYPE(xt_config) :: config
 
   CALL init_mpi
   CALL xt_initialize(mpi_comm_world)
+  config = redist_exchanger_option()
 
   CALL mpi_comm_rank(mpi_comm_world, rank, ierror)
   IF (ierror /= MPI_SUCCESS) &
@@ -82,8 +84,8 @@ PROGRAM test_redist_collection_parallel
        CALL test_abort('mpi_comm_size failed', filename, __LINE__)
 
   IF (world_size > 1) THEN
-    CALL test_4redist
-    CALL test_rr_exchange
+    CALL test_4redist(mpi_comm_world, config)
+    CALL test_rr_exchange(mpi_comm_world, config)
   END IF
 
   IF (test_err_count() /= 0) &
@@ -125,8 +127,10 @@ CONTAINS
     indices_all = xt_idxstripes_new(stripe)
   END SUBROUTINE build_idxlists
 
-  SUBROUTINE test_4redist
+  SUBROUTINE test_4redist(comm, config)
     ! redist test with four different redists
+    INTEGER, INTENT(in) :: comm
+    TYPE(xt_config), INTENT(in) :: config
     INTEGER, PARAMETER :: num_tx = 4
     TYPE(xt_idxlist) :: indices_a, indices_b, indices_all
     INTEGER(xt_int_kind), ALLOCATABLE :: index_vector_a(:), &
@@ -143,10 +147,10 @@ CONTAINS
     ALLOCATE(index_vector_a(vec_size), index_vector_b(vec_size))
     CALL build_idxlists(indices_a, indices_b, indices_all)
 
-    xmaps(1) = xt_xmap_all2all_new(indices_a, indices_b, mpi_comm_world)
-    xmaps(2) = xt_xmap_all2all_new(indices_b, indices_a, mpi_comm_world)
-    xmaps(3) = xt_xmap_all2all_new(indices_a, indices_all, mpi_comm_world)
-    xmaps(4) = xt_xmap_all2all_new(indices_b, indices_all, mpi_comm_world)
+    xmaps(1) = xt_xmap_all2all_new(indices_a, indices_b, comm)
+    xmaps(2) = xt_xmap_all2all_new(indices_b, indices_a, comm)
+    xmaps(3) = xt_xmap_all2all_new(indices_a, indices_all, comm)
+    xmaps(4) = xt_xmap_all2all_new(indices_b, indices_all, comm)
 
     CALL xt_idxlist_get_indices(indices_a, index_vector_a)
     CALL xt_idxlist_get_indices(indices_b, index_vector_b)
@@ -160,10 +164,10 @@ CONTAINS
       CALL xt_xmap_delete(xmaps(i))
     END DO
 
-    redist = xt_redist_collection_new(redists, num_tx, -1, mpi_comm_world)
+    redist = xt_redist_collection_new(redists, num_tx, -1, comm, config)
 
     ! test communicator of redist
-    ! if (!test_communicator(xt_redist_get_MPI_Comm(redist), MPI_COMM_WORLD))
+    ! if (!test_communicator(xt_redist_get_MPI_Comm(redist), COMM))
     !   PUT_ERR("error in xt_redist_get_MPI_Comm\n");
 
     CALL xt_redist_delete(redists)
@@ -284,7 +288,10 @@ CONTAINS
 
   ! redist test with two redists that do a round robin exchange in
   ! different directions
-  SUBROUTINE test_rr_exchange
+  SUBROUTINE test_rr_exchange(comm, config)
+    INTEGER, INTENT(in) :: comm
+    TYPE(xt_config), INTENT(in) :: config
+
     TYPE(xt_idxlist) :: src_indices, dst_indices(2)
     INTEGER(xt_int_kind) :: src_indices_(5)
     INTEGER(xt_int_kind) :: i, temp, dst_indices_(5, 2)
@@ -307,8 +314,8 @@ CONTAINS
     dst_indices(1) = xt_idxvec_new(dst_indices_(:, 1))
     dst_indices(2) = xt_idxvec_new(dst_indices_(:, 2))
 
-    xmaps(1) = xt_xmap_all2all_new(src_indices, dst_indices(1), mpi_comm_world)
-    xmaps(2) = xt_xmap_all2all_new(src_indices, dst_indices(2), mpi_comm_world)
+    xmaps(1) = xt_xmap_all2all_new(src_indices, dst_indices(1), comm)
+    xmaps(2) = xt_xmap_all2all_new(src_indices, dst_indices(2), comm)
 
     CALL xt_idxlist_delete(src_indices)
     CALL xt_idxlist_delete(dst_indices)
@@ -318,10 +325,10 @@ CONTAINS
 
     CALL xt_xmap_delete(xmaps)
 
-    redist = xt_redist_collection_new(redists, 2, -1, mpi_comm_world)
+    redist = xt_redist_collection_new(redists, 2, -1, comm, config)
 
     ! test communicator of redist
-    ! IF (!test_communicator(xt_redist_get_MPI_Comm(redist), MPI_COMM_WORLD))
+    ! IF (!test_communicator(xt_redist_get_MPI_Comm(redist), comm))
     !     PUT_ERR("error in xt_redist_get_MPI_Comm\n");
 
     CALL xt_redist_delete(redists)

tests/test_redist_collection_parallel_run.in

@@ -5,9 +5,11 @@ export LIBC_FATAL_STDERR_
 [ x"@MPI_LAUNCH@" != xtrue ] || exit 77
 for nprocs in 2 3 4 8 ; do
   @abs_top_builddir@/libtool --mode=execute \
-    @MPI_LAUNCH@ -n $nprocs @abs_builddir@/test_redist_collection_parallel
+    @MPI_LAUNCH@ -n $nprocs @abs_builddir@/test_redist_collection_parallel \
+    "$@"
   @abs_top_builddir@/libtool --mode=execute \
-    @MPI_LAUNCH@ -n $nprocs @abs_builddir@/test_redist_collection_parallel_f
+    @MPI_LAUNCH@ -n $nprocs @abs_builddir@/test_redist_collection_parallel_f \
+    "$@"
 done
 #
 # Local Variables: