bool Communicator::GetPacked(int bufSize, CommType::Type commType, unsigned source, unsigned messageTag, /*out*/void *buf)
{
MPI_Status status;
MPI_Request *request = 0;
int flag;
if (commType == CommType::Synch)
{
MPI_Recv(buf, bufSize, MPI_PACKED, source, messageTag, MPI_COMM_WORLD, &status);
this->recvPosition = 0;
flag = 0;
}
else
{
request = new MPI_Request();
MPI_Irecv(buf, bufSize, MPI_PACKED, source, /*messageTag*/messageTag, MPI_COMM_WORLD, request);
this->recvPosition = 0;
//This is necessary to cancel
sem_wait(&this->cancelSem);
this->messageRequest = request;
if (this->cancel)
{
if (!Validator::IsNull(request, NAME("request")))
{
MPI_Cancel(request);
}
}
sem_post(&this->cancelSem);
if (!Validator::IsNull(request, NAME("request")))
{
MPI_Wait(request, &status);
MPI_Test_cancelled( &status, &flag );
}
sem_wait(&this->cancelSem);
delete request;
request = NULL;
this->messageRequest = 0;
sem_post(&this->cancelSem);
}
#ifdef Debug
if (!Validator::IsNull(log, NAME("log")))
{
log->Log(&typeid(this), "Comunicator::GetPacked: source: %u, Tag: %d", source, messageTag);
}
#endif
return (flag != 0);
}
static VALUE status_cancelled_p(VALUE self)
{
int rv, flag;
MPI_Status *stat;
Data_Get_Struct(self, MPI_Status, stat);
rv = MPI_Test_cancelled(stat, &flag);
return flag ? Qtrue : Qfalse;
}
JNIEXPORT jboolean JNICALL Java_mpi_Status_isCancelled(
JNIEnv *env, jobject jthis, jint source, jint tag,
jint error, jint cancelled, jlong ucount)
{
int flag;
MPI_Status stat;
getStatus(&stat, source, tag, error, cancelled, ucount);
int rc = MPI_Test_cancelled(&stat, &flag);
ompi_java_exceptionCheck(env, rc);
return flag==0 ? JNI_FALSE : JNI_TRUE;
}
MPI_Fint c2frequest_ ( MPI_Fint *request )
{
MPI_Request req = MPI_Request_f2c( *request );
MPI_Status status;
int flag;
MPI_Test( &req, &flag, &status );
MPI_Test_cancelled( &status, &flag );
if (!flag) {
fprintf( stderr, "Request: Wrong value for flag\n" );
return 1;
}
else {
*request = MPI_Request_c2f( req );
}
return 0;
}
static void ProcessWaitTest_1 ( MPI_Request request, MPI_Status *status,
char *note )
{
request_list *rq, *last;
int flag, size;
/* look for request */
rq = requests_head_1;
last = 0;
while (rq && (rq->request != request)) {
last = rq;
rq = rq->next;
}
if (!rq) {
#define PRINT_PROBLEMS
#ifdef PRINT_PROBLEMS
fprintf( stderr, "Request not found in '%s'.\n", note );
#endif
return; /* request not found */
}
if (status->MPI_TAG != MPI_ANY_TAG) {
/* if the request was not invalid */
if (rq->status & RQ_CANCEL) {
MPI_Test_cancelled( status, &flag );
if (flag) return; /* the request has been cancelled */
}
if (rq->status & RQ_SEND) {
prof_send( procid_1, rq->otherParty, rq->tag, rq->size, note );
} else {
MPI_Get_count( status, MPI_BYTE, &size );
prof_recv( procid_1, status->MPI_SOURCE, status->MPI_TAG,
size, note );
}
}
if (last) {
last->next = rq->next;
} else {
requests_head_1 = rq->next;
}
free( rq );
}
int main( int argc, char *argv[] )
{
MPI_Fint handleA, handleB;
int rc;
int errs = 0;
int buf[1];
MPI_Request cRequest;
MPI_Status st;
int tFlag;
MTest_Init( &argc, &argv );
/* Request */
rc = MPI_Irecv( buf, 1, MPI_INT, 0, 0, MPI_COMM_WORLD, &cRequest );
if (rc) {
errs++;
printf( "Unable to create request\n" );
}
else {
handleA = MPI_Request_c2f( cRequest );
handleB = MPI_Request_c2f( cRequest );
if (handleA != handleB) {
errs++;
printf( "MPI_Request_c2f does not give the same handle twice on the same MPI_Request\n" );
}
}
MPI_Cancel( &cRequest );
MPI_Test( &cRequest, &tFlag, &st );
MPI_Test_cancelled( &st, &tFlag );
if (!tFlag) {
errs++;
printf( "Unable to cancel MPI_Irecv request\n" );
}
/* Using MPI_Request_free should be ok, but some MPI implementations
object to it imediately after the cancel and that isn't essential to
this test */
MTest_Finalize( errs );
MPI_Finalize();
return 0;
}
int
SAMRAI_MPI::Test_cancelled(
Status* status,
int* flag)
{
#ifndef HAVE_MPI
NULL_USE(status);
NULL_USE(flag);
#endif
int rval = MPI_SUCCESS;
if (!s_mpi_is_initialized) {
TBOX_ERROR("SAMRAI_MPI::Test_canceled is a no-op without run-time MPI!");
}
#ifdef HAVE_MPI
else {
rval = MPI_Test_cancelled(status, flag);
}
#endif
return rval;
}
int main(int argc, char **argv) {
int size, rank, msg, cancelled;
MPI_Request request;
MPI_Status status;
MPI_Init(&argc, &argv);
MPI_Comm_size(MPI_COMM_WORLD, &size);
MPI_Comm_rank(MPI_COMM_WORLD, &rank);
if (size != 2) {
fprintf(stderr,"ERROR: must be run with 2 processes");
MPI_Abort(MPI_COMM_WORLD, 1);
}
if (rank == 0) {
msg = -1;
/* Post, then cancel MPI_ANY_SOURCE recv */
MPI_Irecv(&msg, 1, MPI_INT, MPI_ANY_SOURCE, 0, MPI_COMM_WORLD, &request);
MPI_Cancel(&request);
MPI_Wait(&request, &status);
MPI_Test_cancelled(&status, &cancelled);
assert(cancelled);
MPI_Barrier(MPI_COMM_WORLD);
MPI_Irecv(&msg, 1, MPI_INT, MPI_ANY_SOURCE, 0, MPI_COMM_WORLD, &request);
MPI_Wait(&request, &status);
assert(msg == 42);
} else {
MPI_Barrier(MPI_COMM_WORLD);
msg = 42;
MPI_Send(&msg, 1, MPI_INT, 0, 0, MPI_COMM_WORLD);
}
if (rank == 0)
printf(" No Errors\n");
MPI_Finalize();
}
void ompi_test_cancelled_f(MPI_Fint *status, ompi_fortran_logical_t *flag, MPI_Fint *ierr)
{
int c_ierr;
MPI_Status c_status;
OMPI_LOGICAL_NAME_DECL(flag);
/* This seems silly, but someone will do it */
if (OMPI_IS_FORTRAN_STATUS_IGNORE(status)) {
*flag = OMPI_INT_2_LOGICAL(0);
c_ierr = MPI_SUCCESS;
} else {
c_ierr = MPI_Status_f2c( status, &c_status );
if (MPI_SUCCESS == c_ierr) {
c_ierr = MPI_Test_cancelled(&c_status,
OMPI_LOGICAL_SINGLE_NAME_CONVERT(flag));
OMPI_SINGLE_INT_2_LOGICAL(flag);
}
}
if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);
}
int test_count(MPI_Count count)
{
MPI_Status stat;
int cancelled, cancelled2;
MPI_Count bcount, bcount2;
int nerrs = 0;
bcount = count;
cancelled = 0;
MPI_Status_set_cancelled(&stat, cancelled);
MPI_Status_set_elements_x(&stat, MPI_BYTE, bcount);
MPI_Get_elements_x(&stat, MPI_BYTE, &bcount2);
MPI_Test_cancelled(&stat, &cancelled2);
if (bcount != bcount2) {
fprintf(stderr, "Count Error: expected %llx, got %llx\n",
(long long int)bcount, (long long int)bcount2);
nerrs++;
}
if (cancelled != cancelled2) {
fprintf(stderr, "Cancelled Error: expected %d, got %d\n", cancelled, cancelled2);
nerrs++;
}
return nerrs;
}
bool cancelled() const
{
MPI_Int flag;
MPIWRAP_CALL(MPI_Test_cancelled(nc(&status), &flag));
return flag;
}
int main( int argc, char *argv[] )
{
double sbuf[20000];
#ifdef FOO
double rbuf[20000];
#endif
int rank;
int n, flag, size;
int err = 0;
int verbose = 0;
MPI_Status status;
MPI_Request req;
MPI_Init( &argc, &argv );
MPI_Comm_rank( MPI_COMM_WORLD, &rank );
MPI_Comm_size( MPI_COMM_WORLD, &size );
if (size < 2) {
printf( "Cancel test requires at least 2 processes\n" );
MPI_Abort( MPI_COMM_WORLD, 1 );
}
/* Short Message Test */
n = 200;
if (rank == 1) { /* begin if rank = 1 */
MPI_Isend( sbuf, n, MPI_DOUBLE, 0, 1, MPI_COMM_WORLD, &req );
MPI_Cancel(&req);
MPI_Wait(&req, &status);
MPI_Test_cancelled(&status, &flag);
if (!flag) {
err++;
printf( "Cancelling a short message failed where it should succeed.\n" );
}
else if (verbose)
{
printf("Cancelling a short message succeeded.\n");
}
} /* end if rank == 1 */
#ifdef FOO
/* Note that MPI-2 specifies that status.MPI_ERROR is only set by
multiple completion (e.g., MPI_Waitsome) and not by test_cancelled.
*/
MPI_Barrier(MPI_COMM_WORLD);
if (rank == 0) { /* begin if rank == 0 */
MPI_Recv( rbuf, n, MPI_DOUBLE, 1, 1, MPI_COMM_WORLD, &status);
} /* end if rank = 0 */
else if (rank == 1) { /* begin if rank = 1 */
MPI_Isend( sbuf, n, MPI_DOUBLE, 0, 1, MPI_COMM_WORLD, &req );
MPI_Cancel(&req);
MPI_Wait(&req, &status);
MPI_Test_cancelled(&status, &flag);
if (!flag && status.MPI_ERROR != MPI_SUCCESS) {
err++;
printf( "Cancel of a send returned an error in the status field.\n" );
}
/* end if status.MPI_ERROR */
} /* end if rank == 1 */
#endif
MPI_Barrier(MPI_COMM_WORLD);
/* Eager Message Test */
n = 3000;
if (rank == 1) { /* begin if rank = 1 */
MPI_Isend( sbuf, n, MPI_DOUBLE, 0, 1, MPI_COMM_WORLD, &req );
MPI_Cancel(&req);
MPI_Wait(&req, &status);
MPI_Test_cancelled(&status, &flag);
if (!flag) {
err++;
printf( "Cancelling an eager message (3000 doubles) failed where it should succeed.\n" );
}
else if (verbose)
{
printf("Cancelling an eager message (3000 doubles) succeeded.\n");
}
} /* end if rank == 1 */
#ifdef FOO
MPI_Barrier(MPI_COMM_WORLD);
if (rank == 0) { /* begin if rank == 0 */
MPI_Irecv(rbuf, n, MPI_DOUBLE, 1, 1, MPI_COMM_WORLD, &req );
MPI_Wait( &req, &status);
} /* end if rank = 0 */
else if (rank == 1) { /* begin if rank = 1 */
MPI_Isend( sbuf, n, MPI_DOUBLE, 0, 1, MPI_COMM_WORLD, &req );
MPI_Cancel(&req);
MPI_Wait(&req, &status);
MPI_Test_cancelled(&status, &flag);
if (!flag && status.MPI_ERROR != MPI_SUCCESS) {
err++;
printf( "Cancel of a send returned an error in the status field.\n" );
}
/* end if status.MPI_ERROR */
} /* end if rank == 1 */
#endif
MPI_Barrier(MPI_COMM_WORLD);
/* Rndv Message Test */
n = 20000;
if (rank == 1) { /* begin if rank = 1 */
MPI_Isend( sbuf, n, MPI_DOUBLE, 0, 1, MPI_COMM_WORLD, &req );
MPI_Cancel(&req);
MPI_Wait(&req, &status);
MPI_Test_cancelled(&status, &flag);
if (!flag) {
err++;
printf( "Cancelling a rendezvous message failed (20000 doubles) where it should succeed.\n" );
}
else if (verbose)
{
printf("Cancelling an rendezvous message (20000 doubles) succeeded.\n");
}
} /* end if rank == 1 */
#ifdef FOO
MPI_Barrier(MPI_COMM_WORLD);
if (rank == 0) { /* begin if rank == 0 */
MPI_Irecv(rbuf, n, MPI_DOUBLE, 1, 1, MPI_COMM_WORLD, &req );
MPI_Wait( &req, &status);
} /* end if rank = 0 */
else if (rank == 1) { /* begin if rank = 1 */
MPI_Isend( sbuf, n, MPI_DOUBLE, 0, 1, MPI_COMM_WORLD, &req );
MPI_Cancel(&req);
MPI_Wait(&req, &status);
MPI_Test_cancelled(&status, &flag);
if (!flag && status.MPI_ERROR != MPI_SUCCESS) {
err++;
printf( "Cancel of a send returned an error in the status field.\n" );
}
/* end if status.MPI_ERROR */
} /* end if rank == 1 */
#endif
MPI_Barrier(MPI_COMM_WORLD);
if (rank == 1) { /* begin if rank = 1 */
if (err) {
printf( "Test failed with %d errors.\n", err );
}
else {
printf( " No Errors\n" );
}
}
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 );
exit(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 );
exit(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 );
exit(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 );
exit(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 );
exit(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 );
exit(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 );
exit(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 );
exit(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 );
exit(1);
}
MPI_Recv( btemp, nn, MPI_CHAR, 0, tag, comm, &status );
free(btemp);
}
}
MPI_Barrier( comm );
}
MTest_Finalize( errs );
MPI_Finalize();
return 0;
}
FORT_DLL_SPEC void FORT_CALL mpi_test_cancelled_ ( MPI_Fint *v1, MPI_Fint *v2, MPI_Fint *ierr ){
int l2;
*ierr = MPI_Test_cancelled( (MPI_Status *)(v1), &l2 );
*v2 = MPIR_TO_FLOG(l2);
}
bool is_cancelled() const {
int result;
MPI_Test_cancelled(reinterpret_cast<const MPI_Status *>(this), &result);
return result;
}
int main(int argc, char *argv[])
{
MPI_Request r[3];
MPI_Status s[3];
int *buf0, *buf1, *buf2;
int rank, size, src, dest, flag, errs = 0;
int n0, n1, n2;
MPI_Comm comm;
MTest_Init(&argc, &argv);
MPI_Comm_size(MPI_COMM_WORLD, &size);
if (size < 2) {
fprintf(stderr, "Must run with at least 2 processes\n");
MPI_Abort(MPI_COMM_WORLD, 1);
}
MPI_Comm_rank(MPI_COMM_WORLD, &rank);
dest = 0;
src = 1;
comm = MPI_COMM_WORLD;
n0 = n1 = n2 = 65536;
buf0 = (int *) malloc(n0 * sizeof(int));
buf1 = (int *) malloc(n1 * sizeof(int));
buf2 = (int *) malloc(n2 * sizeof(int));
if (!buf0 || !buf1 || !buf2) {
fprintf(stderr, "Unable to allocate buffers of size %d\n", n0 * (int) sizeof(int));
MPI_Abort(MPI_COMM_WORLD, 1);
}
memset(buf0, -1, n0 * sizeof(int));
memset(buf1, -1, n0 * sizeof(int));
memset(buf2, -1, n0 * sizeof(int));
if (rank == dest) {
MPI_Irecv(buf0, n0, MPI_INT, src, 0, comm, &r[0]);
MPI_Irecv(buf1, n1, MPI_INT, src, 1, comm, &r[1]);
MPI_Irecv(buf2, n2, MPI_INT, src, 2, comm, &r[2]);
MPI_Barrier(comm);
MPI_Cancel(&r[1]);
MPI_Barrier(comm);
memset(s, -1, sizeof(s));
MPI_Waitall(3, r, s);
MPI_Test_cancelled(&s[0], &flag);
if (flag) {
errs++;
printf("request 0 was cancelled!\n");
}
MPI_Test_cancelled(&s[1], &flag);
if (!flag) {
errs++;
printf("request 1 was not cancelled!\n");
}
MPI_Test_cancelled(&s[2], &flag);
if (flag) {
errs++;
printf("request 2 was cancelled!\n");
}
MPI_Barrier(comm);
}
if (rank == src) {
int tflag;
MPI_Barrier(comm);
MPI_Barrier(comm);
MPI_Send(buf0, n0, MPI_INT, dest, 0, comm);
MPI_Isend(buf2, n2, MPI_INT, dest, 2, comm, &r[1]);
MPI_Isend(buf1, n1, MPI_INT, dest, 4, comm, &r[0]);
MPI_Cancel(&r[0]);
memset(s, -3, sizeof(s));
s[0].MPI_ERROR = -3;
s[1].MPI_ERROR = -3;
MPI_Testall(2, r, &tflag, s);
if (tflag) {
MPI_Test_cancelled(&s[0], &flag);
if (!flag) {
errs++;
printf("send request 0 was not cancelled!\n");
}
MPI_Test_cancelled(&s[1], &flag);
if (flag) {
errs++;
printf("send request 1 was cancelled!\n");
}
}
else {
/* If all requests are not complete, then neither r nor s
* may be changed */
if ((s[0].MPI_ERROR) != -3) {
errs++;
printf("Send request status 0 modified. s[0].MPI_ERROR = %d\n", s[0].MPI_ERROR);
}
if ((s[1].MPI_ERROR) != -3) {
errs++;
printf("Send request status 1 modified. s[1].MPI_ERROR = %d\n", s[1].MPI_ERROR);
}
}
MPI_Barrier(comm);
while (!tflag) {
MPI_Testall(2, r, &tflag, s);
}
MPI_Test_cancelled(&s[0], &flag);
if (!flag) {
errs++;
printf("send request 0 was not cancelled!\n");
}
MPI_Test_cancelled(&s[1], &flag);
if (flag) {
errs++;
printf("send request 1 was cancelled!\n");
}
}
if (rank != src && rank != dest) {
MPI_Barrier(comm);
MPI_Barrier(comm);
MPI_Barrier(comm);
}
MTest_Finalize(errs);
MPI_Finalize();
return 0;
}
int main( int argc, char **argv )
{
MPI_Request r1;
int size, rank;
int err = 0;
int partner, buf[10], flag;
MPI_Status status;
MPI_Init( &argc, &argv );
MPI_Comm_size( MPI_COMM_WORLD, &size );
MPI_Comm_rank( MPI_COMM_WORLD, &rank );
if (size < 2) {
printf( "Cancel test requires at least 2 processes\n" );
MPI_Abort( MPI_COMM_WORLD, 1 );
}
/*
* Here is the test. First, we ensure an unsatisfied Irecv:
* process 0 process size-1
* Sendrecv Sendrecv
* Irecv ----
* Cancel ----
* Sendrecv Sendrecv
* Next, we confirm receipt before canceling
* Irecv Send
* Sendrecv Sendrecv
* Cancel
*/
if (rank == 0) {
partner = size - 1;
/* Cancel succeeds */
MPI_Sendrecv( MPI_BOTTOM, 0, MPI_INT, partner, 1,
MPI_BOTTOM, 0, MPI_INT, partner, 1,
MPI_COMM_WORLD, &status );
MPI_Irecv( buf, 10, MPI_INT, partner, 0, MPI_COMM_WORLD, &r1 );
MPI_Cancel( &r1 );
MPI_Wait( &r1, &status );
MPI_Test_cancelled( &status, &flag );
MPI_Sendrecv( MPI_BOTTOM, 0, MPI_INT, partner, 1,
MPI_BOTTOM, 0, MPI_INT, partner, 1,
MPI_COMM_WORLD, &status );
if (!flag) {
err++;
printf( "Cancel of a receive failed where it should succeed.\n" );
}
/* Cancel fails */
MPI_Irecv( buf, 10, MPI_INT, partner, 2, MPI_COMM_WORLD, &r1 );
MPI_Sendrecv( MPI_BOTTOM, 0, MPI_INT, partner, 1,
MPI_BOTTOM, 0, MPI_INT, partner, 1,
MPI_COMM_WORLD, &status );
MPI_Cancel( &r1 );
MPI_Test( &r1, &flag, &status );
MPI_Test_cancelled( &status, &flag );
/* It is technically possible for the cancel to succeed, even though
the message was (at least partially) delivered. I'm leaving
this test in since most of the MPICH devices provide this
behavior. */
if (flag) {
err++;
printf( "Cancel of a receive succeeded where it shouldn't.\n" );
}
if (err) {
printf( "Test failed with %d errors.\n", err );
}
else {
printf( " No Errors\n" );
}
}
else if (rank == size - 1) {
partner = 0;
/* Cancel succeeds */
MPI_Sendrecv( MPI_BOTTOM, 0, MPI_INT, partner, 1,
MPI_BOTTOM, 0, MPI_INT, partner, 1,
MPI_COMM_WORLD, &status );
MPI_Sendrecv( MPI_BOTTOM, 0, MPI_INT, partner, 1,
MPI_BOTTOM, 0, MPI_INT, partner, 1,
MPI_COMM_WORLD, &status );
/* Cancel fails */
MPI_Send( buf, 3, MPI_INT, partner, 2, MPI_COMM_WORLD );
MPI_Sendrecv( MPI_BOTTOM, 0, MPI_INT, partner, 1,
MPI_BOTTOM, 0, MPI_INT, partner, 1,
MPI_COMM_WORLD, &status );
}
/*
Next test - check that a cancel for a request receive from
MPI_PROC_NULL succeeds (there is some suspicion that some
systems can't handle this - also, MPI_REQUEST_NULL
Note that a null request is invalid (see the various NULL comments)
r1 = MPI_REQUEST_NULL;
MPI_Cancel( &r1 );
*/
MPI_Irecv( buf, 10, MPI_INT, MPI_PROC_NULL, 0, MPI_COMM_WORLD, &r1 );
MPI_Cancel( &r1 );
MPI_Request_free( &r1 );
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[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);
}
for (i = 0; i < 4; i++) {
free(bufs[i]);
}
}
MTest_Finalize(errs);
MPI_Finalize();
return 0;
}
int main( int argc, char **argv )
{
MPI_Request r1;
int size, rank;
int err = 0;
int partner, buf[10], flag, idx, index;
MPI_Status status;
MPI_Init( &argc, &argv );
MPI_Comm_size( MPI_COMM_WORLD, &size );
MPI_Comm_rank( MPI_COMM_WORLD, &rank );
if (size < 2) {
printf( "Cancel test requires at least 2 processes\n" );
MPI_Abort( MPI_COMM_WORLD, 1 );
}
/*
* Here is the test. First, we ensure an unsatisfied Irecv:
* process 0 process size-1
* Sendrecv Sendrecv
* Irecv ----
* Cancel ----
* Sendrecv Sendrecv
* Next, we confirm receipt before canceling
* Irecv Send
* Sendrecv Sendrecv
* Cancel
*/
if (rank == 0) {
partner = size - 1;
/* Cancel succeeds for wait/waitall */
MPI_Recv_init( buf, 10, MPI_INT, partner, 0, MPI_COMM_WORLD, &r1 );
MPI_Sendrecv( MPI_BOTTOM, 0, MPI_INT, partner, 1,
MPI_BOTTOM, 0, MPI_INT, partner, 1,
MPI_COMM_WORLD, &status );
MPI_Start( &r1 );
MPI_Cancel( &r1 );
MPI_Wait( &r1, &status );
MPI_Test_cancelled( &status, &flag );
MPI_Sendrecv( MPI_BOTTOM, 0, MPI_INT, partner, 1,
MPI_BOTTOM, 0, MPI_INT, partner, 1,
MPI_COMM_WORLD, &status );
if (!flag) {
err++;
printf( "Cancel of a receive failed where it should succeed (Wait).\n" );
}
MPI_Request_free( &r1 );
/* Cancel fails for test/testall */
buf[0] = -1;
MPI_Recv_init( buf, 10, MPI_INT, partner, 2, MPI_COMM_WORLD, &r1 );
MPI_Start( &r1 );
MPI_Sendrecv( MPI_BOTTOM, 0, MPI_INT, partner, 1,
MPI_BOTTOM, 0, MPI_INT, partner, 1,
MPI_COMM_WORLD, &status );
MPI_Cancel( &r1 );
MPI_Test( &r1, &flag, &status );
MPI_Test_cancelled( &status, &flag );
if (flag) {
err++;
printf( "Cancel of a receive succeeded where it shouldn't (Test).\n" );
if (buf[0] != -1) {
printf( "Receive buffer changed even though cancel suceeded! (Test).\n" );
}
}
MPI_Request_free( &r1 );
/* Cancel succeeds for waitany */
MPI_Recv_init( buf, 10, MPI_INT, partner, 0, MPI_COMM_WORLD, &r1 );
MPI_Sendrecv( MPI_BOTTOM, 0, MPI_INT, partner, 1,
MPI_BOTTOM, 0, MPI_INT, partner, 1,
MPI_COMM_WORLD, &status );
MPI_Start( &r1 );
MPI_Cancel( &r1 );
MPI_Waitany( 1, &r1, &idx, &status );
MPI_Test_cancelled( &status, &flag );
MPI_Sendrecv( MPI_BOTTOM, 0, MPI_INT, partner, 1,
MPI_BOTTOM, 0, MPI_INT, partner, 1,
MPI_COMM_WORLD, &status );
if (!flag) {
err++;
printf( "Cancel of a receive failed where it should succeed (Waitany).\n" );
}
MPI_Request_free( &r1 );
/* Cancel fails for testany */
buf[0] = -1;
MPI_Recv_init( buf, 10, MPI_INT, partner, 2, MPI_COMM_WORLD, &r1 );
MPI_Start( &r1 );
MPI_Sendrecv( MPI_BOTTOM, 0, MPI_INT, partner, 1,
MPI_BOTTOM, 0, MPI_INT, partner, 1,
MPI_COMM_WORLD, &status );
MPI_Cancel( &r1 );
MPI_Testany( 1, &r1, &idx, &flag, &status );
MPI_Test_cancelled( &status, &flag );
if (flag) {
err++;
printf( "Cancel of a receive succeeded where it shouldn't (Testany).\n" );
if (buf[0] != -1) {
printf( "Receive buffer changed even though cancel suceeded! (Test).\n" );
}
}
MPI_Request_free( &r1 );
/* Cancel succeeds for waitsome */
MPI_Recv_init( buf, 10, MPI_INT, partner, 0, MPI_COMM_WORLD, &r1 );
MPI_Sendrecv( MPI_BOTTOM, 0, MPI_INT, partner, 1,
MPI_BOTTOM, 0, MPI_INT, partner, 1,
MPI_COMM_WORLD, &status );
MPI_Start( &r1 );
MPI_Cancel( &r1 );
MPI_Waitsome( 1, &r1, &idx, &index, &status );
MPI_Test_cancelled( &status, &flag );
MPI_Sendrecv( MPI_BOTTOM, 0, MPI_INT, partner, 1,
MPI_BOTTOM, 0, MPI_INT, partner, 1,
MPI_COMM_WORLD, &status );
if (!flag) {
err++;
printf( "Cancel of a receive failed where it should succeed (Waitsome).\n" );
}
MPI_Request_free( &r1 );
/* Cancel fails for testsome*/
buf[0] = -1;
MPI_Recv_init( buf, 10, MPI_INT, partner, 2, MPI_COMM_WORLD, &r1 );
MPI_Start( &r1 );
MPI_Sendrecv( MPI_BOTTOM, 0, MPI_INT, partner, 1,
MPI_BOTTOM, 0, MPI_INT, partner, 1,
MPI_COMM_WORLD, &status );
MPI_Cancel( &r1 );
MPI_Testsome( 1, &r1, &idx, &index, &status );
MPI_Test_cancelled( &status, &flag );
if (flag) {
err++;
printf( "Cancel of a receive succeeded where it shouldn't (Testsome).\n" );
if (buf[0] != -1) {
printf( "Receive buffer changed even though cancel suceeded! (Testsome).\n" );
}
}
MPI_Request_free( &r1 );
if (err) {
printf( "Test failed with %d errors.\n", err );
}
else {
printf( " No Errors\n" );
}
}
else if (rank == size - 1) {
partner = 0;
/* Cancel succeeds for wait/waitall */
MPI_Sendrecv( MPI_BOTTOM, 0, MPI_INT, partner, 1,
MPI_BOTTOM, 0, MPI_INT, partner, 1,
MPI_COMM_WORLD, &status );
MPI_Sendrecv( MPI_BOTTOM, 0, MPI_INT, partner, 1,
MPI_BOTTOM, 0, MPI_INT, partner, 1,
MPI_COMM_WORLD, &status );
/* Cancel fails for test/testall */
buf[0] = 3;
MPI_Send( buf, 3, MPI_INT, partner, 2, MPI_COMM_WORLD );
MPI_Sendrecv( MPI_BOTTOM, 0, MPI_INT, partner, 1,
MPI_BOTTOM, 0, MPI_INT, partner, 1,
MPI_COMM_WORLD, &status );
/* Cancel succeeds for waitany */
MPI_Sendrecv( MPI_BOTTOM, 0, MPI_INT, partner, 1,
MPI_BOTTOM, 0, MPI_INT, partner, 1,
MPI_COMM_WORLD, &status );
MPI_Sendrecv( MPI_BOTTOM, 0, MPI_INT, partner, 1,
MPI_BOTTOM, 0, MPI_INT, partner, 1,
MPI_COMM_WORLD, &status );
/* Cancel fails for testany */
MPI_Send( buf, 3, MPI_INT, partner, 2, MPI_COMM_WORLD );
MPI_Sendrecv( MPI_BOTTOM, 0, MPI_INT, partner, 1,
MPI_BOTTOM, 0, MPI_INT, partner, 1,
MPI_COMM_WORLD, &status );
/* Cancel succeeds for waitsome */
MPI_Sendrecv( MPI_BOTTOM, 0, MPI_INT, partner, 1,
MPI_BOTTOM, 0, MPI_INT, partner, 1,
MPI_COMM_WORLD, &status );
MPI_Sendrecv( MPI_BOTTOM, 0, MPI_INT, partner, 1,
MPI_BOTTOM, 0, MPI_INT, partner, 1,
MPI_COMM_WORLD, &status );
/* Cancel fails for waitsome */
MPI_Send( buf, 3, MPI_INT, partner, 2, MPI_COMM_WORLD );
MPI_Sendrecv( MPI_BOTTOM, 0, MPI_INT, partner, 1,
MPI_BOTTOM, 0, MPI_INT, partner, 1,
MPI_COMM_WORLD, &status );
/*
Next test - check that a cancel for a request receive from
MPI_PROC_NULL succeeds (there is some suspicion that some
systems can't handle this - also, MPI_REQUEST_NULL
*/
/* A null request is an error. (null objects are errors unless otherwise
allowed)
r1 = MPI_REQUEST_NULL;
MPI_Cancel( &r1 );
*/
MPI_Recv_init( buf, 10, MPI_INT, MPI_PROC_NULL, 0, MPI_COMM_WORLD, &r1 );
MPI_Start( &r1 );
MPI_Cancel( &r1 );
MPI_Request_free( &r1 ); /* Must complete cancel. We know that it
won't complete, so we don't need to do
anything else */
}
MPI_Finalize();
return 0;
}
void declareBindings (void)
{
/* === Point-to-point === */
void* buf;
int count;
MPI_Datatype datatype;
int dest;
int tag;
MPI_Comm comm;
MPI_Send (buf, count, datatype, dest, tag, comm); // L12
int source;
MPI_Status status;
MPI_Recv (buf, count, datatype, source, tag, comm, &status); // L15
MPI_Get_count (&status, datatype, &count);
MPI_Bsend (buf, count, datatype, dest, tag, comm);
MPI_Ssend (buf, count, datatype, dest, tag, comm);
MPI_Rsend (buf, count, datatype, dest, tag, comm);
void* buffer;
int size;
MPI_Buffer_attach (buffer, size); // L22
MPI_Buffer_detach (buffer, &size);
MPI_Request request;
MPI_Isend (buf, count, datatype, dest, tag, comm, &request); // L25
MPI_Ibsend (buf, count, datatype, dest, tag, comm, &request);
MPI_Issend (buf, count, datatype, dest, tag, comm, &request);
MPI_Irsend (buf, count, datatype, dest, tag, comm, &request);
MPI_Irecv (buf, count, datatype, source, tag, comm, &request);
MPI_Wait (&request, &status);
int flag;
MPI_Test (&request, &flag, &status); // L32
MPI_Request_free (&request);
MPI_Request* array_of_requests;
int index;
MPI_Waitany (count, array_of_requests, &index, &status); // L36
MPI_Testany (count, array_of_requests, &index, &flag, &status);
MPI_Status* array_of_statuses;
MPI_Waitall (count, array_of_requests, array_of_statuses); // L39
MPI_Testall (count, array_of_requests, &flag, array_of_statuses);
int incount;
int outcount;
int* array_of_indices;
MPI_Waitsome (incount, array_of_requests, &outcount, array_of_indices,
array_of_statuses); // L44--45
MPI_Testsome (incount, array_of_requests, &outcount, array_of_indices,
array_of_statuses); // L46--47
MPI_Iprobe (source, tag, comm, &flag, &status); // L48
MPI_Probe (source, tag, comm, &status);
MPI_Cancel (&request);
MPI_Test_cancelled (&status, &flag);
MPI_Send_init (buf, count, datatype, dest, tag, comm, &request);
MPI_Bsend_init (buf, count, datatype, dest, tag, comm, &request);
MPI_Ssend_init (buf, count, datatype, dest, tag, comm, &request);
MPI_Rsend_init (buf, count, datatype, dest, tag, comm, &request);
MPI_Recv_init (buf, count, datatype, source, tag, comm, &request);
MPI_Start (&request);
MPI_Startall (count, array_of_requests);
void* sendbuf;
int sendcount;
MPI_Datatype sendtype;
int sendtag;
void* recvbuf;
int recvcount;
MPI_Datatype recvtype;
MPI_Datatype recvtag;
MPI_Sendrecv (sendbuf, sendcount, sendtype, dest, sendtag,
recvbuf, recvcount, recvtype, source, recvtag,
comm, &status); // L67--69
MPI_Sendrecv_replace (buf, count, datatype, dest, sendtag, source, recvtag,
comm, &status); // L70--71
MPI_Datatype oldtype;
MPI_Datatype newtype;
MPI_Type_contiguous (count, oldtype, &newtype); // L74
int blocklength;
{
int stride;
MPI_Type_vector (count, blocklength, stride, oldtype, &newtype); // L78
}
{
MPI_Aint stride;
MPI_Type_hvector (count, blocklength, stride, oldtype, &newtype); // L82
}
int* array_of_blocklengths;
{
int* array_of_displacements;
MPI_Type_indexed (count, array_of_blocklengths, array_of_displacements,
oldtype, &newtype); // L87--88
}
{
MPI_Aint* array_of_displacements;
MPI_Type_hindexed (count, array_of_blocklengths, array_of_displacements,
oldtype, &newtype); // L92--93
MPI_Datatype* array_of_types;
MPI_Type_struct (count, array_of_blocklengths, array_of_displacements,
array_of_types, &newtype); // L95--96
}
void* location;
MPI_Aint address;
MPI_Address (location, &address); // L100
MPI_Aint extent;
MPI_Type_extent (datatype, &extent); // L102
MPI_Type_size (datatype, &size);
MPI_Aint displacement;
MPI_Type_lb (datatype, &displacement); // L105
MPI_Type_ub (datatype, &displacement);
MPI_Type_commit (&datatype);
MPI_Type_free (&datatype);
MPI_Get_elements (&status, datatype, &count);
void* inbuf;
void* outbuf;
int outsize;
int position;
MPI_Pack (inbuf, incount, datatype, outbuf, outsize, &position, comm); // L114
int insize;
MPI_Unpack (inbuf, insize, &position, outbuf, outcount, datatype,
comm); // L116--117
MPI_Pack_size (incount, datatype, comm, &size);
/* === Collectives === */
MPI_Barrier (comm); // L121
int root;
MPI_Bcast (buffer, count, datatype, root, comm); // L123
MPI_Gather (sendbuf, sendcount, sendtype, recvbuf, recvcount, recvtype,
root, comm); // L124--125
int* recvcounts;
int* displs;
MPI_Gatherv (sendbuf, sendcount, sendtype,
recvbuf, recvcounts, displs, recvtype,
root, comm); // L128--130
MPI_Scatter (sendbuf, sendcount, sendtype, recvbuf, recvcount, recvtype,
root, comm); // L131--132
int* sendcounts;
MPI_Scatterv (sendbuf, sendcounts, displs, sendtype,
recvbuf, recvcount, recvtype, root, comm); // L134--135
MPI_Allgather (sendbuf, sendcount, sendtype, recvbuf, recvcount, recvtype,
comm); // L136--137
MPI_Allgatherv (sendbuf, sendcount, sendtype,
recvbuf, recvcounts, displs, recvtype,
comm); // L138--140
MPI_Alltoall (sendbuf, sendcount, sendtype, recvbuf, recvcount, recvtype,
comm); // L141--142
int* sdispls;
int* rdispls;
MPI_Alltoallv (sendbuf, sendcounts, sdispls, sendtype,
recvbuf, recvcounts, rdispls, recvtype,
comm); // L145--147
MPI_Op op;
MPI_Reduce (sendbuf, recvbuf, count, datatype, op, root, comm); // L149
#if 0
MPI_User_function function;
int commute;
MPI_Op_create (function, commute, &op); // L153
#endif
MPI_Op_free (&op); // L155
MPI_Allreduce (sendbuf, recvbuf, count, datatype, op, comm);
MPI_Reduce_scatter (sendbuf, recvbuf, recvcounts, datatype, op, comm);
MPI_Scan (sendbuf, recvbuf, count, datatype, op, comm);
/* === Groups, contexts, and communicators === */
MPI_Group group;
MPI_Group_size (group, &size); // L162
int rank;
MPI_Group_rank (group, &rank); // L164
MPI_Group group1;
int n;
int* ranks1;
MPI_Group group2;
int* ranks2;
MPI_Group_translate_ranks (group1, n, ranks1, group2, ranks2); // L170
int result;
MPI_Group_compare (group1, group2, &result); // L172
MPI_Group newgroup;
MPI_Group_union (group1, group2, &newgroup); // L174
MPI_Group_intersection (group1, group2, &newgroup);
MPI_Group_difference (group1, group2, &newgroup);
int* ranks;
MPI_Group_incl (group, n, ranks, &newgroup); // L178
MPI_Group_excl (group, n, ranks, &newgroup);
extern int ranges[][3];
MPI_Group_range_incl (group, n, ranges, &newgroup); // L181
MPI_Group_range_excl (group, n, ranges, &newgroup);
MPI_Group_free (&group);
MPI_Comm_size (comm, &size);
MPI_Comm_rank (comm, &rank);
MPI_Comm comm1;
MPI_Comm comm2;
MPI_Comm_compare (comm1, comm2, &result);
MPI_Comm newcomm;
MPI_Comm_dup (comm, &newcomm);
MPI_Comm_create (comm, group, &newcomm);
int color;
int key;
MPI_Comm_split (comm, color, key, &newcomm); // L194
MPI_Comm_free (&comm);
MPI_Comm_test_inter (comm, &flag);
MPI_Comm_remote_size (comm, &size);
MPI_Comm_remote_group (comm, &group);
MPI_Comm local_comm;
int local_leader;
MPI_Comm peer_comm;
int remote_leader;
MPI_Comm newintercomm;
MPI_Intercomm_create (local_comm, local_leader, peer_comm, remote_leader, tag,
&newintercomm); // L204--205
MPI_Comm intercomm;
MPI_Comm newintracomm;
int high;
MPI_Intercomm_merge (intercomm, high, &newintracomm); // L209
int keyval;
#if 0
MPI_Copy_function copy_fn;
MPI_Delete_function delete_fn;
void* extra_state;
MPI_Keyval_create (copy_fn, delete_fn, &keyval, extra_state); // L215
#endif
MPI_Keyval_free (&keyval); // L217
void* attribute_val;
MPI_Attr_put (comm, keyval, attribute_val); // L219
MPI_Attr_get (comm, keyval, attribute_val, &flag);
MPI_Attr_delete (comm, keyval);
/* === Environmental inquiry === */
char* name;
int resultlen;
MPI_Get_processor_name (name, &resultlen); // L226
MPI_Errhandler errhandler;
#if 0
MPI_Handler_function function;
MPI_Errhandler_create (function, &errhandler); // L230
#endif
MPI_Errhandler_set (comm, errhandler); // L232
MPI_Errhandler_get (comm, &errhandler);
MPI_Errhandler_free (&errhandler);
int errorcode;
char* string;
MPI_Error_string (errorcode, string, &resultlen); // L237
int errorclass;
MPI_Error_class (errorcode, &errorclass); // L239
MPI_Wtime ();
MPI_Wtick ();
int argc;
char** argv;
MPI_Init (&argc, &argv); // L244
MPI_Finalize ();
MPI_Initialized (&flag);
MPI_Abort (comm, errorcode);
}
int main( int argc, char **argv )
{
MPI_Request r1;
int size, rank;
int err = 0;
int partner, buf[10], flag, idx, index;
MPI_Status status;
MPI_Init( &argc, &argv );
MPI_Comm_size( MPI_COMM_WORLD, &size );
MPI_Comm_rank( MPI_COMM_WORLD, &rank );
if (size < 2) {
printf( "Cancel test requires at least 2 processes\n" );
MPI_Abort( MPI_COMM_WORLD, 1 );
}
/*
* Here is the test. First, we ensure an unsatisfied Irecv:
* process 0 process size-1
* Sendrecv Sendrecv
* Irecv ----
* Cancel ----
* Sendrecv Sendrecv
* Next, we confirm receipt before canceling
* Irecv Send
* Sendrecv Sendrecv
* Cancel
*/
if (rank == 0) {
partner = size - 1;
/* Cancel succeeds for wait/waitall */
MPI_Send_init( buf, 10, MPI_INT, partner, 0, MPI_COMM_WORLD, &r1 );
MPI_Sendrecv( MPI_BOTTOM, 0, MPI_INT, partner, 1,
MPI_BOTTOM, 0, MPI_INT, partner, 1,
MPI_COMM_WORLD, &status );
MPI_Start( &r1 );
MPI_Cancel( &r1 );
MPI_Wait( &r1, &status );
MPI_Test_cancelled( &status, &flag );
MPI_Sendrecv( MPI_BOTTOM, 0, MPI_INT, partner, 1,
MPI_BOTTOM, 0, MPI_INT, partner, 1,
MPI_COMM_WORLD, &status );
if (!flag) {
err++;
printf( "Cancel of a send failed where it should succeed (Wait).\n" );
}
MPI_Request_free( &r1 );
/* Cancel fails for test/testall */
buf[0] = 3;
MPI_Send_init( buf, 3, MPI_INT, partner, 2, MPI_COMM_WORLD, &r1 );
MPI_Start( &r1 );
MPI_Sendrecv( MPI_BOTTOM, 0, MPI_INT, partner, 1,
MPI_BOTTOM, 0, MPI_INT, partner, 1,
MPI_COMM_WORLD, &status );
MPI_Cancel( &r1 );
MPI_Test( &r1, &flag, &status );
MPI_Test_cancelled( &status, &flag );
if (flag) {
err++;
printf( "Cancel of a send succeeded where it shouldn't (Test).\n" );
}
MPI_Request_free( &r1 );
/* Cancel succeeds for waitany */
MPI_Send_init( buf, 10, MPI_INT, partner, 0, MPI_COMM_WORLD, &r1 );
MPI_Sendrecv( MPI_BOTTOM, 0, MPI_INT, partner, 1,
MPI_BOTTOM, 0, MPI_INT, partner, 1,
MPI_COMM_WORLD, &status );
MPI_Start( &r1 );
MPI_Cancel( &r1 );
MPI_Waitany( 1, &r1, &idx, &status );
MPI_Test_cancelled( &status, &flag );
MPI_Sendrecv( MPI_BOTTOM, 0, MPI_INT, partner, 1,
MPI_BOTTOM, 0, MPI_INT, partner, 1,
MPI_COMM_WORLD, &status );
if (!flag) {
err++;
printf( "Cancel of a send failed where it should succeed (Waitany).\n" );
}
MPI_Request_free( &r1 );
/* Cancel fails for testany */
buf[0] = 3;
MPI_Send_init( buf, 3, MPI_INT, partner, 2, MPI_COMM_WORLD, &r1 );
MPI_Start( &r1 );
MPI_Sendrecv( MPI_BOTTOM, 0, MPI_INT, partner, 1,
MPI_BOTTOM, 0, MPI_INT, partner, 1,
MPI_COMM_WORLD, &status );
MPI_Cancel( &r1 );
MPI_Testany( 1, &r1, &idx, &flag, &status );
MPI_Test_cancelled( &status, &flag );
if (flag) {
err++;
printf( "Cancel of a send succeeded where it shouldn't (Testany).\n" );
}
MPI_Request_free( &r1 );
/* Cancel succeeds for waitsome */
MPI_Send_init( buf, 10, MPI_INT, partner, 0, MPI_COMM_WORLD, &r1 );
MPI_Sendrecv( MPI_BOTTOM, 0, MPI_INT, partner, 1,
MPI_BOTTOM, 0, MPI_INT, partner, 1,
MPI_COMM_WORLD, &status );
MPI_Start( &r1 );
MPI_Cancel( &r1 );
MPI_Waitsome( 1, &r1, &idx, &index, &status );
MPI_Test_cancelled( &status, &flag );
MPI_Sendrecv( MPI_BOTTOM, 0, MPI_INT, partner, 1,
MPI_BOTTOM, 0, MPI_INT, partner, 1,
MPI_COMM_WORLD, &status );
if (!flag) {
err++;
printf( "Cancel of a send failed where it should succeed (Waitsome).\n" );
}
MPI_Request_free( &r1 );
/* Cancel fails for testsome*/
buf[0] = 3;
MPI_Send_init( buf, 3, MPI_INT, partner, 2, MPI_COMM_WORLD, &r1 );
MPI_Start( &r1 );
MPI_Sendrecv( MPI_BOTTOM, 0, MPI_INT, partner, 1,
MPI_BOTTOM, 0, MPI_INT, partner, 1,
MPI_COMM_WORLD, &status );
MPI_Cancel( &r1 );
MPI_Testsome( 1, &r1, &idx, &index, &status );
MPI_Test_cancelled( &status, &flag );
if (flag) {
err++;
printf( "Cancel of a send succeeded where it shouldn't (Testsome).\n" );
}
MPI_Request_free( &r1 );
if (err) {
printf( "Test failed with %d errors.\n", err );
}
else {
printf( "Test passed\n" );
}
}
else if (rank == size - 1) {
partner = 0;
/* Cancel succeeds for wait/waitall */
MPI_Sendrecv( MPI_BOTTOM, 0, MPI_INT, partner, 1,
MPI_BOTTOM, 0, MPI_INT, partner, 1,
MPI_COMM_WORLD, &status );
MPI_Sendrecv( MPI_BOTTOM, 0, MPI_INT, partner, 1,
MPI_BOTTOM, 0, MPI_INT, partner, 1,
MPI_COMM_WORLD, &status );
/* Cancel fails for test/testall */
buf[0] = -1;
MPI_Recv( buf, 3, MPI_INT, partner, 2, MPI_COMM_WORLD, &status );
MPI_Sendrecv( MPI_BOTTOM, 0, MPI_INT, partner, 1,
MPI_BOTTOM, 0, MPI_INT, partner, 1,
MPI_COMM_WORLD, &status );
if (buf[0] == -1) {
printf( "Receive buffer did not change even though cancel should not have suceeded! (Test).\n" );
}
/* Cancel succeeds for waitany */
MPI_Sendrecv( MPI_BOTTOM, 0, MPI_INT, partner, 1,
MPI_BOTTOM, 0, MPI_INT, partner, 1,
MPI_COMM_WORLD, &status );
MPI_Sendrecv( MPI_BOTTOM, 0, MPI_INT, partner, 1,
MPI_BOTTOM, 0, MPI_INT, partner, 1,
MPI_COMM_WORLD, &status );
/* Cancel fails for testany */
buf[0] = -1;
MPI_Recv( buf, 3, MPI_INT, partner, 2, MPI_COMM_WORLD, &status );
MPI_Sendrecv( MPI_BOTTOM, 0, MPI_INT, partner, 1,
MPI_BOTTOM, 0, MPI_INT, partner, 1,
MPI_COMM_WORLD, &status );
if (buf[0] == -1) {
printf( "Receive buffer did not change even though cancel should not have suceeded! (Testany).\n" );
}
/* Cancel succeeds for waitsome */
MPI_Sendrecv( MPI_BOTTOM, 0, MPI_INT, partner, 1,
MPI_BOTTOM, 0, MPI_INT, partner, 1,
MPI_COMM_WORLD, &status );
MPI_Sendrecv( MPI_BOTTOM, 0, MPI_INT, partner, 1,
MPI_BOTTOM, 0, MPI_INT, partner, 1,
MPI_COMM_WORLD, &status );
/* Cancel fails for testsome */
buf[0] = -1;
MPI_Recv( buf, 3, MPI_INT, partner, 2, MPI_COMM_WORLD, &status );
MPI_Sendrecv( MPI_BOTTOM, 0, MPI_INT, partner, 1,
MPI_BOTTOM, 0, MPI_INT, partner, 1,
MPI_COMM_WORLD, &status );
if (buf[0] == -1) {
printf( "Receive buffer did not change even though cancel should not have suceeded! (Test).\n" );
}
}
MPI_Finalize();
return 0;
}
