vendor/test/impls: Add test session_exchange.

mpich2/test/mpi/impls/mpich/session/Makefile.am

@@ -10,4 +10,4 @@ EXTRA_DIST = testlist
 ## for all programs that are just built from the single corresponding source
 ## file, we don't need per-target _SOURCES rules, automake will infer them
 ## correctly
-noinst_PROGRAMS = session_strict_finalize session_malleable session_shrink session_expand
+noinst_PROGRAMS = session_strict_finalize session_malleable session_shrink session_expand session_exchange

mpich2/test/mpi/impls/mpich/session/ps-test-minimal

@@ -5,3 +5,5 @@ session_malleable 4
 session_shrink 4
 session_shrink 6
 session_expand 2
+session_exchange 3
+session_exchange 6

mpich2/test/mpi/impls/mpich/session/session_exchange.c

+/*
+ * ParaStation
+ *
+ * Copyright (C) 2023 ParTec AG, Munich
+ *
+ * This file may be distributed under the terms of the Q Public License
+ * as defined in the file LICENSE.QPL included in the packaging of this
+ * file.
+ */
+
+#include <stdio.h>
+#include "mpi.h"
+#include "mpitest.h"
+
+/* Text shink and expansion in one re-init (exchange)*/
+
+#define SPAWN_PROCS 2
+
+int errs = 0;
+
+/* Macro for MPI error handling */
+#define CHECK_MPI_ERR(mpi_errno)            \
+    if (mpi_errno != MPI_SUCCESS) {         \
+        errs++;                             \
+        char errstr[MPI_MAX_ERROR_STRING];  \
+        int len = 0;                        \
+        MPI_Error_string(rc, errstr, &len); \
+        fprintf(stderr, "%s\n", errstr);    \
+        goto fn_fail;                       \
+    }
+
+bool is_pmix_4_2_4_err(int mpi_errno)
+{
+    char err_str[MPI_MAX_ERROR_STRING];
+    const char *version_str = "requires PMIx 4.2.4";
+    int strlen = MPI_MAX_ERROR_STRING;
+    MPI_Error_string(mpi_errno, err_str, &strlen);
+
+    if (strstr(err_str, version_str) != NULL) {
+        return true;
+    } else {
+        return false;
+    }
+}
+
+/* Get the world rank to be able to exit gracefully in case of PMIx version issue */
+int get_rank(void)
+{
+    int rank = 0;
+    MPI_Session s = MPI_SESSION_NULL;
+    MPI_Group g = MPI_GROUP_NULL;
+    MPI_Comm c = MPI_COMM_NULL;
+    MPI_Session_init(MPI_INFO_NULL, MPI_ERRORS_ARE_FATAL, &s);
+    MPI_Session_set_errhandler(s, MPI_ERRORS_ARE_FATAL);
+    MPI_Group_from_session_pset(s, "mpi://WORLD", &g);
+    MPI_Comm_create_from_group(g, "org.mpi-forum.mpi-v4_0.example-ex10_8",
+                               MPI_INFO_NULL, MPI_ERRORS_ARE_FATAL, &c);
+    MPI_Comm_rank(c, &rank);
+    MPI_Comm_free(&c);
+    MPI_Group_free(&g);
+    MPI_Session_finalize(&s);
+    return rank;
+}
+
+int main(int argc, char *argv[])
+{
+    int rc;
+    int rank = get_rank();
+    int size = 0;
+    int sum;
+    MPI_Session *sessions_for_reinit[1];
+    MPI_Info sinfo = MPI_INFO_NULL;
+    MPI_Info spawn_status = MPI_INFO_NULL;
+    MPI_Session shandle = MPI_SESSION_NULL;
+    MPI_Session shandle_ex = MPI_SESSION_NULL;
+    MPI_Group ghandle = MPI_GROUP_NULL;
+    MPI_Comm commhandle = MPI_COMM_NULL;
+    int spawned = 0;
+    int found;
+    char status[MPI_MAX_INFO_VAL];
+    char spawned_str[MPI_MAX_INFO_VAL];
+
+    MPI_Info_create(&sinfo);
+    MPI_Info_set(sinfo, "malleable", "1");
+
+    rc = MPI_Session_init(sinfo, MPI_ERRORS_RETURN, &shandle);
+    MPI_Info_free(&sinfo);
+    if (is_pmix_4_2_4_err(rc)) {
+        /* Exit gracefully, this test needs at least PMIx 4.2.4 */
+        goto fn_exit;
+    }
+    CHECK_MPI_ERR(rc);
+
+    /* Is this process a spawned process? */
+    rc = MPIX_Spawn_status(&spawn_status);
+    CHECK_MPI_ERR(rc);
+
+    MPI_Info_get(spawn_status, "spawn_x_spawned", MPI_MAX_INFO_VAL, spawned_str, &found);
+    if (!found) {
+        errs++;
+        fprintf(stderr, "MPIX_Spawn_status does not contain key spawn_x_spawned %d\n", rc);
+        goto fn_fail;
+    }
+    if (strncmp(spawned_str, "1", MPI_MAX_INFO_VAL) != 0) {
+        spawned = 0;
+    } else {
+        spawned = 1;
+    }
+
+    rc = MPI_Session_set_errhandler(shandle, MPI_ERRORS_RETURN);
+    CHECK_MPI_ERR(rc);
+    rc = MPI_Group_from_session_pset(shandle, "mpi://WORLD", &ghandle);
+    CHECK_MPI_ERR(rc);
+    rc = MPI_Comm_create_from_group(ghandle, "org.mpi-forum.mpi-v4_0.example-ex10_8",
+                                    MPI_INFO_NULL, MPI_ERRORS_RETURN, &commhandle);
+    CHECK_MPI_ERR(rc);
+
+    /* Check if comms are initialized */
+    if (commhandle == MPI_COMM_NULL) {
+        errs++;
+        fprintf(stderr, "Comm not initialized\n");
+        goto fn_fail;
+    }
+
+    MPI_Comm_rank(commhandle, &rank);
+    MPI_Comm_size(commhandle, &size);
+
+    if (!spawned) {
+        /* Check conditions for this test */
+        if (size < 3) {
+            fprintf(stderr, "At least 3 processes required\n");
+            MPI_Abort(commhandle, 1);
+        }
+    }
+
+    /* Do something */
+    rc = MPI_Reduce(&rank, &sum, 1, MPI_INT, MPI_SUM, 0, commhandle);
+    CHECK_MPI_ERR(rc);
+    if (rank == 0) {
+        if (sum != (size - 1) * size / 2) {
+            fprintf(stderr, "MPI_Reduce: expect %d, got %d\n", (size - 1) * size / 2, sum);
+            errs++;
+        }
+    }
+
+    /* clean up */
+    MPI_Group_free(&ghandle);
+    MPI_Comm_free(&commhandle);
+
+    if (!spawned) {
+
+        /* Trigger the spawn of two processes */
+        rc = MPIX_Spawn_async((char *) "./session_exchange", MPI_ARGV_NULL,
+                              SPAWN_PROCS, MPI_INFO_NULL, 0, 0, &spawn_status);
+        CHECK_MPI_ERR(rc);
+
+        MPI_Info_get(spawn_status, "spawn_x_status", MPI_MAX_INFO_VAL, status, &found);
+        if (!found) {
+            errs++;
+            fprintf(stderr, "MPIX_Spawn_status does not contain key spawn_x_status %d\n", rc);
+            goto fn_fail;
+        }
+
+        while (strncmp(status, "complete", MPI_MAX_INFO_VAL) != 0 &&
+               strncmp(status, "inactive", MPI_MAX_INFO_VAL) != 0) {
+            /* Wait for spawned process(es) to become ready (complete) or detect error (inactive) */
+            rc = MPIX_Spawn_status(&spawn_status);
+            CHECK_MPI_ERR(rc);
+
+            MPI_Info_get(spawn_status, "spawn_x_status", MPI_MAX_INFO_VAL, status, &found);
+            if (!found) {
+                errs++;
+                fprintf(stderr, "MPIX_Spawn_status does not contain key spawn_x_status %d\n", rc);
+                goto fn_fail;
+            }
+        }
+
+        /* Prepare session array for reinit */
+        sessions_for_reinit[0] = &shandle;
+        /* Reinit, rank 1 and 2 leave, spawned processes are added */
+        if (rank == 1 || rank == 2) {
+            rc = MPIX_Session_reinit(1, sessions_for_reinit, &shandle_ex, MPI_INFO_NULL,
+                                     MPIX_SESSION_REINIT_PREP_FN_NULL, NULL,
+                                     MPIX_SESSION_REINIT_RESUME_FN_NULL, NULL,
+                                     /* leaving */ 1, 1, 0, MPI_ERRORS_RETURN);
+        } else {
+            rc = MPIX_Session_reinit(1, sessions_for_reinit, &shandle_ex, MPI_INFO_NULL,
+                                     MPIX_SESSION_REINIT_PREP_FN_NULL, NULL,
+                                     MPIX_SESSION_REINIT_RESUME_FN_NULL, NULL,
+                                     /* not leaving */ 0, 1, 0, MPI_ERRORS_RETURN);
+        }
+        CHECK_MPI_ERR(rc);
+
+        if (shandle != MPI_SESSION_NULL) {
+            errs++;
+            fprintf(stderr, "MPIX_Session_reinit did not set input sessions to MPI_SESSION_NULL\n");
+        }
+
+        rc = MPI_Session_set_errhandler(shandle_ex, MPI_ERRORS_RETURN);
+        CHECK_MPI_ERR(rc);
+        rc = MPI_Group_from_session_pset(shandle_ex, "mpi://WORLD", &ghandle);
+        CHECK_MPI_ERR(rc);
+        rc = MPI_Comm_create_from_group(ghandle, "org.mpi-forum.mpi-v4_0.example-ex10_8",
+                                        MPI_INFO_NULL, MPI_ERRORS_RETURN, &commhandle);
+        CHECK_MPI_ERR(rc);
+
+        /* Check if comm for new session is initialized */
+        if (commhandle == MPI_COMM_NULL) {
+            errs++;
+            fprintf(stderr, "Comm for new session not initialized\n");
+            goto fn_fail;
+        }
+
+        int old_size = size;
+
+        /* Check if world size stayed the same */
+        MPI_Comm_rank(commhandle, &rank);
+        MPI_Comm_size(commhandle, &size);
+        if (size != old_size) {
+            errs++;
+            fprintf(stderr, "After reinit, expected world size = %d, got %d\n", old_size, size);
+            goto fn_fail;
+        }
+
+        /* clean up */
+        MPI_Group_free(&ghandle);
+        MPI_Comm_free(&commhandle);
+        MPI_Session_finalize(&shandle_ex);
+    } else {
+        MPI_Session_finalize(&shandle);
+    }
+    MPI_Info_free(&spawn_status);
+
+  fn_exit:
+    if (rank == 0) {
+        if (errs == 0) {
+            fprintf(stdout, " No Errors\n");
+        } else {
+            fprintf(stderr, "%d Errors\n", errs);
+        }
+    }
+
+    return MTestReturnValue(errs);
+  fn_fail:
+    if (spawn_status != MPI_INFO_NULL) {
+        MPI_Info_free(&spawn_status);
+    }
+    if (ghandle != MPI_GROUP_NULL) {
+        MPI_Group_free(&ghandle);
+    }
+    if (commhandle != MPI_COMM_NULL) {
+        MPI_Comm_free(&commhandle);
+    }
+    if (shandle != MPI_SESSION_NULL) {
+        MPI_Session_finalize(&shandle);
+    }
+    if (shandle_ex != MPI_SESSION_NULL) {
+        MPI_Session_finalize(&shandle_ex);
+    }
+}

mpich2/test/mpi/impls/mpich/session/testlist

@@ -5,3 +5,5 @@ session_malleable 4
 session_shrink 4
 session_shrink 6
 session_expand 2
+session_exchange 3
+session_exchange 6