int main( int argc, char *argv[] )
{
int errs = 0;
MPI_Comm comm;
int cnt, rlen;
char name[MPI_MAX_OBJECT_NAME], nameout[MPI_MAX_OBJECT_NAME];
MTest_Init( &argc, &argv );
/* Check world and self firt */
nameout[0] = 0;
MPI_Comm_get_name( MPI_COMM_WORLD, nameout, &rlen );
if (strcmp(nameout,"MPI_COMM_WORLD")) {
errs++;
printf( "Name of comm world is %s, should be MPI_COMM_WORLD\n",
nameout );
}
nameout[0] = 0;
MPI_Comm_get_name( MPI_COMM_SELF, nameout, &rlen );
if (strcmp(nameout,"MPI_COMM_SELF")) {
errs++;
printf( "Name of comm self is %s, should be MPI_COMM_SELF\n",
nameout );
}
/* Now, handle other communicators, including world/self */
cnt = 0;
while (MTestGetComm( &comm, 1 )) {
if (comm == MPI_COMM_NULL) continue;
sprintf( name, "comm-%d", cnt );
cnt++;
MPI_Comm_set_name( comm, name );
nameout[0] = 0;
MPI_Comm_get_name( comm, nameout, &rlen );
if (strcmp( name, nameout )) {
errs++;
printf( "Unexpected name, was %s but should be %s\n",
nameout, name );
}
MTestFreeComm( &comm );
}
MTest_Finalize( errs );
MPI_Finalize();
return 0;
}
void mpi_comm_get_name_f(MPI_Fint *comm, char *comm_name,
MPI_Fint *resultlen, MPI_Fint *ierr,
int name_len)
{
int err, c_len;
MPI_Comm c_comm = MPI_Comm_f2c(*comm);
char c_name[MPI_MAX_OBJECT_NAME];
err = MPI_Comm_get_name(c_comm, c_name, &c_len);
if (MPI_SUCCESS == err) {
ompi_fortran_string_c2f(c_name, comm_name, name_len);
*resultlen = OMPI_INT_2_FINT(c_len);
*ierr = OMPI_INT_2_FINT(MPI_SUCCESS);
} else {
*ierr = OMPI_INT_2_FINT(err);
}
}
void MPICommunicator::set_comm(MPI_Comm comm)
{
this->comm = comm;
MPI_Comm_size(this->comm, &(this->_size));
MPI_Comm_rank(this->comm, &(this->_rank));
int len = 0;
char buff[MPI_MAX_OBJECT_NAME];
int err = MPI_Comm_get_name(this->comm, buff, &len);
check_mpi_error(err);
if (len == 0) {
this->_name = string("world");
} else {
this->_name = string(buff, len);
}
shared_ptr<MPIStatus> status = make_shared<MPIStatus>();
this->status = status;
this->status->set_comm(this);
}
static void CIRCLE_MPI_error_handler(MPI_Comm* comm, int* err, ...)
{
char name[MPI_MAX_OBJECT_NAME];
int namelen;
MPI_Comm_get_name(*comm, name, &namelen);
if(*err == LIBCIRCLE_MPI_ERROR) {
LOG(CIRCLE_LOG_ERR, "Libcircle received abort signal, checkpointing.");
}
else {
char error[MPI_MAX_ERROR_STRING];
int error_len = 0;
MPI_Error_string(*err, error, &error_len);
LOG(CIRCLE_LOG_ERR, "MPI Error in Comm [%s]: %s", name, error);
LOG(CIRCLE_LOG_ERR, "Libcircle received MPI error, checkpointing.");
}
CIRCLE_checkpoint();
exit(EXIT_FAILURE);
}
/* 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;
}
#undef MPI_Comm_get_name
#define MPI_Comm_get_name PMPI_Comm_get_name
#else
#ifdef F77_NAME_UPPER
#define mpi_comm_get_name_ MPI_COMM_GET_NAME
#elif defined(F77_NAME_LOWER_2USCORE)
#define mpi_comm_get_name_ mpi_comm_get_name__
#elif !defined(F77_NAME_LOWER_USCORE)
#define mpi_comm_get_name_ mpi_comm_get_name
/* Else leave name alone */
#endif
#endif /* MPICH_MPI_FROM_PMPI */
/* Prototypes for the Fortran interfaces */
#include "fproto.h"
FORT_DLL_SPEC void FORT_CALL mpi_comm_get_name_ ( MPI_Fint *v1, char *v2 FORT_MIXED_LEN(d2), MPI_Fint *v3, MPI_Fint *ierr FORT_END_LEN(d2) ){
char *p2;
p2 = (char *)MPIU_Malloc( d2 + 1 );
*ierr = MPI_Comm_get_name( (MPI_Comm)(*v1), p2, v3 );
if (!*ierr) {char *p = v2, *pc=p2;
while (*pc) {*p++ = *pc++;}
while ((p-v2) < d2) { *p++ = ' '; }
}
MPIU_Free( p2 );
}
int main(int argc, char *argv[])
{
int errs = 0, err;
int rank, size, rsize, i;
int np = 2;
int errcodes[2];
MPI_Comm parentcomm, intercomm;
MPI_Status status;
int can_spawn;
MTest_Init(&argc, &argv);
errs += MTestSpawnPossible(&can_spawn);
if (can_spawn) {
MPI_Comm_get_parent(&parentcomm);
if (parentcomm == MPI_COMM_NULL) {
/* Create 2 more processes */
MPI_Comm_spawn((char *) "./spawn1", MPI_ARGV_NULL, np,
MPI_INFO_NULL, 0, MPI_COMM_WORLD, &intercomm, errcodes);
} else
intercomm = parentcomm;
/* We now have a valid intercomm */
MPI_Comm_remote_size(intercomm, &rsize);
MPI_Comm_size(intercomm, &size);
MPI_Comm_rank(intercomm, &rank);
if (parentcomm == MPI_COMM_NULL) {
/* Master */
if (rsize != np) {
errs++;
printf("Did not create %d processes (got %d)\n", np, rsize);
}
if (rank == 0) {
for (i = 0; i < rsize; i++) {
MPI_Send(&i, 1, MPI_INT, i, 0, intercomm);
}
/* We could use intercomm reduce to get the errors from the
* children, but we'll use a simpler loop to make sure that
* we get valid data */
for (i = 0; i < rsize; i++) {
MPI_Recv(&err, 1, MPI_INT, i, 1, intercomm, MPI_STATUS_IGNORE);
errs += err;
}
}
} else {
/* Child */
char cname[MPI_MAX_OBJECT_NAME];
int rlen;
if (size != np) {
errs++;
printf("(Child) Did not create %d processes (got %d)\n", np, size);
}
/* Check the name of the parent */
cname[0] = 0;
MPI_Comm_get_name(intercomm, cname, &rlen);
/* MPI-2 section 8.4 requires that the parent have this
* default name */
if (strcmp(cname, "MPI_COMM_PARENT") != 0) {
errs++;
printf("Name of parent is not correct\n");
if (rlen > 0 && cname[0]) {
printf(" Got %s but expected MPI_COMM_PARENT\n", cname);
} else {
printf(" Expected MPI_COMM_PARENT but no name set\n");
}
}
MPI_Recv(&i, 1, MPI_INT, 0, 0, intercomm, &status);
if (i != rank) {
errs++;
printf("Unexpected rank on child %d (%d)\n", rank, i);
}
/* Send the errs back to the master process */
MPI_Ssend(&errs, 1, MPI_INT, 0, 1, intercomm);
}
/* It isn't necessary to free the intercomm, but it should not hurt */
/* Using Comm_disconnect instead of free should provide a stronger
* test, as a high-quality MPI implementation will be able to
* recover some resources that it should hold on to in the case
* of MPI_Comm_free */
/* MPI_Comm_free(&intercomm); */
MPI_Comm_disconnect(&intercomm);
/* Note that the MTest_Finalize get errs only over COMM_WORLD */
/* Note also that both the parent and child will generate "No Errors"
* if both call MTest_Finalize */
if (parentcomm == MPI_COMM_NULL) {
MTest_Finalize(errs);
} else {
MPI_Finalize();
}
} else {
MTest_Finalize(errs);
}
return MTestReturnValue(errs);
}
