/*
* This test looks at the handling of logical and for types that are not
* integers or are not required integers (e.g., long long). MPICH allows
* these as well. A strict MPI test should not include this test.
*/
int main( int argc, char *argv[] )
{
int errs = 0;
int rc;
int rank, size;
MPI_Comm comm;
char cinbuf[3], coutbuf[3];
signed char scinbuf[3], scoutbuf[3];
unsigned char ucinbuf[3], ucoutbuf[3];
short sinbuf[3], soutbuf[3];
unsigned short usinbuf[3], usoutbuf[3];
long linbuf[3], loutbuf[3];
unsigned long ulinbuf[3], uloutbuf[3];
unsigned uinbuf[3], uoutbuf[3];
int iinbuf[3], ioutbuf[3];
MTest_Init( &argc, &argv );
comm = MPI_COMM_WORLD;
/* Set errors return so that we can provide better information
should a routine reject one of the operand/datatype pairs */
MPI_Errhandler_set( comm, MPI_ERRORS_RETURN );
MPI_Comm_rank( comm, &rank );
MPI_Comm_size( comm, &size );
#ifndef USE_STRICT_MPI
/* char */
MTestPrintfMsg( 10, "Reduce of MPI_CHAR\n" );
cinbuf[0] = 0xff;
cinbuf[1] = 0;
cinbuf[2] = (rank > 0) ? 0x3c : 0xc3;
coutbuf[0] = 0xf;
coutbuf[1] = 1;
coutbuf[2] = 1;
rc = MPI_Reduce( cinbuf, coutbuf, 3, MPI_CHAR, MPI_BXOR, 0, comm );
if (rc) {
MTestPrintErrorMsg( "MPI_BXOR and MPI_CHAR", rc );
errs++;
}
else {
if (rank == 0) {
if (coutbuf[0] != ((size % 2) ? (char)0xff : (char)0) ) {
errs++;
fprintf( stderr, "char BXOR(1) test failed\n" );
}
if (coutbuf[1]) {
errs++;
fprintf( stderr, "char BXOR(0) test failed\n" );
}
if (coutbuf[2] != ((size % 2) ? (char)0xc3 : (char)0xff)) {
errs++;
fprintf( stderr, "char BXOR(>) test failed\n" );
}
}
}
#endif /* USE_STRICT_MPI */
/* signed char */
MTestPrintfMsg( 10, "Reduce of MPI_SIGNED_CHAR\n" );
scinbuf[0] = 0xff;
scinbuf[1] = 0;
scinbuf[2] = (rank > 0) ? 0x3c : 0xc3;
scoutbuf[0] = 0xf;
scoutbuf[1] = 1;
scoutbuf[2] = 1;
rc = MPI_Reduce( scinbuf, scoutbuf, 3, MPI_SIGNED_CHAR, MPI_BXOR, 0, comm );
if (rc) {
MTestPrintErrorMsg( "MPI_BXOR and MPI_SIGNED_CHAR", rc );
errs++;
}
else {
if (rank == 0) {
if (scoutbuf[0] != ((size % 2) ? (signed char)0xff : (signed char)0) ) {
errs++;
fprintf( stderr, "signed char BXOR(1) test failed\n" );
}
if (scoutbuf[1]) {
errs++;
fprintf( stderr, "signed char BXOR(0) test failed\n" );
}
if (scoutbuf[2] != ((size % 2) ? (signed char)0xc3 : (signed char)0xff)) {
errs++;
fprintf( stderr, "signed char BXOR(>) test failed\n" );
}
}
}
/* unsigned char */
MTestPrintfMsg( 10, "Reduce of MPI_UNSIGNED_CHAR\n" );
ucinbuf[0] = 0xff;
ucinbuf[1] = 0;
ucinbuf[2] = (rank > 0) ? 0x3c : 0xc3;
ucoutbuf[0] = 0;
ucoutbuf[1] = 1;
ucoutbuf[2] = 1;
rc = MPI_Reduce( ucinbuf, ucoutbuf, 3, MPI_UNSIGNED_CHAR, MPI_BXOR, 0, comm );
if (rc) {
MTestPrintErrorMsg( "MPI_BXOR and MPI_UNSIGNED_CHAR", rc );
errs++;
}
else {
if (rank == 0) {
if (ucoutbuf[0] != ((size % 2) ? 0xff : 0)) {
errs++;
fprintf( stderr, "unsigned char BXOR(1) test failed\n" );
}
if (ucoutbuf[1]) {
errs++;
fprintf( stderr, "unsigned char BXOR(0) test failed\n" );
}
if (ucoutbuf[2] != ((size % 2) ? (unsigned char)0xc3 : (unsigned char)0xff)) {
errs++;
fprintf( stderr, "unsigned char BXOR(>) test failed\n" );
}
}
}
/* bytes */
MTestPrintfMsg( 10, "Reduce of MPI_BYTE\n" );
cinbuf[0] = 0xff;
cinbuf[1] = 0;
cinbuf[2] = (rank > 0) ? 0x3c : 0xc3;
coutbuf[0] = 0;
coutbuf[1] = 1;
coutbuf[2] = 1;
rc = MPI_Reduce( cinbuf, coutbuf, 3, MPI_BYTE, MPI_BXOR, 0, comm );
if (rc) {
MTestPrintErrorMsg( "MPI_BXOR and MPI_BYTE", rc );
errs++;
}
else {
if (rank == 0) {
if (coutbuf[0] != ((size % 2) ? (char)0xff : 0)) {
errs++;
fprintf( stderr, "byte BXOR(1) test failed\n" );
}
if (coutbuf[1]) {
errs++;
fprintf( stderr, "byte BXOR(0) test failed\n" );
}
if (coutbuf[2] != ((size % 2) ? (char)0xc3 : (char)0xff)) {
errs++;
fprintf( stderr, "byte BXOR(>) test failed\n" );
}
}
}
/* short */
MTestPrintfMsg( 10, "Reduce of MPI_SHORT\n" );
sinbuf[0] = 0xffff;
sinbuf[1] = 0;
sinbuf[2] = (rank > 0) ? 0x3c3c : 0xc3c3;
soutbuf[0] = 0;
soutbuf[1] = 1;
soutbuf[2] = 1;
rc = MPI_Reduce( sinbuf, soutbuf, 3, MPI_SHORT, MPI_BXOR, 0, comm );
if (rc) {
MTestPrintErrorMsg( "MPI_BXOR and MPI_SHORT", rc );
errs++;
}
else {
if (rank == 0) {
if (soutbuf[0] != ((size % 2) ? (short)0xffff : 0)) {
errs++;
fprintf( stderr, "short BXOR(1) test failed\n" );
}
if (soutbuf[1]) {
errs++;
fprintf( stderr, "short BXOR(0) test failed\n" );
}
if (soutbuf[2] != ((size % 2) ? (short)0xc3c3 : (short)0xffff)) {
errs++;
fprintf( stderr, "short BXOR(>) test failed\n" );
}
}
}
/* unsigned short */
MTestPrintfMsg( 10, "Reduce of MPI_UNSIGNED_SHORT\n" );
usinbuf[0] = 0xffff;
usinbuf[1] = 0;
usinbuf[2] = (rank > 0) ? 0x3c3c : 0xc3c3;
usoutbuf[0] = 0;
usoutbuf[1] = 1;
usoutbuf[2] = 1;
rc = MPI_Reduce( usinbuf, usoutbuf, 3, MPI_UNSIGNED_SHORT, MPI_BXOR, 0, comm );
if (rc) {
MTestPrintErrorMsg( "MPI_BXOR and MPI_UNSIGNED_SHORT", rc );
errs++;
}
else {
if (rank == 0) {
if (usoutbuf[0] != ((size % 2) ? 0xffff : 0)) {
errs++;
fprintf( stderr, "short BXOR(1) test failed\n" );
}
if (usoutbuf[1]) {
errs++;
fprintf( stderr, "short BXOR(0) test failed\n" );
}
if (usoutbuf[2] != ((size % 2) ? 0xc3c3 : 0xffff)) {
errs++;
fprintf( stderr, "short BXOR(>) test failed\n" );
}
}
}
/* unsigned */
MTestPrintfMsg( 10, "Reduce of MPI_UNSIGNED\n" );
uinbuf[0] = 0xffffffff;
uinbuf[1] = 0;
uinbuf[2] = (rank > 0) ? 0x3c3c3c3c : 0xc3c3c3c3;
uoutbuf[0] = 0;
uoutbuf[1] = 1;
uoutbuf[2] = 1;
rc = MPI_Reduce( uinbuf, uoutbuf, 3, MPI_UNSIGNED, MPI_BXOR, 0, comm );
if (rc) {
MTestPrintErrorMsg( "MPI_BXOR and MPI_UNSIGNED", rc );
errs++;
}
else {
if (rank == 0) {
if (uoutbuf[0] != ((size % 2) ? 0xffffffff : 0)) {
errs++;
fprintf( stderr, "unsigned BXOR(1) test failed\n" );
}
if (uoutbuf[1]) {
errs++;
fprintf( stderr, "unsigned BXOR(0) test failed\n" );
}
if (uoutbuf[2] != ((size % 2) ? 0xc3c3c3c3 : 0xffffffff)) {
errs++;
fprintf( stderr, "unsigned BXOR(>) test failed\n" );
}
}
}
/* int */
MTestPrintfMsg( 10, "Reduce of MPI_INT\n" );
iinbuf[0] = 0xffffffff;
iinbuf[1] = 0;
iinbuf[2] = (rank > 0) ? 0x3c3c3c3c : 0xc3c3c3c3;
ioutbuf[0] = 0;
ioutbuf[1] = 1;
ioutbuf[2] = 1;
rc = MPI_Reduce( iinbuf, ioutbuf, 3, MPI_INT, MPI_BXOR, 0, comm );
if (rc) {
MTestPrintErrorMsg( "MPI_BXOR and MPI_INT", rc );
errs++;
}
else {
if (rank == 0) {
if (ioutbuf[0] != ((size % 2) ? 0xffffffff : 0)) {
errs++;
fprintf( stderr, "int BXOR(1) test failed\n" );
}
if (ioutbuf[1]) {
errs++;
fprintf( stderr, "int BXOR(0) test failed\n" );
}
if (ioutbuf[2] != ((size % 2) ? 0xc3c3c3c3 : 0xffffffff)) {
errs++;
fprintf( stderr, "int BXOR(>) test failed\n" );
}
}
}
/* long */
MTestPrintfMsg( 10, "Reduce of MPI_LONG\n" );
linbuf[0] = 0xffffffff;
linbuf[1] = 0;
linbuf[2] = (rank > 0) ? 0x3c3c3c3c : 0xc3c3c3c3;
loutbuf[0] = 0;
loutbuf[1] = 1;
loutbuf[2] = 1;
rc = MPI_Reduce( linbuf, loutbuf, 3, MPI_LONG, MPI_BXOR, 0, comm );
if (rc) {
MTestPrintErrorMsg( "MPI_BXOR and MPI_LONG", rc );
errs++;
}
else {
if (rank == 0) {
if (loutbuf[0] != ((size % 2) ? 0xffffffff : 0)) {
errs++;
fprintf( stderr, "long BXOR(1) test failed\n" );
}
if (loutbuf[1]) {
errs++;
fprintf( stderr, "long BXOR(0) test failed\n" );
}
if (loutbuf[2] != ((size % 2) ? 0xc3c3c3c3 : 0xffffffff)) {
errs++;
fprintf( stderr, "long BXOR(>) test failed\n" );
}
}
}
/* unsigned long */
MTestPrintfMsg( 10, "Reduce of MPI_UNSIGNED_LONG\n" );
ulinbuf[0] = 0xffffffff;
ulinbuf[1] = 0;
ulinbuf[2] = (rank > 0) ? 0x3c3c3c3c : 0xc3c3c3c3;
uloutbuf[0] = 0;
uloutbuf[1] = 1;
uloutbuf[2] = 1;
rc = MPI_Reduce( ulinbuf, uloutbuf, 3, MPI_UNSIGNED_LONG, MPI_BXOR, 0, comm );
if (rc) {
MTestPrintErrorMsg( "MPI_BXOR and MPI_UNSIGNED_LONG", rc );
errs++;
}
else {
if (rank == 0) {
if (uloutbuf[0] != ((size % 2) ? 0xffffffff : 0)) {
errs++;
fprintf( stderr, "unsigned long BXOR(1) test failed\n" );
}
if (uloutbuf[1]) {
errs++;
fprintf( stderr, "unsigned long BXOR(0) test failed\n" );
}
if (uloutbuf[2] != ((size % 2) ? 0xc3c3c3c3 : 0xffffffff)) {
errs++;
fprintf( stderr, "unsigned long BXOR(>) test failed\n" );
}
}
}
#ifdef HAVE_LONG_LONG
{
long long llinbuf[3], lloutbuf[3];
/* long long */
llinbuf[0] = 0xffffffff;
llinbuf[1] = 0;
llinbuf[2] = (rank > 0) ? 0x3c3c3c3c : 0xc3c3c3c3;
lloutbuf[0] = 0;
lloutbuf[1] = 1;
lloutbuf[2] = 1;
if (MPI_LONG_LONG != MPI_DATATYPE_NULL) {
MTestPrintfMsg( 10, "Reduce of MPI_LONG_LONG\n" );
rc = MPI_Reduce( llinbuf, lloutbuf, 3, MPI_LONG_LONG, MPI_BXOR, 0, comm );
if (rc) {
MTestPrintErrorMsg( "MPI_BXOR and MPI_LONG_LONG", rc );
errs++;
}
else {
if (rank == 0) {
if (lloutbuf[0] != ((size % 2) ? 0xffffffff : 0)) {
errs++;
fprintf( stderr, "long long BXOR(1) test failed\n" );
}
if (lloutbuf[1]) {
errs++;
fprintf( stderr, "long long BXOR(0) test failed\n" );
}
if (lloutbuf[2] != ((size % 2) ? 0xc3c3c3c3 : 0xffffffff)) {
errs++;
fprintf( stderr, "long long BXOR(>) test failed\n" );
}
}
}
}
}
#endif
MPI_Errhandler_set( comm, MPI_ERRORS_ARE_FATAL );
MTest_Finalize( errs );
MPI_Finalize();
return 0;
}
int main(int argc, char *argv[])
{
int errs = 0;
int rank, size, source, dest, partner;
int i, testnum;
double tsend;
static int msgsizes[] = { 100, 1000, 10000, 100000, -1 };
static int nmsgs[] = { 100, 10, 10, 4 };
MPI_Comm comm;
MTest_Init(&argc, &argv);
comm = MPI_COMM_WORLD;
MPI_Comm_rank(comm, &rank);
MPI_Comm_size(comm, &size);
source = 0;
dest = 1;
if (size < 2) {
printf("This test requires at least 2 processes\n");
MPI_Abort(MPI_COMM_WORLD, 1);
}
for (testnum = 0; msgsizes[testnum] > 0; testnum++) {
if (rank == source || rank == dest) {
int nmsg = nmsgs[testnum];
int msgSize = msgsizes[testnum];
MPI_Request r[MAX_NMSGS];
int *buf[MAX_NMSGS];
for (i = 0; i < nmsg; i++) {
buf[i] = (int *) malloc(msgSize * sizeof(int));
if (!buf[i]) {
fprintf(stderr, "Unable to allocate %d bytes\n", msgSize);
MPI_Abort(MPI_COMM_WORLD, 1);
}
MTEST_VG_MEM_INIT(buf[i], msgSize * sizeof(int));
}
partner = (rank + 1) % size;
MPI_Sendrecv(MPI_BOTTOM, 0, MPI_INT, partner, 10,
MPI_BOTTOM, 0, MPI_INT, partner, 10, comm, MPI_STATUS_IGNORE);
/* Try to fill up the outgoing message buffers */
for (i = 0; i < nmsg; i++) {
MPI_Isend(buf[i], msgSize, MPI_INT, partner, testnum, comm, &r[i]);
}
for (i = 0; i < nmsg; i++) {
MPI_Recv(buf[i], msgSize, MPI_INT, partner, testnum, comm, MPI_STATUS_IGNORE);
}
MPI_Waitall(nmsg, r, MPI_STATUSES_IGNORE);
/* Repeat the test, but make one of the processes sleep */
MPI_Sendrecv(MPI_BOTTOM, 0, MPI_INT, partner, 10,
MPI_BOTTOM, 0, MPI_INT, partner, 10, comm, MPI_STATUS_IGNORE);
if (rank == dest)
MTestSleep(1);
/* Try to fill up the outgoing message buffers */
tsend = MPI_Wtime();
for (i = 0; i < nmsg; i++) {
MPI_Isend(buf[i], msgSize, MPI_INT, partner, testnum, comm, &r[i]);
}
tsend = MPI_Wtime() - tsend;
for (i = 0; i < nmsg; i++) {
MPI_Recv(buf[i], msgSize, MPI_INT, partner, testnum, comm, MPI_STATUS_IGNORE);
}
MPI_Waitall(nmsg, r, MPI_STATUSES_IGNORE);
if (tsend > 0.5) {
printf("Isends for %d messages of size %d took too long (%f seconds)\n", nmsg,
msgSize, tsend);
errs++;
}
MTestPrintfMsg(1, "%d Isends for size = %d took %f seconds\n", nmsg, msgSize, tsend);
for (i = 0; i < nmsg; i++) {
free(buf[i]);
}
}
}
MTest_Finalize(errs);
return MTestReturnValue(errs);
}
int main( int argc, char *argv[] )
{
int gM, gN, lm, lmlast, ln, lnlast, i, j, errs = 0;
int size, rank;
float *localA, *localB;
MPI_Comm comm;
MTest_Init( &argc, &argv );
comm = MPI_COMM_WORLD;
MPI_Comm_size( comm, &size );
MPI_Comm_rank( comm, &rank );
gM = 20;
gN = 30;
/* Each block is lm x ln in size, except for the last process,
which has lmlast x lnlast */
lm = gM/size;
lmlast = gM - (size - 1)*lm;
ln = gN/size;
lnlast = gN - (size - 1)*ln;
/* Create the local matrices.
Initialize the input matrix so that the entries are
consequtive integers, by row, starting at 0.
*/
if (rank == size - 1) {
localA = (float *)malloc( gN * lmlast * sizeof(float) );
localB = (float *)malloc( gM * lnlast * sizeof(float) );
for (i=0; i<lmlast; i++) {
for (j=0; j<gN; j++) {
localA[i*gN+j] = (float)(i*gN+j + rank * gN * lm);
}
}
}
else {
localA = (float *)malloc( gN * lm * sizeof(float) );
localB = (float *)malloc( gM * ln * sizeof(float) );
for (i=0; i<lm; i++) {
for (j=0; j<gN; j++) {
localA[i*gN+j] = (float)(i*gN+j + rank * gN * lm);
}
}
}
MTestPrintfMsg( 2, "Allocated local arrays\n" );
/* Transpose */
Transpose( localA, localB, gM, gN, comm );
/* check the transposed matrix
In the global matrix, the transpose has consequtive integers,
organized by columns.
*/
if (rank == size - 1) {
for (i=0; i<lnlast; i++) {
for (j=0; j<gM; j++) {
int expected = i+gN*j + rank * ln;
if ((int)localB[i*gM+j] != expected) {
if (errs < MAX_ERRORS)
printf( "Found %d but expected %d\n",
(int)localB[i*gM+j], expected );
errs++;
}
}
}
}
else {
for (i=0; i<ln; i++) {
for (j=0; j<gM; j++) {
int expected = i+gN*j + rank * ln;
if ((int)localB[i*gM+j] != expected) {
if (errs < MAX_ERRORS)
printf( "Found %d but expected %d\n",
(int)localB[i*gM+j], expected );
errs++;
}
}
}
}
/* Free storage */
free( localA );
free( localB );
MTest_Finalize( errs );
MPI_Finalize();
return 0;
}
void Transpose(float *localA, float *localB, int M, int N, MPI_Comm comm)
/* transpose MxN matrix A that is block distributed (1-D) on
processes of comm onto block distributed matrix B */
{
int i, j, extent, myrank, p, n[2], m[2];
int lasti, lastj;
int *sendcounts, *recvcounts;
int *sdispls, *rdispls;
MPI_Datatype xtype[2][2], stype[2][2], *sendtypes, *recvtypes;
MTestPrintfMsg( 2, "M = %d, N = %d\n", M, N );
/* compute parameters */
MPI_Comm_size(comm, &p);
MPI_Comm_rank(comm, &myrank);
extent = sizeof(float);
/* allocate arrays */
sendcounts = (int *)malloc(p*sizeof(int));
recvcounts = (int *)malloc(p*sizeof(int));
sdispls = (int *)malloc(p*sizeof(int));
rdispls = (int *)malloc(p*sizeof(int));
sendtypes = (MPI_Datatype *)malloc(p*sizeof(MPI_Datatype));
recvtypes = (MPI_Datatype *)malloc(p*sizeof(MPI_Datatype));
/* compute block sizes */
m[0] = M/p;
m[1] = M - (p-1)*(M/p);
n[0] = N/p;
n[1] = N - (p-1)*(N/p);
/* compute types */
for (i=0; i <= 1; i++)
for (j=0; j <= 1; j++) {
xtype[i][j] = transpose_type(N, m[i], n[j], MPI_FLOAT);
stype[i][j] = submatrix_type(M, m[i], n[j], MPI_FLOAT);
}
/* prepare collective operation arguments */
lasti = myrank == p-1;
for (j=0; j < p; j++) {
lastj = j == p-1;
sendcounts[j] = 1;
sdispls[j] = j*n[0]*extent;
sendtypes[j] = xtype[lasti][lastj];
recvcounts[j] = 1;
rdispls[j] = j*m[0]*extent;
recvtypes[j] = stype[lastj][lasti];
}
/* communicate */
MTestPrintfMsg( 2, "Begin Alltoallw...\n" );
/* -- Note that the book incorrectly uses &localA and &localB
as arguments to MPI_Alltoallw */
MPI_Alltoallw(localA, sendcounts, sdispls, sendtypes,
localB, recvcounts, rdispls, recvtypes, comm);
MTestPrintfMsg( 2, "Done with Alltoallw\n" );
/* Free buffers */
free( sendcounts );
free( recvcounts );
free( sdispls );
free( rdispls );
free( sendtypes );
free( recvtypes );
/* Free datatypes */
for (i=0; i <= 1; i++)
for (j=0; j <= 1; j++) {
MPI_Type_free( &xtype[i][j] );
MPI_Type_free( &stype[i][j] );
}
}
int main( int argc, char *argv[] )
{
int errs = 0, err;
int rank, size, source, dest;
int minsize = 2, count;
MPI_Comm comm;
MPI_Win win;
MPI_Aint extent;
MTestDatatype sendtype, recvtype;
MTest_Init( &argc, &argv );
/* The following illustrates the use of the routines to
run through a selection of communicators and datatypes.
Use subsets of these for tests that do not involve combinations
of communicators, datatypes, and counts of datatypes */
while (MTestGetIntracommGeneral( &comm, minsize, 1 )) {
if (comm == MPI_COMM_NULL) continue;
/* Determine the sender and receiver */
MPI_Comm_rank( comm, &rank );
MPI_Comm_size( comm, &size );
source = 0;
dest = size - 1;
for (count = 1; count < 65000; count = count * 2) {
while (MTestGetDatatypes( &sendtype, &recvtype, count )) {
MTestPrintfMsg( 1,
"Putting count = %d of sendtype %s receive type %s\n",
count, MTestGetDatatypeName( &sendtype ),
MTestGetDatatypeName( &recvtype ) );
/* Make sure that everyone has a recv buffer */
recvtype.InitBuf( &recvtype );
MPI_Type_extent( recvtype.datatype, &extent );
MPI_Win_create( recvtype.buf, recvtype.count * extent,
extent, MPI_INFO_NULL, comm, &win );
MPI_Win_fence( 0, win );
if (rank == source) {
/* To improve reporting of problems about operations, we
change the error handler to errors return */
MPI_Win_set_errhandler( win, MPI_ERRORS_RETURN );
sendtype.InitBuf( &sendtype );
err = MPI_Put( sendtype.buf, sendtype.count,
sendtype.datatype, dest, 0,
recvtype.count, recvtype.datatype, win );
if (err) {
errs++;
if (errs < 10) {
MTestPrintError( err );
}
}
err = MPI_Win_fence( 0, win );
if (err) {
errs++;
if (errs < 10) {
MTestPrintError( err );
}
}
}
else if (rank == dest) {
MPI_Win_fence( 0, win );
/* This should have the same effect, in terms of
transfering data, as a send/recv pair */
err = MTestCheckRecv( 0, &recvtype );
if (err) {
if (errs < 10) {
printf( "Data in target buffer did not match for destination datatype %s (put with source datatype %s)\n",
MTestGetDatatypeName( &recvtype ),
MTestGetDatatypeName( &sendtype ) );
/* Redo the test, with the errors printed */
recvtype.printErrors = 1;
(void)MTestCheckRecv( 0, &recvtype );
}
errs += err;
}
}
else {
MPI_Win_fence( 0, win );
}
MPI_Win_free( &win );
MTestFreeDatatype( &sendtype );
MTestFreeDatatype( &recvtype );
}
}
MTestFreeComm(&comm);
}
MTest_Finalize( errs );
MPI_Finalize();
return 0;
}
int main(int argc, char *argv[])
{
int errs = 0;
int rank, size, source, dest;
MPI_Comm comm;
MPI_Status status;
MPI_Request req;
static int bufsizes[4] = { 1, 100, 10000, 1000000 };
char *buf;
#ifdef TEST_IRSEND
int veryPicky = 0; /* Set to 1 to test "quality of implementation" in
* a tricky part of cancel */
#endif
int cs, flag, n;
MTest_Init(&argc, &argv);
comm = MPI_COMM_WORLD;
MPI_Comm_rank(comm, &rank);
MPI_Comm_size(comm, &size);
source = 0;
dest = size - 1;
MTestPrintfMsg(1, "Starting scancel test\n");
for (cs = 0; cs < 4; cs++) {
if (rank == 0) {
n = bufsizes[cs];
buf = (char *) malloc(n);
if (!buf) {
fprintf(stderr, "Unable to allocate %d bytes\n", n);
MPI_Abort(MPI_COMM_WORLD, 1);
}
MTestPrintfMsg(1, "(%d) About to create isend and cancel\n", cs);
MPI_Isend(buf, n, MPI_CHAR, dest, cs + n + 1, comm, &req);
MPI_Cancel(&req);
MPI_Wait(&req, &status);
MTestPrintfMsg(1, "Completed wait on isend\n");
MPI_Test_cancelled(&status, &flag);
if (!flag) {
errs++;
printf("Failed to cancel an Isend request\n");
fflush(stdout);
}
else {
n = 0;
}
/* Send the size, zero for successfully cancelled */
MPI_Send(&n, 1, MPI_INT, dest, 123, comm);
/* Send the tag so the message can be received */
n = cs + n + 1;
MPI_Send(&n, 1, MPI_INT, dest, 123, comm);
free(buf);
}
else if (rank == dest) {
int nn, tag;
char *btemp;
MPI_Recv(&nn, 1, MPI_INT, 0, 123, comm, &status);
MPI_Recv(&tag, 1, MPI_INT, 0, 123, comm, &status);
if (nn > 0) {
/* If the message was not cancelled, receive it here */
btemp = (char *) malloc(nn);
if (!btemp) {
fprintf(stderr, "Unable to allocate %d bytes\n", nn);
MPI_Abort(MPI_COMM_WORLD, 1);
}
MPI_Recv(btemp, nn, MPI_CHAR, 0, tag, comm, &status);
free(btemp);
}
}
MPI_Barrier(comm);
if (rank == 0) {
char *bsendbuf;
int bsendbufsize;
int bf, bs;
n = bufsizes[cs];
buf = (char *) malloc(n);
if (!buf) {
fprintf(stderr, "Unable to allocate %d bytes\n", n);
MPI_Abort(MPI_COMM_WORLD, 1);
}
bsendbufsize = n + MPI_BSEND_OVERHEAD;
bsendbuf = (char *) malloc(bsendbufsize);
if (!bsendbuf) {
fprintf(stderr, "Unable to allocate %d bytes for bsend\n", n);
MPI_Abort(MPI_COMM_WORLD, 1);
}
MPI_Buffer_attach(bsendbuf, bsendbufsize);
MTestPrintfMsg(1, "About to create and cancel ibsend\n");
MPI_Ibsend(buf, n, MPI_CHAR, dest, cs + n + 2, comm, &req);
MPI_Cancel(&req);
MPI_Wait(&req, &status);
MPI_Test_cancelled(&status, &flag);
if (!flag) {
errs++;
printf("Failed to cancel an Ibsend request\n");
fflush(stdout);
}
else {
n = 0;
}
/* Send the size, zero for successfully cancelled */
MPI_Send(&n, 1, MPI_INT, dest, 123, comm);
/* Send the tag so the message can be received */
n = cs + n + 2;
MPI_Send(&n, 1, MPI_INT, dest, 123, comm);
free(buf);
MPI_Buffer_detach(&bf, &bs);
free(bsendbuf);
}
else if (rank == dest) {
int nn, tag;
char *btemp;
MPI_Recv(&nn, 1, MPI_INT, 0, 123, comm, &status);
MPI_Recv(&tag, 1, MPI_INT, 0, 123, comm, &status);
if (nn > 0) {
/* If the message was not cancelled, receive it here */
btemp = (char *) malloc(nn);
if (!btemp) {
fprintf(stderr, "Unable to allocate %d bytes\n", nn);
MPI_Abort(MPI_COMM_WORLD, 1);
}
MPI_Recv(btemp, nn, MPI_CHAR, 0, tag, comm, &status);
free(btemp);
}
}
MPI_Barrier(comm);
/* Because this test is erroneous, we do not perform it unless
* TEST_IRSEND is defined. */
#ifdef TEST_IRSEND
/* We avoid ready send to self because an implementation
* is free to detect the error in delivering a message to
* itself without a pending receive; we could also check
* for an error return from the MPI_Irsend */
if (rank == 0 && dest != rank) {
n = bufsizes[cs];
buf = (char *) malloc(n);
if (!buf) {
fprintf(stderr, "Unable to allocate %d bytes\n", n);
MPI_Abort(MPI_COMM_WORLD, 1);
}
MTestPrintfMsg(1, "About to create and cancel irsend\n");
MPI_Irsend(buf, n, MPI_CHAR, dest, cs + n + 3, comm, &req);
MPI_Cancel(&req);
MPI_Wait(&req, &status);
MPI_Test_cancelled(&status, &flag);
/* This can be pretty ugly. The standard is clear (Section 3.8)
* that either a sent message is received or the
* sent message is successfully cancelled. Since this message
* can never be received, the cancel must complete
* successfully.
*
* However, since there is no matching receive, this
* program is erroneous. In this case, we can't really
* flag this as an error */
if (!flag && veryPicky) {
errs++;
printf("Failed to cancel an Irsend request\n");
fflush(stdout);
}
if (flag) {
n = 0;
}
/* Send the size, zero for successfully cancelled */
MPI_Send(&n, 1, MPI_INT, dest, 123, comm);
/* Send the tag so the message can be received */
n = cs + n + 3;
MPI_Send(&n, 1, MPI_INT, dest, 123, comm);
free(buf);
}
else if (rank == dest) {
int n, tag;
char *btemp;
MPI_Recv(&n, 1, MPI_INT, 0, 123, comm, &status);
MPI_Recv(&tag, 1, MPI_INT, 0, 123, comm, &status);
if (n > 0) {
/* If the message was not cancelled, receive it here */
btemp = (char *) malloc(n);
if (!btemp) {
fprintf(stderr, "Unable to allocate %d bytes\n", n);
MPI_Abort(MPI_COMM_WORLD, 1);
}
MPI_Recv(btemp, n, MPI_CHAR, 0, tag, comm, &status);
free(btemp);
}
}
MPI_Barrier(comm);
#endif
if (rank == 0) {
n = bufsizes[cs];
buf = (char *) malloc(n);
if (!buf) {
fprintf(stderr, "Unable to allocate %d bytes\n", n);
MPI_Abort(MPI_COMM_WORLD, 1);
}
MTestPrintfMsg(1, "About to create and cancel issend\n");
MPI_Issend(buf, n, MPI_CHAR, dest, cs + n + 4, comm, &req);
MPI_Cancel(&req);
MPI_Wait(&req, &status);
MPI_Test_cancelled(&status, &flag);
if (!flag) {
errs++;
printf("Failed to cancel an Issend request\n");
fflush(stdout);
}
else {
n = 0;
}
/* Send the size, zero for successfully cancelled */
MPI_Send(&n, 1, MPI_INT, dest, 123, comm);
/* Send the tag so the message can be received */
n = cs + n + 4;
MPI_Send(&n, 1, MPI_INT, dest, 123, comm);
free(buf);
}
else if (rank == dest) {
int nn, tag;
char *btemp;
MPI_Recv(&nn, 1, MPI_INT, 0, 123, comm, &status);
MPI_Recv(&tag, 1, MPI_INT, 0, 123, comm, &status);
if (nn > 0) {
/* If the message was not cancelled, receive it here */
btemp = (char *) malloc(nn);
if (!btemp) {
fprintf(stderr, "Unable to allocate %d bytes\n", nn);
MPI_Abort(MPI_COMM_WORLD, 1);
}
MPI_Recv(btemp, nn, MPI_CHAR, 0, tag, comm, &status);
free(btemp);
}
}
MPI_Barrier(comm);
}
MTest_Finalize(errs);
MPI_Finalize();
return 0;
}
int main( int argc, char *argv[] )
{
int errs = 0;
int size, isLeft;
MPI_Comm intercomm, newcomm;
MTest_Init( &argc, &argv );
MPI_Comm_size( MPI_COMM_WORLD, &size );
if (size < 4) {
printf( "This test requires at least 4 processes\n" );
MPI_Abort( MPI_COMM_WORLD, 1 );
}
while (MTestGetIntercomm( &intercomm, &isLeft, 2 )) {
int key, color;
if (intercomm == MPI_COMM_NULL) continue;
/* Split this intercomm. The new intercomms contain the
processes that had odd (resp even) rank in their local group
in the original intercomm */
MTestPrintfMsg( 1, "Created intercomm %s\n", MTestGetIntercommName() );
MPI_Comm_rank( intercomm, &key );
color = (key % 2);
MPI_Comm_split( intercomm, color, key, &newcomm );
/* Make sure that the new communicator has the appropriate pieces */
if (newcomm != MPI_COMM_NULL) {
int orig_rsize, orig_size, new_rsize, new_size;
int predicted_size, flag, commok=1;
MPI_Comm_test_inter( intercomm, &flag );
if (!flag) {
errs++;
printf( "Output communicator is not an intercomm\n" );
commok = 0;
}
MPI_Comm_remote_size( intercomm, &orig_rsize );
MPI_Comm_remote_size( newcomm, &new_rsize );
MPI_Comm_size( intercomm, &orig_size );
MPI_Comm_size( newcomm, &new_size );
/* The local size is 1/2 the original size, +1 if the
size was odd and the color was even. More precisely,
let n be the orig_size. Then
color 0 color 1
orig size even n/2 n/2
orig size odd (n+1)/2 n/2
However, since these are integer valued, if n is even,
then (n+1)/2 = n/2, so this table is much simpler:
color 0 color 1
orig size even (n+1)/2 n/2
orig size odd (n+1)/2 n/2
*/
predicted_size = (orig_size + !color) / 2;
if (predicted_size != new_size) {
errs++;
printf( "Predicted size = %d but found %d for %s (%d,%d)\n",
predicted_size, new_size, MTestGetIntercommName(),
orig_size, orig_rsize );
commok = 0;
}
predicted_size = (orig_rsize + !color) / 2;
if (predicted_size != new_rsize) {
errs++;
printf( "Predicted remote size = %d but found %d for %s (%d,%d)\n",
predicted_size, new_rsize, MTestGetIntercommName(),
orig_size, orig_rsize );
commok = 0;
}
/* ... more to do */
if (commok) {
errs += TestIntercomm( newcomm );
}
}
else {
int orig_rsize;
/* If the newcomm is null, then this means that remote group
for this color is of size zero (since all processes in this
test have been given colors other than MPI_UNDEFINED).
Confirm that here */
/* FIXME: ToDo */
MPI_Comm_remote_size( intercomm, &orig_rsize );
if (orig_rsize == 1) {
if (color == 0) {
errs++;
printf( "Returned null intercomm when non-null expected\n" );
}
}
}
if (newcomm != MPI_COMM_NULL)
MPI_Comm_free( &newcomm );
MPI_Comm_free( &intercomm );
}
MTest_Finalize(errs);
MPI_Finalize();
return 0;
}
static inline int test(MPI_Comm comm, int rank, int source, int dest,
MTestDatatype * sendtype, MTestDatatype * recvtype)
{
int errs = 0, err;
MPI_Aint extent, lb;
MPI_Win win;
MTestPrintfMsg(1,
"Putting count = %ld of sendtype %s - count = %ld receive type %s\n",
sendtype->count, MTestGetDatatypeName(sendtype), recvtype->count,
MTestGetDatatypeName(recvtype));
/* Make sure that everyone has a recv buffer */
recvtype->InitBuf(recvtype);
MPI_Type_extent(recvtype->datatype, &extent);
MPI_Type_lb(recvtype->datatype, &lb);
MPI_Win_create(recvtype->buf, recvtype->count * extent + lb, extent, MPI_INFO_NULL, comm, &win);
MPI_Win_fence(0, win);
if (rank == source) {
/* To improve reporting of problems about operations, we
* change the error handler to errors return */
MPI_Win_set_errhandler(win, MPI_ERRORS_RETURN);
sendtype->InitBuf(sendtype);
err = MPI_Put(sendtype->buf, sendtype->count,
sendtype->datatype, dest, 0, recvtype->count, recvtype->datatype, win);
if (err) {
errs++;
if (errs < 10) {
MTestPrintError(err);
}
}
err = MPI_Win_fence(0, win);
if (err) {
errs++;
if (errs < 10) {
MTestPrintError(err);
}
}
}
else if (rank == dest) {
MPI_Win_fence(0, win);
/* This should have the same effect, in terms of
* transfering data, as a send/recv pair */
err = MTestCheckRecv(0, recvtype);
if (err) {
if (errs < 10) {
printf
("Data in target buffer did not match for destination datatype %s (put with source datatype %s)\n",
MTestGetDatatypeName(recvtype), MTestGetDatatypeName(sendtype));
/* Redo the test, with the errors printed */
recvtype->printErrors = 1;
(void) MTestCheckRecv(0, recvtype);
}
errs += err;
}
}
else {
MPI_Win_fence(0, win);
}
MPI_Win_free(&win);
return errs;
}
int main( int argc, char *argv[] )
{
int errs = 0;
MPI_Win win;
int *rmabuffer=0, *getbuf=0;
MPI_Aint bufsize=0, getbufsize=0;
int master, partner, next, wrank, wsize, i;
int ntest = LAST_TEST;
int *srcbuf;
MTest_Init( &argc, &argv );
/* Determine who is responsible for each part of the test */
MPI_Comm_rank( MPI_COMM_WORLD, &wrank );
MPI_Comm_size( MPI_COMM_WORLD, &wsize );
if (wsize < 3) {
fprintf( stderr, "This test requires at least 3 processes\n" );
MPI_Abort( MPI_COMM_WORLD, 1 );
}
master = 0;
partner = 1;
next = wrank + 1;
if (next == partner) next++;
if (next >= wsize) {
next = 0;
if (next == partner) next++;
}
/* Determine the last test to run (by default, run them all) */
for (i=1; i<argc; i++) {
if (strcmp( "-ntest", argv[i] ) == 0) {
i++;
if (i < argc) {
ntest = atoi( argv[i] );
}
else {
fprintf( stderr, "Missing value for -ntest\n" );
MPI_Abort( MPI_COMM_WORLD, 1 );
}
}
}
MPI_Type_vector( veccount, 1, stride, MPI_INT, &vectype );
MPI_Type_commit( &vectype );
/* Create the RMA window */
bufsize = 0;
if (wrank == master) {
bufsize = RMA_SIZE;
MPI_Alloc_mem( bufsize*sizeof(int), MPI_INFO_NULL, &rmabuffer );
}
else if (wrank == partner) {
getbufsize = RMA_SIZE;
getbuf = (int *)malloc( getbufsize*sizeof(int) );
if (!getbuf) {
fprintf( stderr, "Unable to allocated %d bytes for getbuf\n",
(int)getbufsize );
MPI_Abort( MPI_COMM_WORLD, 1 );
}
}
srcbuf = malloc(RMA_SIZE*sizeof(*srcbuf));
assert(srcbuf);
MPI_Win_create( rmabuffer, bufsize, sizeof(int), MPI_INFO_NULL,
MPI_COMM_WORLD, &win );
/* Run a sequence of tests */
for (i=0; i<=ntest; i++) {
if (wrank == master) {
MTestPrintfMsg( 0, "Test %d\n", i );
/* Because this lock is local, it must return only when the
lock is acquired */
MPI_Win_lock( MPI_LOCK_EXCLUSIVE, 0, master, win );
RMATestInit( i, rmabuffer, bufsize );
MPI_Send( MPI_BOTTOM, 0, MPI_INT, partner, i, MPI_COMM_WORLD );
MPI_Send( MPI_BOTTOM, 0, MPI_INT, next, i, MPI_COMM_WORLD );
MPI_Recv( MPI_BOTTOM, 0, MPI_INT, MPI_ANY_SOURCE, i,
MPI_COMM_WORLD, MPI_STATUS_IGNORE );
MPI_Win_unlock( master, win );
MPI_Recv( MPI_BOTTOM, 0, MPI_INT, partner, i, MPI_COMM_WORLD,
MPI_STATUS_IGNORE );
errs += RMACheck( i, rmabuffer, bufsize );
}
else if (wrank == partner) {
MPI_Recv( MPI_BOTTOM, 0, MPI_INT, master, i, MPI_COMM_WORLD,
MPI_STATUS_IGNORE );
MPI_Win_lock( MPI_LOCK_EXCLUSIVE, 0, master, win );
RMATest( i, win, master, srcbuf, RMA_SIZE, getbuf, getbufsize );
MPI_Win_unlock( master, win );
errs += RMACheckGet( i, win, getbuf, getbufsize );
MPI_Send( MPI_BOTTOM, 0, MPI_INT, master, i, MPI_COMM_WORLD );
}
else {
MPI_Recv( MPI_BOTTOM, 0, MPI_INT, MPI_ANY_SOURCE, i,
MPI_COMM_WORLD, MPI_STATUS_IGNORE );
MPI_Send( MPI_BOTTOM, 0, MPI_INT, next, i, MPI_COMM_WORLD );
}
}
if (rmabuffer) {
MPI_Free_mem( rmabuffer );
}
if (getbuf) {
free( getbuf );
}
MPI_Win_free( &win );
MPI_Type_free( &vectype );
MTest_Finalize( errs );
MPI_Finalize();
return MTestReturnValue( errs );
}
/* FIXME: This is copied from iccreate. It should be in one place */
int TestIntercomm( 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\n", commname );
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 */
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] );
}
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);
MPI_Waitall( remote_size, reqs, MPI_STATUSES_IGNORE );
free( reqs );
free( bufs );
free( bufmem );
return errs;
}
int main( int argc, char *argv[])
{
struct a { int i;
char c;
} s[10], s1[10];
int j;
int errs = 0;
int rank, size, tsize;
MPI_Aint text;
int blens[2];
MPI_Aint disps[2];
MPI_Datatype bases[2];
MPI_Datatype str, con;
MPI_Status status;
MTest_Init( &argc, &argv );
MPI_Comm_rank( MPI_COMM_WORLD, &rank );
MPI_Comm_size( MPI_COMM_WORLD, &size );
for( j = 0; j < 10; j ++ ) {
s[j].i = j + rank;
s[j].c = j + rank + 'a';
}
blens[0] = blens[1] = 1;
disps[0] = 0; disps[1] = sizeof(int);
bases[0] = MPI_INT; bases[1] = MPI_CHAR;
MPI_Type_struct( 2, blens, disps, bases, &str );
MPI_Type_commit( &str );
MPI_Type_contiguous( 10, str, &con );
MPI_Type_commit( &con );
MPI_Type_size( con, &tsize );
MPI_Type_extent( con, &text );
MTestPrintfMsg( 0, "Size of MPI array is %d, extent is %d\n",
tsize, text );
/* The following block of code is only for verbose-level output */
{
void * p1, *p2;
p1 = s;
p2 = &(s[10].i); /* This statement may fail on some systems */
MTestPrintfMsg( 0,
"C array starts at %p and ends at %p for a length of %d\n",
s, &(s[9].c), (char *)p2-(char *)p1 );
}
MPI_Type_extent( str, &text );
MPI_Type_size( str, &tsize );
MTestPrintfMsg( 0, "Size of MPI struct is %d, extent is %d\n",
tsize, (int)text );
MTestPrintfMsg( 0, "Size of C struct is %d\n", sizeof(struct a) );
if (text != sizeof(struct a)) {
fprintf( stderr,
"Extent of struct a (%d) does not match sizeof (%d)\n",
(int)text, (int)sizeof(struct a) );
errs++;
}
MPI_Send( s, 1, con, rank ^ 1, 0, MPI_COMM_WORLD );
MPI_Recv( s1, 1, con, rank ^ 1, 0, MPI_COMM_WORLD, &status );
for( j = 0; j < 10; j++ ) {
MTestPrintfMsg( 0, "%d Sent: %d %c, Got: %d %c\n", rank,
s[j].i, s[j].c, s1[j].i, s1[j].c );
if ( s1[j].i != j + status.MPI_SOURCE ) {
errs++;
fprintf( stderr, "Got s[%d].i = %d; expected %d\n", j, s1[j].i,
j + status.MPI_SOURCE );
}
if ( s1[j].c != 'a' + j + status.MPI_SOURCE ) {
errs++;
/* If the character is not a printing character,
this can generate a file that diff, for example,
believes is a binary file */
if (isprint( (int)(s1[j].c) )) {
fprintf( stderr, "Got s[%d].c = %c; expected %c\n",
j, s1[j].c, j + status.MPI_SOURCE + 'a');
}
else {
fprintf( stderr, "Got s[%d].c = %x; expected %c\n",
j, (int)s1[j].c, j + status.MPI_SOURCE + 'a');
}
}
}
MPI_Type_free( &str );
MPI_Type_free( &con );
MTest_Finalize( errs );
MPI_Finalize();
return 0;
}
/*
* This program verifies that MPI_Probe() is operating properly in the face of
* unexpected messages arriving after MPI_Probe() has
* been called. This program may hang if MPI_Probe() does not return when the
* message finally arrives (see req #375).
*/
int main(int argc, char **argv)
{
int p_size;
int p_rank;
int msg_size_lg;
int errs = 0;
int mpi_errno;
MTest_Init(&argc, &argv);
MPI_Comm_size(MPI_COMM_WORLD, &p_size);
MPI_Comm_rank(MPI_COMM_WORLD, &p_rank);
/* To improve reporting of problems about operations, we
* change the error handler to errors return */
MPI_Comm_set_errhandler(MPI_COMM_WORLD, MPI_ERRORS_RETURN);
for (msg_size_lg = 0; msg_size_lg <= MAX_BUF_SIZE_LG; msg_size_lg++) {
const int msg_size = 1 << msg_size_lg;
int msg_cnt;
MTestPrintfMsg(2, "testing messages of size %d\n", msg_size);
for (msg_cnt = 0; msg_cnt < NUM_MSGS_PER_BUF_SIZE; msg_cnt++) {
MPI_Status status;
const int tag = msg_size_lg * NUM_MSGS_PER_BUF_SIZE + msg_cnt;
MTestPrintfMsg(2, "Message count %d\n", msg_cnt);
if (p_rank == 0) {
int p;
for (p = 1; p < p_size; p++) {
/* Wait for synchronization message */
mpi_errno = MPI_Recv(NULL, 0, MPI_BYTE, MPI_ANY_SOURCE,
tag, MPI_COMM_WORLD, &status);
if (mpi_errno != MPI_SUCCESS && errs++ < 10) {
MTestPrintError(mpi_errno);
}
if (status.MPI_TAG != tag && errs++ < 10) {
printf
("ERROR: unexpected message tag from MPI_Recv(): lp=0, rp=%d, expected=%d, actual=%d, count=%d\n",
status.MPI_SOURCE, status.MPI_TAG, tag, msg_cnt);
}
# if defined(VERBOSE)
{
printf("sending message: p=%d s=%d c=%d\n",
status.MPI_SOURCE, msg_size, msg_cnt);
}
# endif
/* Send unexpected message which hopefully MPI_Probe() is
* already waiting for at the remote process */
mpi_errno = MPI_Send(buf, msg_size, MPI_BYTE,
status.MPI_SOURCE, status.MPI_TAG, MPI_COMM_WORLD);
if (mpi_errno != MPI_SUCCESS && errs++ < 10) {
MTestPrintError(mpi_errno);
}
}
} else {
int incoming_msg_size;
/* Send synchronization message */
mpi_errno = MPI_Send(NULL, 0, MPI_BYTE, 0, tag, MPI_COMM_WORLD);
if (mpi_errno != MPI_SUCCESS && errs++ < 10) {
MTestPrintError(mpi_errno);
}
/* Perform probe, hopefully before the master process can
* send its reply */
mpi_errno = MPI_Probe(MPI_ANY_SOURCE, MPI_ANY_TAG, MPI_COMM_WORLD, &status);
if (mpi_errno != MPI_SUCCESS && errs++ < 10) {
MTestPrintError(mpi_errno);
}
mpi_errno = MPI_Get_count(&status, MPI_BYTE, &incoming_msg_size);
if (mpi_errno != MPI_SUCCESS && errs++ < 10) {
MTestPrintError(mpi_errno);
}
if (status.MPI_SOURCE != 0 && errs++ < 10) {
printf
("ERROR: unexpected message source from MPI_Probe(): p=%d, expected=0, actual=%d, count=%d\n",
p_rank, status.MPI_SOURCE, msg_cnt);
}
if (status.MPI_TAG != tag && errs++ < 10) {
printf
("ERROR: unexpected message tag from MPI_Probe(): p=%d, expected=%d, actual=%d, count=%d\n",
p_rank, tag, status.MPI_TAG, msg_cnt);
}
if (incoming_msg_size != msg_size && errs++ < 10) {
printf
("ERROR: unexpected message size from MPI_Probe(): p=%d, expected=%d, actual=%d, count=%d\n",
p_rank, msg_size, incoming_msg_size, msg_cnt);
}
/* Receive the probed message from the master process */
mpi_errno = MPI_Recv(buf, msg_size, MPI_BYTE, 0, tag, MPI_COMM_WORLD, &status);
if (mpi_errno != MPI_SUCCESS && errs++ < 10) {
MTestPrintError(mpi_errno);
}
mpi_errno = MPI_Get_count(&status, MPI_BYTE, &incoming_msg_size);
if (mpi_errno != MPI_SUCCESS && errs++ < 10) {
MTestPrintError(mpi_errno);
}
if (status.MPI_SOURCE != 0 && errs++ < 10) {
printf
("ERROR: unexpected message source from MPI_Recv(): p=%d, expected=0, actual=%d, count=%d\n",
p_rank, status.MPI_SOURCE, msg_cnt);
}
if (status.MPI_TAG != tag && errs++ < 10) {
printf
("ERROR: unexpected message tag from MPI_Recv(): p=%d, expected=%d, actual=%d, count=%d\n",
p_rank, tag, status.MPI_TAG, msg_cnt);
}
if (incoming_msg_size != msg_size && errs++ < 10) {
printf
("ERROR: unexpected message size from MPI_Recv(): p=%d, expected=%d, actual=%d, count=%d\n",
p_rank, msg_size, incoming_msg_size, msg_cnt);
}
}
}
}
MTest_Finalize(errs);
return MTestReturnValue(errs);
}
int main( int argc, char *argv[] )
{
int errs = 0;
int rank, size, source, dest;
MPI_Comm comm;
MPI_Status status;
MPI_Request req[4];
static int bufsizes[4] = { 1, 100, 10000, 1000000 };
char *bufs[4];
int flag, i;
MTest_Init( &argc, &argv );
comm = MPI_COMM_WORLD;
MPI_Comm_rank( comm, &rank );
MPI_Comm_size( comm, &size );
source = 0;
dest = size - 1;
if (rank == source) {
MPI_Send( MPI_BOTTOM, 0, MPI_CHAR, dest, 1, MPI_COMM_WORLD );
}
else if (rank == dest) {
/* Create 3 requests to cancel, plus one to use.
Then receive one message and exit */
for (i=0; i<4; i++) {
bufs[i] = (char *) malloc( bufsizes[i] );
MPI_Irecv( bufs[i], bufsizes[i], MPI_CHAR, source,
i, MPI_COMM_WORLD, &req[i] );
}
/* Now, cancel them in a more interesting order, to ensure that the
queue operation work properly */
MPI_Cancel( &req[2] );
MPI_Wait( &req[2], &status );
MTestPrintfMsg( 1, "Completed wait on irecv[2]\n" );
MPI_Test_cancelled( &status, &flag );
if (!flag) {
errs ++;
printf( "Failed to cancel a Irecv[2] request\n" );
fflush(stdout);
}
MPI_Cancel( &req[3] );
MPI_Wait( &req[3], &status );
MTestPrintfMsg( 1, "Completed wait on irecv[3]\n" );
MPI_Test_cancelled( &status, &flag );
if (!flag) {
errs ++;
printf( "Failed to cancel a Irecv[3] request\n" );
fflush(stdout);
}
MPI_Cancel( &req[0] );
MPI_Wait( &req[0], &status );
MTestPrintfMsg( 1, "Completed wait on irecv[0]\n" );
MPI_Test_cancelled( &status, &flag );
if (!flag) {
errs ++;
printf( "Failed to cancel a Irecv[0] request\n" );
fflush(stdout);
}
MPI_Wait( &req[1], &status );
MPI_Test_cancelled( &status, &flag );
if (flag) {
errs ++;
printf( "Incorrectly cancelled Irecv[1]\n" ); fflush(stdout);
}
}
MTest_Finalize( errs );
MPI_Finalize();
return 0;
}
int main(int argc, char **argv)
{
char name[MPI_MAX_OBJECT_NAME];
int namelen, i, inOptional;
int errs = 0;
MTest_Init(&argc, &argv);
/* Sample some datatypes */
/* See 8.4, "Naming Objects" in MPI-2. The default name is the same
* as the datatype name */
MPI_Type_get_name(MPI_DOUBLE, name, &namelen);
if (strncmp(name, "MPI_DOUBLE", MPI_MAX_OBJECT_NAME)) {
errs++;
fprintf(stderr, "Expected MPI_DOUBLE but got :%s:\n", name);
}
MPI_Type_get_name(MPI_INT, name, &namelen);
if (strncmp(name, "MPI_INT", MPI_MAX_OBJECT_NAME)) {
errs++;
fprintf(stderr, "Expected MPI_INT but got :%s:\n", name);
}
/* Now we try them ALL */
inOptional = 0;
for (i = 0; mpi_names[i].name != 0; i++) {
/* Are we in the optional types? */
if (strcmp(mpi_names[i].name, "MPI_REAL4") == 0)
inOptional = 1;
/* If this optional type is not supported, skip it */
if (inOptional && mpi_names[i].dtype == MPI_DATATYPE_NULL)
continue;
if (mpi_names[i].dtype == MPI_DATATYPE_NULL) {
/* Report an error because all of the standard types
* must be supported */
errs++;
fprintf(stderr, "MPI Datatype %s is MPI_DATATYPE_NULL\n", mpi_names[i].name);
continue;
}
MTestPrintfMsg(10, "Checking type %s\n", mpi_names[i].name);
name[0] = 0;
MPI_Type_get_name(mpi_names[i].dtype, name, &namelen);
if (strncmp(name, mpi_names[i].name, namelen)) {
errs++;
fprintf(stderr, "Expected %s but got %s\n", mpi_names[i].name, name);
}
}
/* Try resetting the name */
MPI_Type_set_name(MPI_INT, (char *) "int");
name[0] = 0;
MPI_Type_get_name(MPI_INT, name, &namelen);
if (strncmp(name, "int", MPI_MAX_OBJECT_NAME)) {
errs++;
fprintf(stderr, "Expected int but got :%s:\n", name);
}
#ifndef HAVE_MPI_INTEGER16
errs++;
fprintf(stderr, "MPI_INTEGER16 is not available\n");
#endif
MTest_Finalize(errs);
return MTestReturnValue(errs);
}
int test_communicators( void )
{
MPI_Comm dup_comm, comm;
void *vvalue;
int flag, world_rank, world_size, key_1, key_3;
int errs = 0;
MPI_Aint value;
int isLeft;
MPI_Comm_rank( MPI_COMM_WORLD, &world_rank );
MPI_Comm_size( MPI_COMM_WORLD, &world_size );
#ifdef DEBUG
if (world_rank == 0) {
printf( "*** Communicators ***\n" ); fflush(stdout);
}
#endif
while (MTestGetIntercomm( &comm, &isLeft, 2 )) {
MTestPrintfMsg(1, "start while loop, isLeft=%s\n", (isLeft ? "TRUE" : "FALSE"));
if (comm == MPI_COMM_NULL) {
MTestPrintfMsg(1, "got COMM_NULL, skipping\n");
continue;
}
/*
Check Comm_dup by adding attributes to comm & duplicating
*/
value = 9;
MPI_Keyval_create(copy_fn, delete_fn, &key_1, &value );
MTestPrintfMsg(1, "Keyval_create key=%#x value=%d\n", key_1, value);
value = 7;
MPI_Keyval_create(MPI_NULL_COPY_FN, MPI_NULL_DELETE_FN,
&key_3, &value );
MTestPrintfMsg(1, "Keyval_create key=%#x value=%d\n", key_3, value);
/* This may generate a compilation warning; it is, however, an
easy way to cache a value instead of a pointer */
/* printf( "key1 = %x key3 = %x\n", key_1, key_3 ); */
MPI_Attr_put(comm, key_1, (void *) (MPI_Aint) world_rank );
MPI_Attr_put(comm, key_3, (void *)0 );
MTestPrintfMsg(1, "Comm_dup\n" );
MPI_Comm_dup(comm, &dup_comm );
/* Note that if sizeof(int) < sizeof(void *), we can't use
(void **)&value to get the value we passed into Attr_put. To avoid
problems (e.g., alignment errors), we recover the value into
a (void *) and cast to int. Note that this may generate warning
messages from the compiler. */
MPI_Attr_get(dup_comm, key_1, (void **)&vvalue, &flag );
value = (MPI_Aint)vvalue;
if (! flag) {
errs++;
printf( "dup_comm key_1 not found on %d\n", world_rank );
fflush( stdout );
MPI_Abort(MPI_COMM_WORLD, 3004 );
}
if (value != world_rank) {
errs++;
printf( "dup_comm key_1 value incorrect: %ld\n", (long)value );
fflush( stdout );
MPI_Abort(MPI_COMM_WORLD, 3005 );
}
MPI_Attr_get(dup_comm, key_3, (void **)&vvalue, &flag );
value = (MPI_Aint)vvalue;
if (flag) {
errs++;
printf( "dup_comm key_3 found!\n" );
fflush( stdout );
MPI_Abort(MPI_COMM_WORLD, 3008 );
}
MTestPrintfMsg(1, "Keyval_free key=%#x\n", key_1);
MPI_Keyval_free(&key_1 );
MTestPrintfMsg(1, "Keyval_free key=%#x\n", key_3);
MPI_Keyval_free(&key_3 );
/*
Free all communicators created
*/
MTestPrintfMsg(1, "Comm_free comm\n");
MPI_Comm_free( &comm );
MTestPrintfMsg(1, "Comm_free dup_comm\n");
MPI_Comm_free( &dup_comm );
}
return errs;
}
/*
* This test looks at the handling of logical and for types that are not
* integers or are not required integers (e.g., long long). MPICH allows
* these as well. A strict MPI test should not include this test.
*/
int main( int argc, char *argv[] )
{
int errs = 0, err;
int rank, size;
MPI_Comm comm;
char cinbuf[3], coutbuf[3];
signed char scinbuf[3], scoutbuf[3];
unsigned char ucinbuf[3], ucoutbuf[3];
float finbuf[3], foutbuf[3];
double dinbuf[3], doutbuf[3];
MTest_Init( &argc, &argv );
comm = MPI_COMM_WORLD;
MPI_Comm_rank( comm, &rank );
MPI_Comm_size( comm, &size );
/* Some MPI implementations do not implement all of the required
(datatype,operations) combinations, and further, they do not
always provide clear and specific error messages. By catching
the error, we can provide a higher quality, more specific message.
*/
MPI_Comm_set_errhandler( comm, MPI_ERRORS_RETURN );
#ifndef USE_STRICT_MPI
/* char */
MTestPrintfMsg( 10, "Reduce of MPI_CHAR\n" );
cinbuf[0] = 1;
cinbuf[1] = 0;
cinbuf[2] = (rank > 0);
coutbuf[0] = 0;
coutbuf[1] = 1;
coutbuf[2] = 1;
err = MPI_Reduce( cinbuf, coutbuf, 3, MPI_CHAR, MPI_LOR, 0, comm );
if (err) {
errs++;
MTestPrintErrorMsg( "MPI_LOR and MPI_CHAR", err );
}
else {
if (rank == 0) {
if (!coutbuf[0]) {
errs++;
fprintf( stderr, "char OR(1) test failed\n" );
}
if (coutbuf[1]) {
errs++;
fprintf( stderr, "char OR(0) test failed\n" );
}
if (!coutbuf[2] && size > 1) {
errs++;
fprintf( stderr, "char OR(>) test failed\n" );
}
}
}
#endif /* USE_STRICT_MPI */
/* signed char */
MTestPrintfMsg( 10, "Reduce of MPI_SIGNED_CHAR\n" );
scinbuf[0] = 1;
scinbuf[1] = 0;
scinbuf[2] = (rank > 0);
scoutbuf[0] = 0;
scoutbuf[1] = 1;
scoutbuf[2] = 1;
err = MPI_Reduce( scinbuf, scoutbuf, 3, MPI_SIGNED_CHAR, MPI_LOR, 0, comm );
if (err) {
errs++;
MTestPrintErrorMsg( "MPI_LOR and MPI_SIGNED_CHAR", err );
}
else {
if (rank == 0) {
if (!scoutbuf[0]) {
errs++;
fprintf( stderr, "signed char OR(1) test failed\n" );
}
if (scoutbuf[1]) {
errs++;
fprintf( stderr, "signed char OR(0) test failed\n" );
}
if (!scoutbuf[2] && size > 1) {
errs++;
fprintf( stderr, "signed char OR(>) test failed\n" );
}
}
}
/* unsigned char */
MTestPrintfMsg( 10, "Reduce of MPI_UNSIGNED_CHAR\n" );
ucinbuf[0] = 1;
ucinbuf[1] = 0;
ucinbuf[2] = (rank > 0);
ucoutbuf[0] = 0;
ucoutbuf[1] = 1;
ucoutbuf[2] = 1;
err = MPI_Reduce( ucinbuf, ucoutbuf, 3, MPI_UNSIGNED_CHAR, MPI_LOR, 0, comm );
if (err) {
errs++;
MTestPrintErrorMsg( "MPI_LOR and MPI_UNSIGNED_CHAR", err );
}
else {
if (rank == 0) {
if (!ucoutbuf[0]) {
errs++;
fprintf( stderr, "unsigned char OR(1) test failed\n" );
}
if (ucoutbuf[1]) {
errs++;
fprintf( stderr, "unsigned char OR(0) test failed\n" );
}
if (!ucoutbuf[2] && size > 1) {
errs++;
fprintf( stderr, "unsigned char OR(>) test failed\n" );
}
}
}
#ifndef USE_STRICT_MPI
/* float */
MTestPrintfMsg( 10, "Reduce of MPI_FLOAT\n" );
finbuf[0] = 1;
finbuf[1] = 0;
finbuf[2] = (rank > 0);
foutbuf[0] = 0;
foutbuf[1] = 1;
foutbuf[2] = 1;
err = MPI_Reduce( finbuf, foutbuf, 3, MPI_FLOAT, MPI_LOR, 0, comm );
if (err) {
errs++;
MTestPrintErrorMsg( "MPI_LOR and MPI_FLOAT", err );
}
else {
if (rank == 0) {
if (!foutbuf[0]) {
errs++;
fprintf( stderr, "float OR(1) test failed\n" );
}
if (foutbuf[1]) {
errs++;
fprintf( stderr, "float OR(0) test failed\n" );
}
if (!foutbuf[2] && size > 1) {
errs++;
fprintf( stderr, "float OR(>) test failed\n" );
}
}
}
/* double */
MTestPrintfMsg( 10, "Reduce of MPI_DOUBLE\n" );
dinbuf[0] = 1;
dinbuf[1] = 0;
dinbuf[2] = (rank > 0);
doutbuf[0] = 0;
doutbuf[1] = 1;
doutbuf[2] = 1;
err = MPI_Reduce( dinbuf, doutbuf, 3, MPI_DOUBLE, MPI_LOR, 0, comm );
if (err) {
errs++;
MTestPrintErrorMsg( "MPI_LOR and MPI_DOUBLE", err );
}
else {
if (rank == 0) {
if (!doutbuf[0]) {
errs++;
fprintf( stderr, "double OR(1) test failed\n" );
}
if (doutbuf[1]) {
errs++;
fprintf( stderr, "double OR(0) test failed\n" );
}
if (!doutbuf[2] && size > 1) {
errs++;
fprintf( stderr, "double OR(>) test failed\n" );
}
}
}
#ifdef HAVE_LONG_DOUBLE
{ long double ldinbuf[3], ldoutbuf[3];
/* long double */
ldinbuf[0] = 1;
ldinbuf[1] = 0;
ldinbuf[2] = (rank > 0);
ldoutbuf[0] = 0;
ldoutbuf[1] = 1;
ldoutbuf[2] = 1;
if (MPI_LONG_DOUBLE != MPI_DATATYPE_NULL) {
MTestPrintfMsg( 10, "Reduce of MPI_LONG_DOUBLE\n" );
err = MPI_Reduce( ldinbuf, ldoutbuf, 3, MPI_LONG_DOUBLE, MPI_LOR, 0, comm );
if (err) {
errs++;
MTestPrintErrorMsg( "MPI_LOR and MPI_LONG_DOUBLE", err );
}
else {
if (rank == 0) {
if (!ldoutbuf[0]) {
errs++;
fprintf( stderr, "long double OR(1) test failed\n" );
}
if (ldoutbuf[1]) {
errs++;
fprintf( stderr, "long double OR(0) test failed\n" );
}
if (!ldoutbuf[2] && size > 1) {
errs++;
fprintf( stderr, "long double OR(>) test failed\n" );
}
}
}
}
}
#endif /* HAVE_LONG_DOUBLE */
#endif /* USE_STRICT_MPI */
#ifdef HAVE_LONG_LONG
{
long long llinbuf[3], lloutbuf[3];
/* long long */
llinbuf[0] = 1;
llinbuf[1] = 0;
llinbuf[2] = (rank > 0);
lloutbuf[0] = 0;
lloutbuf[1] = 1;
lloutbuf[2] = 1;
if (MPI_LONG_LONG != MPI_DATATYPE_NULL) {
MTestPrintfMsg( 10, "Reduce of MPI_LONG_LONG\n" );
err = MPI_Reduce( llinbuf, lloutbuf, 3, MPI_LONG_LONG, MPI_LOR, 0, comm );
if (err) {
errs++;
MTestPrintErrorMsg( "MPI_LOR and MPI_LONG_LONG", err );
}
else {
if (rank == 0) {
if (!lloutbuf[0]) {
errs++;
fprintf( stderr, "long long OR(1) test failed\n" );
}
if (lloutbuf[1]) {
errs++;
fprintf( stderr, "long long OR(0) test failed\n" );
}
if (!lloutbuf[2] && size > 1) {
errs++;
fprintf( stderr, "long long OR(>) test failed\n" );
}
}
}
}
}
#endif
MPI_Errhandler_set( comm, MPI_ERRORS_ARE_FATAL );
MTest_Finalize( errs );
MPI_Finalize();
return 0;
}
int main(int argc, char *argv[])
{
int errs = 0, err;
int rank, size, source, dest;
int minsize = 2, count[2], nmsg, maxmsg;
int i, j, len;
MPI_Aint sendcount, recvcount;
MPI_Comm comm;
MPI_Datatype sendtype, recvtype;
DTP_t send_dtp, recv_dtp;
char send_name[MPI_MAX_OBJECT_NAME] = { 0 };
char recv_name[MPI_MAX_OBJECT_NAME] = { 0 };
void *sendbuf, *recvbuf;
MTest_Init(&argc, &argv);
#ifndef USE_DTP_POOL_TYPE__STRUCT /* set in 'test/mpi/structtypetest.txt' to split tests */
MPI_Datatype basic_type;
char type_name[MPI_MAX_OBJECT_NAME] = { 0 };
err = MTestInitBasicPt2ptSignature(argc, argv, count, &basic_type);
if (err)
return MTestReturnValue(1);
err = DTP_pool_create(basic_type, count[0], &send_dtp);
if (err != DTP_SUCCESS) {
MPI_Type_get_name(basic_type, type_name, &len);
fprintf(stdout, "Error while creating send pool (%s,%d)\n", type_name, count[0]);
fflush(stdout);
}
err = DTP_pool_create(basic_type, count[1], &recv_dtp);
if (err != DTP_SUCCESS) {
MPI_Type_get_name(basic_type, type_name, &len);
fprintf(stdout, "Error while creating recv pool (%s,%d)\n", type_name, count[1]);
fflush(stdout);
}
#else
MPI_Datatype *basic_types = NULL;
int *basic_type_counts = NULL;
int basic_type_num;
err = MTestInitStructSignature(argc, argv, &basic_type_num, &basic_type_counts, &basic_types);
if (err)
return MTestReturnValue(1);
err = DTP_pool_create_struct(basic_type_num, basic_types, basic_type_counts, &send_dtp);
if (err != DTP_SUCCESS) {
fprintf(stdout, "Error while creating struct pool\n");
fflush(stdout);
}
err = DTP_pool_create_struct(basic_type_num, basic_types, basic_type_counts, &recv_dtp);
if (err != DTP_SUCCESS) {
fprintf(stdout, "Error while creating struct pool\n");
fflush(stdout);
}
/* these are ignored */
count[0] = 0;
count[1] = 0;
#endif
/* The following illustrates the use of the routines to
* run through a selection of communicators and datatypes.
* Use subsets of these for tests that do not involve combinations
* of communicators, datatypes, and counts of datatypes */
while (MTestGetIntracommGeneral(&comm, minsize, 1)) {
if (comm == MPI_COMM_NULL)
continue;
/* Determine the sender and receiver */
MPI_Comm_rank(comm, &rank);
MPI_Comm_size(comm, &size);
source = 0;
dest = size - 1;
/* To improve reporting of problems about operations, we
* change the error handler to errors return */
MPI_Comm_set_errhandler(comm, MPI_ERRORS_RETURN);
for (i = 0; i < send_dtp->DTP_num_objs; i++) {
err = DTP_obj_create(send_dtp, i, 0, 1, count[0]);
if (err != DTP_SUCCESS) {
errs++;
break;
}
sendcount = send_dtp->DTP_obj_array[i].DTP_obj_count;
sendtype = send_dtp->DTP_obj_array[i].DTP_obj_type;
sendbuf = send_dtp->DTP_obj_array[i].DTP_obj_buf;
for (j = 0; j < recv_dtp->DTP_num_objs; j++) {
int nbytes;
MPI_Type_size(sendtype, &nbytes);
maxmsg = MAX_COUNT - count[0];
err = DTP_obj_create(recv_dtp, j, 0, 0, 0);
if (err != DTP_SUCCESS) {
errs++;
break;
}
recvcount = recv_dtp->DTP_obj_array[j].DTP_obj_count;
recvtype = recv_dtp->DTP_obj_array[j].DTP_obj_type;
recvbuf = recv_dtp->DTP_obj_array[j].DTP_obj_buf;
/* We may want to limit the total message size sent */
if (nbytes > MAX_MSG_SIZE) {
continue;
}
if (rank == source) {
MPI_Type_get_name(sendtype, send_name, &len);
MTestPrintfMsg(1, "Sending count = %d of sendtype %s of total size %d bytes\n",
count[0], send_name, nbytes * count[0]);
for (nmsg = 1; nmsg < maxmsg; nmsg++) {
err = MPI_Send(sendbuf, sendcount, sendtype, dest, 0, comm);
if (err) {
errs++;
if (errs < 10) {
MTestPrintError(err);
}
}
}
} else if (rank == dest) {
for (nmsg = 1; nmsg < maxmsg; nmsg++) {
err =
MPI_Recv(recvbuf, recvcount, recvtype, source, 0, comm,
MPI_STATUS_IGNORE);
if (err) {
errs++;
if (errs < 10) {
MTestPrintError(err);
}
}
err = DTP_obj_buf_check(recv_dtp, j, 0, 1, count[0]);
if (err != DTP_SUCCESS) {
if (errs < 10) {
MPI_Type_get_name(sendtype, send_name, &len);
MPI_Type_get_name(recvtype, recv_name, &len);
fprintf(stdout,
"Data in target buffer did not match for destination datatype %s and source datatype %s, count = %d, message iteration %d of %d\n",
recv_name, send_name, count[0], nmsg, maxmsg);
fflush(stdout);
}
errs++;
}
}
}
DTP_obj_free(recv_dtp, j);
}
DTP_obj_free(send_dtp, i);
}
MTestFreeComm(&comm);
}
DTP_pool_free(send_dtp);
DTP_pool_free(recv_dtp);
#ifdef USE_DTP_POOL_TYPE__STRUCT
/* cleanup array if any */
if (basic_types) {
free(basic_types);
}
if (basic_type_counts) {
free(basic_type_counts);
}
#endif
MTest_Finalize(errs);
return MTestReturnValue(errs);
}
