1 /* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil ; -*- */
4 * (C) 2001 by Argonne National Laboratory.
5 * See COPYRIGHT in top-level directory.
8 #include "mpitestconf.h"
10 #if defined(HAVE_STDIO_H) || defined(STDC_HEADERS)
13 #if defined(HAVE_STDLIB_H) || defined(STDC_HEADERS)
16 #if defined(HAVE_STRING_H) || defined(STDC_HEADERS)
22 /* The following two includes permit the collection of resource usage
25 #ifdef HAVE_SYS_TIME_H
28 #ifdef HAVE_SYS_RESOURCE_H
29 #include <sys/resource.h>
35 * Utility routines for writing MPI tests.
37 * We check the return codes on all MPI routines (other than INIT)
38 * to allow the program that uses these routines to select MPI_ERRORS_RETURN
39 * as the error handler. We do *not* set MPI_ERRORS_RETURN because
40 * the code that makes use of these routines may not check return
45 static void MTestRMACleanup( void );
46 static void MTestResourceSummary( FILE * );
48 /* Here is where we could put the includes and definitions to enable
51 static int dbgflag = 0; /* Flag used for debugging */
52 static int wrank = -1; /* World rank */
53 static int verbose = 0; /* Message level (0 is none) */
54 static int returnWithVal = 0; /* Allow programs to return with a non-zero
55 if there was an error (may cause problems
56 with some runtime systems) */
57 static int usageOutput = 0; /* */
59 /* Provide backward portability to MPI 1 */
64 #define MPI_THREAD_SINGLE 0
68 * Initialize and Finalize MTest
72 Initialize MTest, initializing MPI if necessary.
74 Environment Variables:
75 + MPITEST_DEBUG - If set (to any value), turns on debugging output
76 . MPITEST_THREADLEVEL_DEFAULT - If set, use as the default "provided"
77 level of thread support. Applies to
78 MTest_Init but not MTest_Init_thread.
79 - MPITEST_VERBOSE - If set to a numeric value, turns on that level of
80 verbose output. This is used by the routine 'MTestPrintfMsg'
83 void MTest_Init_thread( int *argc, char ***argv, int required, int *provided )
88 MPI_Initialized( &flag );
90 /* Permit an MPI that claims only MPI 1 but includes the
91 MPI_Init_thread routine (e.g., IBM MPI) */
92 #if MPI_VERSION >= 2 || defined(HAVE_MPI_INIT_THREAD)
93 MPI_Init_thread( argc, argv, required, provided );
95 MPI_Init( argc, argv );
99 /* Check for debugging control */
100 if (getenv( "MPITEST_DEBUG" )) {
102 MPI_Comm_rank( MPI_COMM_WORLD, &wrank );
105 /* Check for verbose control */
106 envval = getenv( "MPITEST_VERBOSE" );
109 long val = strtol( envval, &s, 0 );
111 /* This is the error case for strtol */
112 fprintf( stderr, "Warning: %s not valid for MPITEST_VERBOSE\n",
121 fprintf( stderr, "Warning: %s not valid for MPITEST_VERBOSE\n",
127 /* Check for option to return success/failure in the return value of main */
128 envval = getenv( "MPITEST_RETURN_WITH_CODE" );
130 if (strcmp( envval, "yes" ) == 0 ||
131 strcmp( envval, "YES" ) == 0 ||
132 strcmp( envval, "true" ) == 0 ||
133 strcmp( envval, "TRUE" ) == 0) {
136 else if (strcmp( envval, "no" ) == 0 ||
137 strcmp( envval, "NO" ) == 0 ||
138 strcmp( envval, "false" ) == 0 ||
139 strcmp( envval, "FALSE" ) == 0) {
144 "Warning: %s not valid for MPITEST_RETURN_WITH_CODE\n",
150 /* Print rusage data if set */
151 if (getenv( "MPITEST_RUSAGE" )) {
156 * Initialize the tests, using an MPI-1 style init. Supports
157 * MTEST_THREADLEVEL_DEFAULT to test with user-specified thread level
159 void MTest_Init( int *argc, char ***argv )
162 #if MPI_VERSION >= 2 || defined(HAVE_MPI_INIT_THREAD)
166 threadLevel = MPI_THREAD_SINGLE;
167 str = getenv( "MTEST_THREADLEVEL_DEFAULT" );
168 if (!str) str = getenv( "MPITEST_THREADLEVEL_DEFAULT" );
170 if (strcmp(str,"MULTIPLE") == 0 || strcmp(str,"multiple") == 0) {
171 threadLevel = MPI_THREAD_MULTIPLE;
173 else if (strcmp(str,"SERIALIZED") == 0 ||
174 strcmp(str,"serialized") == 0) {
175 threadLevel = MPI_THREAD_SERIALIZED;
177 else if (strcmp(str,"FUNNELED") == 0 || strcmp(str,"funneled") == 0) {
178 threadLevel = MPI_THREAD_FUNNELED;
180 else if (strcmp(str,"SINGLE") == 0 || strcmp(str,"single") == 0) {
181 threadLevel = MPI_THREAD_SINGLE;
184 fprintf( stderr, "Unrecognized thread level %s\n", str );
185 /* Use exit since MPI_Init/Init_thread has not been called. */
189 MTest_Init_thread( argc, argv, threadLevel, &provided );
191 /* If the MPI_VERSION is 1, there is no MPI_THREAD_xxx defined */
192 MTest_Init_thread( argc, argv, 0, &provided );
197 Finalize MTest. errs is the number of errors on the calling process;
198 this routine will write the total number of errors over all of MPI_COMM_WORLD
199 to the process with rank zero, or " No Errors".
200 It does *not* finalize MPI.
202 void MTest_Finalize( int errs )
204 int rank, toterrs, merr;
206 merr = MPI_Comm_rank( MPI_COMM_WORLD, &rank );
207 if (merr) MTestPrintError( merr );
209 merr = MPI_Reduce( &errs, &toterrs, 1, MPI_INT, MPI_SUM,
211 if (merr) MTestPrintError( merr );
214 printf( " Found %d errors\n", toterrs );
217 printf( " No Errors\n" );
223 MTestResourceSummary( stdout );
226 /* Clean up any persistent objects that we allocated */
229 /* ------------------------------------------------------------------------ */
230 /* This routine may be used instead of "return 0;" at the end of main;
231 it allows the program to use the return value to signal success or failure.
233 int MTestReturnValue( int errors )
235 if (returnWithVal) return errors ? 1 : 0;
238 /* ------------------------------------------------------------------------ */
241 * Miscellaneous utilities, particularly to eliminate OS dependencies
243 * MTestSleep( seconds )
245 #ifdef HAVE_WINDOWS_H
247 void MTestSleep( int sec )
253 void MTestSleep( int sec )
262 * Eventually, this could read a description of a file. For now, we hard
265 * Each kind of datatype has the following functions:
266 * MTestTypeXXXInit - Initialize a send buffer for that type
267 * MTestTypeXXXInitRecv - Initialize a receive buffer for that type
268 * MTestTypeXXXFree - Free any buffers associate with that type
269 * MTestTypeXXXCheckbuf - Check that the buffer contains the expected data
270 * These routines work with (nearly) any datatype that is of type XXX,
271 * allowing the test codes to create a variety of contiguous, vector, and
272 * indexed types, then test them by calling these routines.
274 * Available types (for the XXX) are
275 * Contig - Simple contiguous buffers
276 * Vector - Simple strided "vector" type
277 * Indexed - Indexed datatype. Only for a count of 1 instance of the
280 static int datatype_index = 0;
282 /* ------------------------------------------------------------------------ */
283 /* Datatype routines for contiguous datatypes */
284 /* ------------------------------------------------------------------------ */
286 * Setup contiguous buffers of n copies of a datatype.
288 static void *MTestTypeContigInit( MTestDatatype *mtype )
293 if (mtype->count > 0) {
296 merr = MPI_Type_extent( mtype->datatype, &size );
297 if (merr) MTestPrintError( merr );
298 totsize = size * mtype->count;
300 mtype->buf = (void *) malloc( totsize );
302 p = (signed char *)(mtype->buf);
304 /* Error - out of memory */
305 MTestError( "Out of memory in type buffer init" );
307 for (i=0; i<totsize; i++) {
308 p[i] = 0xff ^ (i & 0xff);
321 * Setup contiguous buffers of n copies of a datatype. Initialize for
322 * reception (e.g., set initial data to detect failure)
324 static void *MTestTypeContigInitRecv( MTestDatatype *mtype )
329 if (mtype->count > 0) {
332 merr = MPI_Type_extent( mtype->datatype, &size );
333 if (merr) MTestPrintError( merr );
334 totsize = size * mtype->count;
336 mtype->buf = (void *) malloc( totsize );
338 p = (signed char *)(mtype->buf);
340 /* Error - out of memory */
341 MTestError( "Out of memory in type buffer init" );
343 for (i=0; i<totsize; i++) {
355 static void *MTestTypeContigFree( MTestDatatype *mtype )
363 static int MTestTypeContigCheckbuf( MTestDatatype *mtype )
366 unsigned char expected;
367 int i, totsize, err = 0, merr;
370 p = (unsigned char *)mtype->buf;
372 merr = MPI_Type_extent( mtype->datatype, &size );
373 if (merr) MTestPrintError( merr );
374 totsize = size * mtype->count;
375 for (i=0; i<totsize; i++) {
376 expected = (0xff ^ (i & 0xff));
377 if (p[i] != expected) {
379 if (mtype->printErrors && err < 10) {
380 printf( "Data expected = %x but got p[%d] = %x\n",
390 /* ------------------------------------------------------------------------ */
391 /* Datatype routines for vector datatypes */
392 /* ------------------------------------------------------------------------ */
394 static void *MTestTypeVectorInit( MTestDatatype *mtype )
399 if (mtype->count > 0) {
401 int i, j, k, nc, totsize;
403 merr = MPI_Type_extent( mtype->datatype, &size );
404 if (merr) MTestPrintError( merr );
405 totsize = mtype->count * size;
407 mtype->buf = (void *) malloc( totsize );
409 p = (unsigned char *)(mtype->buf);
411 /* Error - out of memory */
412 MTestError( "Out of memory in type buffer init" );
415 /* First, set to -1 */
416 for (i=0; i<totsize; i++) p[i] = 0xff;
418 /* Now, set the actual elements to the successive values.
419 To do this, we need to run 3 loops */
421 /* count is usually one for a vector type */
422 for (k=0; k<mtype->count; k++) {
423 /* For each element (block) */
424 for (i=0; i<mtype->nelm; i++) {
426 for (j=0; j<mtype->blksize; j++) {
427 p[j] = (0xff ^ (nc & 0xff));
440 static void *MTestTypeVectorFree( MTestDatatype *mtype )
449 /* ------------------------------------------------------------------------ */
450 /* Datatype routines for indexed block datatypes */
451 /* ------------------------------------------------------------------------ */
454 * Setup a buffer for one copy of an indexed datatype.
456 static void *MTestTypeIndexedInit( MTestDatatype *mtype )
461 if (mtype->count > 1) {
462 MTestError( "This datatype is supported only for a single count" );
464 if (mtype->count == 1) {
468 /* Allocate the send/recv buffer */
469 merr = MPI_Type_extent( mtype->datatype, &totsize );
470 if (merr) MTestPrintError( merr );
472 mtype->buf = (void *) malloc( totsize );
474 p = (signed char *)(mtype->buf);
476 MTestError( "Out of memory in type buffer init\n" );
478 /* Initialize the elements */
479 /* First, set to -1 */
480 for (i=0; i<totsize; i++) p[i] = 0xff;
482 /* Now, set the actual elements to the successive values.
483 We require that the base type is a contiguous type */
485 for (i=0; i<mtype->nelm; i++) {
487 /* Compute the offset: */
488 offset = mtype->displs[i] * mtype->basesize;
489 /* For each element in the block */
490 for (b=0; b<mtype->index[i]; b++) {
491 for (j=0; j<mtype->basesize; j++) {
492 p[offset+j] = 0xff ^ (k++ & 0xff);
494 offset += mtype->basesize;
509 * Setup indexed buffers for 1 copy of a datatype. Initialize for
510 * reception (e.g., set initial data to detect failure)
512 static void *MTestTypeIndexedInitRecv( MTestDatatype *mtype )
517 if (mtype->count > 1) {
518 MTestError( "This datatype is supported only for a single count" );
520 if (mtype->count == 1) {
523 merr = MPI_Type_extent( mtype->datatype, &totsize );
524 if (merr) MTestPrintError( merr );
526 mtype->buf = (void *) malloc( totsize );
528 p = (signed char *)(mtype->buf);
530 /* Error - out of memory */
531 MTestError( "Out of memory in type buffer init\n" );
533 for (i=0; i<totsize; i++) {
547 static void *MTestTypeIndexedFree( MTestDatatype *mtype )
551 free( mtype->displs );
552 free( mtype->index );
560 static int MTestTypeIndexedCheckbuf( MTestDatatype *mtype )
563 unsigned char expected;
564 int i, err = 0, merr;
567 p = (unsigned char *)mtype->buf;
570 merr = MPI_Type_extent( mtype->datatype, &totsize );
571 if (merr) MTestPrintError( merr );
574 for (i=0; i<mtype->nelm; i++) {
576 /* Compute the offset: */
577 offset = mtype->displs[i] * mtype->basesize;
578 for (b=0; b<mtype->index[i]; b++) {
579 for (j=0; j<mtype->basesize; j++) {
580 expected = (0xff ^ (k & 0xff));
581 if (p[offset+j] != expected) {
583 if (mtype->printErrors && err < 10) {
584 printf( "Data expected = %x but got p[%d,%d] = %x\n",
585 expected, i,j, p[offset+j] );
591 offset += mtype->basesize;
599 /* ------------------------------------------------------------------------ */
600 /* Routines to select a datatype and associated buffer create/fill/check */
602 /* ------------------------------------------------------------------------ */
605 Create a range of datatypes with a given count elements.
606 This uses a selection of types, rather than an exhaustive collection.
607 It allocates both send and receive types so that they can have the same
608 type signature (collection of basic types) but different type maps (layouts
611 int MTestGetDatatypes( MTestDatatype *sendtype, MTestDatatype *recvtype,
617 sendtype->InitBuf = 0;
618 sendtype->FreeBuf = 0;
619 sendtype->CheckBuf = 0;
620 sendtype->datatype = 0;
621 sendtype->isBasic = 0;
622 sendtype->printErrors = 0;
623 recvtype->InitBuf = 0;
624 recvtype->FreeBuf = 0;
626 recvtype->CheckBuf = 0;
627 recvtype->datatype = 0;
628 recvtype->isBasic = 0;
629 recvtype->printErrors = 0;
634 /* Set the defaults for the message lengths */
635 sendtype->count = count;
636 recvtype->count = count;
637 /* Use datatype_index to choose a datatype to use. If at the end of the
639 switch (datatype_index) {
641 sendtype->datatype = MPI_INT;
642 sendtype->isBasic = 1;
643 recvtype->datatype = MPI_INT;
644 recvtype->isBasic = 1;
647 sendtype->datatype = MPI_DOUBLE;
648 sendtype->isBasic = 1;
649 recvtype->datatype = MPI_DOUBLE;
650 recvtype->isBasic = 1;
653 sendtype->datatype = MPI_FLOAT_INT;
654 sendtype->isBasic = 1;
655 recvtype->datatype = MPI_FLOAT_INT;
656 recvtype->isBasic = 1;
659 merr = MPI_Type_dup( MPI_INT, &sendtype->datatype );
660 if (merr) MTestPrintError( merr );
661 merr = MPI_Type_set_name( sendtype->datatype,
662 (char*)"dup of MPI_INT" );
663 if (merr) MTestPrintError( merr );
664 merr = MPI_Type_dup( MPI_INT, &recvtype->datatype );
665 if (merr) MTestPrintError( merr );
666 merr = MPI_Type_set_name( recvtype->datatype,
667 (char*)"dup of MPI_INT" );
668 if (merr) MTestPrintError( merr );
669 /* dup'ed types are already committed if the original type
670 was committed (MPI-2, section 8.8) */
673 /* vector send type and contiguous receive type */
674 /* These sizes are in bytes (see the VectorInit code) */
675 sendtype->stride = 3 * sizeof(int);
676 sendtype->blksize = sizeof(int);
677 sendtype->nelm = recvtype->count;
679 merr = MPI_Type_vector( recvtype->count, 1, 3, MPI_INT,
680 &sendtype->datatype );
681 if (merr) MTestPrintError( merr );
682 merr = MPI_Type_commit( &sendtype->datatype );
683 if (merr) MTestPrintError( merr );
684 merr = MPI_Type_set_name( sendtype->datatype,
685 (char*)"int-vector" );
686 if (merr) MTestPrintError( merr );
688 recvtype->datatype = MPI_INT;
689 recvtype->isBasic = 1;
690 sendtype->InitBuf = MTestTypeVectorInit;
691 recvtype->InitBuf = MTestTypeContigInitRecv;
692 sendtype->FreeBuf = MTestTypeVectorFree;
693 recvtype->FreeBuf = MTestTypeContigFree;
694 sendtype->CheckBuf = 0;
695 recvtype->CheckBuf = MTestTypeContigCheckbuf;
699 /* Indexed send using many small blocks and contig receive */
700 sendtype->blksize = sizeof(int);
701 sendtype->nelm = recvtype->count;
702 sendtype->basesize = sizeof(int);
703 sendtype->displs = (int *)malloc( sendtype->nelm * sizeof(int) );
704 sendtype->index = (int *)malloc( sendtype->nelm * sizeof(int) );
705 if (!sendtype->displs || !sendtype->index) {
706 MTestError( "Out of memory in type init\n" );
708 /* Make the sizes larger (4 ints) to help push the total
709 size to over 256k in some cases, as the MPICH code as of
710 10/1/06 used large internal buffers for packing non-contiguous
712 for (i=0; i<sendtype->nelm; i++) {
713 sendtype->index[i] = 4;
714 sendtype->displs[i] = 5*i;
716 merr = MPI_Type_indexed( sendtype->nelm,
717 sendtype->index, sendtype->displs,
718 MPI_INT, &sendtype->datatype );
719 if (merr) MTestPrintError( merr );
720 merr = MPI_Type_commit( &sendtype->datatype );
721 if (merr) MTestPrintError( merr );
722 merr = MPI_Type_set_name( sendtype->datatype,
723 (char*)"int-indexed(4-int)" );
724 if (merr) MTestPrintError( merr );
726 sendtype->InitBuf = MTestTypeIndexedInit;
727 sendtype->FreeBuf = MTestTypeIndexedFree;
728 sendtype->CheckBuf = 0;
730 recvtype->datatype = MPI_INT;
731 recvtype->isBasic = 1;
732 recvtype->count = count * 4;
733 recvtype->InitBuf = MTestTypeContigInitRecv;
734 recvtype->FreeBuf = MTestTypeContigFree;
735 recvtype->CheckBuf = MTestTypeContigCheckbuf;
739 /* Indexed send using 2 large blocks and contig receive */
740 sendtype->blksize = sizeof(int);
742 sendtype->basesize = sizeof(int);
743 sendtype->displs = (int *)malloc( sendtype->nelm * sizeof(int) );
744 sendtype->index = (int *)malloc( sendtype->nelm * sizeof(int) );
745 if (!sendtype->displs || !sendtype->index) {
746 MTestError( "Out of memory in type init\n" );
748 /* index -> block size */
749 sendtype->index[0] = (recvtype->count + 1) / 2;
750 sendtype->displs[0] = 0;
751 sendtype->index[1] = recvtype->count - sendtype->index[0];
752 sendtype->displs[1] = sendtype->index[0] + 1;
753 /* There is a deliberate gap here */
755 merr = MPI_Type_indexed( sendtype->nelm,
756 sendtype->index, sendtype->displs,
757 MPI_INT, &sendtype->datatype );
758 if (merr) MTestPrintError( merr );
759 merr = MPI_Type_commit( &sendtype->datatype );
760 if (merr) MTestPrintError( merr );
761 merr = MPI_Type_set_name( sendtype->datatype,
762 (char*)"int-indexed(2 blocks)" );
763 if (merr) MTestPrintError( merr );
765 sendtype->InitBuf = MTestTypeIndexedInit;
766 sendtype->FreeBuf = MTestTypeIndexedFree;
767 sendtype->CheckBuf = 0;
769 recvtype->datatype = MPI_INT;
770 recvtype->isBasic = 1;
771 recvtype->count = sendtype->index[0] + sendtype->index[1];
772 recvtype->InitBuf = MTestTypeContigInitRecv;
773 recvtype->FreeBuf = MTestTypeContigFree;
774 recvtype->CheckBuf = MTestTypeContigCheckbuf;
778 /* Indexed receive using many small blocks and contig send */
779 recvtype->blksize = sizeof(int);
780 recvtype->nelm = recvtype->count;
781 recvtype->basesize = sizeof(int);
782 recvtype->displs = (int *)malloc( recvtype->nelm * sizeof(int) );
783 recvtype->index = (int *)malloc( recvtype->nelm * sizeof(int) );
784 if (!recvtype->displs || !recvtype->index) {
785 MTestError( "Out of memory in type recv init\n" );
787 /* Make the sizes larger (4 ints) to help push the total
788 size to over 256k in some cases, as the MPICH code as of
789 10/1/06 used large internal buffers for packing non-contiguous
791 /* Note that there are gaps in the indexed type */
792 for (i=0; i<recvtype->nelm; i++) {
793 recvtype->index[i] = 4;
794 recvtype->displs[i] = 5*i;
796 merr = MPI_Type_indexed( recvtype->nelm,
797 recvtype->index, recvtype->displs,
798 MPI_INT, &recvtype->datatype );
799 if (merr) MTestPrintError( merr );
800 merr = MPI_Type_commit( &recvtype->datatype );
801 if (merr) MTestPrintError( merr );
802 merr = MPI_Type_set_name( recvtype->datatype,
803 (char*)"recv-int-indexed(4-int)" );
804 if (merr) MTestPrintError( merr );
806 recvtype->InitBuf = MTestTypeIndexedInitRecv;
807 recvtype->FreeBuf = MTestTypeIndexedFree;
808 recvtype->CheckBuf = MTestTypeIndexedCheckbuf;
810 sendtype->datatype = MPI_INT;
811 sendtype->isBasic = 1;
812 sendtype->count = count * 4;
813 sendtype->InitBuf = MTestTypeContigInit;
814 sendtype->FreeBuf = MTestTypeContigFree;
815 sendtype->CheckBuf = 0;
818 /* Less commonly used but still simple types */
820 sendtype->datatype = MPI_SHORT;
821 sendtype->isBasic = 1;
822 recvtype->datatype = MPI_SHORT;
823 recvtype->isBasic = 1;
826 sendtype->datatype = MPI_LONG;
827 sendtype->isBasic = 1;
828 recvtype->datatype = MPI_LONG;
829 recvtype->isBasic = 1;
832 sendtype->datatype = MPI_CHAR;
833 sendtype->isBasic = 1;
834 recvtype->datatype = MPI_CHAR;
835 recvtype->isBasic = 1;
838 sendtype->datatype = MPI_UINT64_T;
839 sendtype->isBasic = 1;
840 recvtype->datatype = MPI_UINT64_T;
841 recvtype->isBasic = 1;
844 sendtype->datatype = MPI_FLOAT;
845 sendtype->isBasic = 1;
846 recvtype->datatype = MPI_FLOAT;
847 recvtype->isBasic = 1;
850 #ifndef USE_STRICT_MPI
851 /* MPI_BYTE may only be used with MPI_BYTE in strict MPI */
853 sendtype->datatype = MPI_INT;
854 sendtype->isBasic = 1;
855 recvtype->datatype = MPI_BYTE;
856 recvtype->isBasic = 1;
857 recvtype->count *= sizeof(int);
864 if (!sendtype->InitBuf) {
865 sendtype->InitBuf = MTestTypeContigInit;
866 recvtype->InitBuf = MTestTypeContigInitRecv;
867 sendtype->FreeBuf = MTestTypeContigFree;
868 recvtype->FreeBuf = MTestTypeContigFree;
869 sendtype->CheckBuf = MTestTypeContigCheckbuf;
870 recvtype->CheckBuf = MTestTypeContigCheckbuf;
874 if (dbgflag && datatype_index > 0) {
876 fprintf( stderr, "%d: sendtype is %s\n", wrank, MTestGetDatatypeName( sendtype ) );
877 merr = MPI_Type_size( sendtype->datatype, &typesize );
878 if (merr) MTestPrintError( merr );
879 fprintf( stderr, "%d: sendtype size = %d\n", wrank, typesize );
880 fprintf( stderr, "%d: recvtype is %s\n", wrank, MTestGetDatatypeName( recvtype ) );
881 merr = MPI_Type_size( recvtype->datatype, &typesize );
882 if (merr) MTestPrintError( merr );
883 fprintf( stderr, "%d: recvtype size = %d\n", wrank, typesize );
887 else if (verbose && datatype_index > 0) {
888 printf( "Get new datatypes: send = %s, recv = %s\n",
889 MTestGetDatatypeName( sendtype ),
890 MTestGetDatatypeName( recvtype ) );
894 return datatype_index;
897 /* Reset the datatype index (start from the initial data type.
898 Note: This routine is rarely needed; MTestGetDatatypes automatically
899 starts over after the last available datatype is used.
901 void MTestResetDatatypes( void )
905 /* Return the index of the current datatype. This is rarely needed and
906 is provided mostly to enable debugging of the MTest package itself */
907 int MTestGetDatatypeIndex( void )
909 return datatype_index;
912 /* Free the storage associated with a datatype */
913 void MTestFreeDatatype( MTestDatatype *mtype )
916 /* Invoke a datatype-specific free function to handle
917 both the datatype and the send/receive buffers */
918 if (mtype->FreeBuf) {
919 (mtype->FreeBuf)( mtype );
921 /* Free the datatype itself if it was created */
922 if (!mtype->isBasic) {
923 merr = MPI_Type_free( &mtype->datatype );
924 if (merr) MTestPrintError( merr );
928 /* Check that a message was received correctly. Returns the number of
929 errors detected. Status may be NULL or MPI_STATUS_IGNORE */
930 int MTestCheckRecv( MPI_Status *status, MTestDatatype *recvtype )
935 if (status && status != MPI_STATUS_IGNORE) {
936 merr = MPI_Get_count( status, recvtype->datatype, &count );
937 if (merr) MTestPrintError( merr );
939 /* Check count against expected count */
940 if (count != recvtype->count) {
945 /* Check received data */
946 if (!errs && recvtype->CheckBuf( recvtype )) {
952 /* This next routine uses a circular buffer of static name arrays just to
953 simplify the use of the routine */
954 const char *MTestGetDatatypeName( MTestDatatype *dtype )
956 static char name[4][MPI_MAX_OBJECT_NAME];
961 merr = MPI_Type_get_name( dtype->datatype, name[sp], &rlen );
962 if (merr) MTestPrintError( merr );
963 return (const char *)name[sp++];
965 /* ----------------------------------------------------------------------- */
968 * Create communicators. Use separate routines for inter and intra
969 * communicators (there is a routine to give both)
970 * Note that the routines may return MPI_COMM_NULL, so code should test for
971 * that return value as well.
974 static __thread int interCommIdx = 0;
975 static __thread int intraCommIdx = 0;
976 static __thread const char *intraCommName = 0;
977 static __thread const char *interCommName = 0;
980 * Get an intracommunicator with at least min_size members. If "allowSmaller"
981 * is true, allow the communicator to be smaller than MPI_COMM_WORLD and
982 * for this routine to return MPI_COMM_NULL for some values. Returns 0 if
983 * no more communicators are available.
985 int MTestGetIntracommGeneral( MPI_Comm *comm, int min_size, int allowSmaller )
987 int size, rank, merr;
991 /* The while loop allows us to skip communicators that are too small.
992 MPI_COMM_NULL is always considered large enough */
996 switch (intraCommIdx) {
998 *comm = MPI_COMM_WORLD;
1000 intraCommName = "MPI_COMM_WORLD";
1004 merr = MPI_Comm_dup(MPI_COMM_WORLD, comm );
1005 if (merr) MTestPrintError( merr );
1006 intraCommName = "Dup of MPI_COMM_WORLD";
1010 merr = MPI_Comm_size( MPI_COMM_WORLD, &size );
1011 if (merr) MTestPrintError( merr );
1012 merr = MPI_Comm_rank( MPI_COMM_WORLD, &rank );
1013 if (merr) MTestPrintError( merr );
1014 merr = MPI_Comm_split( MPI_COMM_WORLD, 0, size-rank, comm );
1015 if (merr) MTestPrintError( merr );
1016 intraCommName = "Rank reverse of MPI_COMM_WORLD";
1019 /* subset of world, with reversed ranks */
1020 merr = MPI_Comm_size( MPI_COMM_WORLD, &size );
1021 if (merr) MTestPrintError( merr );
1022 merr = MPI_Comm_rank( MPI_COMM_WORLD, &rank );
1023 if (merr) MTestPrintError( merr );
1024 merr = MPI_Comm_split( MPI_COMM_WORLD, ((rank < size/2) ? 1 : MPI_UNDEFINED),
1026 if (merr) MTestPrintError( merr );
1027 intraCommName = "Rank reverse of half of MPI_COMM_WORLD";
1030 *comm = MPI_COMM_SELF;
1032 intraCommName = "MPI_COMM_SELF";
1035 /* These next cases are communicators that include some
1036 but not all of the processes */
1043 merr = MPI_Comm_size( MPI_COMM_WORLD, &size );
1044 if (merr) MTestPrintError( merr );
1045 newsize = size - (intraCommIdx - 4);
1047 if (allowSmaller && newsize >= min_size) {
1048 merr = MPI_Comm_rank( MPI_COMM_WORLD, &rank );
1049 if (merr) MTestPrintError( merr );
1050 merr = MPI_Comm_split( MPI_COMM_WORLD, rank < newsize, rank,
1052 if (merr) MTestPrintError( merr );
1053 if (rank >= newsize) {
1054 merr = MPI_Comm_free( comm );
1055 if (merr) MTestPrintError( merr );
1056 *comm = MPI_COMM_NULL;
1059 intraCommName = "Split of WORLD";
1063 /* Act like default */
1064 *comm = MPI_COMM_NULL;
1070 /* Other ideas: dup of self, cart comm, graph comm */
1072 *comm = MPI_COMM_NULL;
1077 if (*comm != MPI_COMM_NULL) {
1078 merr = MPI_Comm_size( *comm, &size );
1079 if (merr) MTestPrintError( merr );
1080 if (size >= min_size)
1084 intraCommName = "MPI_COMM_NULL";
1089 /* we are only done if all processes are done */
1090 MPI_Allreduce(&done2, &done, 1, MPI_INT, MPI_LAND, MPI_COMM_WORLD);
1092 /* Advance the comm index whether we are done or not, otherwise we could
1093 * spin forever trying to allocate a too-small communicator over and
1097 if (!done && !isBasic && *comm != MPI_COMM_NULL) {
1098 /* avoid leaking communicators */
1099 merr = MPI_Comm_free(comm);
1100 if (merr) MTestPrintError(merr);
1104 return intraCommIdx;
1108 * Get an intracommunicator with at least min_size members.
1110 int MTestGetIntracomm( MPI_Comm *comm, int min_size )
1112 return MTestGetIntracommGeneral( comm, min_size, 0 );
1115 /* Return the name of an intra communicator */
1116 const char *MTestGetIntracommName( void )
1118 return intraCommName;
1122 * Return an intercomm; set isLeftGroup to 1 if the calling process is
1123 * a member of the "left" group.
1125 int MTestGetIntercomm( MPI_Comm *comm, int *isLeftGroup, int min_size )
1127 int size, rank, remsize, merr;
1129 MPI_Comm mcomm = MPI_COMM_NULL;
1130 MPI_Comm mcomm2 = MPI_COMM_NULL;
1133 /* The while loop allows us to skip communicators that are too small.
1134 MPI_COMM_NULL is always considered large enough. The size is
1135 the sum of the sizes of the local and remote groups */
1137 *comm = MPI_COMM_NULL;
1139 interCommName = "MPI_COMM_NULL";
1141 switch (interCommIdx) {
1143 /* Split comm world in half */
1144 merr = MPI_Comm_rank( MPI_COMM_WORLD, &rank );
1145 if (merr) MTestPrintError( merr );
1146 merr = MPI_Comm_size( MPI_COMM_WORLD, &size );
1147 if (merr) MTestPrintError( merr );
1149 merr = MPI_Comm_split( MPI_COMM_WORLD, (rank < size/2), rank,
1151 if (merr) MTestPrintError( merr );
1155 else if (rank == size/2) {
1159 /* Remote leader is signficant only for the processes
1160 designated local leaders */
1163 *isLeftGroup = rank < size/2;
1164 merr = MPI_Intercomm_create( mcomm, 0, MPI_COMM_WORLD, rleader,
1166 if (merr) MTestPrintError( merr );
1167 interCommName = "Intercomm by splitting MPI_COMM_WORLD";
1170 *comm = MPI_COMM_NULL;
1173 /* Split comm world in to 1 and the rest */
1174 merr = MPI_Comm_rank( MPI_COMM_WORLD, &rank );
1175 if (merr) MTestPrintError( merr );
1176 merr = MPI_Comm_size( MPI_COMM_WORLD, &size );
1177 if (merr) MTestPrintError( merr );
1179 merr = MPI_Comm_split( MPI_COMM_WORLD, rank == 0, rank,
1181 if (merr) MTestPrintError( merr );
1185 else if (rank == 1) {
1189 /* Remote leader is signficant only for the processes
1190 designated local leaders */
1193 *isLeftGroup = rank == 0;
1194 merr = MPI_Intercomm_create( mcomm, 0, MPI_COMM_WORLD,
1195 rleader, 12346, comm );
1196 if (merr) MTestPrintError( merr );
1197 interCommName = "Intercomm by splitting MPI_COMM_WORLD into 1, rest";
1200 *comm = MPI_COMM_NULL;
1204 /* Split comm world in to 2 and the rest */
1205 merr = MPI_Comm_rank( MPI_COMM_WORLD, &rank );
1206 if (merr) MTestPrintError( merr );
1207 merr = MPI_Comm_size( MPI_COMM_WORLD, &size );
1208 if (merr) MTestPrintError( merr );
1210 merr = MPI_Comm_split( MPI_COMM_WORLD, rank < 2, rank,
1212 if (merr) MTestPrintError( merr );
1216 else if (rank == 2) {
1220 /* Remote leader is signficant only for the processes
1221 designated local leaders */
1224 *isLeftGroup = rank < 2;
1225 merr = MPI_Intercomm_create( mcomm, 0, MPI_COMM_WORLD,
1226 rleader, 12347, comm );
1227 if (merr) MTestPrintError( merr );
1228 interCommName = "Intercomm by splitting MPI_COMM_WORLD into 2, rest";
1231 *comm = MPI_COMM_NULL;
1235 /* Split comm world in half, then dup */
1236 merr = MPI_Comm_rank( MPI_COMM_WORLD, &rank );
1237 if (merr) MTestPrintError( merr );
1238 merr = MPI_Comm_size( MPI_COMM_WORLD, &size );
1239 if (merr) MTestPrintError( merr );
1241 merr = MPI_Comm_split( MPI_COMM_WORLD, (rank < size/2), rank,
1243 if (merr) MTestPrintError( merr );
1247 else if (rank == size/2) {
1251 /* Remote leader is signficant only for the processes
1252 designated local leaders */
1255 *isLeftGroup = rank < size/2;
1256 merr = MPI_Intercomm_create( mcomm, 0, MPI_COMM_WORLD, rleader,
1258 if (merr) MTestPrintError( merr );
1259 /* avoid leaking after assignment below */
1260 merr = MPI_Comm_free( &mcomm );
1261 if (merr) MTestPrintError( merr );
1263 /* now dup, some bugs only occur for dup's of intercomms */
1265 merr = MPI_Comm_dup(mcomm, comm);
1266 if (merr) MTestPrintError( merr );
1267 interCommName = "Intercomm by splitting MPI_COMM_WORLD then dup'ing";
1270 *comm = MPI_COMM_NULL;
1274 /* Split comm world in half, form intercomm, then split that intercomm */
1275 merr = MPI_Comm_rank( MPI_COMM_WORLD, &rank );
1276 if (merr) MTestPrintError( merr );
1277 merr = MPI_Comm_size( MPI_COMM_WORLD, &size );
1278 if (merr) MTestPrintError( merr );
1280 merr = MPI_Comm_split( MPI_COMM_WORLD, (rank < size/2), rank,
1282 if (merr) MTestPrintError( merr );
1286 else if (rank == size/2) {
1290 /* Remote leader is signficant only for the processes
1291 designated local leaders */
1294 *isLeftGroup = rank < size/2;
1295 merr = MPI_Intercomm_create( mcomm, 0, MPI_COMM_WORLD, rleader,
1297 if (merr) MTestPrintError( merr );
1298 /* avoid leaking after assignment below */
1299 merr = MPI_Comm_free( &mcomm );
1300 if (merr) MTestPrintError( merr );
1302 /* now split, some bugs only occur for splits of intercomms */
1304 rank = MPI_Comm_rank(mcomm, &rank);
1305 if (merr) MTestPrintError( merr );
1306 /* this split is effectively a dup but tests the split code paths */
1307 merr = MPI_Comm_split(mcomm, 0, rank, comm);
1308 if (merr) MTestPrintError( merr );
1309 interCommName = "Intercomm by splitting MPI_COMM_WORLD then then splitting again";
1312 *comm = MPI_COMM_NULL;
1316 /* split comm world in half discarding rank 0 on the "left"
1317 * communicator, then form them into an intercommunicator */
1318 merr = MPI_Comm_rank( MPI_COMM_WORLD, &rank );
1319 if (merr) MTestPrintError( merr );
1320 merr = MPI_Comm_size( MPI_COMM_WORLD, &size );
1321 if (merr) MTestPrintError( merr );
1323 int color = (rank < size/2 ? 0 : 1);
1325 color = MPI_UNDEFINED;
1327 merr = MPI_Comm_split( MPI_COMM_WORLD, color, rank, &mcomm );
1328 if (merr) MTestPrintError( merr );
1333 else if (rank == (size/2)) {
1337 /* Remote leader is signficant only for the processes
1338 designated local leaders */
1341 *isLeftGroup = rank < size/2;
1342 if (rank != 0) { /* 0's mcomm is MPI_COMM_NULL */
1343 merr = MPI_Intercomm_create( mcomm, 0, MPI_COMM_WORLD, rleader, 12345, comm );
1344 if (merr) MTestPrintError( merr );
1346 interCommName = "Intercomm by splitting MPI_COMM_WORLD (discarding rank 0 in the left group) then MPI_Intercomm_create'ing";
1349 *comm = MPI_COMM_NULL;
1354 /* Split comm world in half then form them into an
1355 * intercommunicator. Then discard rank 0 from each group of the
1356 * intercomm via MPI_Comm_create. */
1357 merr = MPI_Comm_rank( MPI_COMM_WORLD, &rank );
1358 if (merr) MTestPrintError( merr );
1359 merr = MPI_Comm_size( MPI_COMM_WORLD, &size );
1360 if (merr) MTestPrintError( merr );
1362 MPI_Group oldgroup, newgroup;
1364 int color = (rank < size/2 ? 0 : 1);
1366 merr = MPI_Comm_split( MPI_COMM_WORLD, color, rank, &mcomm );
1367 if (merr) MTestPrintError( merr );
1372 else if (rank == (size/2)) {
1376 /* Remote leader is signficant only for the processes
1377 designated local leaders */
1380 *isLeftGroup = rank < size/2;
1381 merr = MPI_Intercomm_create( mcomm, 0, MPI_COMM_WORLD, rleader, 12345, &mcomm2 );
1382 if (merr) MTestPrintError( merr );
1384 /* We have an intercomm between the two halves of comm world. Now create
1385 * a new intercomm that removes rank 0 on each side. */
1386 merr = MPI_Comm_group(mcomm2, &oldgroup);
1387 if (merr) MTestPrintError( merr );
1389 merr = MPI_Group_excl(oldgroup, 1, ranks, &newgroup);
1390 if (merr) MTestPrintError( merr );
1391 merr = MPI_Comm_create(mcomm2, newgroup, comm);
1392 if (merr) MTestPrintError( merr );
1394 merr = MPI_Group_free(&oldgroup);
1395 if (merr) MTestPrintError( merr );
1396 merr = MPI_Group_free(&newgroup);
1397 if (merr) MTestPrintError( merr );
1399 interCommName = "Intercomm by splitting MPI_COMM_WORLD then discarding 0 ranks with MPI_Comm_create";
1402 *comm = MPI_COMM_NULL;
1407 *comm = MPI_COMM_NULL;
1412 if (*comm != MPI_COMM_NULL) {
1413 merr = MPI_Comm_size( *comm, &size );
1414 if (merr) MTestPrintError( merr );
1415 merr = MPI_Comm_remote_size( *comm, &remsize );
1416 if (merr) MTestPrintError( merr );
1417 if (size + remsize >= min_size) done = 1;
1420 interCommName = "MPI_COMM_NULL";
1424 /* we are only done if all processes are done */
1425 MPI_Allreduce(MPI_IN_PLACE, &done, 1, MPI_INT, MPI_LAND, MPI_COMM_WORLD);
1427 /* Advance the comm index whether we are done or not, otherwise we could
1428 * spin forever trying to allocate a too-small communicator over and
1432 if (!done && *comm != MPI_COMM_NULL) {
1433 /* avoid leaking communicators */
1434 merr = MPI_Comm_free(comm);
1435 if (merr) MTestPrintError(merr);
1438 /* cleanup for common temp objects */
1439 if (mcomm != MPI_COMM_NULL) {
1440 merr = MPI_Comm_free(&mcomm);
1441 if (merr) MTestPrintError( merr );
1443 if (mcomm2 != MPI_COMM_NULL) {
1444 merr = MPI_Comm_free(&mcomm2);
1445 if (merr) MTestPrintError( merr );
1449 return interCommIdx;
1451 /* Return the name of an intercommunicator */
1452 const char *MTestGetIntercommName( void )
1454 return interCommName;
1457 /* Get a communicator of a given minimum size. Both intra and inter
1458 communicators are provided */
1459 int MTestGetComm( MPI_Comm *comm, int min_size )
1462 static __thread int getinter = 0;
1465 idx = MTestGetIntracomm( comm, min_size );
1472 idx = MTestGetIntercomm( comm, &isLeft, min_size );
1481 /* Free a communicator. It may be called with a predefined communicator
1483 void MTestFreeComm( MPI_Comm *comm )
1486 if (*comm != MPI_COMM_WORLD &&
1487 *comm != MPI_COMM_SELF &&
1488 *comm != MPI_COMM_NULL) {
1489 merr = MPI_Comm_free( comm );
1490 if (merr) MTestPrintError( merr );
1494 /* ------------------------------------------------------------------------ */
1495 void MTestPrintError( int errcode )
1498 char string[MPI_MAX_ERROR_STRING];
1500 MPI_Error_class( errcode, &errclass );
1501 MPI_Error_string( errcode, string, &slen );
1502 printf( "Error class %d (%s)\n", errclass, string );
1505 void MTestPrintErrorMsg( const char msg[], int errcode )
1508 char string[MPI_MAX_ERROR_STRING];
1510 MPI_Error_class( errcode, &errclass );
1511 MPI_Error_string( errcode, string, &slen );
1512 printf( "%s: Error class %d (%s)\n", msg, errclass, string );
1515 /* ------------------------------------------------------------------------ */
1517 If verbose output is selected and the level is at least that of the
1518 value of the verbose flag, then perform printf( format, ... );
1520 void MTestPrintfMsg( int level, const char format[], ... )
1524 if (verbose && level >= verbose) {
1525 va_start(list,format);
1526 vprintf( format, list );
1531 /* Fatal error. Report and exit */
1532 void MTestError( const char *msg )
1534 fprintf( stderr, "%s\n", msg );
1536 MPI_Abort( MPI_COMM_WORLD, 1 );
1539 /* ------------------------------------------------------------------------ */
1540 static void MTestResourceSummary( FILE *fp )
1542 #ifdef HAVE_GETRUSAGE
1544 static __thread int pfThreshold = -2;
1546 if (getrusage( RUSAGE_SELF, &ru ) == 0) {
1547 /* There is an option to generate output only when a resource
1548 exceeds a threshold. To date, only page faults supported. */
1549 if (pfThreshold == -2) {
1550 char *p = getenv("MPITEST_RUSAGE_PF");
1553 pfThreshold = strtol( p, 0, 0 );
1556 if (pfThreshold > 0) {
1557 doOutput = ru.ru_minflt > pfThreshold;
1560 /* Cast values to long in case some system has defined them
1561 as another integer type */
1562 fprintf( fp, "RUSAGE: max resident set = %ldKB\n",
1563 (long)ru.ru_maxrss );
1564 fprintf( fp, "RUSAGE: page faults = %ld : %ld\n",
1565 (long)ru.ru_minflt, (long)ru.ru_majflt );
1566 /* Not every Unix provides useful information for the xxrss fields */
1567 fprintf( fp, "RUSAGE: memory in text/data/stack = %ld : %ld : %ld\n",
1568 (long)ru.ru_ixrss, (long)ru.ru_idrss, (long)ru.ru_isrss );
1569 fprintf( fp, "RUSAGE: I/O in and out = %ld : %ld\n",
1570 (long)ru.ru_inblock, (long)ru.ru_oublock );
1571 fprintf( fp, "RUSAGE: context switch = %ld : %ld\n",
1572 (long)ru.ru_nvcsw, (long)ru.ru_nivcsw );
1576 fprintf( fp, "RUSAGE: return error %d\n", errno );
1580 /* ------------------------------------------------------------------------ */
1581 #ifdef HAVE_MPI_WIN_CREATE
1583 * Create MPI Windows
1585 static __thread int win_index = 0;
1586 static const char *winName;
1587 /* Use an attribute to remember the type of memory allocation (static,
1588 malloc, or MPI_Alloc_mem) */
1589 static __thread int mem_keyval = MPI_KEYVAL_INVALID;
1590 int MTestGetWin( MPI_Win *win, int mustBePassive )
1592 static char actbuf[1024];
1593 static char *pasbuf;
1598 if (mem_keyval == MPI_KEYVAL_INVALID) {
1599 /* Create the keyval */
1600 merr = MPI_Win_create_keyval( MPI_WIN_NULL_COPY_FN,
1601 MPI_WIN_NULL_DELETE_FN,
1603 if (merr) MTestPrintError( merr );
1607 switch (win_index) {
1609 /* Active target window */
1610 merr = MPI_Win_create( actbuf, 1024, 1, MPI_INFO_NULL, MPI_COMM_WORLD,
1612 if (merr) MTestPrintError( merr );
1613 winName = "active-window";
1614 merr = MPI_Win_set_attr( *win, mem_keyval, (void *)0 );
1615 if (merr) MTestPrintError( merr );
1618 /* Passive target window */
1619 merr = MPI_Alloc_mem( 1024, MPI_INFO_NULL, &pasbuf );
1620 if (merr) MTestPrintError( merr );
1621 merr = MPI_Win_create( pasbuf, 1024, 1, MPI_INFO_NULL, MPI_COMM_WORLD,
1623 if (merr) MTestPrintError( merr );
1624 winName = "passive-window";
1625 merr = MPI_Win_set_attr( *win, mem_keyval, (void *)2 );
1626 if (merr) MTestPrintError( merr );
1629 /* Active target; all windows different sizes */
1630 merr = MPI_Comm_rank( MPI_COMM_WORLD, &rank );
1631 if (merr) MTestPrintError( merr );
1634 buf = (char *)malloc( n );
1637 merr = MPI_Win_create( buf, n, 1, MPI_INFO_NULL, MPI_COMM_WORLD,
1639 if (merr) MTestPrintError( merr );
1640 winName = "active-all-different-win";
1641 merr = MPI_Win_set_attr( *win, mem_keyval, (void *)1 );
1642 if (merr) MTestPrintError( merr );
1645 /* Active target, no locks set */
1646 merr = MPI_Comm_rank( MPI_COMM_WORLD, &rank );
1647 if (merr) MTestPrintError( merr );
1650 buf = (char *)malloc( n );
1653 merr = MPI_Info_create( &info );
1654 if (merr) MTestPrintError( merr );
1655 merr = MPI_Info_set( info, (char*)"nolocks", (char*)"true" );
1656 if (merr) MTestPrintError( merr );
1657 merr = MPI_Win_create( buf, n, 1, info, MPI_COMM_WORLD, win );
1658 if (merr) MTestPrintError( merr );
1659 merr = MPI_Info_free( &info );
1660 if (merr) MTestPrintError( merr );
1661 winName = "active-nolocks-all-different-win";
1662 merr = MPI_Win_set_attr( *win, mem_keyval, (void *)1 );
1663 if (merr) MTestPrintError( merr );
1671 /* Return a pointer to the name associated with a window object */
1672 const char *MTestGetWinName( void )
1676 /* Free the storage associated with a window object */
1677 void MTestFreeWin( MPI_Win *win )
1682 merr = MPI_Win_get_attr( *win, MPI_WIN_BASE, &addr, &flag );
1683 if (merr) MTestPrintError( merr );
1685 MTestError( "Could not get WIN_BASE from window" );
1689 merr = MPI_Win_get_attr( *win, mem_keyval, &val, &flag );
1690 if (merr) MTestPrintError( merr );
1692 if (val == (void *)1) {
1695 else if (val == (void *)2) {
1696 merr = MPI_Free_mem( addr );
1697 if (merr) MTestPrintError( merr );
1699 /* if val == (void *)0, then static data that must not be freed */
1702 merr = MPI_Win_free(win);
1703 if (merr) MTestPrintError( merr );
1705 static void MTestRMACleanup( void )
1707 if (mem_keyval != MPI_KEYVAL_INVALID) {
1708 MPI_Win_free_keyval( &mem_keyval );
1712 static void MTestRMACleanup( void ) {}