/*
This program is from mpich/tsuite/pt2pt and should be changed there only.
It needs gcomm and dtype from mpich/tsuite, and can be run with
any number of processes > 1.
This version uses sendrecv and sendrecv_replace (but only in the
head-to-head mode).
*/
int main( int argc, char **argv )
{
MPI_Datatype *types;
void **inbufs, **outbufs;
char **names;
int *counts, *bytesize, ntype;
MPI_Comm comms[20];
int ncomm = 20, rank, np, partner, tag, count;
int i, j, k, err, world_rank, errloc;
MPI_Status status;
char *obuf, *ibuf;
MPI_Init( &argc, &argv );
AllocateForData( &types, &inbufs, &outbufs, &counts, &bytesize,
&names, &ntype );
GenerateData( types, inbufs, outbufs, counts, bytesize, names, &ntype );
MPI_Comm_rank( MPI_COMM_WORLD, &world_rank );
MakeComms( comms, 20, &ncomm, 0 );
/* Test over a wide range of datatypes and communicators */
err = 0;
for (i=0; i<ncomm; i++) {
MPI_Comm_rank( comms[i], &rank );
MPI_Comm_size( comms[i], &np );
if (np < 2) continue;
tag = i;
if (rank == 0)
partner = np - 1;
if (rank == np - 1)
partner = 0;
for (j=0; j<ntype; j++) {
if (world_rank == 0)
fprintf( stdout, "Testing type %s\n", names[j] );
if (rank == 0 || rank == np - 1) {
obuf = outbufs[j];
for (k=0; k<bytesize[j]; k++)
obuf[k] = 0;
MPI_Sendrecv( inbufs[j], counts[j], types[j], partner, tag,
outbufs[j], counts[j], types[j], partner, tag,
comms[i], &status );
/* Test correct */
MPI_Get_count( &status, types[j], &count );
if (count != counts[j]) {
fprintf( stderr,
"Error in counts (got %d expected %d) with type %s\n",
count, counts[j], names[j] );
err++;
}
if (status.MPI_SOURCE != partner) {
fprintf( stderr,
"Error in source (got %d expected %d) with type %s\n",
status.MPI_SOURCE, partner, names[j] );
err++;
}
if ((errloc = CheckData( inbufs[j], outbufs[j], bytesize[j] ))) {
char *p1, *p2;
fprintf( stderr,
"Error in data with type %s (type %d on %d) at byte %d\n",
names[j], j, world_rank, errloc - 1 );
p1 = (char *)inbufs[j];
p2 = (char *)outbufs[j];
fprintf( stderr,
"Got %x expected %x\n", p1[errloc-1], p2[errloc-1] );
err++;
}
/* Now do sendrecv_replace */
obuf = outbufs[j];
ibuf = inbufs[j];
for (k=0; k<bytesize[j]; k++)
obuf[k] = ibuf[k];
/* This would be a better test if the data was different... */
MPI_Sendrecv_replace( obuf, counts[j], types[j], partner, tag,
partner, tag, comms[i], &status );
/* Test correct */
MPI_Get_count( &status, types[j], &count );
if (count != counts[j]) {
fprintf( stderr,
"Error in counts (got %d expected %d) with type %s\n",
count, counts[j], names[j] );
err++;
}
if (status.MPI_SOURCE != partner) {
fprintf( stderr,
"Error in source (got %d expected %d) with type %s\n",
status.MPI_SOURCE, partner, names[j] );
err++;
}
if ((errloc = CheckData( inbufs[j], outbufs[j], bytesize[j] ))) {
char *p1, *p2;
fprintf( stderr,
"Error in data with type %s (type %d on %d) at byte %d\n",
names[j], j, world_rank, errloc - 1 );
p1 = (char *)inbufs[j];
p2 = (char *)outbufs[j];
fprintf( stderr,
"Got %x expected %x\n", p1[errloc-1], p2[errloc-1] );
err++;
}
}
}
}
if (err > 0) {
fprintf( stderr, "%d errors on %d\n", err, rank );
}
FreeDatatypes( types, inbufs, outbufs, counts, bytesize, names, ntype );
FreeComms( comms, ncomm );
MPI_Finalize();
return err;
}
int main( int argc, char **argv )
{
MPI_Datatype *types;
void **inbufs, **outbufs;
char **names;
int *counts, *bytesize, ntype;
MPI_Comm comms[20];
int ncomm = 20, rank, np, partner, tag;
int i, j, k, err, toterr, world_rank;
MPI_Status status, statuses[2];
int flag;
char *obuf;
MPI_Request requests[2];
MPI_Init( &argc, &argv );
AllocateForData( &types, &inbufs, &outbufs, &counts, &bytesize,
&names, &ntype );
GenerateData( types, inbufs, outbufs, counts, bytesize, names, &ntype );
MPI_Comm_rank( MPI_COMM_WORLD, &world_rank );
MakeComms( comms, 20, &ncomm, 0 );
/* Test over a wide range of datatypes and communicators */
err = 0;
for (i=0; i<ncomm; i++) {
MPI_Comm_rank( comms[i], &rank );
MPI_Comm_size( comms[i], &np );
if (np < 2) continue;
tag = i;
/* This is the test.
master: worker:
irecv send
isend
testall (fail)
sendrecv sendrecv
irecv
sendrecv sendrecv
wait
sendrecv sendrecv
testall (should succeed)
*/
for (j=0; j<ntype; j++) {
if (world_rank == 0 && verbose)
fprintf( stdout, "Testing type %s\n", names[j] );
if (rank == 0) {
/* Master */
partner = np - 1;
#if 0
MPIR_PrintDatatypePack( stdout, counts[j], types[j], 0, 0 );
#endif
obuf = outbufs[j];
for (k=0; k<bytesize[j]; k++)
obuf[k] = 0;
MPI_Irecv(outbufs[j], counts[j], types[j], partner, tag,
comms[i], &requests[0] );
/* Use issend to ensure that the test cannot complete */
MPI_Isend( inbufs[j], counts[j], types[j], partner, tag,
comms[i], &requests[1] );
/* Note that the send may have completed */
MPI_Testall( 2, &requests[0], &flag, statuses );
if (flag) {
err++;
fprintf( stderr, "MPI_Testall returned flag == true!\n" );
}
if (requests[1] == MPI_REQUEST_NULL) {
err++;
fprintf( stderr, "MPI_Testall freed a request\n" );
}
MPI_Sendrecv( MPI_BOTTOM, 0, MPI_INT, partner, ncomm+i,
MPI_BOTTOM, 0, MPI_INT, partner, ncomm+i,
comms[i], &status );
MPI_Sendrecv( MPI_BOTTOM, 0, MPI_INT, partner, ncomm+i,
MPI_BOTTOM, 0, MPI_INT, partner, ncomm+i,
comms[i], &status );
MPI_Sendrecv( MPI_BOTTOM, 0, MPI_INT, partner, ncomm+i,
MPI_BOTTOM, 0, MPI_INT, partner, ncomm+i,
comms[i], &status );
/* This should succeed, but may fail if the wait below is
still waiting */
MPI_Testall( 2, requests, &flag, statuses );
if (!flag) {
err++;
fprintf( stderr, "MPI_Testall returned flag == false!\n" );
}
if (requests[0] != MPI_REQUEST_NULL ||
requests[1] != MPI_REQUEST_NULL) {
err++;
fprintf( stderr, "MPI_Testall failed to free requests (test %d)\n", j );
if (requests[0] != MPI_REQUEST_NULL) {
fprintf( stderr, "Failed to free Irecv request\n" );
}
if (requests[1] != MPI_REQUEST_NULL) {
fprintf( stderr, "Failed to free Isend request\n" );
}
}
/* Check the received data */
if (CheckDataAndPrint( inbufs[j], outbufs[j], bytesize[j],
names[j], j )) {
err++;
}
}
else if (rank == np - 1) {
/* receiver */
partner = 0;
obuf = outbufs[j];
for (k=0; k<bytesize[j]; k++)
obuf[k] = 0;
MPI_Send( inbufs[j], counts[j], types[j], partner, tag,
comms[i] );
MPI_Sendrecv( MPI_BOTTOM, 0, MPI_INT, partner, ncomm+i,
MPI_BOTTOM, 0, MPI_INT, partner, ncomm+i,
comms[i], &status );
MPI_Irecv(outbufs[j], counts[j], types[j], partner, tag,
comms[i], &requests[0] );
MPI_Sendrecv( MPI_BOTTOM, 0, MPI_INT, partner, ncomm+i,
MPI_BOTTOM, 0, MPI_INT, partner, ncomm+i,
comms[i], &status );
MPI_Wait( requests, statuses );
if (CheckDataAndPrint( inbufs[j], outbufs[j], bytesize[j],
names[j], j )) {
err++;
}
MPI_Sendrecv( MPI_BOTTOM, 0, MPI_INT, partner, ncomm+i,
MPI_BOTTOM, 0, MPI_INT, partner, ncomm+i,
comms[i], &status );
}
}
}
if (err > 0) {
fprintf( stderr, "%d errors on %d\n", err, rank );
}
MPI_Allreduce( &err, &toterr, 1, MPI_INT, MPI_SUM, MPI_COMM_WORLD );
if (world_rank == 0) {
if (toterr == 0) {
printf( " No Errors\n" );
}
else {
printf (" Found %d errors\n", toterr );
}
}
FreeDatatypes( types, inbufs, outbufs, counts, bytesize, names, ntype );
FreeComms( comms, ncomm );
MPI_Finalize();
return err;
}
int main( int argc, char **argv )
{
MPI_Datatype *types;
void **inbufs, **outbufs;
char **names;
int *counts, *bytesize, ntype;
MPI_Comm comms[20];
int ncomm = 20, rank, np, partner, tag;
int i, j, k, err, toterr, world_rank, errloc;
MPI_Status status, statuses[2];
int flag, index;
char *obuf;
MPI_Request requests[2];
MPI_Init( &argc, &argv );
AllocateForData( &types, &inbufs, &outbufs, &counts, &bytesize,
&names, &ntype );
GenerateData( types, inbufs, outbufs, counts, bytesize, names, &ntype );
MPI_Comm_rank( MPI_COMM_WORLD, &world_rank );
MakeComms( comms, 20, &ncomm, 0 );
/* Test over a wide range of datatypes and communicators */
err = 0;
for (i=0; i<ncomm; i++) {
MPI_Comm_rank( comms[i], &rank );
MPI_Comm_size( comms[i], &np );
if (np < 2) continue;
tag = i;
for (j=0; j<ntype; j++) {
if (world_rank == 0){
/* SI make size of outputindependent of number of processes */
if (i<2) fprintf( stdout, "Testing type %s\n",names[j] );
}
/* This test does an irsend between both partners, with
a sendrecv after the irecv used to guarentee that the
irsend has a matching receive
*/
if (rank == 0) {
partner = np - 1;
#if 0
MPIR_PrintDatatypePack( stdout, counts[j], types[j], 0, 0 );
#endif
obuf = outbufs[j];
for (k=0; k<bytesize[j]; k++)
obuf[k] = 0;
MPI_Irecv(outbufs[j], counts[j], types[j], partner, tag,
comms[i], &requests[0] );
MPI_Sendrecv( MPI_BOTTOM, 0, MPI_INT, partner, ncomm+i,
MPI_BOTTOM, 0, MPI_INT, partner, ncomm+i,
comms[i], &status );
MPI_Irsend( inbufs[j], counts[j], types[j], partner, tag,
comms[i], &requests[1] );
do {
MPI_Waitany( 2, requests, &index, &status );
} while (index != 0);
/* Always the possiblity that the Irsend is still waiting */
MPI_Waitall( 2, requests, statuses );
if ((errloc = CheckData( inbufs[j], outbufs[j], bytesize[j] ))) {
char *p1, *p2;
fprintf( stderr,
"Error in data with type %s (type %d on %d) at byte %d\n",
names[j], j, world_rank, errloc - 1 );
p1 = (char *)inbufs[j];
p2 = (char *)outbufs[j];
fprintf( stderr,
"Got %x expected %x\n", p1[errloc-1], p2[errloc-1] );
err++;
#if 0
MPIR_PrintDatatypeUnpack( stderr, counts[j], types[j],
0, 0 );
#endif
}
}
else if (rank == np - 1) {
partner = 0;
obuf = outbufs[j];
for (k=0; k<bytesize[j]; k++)
obuf[k] = 0;
MPI_Irecv(outbufs[j], counts[j], types[j], partner, tag,
comms[i], &requests[0] );
MPI_Sendrecv( MPI_BOTTOM, 0, MPI_INT, partner, ncomm+i,
MPI_BOTTOM, 0, MPI_INT, partner, ncomm+i,
comms[i], &status );
/* Wait for irecv to complete */
do {
MPI_Test( &requests[0], &flag, &status );
} while (!flag);
if ((errloc = CheckData( inbufs[j], outbufs[j], bytesize[j] ))) {
char *p1, *p2;
fprintf( stderr,
"Error in data with type %s (type %d on %d) at byte %d\n",
names[j], j, world_rank, errloc - 1 );
p1 = (char *)inbufs[j];
p2 = (char *)outbufs[j];
fprintf( stderr,
"Got %x expected %x\n", p1[errloc-1], p2[errloc-1] );
err++;
#if 0
MPIR_PrintDatatypeUnpack( stderr, counts[j], types[j],
0, 0 );
#endif
}
MPI_Irsend( inbufs[j], counts[j], types[j], partner, tag,
comms[i], &requests[1] );
MPI_Waitall(1, &requests[1], &status );
}
}
}
if (err > 0) {
fprintf( stderr, "%d errors on %d\n", err, rank );
}
MPI_Allreduce( &err, &toterr, 1, MPI_INT, MPI_SUM, MPI_COMM_WORLD );
if (world_rank == 0) {
if (toterr == 0) {
printf( " No Errors\n" );
}
else {
printf (" Found %d errors\n", toterr );
}
}
FreeDatatypes( types, inbufs, outbufs, counts, bytesize, names, ntype );
FreeComms( comms, ncomm );
MPI_Finalize();
return err;
}
/*
This program is from mpich/tsuite/pt2pt and should be changed there only.
It needs gcomm and dtype from mpich/tsuite, and can be run with
any number of processes > 1.
This version uses Pack to send a message and Unpack OR the datatype
to receive it.
*/
int main( int argc, char **argv )
{
MPI_Datatype *types;
void **inbufs, **outbufs;
char **names;
char *packbuf, *unpackbuf;
int packsize, unpacksize, position;
int *counts, *bytesize, ntype;
MPI_Comm comms[20];
int ncomm = 20, rank, np, partner, tag, count;
int i, j, k, err, toterr, world_rank;
int errloc;
MPI_Status status;
char *obuf;
MPI_Init( &argc, &argv );
AllocateForData( &types, &inbufs, &outbufs, &counts, &bytesize,
&names, &ntype );
GenerateData( types, inbufs, outbufs, counts, bytesize, names, &ntype );
MPI_Comm_rank( MPI_COMM_WORLD, &world_rank );
MakeComms( comms, 20, &ncomm, 0 );
/* Test over a wide range of datatypes and communicators */
err = 0;
for (i=0; i<ncomm; i++) {
MPI_Comm_rank( comms[i], &rank );
MPI_Comm_size( comms[i], &np );
if (np < 2) continue;
if (world_rank == 0 && verbose) {
fprintf( stdout, "Testing with communicator with %d members\n", np );
}
tag = i;
for (j=0; j<ntype; j++) {
if (world_rank == 0 && verbose)
fprintf( stdout, "Testing type %s\n", names[j] );
if (rank == 0) {
partner = np - 1;
MPI_Pack_size( counts[j], types[j], comms[i], &packsize );
packbuf = (char *)malloc( packsize );
if (!packbuf) {
fprintf( stderr, "[%i] Aborting\n",rank );fflush(stderr);
MPI_Abort( MPI_COMM_WORLD, 1 );
}
position = 0;
MPI_Pack( inbufs[j], counts[j], types[j], packbuf, packsize,
&position, comms[i] );
/* Send twice */
MPI_Send( packbuf, position, MPI_PACKED, partner, tag, comms[i] );
MPI_Send( packbuf, position, MPI_PACKED, partner, tag, comms[i] );
free( packbuf );
}
else if (rank == np-1) {
partner = 0;
obuf = outbufs[j];
for (k=0; k<bytesize[j]; k++)
obuf[k] = 0;
/* Receive directly */
MPI_Recv( outbufs[j], counts[j], types[j], partner, tag, comms[i],
&status );
/* Test correct */
MPI_Get_count( &status, types[j], &count );
if (count != counts[j]) {
fprintf( stderr,
"Error in counts (got %d expected %d) with type %s\n",
count, counts[j], names[j] );
err++;
}
if (status.MPI_SOURCE != partner) {
fprintf( stderr,
"Error in source (got %d expected %d) with type %s\n",
status.MPI_SOURCE, partner, names[j] );
err++;
}
if ((errloc = CheckData( inbufs[j], outbufs[j], bytesize[j] ))) {
fprintf( stderr,
"Error in data at byte %d with type %s (type %d on %d)\n",
errloc - 1, names[j], j, world_rank );
err++;
}
/* Receive packed, then unpack */
MPI_Pack_size( counts[j], types[j], comms[i], &unpacksize );
unpackbuf = (char *)malloc( unpacksize );
if (!unpackbuf) {
fprintf( stderr, "[%i] Aborting\n",rank );fflush(stderr);
MPI_Abort( MPI_COMM_WORLD, 1 );
}
MPI_Recv( unpackbuf, unpacksize, MPI_PACKED, partner, tag,
comms[i], &status );
obuf = outbufs[j];
for (k=0; k<bytesize[j]; k++)
obuf[k] = 0;
position = 0;
MPI_Get_count( &status, MPI_PACKED, &unpacksize );
MPI_Unpack( unpackbuf, unpacksize, &position,
outbufs[j], counts[j], types[j], comms[i] );
free( unpackbuf );
/* Test correct */
#ifdef FOO
/* Length is tricky; a correct code will have signaled an error
in MPI_Unpack */
count = position;
if (count != counts[j]) {
fprintf( stderr,
"Error in counts (got %d expected %d) with type %s (Unpack)\n",
count, counts[j], names[j] );
err++;
}
#endif
if (status.MPI_SOURCE != partner) {
fprintf( stderr,
"Error in source (got %d expected %d) with type %s (Unpack)\n",
status.MPI_SOURCE, partner, names[j] );
err++;
}
if ((errloc = CheckData( inbufs[j], outbufs[j], bytesize[j] ))) {
fprintf( stderr,
"Error in data at byte %d with type %s (type %d on %d, Unpack)\n",
errloc - 1, names[j], j, world_rank );
err++;
}
}
}
}
if (err > 0) {
fprintf( stderr, "%d errors on %d\n", err, rank );
}
MPI_Allreduce( &err, &toterr, 1, MPI_INT, MPI_SUM, MPI_COMM_WORLD );
if (world_rank == 0) {
if (toterr == 0) {
printf( " No Errors\n" );
}
else {
printf (" Found %d errors\n", toterr );
}
}
FreeDatatypes( types, inbufs, outbufs, counts, bytesize, names, ntype );
FreeComms( comms, ncomm );
MPI_Barrier( MPI_COMM_WORLD );
MPI_Finalize();
return err;
}
/*
This program is from mpich/tsuite/pt2pt and should be changed there only.
It needs gcomm and dtype from mpich/tsuite, and can be run with
any number of processes > 1.
*/
int main( int argc, char **argv)
{
MPI_Datatype *types;
void **inbufs, **outbufs;
char **names;
int *counts, *bytesize, ntype;
MPI_Comm comms[20];
int ncomm = 20, rank, np, partner, tag, count;
int i, j, k, err, toterr, world_rank, errloc;
MPI_Status status;
char *obuf;
MPI_Init( &argc, &argv );
/*
* Check for -basiconly to select only the simple datatypes
*/
for (i=1; i<argc; i++) {
if (!argv[i]) break;
if (strcmp( argv[i], "-basiconly" ) == 0) {
BasicDatatypesOnly();
}
else if (strcmp( argv[i], "-verbose" ) == 0) {
verbose = 1;
}
}
AllocateForData( &types, &inbufs, &outbufs, &counts, &bytesize,
&names, &ntype );
GenerateData( types, inbufs, outbufs, counts, bytesize, names, &ntype );
MPI_Comm_rank( MPI_COMM_WORLD, &world_rank );
MakeComms( comms, 20, &ncomm, 0 );
/* Test over a wide range of datatypes and communicators */
err = 0;
for (i=0; i<ncomm; i++) {
if (comms[i] == MPI_COMM_NULL) continue;
MPI_Comm_rank( comms[i], &rank );
MPI_Comm_size( comms[i], &np );
if (np < 2) continue;
if (world_rank == 0 && verbose)
fprintf( stdout, "Testing communicator number %d\n", i );
tag = i;
for (j=0; j<ntype; j++) {
//for (j=52; j<53; j++) {
if (world_rank == 0 && verbose)
fprintf( stdout, "Testing type %s\n", names[j] );
if (rank == 0) {
partner = np - 1;
#if 0
MPIR_PrintDatatypePack( stdout, counts[j], types[j], 0, 0 );
#endif
MPI_Send( inbufs[j], counts[j], types[j], partner, tag, comms[i] );
}
else if (rank == np-1) {
partner = 0;
obuf = outbufs[j];
for (k=0; k<bytesize[j]; k++)
obuf[k] = 0;
MPI_Recv( outbufs[j], counts[j], types[j], partner, tag,
comms[i], &status );
/* Test correct */
MPI_Get_count( &status, types[j], &count );
if (count != counts[j]) {
fprintf( stderr,
"Error in counts (got %d expected %d) with type %s\n",
count, counts[j], names[j] );
err++;
}
if (status.MPI_SOURCE != partner) {
fprintf( stderr,
"Error in source (got %d expected %d) with type %s\n",
status.MPI_SOURCE, partner, names[j] );
err++;
}
if ((errloc = CheckData( inbufs[j], outbufs[j], bytesize[j] ))) {
char *p1, *p2;
int *q1, *q2;
d1 *base;
fprintf( stderr,
"Error in data with type %s (type %d on %d) at byte %d\n",
names[j], j, world_rank, errloc - 1 );
p1 = (char*)inbufs[j];
q1 = (int*)inbufs[j];
p2 = (char*)outbufs[j];
q2 = (int*)outbufs[j];
fprintf( stderr,
"Got %x expected %x\n", p1[errloc-1], p2[errloc-1] );
base = (d1*)inbufs[j];
for (k=0; k<10; k++) {
if (k%60 == 0) printf("\n");
printf("%d %lf ", base[k].a1, base[k].a2);
}
/*
for (k=0; k<bytesize[j]/sizeof(int); ++k) {
if (k%60 == 0) printf("\n");
printf("%d ", q1[k]);
}
*/
base = (d1*)outbufs[j];
for (k=0; k<10; k++) {
if (k%60 == 0) printf("\n");
printf("%d %lf ", base[k].a1, base[k].a2);
}
/*
for (k=0; k<bytesize[j]/sizeof(int); ++k) {
if (k%60 == 0) printf("\n");
printf("%d ", q2[k]);
}
*/
printf("\n");
err++;
#if 0
MPIR_PrintDatatypeUnpack( stderr, counts[j], types[j],
0, 0 );
#endif
}
}
}
}
if (err > 0) {
fprintf( stderr, "%d errors on %d\n", err, rank );
}
MPI_Allreduce( &err, &toterr, 1, MPI_INT, MPI_SUM, MPI_COMM_WORLD );
if (world_rank == 0) {
if (toterr == 0) {
printf( " No Errors\n" );
}
else {
printf (" Found %d errors\n", toterr );
}
}
FreeDatatypes( types, inbufs, outbufs, counts, bytesize, names, ntype );
FreeComms( comms, ncomm );
MPI_Finalize();
return err;
}
