Reduce failure test to special case of regular xmap construction.

tests/test_xmap_all2all_fail.c

@@ -62,77 +62,84 @@
 
 #define VERBOSE
 #include "tests.h"
+#include "test_xmap_common.h"
 
 /* If we're not using GNU C, elide __attribute__ */
 #ifndef __GNUC__
 #  define  __attribute__(x)  /*NOTHING*/
 #endif
 
-static enum {
-  SMALL,
-  BIG,
-} index_list_size = SMALL;
+static enum test_idxlist_size index_list_size = SMALL;
 
 static void
 parse_options(int *argc, char ***argv);
-static void
-xfail_abort(MPI_Comm comm, const char *msg, const char *source, int line)
-  __attribute__((noreturn));
 
 typedef void (*Xt_abort_func)(MPI_Comm comm, const char *msg,
                               const char *source, int line)
   __attribute__((noreturn));
 extern Xt_abort_func Xt_abort;
 
+static Xt_xmap
+xmap_new_fail3(Xt_idxlist src_idxlist, Xt_idxlist dst_idxlist, MPI_Comm comm);
+
+
 
 int main(int argc, char **argv) {
 
    // init mpi
-   xt_mpi_call(MPI_Init(NULL, NULL), MPI_COMM_WORLD);
+  MPI_Comm comm = MPI_COMM_WORLD;
+  xt_mpi_call(MPI_Init(NULL, NULL), comm);
 
-   xt_initialize(MPI_COMM_WORLD);
+  xt_initialize(comm);
 
-   int my_rank;
-   MPI_Comm_rank(MPI_COMM_WORLD, &my_rank);
+  int my_rank;
+  MPI_Comm_rank(comm, &my_rank);
 
-   parse_options(&argc, &argv);
+  parse_options(&argc, &argv);
 
-   {
-      // source index list
-      struct Xt_stripe src_stripe;
-      src_stripe.nstrides = (index_list_size == SMALL)?7:1023;
-      src_stripe.start = (Xt_int)(1 + (Xt_int)my_rank * src_stripe.nstrides);
-      src_stripe.stride = 1;
-      Xt_idxlist src_idxlist = xt_idxstripes_new(&src_stripe, 1);
+  {
+    // source index list
+    struct Xt_stripe src_stripe;
+    src_stripe.nstrides = (index_list_size == SMALL)?7:1023;
+    src_stripe.start = (Xt_int)(1 + (Xt_int)my_rank * src_stripe.nstrides);
+    src_stripe.stride = 1;
 
-      // destination index list
-      struct Xt_stripe dst_stripe;
-      dst_stripe.nstrides = src_stripe.nstrides;
-      dst_stripe.start = (Xt_int)(src_stripe.start + src_stripe.nstrides);
-      dst_stripe.stride = -1;
-      Xt_idxlist dst_idxlist = xt_idxstripes_new(&dst_stripe, 1);
+    // destination index list
+    struct Xt_stripe dst_stripe;
+    dst_stripe.nstrides = src_stripe.nstrides;
+    dst_stripe.start = (Xt_int)(src_stripe.start + src_stripe.nstrides);
+    dst_stripe.stride = -1;
 
-      // test of exchange map
-      // NOTE: this should fail
-      Xt_abort = xfail_abort;
-      Xt_xmap xmap
-        = xt_xmap_all2all_new(src_idxlist, dst_idxlist, MPI_COMM_WORLD);
+    test_self_xmap_construct_idxstripes(&src_stripe, 1, &dst_stripe, 1,
+                                        xmap_new_fail3, comm);
+  }
 
-      /* this position should not be reached */
-      MPI_Abort(MPI_COMM_WORLD, 1);
+  xt_finalize();
+  xt_mpi_call(MPI_Finalize(), comm);
 
-      // clean up
-      xt_xmap_delete(xmap);
-      xt_idxlist_delete(src_idxlist);
-      xt_idxlist_delete(dst_idxlist);
-   }
+  return TEST_EXIT_CODE;
+}
 
-   xt_finalize();
-   xt_mpi_call(MPI_Finalize(), MPI_COMM_WORLD);
+static void
+xfail_abort(MPI_Comm comm, const char *msg, const char *source, int line)
+  __attribute__((noreturn));
 
-   return TEST_EXIT_CODE;
+static Xt_xmap
+xmap_new_fail3(Xt_idxlist src_idxlist, Xt_idxlist dst_idxlist, MPI_Comm comm)
+{
+  Xt_abort_func orig_xt_abort = Xt_abort;
+  // test of exchange map constructor error handling
+  Xt_abort = xfail_abort;
+  // NOTE: this is the call which should fail
+  Xt_xmap xmap
+    = xt_xmap_all2all_new(src_idxlist, dst_idxlist, comm);
+  /* this position should not be reached */
+  Xt_abort = orig_xt_abort;
+  MPI_Abort(MPI_COMM_WORLD, 1);
+  return xmap;
 }
 
+
 static void
 parse_options(int *argc, char ***argv)
 {

tests/test_xmap_all2all_fail_f.f90

@@ -45,21 +45,26 @@
 !
 #include "fc_feature_defs.inc"
 PROGRAM test_xmap_all2all_fail
+  USE iso_c_binding, ONLY: c_int
   USE mpi
   USE ftest_common, ONLY: init_mpi, finish_mpi, test_abort
   USE test_idxlist_utils, ONLY: test_err_count
   USE yaxt, ONLY: xt_initialize, xt_finalize, xt_int_kind, &
+       xt_stripe, &
        xt_idxlist, xt_idxlist_delete, xt_idxvec_new, &
        xt_xmap, xt_xmap_delete, xt_xmap_all2all_new, &
        xt_xmap_get_num_destinations, xt_xmap_get_num_sources, &
        xt_xmap_get_destination_ranks, xt_xmap_get_source_ranks, &
        xt_set_abort_handler, xt_restore_default_abort_hndl
+  USE test_xmap_common, ONLY : test_self_xmap_construct
   IMPLICIT NONE
   INTERFACE
-    SUBROUTINE xfail_abort(comm, msg, source, line)
-      INTEGER, INTENT(in) :: comm, line
-      CHARACTER(len=*), INTENT(in) :: msg, source
-    END SUBROUTINE xfail_abort
+    FUNCTION xmap_new_fail3(src_idxlist, dst_idxlist, comm) RESULT(xmap)
+      IMPORT :: xt_xmap, xt_idxlist
+      TYPE(xt_xmap) :: xmap
+      TYPE(xt_idxlist), INTENT(in) :: src_idxlist, dst_idxlist
+      INTEGER, INTENT(in) :: comm
+    END FUNCTION xmap_new_fail3
   END INTERFACE
   INTEGER, PARAMETER :: xi = xt_int_kind
   CHARACTER(len=*), PARAMETER :: filename = 'test_xmap_all2all_fail_f.f90'
@@ -68,68 +73,29 @@ PROGRAM test_xmap_all2all_fail
   CALL xt_initialize(mpi_comm_world)
   CALL mpi_comm_rank(mpi_comm_world, my_rank, ierror)
   CALL parse_options
-  CALL test_xmap1(list_size)
+  CALL test_xmap1(list_size, mpi_comm_world)
 
   IF (test_err_count() /= 0) &
        CALL test_abort("non-zero error count!", filename, __LINE__)
   CALL xt_finalize
   CALL finish_mpi
 CONTAINS
-  SUBROUTINE shift_idx(idx, offset)
-    INTEGER(xt_int_kind), INTENT(inout) :: idx(:)
-    INTEGER(xt_int_kind), INTENT(in) :: offset
-    INTEGER :: i
-    DO i = 1, SIZE(idx)
-      idx(i) = idx(i) + INT(my_rank, xi) * offset
-    END DO
-  END SUBROUTINE shift_idx
-
-  SUBROUTINE test_xmap(src_index_list, dst_index_list)
-    INTEGER(xt_int_kind), INTENT(in) :: src_index_list(:), dst_index_list(:)
-    TYPE(xt_idxlist) :: src_idxlist, dst_idxlist
-    TYPE(xt_xmap) :: xmap
-    INTEGER :: rank(1)
-    src_idxlist = xt_idxvec_new(src_index_list)
-    dst_idxlist = xt_idxvec_new(dst_index_list)
-
-    CALL xt_set_abort_handler(xfail_abort)
-    xmap = xt_xmap_all2all_new(src_idxlist, dst_idxlist, mpi_comm_world)
-    CALL xt_restore_default_abort_hndl
-    CALL xt_idxlist_delete(src_idxlist)
-    CALL xt_idxlist_delete(dst_idxlist)
-
-    IF (xt_xmap_get_num_destinations(xmap) /= 1) &
-         CALL test_abort("error in xmap construction", filename, __LINE__)
-
-    IF (xt_xmap_get_num_sources(xmap) /= 1) &
-         CALL test_abort("error in xt_xmap_get_num_sources", filename, __LINE__)
-    CALL xt_xmap_get_destination_ranks(xmap, rank)
-    IF (rank(1) /= my_rank) &
-         CALL test_abort("error in xt_xmap_get_destination_ranks", &
-         filename, __LINE__)
+  SUBROUTINE test_xmap1(num_idx, comm)
+    INTEGER, INTENT(in) :: num_idx, comm
+    TYPE(xt_stripe) :: src_stripe(1), dst_stripe(1)
 
-    CALL xt_xmap_get_source_ranks(xmap, rank)
-    IF (rank(1) /= my_rank) &
-         CALL test_abort("error in xt_xmap_get_source_ranks", &
-         filename, __LINE__)
-    CALL xt_xmap_delete(xmap)
-  END SUBROUTINE test_xmap
+    ! soruce index list
+    src_stripe(1)%nstrides = INT(num_idx, c_int)
+    src_stripe(1)%start = 1_xi + INT(my_rank, xi) * INT(num_idx, xi)
+    src_stripe(1)%stride = 1_xi
 
-  SUBROUTINE test_xmap1(num_idx)
-    INTEGER, INTENT(in) :: num_idx
-    INTEGER :: i
-    INTEGER(xt_int_kind) :: src_index_list(num_idx), &
-         dst_index_list(num_idx)
-    DO i = 1, num_idx
-      src_index_list(i) = INT(i, xi)
-    END DO
-    CALL shift_idx(src_index_list, INT(num_idx, xi))
-    DO i = 1, num_idx
-      dst_index_list(i) = INT(num_idx - i + 2, xi)
-    END DO
-    CALL shift_idx(dst_index_list, INT(num_idx, xi))
+    ! destination index list
+    dst_stripe(1)%nstrides = INT(num_idx, c_int)
+    dst_stripe(1)%start = src_stripe(1)%start + src_stripe(1)%nstrides
+    dst_stripe(1)%stride = -1_xi
     ! note: this should fail because dst/src indices don't match
-    CALL test_xmap(src_index_list, dst_index_list)
+    CALL test_self_xmap_construct(src_stripe, dst_stripe,&
+         & xmap_new_fail3, comm)
   END SUBROUTINE test_xmap1
 
   SUBROUTINE parse_options
@@ -197,6 +163,22 @@ SUBROUTINE xfail_abort(comm, msg, source, line)
   CALL posix_exit(3_c_int)
 END SUBROUTINE xfail_abort
 
+FUNCTION xmap_new_fail3(src_idxlist, dst_idxlist, comm) RESULT(xmap)
+  USE yaxt, ONLY: xt_xmap, xt_idxlist, xt_xmap_all2all_new, &
+       xt_set_abort_handler, xt_restore_default_abort_hndl
+  TYPE(xt_xmap) :: xmap
+  TYPE(xt_idxlist), INTENT(in) :: src_idxlist, dst_idxlist
+  INTEGER, INTENT(in) :: comm
+  INTERFACE
+    SUBROUTINE xfail_abort(comm, msg, source, line)
+      INTEGER, INTENT(in) :: comm, line
+      CHARACTER(len=*), INTENT(in) :: msg, source
+    END SUBROUTINE xfail_abort
+  END INTERFACE
+  CALL xt_set_abort_handler(xfail_abort)
+  xmap = xt_xmap_all2all_new(src_idxlist, dst_idxlist, comm)
+  CALL xt_restore_default_abort_hndl
+END FUNCTION xmap_new_fail3
 
 !
 ! Local Variables: