int f2ctype_(MPI_Fint * fhandle, MPI_Fint * typeidx)
{
int errs = 0;
MPI_Datatype ctype;
/* printf("Testing %s\n", mpi_names[*typeidx].name); */
ctype = MPI_Type_f2c(*fhandle);
if (ctype != mpi_names[*typeidx].dtype) {
char mytypename[MPI_MAX_OBJECT_NAME];
int mytypenamelen;
/* An implementation is not *required* to deliver the
* corresponding C version of the MPI Datatype bit-for-bit. But
* if *must* act like it - e.g., the datatype name must be the same */
MPI_Type_get_name(ctype, mytypename, &mytypenamelen);
if (strcmp(mytypename, mpi_names[*typeidx].name) != 0 &&
/* LONG_LONG is a synonym of LONG_LONG_INT, thus LONG_LONG_INT is also a vaild name */
(ctype != MPI_LONG_LONG || strcmp(mytypename, "MPI_LONG_LONG_INT") != 0)) {
errs++;
printf("C and Fortran types for %s (c name is %s) do not match f=%d, ctof=%d.\n",
mpi_names[*typeidx].name, mytypename, *fhandle, MPI_Type_c2f(ctype));
}
}
return errs;
}
int main (int argc, char** argv) {
int rank, numprocs;
int namelen;
char name[MPI_MAX_OBJECT_NAME], newname[MPI_MAX_OBJECT_NAME];
int i, errs;
MPI_Init(&argc, &argv);
MPI_Comm_rank(MPI_COMM_WORLD, &rank);
MPI_Comm_size(MPI_COMM_WORLD, &numprocs);
// 获取所有类型名字
for (i = 0; i < 3; i++) {
MPI_Type_get_name(mpi_names[i].dtype, name, &namelen);
if (strncmp(name, mpi_names[i].name, MPI_MAX_OBJECT_NAME)) {
errs++;
fprintf(stderr, "Expected %s but got: %s \n", mpi_names[i].name, name);
fflush(stderr);
} else {
fprintf(stdout, "Proc: %d, %s type's name: %s, namelen = %d\n",
rank, mpi_names[i].name, name, namelen);
fflush(stdout);
}
}
// 重设类型名字
sprintf_s(newname, "int_%d", rank);
name[0]=0;
MPI_Type_set_name(MPI_INT, newname);
MPI_Type_get_name(MPI_INT, name, &namelen);
if (strncmp(name, newname, MPI_MAX_OBJECT_NAME)) {
errs++;
fprintf(stderr, "\nExpected MPI_INT but got: %s \n", name);
fflush(stderr);
} else {
fprintf(stdout, "\nProc: %d, MPI_INT type's name: %s, namelen = %d\n",
rank, name, namelen);
fflush(stdout);
}
MPI_Finalize();
return 0;
}
/* This next routine uses a circular buffer of static name arrays just to
simplify the use of the routine */
const char *MTestGetDatatypeName( MTestDatatype *dtype )
{
static char name[4][MPI_MAX_OBJECT_NAME];
static int sp=0;
int rlen, merr;
if (sp >= 4) sp = 0;
merr = MPI_Type_get_name( dtype->datatype, name[sp], &rlen );
if (merr) MTestPrintError( merr );
return (const char *)name[sp++];
}
JNIEXPORT jstring JNICALL Java_mpi_Datatype_getName(
JNIEnv *env, jobject jthis, jlong handle)
{
char name[MPI_MAX_OBJECT_NAME];
int len;
int rc = MPI_Type_get_name((MPI_Datatype)handle, name, &len);
if(ompi_java_exceptionCheck(env, rc))
return NULL;
return (*env)->NewStringUTF(env, name);
}
void mpi_type_get_name_f(MPI_Fint *type, char *type_name, MPI_Fint *resultlen, MPI_Fint *ierr, int name_len)
{
int err, c_len;
MPI_Datatype c_type = MPI_Type_f2c(*type);
char c_name[MPI_MAX_OBJECT_NAME];
err = MPI_Type_get_name(c_type, c_name, &c_len);
if (MPI_SUCCESS == err) {
ompi_fortran_string_c2f(c_name, type_name, name_len);
*resultlen = OMPI_INT_2_FINT(c_len);
*ierr = OMPI_INT_2_FINT(MPI_SUCCESS);
} else {
*ierr = OMPI_INT_2_FINT(err);
}
}
/*
This program is derived from one in the MPICH-1 test suite
This version sends and receives EVERYTHING from MPI_BOTTOM, by putting
the data into a structure.
*/
int main( int argc, char **argv )
{
MPI_Datatype *types;
void **inbufs, **outbufs;
int *counts, *bytesize, ntype;
MPI_Comm comm;
int ncomm = 20, rank, np, partner, tag, count;
int j, k, err, toterr, world_rank, errloc;
MPI_Status status;
char *obuf;
MPI_Datatype offsettype;
int blen;
MPI_Aint displ, extent, natural_extent;
char myname[MPI_MAX_OBJECT_NAME];
int mynamelen;
MTest_Init( &argc, &argv );
MTestDatatype2Allocate( &types, &inbufs, &outbufs, &counts, &bytesize,
&ntype );
MTestDatatype2Generate( types, inbufs, outbufs, counts, bytesize, &ntype );
MPI_Comm_rank( MPI_COMM_WORLD, &world_rank );
/* Test over a wide range of datatypes and communicators */
err = 0;
tag = 0;
while (MTestGetIntracomm( &comm, 2 )) {
if (comm == MPI_COMM_NULL) continue;
MPI_Comm_rank( comm, &rank );
MPI_Comm_size( comm, &np );
if (np < 2) continue;
tag++;
for (j=0; j<ntype; j++) {
MPI_Type_get_name( types[j], myname, &mynamelen );
if (world_rank == 0)
MTestPrintfMsg( 10, "Testing type %s\n", myname );
if (rank == 0) {
MPI_Get_address( inbufs[j], &displ );
blen = 1;
MPI_Type_create_struct( 1, &blen, &displ, types + j,
&offsettype );
MPI_Type_commit( &offsettype );
/* Warning: if the type has an explicit MPI_UB, then using a
simple shift of the offset won't work. For now, we skip
types whose extents are negative; the correct solution is
to add, where required, an explicit MPI_UB */
MPI_Type_extent( offsettype, &extent );
if (extent < 0) {
if (world_rank == 0)
MTestPrintfMsg( 10,
"... skipping (appears to have explicit MPI_UB\n" );
MPI_Type_free( &offsettype );
continue;
}
MPI_Type_extent( types[j], &natural_extent );
if (natural_extent != extent) {
MPI_Type_free( &offsettype );
continue;
}
partner = np - 1;
MPI_Send( MPI_BOTTOM, counts[j], offsettype, partner, tag,
comm );
MPI_Type_free( &offsettype );
}
else if (rank == np-1) {
partner = 0;
obuf = outbufs[j];
for (k=0; k<bytesize[j]; k++)
obuf[k] = 0;
MPI_Get_address( outbufs[j], &displ );
blen = 1;
MPI_Type_create_struct( 1, &blen, &displ, types + j,
&offsettype );
MPI_Type_commit( &offsettype );
/* Warning: if the type has an explicit MPI_UB, then using a
simple shift of the offset won't work. For now, we skip
types whose extents are negative; the correct solution is
to add, where required, an explicit MPI_UB */
MPI_Type_extent( offsettype, &extent );
if (extent < 0) {
MPI_Type_free( &offsettype );
continue;
}
MPI_Type_extent( types[j], &natural_extent );
if (natural_extent != extent) {
MPI_Type_free( &offsettype );
continue;
}
MPI_Recv( MPI_BOTTOM, counts[j], offsettype,
partner, tag, comm, &status );
/* Test for correctness */
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], myname );
err++;
}
if (status.MPI_SOURCE != partner) {
fprintf( stderr,
"Error in source (got %d expected %d) with type %s\n",
status.MPI_SOURCE, partner, myname );
err++;
}
if ((errloc = MTestDatatype2Check( inbufs[j], outbufs[j],
bytesize[j] ))) {
fprintf( stderr,
"Error in data with type %s (type %d on %d) at byte %d\n",
myname, j, world_rank, errloc - 1 );
if (err < 10) {
/* Give details on only the first 10 errors */
unsigned char *in_p = (unsigned char *)inbufs[j],
*out_p = (unsigned char *)outbufs[j];
int jj;
jj = errloc - 1;
jj &= 0xfffffffc; /* lop off a few bits */
in_p += jj;
out_p += jj;
fprintf( stderr, "%02x%02x%02x%02x should be %02x%02x%02x%02x\n",
out_p[0], out_p[1], out_p[2], out_p[3],
in_p[0], in_p[1], in_p[2], in_p[3] );
}
err++;
}
MPI_Type_free( &offsettype );
}
}
MTestFreeComm( &comm );
}
MTestDatatype2Free( types, inbufs, outbufs, counts, bytesize, ntype );
MTest_Finalize( err );
MPI_Finalize();
return MTestReturnValue( err );
}
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 );
MPI_Finalize();
return 0;
}
int main( int argc, char **argv )
{
mpi_names_t mpi_names[] = {
{ MPI_CHAR, "MPI_CHAR" },
{ MPI_SIGNED_CHAR, "MPI_SIGNED_CHAR" },
{ MPI_UNSIGNED_CHAR, "MPI_UNSIGNED_CHAR" },
{ MPI_BYTE, "MPI_BYTE" },
{ MPI_WCHAR, "MPI_WCHAR" },
{ MPI_SHORT, "MPI_SHORT" },
{ MPI_UNSIGNED_SHORT, "MPI_UNSIGNED_SHORT" },
{ MPI_INT, "MPI_INT" },
{ MPI_UNSIGNED, "MPI_UNSIGNED" },
{ MPI_LONG, "MPI_LONG" },
{ MPI_UNSIGNED_LONG, "MPI_UNSIGNED_LONG" },
{ MPI_FLOAT, "MPI_FLOAT" },
{ MPI_DOUBLE, "MPI_DOUBLE" },
#if MTEST_HAVE_MIN_MPI_VERSION(2,2)
/* these two types were added in MPI-2.2 */
{ MPI_AINT, "MPI_AINT" },
{ MPI_OFFSET, "MPI_OFFSET" },
#endif
{ MPI_PACKED, "MPI_PACKED" },
{ MPI_LB, "MPI_LB" },
{ MPI_UB, "MPI_UB" },
{ MPI_FLOAT_INT, "MPI_FLOAT_INT" },
{ MPI_DOUBLE_INT, "MPI_DOUBLE_INT" },
{ MPI_LONG_INT, "MPI_LONG_INT" },
{ MPI_SHORT_INT, "MPI_SHORT_INT" },
{ MPI_2INT, "MPI_2INT" },
/* Fortran */
#ifdef HAVE_FORTRAN_BINDING
{ MPI_COMPLEX, "MPI_COMPLEX" },
{ MPI_DOUBLE_COMPLEX, "MPI_DOUBLE_COMPLEX" },
{ MPI_LOGICAL, "MPI_LOGICAL" },
{ MPI_REAL, "MPI_REAL" },
{ MPI_DOUBLE_PRECISION, "MPI_DOUBLE_PRECISION" },
{ MPI_INTEGER, "MPI_INTEGER" },
{ MPI_2INTEGER, "MPI_2INTEGER" },
/* 2COMPLEX (and the 2DOUBLE_COMPLEX) were in MPI 1.0 but not later */
#ifdef HAVE_MPI_2COMPLEX
{ MPI_2COMPLEX, "MPI_2COMPLEX" },
#endif
#ifdef HAVE_MPI_2DOUBLE_COMPLEX
/* MPI_2DOUBLE_COMPLEX is an extension - it is not part of MPI 2.1 */
{ MPI_2DOUBLE_COMPLEX, "MPI_2DOUBLE_COMPLEX" },
#endif
{ MPI_2REAL, "MPI_2REAL" },
{ MPI_2DOUBLE_PRECISION, "MPI_2DOUBLE_PRECISION" },
{ MPI_CHARACTER, "MPI_CHARACTER" },
#endif
#if MTEST_HAVE_MIN_MPI_VERSION(2,2)
/* these C99 types were added in MPI-2.2 */
{ MPI_INT8_T, "MPI_INT8_T" },
{ MPI_INT16_T, "MPI_INT16_T" },
{ MPI_INT32_T, "MPI_INT32_T" },
{ MPI_INT64_T, "MPI_INT64_T" },
{ MPI_UINT8_T, "MPI_UINT8_T" },
{ MPI_UINT16_T, "MPI_UINT16_T" },
{ MPI_UINT32_T, "MPI_UINT32_T" },
{ MPI_UINT64_T, "MPI_UINT64_T" },
{ MPI_C_BOOL, "MPI_C_BOOL" },
{ MPI_C_FLOAT_COMPLEX, "MPI_C_FLOAT_COMPLEX" },
{ MPI_C_DOUBLE_COMPLEX, "MPI_C_DOUBLE_COMPLEX" },
{ MPI_AINT, "MPI_AINT" },
{ MPI_OFFSET, "MPI_OFFSET" },
#endif
/* Size-specific types */
/* Do not move MPI_REAL4 - this is used to indicate the very first
optional type. In addition, you must not add any required types
after this type */
/* See MPI 2.1, Section 16.2. These are required, predefined types.
If the type is not available (e.g., *only* because the Fortran
compiler does not support it), the value may be MPI_DATATYPE_NULL */
{ MPI_REAL4, "MPI_REAL4" },
{ MPI_REAL8, "MPI_REAL8" },
{ MPI_REAL16, "MPI_REAL16" },
{ MPI_COMPLEX8, "MPI_COMPLEX8" },
{ MPI_COMPLEX16, "MPI_COMPLEX16" },
{ MPI_COMPLEX32, "MPI_COMPLEX32" },
{ MPI_INTEGER1, "MPI_INTEGER1" },
{ MPI_INTEGER2, "MPI_INTEGER2" },
{ MPI_INTEGER4, "MPI_INTEGER4" },
{ MPI_INTEGER8, "MPI_INTEGER8" },
#ifdef HAVE_MPI_INTEGER16
/* MPI_INTEGER16 is not included in most of the tables in MPI 2.1,
and some implementations omit it. An error will be reported, but
this ifdef allows the test to be built and run. */
{ MPI_INTEGER16, "MPI_INTEGER16" },
#endif
/* Semi-optional types - if the compiler doesn't support long double
or long long, these might be MPI_DATATYPE_NULL */
{ MPI_LONG_DOUBLE, "MPI_LONG_DOUBLE" },
{ MPI_LONG_LONG_INT, "MPI_LONG_LONG_INT" },
{ MPI_LONG_LONG, "MPI_LONG_LONG" },
{ MPI_UNSIGNED_LONG_LONG, "MPI_UNSIGNED_LONG_LONG" },
{ MPI_LONG_DOUBLE_INT, "MPI_LONG_DOUBLE_INT" },
#if MTEST_HAVE_MIN_MPI_VERSION(2,2)
/* added in MPI-2.2 */
{ MPI_C_LONG_DOUBLE_COMPLEX, "MPI_C_LONG_DOUBLE_COMPLEX" },
{ MPI_AINT, "MPI_AINT" },
{ MPI_OFFSET, "MPI_OFFSET" },
#endif
#if MTEST_HAVE_MIN_MPI_VERSION(3,0)
/* added in MPI 3 */
{ MPI_COUNT, "MPI_COUNT" },
#endif
{ 0, (char *)0 }, /* Sentinal used to indicate the last element */
};
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 );
MPI_Finalize();
return 0;
}
int main(int argc, char *argv[])
{
int err, errs = 0;
int rank, size, orig, target;
int minsize = 2, count;
int i, j;
MPI_Aint origcount, targetcount;
MPI_Comm comm;
MPI_Win win;
MPI_Aint lb, extent;
MPI_Datatype origtype, targettype;
DTP_t orig_dtp, target_dtp;
void *origbuf, *targetbuf;
MTest_Init(&argc, &argv);
#ifndef USE_DTP_POOL_TYPE__STRUCT /* set in 'test/mpi/structtypetest.txt' to split tests */
MPI_Datatype basic_type;
int len;
char type_name[MPI_MAX_OBJECT_NAME] = { 0 };
err = MTestInitBasicSignature(argc, argv, &count, &basic_type);
if (err)
return MTestReturnValue(1);
err = DTP_pool_create(basic_type, count, &orig_dtp);
if (err != DTP_SUCCESS) {
MPI_Type_get_name(basic_type, type_name, &len);
fprintf(stdout, "Error while creating orig pool (%s,%d)\n", type_name, count);
fflush(stdout);
}
err = DTP_pool_create(basic_type, count, &target_dtp);
if (err != DTP_SUCCESS) {
MPI_Type_get_name(basic_type, type_name, &len);
fprintf(stdout, "Error while creating target pool (%s,%d)\n", type_name, count);
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, &orig_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, &target_dtp);
if (err != DTP_SUCCESS) {
fprintf(stdout, "Error while creating struct pool\n");
fflush(stdout);
}
/* this is ignored */
count = 0;
#endif
while (MTestGetIntracommGeneral(&comm, minsize, 1)) {
if (comm == MPI_COMM_NULL)
continue;
MPI_Comm_rank(comm, &rank);
MPI_Comm_size(comm, &size);
orig = 0;
target = size - 1;
for (i = 0; i < target_dtp->DTP_num_objs; i++) {
err = DTP_obj_create(target_dtp, i, 0, 0, 0);
if (err != DTP_SUCCESS) {
errs++;
break;
}
targetcount = target_dtp->DTP_obj_array[i].DTP_obj_count;
targettype = target_dtp->DTP_obj_array[i].DTP_obj_type;
targetbuf = target_dtp->DTP_obj_array[i].DTP_obj_buf;
MPI_Type_get_extent(targettype, &lb, &extent);
MPI_Win_create(targetbuf, lb + targetcount * extent,
(int) extent, MPI_INFO_NULL, comm, &win);
for (j = 0; j < orig_dtp->DTP_num_objs; j++) {
err = DTP_obj_create(orig_dtp, j, 0, 1, count);
if (err != DTP_SUCCESS) {
errs++;
break;
}
origcount = orig_dtp->DTP_obj_array[j].DTP_obj_count;
origtype = orig_dtp->DTP_obj_array[j].DTP_obj_type;
origbuf = orig_dtp->DTP_obj_array[j].DTP_obj_buf;
if (rank == orig) {
MPI_Win_lock(MPI_LOCK_SHARED, target, 0, win);
MPI_Accumulate(origbuf, origcount,
origtype, target, 0, targetcount, targettype, MPI_REPLACE, win);
MPI_Win_unlock(target, win);
MPI_Barrier(comm);
char *resbuf = (char *) calloc(lb + extent * targetcount, sizeof(char));
/*wait for the destination to finish checking and reinitializing the buffer */
MPI_Barrier(comm);
MPI_Win_lock(MPI_LOCK_SHARED, target, 0, win);
MPI_Get_accumulate(origbuf, origcount,
origtype, resbuf, targetcount, targettype,
target, 0, targetcount, targettype, MPI_REPLACE, win);
MPI_Win_unlock(target, win);
MPI_Barrier(comm);
free(resbuf);
} else if (rank == target) {
/* TODO: add a DTP_buf_set() function to replace this */
char *tmp = (char *) calloc(lb + extent * targetcount, sizeof(char));
memcpy(tmp, targetbuf, lb + extent * targetcount);
MPI_Barrier(comm);
MPI_Win_lock(MPI_LOCK_SHARED, target, 0, win);
err = DTP_obj_buf_check(target_dtp, i, 0, 1, count);
if (err != DTP_SUCCESS) {
errs++;
}
/* restore target buffer */
memcpy(targetbuf, tmp, lb + extent * targetcount);
free(tmp);
MPI_Win_unlock(target, win);
/*signal the source that checking and reinitialization is done */
MPI_Barrier(comm);
MPI_Barrier(comm);
MPI_Win_lock(MPI_LOCK_SHARED, target, 0, win);
err = DTP_obj_buf_check(target_dtp, i, 0, 1, count);
if (err != DTP_SUCCESS) {
errs++;
}
MPI_Win_unlock(target, win);
}
DTP_obj_free(orig_dtp, j);
}
MPI_Win_free(&win);
DTP_obj_free(target_dtp, i);
}
MTestFreeComm(&comm);
}
DTP_pool_free(orig_dtp);
DTP_pool_free(target_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);
}
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);
}
