Logo AND Algorithmique Numérique Distribuée

Public GIT Repository
Try to fix mpich tests on systems without privatization
authordegomme <augustin.degomme@unibas.ch>
Sun, 12 Feb 2017 01:57:28 +0000 (02:57 +0100)
committerdegomme <augustin.degomme@unibas.ch>
Sun, 12 Feb 2017 01:57:28 +0000 (02:57 +0100)
teshsuite/smpi/mpich3-test/CMakeLists.txt
teshsuite/smpi/mpich3-test/util/dtypes_manual.c [new file with mode: 0644]
teshsuite/smpi/mpich3-test/util/mtest_datatype_gen_manual.c [new file with mode: 0644]
teshsuite/smpi/mpich3-test/util/mtest_manual.c

index 28b482a..614d904 100644 (file)
@@ -22,6 +22,8 @@ set(txt_files  ${txt_files}  ${CMAKE_CURRENT_SOURCE_DIR}/README
                              ${CMAKE_CURRENT_SOURCE_DIR}/util/mtest_datatype.c
                              ${CMAKE_CURRENT_SOURCE_DIR}/util/mtest_datatype_gen.c
                              ${CMAKE_CURRENT_SOURCE_DIR}/util/mtest_manual.c
                              ${CMAKE_CURRENT_SOURCE_DIR}/util/mtest_datatype.c
                              ${CMAKE_CURRENT_SOURCE_DIR}/util/mtest_datatype_gen.c
                              ${CMAKE_CURRENT_SOURCE_DIR}/util/mtest_manual.c
+                             ${CMAKE_CURRENT_SOURCE_DIR}/util/mtestt_datatype_gen_manual.c
+                             ${CMAKE_CURRENT_SOURCE_DIR}/util/dtypes_manual.c
                              ${CMAKE_CURRENT_SOURCE_DIR}/f77/testlist
                              ${CMAKE_CURRENT_SOURCE_DIR}/f90/testlist
                              ${CMAKE_CURRENT_SOURCE_DIR}/include/dtypes.h
                              ${CMAKE_CURRENT_SOURCE_DIR}/f77/testlist
                              ${CMAKE_CURRENT_SOURCE_DIR}/f90/testlist
                              ${CMAKE_CURRENT_SOURCE_DIR}/include/dtypes.h
@@ -49,6 +51,6 @@ if(enable_smpi AND enable_smpi_MPICH3_testsuite)
   if(HAVE_PRIVATIZATION)
     add_library(mtest_c STATIC util/dtypes.c util/mtest.c  util/mtestcheck.c  util/mtest_datatype.c util/mtest_datatype_gen.c)
   else()
   if(HAVE_PRIVATIZATION)
     add_library(mtest_c STATIC util/dtypes.c util/mtest.c  util/mtestcheck.c  util/mtest_datatype.c util/mtest_datatype_gen.c)
   else()
-    add_library(mtest_c STATIC util/mtest_manual.c)
+    add_library(mtest_c STATIC util/mtest_manual.c util/dtypes_manual.c util/mtestcheck.c util/mtest_datatype.c util/mtest_datatype_gen_manual.c)
   endif()
 endif()
   endif()
 endif()
diff --git a/teshsuite/smpi/mpich3-test/util/dtypes_manual.c b/teshsuite/smpi/mpich3-test/util/dtypes_manual.c
new file mode 100644 (file)
index 0000000..bfff4be
--- /dev/null
@@ -0,0 +1,387 @@
+/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil ; -*- */
+/*
+ *
+ *  (C) 2014 by Argonne National Laboratory.
+ *      See COPYRIGHT in top-level directory.
+ */
+#include "mpi.h"
+#include "mpitestconf.h"
+#include "mpitest.h"
+#include "dtypes.h"
+#if defined(HAVE_STDIO_H) || defined(STDC_HEADERS)
+#include <stdio.h>
+#endif
+#if defined(HAVE_STDLIB_H) || defined(STDC_HEADERS)
+#include <stdlib.h>
+#endif
+#if defined(HAVE_STRING_H) || defined(STDC_HEADERS)
+#include <string.h>
+#endif
+#ifdef HAVE_STDARG_H
+#include <stdarg.h>
+#endif
+
+/* This file contains code to generate a variety of MPI datatypes for testing
+   the various MPI routines.
+
+   To simplify the test code, this generates an array of datatypes, buffers with
+   data and buffers with no data (0 bits) for use in send and receive
+   routines of various types.
+
+   In addition, this doesn't even test all of the possibilities.  For example,
+   there is currently no test of sending more than one item defined with
+   MPI_Type_contiguous .
+
+   Note also that this test assumes that the sending and receive types are
+   the same.  MPI requires only that the type signatures match, which is
+   a weaker requirement.
+
+   This code was drawn from the MPICH-1 test suite and modified to fit the
+   new MPICH test suite.  It provides an alternative set of datatype tests
+   to the ones in mtest.c.
+
+ */
+
+/* Change this to test only the basic, predefined types */
+static int basic_only = 0;
+
+/*
+   Arrays types, inbufs, outbufs, and counts are allocated by the
+   CALLER.  n on input is the maximum number; on output, it is the
+   number defined.
+
+   See MTestDatatype2Allocate below for a routine to allocate these arrays.
+
+   We may want to add a routine to call to check that the proper data
+   has been received.
+ */
+
+/*
+   Add a predefined MPI type to the tests.  _count instances of the
+   type will be sent.
+*/
+#define SETUPBASICTYPE(_mpitype,_ctype,_count) { \
+  int i; _ctype *a;    \
+  if (cnt > *n) {*n = cnt; return; }                   \
+  types[cnt] = _mpitype; \
+  inbufs[cnt] = (void *)calloc(_count,sizeof(_ctype)); \
+  outbufs[cnt] = (void *)malloc(sizeof(_ctype) * (_count));    \
+  a = (_ctype *)inbufs[cnt]; for (i=0; i<(_count); i++) a[i] = i;      \
+  a = (_ctype *)outbufs[cnt]; for (i=0; i<(_count); i++) a[i] = 0;     \
+  counts[cnt]  = _count; bytesize[cnt] = sizeof(_ctype) * (_count); cnt++; }
+
+/*
+   Add a contiguous version of a predefined type.  Send one instance of
+   the type which contains _count copies of the predefined type.
+ */
+#define SETUPCONTIGTYPE(_mpitype,_ctype,_count) { \
+  int i; _ctype *a; char*myname; \
+  char _basename[MPI_MAX_OBJECT_NAME]; int _basenamelen;\
+  if (cnt > *n) {*n = cnt; return; }\
+  MPI_Type_contiguous(_count, _mpitype, types + cnt);\
+  MPI_Type_commit(types + cnt);\
+  inbufs[cnt] = (void *)calloc(_count, sizeof(_ctype)); \
+  outbufs[cnt] = (void *)malloc(sizeof(_ctype) * (_count));    \
+  a = (_ctype *)inbufs[cnt]; for (i=0; i<(_count); i++) a[i] = i;      \
+  a = (_ctype *)outbufs[cnt]; for (i=0; i<(_count); i++) a[i] = 0;     \
+  myname = (char *)malloc(100);\
+  MPI_Type_get_name(_mpitype, _basename, &_basenamelen); \
+  snprintf(myname, 100, "Contig type %s", _basename);  \
+  MPI_Type_set_name(types[cnt], myname); \
+  free(myname); \
+  counts[cnt]  = 1;  bytesize[cnt] = sizeof(_ctype) * (_count); cnt++; }
+
+/*
+  Create a vector with _count elements, separated by stride _stride,
+  of _mpitype.  Each block has a single element.
+ */
+#define SETUPVECTORTYPE(_mpitype,_ctype,_count,_stride,_name) { \
+  int i; _ctype *a; char *myname;                              \
+  char _basename[MPI_MAX_OBJECT_NAME]; int _basenamelen;\
+  if (cnt > *n) {*n = cnt; return; }\
+  MPI_Type_vector(_count, 1, _stride, _mpitype, types + cnt);  \
+  MPI_Type_commit(types + cnt);\
+  inbufs[cnt] = (void *)calloc(sizeof(_ctype) * (_count) * (_stride),1); \
+  outbufs[cnt] = (void *)calloc(sizeof(_ctype) * (_count) * (_stride),1); \
+  a = (_ctype *)inbufs[cnt]; for (i=0; i<(_count); i++) a[i*(_stride)] = i; \
+  a = (_ctype *)outbufs[cnt]; for (i=0; i<(_count); i++) a[i*(_stride)] = 0; \
+  myname = (char *)malloc(100);\
+  MPI_Type_get_name(_mpitype, _basename, &_basenamelen); \
+  snprintf(myname, 100, "Vector type %s", _basename);          \
+  MPI_Type_set_name(types[cnt], myname); \
+  free(myname); \
+  counts[cnt]  = 1; bytesize[cnt] = sizeof(_ctype) * (_count) * (_stride) ;\
+  cnt++; }
+
+/* This indexed type is setup like a contiguous type .
+   Note that systems may try to convert this to contiguous, so we'll
+   eventually need a test that has holes in it */
+#define SETUPINDEXTYPE(_mpitype,_ctype,_count,_name) { \
+  int i; int *lens, *disp; _ctype *a; char *myname;    \
+  char _basename[MPI_MAX_OBJECT_NAME]; int _basenamelen;\
+  if (cnt > *n) {*n = cnt; return; }\
+  lens = (int *)malloc((_count) * sizeof(int)); \
+  disp = (int *)malloc((_count) * sizeof(int)); \
+  for (i=0; i<(_count); i++) { lens[i] = 1; disp[i] = i; } \
+  MPI_Type_indexed((_count), lens, disp, _mpitype, types + cnt);\
+  free(lens); free(disp); \
+  MPI_Type_commit(types + cnt);\
+  inbufs[cnt] = (void *)calloc((_count), sizeof(_ctype)); \
+  outbufs[cnt] = (void *)malloc(sizeof(_ctype) * (_count)); \
+  a = (_ctype *)inbufs[cnt]; for (i=0; i<(_count); i++) a[i] = i; \
+  a = (_ctype *)outbufs[cnt]; for (i=0; i<(_count); i++) a[i] = 0; \
+  myname = (char *)malloc(100);\
+  MPI_Type_get_name(_mpitype, _basename, &_basenamelen); \
+  snprintf(myname, 100, "Index type %s", _basename);           \
+  MPI_Type_set_name(types[cnt], myname); \
+  free(myname); \
+  counts[cnt]  = 1;  bytesize[cnt] = sizeof(_ctype) * (_count); cnt++; }
+
+/* This defines a structure of two basic members; by chosing things like
+   (char, double), various packing and alignment tests can be made */
+#define SETUPSTRUCT2TYPE(_mpitype1,_ctype1,_mpitype2,_ctype2,_count,_tname) { \
+  int i; char *myname;                                         \
+  MPI_Datatype b[3]; int cnts[3]; \
+  struct name { _ctype1 a1; _ctype2 a2; } *a, samp;    \
+  MPI_Aint disp[3];                            \
+  if (cnt > *n) {*n = cnt; return; }                                   \
+  b[0] = _mpitype1; b[1] = _mpitype2; b[2] = MPI_UB;   \
+  cnts[0] = 1; cnts[1] = 1; cnts[2] = 1;       \
+  MPI_Get_address(&(samp.a2), &disp[1]);               \
+  MPI_Get_address(&(samp.a1), &disp[0]);               \
+  MPI_Get_address(&(samp) + 1, &disp[2]);              \
+  disp[1] = disp[1] - disp[0]; disp[2] = disp[2] - disp[0]; disp[0] = 0; \
+  MPI_Type_create_struct(3, cnts, disp, b, types + cnt);               \
+  MPI_Type_commit(types + cnt);                                        \
+  inbufs[cnt] = (void *)calloc(sizeof(struct name) * (_count),1);      \
+  outbufs[cnt] = (void *)calloc(sizeof(struct name) * (_count),1);     \
+  a = (struct name *)inbufs[cnt]; for (i=0; i<(_count); i++) { a[i].a1 = i; \
+      a[i].a2 = i; }                                                   \
+  a = (struct name *)outbufs[cnt]; for (i=0; i<(_count); i++) { a[i].a1 = 0; \
+      a[i].a2 = 0; }                                                   \
+  myname = (char *)malloc(100);                                        \
+  snprintf(myname, 100, "Struct type %s", _tname);             \
+  MPI_Type_set_name(types[cnt], myname); \
+  free(myname); \
+  counts[cnt]  = (_count);  bytesize[cnt] = sizeof(struct name) * (_count);cnt++; }
+
+/* This accomplished the same effect as VECTOR, but allow a count of > 1 */
+#define SETUPSTRUCTTYPEUB(_mpitype,_ctype,_count,_stride) {    \
+  int i; _ctype *a; char *myname;                                      \
+  int blens[2];  MPI_Aint disps[2]; MPI_Datatype mtypes[2];    \
+  char _basename[MPI_MAX_OBJECT_NAME]; int _basenamelen;\
+  if (cnt > *n) {*n = cnt; return; }                                   \
+  blens[0] = 1; blens[1] = 1; disps[0] = 0; \
+  disps[1] = (_stride) * sizeof(_ctype); \
+  mtypes[0] = _mpitype; mtypes[1] = MPI_UB;                            \
+  MPI_Type_create_struct(2, blens, disps, mtypes, types + cnt);        \
+  MPI_Type_commit(types + cnt);                                        \
+  inbufs[cnt] = (void *)calloc(sizeof(_ctype) * (_count) * (_stride),1);\
+  outbufs[cnt] = (void *)calloc(sizeof(_ctype) * (_count) * (_stride),1);\
+  a = (_ctype *)inbufs[cnt]; for (i=0; i<(_count); i++) a[i*(_stride)] = i;  \
+  a = (_ctype *)outbufs[cnt]; for (i=0; i<(_count); i++) a[i*(_stride)] = 0; \
+  myname = (char *)malloc(100);                                        \
+  MPI_Type_get_name(_mpitype, _basename, &_basenamelen); \
+  snprintf(myname, 100, "Struct (MPI_UB) type %s", _basename); \
+  MPI_Type_set_name(types[cnt], myname); \
+  free(myname); \
+  counts[cnt]  = (_count);  \
+  bytesize[cnt] = sizeof(_ctype) * (_count) * (_stride);\
+  cnt++; }
+
+/*
+ * Set whether only the basic types should be generated
+ */
+void MTestDatatype2BasicOnly(void)
+{
+    basic_only = 1;
+}
+
+SMPI_VARINIT_GLOBAL_AND_SET(nbasic_types, int, 0);  /* World rank */
+/* On input, n is the size of the various buffers.  On output,
+   it is the number available types
+ */
+void MTestDatatype2Generate(MPI_Datatype * types, void **inbufs, void **outbufs,
+                            int *counts, int *bytesize, int *n)
+{
+    int cnt = 0;                /* Number of defined types */
+    int typecnt = 10;           /* Number of instances to send in most cases */
+    int stride = 9;             /* Number of elements in vector to stride */
+
+    /* First, generate an element of each basic type */
+    SETUPBASICTYPE(MPI_CHAR, char, typecnt);
+    SETUPBASICTYPE(MPI_SHORT, short, typecnt);
+    SETUPBASICTYPE(MPI_INT, int, typecnt);
+    SETUPBASICTYPE(MPI_LONG, long, typecnt);
+    SETUPBASICTYPE(MPI_UNSIGNED_CHAR, unsigned char, typecnt);
+    SETUPBASICTYPE(MPI_UNSIGNED_SHORT, unsigned short, typecnt);
+    SETUPBASICTYPE(MPI_UNSIGNED, unsigned, typecnt);
+    SETUPBASICTYPE(MPI_UNSIGNED_LONG, unsigned long, typecnt);
+    SETUPBASICTYPE(MPI_FLOAT, float, typecnt);
+    SETUPBASICTYPE(MPI_DOUBLE, double, typecnt);
+    SETUPBASICTYPE(MPI_BYTE, char, typecnt);
+#ifdef HAVE_LONG_LONG_INT
+    SETUPBASICTYPE(MPI_LONG_LONG_INT, long long, typecnt);
+#endif
+#ifdef HAVE_LONG_DOUBLE
+    SETUPBASICTYPE(MPI_LONG_DOUBLE, long double, typecnt);
+#endif
+    SMPI_VARGET_GLOBAL(nbasic_types) = cnt;
+
+    if (basic_only) {
+        *n = cnt;
+        return;
+    }
+    /* Generate contiguous data items */
+    SETUPCONTIGTYPE(MPI_CHAR, char, typecnt);
+    SETUPCONTIGTYPE(MPI_SHORT, short, typecnt);
+    SETUPCONTIGTYPE(MPI_INT, int, typecnt);
+    SETUPCONTIGTYPE(MPI_LONG, long, typecnt);
+    SETUPCONTIGTYPE(MPI_UNSIGNED_CHAR, unsigned char, typecnt);
+    SETUPCONTIGTYPE(MPI_UNSIGNED_SHORT, unsigned short, typecnt);
+    SETUPCONTIGTYPE(MPI_UNSIGNED, unsigned, typecnt);
+    SETUPCONTIGTYPE(MPI_UNSIGNED_LONG, unsigned long, typecnt);
+    SETUPCONTIGTYPE(MPI_FLOAT, float, typecnt);
+    SETUPCONTIGTYPE(MPI_DOUBLE, double, typecnt);
+    SETUPCONTIGTYPE(MPI_BYTE, char, typecnt);
+#ifdef HAVE_LONG_LONG_INT
+    SETUPCONTIGTYPE(MPI_LONG_LONG_INT, long long, typecnt);
+#endif
+#ifdef HAVE_LONG_DOUBLE
+    SETUPCONTIGTYPE(MPI_LONG_DOUBLE, long double, typecnt);
+#endif
+
+    /* Generate vector items */
+    SETUPVECTORTYPE(MPI_CHAR, char, typecnt, stride, "MPI_CHAR");
+    SETUPVECTORTYPE(MPI_SHORT, short, typecnt, stride, "MPI_SHORT");
+    SETUPVECTORTYPE(MPI_INT, int, typecnt, stride, "MPI_INT");
+    SETUPVECTORTYPE(MPI_LONG, long, typecnt, stride, "MPI_LONG");
+    SETUPVECTORTYPE(MPI_UNSIGNED_CHAR, unsigned char, typecnt, stride, "MPI_UNSIGNED_CHAR");
+    SETUPVECTORTYPE(MPI_UNSIGNED_SHORT, unsigned short, typecnt, stride, "MPI_UNSIGNED_SHORT");
+    SETUPVECTORTYPE(MPI_UNSIGNED, unsigned, typecnt, stride, "MPI_UNSIGNED");
+    SETUPVECTORTYPE(MPI_UNSIGNED_LONG, unsigned long, typecnt, stride, "MPI_UNSIGNED_LONG");
+    SETUPVECTORTYPE(MPI_FLOAT, float, typecnt, stride, "MPI_FLOAT");
+    SETUPVECTORTYPE(MPI_DOUBLE, double, typecnt, stride, "MPI_DOUBLE");
+    SETUPVECTORTYPE(MPI_BYTE, char, typecnt, stride, "MPI_BYTE");
+#ifdef HAVE_LONG_LONG_INT
+    SETUPVECTORTYPE(MPI_LONG_LONG_INT, long long, typecnt, stride, "MPI_LONG_LONG_INT");
+#endif
+#ifdef HAVE_LONG_DOUBLE
+    SETUPVECTORTYPE(MPI_LONG_DOUBLE, long double, typecnt, stride, "MPI_LONG_DOUBLE");
+#endif
+
+    /* Generate indexed items */
+    SETUPINDEXTYPE(MPI_CHAR, char, typecnt, "MPI_CHAR");
+    SETUPINDEXTYPE(MPI_SHORT, short, typecnt, "MPI_SHORT");
+    SETUPINDEXTYPE(MPI_INT, int, typecnt, "MPI_INT");
+    SETUPINDEXTYPE(MPI_LONG, long, typecnt, "MPI_LONG");
+    SETUPINDEXTYPE(MPI_UNSIGNED_CHAR, unsigned char, typecnt, "MPI_UNSIGNED_CHAR");
+    SETUPINDEXTYPE(MPI_UNSIGNED_SHORT, unsigned short, typecnt, "MPI_UNSIGNED_SHORT");
+    SETUPINDEXTYPE(MPI_UNSIGNED, unsigned, typecnt, "MPI_UNSIGNED");
+    SETUPINDEXTYPE(MPI_UNSIGNED_LONG, unsigned long, typecnt, "MPI_UNSIGNED_LONG");
+    SETUPINDEXTYPE(MPI_FLOAT, float, typecnt, "MPI_FLOAT");
+    SETUPINDEXTYPE(MPI_DOUBLE, double, typecnt, "MPI_DOUBLE");
+    SETUPINDEXTYPE(MPI_BYTE, char, typecnt, "MPI_BYTE");
+#ifdef HAVE_LONG_LONG_INT
+    SETUPINDEXTYPE(MPI_LONG_LONG_INT, long long, typecnt, "MPI_LONG_LONG_INT");
+#endif
+#ifdef HAVE_LONG_DOUBLE
+    SETUPINDEXTYPE(MPI_LONG_DOUBLE, long double, typecnt, "MPI_LONG_DOUBLE");
+#endif
+
+    /* Generate struct items */
+    SETUPSTRUCT2TYPE(MPI_CHAR, char, MPI_DOUBLE, double, typecnt, "char-double");
+    SETUPSTRUCT2TYPE(MPI_DOUBLE, double, MPI_CHAR, char, typecnt, "double-char");
+    SETUPSTRUCT2TYPE(MPI_UNSIGNED, unsigned, MPI_DOUBLE, double, typecnt, "unsigned-double");
+    SETUPSTRUCT2TYPE(MPI_FLOAT, float, MPI_LONG, long, typecnt, "float-long");
+    SETUPSTRUCT2TYPE(MPI_UNSIGNED_CHAR, unsigned char, MPI_CHAR, char, typecnt,
+                     "unsigned char-char");
+    SETUPSTRUCT2TYPE(MPI_UNSIGNED_SHORT, unsigned short, MPI_DOUBLE, double,
+                     typecnt, "unsigned short-double");
+
+    /* Generate struct using MPI_UB */
+    SETUPSTRUCTTYPEUB(MPI_CHAR, char, typecnt, stride);
+    SETUPSTRUCTTYPEUB(MPI_SHORT, short, typecnt, stride);
+    SETUPSTRUCTTYPEUB(MPI_INT, int, typecnt, stride);
+    SETUPSTRUCTTYPEUB(MPI_LONG, long, typecnt, stride);
+    SETUPSTRUCTTYPEUB(MPI_UNSIGNED_CHAR, unsigned char, typecnt, stride);
+    SETUPSTRUCTTYPEUB(MPI_UNSIGNED_SHORT, unsigned short, typecnt, stride);
+    SETUPSTRUCTTYPEUB(MPI_UNSIGNED, unsigned, typecnt, stride);
+    SETUPSTRUCTTYPEUB(MPI_UNSIGNED_LONG, unsigned long, typecnt, stride);
+    SETUPSTRUCTTYPEUB(MPI_FLOAT, float, typecnt, stride);
+    SETUPSTRUCTTYPEUB(MPI_DOUBLE, double, typecnt, stride);
+    SETUPSTRUCTTYPEUB(MPI_BYTE, char, typecnt, stride);
+
+    /* 60 different entries to this point + 4 for long long and
+     * 4 for long double */
+    *n = cnt;
+}
+
+/*
+   MAX_TEST should be 1 + actual max (allows us to check that it was,
+   indeed, large enough)
+ */
+#define MAX_TEST 70
+void MTestDatatype2Allocate(MPI_Datatype ** types, void ***inbufs,
+                            void ***outbufs, int **counts, int **bytesize, int *n)
+{
+    *types = (MPI_Datatype *) malloc(MAX_TEST * sizeof(MPI_Datatype));
+    *inbufs = (void **) malloc(MAX_TEST * sizeof(void *));
+    *outbufs = (void **) malloc(MAX_TEST * sizeof(void *));
+    *counts = (int *) malloc(MAX_TEST * sizeof(int));
+    *bytesize = (int *) malloc(MAX_TEST * sizeof(int));
+    *n = MAX_TEST;
+}
+
+int MTestDatatype2Check(void *inbuf, void *outbuf, int size_bytes)
+{
+    char *in = (char *) inbuf, *out = (char *) outbuf;
+    int i;
+    for (i = 0; i < size_bytes; i++) {
+        if (in[i] != out[i]) {
+            return i + 1;
+        }
+    }
+    return 0;
+}
+
+/*
+ * This is a version of CheckData that prints error messages
+ */
+static int MtestDatatype2CheckAndPrint(void *inbuf, void *outbuf, int size_bytes,
+                                char *typename, int typenum)
+{
+    int errloc, world_rank;
+
+    if ((errloc = MTestDatatype2Check(inbuf, outbuf, size_bytes))) {
+        char *p1, *p2;
+        MPI_Comm_rank(MPI_COMM_WORLD, &world_rank);
+        fprintf(stderr,
+                "Error in data with type %s (type %d on %d) at byte %d of %d\n",
+                typename, typenum, world_rank, errloc - 1, size_bytes);
+        p1 = (char *) inbuf;
+        p2 = (char *) outbuf;
+        fprintf(stderr, "Got %x expected %x\n", p2[errloc - 1], p1[errloc - 1]);
+    }
+    return errloc;
+}
+
+void MTestDatatype2Free(MPI_Datatype * types, void **inbufs, void **outbufs,
+                        int *counts, int *bytesize, int n)
+{
+    int i;
+    for (i = 0; i < n; i++) {
+        if (inbufs[i])
+            free(inbufs[i]);
+        if (outbufs[i])
+            free(outbufs[i]);
+        /* Only if not basic ... */
+        if (i >= SMPI_VARGET_GLOBAL(nbasic_types))
+            MPI_Type_free(types + i);
+    }
+    free(types);
+    free(inbufs);
+    free(outbufs);
+    free(counts);
+    free(bytesize);
+}
diff --git a/teshsuite/smpi/mpich3-test/util/mtest_datatype_gen_manual.c b/teshsuite/smpi/mpich3-test/util/mtest_datatype_gen_manual.c
new file mode 100644 (file)
index 0000000..bfc5bdf
--- /dev/null
@@ -0,0 +1,626 @@
+/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil ; -*- */
+/*
+ *
+ *  (C) 2014 by Argonne National Laboratory.
+ *      See COPYRIGHT in top-level directory.
+ */
+#include "mtest_datatype.h"
+#if defined(HAVE_STDIO_H) || defined(STDC_HEADERS)
+#include <stdio.h>
+#endif
+#if defined(HAVE_STDLIB_H) || defined(STDC_HEADERS)
+#include <stdlib.h>
+#endif
+#if defined(HAVE_STRING_H) || defined(STDC_HEADERS)
+#include <string.h>
+#endif
+#ifdef HAVE_STDARG_H
+#include <stdarg.h>
+#endif
+/* The following two includes permit the collection of resource usage
+   data in the tests
+ */
+#ifdef HAVE_SYS_TIME_H
+#include <sys/time.h>
+#endif
+#ifdef HAVE_SYS_RESOURCE_H
+#include <sys/resource.h>
+#endif
+#include <errno.h>
+
+static int dbgflag = 0;         /* Flag used for debugging */
+SMPI_VARINIT_GLOBAL_AND_SET(wrank2, int, -1);  /* World rank */
+static int verbose = 0;         /* Message level (0 is none) */
+
+/*
+ * Utility routines for writing MPI datatype communication tests.
+ *
+ * Both basic and derived datatype are included.
+ * For basic datatypes, every type has a test case that both the send and
+ * receive buffer use the same datatype and count.
+ *
+ *  For derived datatypes:
+ *    All the test cases are defined in this file, and the datatype definitions
+ *    are in file mtest_datatype.c. Each test case will be automatically called
+ *    by every datatype.
+ *
+ *  Test case generation:
+ *    Every datatype tests derived datatype send buffer and
+ *    derived datatype receive buffer separately. Each test contains various sub
+ *    tests for different structures (i.e., different value of count or block
+ *    length). The following four structures are defined:
+ *      L count & S block length & S stride
+ *      S count & L block length & S stride
+ *      L count & S block length & L stride
+ *      S count & L block length & L stride
+ *      S count & L block length & S stride & S lower-bound
+ *      contiguous (stride = block length)
+ *      contiguous (stride = block length) & S lower-bound
+ *
+ *  How to add a new structure for each datatype:
+ *    1. Add structure definition in function MTestDdtStructDefine.
+ *    2. Increase MTEST_DDT_NUM_SUBTESTS
+ *
+ *  Datatype definition:
+ *    Every type is initialized by the creation function stored in
+ *    mtestDdtCreators variable, all of their create/init/check functions are
+ *    defined in file mtest_datatype.c.
+ *
+ *  How to add a new derived datatype:
+ *    1. Add the new datatype in enum MTEST_DERIVED_DT.
+ *    2. Add its create/init/check functions in file mtest_datatype.c
+ *    3. Add its creator function to mtestDdtCreators variable
+ *
+ *  Following three test levels of datatype are defined.
+ *    1. Basic
+ *      All basic datatypes
+ *    2. Minimum
+ *      All basic datatypes | Vector | Indexed
+ *    3. Full
+ *      All basic datatypes | Vector | Hvector | Indexed | Hindexed |
+ *      Indexed-block | Hindexed-block | Subarray with order-C | Subarray with order-Fortran
+ *
+ *  There are two ways to specify the test level of datatype. The second way has
+ *  higher priority (means the value specified by the first way will be overwritten
+ *  by that in the second way).
+ *  1. Specify global test level by setting the MPITEST_DATATYPE_TEST_LEVEL
+ *     environment variable before execution (basic,min,full|full by default).
+ *  2. Initialize a special level for a datatype loop by calling the corresponding
+ *     initialization function before that loop, otherwise the default value specified
+ *     in the first way is used.
+ *    Basic     : MTestInitBasicDatatypes
+ *    Minimum   : MTestInitMinDatatypes
+ *    Full      : MTestInitFullDatatypes
+ */
+
+static int datatype_index = 0;
+
+/* ------------------------------------------------------------------------ */
+/* Routine and internal parameters to define the range of datatype tests */
+/* ------------------------------------------------------------------------ */
+
+#define MTEST_DDT_NUM_SUBTESTS 7        /* 7 kinds of derived datatype structure */
+static MTestDdtCreator mtestDdtCreators[MTEST_DDT_MAX];
+
+static int MTEST_BDT_START_IDX = -1;
+static int MTEST_BDT_NUM_TESTS = 0;
+static int MTEST_BDT_RANGE = 0;
+
+static int MTEST_DDT_NUM_TYPES = 0;
+static int MTEST_SEND_DDT_START_IDX = 0;
+static int MTEST_SEND_DDT_NUM_TESTS = 0;
+static int MTEST_SEND_DDT_RANGE = 0;
+
+static int MTEST_RECV_DDT_START_IDX = 0;
+static int MTEST_RECV_DDT_NUM_TESTS = 0;
+static int MTEST_RECV_DDT_RANGE = 0;
+
+enum {
+    MTEST_DATATYPE_TEST_LEVEL_FULL,
+    MTEST_DATATYPE_TEST_LEVEL_MIN,
+    MTEST_DATATYPE_TEST_LEVEL_BASIC
+};
+
+/* current datatype test level */
+static int MTEST_DATATYPE_TEST_LEVEL = MTEST_DATATYPE_TEST_LEVEL_FULL;
+/* default datatype test level specified by environment variable */
+static int MTEST_DATATYPE_TEST_LEVEL_ENV = -1;
+/* default datatype initialization function */
+static void (*MTestInitDefaultTestFunc) (void) = NULL;
+
+static void MTestInitDatatypeGen(int basic_dt_num, int derived_dt_num)
+{
+    MTEST_BDT_START_IDX = 0;
+    MTEST_BDT_NUM_TESTS = basic_dt_num;
+    MTEST_BDT_RANGE = MTEST_BDT_START_IDX + MTEST_BDT_NUM_TESTS;
+    MTEST_DDT_NUM_TYPES = derived_dt_num;
+    MTEST_SEND_DDT_START_IDX = MTEST_BDT_NUM_TESTS;
+    MTEST_SEND_DDT_NUM_TESTS = MTEST_DDT_NUM_TYPES * MTEST_DDT_NUM_SUBTESTS;
+    MTEST_SEND_DDT_RANGE = MTEST_SEND_DDT_START_IDX + MTEST_SEND_DDT_NUM_TESTS;
+    MTEST_RECV_DDT_START_IDX = MTEST_SEND_DDT_START_IDX + MTEST_SEND_DDT_NUM_TESTS;
+    MTEST_RECV_DDT_NUM_TESTS = MTEST_DDT_NUM_TYPES * MTEST_DDT_NUM_SUBTESTS;
+    MTEST_RECV_DDT_RANGE = MTEST_RECV_DDT_START_IDX + MTEST_RECV_DDT_NUM_TESTS;
+}
+
+static int MTestIsDatatypeGenInited()
+{
+    return (MTEST_BDT_START_IDX < 0) ? 0 : 1;
+}
+
+static void MTestPrintDatatypeGen()
+{
+    MTestPrintfMsg(1, "MTest datatype test level : %s. %d basic datatype tests, "
+                   "%d derived datatype tests will be generated\n",
+                   (MTEST_DATATYPE_TEST_LEVEL == MTEST_DATATYPE_TEST_LEVEL_FULL) ? "FULL" : "MIN",
+                   MTEST_BDT_NUM_TESTS, MTEST_SEND_DDT_NUM_TESTS + MTEST_RECV_DDT_NUM_TESTS);
+}
+
+static void MTestResetDatatypeGen()
+{
+    MTEST_BDT_START_IDX = -1;
+}
+
+void MTestInitFullDatatypes(void)
+{
+    /* Do not allow to change datatype test level during loop.
+     * Otherwise indexes will be wrong.
+     * Test must explicitly call reset or wait for current datatype loop being
+     * done before changing to another test level. */
+    if (!MTestIsDatatypeGenInited()) {
+        MTEST_DATATYPE_TEST_LEVEL = MTEST_DATATYPE_TEST_LEVEL_FULL;
+        MTestTypeCreatorInit((MTestDdtCreator *) mtestDdtCreators);
+        MTestInitDatatypeGen(MTEST_BDT_MAX, MTEST_DDT_MAX);
+    }
+    else {
+        printf("Warning: trying to reinitialize mtest datatype during " "datatype iteration!");
+    }
+}
+
+void MTestInitMinDatatypes(void)
+{
+    /* Do not allow to change datatype test level during loop.
+     * Otherwise indexes will be wrong.
+     * Test must explicitly call reset or wait for current datatype loop being
+     * done before changing to another test level. */
+    if (!MTestIsDatatypeGenInited()) {
+        MTEST_DATATYPE_TEST_LEVEL = MTEST_DATATYPE_TEST_LEVEL_MIN;
+        MTestTypeMinCreatorInit((MTestDdtCreator *) mtestDdtCreators);
+        MTestInitDatatypeGen(MTEST_BDT_MAX, MTEST_MIN_DDT_MAX);
+    }
+    else {
+        printf("Warning: trying to reinitialize mtest datatype during " "datatype iteration!");
+    }
+}
+
+void MTestInitBasicDatatypes(void)
+{
+    /* Do not allow to change datatype test level during loop.
+     * Otherwise indexes will be wrong.
+     * Test must explicitly call reset or wait for current datatype loop being
+     * done before changing to another test level. */
+    if (!MTestIsDatatypeGenInited()) {
+        MTEST_DATATYPE_TEST_LEVEL = MTEST_DATATYPE_TEST_LEVEL_BASIC;
+        MTestInitDatatypeGen(MTEST_BDT_MAX, 0);
+    }
+    else {
+        printf("Warning: trying to reinitialize mtest datatype during " "datatype iteration!");
+    }
+}
+
+static inline void MTestInitDatatypeEnv()
+{
+    char *envval = 0;
+
+    /* Read global test level specified by user environment variable.
+     * Only initialize once at the first time that test calls datatype routine. */
+    if (MTEST_DATATYPE_TEST_LEVEL_ENV > -1)
+        return;
+
+    /* default full */
+    MTEST_DATATYPE_TEST_LEVEL_ENV = MTEST_DATATYPE_TEST_LEVEL_FULL;
+    MTestInitDefaultTestFunc = MTestInitFullDatatypes;
+
+    envval = getenv("MPITEST_DATATYPE_TEST_LEVEL");
+    if (envval && strlen(envval)) {
+        if (!strncmp(envval, "min", strlen("min"))) {
+            MTEST_DATATYPE_TEST_LEVEL_ENV = MTEST_DATATYPE_TEST_LEVEL_MIN;
+            MTestInitDefaultTestFunc = MTestInitMinDatatypes;
+        }
+        else if (!strncmp(envval, "basic", strlen("basic"))) {
+            MTEST_DATATYPE_TEST_LEVEL_ENV = MTEST_DATATYPE_TEST_LEVEL_BASIC;
+            MTestInitDefaultTestFunc = MTestInitBasicDatatypes;
+        }
+        else if (strncmp(envval, "full", strlen("full"))) {
+            fprintf(stderr, "Unknown MPITEST_DATATYPE_TEST_LEVEL %s\n", envval);
+        }
+    }
+}
+
+/* -------------------------------------------------------------------------------*/
+/* Routine to define various sets of blocklen/count/stride for derived datatypes. */
+/* ------------------------------------------------------------------------------ */
+
+static inline int MTestDdtStructDefine(int ddt_index, MPI_Aint tot_count, MPI_Aint * count,
+                                       MPI_Aint * blen, MPI_Aint * stride,
+                                       MPI_Aint * align_tot_count, MPI_Aint * lb)
+{
+    int merr = 0;
+    int ddt_c_st;
+    MPI_Aint _short = 0, _align_tot_count = 0, _count = 0, _blen = 0, _stride = 0;
+    MPI_Aint _lb = 0;
+
+    ddt_c_st = ddt_index % MTEST_DDT_NUM_SUBTESTS;
+
+    /* Get short value according to user specified tot_count.
+     * It is used as count for large-block-length structure, or block length
+     * for large-count structure. */
+    if (tot_count < 2) {
+        _short = 1;
+    }
+    else if (tot_count < 64) {
+        _short = 2;
+    }
+    else {
+        _short = 64;
+    }
+    _align_tot_count = (tot_count + _short - 1) & ~(_short - 1);
+
+    switch (ddt_c_st) {
+    case 0:
+        /* Large block length. */
+        _count = _short;
+        _blen = _align_tot_count / _short;
+        _stride = _blen * 2;
+        break;
+    case 1:
+        /* Large count */
+        _count = _align_tot_count / _short;
+        _blen = _short;
+        _stride = _blen * 2;
+        break;
+    case 2:
+        /* Large block length and large stride */
+        _count = _short;
+        _blen = _align_tot_count / _short;
+        _stride = _blen * 10;
+        break;
+    case 3:
+        /* Large count and large stride */
+        _count = _align_tot_count / _short;
+        _blen = _short;
+        _stride = _blen * 10;
+        break;
+    case 4:
+        /* Large block length with lb */
+        _count = _short;
+        _blen = _align_tot_count / _short;
+        _stride = _blen * 2;
+        _lb = _short / 2;       /* make sure lb < blen */
+        break;
+    case 5:
+        /* Contig ddt (stride = block length) without lb */
+        _count = _align_tot_count / _short;
+        _blen = _short;
+        _stride = _blen;
+        break;
+    case 6:
+        /* Contig ddt (stride = block length) with lb */
+        _count = _short;
+        _blen = _align_tot_count / _short;
+        _stride = _blen;
+        _lb = _short / 2;       /* make sure lb < blen */
+        break;
+    default:
+        /* Undefined index */
+        merr = 1;
+        break;
+    }
+
+    *align_tot_count = _align_tot_count;
+    *count = _count;
+    *blen = _blen;
+    *stride = _stride;
+    *lb = _lb;
+
+    return merr;
+}
+
+/* ------------------------------------------------------------------------ */
+/* Routine to generate basic datatypes                                       */
+/* ------------------------------------------------------------------------ */
+
+static inline int MTestGetBasicDatatypes(MTestDatatype * sendtype,
+                                         MTestDatatype * recvtype, MPI_Aint tot_count)
+{
+    int merr = 0;
+    int bdt_index = datatype_index - MTEST_BDT_START_IDX;
+    if (bdt_index >= MTEST_BDT_MAX) {
+        printf("Wrong index:  global %d, bst %d in %s\n", datatype_index, bdt_index, __FUNCTION__);
+        merr++;
+        return merr;
+    }
+
+    switch (bdt_index) {
+    case MTEST_BDT_INT:
+        merr = MTestTypeBasicCreate(MPI_INT, sendtype);
+        merr = MTestTypeBasicCreate(MPI_INT, recvtype);
+        break;
+    case MTEST_BDT_DOUBLE:
+        merr = MTestTypeBasicCreate(MPI_DOUBLE, sendtype);
+        merr = MTestTypeBasicCreate(MPI_DOUBLE, recvtype);
+        break;
+    case MTEST_BDT_FLOAT_INT:
+        merr = MTestTypeBasicCreate(MPI_FLOAT_INT, sendtype);
+        merr = MTestTypeBasicCreate(MPI_FLOAT_INT, recvtype);
+        break;
+    case MTEST_BDT_SHORT:
+        merr = MTestTypeBasicCreate(MPI_SHORT, sendtype);
+        merr = MTestTypeBasicCreate(MPI_SHORT, recvtype);
+        break;
+    case MTEST_BDT_LONG:
+        merr = MTestTypeBasicCreate(MPI_LONG, sendtype);
+        merr = MTestTypeBasicCreate(MPI_LONG, recvtype);
+        break;
+    case MTEST_BDT_CHAR:
+        merr = MTestTypeBasicCreate(MPI_CHAR, sendtype);
+        merr = MTestTypeBasicCreate(MPI_CHAR, recvtype);
+        break;
+    case MTEST_BDT_UINT64_T:
+        merr = MTestTypeBasicCreate(MPI_UINT64_T, sendtype);
+        merr = MTestTypeBasicCreate(MPI_UINT64_T, recvtype);
+        break;
+    case MTEST_BDT_FLOAT:
+        merr = MTestTypeBasicCreate(MPI_FLOAT, sendtype);
+        merr = MTestTypeBasicCreate(MPI_FLOAT, recvtype);
+        break;
+    case MTEST_BDT_BYTE:
+        merr = MTestTypeBasicCreate(MPI_BYTE, sendtype);
+        merr = MTestTypeBasicCreate(MPI_BYTE, recvtype);
+        break;
+    }
+    sendtype->count = tot_count;
+    recvtype->count = tot_count;
+
+    return merr;
+}
+
+/* ------------------------------------------------------------------------ */
+/* Routine to generate send/receive derived datatypes                     */
+/* ------------------------------------------------------------------------ */
+
+static inline int MTestGetSendDerivedDatatypes(MTestDatatype * sendtype,
+                                               MTestDatatype * recvtype, MPI_Aint tot_count)
+{
+    int merr = 0;
+    int ddt_datatype_index, ddt_c_dt;
+    MPI_Aint blen, stride, count, align_tot_count, lb;
+    MPI_Datatype old_type = MPI_DOUBLE;
+
+    /* Check index */
+    ddt_datatype_index = datatype_index - MTEST_SEND_DDT_START_IDX;
+    ddt_c_dt = ddt_datatype_index / MTEST_DDT_NUM_SUBTESTS;
+    if (ddt_c_dt >= MTEST_DDT_MAX || !mtestDdtCreators[ddt_c_dt]) {
+        printf("Wrong index:  global %d, send %d send-ddt %d, or undefined creator in %s\n",
+               datatype_index, ddt_datatype_index, ddt_c_dt, __FUNCTION__);
+        merr++;
+        return merr;
+    }
+
+    /* Set datatype structure */
+    merr = MTestDdtStructDefine(ddt_datatype_index, tot_count, &count, &blen,
+                                &stride, &align_tot_count, &lb);
+    if (merr) {
+        printf("Wrong index:  global %d, send %d send-ddt %d, or undefined ddt structure in %s\n",
+               datatype_index, ddt_datatype_index, ddt_c_dt, __FUNCTION__);
+        merr++;
+        return merr;
+    }
+
+    /* Create send datatype */
+    merr = mtestDdtCreators[ddt_c_dt] (count, blen, stride, lb, old_type, "send", sendtype);
+    if (merr)
+        return merr;
+
+    sendtype->count = 1;
+
+    /* Create receive datatype */
+    merr = MTestTypeBasicCreate(old_type, recvtype);
+    if (merr)
+        return merr;
+
+    recvtype->count = sendtype->count * align_tot_count;
+
+    return merr;
+}
+
+static inline int MTestGetRecvDerivedDatatypes(MTestDatatype * sendtype,
+                                               MTestDatatype * recvtype, MPI_Aint tot_count)
+{
+    int merr = 0;
+    int ddt_datatype_index, ddt_c_dt;
+    MPI_Aint blen, stride, count, align_tot_count, lb;
+    MPI_Datatype old_type = MPI_DOUBLE;
+
+    /* Check index */
+    ddt_datatype_index = datatype_index - MTEST_RECV_DDT_START_IDX;
+    ddt_c_dt = ddt_datatype_index / MTEST_DDT_NUM_SUBTESTS;
+    if (ddt_c_dt >= MTEST_DDT_MAX || !mtestDdtCreators[ddt_c_dt]) {
+        printf("Wrong index:  global %d, recv %d recv-ddt %d, or undefined creator in %s\n",
+               datatype_index, ddt_datatype_index, ddt_c_dt, __FUNCTION__);
+        merr++;
+        return merr;
+    }
+
+    /* Set datatype structure */
+    merr = MTestDdtStructDefine(ddt_datatype_index, tot_count, &count, &blen,
+                                &stride, &align_tot_count, &lb);
+    if (merr) {
+        printf("Wrong index:  global %d, recv %d recv-ddt %d, or undefined ddt structure in %s\n",
+               datatype_index, ddt_datatype_index, ddt_c_dt, __FUNCTION__);
+        return merr;
+    }
+
+    /* Create receive datatype */
+    merr = mtestDdtCreators[ddt_c_dt] (count, blen, stride, lb, old_type, "recv", recvtype);
+    if (merr)
+        return merr;
+
+    recvtype->count = 1;
+
+    /* Create send datatype */
+    merr = MTestTypeBasicCreate(old_type, sendtype);
+    if (merr)
+        return merr;
+
+    sendtype->count = recvtype->count * align_tot_count;
+
+    return merr;
+}
+
+/* ------------------------------------------------------------------------ */
+/* Exposed routine to external tests                                         */
+/* ------------------------------------------------------------------------ */
+int MTestGetDatatypes(MTestDatatype * sendtype, MTestDatatype * recvtype, MPI_Aint tot_count)
+{
+    int merr = 0;
+
+    MTestGetDbgInfo(&dbgflag, &verbose);
+    MTestInitDatatypeEnv();
+    MPI_Comm_rank(MPI_COMM_WORLD, &SMPI_VARGET_GLOBAL(wrank2));
+
+    /* Initialize the default test level if test does not specify. */
+    if (!MTestIsDatatypeGenInited()) {
+        MTestInitDefaultTestFunc();
+    }
+
+    if (datatype_index == 0) {
+        MTestPrintDatatypeGen();
+    }
+
+    /* Start generating tests */
+    if (datatype_index < MTEST_BDT_RANGE) {
+        merr = MTestGetBasicDatatypes(sendtype, recvtype, tot_count);
+
+    }
+    else if (datatype_index < MTEST_SEND_DDT_RANGE) {
+        merr = MTestGetSendDerivedDatatypes(sendtype, recvtype, tot_count);
+
+    }
+    else if (datatype_index < MTEST_RECV_DDT_RANGE) {
+        merr = MTestGetRecvDerivedDatatypes(sendtype, recvtype, tot_count);
+
+    }
+    else {
+        /* out of range */
+        datatype_index = -1;
+        MTestResetDatatypeGen();
+    }
+
+    /* stop if error reported */
+    if (merr) {
+        datatype_index = -1;
+    }
+
+    if (datatype_index > 0) {
+        /* general initialization for receive buffer. */
+        recvtype->InitBuf = MTestTypeInitRecv;
+    }
+
+    datatype_index++;
+
+    if (verbose >= 2 && datatype_index > 0) {
+        MPI_Count ssize, rsize;
+        MPI_Aint slb, rlb, sextent, rextent;
+        const char *sendtype_nm = MTestGetDatatypeName(sendtype);
+        const char *recvtype_nm = MTestGetDatatypeName(recvtype);
+        MPI_Type_size_x(sendtype->datatype, &ssize);
+        MPI_Type_size_x(recvtype->datatype, &rsize);
+
+        MPI_Type_get_extent(sendtype->datatype, &slb, &sextent);
+        MPI_Type_get_extent(recvtype->datatype, &rlb, &rextent);
+
+        MTestPrintfMsg(2, "Get datatypes: send = %s(size %d ext %ld lb %ld count %d basesize %d), "
+                       "recv = %s(size %d ext %ld lb %ld count %d basesize %d), tot_count=%d\n",
+                       sendtype_nm, ssize, sextent, slb, sendtype->count, sendtype->basesize,
+                       recvtype_nm, rsize, rextent, rlb, recvtype->count, recvtype->basesize,
+                       tot_count);
+        fflush(stdout);
+    }
+
+    return datatype_index;
+}
+
+/* Reset the datatype index (start from the initial data type.
+   Note: This routine is rarely needed; MTestGetDatatypes automatically
+   starts over after the last available datatype is used.
+*/
+void MTestResetDatatypes(void)
+{
+    datatype_index = 0;
+    MTestResetDatatypeGen();
+}
+
+/* Return the index of the current datatype.  This is rarely needed and
+   is provided mostly to enable debugging of the MTest package itself */
+int MTestGetDatatypeIndex(void)
+{
+    return datatype_index;
+}
+
+/* Free the storage associated with a datatype */
+void MTestFreeDatatype(MTestDatatype * mtype)
+{
+    int merr;
+    /* Invoke a datatype-specific free function to handle
+     * both the datatype and the send/receive buffers */
+    if (mtype->FreeBuf) {
+        (mtype->FreeBuf) (mtype);
+    }
+    /* Free the datatype itself if it was created */
+    if (!mtype->isBasic) {
+        merr = MPI_Type_free(&mtype->datatype);
+        if (merr)
+            MTestPrintError(merr);
+    }
+}
+
+/* Check that a message was received correctly.  Returns the number of
+   errors detected.  Status may be NULL or MPI_STATUS_IGNORE */
+int MTestCheckRecv(MPI_Status * status, MTestDatatype * recvtype)
+{
+    int count;
+    int errs = 0, merr;
+
+    if (status && status != MPI_STATUS_IGNORE) {
+        merr = MPI_Get_count(status, recvtype->datatype, &count);
+        if (merr)
+            MTestPrintError(merr);
+
+        /* Check count against expected count */
+        if (count != recvtype->count) {
+            errs++;
+        }
+    }
+
+    /* Check received data */
+    if (!errs && recvtype->CheckBuf(recvtype)) {
+        errs++;
+    }
+    return errs;
+}
+
+/* This next routine uses a circular buffer of static name arrays just to
+   simplify the use of the routine */
+const char *MTestGetDatatypeName(MTestDatatype * dtype)
+{
+    static char name[4][MPI_MAX_OBJECT_NAME];
+    static int sp = 0;
+    int rlen, merr;
+
+    if (sp >= 4)
+        sp = 0;
+    merr = MPI_Type_get_name(dtype->datatype, name[sp], &rlen);
+    if (merr)
+        MTestPrintError(merr);
+    return (const char *) name[sp++];
+}
index e0813e7..7af77c9 100644 (file)
  * as the error handler.  We do *not* set MPI_ERRORS_RETURN because
  * the code that makes use of these routines may not check return
  * codes.
  * as the error handler.  We do *not* set MPI_ERRORS_RETURN because
  * the code that makes use of these routines may not check return
  * codes.
- * 
+ *
  */
 
  */
 
-static void MTestRMACleanup( void );
-static void MTestResourceSummary( FILE * );
+static void MTestRMACleanup(void);
+static void MTestResourceSummary(FILE *);
 
 /* Here is where we could put the includes and definitions to enable
    memory testing */
 
 /* Here is where we could put the includes and definitions to enable
    memory testing */
@@ -64,1287 +64,723 @@ SMPI_VARINIT_GLOBAL_AND_SET(usageOutput, int, 0); /* */
 #define MPI_THREAD_SINGLE 0
 #endif
 
 #define MPI_THREAD_SINGLE 0
 #endif
 
-/* 
+/*
  * Initialize and Finalize MTest
  */
 
 /*
  * Initialize and Finalize MTest
  */
 
 /*
-   Initialize MTest, initializing MPI if necessary.  
+   Initialize MTest, initializing MPI if necessary.
 
  Environment Variables:
 + MPITEST_DEBUG - If set (to any value), turns on debugging output
 . MPITEST_THREADLEVEL_DEFAULT - If set, use as the default "provided"
 
  Environment Variables:
 + MPITEST_DEBUG - If set (to any value), turns on debugging output
 . MPITEST_THREADLEVEL_DEFAULT - If set, use as the default "provided"
-                                level of thread support.  Applies to 
+                                level of thread support.  Applies to
                                 MTest_Init but not MTest_Init_thread.
 - MPITEST_VERBOSE - If set to a numeric value, turns on that level of
   verbose output.  This is used by the routine 'MTestPrintfMsg'
 
 */
                                 MTest_Init but not MTest_Init_thread.
 - MPITEST_VERBOSE - If set to a numeric value, turns on that level of
   verbose output.  This is used by the routine 'MTestPrintfMsg'
 
 */
-void MTest_Init_thread( int *argc, char ***argv, int required, int *provided )
+void MTest_Init_thread(int *argc, char ***argv, int required, int *provided)
 {
     int flag;
     char *envval = 0;
 
 {
     int flag;
     char *envval = 0;
 
-    MPI_Initialized( &flag );
+    MPI_Initialized(&flag);
     if (!flag) {
     if (!flag) {
-       /* Permit an MPI that claims only MPI 1 but includes the 
-          MPI_Init_thread routine (e.g., IBM MPI) */
+        /* Permit an MPI that claims only MPI 1 but includes the
+         * MPI_Init_thread routine (e.g., IBM MPI) */
 #if MPI_VERSION >= 2 || defined(HAVE_MPI_INIT_THREAD)
 #if MPI_VERSION >= 2 || defined(HAVE_MPI_INIT_THREAD)
-       MPI_Init_thread( argc, argv, required, provided );
+        MPI_Init_thread(argc, argv, required, provided);
 #else
 #else
-       MPI_Init( argc, argv );
-       *provided = -1;
+        MPI_Init(argc, argv);
+        *provided = -1;
 #endif
     }
     /* Check for debugging control */
 #endif
     }
     /* Check for debugging control */
-    if (getenv( "MPITEST_DEBUG" )) {
-       SMPI_VARGET_GLOBAL(dbgflag) = 1;
-       MPI_Comm_rank( MPI_COMM_WORLD, &SMPI_VARGET_GLOBAL(wrank) );
+    if (getenv("MPITEST_DEBUG")) {
+        SMPI_VARGET_GLOBAL(dbgflag) = 1;
+        MPI_Comm_rank(MPI_COMM_WORLD, &SMPI_VARGET_GLOBAL(wrank));
     }
 
     /* Check for verbose control */
     }
 
     /* Check for verbose control */
-    envval = getenv( "MPITEST_VERBOSE" );
+    envval = getenv("MPITEST_VERBOSE");
     if (envval) {
     if (envval) {
-       char *s;
-       long val = strtol( envval, &s, 0 );
-       if (s == envval) {
-           /* This is the error case for strtol */
-           fprintf( stderr, "Warning: %s not valid for MPITEST_VERBOSE\n", 
-                    envval );
-           fflush( stderr );
-       }
-       else {
-           if (val >= 0) {
-               SMPI_VARGET_GLOBAL(verbose) = val;
-           }
-           else {
-               fprintf( stderr, "Warning: %s not valid for MPITEST_VERBOSE\n", 
-                        envval );
-               fflush( stderr );
-           }
-       }
+        char *s;
+        long val = strtol(envval, &s, 0);
+        if (s == envval) {
+            /* This is the error case for strtol */
+            fprintf(stderr, "Warning: %s not valid for MPITEST_VERBOSE\n", envval);
+            fflush(stderr);
+        }
+        else {
+            if (val >= 0) {
+                SMPI_VARGET_GLOBAL(verbose) = val;
+            }
+            else {
+                fprintf(stderr, "Warning: %s not valid for MPITEST_VERBOSE\n", envval);
+                fflush(stderr);
+            }
+        }
     }
     /* Check for option to return success/failure in the return value of main */
     }
     /* Check for option to return success/failure in the return value of main */
-    envval = getenv( "MPITEST_RETURN_WITH_CODE" );
+    envval = getenv("MPITEST_RETURN_WITH_CODE");
     if (envval) {
     if (envval) {
-       if (strcmp( envval, "yes" ) == 0 ||
-           strcmp( envval, "YES" ) == 0 ||
-           strcmp( envval, "true" ) == 0 ||
-           strcmp( envval, "TRUE" ) == 0) {
-           SMPI_VARGET_GLOBAL(returnWithVal) = 1;
-       }
-       else if (strcmp( envval, "no" ) == 0 ||
-           strcmp( envval, "NO" ) == 0 ||
-           strcmp( envval, "false" ) == 0 ||
-           strcmp( envval, "FALSE" ) == 0) {
-           SMPI_VARGET_GLOBAL(returnWithVal) = 0;
-       }
-       else {
-           fprintf( stderr, 
-                    "Warning: %s not valid for MPITEST_RETURN_WITH_CODE\n", 
-                    envval );
-           fflush( stderr );
-       }
+        if (strcmp(envval, "yes") == 0 ||
+            strcmp(envval, "YES") == 0 ||
+            strcmp(envval, "true") == 0 || strcmp(envval, "TRUE") == 0) {
+            SMPI_VARGET_GLOBAL(returnWithVal) = 1;
+        }
+        else if (strcmp(envval, "no") == 0 ||
+                 strcmp(envval, "NO") == 0 ||
+                 strcmp(envval, "false") == 0 || strcmp(envval, "FALSE") == 0) {
+            SMPI_VARGET_GLOBAL(returnWithVal) = 0;
+        }
+        else {
+            fprintf(stderr, "Warning: %s not valid for MPITEST_RETURN_WITH_CODE\n", envval);
+            fflush(stderr);
+        }
     }
     }
-    
+
     /* Print rusage data if set */
     /* Print rusage data if set */
-    if (getenv( "MPITEST_RUSAGE" )) {
-       SMPI_VARGET_GLOBAL(usageOutput) = 1;
+    if (getenv("MPITEST_RUSAGE")) {
+        SMPI_VARGET_GLOBAL(usageOutput) = 1;
     }
 }
     }
 }
-/* 
- * Initialize the tests, using an MPI-1 style init.  Supports 
+
+/*
+ * Initialize the tests, using an MPI-1 style init.  Supports
  * MTEST_THREADLEVEL_DEFAULT to test with user-specified thread level
  */
  * MTEST_THREADLEVEL_DEFAULT to test with user-specified thread level
  */
-void MTest_Init( int *argc, char ***argv )
+void MTest_Init(int *argc, char ***argv)
 {
     int provided;
 #if MPI_VERSION >= 2 || defined(HAVE_MPI_INIT_THREAD)
     const char *str = 0;
 {
     int provided;
 #if MPI_VERSION >= 2 || defined(HAVE_MPI_INIT_THREAD)
     const char *str = 0;
-    int        threadLevel;
+    int threadLevel;
 
     threadLevel = MPI_THREAD_SINGLE;
 
     threadLevel = MPI_THREAD_SINGLE;
-    str = getenv( "MTEST_THREADLEVEL_DEFAULT" );
-    if (!str) str = getenv( "MPITEST_THREADLEVEL_DEFAULT" );
+    str = getenv("MTEST_THREADLEVEL_DEFAULT");
+    if (!str)
+        str = getenv("MPITEST_THREADLEVEL_DEFAULT");
     if (str && *str) {
     if (str && *str) {
-       if (strcmp(str,"MULTIPLE") == 0 || strcmp(str,"multiple") == 0) {
-           threadLevel = MPI_THREAD_MULTIPLE;
-       }
-       else if (strcmp(str,"SERIALIZED") == 0 || 
-                strcmp(str,"serialized") == 0) {
-           threadLevel = MPI_THREAD_SERIALIZED;
-       }
-       else if (strcmp(str,"FUNNELED") == 0 || strcmp(str,"funneled") == 0) {
-           threadLevel = MPI_THREAD_FUNNELED;
-       }
-       else if (strcmp(str,"SINGLE") == 0 || strcmp(str,"single") == 0) {
-           threadLevel = MPI_THREAD_SINGLE;
-       }
-       else {
-           fprintf( stderr, "Unrecognized thread level %s\n", str );
-           /* Use exit since MPI_Init/Init_thread has not been called. */
-           exit(1);
-       }
+        if (strcmp(str, "MULTIPLE") == 0 || strcmp(str, "multiple") == 0) {
+            threadLevel = MPI_THREAD_MULTIPLE;
+        }
+        else if (strcmp(str, "SERIALIZED") == 0 || strcmp(str, "serialized") == 0) {
+            threadLevel = MPI_THREAD_SERIALIZED;
+        }
+        else if (strcmp(str, "FUNNELED") == 0 || strcmp(str, "funneled") == 0) {
+            threadLevel = MPI_THREAD_FUNNELED;
+        }
+        else if (strcmp(str, "SINGLE") == 0 || strcmp(str, "single") == 0) {
+            threadLevel = MPI_THREAD_SINGLE;
+        }
+        else {
+            fprintf(stderr, "Unrecognized thread level %s\n", str);
+            /* Use exit since MPI_Init/Init_thread has not been called. */
+            exit(1);
+        }
     }
     }
-    MTest_Init_thread( argc, argv, threadLevel, &provided );
+    MTest_Init_thread(argc, argv, threadLevel, &provided);
 #else
     /* If the MPI_VERSION is 1, there is no MPI_THREAD_xxx defined */
 #else
     /* If the MPI_VERSION is 1, there is no MPI_THREAD_xxx defined */
-    MTest_Init_thread( argc, argv, 0, &provided );
-#endif    
+    MTest_Init_thread(argc, argv, 0, &provided);
+#endif
 }
 
 /*
 }
 
 /*
-  Finalize MTest.  errs is the number of errors on the calling process; 
+  Finalize MTest.  errs is the number of errors on the calling process;
   this routine will write the total number of errors over all of MPI_COMM_WORLD
   to the process with rank zero, or " No Errors".
   It does *not* finalize MPI.
  */
   this routine will write the total number of errors over all of MPI_COMM_WORLD
   to the process with rank zero, or " No Errors".
   It does *not* finalize MPI.
  */
-void MTest_Finalize( int errs )
+void MTest_Finalize(int errs)
 {
     int rank, toterrs, merr;
 
 {
     int rank, toterrs, merr;
 
-    merr = MPI_Comm_rank( MPI_COMM_WORLD, &rank );
-    if (merr) MTestPrintError( merr );
+    merr = MPI_Comm_rank(MPI_COMM_WORLD, &rank);
+    if (merr)
+        MTestPrintError(merr);
 
 
-    merr = MPI_Reduce( &errs, &toterrs, 1, MPI_INT, MPI_SUM, 
-                     0, MPI_COMM_WORLD );
-    if (merr) MTestPrintError( merr );
+    merr = MPI_Reduce(&errs, &toterrs, 1, MPI_INT, MPI_SUM, 0, MPI_COMM_WORLD);
+    if (merr)
+        MTestPrintError(merr);
     if (rank == 0) {
     if (rank == 0) {
-       if (toterrs) {
-           printf( " Found %d errors\n", toterrs );
-       }
-       else {
-           printf( " No Errors\n" );
-       }
-       fflush( stdout );
+        if (toterrs) {
+            printf(" Found %d errors\n", toterrs);
+        }
+        else {
+            printf(" No Errors\n");
+        }
+        fflush(stdout);
     }
     }
-    
+
     if (SMPI_VARGET_GLOBAL(usageOutput))
     if (SMPI_VARGET_GLOBAL(usageOutput))
-       MTestResourceSummary( stdout );
+        MTestResourceSummary(stdout);
 
 
     /* Clean up any persistent objects that we allocated */
     MTestRMACleanup();
 }
 
 
     /* Clean up any persistent objects that we allocated */
     MTestRMACleanup();
 }
+
 /* ------------------------------------------------------------------------ */
 /* ------------------------------------------------------------------------ */
-/* This routine may be used instead of "return 0;" at the end of main; 
-   it allows the program to use the return value to signal success or failure. 
+/* This routine may be used instead of "return 0;" at the end of main;
+   it allows the program to use the return value to signal success or failure.
  */
  */
-int MTestReturnValue( int errors )
+int MTestReturnValue(int errors)
 {
 {
-    if (SMPI_VARGET_GLOBAL(returnWithVal)) return errors ? 1 : 0;
+    if (SMPI_VARGET_GLOBAL(returnWithVal))
+        return errors ? 1 : 0;
     return 0;
 }
     return 0;
 }
+
 /* ------------------------------------------------------------------------ */
 
 /*
  * Miscellaneous utilities, particularly to eliminate OS dependencies
  * from the tests.
 /* ------------------------------------------------------------------------ */
 
 /*
  * Miscellaneous utilities, particularly to eliminate OS dependencies
  * from the tests.
- * MTestSleep( seconds )
+ * MTestSleep(seconds)
  */
 #ifdef HAVE_WINDOWS_H
 #include <windows.h>
  */
 #ifdef HAVE_WINDOWS_H
 #include <windows.h>
-void MTestSleep( int sec )
+void MTestSleep(int sec)
 {
 {
-    Sleep( 1000 * sec );
+    Sleep(1000 * sec);
 }
 #else
 #include <unistd.h>
 }
 #else
 #include <unistd.h>
-void MTestSleep( int sec )
-{
-    sleep( sec );
-}
-#endif
-
-/*
- * Datatypes
- *
- * Eventually, this could read a description of a file.  For now, we hard 
- * code the choices.
- *
- * Each kind of datatype has the following functions:
- *    MTestTypeXXXInit     - Initialize a send buffer for that type
- *    MTestTypeXXXInitRecv - Initialize a receive buffer for that type
- *    MTestTypeXXXFree     - Free any buffers associate with that type
- *    MTestTypeXXXCheckbuf - Check that the buffer contains the expected data
- * These routines work with (nearly) any datatype that is of type XXX, 
- * allowing the test codes to create a variety of contiguous, vector, and
- * indexed types, then test them by calling these routines.
- *
- * Available types (for the XXX) are
- *    Contig   - Simple contiguous buffers
- *    Vector   - Simple strided "vector" type
- *    Indexed  - Indexed datatype.  Only for a count of 1 instance of the 
- *               datatype
- */
-SMPI_VARINIT_GLOBAL_AND_SET(datatype_index, int, 0);
-
-/* ------------------------------------------------------------------------ */
-/* Datatype routines for contiguous datatypes                               */
-/* ------------------------------------------------------------------------ */
-/* 
- * Setup contiguous buffers of n copies of a datatype.
- */
-static void *MTestTypeContigInit( MTestDatatype *mtype )
-{
-    MPI_Aint size;
-    int merr;
-
-    if (mtype->count > 0) {
-       signed char *p;
-       int  i, totsize;
-       merr = MPI_Type_extent( mtype->datatype, &size );
-       if (merr) MTestPrintError( merr );
-       totsize = size * mtype->count;
-       if (!mtype->buf) {
-           mtype->buf = (void *) malloc( totsize );
-       }
-       p = (signed char *)(mtype->buf);
-       if (!p) {
-           /* Error - out of memory */
-           MTestError( "Out of memory in type buffer init" );
-       }
-       for (i=0; i<totsize; i++) {
-           p[i] = 0xff ^ (i & 0xff);
-       }
-    }
-    else {
-       if (mtype->buf) {
-           free( mtype->buf );
-       }
-       mtype->buf = 0;
-    }
-    return mtype->buf;
-}
-
-/* 
- * Setup contiguous buffers of n copies of a datatype.  Initialize for
- * reception (e.g., set initial data to detect failure)
- */
-static void *MTestTypeContigInitRecv( MTestDatatype *mtype )
-{
-    MPI_Aint size;
-    int      merr;
-
-    if (mtype->count > 0) {
-       signed char *p;
-       int  i, totsize;
-       merr = MPI_Type_extent( mtype->datatype, &size );
-       if (merr) MTestPrintError( merr );
-       totsize = size * mtype->count;
-       if (!mtype->buf) {
-           mtype->buf = (void *) malloc( totsize );
-       }
-       p = (signed char *)(mtype->buf);
-       if (!p) {
-           /* Error - out of memory */
-           MTestError( "Out of memory in type buffer init" );
-       }
-       for (i=0; i<totsize; i++) {
-           p[i] = 0xff;
-       }
-    }
-    else {
-       if (mtype->buf) {
-           free( mtype->buf );
-       }
-       mtype->buf = 0;
-    }
-    return mtype->buf;
-}
-static void *MTestTypeContigFree( MTestDatatype *mtype )
-{
-    if (mtype->buf) {
-       free( mtype->buf );
-       mtype->buf = 0;
-    }
-    return 0;
-}
-static int MTestTypeContigCheckbuf( MTestDatatype *mtype )
-{
-    unsigned char *p;
-    unsigned char expected;
-    int  i, totsize, err = 0, merr;
-    MPI_Aint size;
-
-    p = (unsigned char *)mtype->buf;
-    if (p) {
-       merr = MPI_Type_extent( mtype->datatype, &size );
-       if (merr) MTestPrintError( merr );
-       totsize = size * mtype->count;
-       for (i=0; i<totsize; i++) {
-           expected = (0xff ^ (i & 0xff));
-           if (p[i] != expected) {
-               err++;
-               if (mtype->printErrors && err < 10) {
-                   printf( "Data expected = %x but got p[%d] = %x\n",
-                           expected, i, p[i] );
-                   fflush( stdout );
-               }
-           }
-       }
-    }
-    return err;
-}
-
-/* ------------------------------------------------------------------------ */
-/* Datatype routines for vector datatypes                                   */
-/* ------------------------------------------------------------------------ */
-
-static void *MTestTypeVectorInit( MTestDatatype *mtype )
-{
-    MPI_Aint size;
-    int      merr;
-
-    if (mtype->count > 0) {
-       unsigned char *p;
-       int  i, j, k, nc, totsize;
-
-       merr = MPI_Type_extent( mtype->datatype, &size );
-       if (merr) MTestPrintError( merr );
-       totsize    = mtype->count * size;
-       if (!mtype->buf) {
-           mtype->buf = (void *) malloc( totsize );
-       }
-       p          = (unsigned char *)(mtype->buf);
-       if (!p) {
-           /* Error - out of memory */
-           MTestError( "Out of memory in type buffer init" );
-       }
-
-       /* First, set to -1 */
-       for (i=0; i<totsize; i++) p[i] = 0xff;
-
-       /* Now, set the actual elements to the successive values.
-          To do this, we need to run 3 loops */
-       nc = 0;
-       /* count is usually one for a vector type */
-       for (k=0; k<mtype->count; k++) {
-           /* For each element (block) */
-           for (i=0; i<mtype->nelm; i++) {
-               /* For each value */
-               for (j=0; j<mtype->blksize; j++) {
-                   p[j] = (0xff ^ (nc & 0xff));
-                   nc++;
-               }
-               p += mtype->stride;
-           }
-       }
-    }
-    else {
-       mtype->buf = 0;
-    }
-    return mtype->buf;
-}
-
-static void *MTestTypeVectorFree( MTestDatatype *mtype )
-{
-    if (mtype->buf) {
-       free( mtype->buf );
-       mtype->buf = 0;
-    }
-    return 0;
-}
-
-/* ------------------------------------------------------------------------ */
-/* Datatype routines for indexed block datatypes                            */
-/* ------------------------------------------------------------------------ */
-
-/* 
- * Setup a buffer for one copy of an indexed datatype. 
- */
-static void *MTestTypeIndexedInit( MTestDatatype *mtype )
-{
-    MPI_Aint totsize;
-    int      merr;
-    
-    if (mtype->count > 1) {
-       MTestError( "This datatype is supported only for a single count" );
-    }
-    if (mtype->count == 1) {
-       signed char *p;
-       int  i, k, offset, j;
-
-       /* Allocate the send/recv buffer */
-       merr = MPI_Type_extent( mtype->datatype, &totsize );
-       if (merr) MTestPrintError( merr );
-       if (!mtype->buf) {
-           mtype->buf = (void *) malloc( totsize );
-       }
-       p = (signed char *)(mtype->buf);
-       if (!p) {
-           MTestError( "Out of memory in type buffer init\n" );
-       }
-       /* Initialize the elements */
-       /* First, set to -1 */
-       for (i=0; i<totsize; i++) p[i] = 0xff;
-
-       /* Now, set the actual elements to the successive values.
-          We require that the base type is a contiguous type */
-       k = 0;
-       for (i=0; i<mtype->nelm; i++) {
-           int b;
-           /* Compute the offset: */
-           offset = mtype->displs[i] * mtype->basesize;
-           /* For each element in the block */
-           for (b=0; b<mtype->index[i]; b++) {
-               for (j=0; j<mtype->basesize; j++) {
-                   p[offset+j] = 0xff ^ (k++ & 0xff);
-               }
-               offset += mtype->basesize;
-           }
-       }
-    }
-    else {
-       /* count == 0 */
-       if (mtype->buf) {
-           free( mtype->buf );
-       }
-       mtype->buf = 0;
-    }
-    return mtype->buf;
-}
-
-/* 
- * Setup indexed buffers for 1 copy of a datatype.  Initialize for
- * reception (e.g., set initial data to detect failure)
- */
-static void *MTestTypeIndexedInitRecv( MTestDatatype *mtype )
+void MTestSleep(int sec)
 {
 {
-    MPI_Aint totsize;
-    int      merr;
-
-    if (mtype->count > 1) {
-       MTestError( "This datatype is supported only for a single count" );
-    }
-    if (mtype->count == 1) {
-       signed char *p;
-       int  i;
-       merr = MPI_Type_extent( mtype->datatype, &totsize );
-       if (merr) MTestPrintError( merr );
-       if (!mtype->buf) {
-           mtype->buf = (void *) malloc( totsize );
-       }
-       p = (signed char *)(mtype->buf);
-       if (!p) {
-           /* Error - out of memory */
-           MTestError( "Out of memory in type buffer init\n" );
-       }
-       for (i=0; i<totsize; i++) {
-           p[i] = 0xff;
-       }
-    }
-    else {
-       /* count == 0 */
-       if (mtype->buf) {
-           free( mtype->buf );
-       }
-       mtype->buf = 0;
-    }
-    return mtype->buf;
+    sleep(sec);
 }
 }
-
-static void *MTestTypeIndexedFree( MTestDatatype *mtype )
-{
-    if (mtype->buf) {
-       free( mtype->buf );
-       free( mtype->displs );
-       free( mtype->index );
-       mtype->buf    = 0;
-       mtype->displs = 0;
-       mtype->index  = 0;
-    }
-    return 0;
-}
-
-static int MTestTypeIndexedCheckbuf( MTestDatatype *mtype )
-{
-    unsigned char *p;
-    unsigned char expected;
-    int  i, err = 0, merr;
-    MPI_Aint totsize;
-
-    p = (unsigned char *)mtype->buf;
-    if (p) {
-       int j, k, offset;
-       merr = MPI_Type_extent( mtype->datatype, &totsize );
-       if (merr) MTestPrintError( merr );
-       
-       k = 0;
-       for (i=0; i<mtype->nelm; i++) {
-           int b;
-           /* Compute the offset: */
-           offset = mtype->displs[i] * mtype->basesize;
-           for (b=0; b<mtype->index[i]; b++) {
-               for (j=0; j<mtype->basesize; j++) {
-                   expected = (0xff ^ (k & 0xff));
-                   if (p[offset+j] != expected) {
-                       err++;
-                       if (mtype->printErrors && err < 10) {
-                           printf( "Data expected = %x but got p[%d,%d] = %x\n",
-                                   expected, i,j, p[offset+j] );
-                           fflush( stdout );
-                       }
-                   }
-                   k++;
-               }
-               offset += mtype->basesize;
-           }
-       }
-    }
-    return err;
-}
-
-
-/* ------------------------------------------------------------------------ */
-/* Routines to select a datatype and associated buffer create/fill/check    */
-/* routines                                                                 */
-/* ------------------------------------------------------------------------ */
-
-/* 
-   Create a range of datatypes with a given count elements.
-   This uses a selection of types, rather than an exhaustive collection.
-   It allocates both send and receive types so that they can have the same
-   type signature (collection of basic types) but different type maps (layouts
-   in memory) 
- */
-int MTestGetDatatypes( MTestDatatype *sendtype, MTestDatatype *recvtype,
-                      int count )
-{
-    int merr;
-    int i;
-
-    sendtype->InitBuf    = 0;
-    sendtype->FreeBuf    = 0;
-    sendtype->CheckBuf   = 0;
-    sendtype->datatype   = 0;
-    sendtype->isBasic    = 0;
-    sendtype->printErrors = 0;
-    recvtype->InitBuf    = 0;
-    recvtype->FreeBuf    = 0;
-
-    recvtype->CheckBuf   = 0;
-    recvtype->datatype   = 0;
-    recvtype->isBasic    = 0;
-    recvtype->printErrors = 0;
-
-    sendtype->buf        = 0;
-    recvtype->buf        = 0;
-
-    /* Set the defaults for the message lengths */
-    sendtype->count      = count;
-    recvtype->count      = count;
-    /* Use datatype_index to choose a datatype to use.  If at the end of the
-       list, return 0 */
-    switch (SMPI_VARGET_GLOBAL(datatype_index)) {
-    case 0:
-       sendtype->datatype = MPI_INT;
-       sendtype->isBasic  = 1;
-       recvtype->datatype = MPI_INT;
-       recvtype->isBasic  = 1;
-       break;
-    case 1:
-       sendtype->datatype = MPI_DOUBLE;
-       sendtype->isBasic  = 1;
-       recvtype->datatype = MPI_DOUBLE;
-       recvtype->isBasic  = 1;
-       break;
-    case 2:
-       sendtype->datatype = MPI_FLOAT_INT;
-       sendtype->isBasic  = 1;
-       recvtype->datatype = MPI_FLOAT_INT;
-       recvtype->isBasic  = 1;
-       break;
-    case 3:
-       merr = MPI_Type_dup( MPI_INT, &sendtype->datatype );
-       if (merr) MTestPrintError( merr );
-       merr = MPI_Type_set_name( sendtype->datatype,
-                                  (char*)"dup of MPI_INT" );
-       if (merr) MTestPrintError( merr );
-       merr = MPI_Type_dup( MPI_INT, &recvtype->datatype );
-       if (merr) MTestPrintError( merr );
-       merr = MPI_Type_set_name( recvtype->datatype,
-                                  (char*)"dup of MPI_INT" );
-       if (merr) MTestPrintError( merr );
-       /* dup'ed types are already committed if the original type 
-          was committed (MPI-2, section 8.8) */
-       break;
-    case 4:
-       /* vector send type and contiguous receive type */
-       /* These sizes are in bytes (see the VectorInit code) */
-       sendtype->stride   = 3 * sizeof(int);
-       sendtype->blksize  = sizeof(int);
-       sendtype->nelm     = recvtype->count;
-
-       merr = MPI_Type_vector( recvtype->count, 1, 3, MPI_INT, 
-                               &sendtype->datatype );
-       if (merr) MTestPrintError( merr );
-        merr = MPI_Type_commit( &sendtype->datatype );
-       if (merr) MTestPrintError( merr );
-       merr = MPI_Type_set_name( sendtype->datatype,
-                                  (char*)"int-vector" );
-       if (merr) MTestPrintError( merr );
-       sendtype->count    = 1;
-       recvtype->datatype = MPI_INT;
-       recvtype->isBasic  = 1;
-       sendtype->InitBuf  = MTestTypeVectorInit;
-       recvtype->InitBuf  = MTestTypeContigInitRecv;
-       sendtype->FreeBuf  = MTestTypeVectorFree;
-       recvtype->FreeBuf  = MTestTypeContigFree;
-       sendtype->CheckBuf = 0;
-       recvtype->CheckBuf = MTestTypeContigCheckbuf;
-       break;
-
-    case 5:
-       /* Indexed send using many small blocks and contig receive */
-       sendtype->blksize  = sizeof(int);
-       sendtype->nelm     = recvtype->count;
-       sendtype->basesize = sizeof(int);
-       sendtype->displs   = (int *)malloc( sendtype->nelm * sizeof(int) );
-       sendtype->index    = (int *)malloc( sendtype->nelm * sizeof(int) );
-       if (!sendtype->displs || !sendtype->index) {
-           MTestError( "Out of memory in type init\n" );
-       }
-       /* Make the sizes larger (4 ints) to help push the total
-          size to over 256k in some cases, as the MPICH code as of
-          10/1/06 used large internal buffers for packing non-contiguous
-          messages */
-       for (i=0; i<sendtype->nelm; i++) {
-           sendtype->index[i]   = 4;
-           sendtype->displs[i]  = 5*i;
-       }
-       merr = MPI_Type_indexed( sendtype->nelm,
-                                sendtype->index, sendtype->displs, 
-                                MPI_INT, &sendtype->datatype );
-       if (merr) MTestPrintError( merr );
-        merr = MPI_Type_commit( &sendtype->datatype );
-       if (merr) MTestPrintError( merr );
-       merr = MPI_Type_set_name( sendtype->datatype,
-                                  (char*)"int-indexed(4-int)" );
-       if (merr) MTestPrintError( merr );
-       sendtype->count    = 1;
-       sendtype->InitBuf  = MTestTypeIndexedInit;
-       sendtype->FreeBuf  = MTestTypeIndexedFree;
-       sendtype->CheckBuf = 0;
-
-       recvtype->datatype = MPI_INT;
-       recvtype->isBasic  = 1;
-       recvtype->count    = count * 4;
-       recvtype->InitBuf  = MTestTypeContigInitRecv;
-       recvtype->FreeBuf  = MTestTypeContigFree;
-       recvtype->CheckBuf = MTestTypeContigCheckbuf;
-       break;
-
-    case 6:
-       /* Indexed send using 2 large blocks and contig receive */
-       sendtype->blksize  = sizeof(int);
-       sendtype->nelm     = 2;
-       sendtype->basesize = sizeof(int);
-       sendtype->displs   = (int *)malloc( sendtype->nelm * sizeof(int) );
-       sendtype->index    = (int *)malloc( sendtype->nelm * sizeof(int) );
-       if (!sendtype->displs || !sendtype->index) {
-           MTestError( "Out of memory in type init\n" );
-       }
-       /* index -> block size */
-       sendtype->index[0]   = (recvtype->count + 1) / 2;
-       sendtype->displs[0]  = 0;
-       sendtype->index[1]   = recvtype->count - sendtype->index[0];
-       sendtype->displs[1]  = sendtype->index[0] + 1; 
-       /* There is a deliberate gap here */
-
-       merr = MPI_Type_indexed( sendtype->nelm,
-                                sendtype->index, sendtype->displs, 
-                                MPI_INT, &sendtype->datatype );
-       if (merr) MTestPrintError( merr );
-        merr = MPI_Type_commit( &sendtype->datatype );
-       if (merr) MTestPrintError( merr );
-       merr = MPI_Type_set_name( sendtype->datatype,
-                                  (char*)"int-indexed(2 blocks)" );
-       if (merr) MTestPrintError( merr );
-       sendtype->count    = 1;
-       sendtype->InitBuf  = MTestTypeIndexedInit;
-       sendtype->FreeBuf  = MTestTypeIndexedFree;
-       sendtype->CheckBuf = 0;
-
-       recvtype->datatype = MPI_INT;
-       recvtype->isBasic  = 1;
-       recvtype->count    = sendtype->index[0] + sendtype->index[1];
-       recvtype->InitBuf  = MTestTypeContigInitRecv;
-       recvtype->FreeBuf  = MTestTypeContigFree;
-       recvtype->CheckBuf = MTestTypeContigCheckbuf;
-       break;
-
-    case 7:
-       /* Indexed receive using many small blocks and contig send */
-       recvtype->blksize  = sizeof(int);
-       recvtype->nelm     = recvtype->count;
-       recvtype->basesize = sizeof(int);
-       recvtype->displs   = (int *)malloc( recvtype->nelm * sizeof(int) );
-       recvtype->index    = (int *)malloc( recvtype->nelm * sizeof(int) );
-       if (!recvtype->displs || !recvtype->index) {
-           MTestError( "Out of memory in type recv init\n" );
-       }
-       /* Make the sizes larger (4 ints) to help push the total
-          size to over 256k in some cases, as the MPICH code as of
-          10/1/06 used large internal buffers for packing non-contiguous
-          messages */
-       /* Note that there are gaps in the indexed type */
-       for (i=0; i<recvtype->nelm; i++) {
-           recvtype->index[i]   = 4;
-           recvtype->displs[i]  = 5*i;
-       }
-       merr = MPI_Type_indexed( recvtype->nelm,
-                                recvtype->index, recvtype->displs, 
-                                MPI_INT, &recvtype->datatype );
-       if (merr) MTestPrintError( merr );
-        merr = MPI_Type_commit( &recvtype->datatype );
-       if (merr) MTestPrintError( merr );
-       merr = MPI_Type_set_name( recvtype->datatype,
-                                  (char*)"recv-int-indexed(4-int)" );
-       if (merr) MTestPrintError( merr );
-       recvtype->count    = 1;
-       recvtype->InitBuf  = MTestTypeIndexedInitRecv;
-       recvtype->FreeBuf  = MTestTypeIndexedFree;
-       recvtype->CheckBuf = MTestTypeIndexedCheckbuf;
-
-       sendtype->datatype = MPI_INT;
-       sendtype->isBasic  = 1;
-       sendtype->count    = count * 4;
-       sendtype->InitBuf  = MTestTypeContigInit;
-       sendtype->FreeBuf  = MTestTypeContigFree;
-       sendtype->CheckBuf = 0;
-       break;
-
-       /* Less commonly used but still simple types */
-    case 8:
-       sendtype->datatype = MPI_SHORT;
-       sendtype->isBasic  = 1;
-       recvtype->datatype = MPI_SHORT;
-       recvtype->isBasic  = 1;
-       break;
-    case 9:
-       sendtype->datatype = MPI_LONG;
-       sendtype->isBasic  = 1;
-       recvtype->datatype = MPI_LONG;
-       recvtype->isBasic  = 1;
-       break;
-    case 10:
-       sendtype->datatype = MPI_CHAR;
-       sendtype->isBasic  = 1;
-       recvtype->datatype = MPI_CHAR;
-       recvtype->isBasic  = 1;
-       break;
-    case 11:
-       sendtype->datatype = MPI_UINT64_T;
-       sendtype->isBasic  = 1;
-       recvtype->datatype = MPI_UINT64_T;
-       recvtype->isBasic  = 1;
-       break;
-    case 12:
-       sendtype->datatype = MPI_FLOAT;
-       sendtype->isBasic  = 1;
-       recvtype->datatype = MPI_FLOAT;
-       recvtype->isBasic  = 1;
-       break;
-
-#ifndef USE_STRICT_MPI
-       /* MPI_BYTE may only be used with MPI_BYTE in strict MPI */
-    case 13:
-       sendtype->datatype = MPI_INT;
-       sendtype->isBasic  = 1;
-       recvtype->datatype = MPI_BYTE;
-       recvtype->isBasic  = 1;
-       recvtype->count    *= sizeof(int);
-       break;
 #endif
 #endif
-    default:
-       SMPI_VARGET_GLOBAL(datatype_index) = -1;
-    }
-
-    if (!sendtype->InitBuf) {
-       sendtype->InitBuf  = MTestTypeContigInit;
-       recvtype->InitBuf  = MTestTypeContigInitRecv;
-       sendtype->FreeBuf  = MTestTypeContigFree;
-       recvtype->FreeBuf  = MTestTypeContigFree;
-       sendtype->CheckBuf = MTestTypeContigCheckbuf;
-       recvtype->CheckBuf = MTestTypeContigCheckbuf;
-    }
-    SMPI_VARGET_GLOBAL(datatype_index)++;
-
-    if (SMPI_VARGET_GLOBAL(dbgflag) && SMPI_VARGET_GLOBAL(datatype_index) > 0) {
-       int typesize;
-       fprintf( stderr, "%d: sendtype is %s\n", SMPI_VARGET_GLOBAL(wrank), MTestGetDatatypeName( sendtype ) );
-       merr = MPI_Type_size( sendtype->datatype, &typesize );
-       if (merr) MTestPrintError( merr );
-       fprintf( stderr, "%d: sendtype size = %d\n", SMPI_VARGET_GLOBAL(wrank), typesize );
-       fprintf( stderr, "%d: recvtype is %s\n", SMPI_VARGET_GLOBAL(wrank), MTestGetDatatypeName( recvtype ) );
-       merr = MPI_Type_size( recvtype->datatype, &typesize );
-       if (merr) MTestPrintError( merr );
-       fprintf( stderr, "%d: recvtype size = %d\n", SMPI_VARGET_GLOBAL(wrank), typesize );
-       fflush( stderr );
-       
-    }
-    else if (SMPI_VARGET_GLOBAL(verbose) && SMPI_VARGET_GLOBAL(datatype_index) > 0) {
-       printf( "Get new datatypes: send = %s, recv = %s\n", 
-               MTestGetDatatypeName( sendtype ), 
-               MTestGetDatatypeName( recvtype ) );
-       fflush( stdout );
-    }
-
-    return SMPI_VARGET_GLOBAL(datatype_index);
-}
-
-/* Reset the datatype index (start from the initial data type.
-   Note: This routine is rarely needed; MTestGetDatatypes automatically
-   starts over after the last available datatype is used.
-*/
-void MTestResetDatatypes( void )
-{
-    SMPI_VARGET_GLOBAL(datatype_index) = 0;
-}
-/* Return the index of the current datatype.  This is rarely needed and
-   is provided mostly to enable debugging of the MTest package itself */
-int MTestGetDatatypeIndex( void )
-{
-    return SMPI_VARGET_GLOBAL(datatype_index);
-}
-
-/* Free the storage associated with a datatype */
-void MTestFreeDatatype( MTestDatatype *mtype )
-{
-    int merr;
-    /* Invoke a datatype-specific free function to handle
-       both the datatype and the send/receive buffers */
-    if (mtype->FreeBuf) {
-       (mtype->FreeBuf)( mtype );
-    }
-    /* Free the datatype itself if it was created */
-    if (!mtype->isBasic) {
-       merr = MPI_Type_free( &mtype->datatype );
-       if (merr) MTestPrintError( merr );
-    }
-}
 
 
-/* Check that a message was received correctly.  Returns the number of
-   errors detected.  Status may be NULL or MPI_STATUS_IGNORE */
-int MTestCheckRecv( MPI_Status *status, MTestDatatype *recvtype )
+/* Other mtest subfiles read debug setting using this function. */
+void MTestGetDbgInfo(int *_dbgflag, int *_verbose)
 {
 {
-    int count;
-    int errs = 0, merr;
-
-    if (status && status != MPI_STATUS_IGNORE) {
-       merr = MPI_Get_count( status, recvtype->datatype, &count );
-       if (merr) MTestPrintError( merr );
-       
-       /* Check count against expected count */
-       if (count != recvtype->count) {
-           errs ++;
-       }
-    }
-
-    /* Check received data */
-    if (!errs && recvtype->CheckBuf( recvtype )) {
-       errs++;
-    }
-    return errs;
+    *_dbgflag = SMPI_VARGET_GLOBAL(dbgflag);
+    *_verbose = SMPI_VARGET_GLOBAL(verbose);
 }
 
 }
 
-/* This next routine uses a circular buffer of static name arrays just to
-   simplify the use of the routine */
-const char *MTestGetDatatypeName( MTestDatatype *dtype )
-{
-    typedef char name_type[4][MPI_MAX_OBJECT_NAME];
-    SMPI_VARINIT_STATIC(name, name_type);
-    SMPI_VARINIT_STATIC_AND_SET(sp, int, 0);
-    int rlen, merr;
-
-    if (SMPI_VARGET_STATIC(sp) >= 4) SMPI_VARGET_STATIC(sp) = 0;
-    merr = MPI_Type_get_name( dtype->datatype, SMPI_VARGET_STATIC(name)[SMPI_VARGET_STATIC(sp)], &rlen );
-    if (merr) MTestPrintError( merr );
-    return (const char *)SMPI_VARGET_STATIC(name)[SMPI_VARGET_STATIC(sp)++];
-}
 /* ----------------------------------------------------------------------- */
 
 /* ----------------------------------------------------------------------- */
 
-/* 
+/*
  * Create communicators.  Use separate routines for inter and intra
  * communicators (there is a routine to give both)
  * Note that the routines may return MPI_COMM_NULL, so code should test for
  * that return value as well.
  * Create communicators.  Use separate routines for inter and intra
  * communicators (there is a routine to give both)
  * Note that the routines may return MPI_COMM_NULL, so code should test for
  * that return value as well.
- * 
+ *
  */
  */
-SMPI_VARINIT_GLOBAL_AND_SET(interCommIdx, int, 0);
-SMPI_VARINIT_GLOBAL_AND_SET(intraCommIdx, int, 0);
-SMPI_VARINIT_GLOBAL_AND_SET(intraCommName, const char *, 0);
-SMPI_VARINIT_GLOBAL_AND_SET(interCommName, const char *, 0);
+static int interCommIdx = 0;
+static int intraCommIdx = 0;
+static const char *intraCommName = 0;
+static const char *interCommName = 0;
 
 
-/* 
+/*
  * Get an intracommunicator with at least min_size members.  If "allowSmaller"
  * is true, allow the communicator to be smaller than MPI_COMM_WORLD and
  * for this routine to return MPI_COMM_NULL for some values.  Returns 0 if
  * no more communicators are available.
  */
  * Get an intracommunicator with at least min_size members.  If "allowSmaller"
  * is true, allow the communicator to be smaller than MPI_COMM_WORLD and
  * for this routine to return MPI_COMM_NULL for some values.  Returns 0 if
  * no more communicators are available.
  */
-int MTestGetIntracommGeneral( MPI_Comm *comm, int min_size, int allowSmaller )
+int MTestGetIntracommGeneral(MPI_Comm * comm, int min_size, int allowSmaller)
 {
     int size, rank, merr;
 {
     int size, rank, merr;
-    int done2, done=0;
+    int done = 0;
     int isBasic = 0;
 
     /* The while loop allows us to skip communicators that are too small.
     int isBasic = 0;
 
     /* The while loop allows us to skip communicators that are too small.
-       MPI_COMM_NULL is always considered large enough */
+     * MPI_COMM_NULL is always considered large enough */
     while (!done) {
     while (!done) {
-       isBasic = 0;
-       SMPI_VARGET_GLOBAL(intraCommName) = "";
-       switch (SMPI_VARGET_GLOBAL(intraCommIdx)) {
-       case 0:
-           *comm = MPI_COMM_WORLD;
-           isBasic = 1;
-           SMPI_VARGET_GLOBAL(intraCommName) = "MPI_COMM_WORLD";
-           break;
-       case 1:
-           /* dup of world */
-           merr = MPI_Comm_dup(MPI_COMM_WORLD, comm );
-           if (merr) MTestPrintError( merr );
-           SMPI_VARGET_GLOBAL(intraCommName) = "Dup of MPI_COMM_WORLD";
-           break;
-       case 2:
-           /* reverse ranks */
-           merr = MPI_Comm_size( MPI_COMM_WORLD, &size );
-           if (merr) MTestPrintError( merr );
-           merr = MPI_Comm_rank( MPI_COMM_WORLD, &rank );
-           if (merr) MTestPrintError( merr );
-           merr = MPI_Comm_split( MPI_COMM_WORLD, 0, size-rank, comm );
-           if (merr) MTestPrintError( merr );
-           SMPI_VARGET_GLOBAL(intraCommName) = "Rank reverse of MPI_COMM_WORLD";
-           break;
-       case 3:
-           /* subset of world, with reversed ranks */
-           merr = MPI_Comm_size( MPI_COMM_WORLD, &size );
-           if (merr) MTestPrintError( merr );
-           merr = MPI_Comm_rank( MPI_COMM_WORLD, &rank );
-           if (merr) MTestPrintError( merr );
-           merr = MPI_Comm_split( MPI_COMM_WORLD, ((rank < size/2) ? 1 : MPI_UNDEFINED),
-                                  size-rank, comm );
-           if (merr) MTestPrintError( merr );
-           SMPI_VARGET_GLOBAL(intraCommName) = "Rank reverse of half of MPI_COMM_WORLD";
-           break;
-       case 4:
-           *comm = MPI_COMM_SELF;
-           isBasic = 1;
-           SMPI_VARGET_GLOBAL(intraCommName) = "MPI_COMM_SELF";
-           break;
-
-           /* These next cases are communicators that include some
-              but not all of the processes */
-       case 5:
-       case 6:
-       case 7:
-       case 8:
-       {
-           int newsize;
-           merr = MPI_Comm_size( MPI_COMM_WORLD, &size );
-           if (merr) MTestPrintError( merr );
-           newsize = size - (SMPI_VARGET_GLOBAL(intraCommIdx) - 4);
-           
-           if (allowSmaller && newsize >= min_size) {
-               merr = MPI_Comm_rank( MPI_COMM_WORLD, &rank );
-               if (merr) MTestPrintError( merr );
-               merr = MPI_Comm_split( MPI_COMM_WORLD, rank < newsize, rank, 
-                                      comm );
-               if (merr) MTestPrintError( merr );
-               if (rank >= newsize) {
-                   merr = MPI_Comm_free( comm );
-                   if (merr) MTestPrintError( merr );
-                   *comm = MPI_COMM_NULL;
-               }
-               else {
-                   SMPI_VARGET_GLOBAL(intraCommName) = "Split of WORLD";
-               }
-           }
-           else {
-               /* Act like default */
-               *comm = MPI_COMM_NULL;
-               SMPI_VARGET_GLOBAL(intraCommIdx) = -1;
-           }
-       }
-       break;
-           
-           /* Other ideas: dup of self, cart comm, graph comm */
-       default:
-           *comm = MPI_COMM_NULL;
-           SMPI_VARGET_GLOBAL(intraCommIdx) = -1;
-           break;
-       }
-
-       if (*comm != MPI_COMM_NULL) {
-           merr = MPI_Comm_size( *comm, &size );
-           if (merr) MTestPrintError( merr );
-           if (size >= min_size)
-               done = 1;
-       }
+        isBasic = 0;
+        intraCommName = "";
+        switch (intraCommIdx) {
+        case 0:
+            *comm = MPI_COMM_WORLD;
+            isBasic = 1;
+            intraCommName = "MPI_COMM_WORLD";
+            break;
+        case 1:
+            /* dup of world */
+            merr = MPI_Comm_dup(MPI_COMM_WORLD, comm);
+            if (merr)
+                MTestPrintError(merr);
+            intraCommName = "Dup of MPI_COMM_WORLD";
+            break;
+        case 2:
+            /* reverse ranks */
+            merr = MPI_Comm_size(MPI_COMM_WORLD, &size);
+            if (merr)
+                MTestPrintError(merr);
+            merr = MPI_Comm_rank(MPI_COMM_WORLD, &rank);
+            if (merr)
+                MTestPrintError(merr);
+            merr = MPI_Comm_split(MPI_COMM_WORLD, 0, size - rank, comm);
+            if (merr)
+                MTestPrintError(merr);
+            intraCommName = "Rank reverse of MPI_COMM_WORLD";
+            break;
+        case 3:
+            /* subset of world, with reversed ranks */
+            merr = MPI_Comm_size(MPI_COMM_WORLD, &size);
+            if (merr)
+                MTestPrintError(merr);
+            merr = MPI_Comm_rank(MPI_COMM_WORLD, &rank);
+            if (merr)
+                MTestPrintError(merr);
+            merr = MPI_Comm_split(MPI_COMM_WORLD, ((rank < size / 2) ? 1 : MPI_UNDEFINED),
+                                  size - rank, comm);
+            if (merr)
+                MTestPrintError(merr);
+            intraCommName = "Rank reverse of half of MPI_COMM_WORLD";
+            break;
+        case 4:
+            *comm = MPI_COMM_SELF;
+            isBasic = 1;
+            intraCommName = "MPI_COMM_SELF";
+            break;
+        case 5:
+            {
+#if MTEST_HAVE_MIN_MPI_VERSION(3,0)
+                /* Dup of the world using MPI_Intercomm_merge */
+                int rleader, isLeft;
+                MPI_Comm local_comm, inter_comm;
+                MPI_Comm_size(MPI_COMM_WORLD, &size);
+                MPI_Comm_rank(MPI_COMM_WORLD, &rank);
+                if (size > 1) {
+                    merr = MPI_Comm_split(MPI_COMM_WORLD, (rank < size / 2), rank, &local_comm);
+                    if (merr)
+                        MTestPrintError(merr);
+                    if (rank == 0) {
+                        rleader = size / 2;
+                    }
+                    else if (rank == size / 2) {
+                        rleader = 0;
+                    }
+                    else {
+                        rleader = -1;
+                    }
+                    isLeft = rank < size / 2;
+                    merr =
+                        MPI_Intercomm_create(local_comm, 0, MPI_COMM_WORLD, rleader, 99,
+                                             &inter_comm);
+                    if (merr)
+                        MTestPrintError(merr);
+                    merr = MPI_Intercomm_merge(inter_comm, isLeft, comm);
+                    if (merr)
+                        MTestPrintError(merr);
+                    MPI_Comm_free(&inter_comm);
+                    MPI_Comm_free(&local_comm);
+                    intraCommName = "Dup of WORLD created by MPI_Intercomm_merge";
+                }
+                else {
+                    *comm = MPI_COMM_NULL;
+                }
+            }
+            break;
+        case 6:
+            {
+                /* Even of the world using MPI_Comm_create_group */
+                int i;
+                MPI_Group world_group, even_group;
+                int *excl = NULL;
+
+                MPI_Comm_size(MPI_COMM_WORLD, &size);
+                MPI_Comm_rank(MPI_COMM_WORLD, &rank);
+                if (allowSmaller && (size + 1) / 2 >= min_size) {
+                    /* exclude the odd ranks */
+                    excl = malloc((size / 2) * sizeof(int));
+                    for (i = 0; i < size / 2; i++)
+                        excl[i] = (2 * i) + 1;
+
+                    MPI_Comm_group(MPI_COMM_WORLD, &world_group);
+                    MPI_Group_excl(world_group, size / 2, excl, &even_group);
+                    MPI_Group_free(&world_group);
+                    free(excl);
+
+                    if (rank % 2 == 0) {
+                        /* Even processes create a comm. for themselves */
+                        MPI_Comm_create_group(MPI_COMM_WORLD, even_group, 0, comm);
+                        intraCommName = "Even of WORLD created by MPI_Comm_create_group";
+                    }
+                    else {
+                        *comm = MPI_COMM_NULL;
+                    }
+
+                    MPI_Group_free(&even_group);
+                }
+                else {
+                    *comm = MPI_COMM_NULL;
+                }
+#else
+                *comm = MPI_COMM_NULL;
+#endif
+            }
+            break;
+        case 7:
+            {
+                /* High half of the world using MPI_Comm_create */
+                int ranges[1][3];
+                MPI_Group world_group, high_group;
+                MPI_Comm_size(MPI_COMM_WORLD, &size);
+                MPI_Comm_rank(MPI_COMM_WORLD, &rank);
+                ranges[0][0] = size / 2;
+                ranges[0][1] = size - 1;
+                ranges[0][2] = 1;
+
+                if (allowSmaller && (size + 1) / 2 >= min_size) {
+                    MPI_Comm_group(MPI_COMM_WORLD, &world_group);
+                    merr = MPI_Group_range_incl(world_group, 1, ranges, &high_group);
+                    if (merr)
+                        MTestPrintError(merr);
+                    merr = MPI_Comm_create(MPI_COMM_WORLD, high_group, comm);
+                    if (merr)
+                        MTestPrintError(merr);
+                    MPI_Group_free(&world_group);
+                    MPI_Group_free(&high_group);
+                    intraCommName = "High half of WORLD created by MPI_Comm_create";
+                }
+                else {
+                    *comm = MPI_COMM_NULL;
+                }
+            }
+            break;
+            /* These next cases are communicators that include some
+             * but not all of the processes */
+        case 8:
+        case 9:
+        case 10:
+        case 11:
+            {
+                int newsize;
+                merr = MPI_Comm_size(MPI_COMM_WORLD, &size);
+                if (merr)
+                    MTestPrintError(merr);
+                newsize = size - (intraCommIdx - 7);
+
+                if (allowSmaller && newsize >= min_size) {
+                    merr = MPI_Comm_rank(MPI_COMM_WORLD, &rank);
+                    if (merr)
+                        MTestPrintError(merr);
+                    merr = MPI_Comm_split(MPI_COMM_WORLD, rank < newsize, rank, comm);
+                    if (merr)
+                        MTestPrintError(merr);
+                    if (rank >= newsize) {
+                        merr = MPI_Comm_free(comm);
+                        if (merr)
+                            MTestPrintError(merr);
+                        *comm = MPI_COMM_NULL;
+                    }
+                    else {
+                        intraCommName = "Split of WORLD";
+                    }
+                }
+                else {
+                    /* Act like default */
+                    *comm = MPI_COMM_NULL;
+                    intraCommIdx = -1;
+                }
+            }
+            break;
+
+            /* Other ideas: dup of self, cart comm, graph comm */
+        default:
+            *comm = MPI_COMM_NULL;
+            intraCommIdx = -1;
+            break;
+        }
+
+        if (*comm != MPI_COMM_NULL) {
+            merr = MPI_Comm_size(*comm, &size);
+            if (merr)
+                MTestPrintError(merr);
+            if (size >= min_size)
+                done = 1;
+        }
         else {
         else {
-            SMPI_VARGET_GLOBAL(intraCommName) = "MPI_COMM_NULL";
+            intraCommName = "MPI_COMM_NULL";
             isBasic = 1;
             done = 1;
         }
             isBasic = 1;
             done = 1;
         }
-done2=done;
+
         /* we are only done if all processes are done */
         /* we are only done if all processes are done */
-        MPI_Allreduce(&done2, &done, 1, MPI_INT, MPI_LAND, MPI_COMM_WORLD);
+        MPI_Allreduce(MPI_IN_PLACE, &done, 1, MPI_INT, MPI_LAND, MPI_COMM_WORLD);
 
         /* Advance the comm index whether we are done or not, otherwise we could
          * spin forever trying to allocate a too-small communicator over and
          * over again. */
 
         /* Advance the comm index whether we are done or not, otherwise we could
          * spin forever trying to allocate a too-small communicator over and
          * over again. */
-        SMPI_VARGET_GLOBAL(intraCommIdx)++;
+        intraCommIdx++;
 
         if (!done && !isBasic && *comm != MPI_COMM_NULL) {
             /* avoid leaking communicators */
             merr = MPI_Comm_free(comm);
 
         if (!done && !isBasic && *comm != MPI_COMM_NULL) {
             /* avoid leaking communicators */
             merr = MPI_Comm_free(comm);
-            if (merr) MTestPrintError(merr);
+            if (merr)
+                MTestPrintError(merr);
         }
     }
 
         }
     }
 
-    return SMPI_VARGET_GLOBAL(intraCommIdx);
+    return intraCommIdx;
 }
 
 }
 
-/* 
+/*
  * Get an intracommunicator with at least min_size members.
  */
  * Get an intracommunicator with at least min_size members.
  */
-int MTestGetIntracomm( MPI_Comm *comm, int min_size ) 
+int MTestGetIntracomm(MPI_Comm * comm, int min_size)
 {
 {
-    return MTestGetIntracommGeneral( comm, min_size, 0 );
+    return MTestGetIntracommGeneral(comm, min_size, 0);
 }
 
 /* Return the name of an intra communicator */
 }
 
 /* Return the name of an intra communicator */
-const char *MTestGetIntracommName( void )
+const char *MTestGetIntracommName(void)
 {
 {
-    return SMPI_VARGET_GLOBAL(intraCommName);
+    return intraCommName;
 }
 
 }
 
-/* 
- * Return an intercomm; set isLeftGroup to 1 if the calling process is 
+/*
+ * Return an intercomm; set isLeftGroup to 1 if the calling process is
  * a member of the "left" group.
  */
  * a member of the "left" group.
  */
-int MTestGetIntercomm( MPI_Comm *comm, int *isLeftGroup, int min_size )
+int MTestGetIntercomm(MPI_Comm * comm, int *isLeftGroup, int min_size)
 {
     int size, rank, remsize, merr;
 {
     int size, rank, remsize, merr;
-    int done=0;
-    MPI_Comm mcomm  = MPI_COMM_NULL;
+    int done = 0;
+    MPI_Comm mcomm = MPI_COMM_NULL;
     MPI_Comm mcomm2 = MPI_COMM_NULL;
     int rleader;
 
     /* The while loop allows us to skip communicators that are too small.
     MPI_Comm mcomm2 = MPI_COMM_NULL;
     int rleader;
 
     /* The while loop allows us to skip communicators that are too small.
-       MPI_COMM_NULL is always considered large enough.  The size is
-       the sum of the sizes of the local and remote groups */
+     * MPI_COMM_NULL is always considered large enough.  The size is
+     * the sum of the sizes of the local and remote groups */
     while (!done) {
         *comm = MPI_COMM_NULL;
         *isLeftGroup = 0;
     while (!done) {
         *comm = MPI_COMM_NULL;
         *isLeftGroup = 0;
-        SMPI_VARGET_GLOBAL(interCommName) = "MPI_COMM_NULL";
-
-       switch (SMPI_VARGET_GLOBAL(interCommIdx)) {
-       case 0:
-           /* Split comm world in half */
-           merr = MPI_Comm_rank( MPI_COMM_WORLD, &rank );
-           if (merr) MTestPrintError( merr );
-           merr = MPI_Comm_size( MPI_COMM_WORLD, &size );
-           if (merr) MTestPrintError( merr );
-           if (size > 1) {
-               merr = MPI_Comm_split( MPI_COMM_WORLD, (rank < size/2), rank, 
-                                      &mcomm );
-               if (merr) MTestPrintError( merr );
-               if (rank == 0) {
-                   rleader = size/2;
-               }
-               else if (rank == size/2) {
-                   rleader = 0;
-               }
-               else {
-                   /* Remote leader is signficant only for the processes
-                      designated local leaders */
-                   rleader = -1;
-               }
-               *isLeftGroup = rank < size/2;
-               merr = MPI_Intercomm_create( mcomm, 0, MPI_COMM_WORLD, rleader,
-                                            12345, comm );
-               if (merr) MTestPrintError( merr );
-               SMPI_VARGET_GLOBAL(interCommName) = "Intercomm by splitting MPI_COMM_WORLD";
-           }
-           else 
-               *comm = MPI_COMM_NULL;
-           break;
-       case 1:
-           /* Split comm world in to 1 and the rest */
-           merr = MPI_Comm_rank( MPI_COMM_WORLD, &rank );
-           if (merr) MTestPrintError( merr );
-           merr = MPI_Comm_size( MPI_COMM_WORLD, &size );
-           if (merr) MTestPrintError( merr );
-           if (size > 1) {
-               merr = MPI_Comm_split( MPI_COMM_WORLD, rank == 0, rank, 
-                                      &mcomm );
-               if (merr) MTestPrintError( merr );
-               if (rank == 0) {
-                   rleader = 1;
-               }
-               else if (rank == 1) {
-                   rleader = 0;
-               }
-               else {
-                   /* Remote leader is signficant only for the processes
-                      designated local leaders */
-                   rleader = -1;
-               }
-               *isLeftGroup = rank == 0;
-               merr = MPI_Intercomm_create( mcomm, 0, MPI_COMM_WORLD, 
-                                            rleader, 12346, comm );
-               if (merr) MTestPrintError( merr );
-               SMPI_VARGET_GLOBAL(interCommName) = "Intercomm by splitting MPI_COMM_WORLD into 1, rest";
-           }
-           else
-               *comm = MPI_COMM_NULL;
-           break;
-
-       case 2:
-           /* Split comm world in to 2 and the rest */
-           merr = MPI_Comm_rank( MPI_COMM_WORLD, &rank );
-           if (merr) MTestPrintError( merr );
-           merr = MPI_Comm_size( MPI_COMM_WORLD, &size );
-           if (merr) MTestPrintError( merr );
-           if (size > 3) {
-               merr = MPI_Comm_split( MPI_COMM_WORLD, rank < 2, rank, 
-                                      &mcomm );
-               if (merr) MTestPrintError( merr );
-               if (rank == 0) {
-                   rleader = 2;
-               }
-               else if (rank == 2) {
-                   rleader = 0;
-               }
-               else {
-                   /* Remote leader is signficant only for the processes
-                      designated local leaders */
-                   rleader = -1;
-               }
-               *isLeftGroup = rank < 2;
-               merr = MPI_Intercomm_create( mcomm, 0, MPI_COMM_WORLD, 
-                                            rleader, 12347, comm );
-               if (merr) MTestPrintError( merr );
-               SMPI_VARGET_GLOBAL(interCommName) = "Intercomm by splitting MPI_COMM_WORLD into 2, rest";
-           }
-           else 
-               *comm = MPI_COMM_NULL;
-           break;
-
-       case 3:
-           /* Split comm world in half, then dup */
-           merr = MPI_Comm_rank( MPI_COMM_WORLD, &rank );
-           if (merr) MTestPrintError( merr );
-           merr = MPI_Comm_size( MPI_COMM_WORLD, &size );
-           if (merr) MTestPrintError( merr );
-           if (size > 1) {
-               merr = MPI_Comm_split( MPI_COMM_WORLD, (rank < size/2), rank, 
-                                      &mcomm );
-               if (merr) MTestPrintError( merr );
-               if (rank == 0) {
-                   rleader = size/2;
-               }
-               else if (rank == size/2) {
-                   rleader = 0;
-               }
-               else {
-                   /* Remote leader is signficant only for the processes
-                      designated local leaders */
-                   rleader = -1;
-               }
-               *isLeftGroup = rank < size/2;
-               merr = MPI_Intercomm_create( mcomm, 0, MPI_COMM_WORLD, rleader,
-                                            12345, comm );
-               if (merr) MTestPrintError( merr );
+        interCommName = "MPI_COMM_NULL";
+
+        switch (interCommIdx) {
+        case 0:
+            /* Split comm world in half */
+            merr = MPI_Comm_rank(MPI_COMM_WORLD, &rank);
+            if (merr)
+                MTestPrintError(merr);
+            merr = MPI_Comm_size(MPI_COMM_WORLD, &size);
+            if (merr)
+                MTestPrintError(merr);
+            if (size > 1) {
+                merr = MPI_Comm_split(MPI_COMM_WORLD, (rank < size / 2), rank, &mcomm);
+                if (merr)
+                    MTestPrintError(merr);
+                if (rank == 0) {
+                    rleader = size / 2;
+                }
+                else if (rank == size / 2) {
+                    rleader = 0;
+                }
+                else {
+                    /* Remote leader is signficant only for the processes
+                     * designated local leaders */
+                    rleader = -1;
+                }
+                *isLeftGroup = rank < size / 2;
+                merr = MPI_Intercomm_create(mcomm, 0, MPI_COMM_WORLD, rleader, 12345, comm);
+                if (merr)
+                    MTestPrintError(merr);
+                interCommName = "Intercomm by splitting MPI_COMM_WORLD";
+            }
+            else
+                *comm = MPI_COMM_NULL;
+            break;
+        case 1:
+            /* Split comm world in to 1 and the rest */
+            merr = MPI_Comm_rank(MPI_COMM_WORLD, &rank);
+            if (merr)
+                MTestPrintError(merr);
+            merr = MPI_Comm_size(MPI_COMM_WORLD, &size);
+            if (merr)
+                MTestPrintError(merr);
+            if (size > 1) {
+                merr = MPI_Comm_split(MPI_COMM_WORLD, rank == 0, rank, &mcomm);
+                if (merr)
+                    MTestPrintError(merr);
+                if (rank == 0) {
+                    rleader = 1;
+                }
+                else if (rank == 1) {
+                    rleader = 0;
+                }
+                else {
+                    /* Remote leader is signficant only for the processes
+                     * designated local leaders */
+                    rleader = -1;
+                }
+                *isLeftGroup = rank == 0;
+                merr = MPI_Intercomm_create(mcomm, 0, MPI_COMM_WORLD, rleader, 12346, comm);
+                if (merr)
+                    MTestPrintError(merr);
+                interCommName = "Intercomm by splitting MPI_COMM_WORLD into 1, rest";
+            }
+            else
+                *comm = MPI_COMM_NULL;
+            break;
+
+        case 2:
+            /* Split comm world in to 2 and the rest */
+            merr = MPI_Comm_rank(MPI_COMM_WORLD, &rank);
+            if (merr)
+                MTestPrintError(merr);
+            merr = MPI_Comm_size(MPI_COMM_WORLD, &size);
+            if (merr)
+                MTestPrintError(merr);
+            if (size > 3) {
+                merr = MPI_Comm_split(MPI_COMM_WORLD, rank < 2, rank, &mcomm);
+                if (merr)
+                    MTestPrintError(merr);
+                if (rank == 0) {
+                    rleader = 2;
+                }
+                else if (rank == 2) {
+                    rleader = 0;
+                }
+                else {
+                    /* Remote leader is signficant only for the processes
+                     * designated local leaders */
+                    rleader = -1;
+                }
+                *isLeftGroup = rank < 2;
+                merr = MPI_Intercomm_create(mcomm, 0, MPI_COMM_WORLD, rleader, 12347, comm);
+                if (merr)
+                    MTestPrintError(merr);
+                interCommName = "Intercomm by splitting MPI_COMM_WORLD into 2, rest";
+            }
+            else
+                *comm = MPI_COMM_NULL;
+            break;
+
+        case 3:
+            /* Split comm world in half, then dup */
+            merr = MPI_Comm_rank(MPI_COMM_WORLD, &rank);
+            if (merr)
+                MTestPrintError(merr);
+            merr = MPI_Comm_size(MPI_COMM_WORLD, &size);
+            if (merr)
+                MTestPrintError(merr);
+            if (size > 1) {
+                merr = MPI_Comm_split(MPI_COMM_WORLD, (rank < size / 2), rank, &mcomm);
+                if (merr)
+                    MTestPrintError(merr);
+                if (rank == 0) {
+                    rleader = size / 2;
+                }
+                else if (rank == size / 2) {
+                    rleader = 0;
+                }
+                else {
+                    /* Remote leader is signficant only for the processes
+                     * designated local leaders */
+                    rleader = -1;
+                }
+                *isLeftGroup = rank < size / 2;
+                merr = MPI_Intercomm_create(mcomm, 0, MPI_COMM_WORLD, rleader, 12345, comm);
+                if (merr)
+                    MTestPrintError(merr);
                 /* avoid leaking after assignment below */
                 /* avoid leaking after assignment below */
-               merr = MPI_Comm_free( &mcomm );
-               if (merr) MTestPrintError( merr );
-
-               /* now dup, some bugs only occur for dup's of intercomms */
-               mcomm = *comm;
-               merr = MPI_Comm_dup(mcomm, comm);
-               if (merr) MTestPrintError( merr );
-               SMPI_VARGET_GLOBAL(interCommName) = "Intercomm by splitting MPI_COMM_WORLD then dup'ing";
-           }
-           else 
-               *comm = MPI_COMM_NULL;
-           break;
-
-       case 4:
-           /* Split comm world in half, form intercomm, then split that intercomm */
-           merr = MPI_Comm_rank( MPI_COMM_WORLD, &rank );
-           if (merr) MTestPrintError( merr );
-           merr = MPI_Comm_size( MPI_COMM_WORLD, &size );
-           if (merr) MTestPrintError( merr );
-           if (size > 1) {
-               merr = MPI_Comm_split( MPI_COMM_WORLD, (rank < size/2), rank, 
-                                      &mcomm );
-               if (merr) MTestPrintError( merr );
-               if (rank == 0) {
-                   rleader = size/2;
-               }
-               else if (rank == size/2) {
-                   rleader = 0;
-               }
-               else {
-                   /* Remote leader is signficant only for the processes
-                      designated local leaders */
-                   rleader = -1;
-               }
-               *isLeftGroup = rank < size/2;
-               merr = MPI_Intercomm_create( mcomm, 0, MPI_COMM_WORLD, rleader,
-                                            12345, comm );
-               if (merr) MTestPrintError( merr );
+                merr = MPI_Comm_free(&mcomm);
+                if (merr)
+                    MTestPrintError(merr);
+
+                /* now dup, some bugs only occur for dup's of intercomms */
+                mcomm = *comm;
+                merr = MPI_Comm_dup(mcomm, comm);
+                if (merr)
+                    MTestPrintError(merr);
+                interCommName = "Intercomm by splitting MPI_COMM_WORLD then dup'ing";
+            }
+            else
+                *comm = MPI_COMM_NULL;
+            break;
+
+        case 4:
+            /* Split comm world in half, form intercomm, then split that intercomm */
+            merr = MPI_Comm_rank(MPI_COMM_WORLD, &rank);
+            if (merr)
+                MTestPrintError(merr);
+            merr = MPI_Comm_size(MPI_COMM_WORLD, &size);
+            if (merr)
+                MTestPrintError(merr);
+            if (size > 1) {
+                merr = MPI_Comm_split(MPI_COMM_WORLD, (rank < size / 2), rank, &mcomm);
+                if (merr)
+                    MTestPrintError(merr);
+                if (rank == 0) {
+                    rleader = size / 2;
+                }
+                else if (rank == size / 2) {
+                    rleader = 0;
+                }
+                else {
+                    /* Remote leader is signficant only for the processes
+                     * designated local leaders */
+                    rleader = -1;
+                }
+                *isLeftGroup = rank < size / 2;
+                merr = MPI_Intercomm_create(mcomm, 0, MPI_COMM_WORLD, rleader, 12345, comm);
+                if (merr)
+                    MTestPrintError(merr);
                 /* avoid leaking after assignment below */
                 /* avoid leaking after assignment below */
-               merr = MPI_Comm_free( &mcomm );
-               if (merr) MTestPrintError( merr );
-
-               /* now split, some bugs only occur for splits of intercomms */
-               mcomm = *comm;
-               rank = MPI_Comm_rank(mcomm, &rank);
-               if (merr) MTestPrintError( merr );
-               /* this split is effectively a dup but tests the split code paths */
-               merr = MPI_Comm_split(mcomm, 0, rank, comm);
-               if (merr) MTestPrintError( merr );
-               SMPI_VARGET_GLOBAL(interCommName) = "Intercomm by splitting MPI_COMM_WORLD then then splitting again";
-           }
-           else
-               *comm = MPI_COMM_NULL;
-           break;
-
-       case 5:
+                merr = MPI_Comm_free(&mcomm);
+                if (merr)
+                    MTestPrintError(merr);
+
+                /* now split, some bugs only occur for splits of intercomms */
+                mcomm = *comm;
+                merr = MPI_Comm_rank(mcomm, &rank);
+                if (merr)
+                    MTestPrintError(merr);
+                /* this split is effectively a dup but tests the split code paths */
+                merr = MPI_Comm_split(mcomm, 0, rank, comm);
+                if (merr)
+                    MTestPrintError(merr);
+                interCommName = "Intercomm by splitting MPI_COMM_WORLD then then splitting again";
+            }
+            else
+                *comm = MPI_COMM_NULL;
+            break;
+
+        case 5:
             /* split comm world in half discarding rank 0 on the "left"
              * communicator, then form them into an intercommunicator */
             /* split comm world in half discarding rank 0 on the "left"
              * communicator, then form them into an intercommunicator */
-           merr = MPI_Comm_rank( MPI_COMM_WORLD, &rank );
-           if (merr) MTestPrintError( merr );
-           merr = MPI_Comm_size( MPI_COMM_WORLD, &size );
-           if (merr) MTestPrintError( merr );
-           if (size >= 4) {
-                int color = (rank < size/2 ? 0 : 1);
+            merr = MPI_Comm_rank(MPI_COMM_WORLD, &rank);
+            if (merr)
+                MTestPrintError(merr);
+            merr = MPI_Comm_size(MPI_COMM_WORLD, &size);
+            if (merr)
+                MTestPrintError(merr);
+            if (size >= 4) {
+                int color = (rank < size / 2 ? 0 : 1);
                 if (rank == 0)
                     color = MPI_UNDEFINED;
 
                 if (rank == 0)
                     color = MPI_UNDEFINED;
 
-               merr = MPI_Comm_split( MPI_COMM_WORLD, color, rank, &mcomm );
-               if (merr) MTestPrintError( merr );
-
-               if (rank == 1) {
-                   rleader = size/2;
-               }
-               else if (rank == (size/2)) {
-                   rleader = 1;
-               }
-               else {
-                   /* Remote leader is signficant only for the processes
-                      designated local leaders */
-                   rleader = -1;
-               }
-               *isLeftGroup = rank < size/2;
-                if (rank != 0) { /* 0's mcomm is MPI_COMM_NULL */
-                    merr = MPI_Intercomm_create( mcomm, 0, MPI_COMM_WORLD, rleader, 12345, comm );
-                    if (merr) MTestPrintError( merr );
+                merr = MPI_Comm_split(MPI_COMM_WORLD, color, rank, &mcomm);
+                if (merr)
+                    MTestPrintError(merr);
+
+                if (rank == 1) {
+                    rleader = size / 2;
+                }
+                else if (rank == (size / 2)) {
+                    rleader = 1;
+                }
+                else {
+                    /* Remote leader is signficant only for the processes
+                     * designated local leaders */
+                    rleader = -1;
                 }
                 }
-                SMPI_VARGET_GLOBAL(interCommName) = "Intercomm by splitting MPI_COMM_WORLD (discarding rank 0 in the left group) then MPI_Intercomm_create'ing";
+                *isLeftGroup = rank < size / 2;
+                if (rank != 0) {        /* 0's mcomm is MPI_COMM_NULL */
+                    merr = MPI_Intercomm_create(mcomm, 0, MPI_COMM_WORLD, rleader, 12345, comm);
+                    if (merr)
+                        MTestPrintError(merr);
+                }
+                interCommName =
+                    "Intercomm by splitting MPI_COMM_WORLD (discarding rank 0 in the left group) then MPI_Intercomm_create'ing";
             }
             else {
                 *comm = MPI_COMM_NULL;
             }
             else {
                 *comm = MPI_COMM_NULL;
@@ -1355,71 +791,84 @@ int MTestGetIntercomm( MPI_Comm *comm, int *isLeftGroup, int min_size )
             /* Split comm world in half then form them into an
              * intercommunicator.  Then discard rank 0 from each group of the
              * intercomm via MPI_Comm_create. */
             /* Split comm world in half then form them into an
              * intercommunicator.  Then discard rank 0 from each group of the
              * intercomm via MPI_Comm_create. */
-           merr = MPI_Comm_rank( MPI_COMM_WORLD, &rank );
-           if (merr) MTestPrintError( merr );
-           merr = MPI_Comm_size( MPI_COMM_WORLD, &size );
-           if (merr) MTestPrintError( merr );
-           if (size >= 4) {
+            merr = MPI_Comm_rank(MPI_COMM_WORLD, &rank);
+            if (merr)
+                MTestPrintError(merr);
+            merr = MPI_Comm_size(MPI_COMM_WORLD, &size);
+            if (merr)
+                MTestPrintError(merr);
+            if (size >= 4) {
                 MPI_Group oldgroup, newgroup;
                 int ranks[1];
                 MPI_Group oldgroup, newgroup;
                 int ranks[1];
-                int color = (rank < size/2 ? 0 : 1);
-
-               merr = MPI_Comm_split( MPI_COMM_WORLD, color, rank, &mcomm );
-               if (merr) MTestPrintError( merr );
-
-               if (rank == 0) {
-                   rleader = size/2;
-               }
-               else if (rank == (size/2)) {
-                   rleader = 0;
-               }
-               else {
-                   /* Remote leader is signficant only for the processes
-                      designated local leaders */
-                   rleader = -1;
-               }
-               *isLeftGroup = rank < size/2;
-                merr = MPI_Intercomm_create( mcomm, 0, MPI_COMM_WORLD, rleader, 12345, &mcomm2 );
-                if (merr) MTestPrintError( merr );
+                int color = (rank < size / 2 ? 0 : 1);
+
+                merr = MPI_Comm_split(MPI_COMM_WORLD, color, rank, &mcomm);
+                if (merr)
+                    MTestPrintError(merr);
+
+                if (rank == 0) {
+                    rleader = size / 2;
+                }
+                else if (rank == (size / 2)) {
+                    rleader = 0;
+                }
+                else {
+                    /* Remote leader is signficant only for the processes
+                     * designated local leaders */
+                    rleader = -1;
+                }
+                *isLeftGroup = rank < size / 2;
+                merr = MPI_Intercomm_create(mcomm, 0, MPI_COMM_WORLD, rleader, 12345, &mcomm2);
+                if (merr)
+                    MTestPrintError(merr);
 
                 /* We have an intercomm between the two halves of comm world. Now create
                  * a new intercomm that removes rank 0 on each side. */
                 merr = MPI_Comm_group(mcomm2, &oldgroup);
 
                 /* We have an intercomm between the two halves of comm world. Now create
                  * a new intercomm that removes rank 0 on each side. */
                 merr = MPI_Comm_group(mcomm2, &oldgroup);
-                if (merr) MTestPrintError( merr );
+                if (merr)
+                    MTestPrintError(merr);
                 ranks[0] = 0;
                 merr = MPI_Group_excl(oldgroup, 1, ranks, &newgroup);
                 ranks[0] = 0;
                 merr = MPI_Group_excl(oldgroup, 1, ranks, &newgroup);
-                if (merr) MTestPrintError( merr );
+                if (merr)
+                    MTestPrintError(merr);
                 merr = MPI_Comm_create(mcomm2, newgroup, comm);
                 merr = MPI_Comm_create(mcomm2, newgroup, comm);
-                if (merr) MTestPrintError( merr );
+                if (merr)
+                    MTestPrintError(merr);
 
                 merr = MPI_Group_free(&oldgroup);
 
                 merr = MPI_Group_free(&oldgroup);
-                if (merr) MTestPrintError( merr );
+                if (merr)
+                    MTestPrintError(merr);
                 merr = MPI_Group_free(&newgroup);
                 merr = MPI_Group_free(&newgroup);
-                if (merr) MTestPrintError( merr );
+                if (merr)
+                    MTestPrintError(merr);
 
 
-                SMPI_VARGET_GLOBAL(interCommName) = "Intercomm by splitting MPI_COMM_WORLD then discarding 0 ranks with MPI_Comm_create";
+                interCommName =
+                    "Intercomm by splitting MPI_COMM_WORLD then discarding 0 ranks with MPI_Comm_create";
             }
             else {
                 *comm = MPI_COMM_NULL;
             }
             break;
 
             }
             else {
                 *comm = MPI_COMM_NULL;
             }
             break;
 
-       default:
-           *comm = MPI_COMM_NULL;
-           SMPI_VARGET_GLOBAL(interCommIdx) = -1;
-           break;
-       }
-
-       if (*comm != MPI_COMM_NULL) {
-           merr = MPI_Comm_size( *comm, &size );
-           if (merr) MTestPrintError( merr );
-           merr = MPI_Comm_remote_size( *comm, &remsize );
-           if (merr) MTestPrintError( merr );
-           if (size + remsize >= min_size) done = 1;
-       }
-       else {
-           SMPI_VARGET_GLOBAL(interCommName) = "MPI_COMM_NULL";
-           done = 1;
+        default:
+            *comm = MPI_COMM_NULL;
+            interCommIdx = -1;
+            break;
+        }
+
+        if (*comm != MPI_COMM_NULL) {
+            merr = MPI_Comm_size(*comm, &size);
+            if (merr)
+                MTestPrintError(merr);
+            merr = MPI_Comm_remote_size(*comm, &remsize);
+            if (merr)
+                MTestPrintError(merr);
+            if (size + remsize >= min_size)
+                done = 1;
+        }
+        else {
+            interCommName = "MPI_COMM_NULL";
+            done = 1;
         }
 
         /* we are only done if all processes are done */
         }
 
         /* we are only done if all processes are done */
@@ -1428,52 +877,172 @@ int MTestGetIntercomm( MPI_Comm *comm, int *isLeftGroup, int min_size )
         /* Advance the comm index whether we are done or not, otherwise we could
          * spin forever trying to allocate a too-small communicator over and
          * over again. */
         /* Advance the comm index whether we are done or not, otherwise we could
          * spin forever trying to allocate a too-small communicator over and
          * over again. */
-        SMPI_VARGET_GLOBAL(interCommIdx)++;
+        interCommIdx++;
 
         if (!done && *comm != MPI_COMM_NULL) {
             /* avoid leaking communicators */
             merr = MPI_Comm_free(comm);
 
         if (!done && *comm != MPI_COMM_NULL) {
             /* avoid leaking communicators */
             merr = MPI_Comm_free(comm);
-            if (merr) MTestPrintError(merr);
+            if (merr)
+                MTestPrintError(merr);
         }
 
         /* cleanup for common temp objects */
         if (mcomm != MPI_COMM_NULL) {
             merr = MPI_Comm_free(&mcomm);
         }
 
         /* cleanup for common temp objects */
         if (mcomm != MPI_COMM_NULL) {
             merr = MPI_Comm_free(&mcomm);
-            if (merr) MTestPrintError( merr );
+            if (merr)
+                MTestPrintError(merr);
         }
         if (mcomm2 != MPI_COMM_NULL) {
             merr = MPI_Comm_free(&mcomm2);
         }
         if (mcomm2 != MPI_COMM_NULL) {
             merr = MPI_Comm_free(&mcomm2);
-            if (merr) MTestPrintError( merr );
+            if (merr)
+                MTestPrintError(merr);
         }
     }
 
         }
     }
 
-    return SMPI_VARGET_GLOBAL(interCommIdx);
+    return interCommIdx;
 }
 }
+
+int MTestTestIntercomm(MPI_Comm comm)
+{
+    int local_size, remote_size, rank, **bufs, *bufmem, rbuf[2], j;
+    int errs = 0, wrank, nsize;
+    char commname[MPI_MAX_OBJECT_NAME + 1];
+    MPI_Request *reqs;
+
+    MPI_Comm_rank(MPI_COMM_WORLD, &wrank);
+    MPI_Comm_size(comm, &local_size);
+    MPI_Comm_remote_size(comm, &remote_size);
+    MPI_Comm_rank(comm, &rank);
+    MPI_Comm_get_name(comm, commname, &nsize);
+
+    MTestPrintfMsg(1, "Testing communication on intercomm '%s', remote_size=%d\n",
+                   commname, remote_size);
+
+    reqs = (MPI_Request *) malloc(remote_size * sizeof(MPI_Request));
+    if (!reqs) {
+        printf("[%d] Unable to allocated %d requests for testing intercomm %s\n",
+               wrank, remote_size, commname);
+        errs++;
+        return errs;
+    }
+    bufs = (int **) malloc(remote_size * sizeof(int *));
+    if (!bufs) {
+        printf("[%d] Unable to allocated %d int pointers for testing intercomm %s\n",
+               wrank, remote_size, commname);
+        errs++;
+        return errs;
+    }
+    bufmem = (int *) malloc(remote_size * 2 * sizeof(int));
+    if (!bufmem) {
+        printf("[%d] Unable to allocated %d int data for testing intercomm %s\n",
+               wrank, 2 * remote_size, commname);
+        errs++;
+        return errs;
+    }
+
+    /* Each process sends a message containing its own rank and the
+     * rank of the destination with a nonblocking send.  Because we're using
+     * nonblocking sends, we need to use different buffers for each isend */
+    /* NOTE: the send buffer access restriction was relaxed in MPI-2.2, although
+     * it doesn't really hurt to keep separate buffers for our purposes */
+    for (j = 0; j < remote_size; j++) {
+        bufs[j] = &bufmem[2 * j];
+        bufs[j][0] = rank;
+        bufs[j][1] = j;
+        MPI_Isend(bufs[j], 2, MPI_INT, j, 0, comm, &reqs[j]);
+    }
+    MTestPrintfMsg(2, "isends posted, about to recv\n");
+
+    for (j = 0; j < remote_size; j++) {
+        MPI_Recv(rbuf, 2, MPI_INT, j, 0, comm, MPI_STATUS_IGNORE);
+        if (rbuf[0] != j) {
+            printf("[%d] Expected rank %d but saw %d in %s\n", wrank, j, rbuf[0], commname);
+            errs++;
+        }
+        if (rbuf[1] != rank) {
+            printf("[%d] Expected target rank %d but saw %d from %d in %s\n",
+                   wrank, rank, rbuf[1], j, commname);
+            errs++;
+        }
+    }
+    if (errs)
+        fflush(stdout);
+
+    MTestPrintfMsg(2, "my recvs completed, about to waitall\n");
+    MPI_Waitall(remote_size, reqs, MPI_STATUSES_IGNORE);
+
+    free(reqs);
+    free(bufs);
+    free(bufmem);
+
+    return errs;
+}
+
+int MTestTestIntracomm(MPI_Comm comm)
+{
+    int i, errs = 0;
+    int size;
+    int in[16], out[16], sol[16];
+
+    MPI_Comm_size(comm, &size);
+
+    /* Set input, output and sol-values */
+    for (i = 0; i < 16; i++) {
+        in[i] = i;
+        out[i] = 0;
+        sol[i] = i * size;
+    }
+    MPI_Allreduce(in, out, 16, MPI_INT, MPI_SUM, comm);
+
+    /* Test results */
+    for (i = 0; i < 16; i++) {
+        if (sol[i] != out[i])
+            errs++;
+    }
+
+    return errs;
+}
+
+int MTestTestComm(MPI_Comm comm)
+{
+    int is_inter;
+
+    if (comm == MPI_COMM_NULL)
+        return 0;
+
+    MPI_Comm_test_inter(comm, &is_inter);
+
+    if (is_inter)
+        return MTestTestIntercomm(comm);
+    else
+        return MTestTestIntracomm(comm);
+}
+
 /* Return the name of an intercommunicator */
 /* Return the name of an intercommunicator */
-const char *MTestGetIntercommName( void )
+const char *MTestGetIntercommName(void)
 {
 {
-    return SMPI_VARGET_GLOBAL(interCommName);
+    return interCommName;
 }
 
 }
 
-/* Get a communicator of a given minimum size.  Both intra and inter 
+/* Get a communicator of a given minimum size.  Both intra and inter
    communicators are provided */
    communicators are provided */
-int MTestGetComm( MPI_Comm *comm, int min_size )
+int MTestGetComm(MPI_Comm * comm, int min_size)
 {
 {
-    int idx=0;
-    SMPI_VARINIT_STATIC_AND_SET(getinter, int, 0);
-
-    if (!SMPI_VARGET_STATIC(getinter)) {
-       idx = MTestGetIntracomm( comm, min_size );
-       if (idx == 0) {
-           SMPI_VARGET_STATIC(getinter) = 1;
-       }
+    int idx = 0;
+    static int getinter = 0;
+
+    if (!getinter) {
+        idx = MTestGetIntracomm(comm, min_size);
+        if (idx == 0) {
+            getinter = 1;
+        }
     }
     }
-    if (SMPI_VARGET_STATIC(getinter)) {
-       int isLeft;
-       idx = MTestGetIntercomm( comm, &isLeft, min_size );
-       if (idx == 0) {
-           SMPI_VARGET_STATIC(getinter) = 0;
-       }
+    if (getinter) {
+        int isLeft;
+        idx = MTestGetIntercomm(comm, &isLeft, min_size);
+        if (idx == 0) {
+            getinter = 0;
+        }
     }
 
     return idx;
     }
 
     return idx;
@@ -1481,235 +1050,312 @@ int MTestGetComm( MPI_Comm *comm, int min_size )
 
 /* Free a communicator.  It may be called with a predefined communicator
  or MPI_COMM_NULL */
 
 /* Free a communicator.  It may be called with a predefined communicator
  or MPI_COMM_NULL */
-void MTestFreeComm( MPI_Comm *comm )
+void MTestFreeComm(MPI_Comm * comm)
 {
     int merr;
 {
     int merr;
-    if (*comm != MPI_COMM_WORLD &&
-       *comm != MPI_COMM_SELF &&
-       *comm != MPI_COMM_NULL) {
-       merr = MPI_Comm_free( comm );
-       if (merr) MTestPrintError( merr );
+    if (*comm != MPI_COMM_WORLD && *comm != MPI_COMM_SELF && *comm != MPI_COMM_NULL) {
+        merr = MPI_Comm_free(comm);
+        if (merr)
+            MTestPrintError(merr);
     }
 }
 
 /* ------------------------------------------------------------------------ */
     }
 }
 
 /* ------------------------------------------------------------------------ */
-void MTestPrintError( int errcode )
+void MTestPrintError(int errcode)
 {
     int errclass, slen;
     char string[MPI_MAX_ERROR_STRING];
 {
     int errclass, slen;
     char string[MPI_MAX_ERROR_STRING];
-    
-    MPI_Error_class( errcode, &errclass );
-    MPI_Error_string( errcode, string, &slen );
-    printf( "Error class %d (%s)\n", errclass, string );
-    fflush( stdout );
+
+    MPI_Error_class(errcode, &errclass);
+    MPI_Error_string(errcode, string, &slen);
+    printf("Error class %d (%s)\n", errclass, string);
+    fflush(stdout);
 }
 }
-void MTestPrintErrorMsg( const char msg[], int errcode )
+
+void MTestPrintErrorMsg(const char msg[], int errcode)
 {
     int errclass, slen;
     char string[MPI_MAX_ERROR_STRING];
 {
     int errclass, slen;
     char string[MPI_MAX_ERROR_STRING];
-    
-    MPI_Error_class( errcode, &errclass );
-    MPI_Error_string( errcode, string, &slen );
-    printf( "%s: Error class %d (%s)\n", msg, errclass, string ); 
-    fflush( stdout );
+
+    MPI_Error_class(errcode, &errclass);
+    MPI_Error_string(errcode, string, &slen);
+    printf("%s: Error class %d (%s)\n", msg, errclass, string);
+    fflush(stdout);
 }
 }
+
 /* ------------------------------------------------------------------------ */
 /* ------------------------------------------------------------------------ */
-/* 
+/*
  If verbose output is selected and the level is at least that of the
  If verbose output is selected and the level is at least that of the
- value of the verbose flag, then perform printf( format, ... );
+ value of the verbose flag, then perform printf(format, ...);
  */
  */
-void MTestPrintfMsg( int level, const char format[], ... )
+void MTestPrintfMsg(int level, const char format[], ...)
 {
     va_list list;
 
 {
     va_list list;
 
-    if (SMPI_VARGET_GLOBAL(verbose) && level >= SMPI_VARGET_GLOBAL(verbose)) {
-       va_start(list,format);
-       vprintf( format, list );
-       va_end(list);
-       fflush(stdout);
+    if (SMPI_VARGET_GLOBAL(verbose) && level <= SMPI_VARGET_GLOBAL(verbose)) {
+        va_start(list, format);
+        vprintf(format, list);
+        va_end(list);
+        fflush(stdout);
     }
 }
     }
 }
+
 /* Fatal error.  Report and exit */
 /* Fatal error.  Report and exit */
-void MTestError( const char *msg )
+void MTestError(const char *msg)
 {
 {
-    fprintf( stderr, "%s\n", msg );
-    fflush( stderr );
-    MPI_Abort( MPI_COMM_WORLD, 1 );
-    exit(1);
+    fprintf(stderr, "%s\n", msg);
+    fflush(stderr);
+    MPI_Abort(MPI_COMM_WORLD, 1);
 }
 }
+
 /* ------------------------------------------------------------------------ */
 /* ------------------------------------------------------------------------ */
-static void MTestResourceSummary( FILE *fp )
+static void MTestResourceSummary(FILE * fp)
 {
 #ifdef HAVE_GETRUSAGE
     struct rusage ru;
 {
 #ifdef HAVE_GETRUSAGE
     struct rusage ru;
-    SMPI_VARINIT_STATIC_AND_SET(pfThreshold, int, -2);
+    static int pfThreshold = -2;
     int doOutput = 1;
     int doOutput = 1;
-    if (getrusage( RUSAGE_SELF, &ru ) == 0) {
-       /* There is an option to generate output only when a resource
-          exceeds a threshold.  To date, only page faults supported. */
-       if (SMPI_VARGET_STATIC(pfThreshold) == -2) {
-           char *p = getenv("MPITEST_RUSAGE_PF");
-           SMPI_VARGET_STATIC(pfThreshold) = -1;
-           if (p) {
-               SMPI_VARGET_STATIC(pfThreshold) = strtol( p, 0, 0 );
-           }
-       }
-       if (SMPI_VARGET_STATIC(pfThreshold) > 0) {
-           doOutput = ru.ru_minflt > SMPI_VARGET_STATIC(pfThreshold);
-       }
-       if (doOutput) {
-           /* Cast values to long in case some system has defined them
-              as another integer type */
-           fprintf( fp, "RUSAGE: max resident set = %ldKB\n", 
-                    (long)ru.ru_maxrss );
-           fprintf( fp, "RUSAGE: page faults = %ld : %ld\n", 
-                    (long)ru.ru_minflt, (long)ru.ru_majflt );
-           /* Not every Unix provides useful information for the xxrss fields */
-           fprintf( fp, "RUSAGE: memory in text/data/stack = %ld : %ld : %ld\n", 
-                    (long)ru.ru_ixrss, (long)ru.ru_idrss, (long)ru.ru_isrss );
-           fprintf( fp, "RUSAGE: I/O in and out = %ld : %ld\n", 
-                    (long)ru.ru_inblock, (long)ru.ru_oublock );
-           fprintf( fp, "RUSAGE: context switch = %ld : %ld\n", 
-                    (long)ru.ru_nvcsw, (long)ru.ru_nivcsw );
-       }
+    if (getrusage(RUSAGE_SELF, &ru) == 0) {
+        /* There is an option to generate output only when a resource
+         * exceeds a threshold.  To date, only page faults supported. */
+        if (pfThreshold == -2) {
+            char *p = getenv("MPITEST_RUSAGE_PF");
+            pfThreshold = -1;
+            if (p) {
+                pfThreshold = strtol(p, 0, 0);
+            }
+        }
+        if (pfThreshold > 0) {
+            doOutput = ru.ru_minflt > pfThreshold;
+        }
+        if (doOutput) {
+            /* Cast values to long in case some system has defined them
+             * as another integer type */
+            fprintf(fp, "RUSAGE: max resident set = %ldKB\n", (long) ru.ru_maxrss);
+            fprintf(fp, "RUSAGE: page faults = %ld : %ld\n",
+                    (long) ru.ru_minflt, (long) ru.ru_majflt);
+            /* Not every Unix provides useful information for the xxrss fields */
+            fprintf(fp, "RUSAGE: memory in text/data/stack = %ld : %ld : %ld\n",
+                    (long) ru.ru_ixrss, (long) ru.ru_idrss, (long) ru.ru_isrss);
+            fprintf(fp, "RUSAGE: I/O in and out = %ld : %ld\n",
+                    (long) ru.ru_inblock, (long) ru.ru_oublock);
+            fprintf(fp, "RUSAGE: context switch = %ld : %ld\n",
+                    (long) ru.ru_nvcsw, (long) ru.ru_nivcsw);
+        }
     }
     else {
     }
     else {
-       fprintf( fp, "RUSAGE: return error %d\n", errno );
+        fprintf(fp, "RUSAGE: return error %d\n", errno);
     }
 #endif
 }
     }
 #endif
 }
+
 /* ------------------------------------------------------------------------ */
 #ifdef HAVE_MPI_WIN_CREATE
 /*
  * Create MPI Windows
  */
 /* ------------------------------------------------------------------------ */
 #ifdef HAVE_MPI_WIN_CREATE
 /*
  * Create MPI Windows
  */
-SMPI_VARINIT_GLOBAL_AND_SET(win_index, int, 0);
-SMPI_VARINIT_GLOBAL(winName, const char *);
+static int win_index = 0;
+static const char *winName;
 /* Use an attribute to remember the type of memory allocation (static,
    malloc, or MPI_Alloc_mem) */
 /* Use an attribute to remember the type of memory allocation (static,
    malloc, or MPI_Alloc_mem) */
-SMPI_VARINIT_GLOBAL_AND_SET(mem_keyval, int, MPI_KEYVAL_INVALID);
-int MTestGetWin( MPI_Win *win, int mustBePassive )
+static int mem_keyval = MPI_KEYVAL_INVALID;
+int MTestGetWin(MPI_Win * win, int mustBePassive)
 {
 {
-    typedef char actbuf_type[1024];
-    SMPI_VARINIT_STATIC(actbuf, actbuf_type);
-    SMPI_VARINIT_STATIC(pasbuf, char *);
-    char        *buf;
-    int         n, rank, merr;
-    MPI_Info    info;
-
-    if (SMPI_VARGET_GLOBAL(mem_keyval) == MPI_KEYVAL_INVALID) {
-       /* Create the keyval */
-       merr = MPI_Win_create_keyval( MPI_WIN_NULL_COPY_FN, 
-                                     MPI_WIN_NULL_DELETE_FN, 
-                                     &SMPI_VARGET_GLOBAL(mem_keyval), 0 );
-       if (merr) MTestPrintError( merr );
+    static char actbuf[1024];
+    static char *pasbuf;
+    char *buf;
+    int n, rank, merr;
+    MPI_Info info;
+
+    if (mem_keyval == MPI_KEYVAL_INVALID) {
+        /* Create the keyval */
+        merr = MPI_Win_create_keyval(MPI_WIN_NULL_COPY_FN, MPI_WIN_NULL_DELETE_FN, &mem_keyval, 0);
+        if (merr)
+            MTestPrintError(merr);
 
     }
 
 
     }
 
-    switch (SMPI_VARGET_GLOBAL(win_index)) {
+    switch (win_index) {
     case 0:
     case 0:
-       /* Active target window */
-       merr = MPI_Win_create( SMPI_VARGET_STATIC(actbuf), 1024, 1, MPI_INFO_NULL, MPI_COMM_WORLD,
-                              win );
-       if (merr) MTestPrintError( merr );
-       SMPI_VARGET_GLOBAL(winName) = "active-window";
-       merr = MPI_Win_set_attr( *win, SMPI_VARGET_GLOBAL(mem_keyval), (void *)0 );
-       if (merr) MTestPrintError( merr );
-       break;
+        /* Active target window */
+        merr = MPI_Win_create(actbuf, 1024, 1, MPI_INFO_NULL, MPI_COMM_WORLD, win);
+        if (merr)
+            MTestPrintError(merr);
+        winName = "active-window";
+        merr = MPI_Win_set_attr(*win, mem_keyval, (void *) 0);
+        if (merr)
+            MTestPrintError(merr);
+        break;
     case 1:
     case 1:
-       /* Passive target window */
-       merr = MPI_Alloc_mem( 1024, MPI_INFO_NULL, &SMPI_VARGET_STATIC(pasbuf) );
-       if (merr) MTestPrintError( merr );
-       merr = MPI_Win_create( SMPI_VARGET_STATIC(pasbuf), 1024, 1, MPI_INFO_NULL, MPI_COMM_WORLD,
-                              win );
-       if (merr) MTestPrintError( merr );
-       SMPI_VARGET_GLOBAL(winName) = "passive-window";
-       merr = MPI_Win_set_attr( *win, SMPI_VARGET_GLOBAL(mem_keyval), (void *)2 );
-       if (merr) MTestPrintError( merr );
-       break;
+        /* Passive target window */
+        merr = MPI_Alloc_mem(1024, MPI_INFO_NULL, &pasbuf);
+        if (merr)
+            MTestPrintError(merr);
+        merr = MPI_Win_create(pasbuf, 1024, 1, MPI_INFO_NULL, MPI_COMM_WORLD, win);
+        if (merr)
+            MTestPrintError(merr);
+        winName = "passive-window";
+        merr = MPI_Win_set_attr(*win, mem_keyval, (void *) 2);
+        if (merr)
+            MTestPrintError(merr);
+        break;
     case 2:
     case 2:
-       /* Active target; all windows different sizes */
-       merr = MPI_Comm_rank( MPI_COMM_WORLD, &rank );
-       if (merr) MTestPrintError( merr );
-       n = rank * 64;
-       if (n) 
-           buf = (char *)malloc( n );
-       else
-           buf = 0;
-       merr = MPI_Win_create( buf, n, 1, MPI_INFO_NULL, MPI_COMM_WORLD, 
-                              win );
-       if (merr) MTestPrintError( merr );
-       SMPI_VARGET_GLOBAL(winName) = "active-all-different-win";
-       merr = MPI_Win_set_attr( *win, SMPI_VARGET_GLOBAL(mem_keyval), (void *)1 );
-       if (merr) MTestPrintError( merr );
-       break;
+        /* Active target; all windows different sizes */
+        merr = MPI_Comm_rank(MPI_COMM_WORLD, &rank);
+        if (merr)
+            MTestPrintError(merr);
+        n = rank * 64;
+        if (n)
+            buf = (char *) malloc(n);
+        else
+            buf = 0;
+        merr = MPI_Win_create(buf, n, 1, MPI_INFO_NULL, MPI_COMM_WORLD, win);
+        if (merr)
+            MTestPrintError(merr);
+        winName = "active-all-different-win";
+        merr = MPI_Win_set_attr(*win, mem_keyval, (void *) 1);
+        if (merr)
+            MTestPrintError(merr);
+        break;
     case 3:
     case 3:
-       /* Active target, no locks set */
-       merr = MPI_Comm_rank( MPI_COMM_WORLD, &rank );
-       if (merr) MTestPrintError( merr );
-       n = rank * 64;
-       if (n) 
-           buf = (char *)malloc( n );
-       else
-           buf = 0;
-       merr = MPI_Info_create( &info );
-       if (merr) MTestPrintError( merr );
-       merr = MPI_Info_set( info, (char*)"nolocks", (char*)"true" );
-       if (merr) MTestPrintError( merr );
-       merr = MPI_Win_create( buf, n, 1, info, MPI_COMM_WORLD, win );
-       if (merr) MTestPrintError( merr );
-       merr = MPI_Info_free( &info );
-       if (merr) MTestPrintError( merr );
-       SMPI_VARGET_GLOBAL(winName) = "active-nolocks-all-different-win";
-       merr = MPI_Win_set_attr( *win, SMPI_VARGET_GLOBAL(mem_keyval), (void *)1 );
-       if (merr) MTestPrintError( merr );
-       break;
+        /* Active target, no locks set */
+        merr = MPI_Comm_rank(MPI_COMM_WORLD, &rank);
+        if (merr)
+            MTestPrintError(merr);
+        n = rank * 64;
+        if (n)
+            buf = (char *) malloc(n);
+        else
+            buf = 0;
+        merr = MPI_Info_create(&info);
+        if (merr)
+            MTestPrintError(merr);
+        merr = MPI_Info_set(info, (char *) "nolocks", (char *) "true");
+        if (merr)
+            MTestPrintError(merr);
+        merr = MPI_Win_create(buf, n, 1, info, MPI_COMM_WORLD, win);
+        if (merr)
+            MTestPrintError(merr);
+        merr = MPI_Info_free(&info);
+        if (merr)
+            MTestPrintError(merr);
+        winName = "active-nolocks-all-different-win";
+        merr = MPI_Win_set_attr(*win, mem_keyval, (void *) 1);
+        if (merr)
+            MTestPrintError(merr);
+        break;
     default:
     default:
-       SMPI_VARGET_GLOBAL(win_index) = -1;
+        win_index = -1;
     }
     }
-    SMPI_VARGET_GLOBAL(win_index)++;
-    return SMPI_VARGET_GLOBAL(win_index);
+    win_index++;
+    return win_index;
 }
 }
+
 /* Return a pointer to the name associated with a window object */
 /* Return a pointer to the name associated with a window object */
-const char *MTestGetWinName( void )
+const char *MTestGetWinName(void)
 {
 {
-    return SMPI_VARGET_GLOBAL(winName);
+    return winName;
 }
 }
+
 /* Free the storage associated with a window object */
 /* Free the storage associated with a window object */
-void MTestFreeWin( MPI_Win *win )
+void MTestFreeWin(MPI_Win * win)
 {
     void *addr;
 {
     void *addr;
-    int  flag, merr;
+    int flag, merr;
 
 
-    merr = MPI_Win_get_attr( *win, MPI_WIN_BASE, &addr, &flag );
-    if (merr) MTestPrintError( merr );
+    merr = MPI_Win_get_attr(*win, MPI_WIN_BASE, &addr, &flag);
+    if (merr)
+        MTestPrintError(merr);
     if (!flag) {
     if (!flag) {
-       MTestError( "Could not get WIN_BASE from window" );
+        MTestError("Could not get WIN_BASE from window");
     }
     if (addr) {
     }
     if (addr) {
-       void *val;
-       merr = MPI_Win_get_attr( *win, SMPI_VARGET_GLOBAL(mem_keyval), &val, &flag );
-       if (merr) MTestPrintError( merr );
-       if (flag) {
-           if (val == (void *)1) {
-               free( addr );
-           }
-           else if (val == (void *)2) {
-               merr = MPI_Free_mem( addr );
-               if (merr) MTestPrintError( merr );
-           }
-           /* if val == (void *)0, then static data that must not be freed */
-       }
+        void *val;
+        merr = MPI_Win_get_attr(*win, mem_keyval, &val, &flag);
+        if (merr)
+            MTestPrintError(merr);
+        if (flag) {
+            if (val == (void *) 1) {
+                free(addr);
+            }
+            else if (val == (void *) 2) {
+                merr = MPI_Free_mem(addr);
+                if (merr)
+                    MTestPrintError(merr);
+            }
+            /* if val == (void *)0, then static data that must not be freed */
+        }
     }
     merr = MPI_Win_free(win);
     }
     merr = MPI_Win_free(win);
-    if (merr) MTestPrintError( merr );
+    if (merr)
+        MTestPrintError(merr);
 }
 }
-static void MTestRMACleanup( void )
+
+static void MTestRMACleanup(void)
 {
 {
-    if (SMPI_VARGET_GLOBAL(mem_keyval) != MPI_KEYVAL_INVALID) {
-       MPI_Win_free_keyval( &SMPI_VARGET_GLOBAL(mem_keyval) );
+    if (mem_keyval != MPI_KEYVAL_INVALID) {
+        MPI_Win_free_keyval(&mem_keyval);
     }
 }
     }
 }
-#else 
-static void MTestRMACleanup( void ) {}
+#else
+static void MTestRMACleanup(void)
+{
+}
 #endif
 #endif
+
+/* ------------------------------------------------------------------------ */
+/* This function determines if it is possible to spawn addition MPI
+ * processes using MPI_COMM_SPAWN and MPI_COMM_SPAWN_MULTIPLE.
+ *
+ * It sets the can_spawn value to one of the following:
+ * 1  = yes, additional processes can be spawned
+ * 0  = no, MPI_UNIVERSE_SIZE <= the size of MPI_COMM_WORLD
+ * -1 = it is unknown whether or not processes can be spawned
+ *      due to errors in the necessary query functions
+ *
+ */
+int MTestSpawnPossible(int *can_spawn)
+{
+    int errs = 0;
+
+    void *v = NULL;
+    int flag = -1;
+    int vval = -1;
+    int rc;
+
+    rc = MPI_Comm_get_attr(MPI_COMM_WORLD, MPI_UNIVERSE_SIZE, &v, &flag);
+    if (rc != MPI_SUCCESS) {
+        /* MPI_UNIVERSE_SIZE keyval missing from MPI_COMM_WORLD attributes */
+        *can_spawn = -1;
+        errs++;
+    }
+    else {
+        /* MPI_UNIVERSE_SIZE need not be set */
+        if (flag) {
+
+            int size = -1;
+            rc = MPI_Comm_size(MPI_COMM_WORLD, &size);
+            if (rc != MPI_SUCCESS) {
+                /* MPI_Comm_size failed for MPI_COMM_WORLD */
+                *can_spawn = -1;
+                errs++;
+            }
+
+            vval = *(int *) v;
+            if (vval <= size) {
+                /* no additional processes can be spawned */
+                *can_spawn = 0;
+            }
+            else {
+                *can_spawn = 1;
+            }
+        }
+        else {
+            /* No attribute associated with key MPI_UNIVERSE_SIZE of MPI_COMM_WORLD */
+            *can_spawn = -1;
+        }
+    }
+    return errs;
+}
+
+/* ------------------------------------------------------------------------ */