/* Free the storage associated with a window object */
void MTestFreeWin(MPI_Win * win)
{
void *addr;
int flag, merr;
merr = MPI_Win_get_attr(*win, MPI_WIN_BASE, &addr, &flag);
if (merr)
MTestPrintError(merr);
if (!flag) {
MTestError("Could not get WIN_BASE from window");
}
if (addr) {
void *val;
merr = MPI_Win_get_attr(*win, mem_keyval, &val, &flag);
if (merr)
MTestPrintError(merr);
if (flag) {
if (val == (void *) 1) {
free(addr);
}
else if (val == (void *) 2) {
merr = MPI_Free_mem(addr);
if (merr)
MTestPrintError(merr);
}
/* if val == (void *)0, then static data that must not be freed */
}
}
merr = MPI_Win_free(win);
if (merr)
MTestPrintError(merr);
}
/*
Finalize MTest. errs is the number of errors on the calling process;
this routine will write the total number of errors over all of MPI_COMM_WORLD
to the process with rank zero, or " No Errors".
It does *not* finalize MPI.
*/
void MTest_Finalize(int errs)
{
int rank, toterrs, merr;
merr = MPI_Comm_rank(MPI_COMM_WORLD, &rank);
if (merr)
MTestPrintError(merr);
merr = MPI_Reduce(&errs, &toterrs, 1, MPI_INT, MPI_SUM, 0, MPI_COMM_WORLD);
if (merr)
MTestPrintError(merr);
if (rank == 0) {
if (toterrs) {
printf(" Found %d errors\n", toterrs);
}
else {
printf(" No Errors\n");
}
fflush(stdout);
}
if (usageOutput)
MTestResourceSummary(stdout);
/* Clean up any persistent objects that we allocated */
MTestRMACleanup();
}
/*
* Setup contiguous type info and handlers.
*
* A contiguous datatype is created by using following parameters (stride is unused).
* nblock: Number of blocks.
* blocklen: Number of elements in each block. The total number of elements in
* this datatype is set as (nblock * blocklen).
* lb: Lower bound of the new datatype (ignored).
* oldtype: Datatype of element.
*/
static int MTestTypeContiguousCreate(MPI_Aint nblock, MPI_Aint blocklen, MPI_Aint stride,
MPI_Aint lb, MPI_Datatype oldtype, const char *typename_prefix,
MTestDatatype * mtype)
{
int merr = 0;
char type_name[128];
MTestTypeReset(mtype);
merr = MPI_Type_size(oldtype, &mtype->basesize);
if (merr)
MTestPrintError(merr);
mtype->nblock = nblock;
mtype->blksize = blocklen * mtype->basesize;
merr = MPI_Type_contiguous(nblock * blocklen, oldtype, &mtype->datatype);
if (merr)
MTestPrintError(merr);
merr = MPI_Type_commit(&mtype->datatype);
if (merr)
MTestPrintError(merr);
memset(type_name, 0, sizeof(type_name));
sprintf(type_name, "%s %s (%ld count)", typename_prefix, "contiguous", nblock * blocklen);
merr = MPI_Type_set_name(mtype->datatype, (char *) type_name);
if (merr)
MTestPrintError(merr);
mtype->InitBuf = MTestTypeContigInit;
mtype->FreeBuf = MTestTypeFree;
mtype->CheckBuf = MTestTypeContigCheckbuf;
return merr;
}
/*
* Setup struct type info and handlers.
*
* A struct datatype is created by using following parameters.
* nblock: Number of blocks.
* blocklen: Number of elements in each block. Each block has the same length.
* stride: Strided number of elements between two adjacent blocks. The byte
* displacement of each block is set as (index of current block * stride * size of oldtype).
* lb: Lower bound of the new datatype.
* oldtype: Datatype of element. Each block has the same oldtype.
*/
static int MTestTypeStructCreate(MPI_Aint nblock, MPI_Aint blocklen, MPI_Aint stride, MPI_Aint lb,
MPI_Datatype oldtype, const char *typename_prefix,
MTestDatatype * mtype)
{
int merr;
char type_name[128];
int i;
MTestTypeReset(mtype);
merr = MPI_Type_size(oldtype, &mtype->basesize);
if (merr)
MTestPrintError(merr);
mtype->old_datatypes = (MPI_Datatype *) malloc(nblock * sizeof(MPI_Datatype));
mtype->displ_in_bytes = (MPI_Aint *) malloc(nblock * sizeof(MPI_Aint));
mtype->index = (int *) malloc(nblock * sizeof(int));
if (!mtype->displ_in_bytes || !mtype->old_datatypes) {
char errmsg[128] = { 0 };
sprintf(errmsg, "Out of memory in %s", __FUNCTION__);
MTestError(errmsg);
}
mtype->nblock = nblock;
mtype->blksize = blocklen * mtype->basesize;
for (i = 0; i < nblock; i++) {
mtype->displ_in_bytes[i] = (lb + stride * i) * mtype->basesize;
mtype->old_datatypes[i] = oldtype;
mtype->index[i] = blocklen;
}
/* Struct uses displacement in bytes */
merr = MPI_Type_create_struct(nblock, mtype->index, mtype->displ_in_bytes,
mtype->old_datatypes, &mtype->datatype);
if (merr)
MTestPrintError(merr);
merr = MPI_Type_commit(&mtype->datatype);
if (merr)
MTestPrintError(merr);
memset(type_name, 0, sizeof(type_name));
sprintf(type_name, "%s %s (%ld nblock %ld blocklen %ld stride %ld lb)", typename_prefix,
"struct", nblock, blocklen, stride, lb);
merr = MPI_Type_set_name(mtype->datatype, (char *) type_name);
if (merr)
MTestPrintError(merr);
/* Reuse indexed functions, because they use the same displ_in_bytes and index */
mtype->InitBuf = MTestTypeIndexedInit;
mtype->FreeBuf = MTestTypeFree;
mtype->CheckBuf = MTestTypeIndexedCheckbuf;
return merr;
}
/*
* Setup indexed-block type info and handlers.
*
* A indexed-block datatype is created by using following parameters.
* nblock: Number of blocks.
* blocklen: Number of elements in each block.
* stride: Strided number of elements between two adjacent blocks. The
* displacement of each block is set as (index of current block * stride).
* lb: Lower bound of the new datatype.
* oldtype: Datatype of element.
*/
static int MTestTypeIndexedBlockCreate(MPI_Aint nblock, MPI_Aint blocklen, MPI_Aint stride,
MPI_Aint lb, MPI_Datatype oldtype,
const char *typename_prefix, MTestDatatype * mtype)
{
int merr;
char type_name[128];
int i;
MTestTypeReset(mtype);
merr = MPI_Type_size(oldtype, &mtype->basesize);
if (merr)
MTestPrintError(merr);
mtype->displs = (int *) malloc(nblock * sizeof(int));
mtype->displ_in_bytes = (MPI_Aint *) malloc(nblock * sizeof(MPI_Aint));
if (!mtype->displs || !mtype->displ_in_bytes) {
char errmsg[128] = { 0 };
sprintf(errmsg, "Out of memory in %s", __FUNCTION__);
MTestError(errmsg);
}
mtype->nblock = nblock;
mtype->blksize = blocklen * mtype->basesize;
for (i = 0; i < nblock; i++) {
mtype->displs[i] = lb + stride * i;
mtype->displ_in_bytes[i] = (lb + stride * i) * mtype->basesize;
}
/* Indexed-block uses displacement in oldtypes */
merr = MPI_Type_create_indexed_block(nblock, blocklen, mtype->displs,
oldtype, &mtype->datatype);
if (merr)
MTestPrintError(merr);
merr = MPI_Type_commit(&mtype->datatype);
if (merr)
MTestPrintError(merr);
memset(type_name, 0, sizeof(type_name));
sprintf(type_name, "%s %s (%ld nblock %ld blocklen %ld stride %ld lb)", typename_prefix,
"index_block", nblock, blocklen, stride, lb);
merr = MPI_Type_set_name(mtype->datatype, (char *) type_name);
if (merr)
MTestPrintError(merr);
mtype->InitBuf = MTestTypeIndexedBlockInit;
mtype->FreeBuf = MTestTypeFree;
mtype->CheckBuf = MTestTypeIndexedBlockCheckbuf;
return merr;
}
/*
* Setup order-Fortran subarray type info and handlers.
*
* A 2D-subarray datatype specified with order Fortran and located in the right
* bottom of the full array is created by using input parameters.
* Number of elements in the dimensions of the full array: {stride, nblock + lb}
* Number of elements in the dimensions of the subarray: {blocklen, nblock}
* Starting of the subarray in each dimension: {stride - blocklen, lb}
* order: MPI_ORDER_FORTRAN
* oldtype: oldtype
*/
static int MTestTypeSubArrayOrderFortranCreate(MPI_Aint nblock, MPI_Aint blocklen, MPI_Aint stride,
MPI_Aint lb, MPI_Datatype oldtype,
const char *typename_prefix, MTestDatatype * mtype)
{
int merr;
char type_name[128];
MTestTypeReset(mtype);
merr = MPI_Type_size(oldtype, &mtype->basesize);
if (merr)
MTestPrintError(merr);
/* use the same row and col as that of order-c subarray for buffer
* initialization and check because we access buffer in order-c */
mtype->arr_sizes[0] = nblock + lb; /* {row, col} */
mtype->arr_sizes[1] = stride;
mtype->arr_subsizes[0] = nblock; /* {row, col} */
mtype->arr_subsizes[1] = blocklen;
mtype->arr_starts[0] = lb; /* {row, col} */
mtype->arr_starts[1] = stride - blocklen;
mtype->order = MPI_ORDER_FORTRAN;
/* reverse row and col when create datatype so that we can get the same
* packed data on the other side in order to reuse the contig check function */
int arr_sizes[2] = { mtype->arr_sizes[1], mtype->arr_sizes[0] };
int arr_subsizes[2] = { mtype->arr_subsizes[1], mtype->arr_subsizes[0] };
int arr_starts[2] = { mtype->arr_starts[1], mtype->arr_starts[0] };
merr = MPI_Type_create_subarray(2, arr_sizes, arr_subsizes, arr_starts,
mtype->order, oldtype, &mtype->datatype);
if (merr)
MTestPrintError(merr);
merr = MPI_Type_commit(&mtype->datatype);
if (merr)
MTestPrintError(merr);
memset(type_name, 0, sizeof(type_name));
sprintf(type_name, "%s %s (full{%d,%d}, sub{%d,%d},start{%d,%d})",
typename_prefix, "subarray-f", arr_sizes[0], arr_sizes[1],
arr_subsizes[0], arr_subsizes[1], arr_starts[0], arr_starts[1]);
merr = MPI_Type_set_name(mtype->datatype, (char *) type_name);
if (merr)
MTestPrintError(merr);
mtype->InitBuf = MTestTypeSubarrayInit;
mtype->FreeBuf = MTestTypeFree;
mtype->CheckBuf = MTestTypeSubarrayCheckbuf;
return merr;
}
/*
* Setup contiguous buffers of n copies of a datatype. Initialize for
* reception (e.g., set initial data to detect failure)
*/
static void *MTestTypeContigInitRecv( MTestDatatype *mtype )
{
MPI_Aint size;
int merr;
if (mtype->count > 0) {
signed char *p;
int i, totsize;
merr = MPI_Type_extent( mtype->datatype, &size );
if (merr) MTestPrintError( merr );
totsize = size * mtype->count;
if (!mtype->buf) {
mtype->buf = (void *) malloc( totsize );
}
p = (signed char *)(mtype->buf);
if (!p) {
/* Error - out of memory */
MTestError( "Out of memory in type buffer init" );
}
for (i=0; i<totsize; i++) {
p[i] = 0xff;
}
}
else {
if (mtype->buf) {
free( mtype->buf );
}
mtype->buf = 0;
}
return mtype->buf;
}
static int MTestTypeContigCheckbuf( MTestDatatype *mtype )
{
unsigned char *p;
unsigned char expected;
int i, totsize, err = 0, merr;
MPI_Aint size;
p = (unsigned char *)mtype->buf;
if (p) {
merr = MPI_Type_extent( mtype->datatype, &size );
if (merr) MTestPrintError( merr );
totsize = size * mtype->count;
for (i=0; i<totsize; i++) {
expected = (0xff ^ (i & 0xff));
if (p[i] != expected) {
err++;
if (mtype->printErrors && err < 10) {
printf( "Data expected = %x but got p[%d] = %x\n",
expected, i, p[i] );
fflush( stdout );
}
}
}
}
return err;
}
/*
* Setup indexed buffers for 1 copy of a datatype. Initialize for
* reception (e.g., set initial data to detect failure)
*/
static void *MTestTypeIndexedInitRecv( MTestDatatype *mtype )
{
MPI_Aint totsize;
int merr;
if (mtype->count > 1) {
MTestError( "This datatype is supported only for a single count" );
}
if (mtype->count == 1) {
signed char *p;
int i;
merr = MPI_Type_extent( mtype->datatype, &totsize );
if (merr) MTestPrintError( merr );
if (!mtype->buf) {
mtype->buf = (void *) malloc( totsize );
}
p = (signed char *)(mtype->buf);
if (!p) {
/* Error - out of memory */
MTestError( "Out of memory in type buffer init\n" );
}
for (i=0; i<totsize; i++) {
p[i] = 0xff;
}
}
else {
/* count == 0 */
if (mtype->buf) {
free( mtype->buf );
}
mtype->buf = 0;
}
return mtype->buf;
}
int main(int argc, char *argv[])
{
int errs = 0, err;
int j, count;
char *ap;
MTest_Init(&argc, &argv);
MPI_Errhandler_set(MPI_COMM_WORLD, MPI_ERRORS_RETURN);
for (count = 1; count < 128000; count *= 2) {
err = MPI_Alloc_mem(count, MPI_INFO_NULL, &ap);
if (err) {
int errclass;
/* An error of MPI_ERR_NO_MEM is allowed */
MPI_Error_class(err, &errclass);
if (errclass != MPI_ERR_NO_MEM) {
errs++;
MTestPrintError(err);
}
} else {
/* Access all of this memory */
for (j = 0; j < count; j++) {
ap[j] = (char) (j & 0x7f);
}
MPI_Free_mem(ap);
}
}
MTest_Finalize(errs);
return MTestReturnValue(errs);
}
/*
* Initialize buffer of basic datatype
*/
static void *MTestTypeContigInit(MTestDatatype * mtype)
{
MPI_Aint extent = 0, lb = 0, size;
int merr;
if (mtype->count > 0) {
unsigned char *p;
MPI_Aint i, totsize;
merr = MPI_Type_get_extent(mtype->datatype, &lb, &extent);
if (merr)
MTestPrintError(merr);
size = extent + lb;
totsize = size * mtype->count;
if (!mtype->buf) {
mtype->buf = (void *) malloc(totsize);
}
p = (unsigned char *) (mtype->buf);
if (!p) {
char errmsg[128] = { 0 };
sprintf(errmsg, "Out of memory in %s", __FUNCTION__);
MTestError(errmsg);
}
for (i = 0; i < totsize; i++) {
p[i] = (unsigned char) (0xff ^ (i & 0xff));
}
}
else {
if (mtype->buf) {
free(mtype->buf);
}
mtype->buf = 0;
}
return mtype->buf;
}
int CheckMPIErr(int err)
{
int rc = 0;
if (err != MPI_SUCCESS) {
MTestPrintError(err);
rc = 1;
}
return rc;
}
/* Free a communicator. It may be called with a predefined communicator
or MPI_COMM_NULL */
void MTestFreeComm(MPI_Comm * comm)
{
int merr;
if (*comm != MPI_COMM_WORLD && *comm != MPI_COMM_SELF && *comm != MPI_COMM_NULL) {
merr = MPI_Comm_free(comm);
if (merr)
MTestPrintError(merr);
}
}
/*
* Initialize buffer of indexed-block datatype
*/
static void *MTestTypeIndexedBlockInit(MTestDatatype * mtype)
{
MPI_Aint extent = 0, lb = 0, size, totsize, offset, dt_offset;
int merr;
if (mtype->count > 0) {
unsigned char *p;
MPI_Aint k, j;
int i, nc;
/* Allocate the send/recv buffer */
merr = MPI_Type_get_extent(mtype->datatype, &lb, &extent);
if (merr)
MTestPrintError(merr);
size = extent + lb;
totsize = size * mtype->count;
if (!mtype->buf) {
mtype->buf = (void *) malloc(totsize);
}
p = (unsigned char *) (mtype->buf);
if (!p) {
char errmsg[128] = { 0 };
sprintf(errmsg, "Out of memory in %s", __FUNCTION__);
MTestError(errmsg);
}
/* First, set to -1 */
for (k = 0; k < totsize; k++)
p[k] = 0xff;
/* Now, set the actual elements to the successive values.
* We require that the base type is a contiguous type */
nc = 0;
dt_offset = 0;
/* For each datatype */
for (k = 0; k < mtype->count; k++) {
/* For each block */
for (i = 0; i < mtype->nblock; i++) {
offset = dt_offset + mtype->displ_in_bytes[i];
/* For each byte in the block */
for (j = 0; j < mtype->blksize; j++) {
p[offset + j] = (unsigned char) (0xff ^ (nc++ & 0xff));
}
}
dt_offset += size;
}
}
else {
/* count == 0 */
if (mtype->buf) {
free(mtype->buf);
}
mtype->buf = 0;
}
return mtype->buf;
}
/*
* Setup order-C subarray type info and handlers.
*
* A 2D-subarray datatype specified with order C and located in the right-bottom
* of the full array is created by using input parameters.
* Number of elements in the dimensions of the full array: {nblock + lb, stride}
* Number of elements in the dimensions of the subarray: {nblock, blocklen}
* Starting of the subarray in each dimension: {1, stride - blocklen}
* order: MPI_ORDER_C
* oldtype: oldtype
*/
static int MTestTypeSubArrayOrderCCreate(MPI_Aint nblock, MPI_Aint blocklen, MPI_Aint stride,
MPI_Aint lb, MPI_Datatype oldtype,
const char *typename_prefix, MTestDatatype * mtype)
{
int merr;
char type_name[128];
MTestTypeReset(mtype);
merr = MPI_Type_size(oldtype, &mtype->basesize);
if (merr)
MTestPrintError(merr);
mtype->arr_sizes[0] = nblock + lb; /* {row, col} */
mtype->arr_sizes[1] = stride;
mtype->arr_subsizes[0] = nblock; /* {row, col} */
mtype->arr_subsizes[1] = blocklen;
mtype->arr_starts[0] = lb; /* {row, col} */
mtype->arr_starts[1] = stride - blocklen;
mtype->order = MPI_ORDER_C;
merr = MPI_Type_create_subarray(2, mtype->arr_sizes, mtype->arr_subsizes, mtype->arr_starts,
mtype->order, oldtype, &mtype->datatype);
if (merr)
MTestPrintError(merr);
merr = MPI_Type_commit(&mtype->datatype);
if (merr)
MTestPrintError(merr);
memset(type_name, 0, sizeof(type_name));
sprintf(type_name, "%s %s (full{%d,%d}, sub{%d,%d},start{%d,%d})",
typename_prefix, "subarray-c", mtype->arr_sizes[0], mtype->arr_sizes[1],
mtype->arr_subsizes[0], mtype->arr_subsizes[1], mtype->arr_starts[0],
mtype->arr_starts[1]);
merr = MPI_Type_set_name(mtype->datatype, (char *) type_name);
if (merr)
MTestPrintError(merr);
mtype->InitBuf = MTestTypeSubarrayInit;
mtype->FreeBuf = MTestTypeFree;
mtype->CheckBuf = MTestTypeSubarrayCheckbuf;
return merr;
}
/*
* Check value of received subarray datatype buffer
*/
static int MTestTypeSubarrayCheckbuf(MTestDatatype * mtype)
{
unsigned char *p;
unsigned char expected;
int err = 0, merr;
MPI_Aint size, offset, dt_offset, byte_offset, lb = 0, extent = 0;
p = (unsigned char *) mtype->buf;
if (p) {
MPI_Aint k;
int j, b, i, nc;
merr = MPI_Type_get_extent(mtype->datatype, &lb, &extent);
if (merr)
MTestPrintError(merr);
size = lb + extent;
int ncol, sub_ncol, sub_nrow, sub_col_start, sub_row_start;
ncol = mtype->arr_sizes[1];
sub_nrow = mtype->arr_subsizes[0];
sub_ncol = mtype->arr_subsizes[1];
sub_row_start = mtype->arr_starts[0];
sub_col_start = mtype->arr_starts[1];
nc = 0;
dt_offset = 0;
/* For each datatype */
for (k = 0; k < mtype->count; k++) {
/* For each row */
for (i = 0; i < sub_nrow; i++) {
offset = (sub_row_start + i) * ncol + sub_col_start;
/* For each element in row */
for (j = 0; j < sub_ncol; j++) {
byte_offset = dt_offset + (offset + j) * mtype->basesize;
/* For each byte in element */
for (b = 0; b < mtype->basesize; b++) {
expected = (unsigned char) (0xff ^ (nc++ & 0xff));
if (p[byte_offset + b] != expected) {
err++;
if (mtype->printErrors && err < 10) {
printf("Data expected = %x but got p[%d,%d,%d] = %x\n",
expected, i, j, b, p[byte_offset + b]);
fflush(stdout);
}
}
}
}
}
dt_offset += size;
}
}
if (err)
printf("%s error\n", __FUNCTION__);
return err;
}
/* 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++];
}
/*
* Initialize buffer of vector datatype
*/
static void *MTestTypeVectorInit(MTestDatatype * mtype)
{
MPI_Aint extent = 0, lb = 0, size, totsize, dt_offset, byte_offset;
int merr;
if (mtype->count > 0) {
unsigned char *p;
MPI_Aint k, j;
int i, nc;
merr = MPI_Type_get_extent(mtype->datatype, &lb, &extent);
if (merr)
MTestPrintError(merr);
size = extent + lb;
totsize = mtype->count * size;
if (!mtype->buf) {
mtype->buf = (void *) malloc(totsize);
}
p = (unsigned char *) (mtype->buf);
if (!p) {
char errmsg[128] = { 0 };
sprintf(errmsg, "Out of memory in %s", __FUNCTION__);
MTestError(errmsg);
}
/* First, set to -1 */
for (k = 0; k < totsize; k++)
p[k] = 0xff;
/* Now, set the actual elements to the successive values.
* We require that the base type is a contiguous type */
nc = 0;
dt_offset = 0;
/* For each datatype */
for (k = 0; k < mtype->count; k++) {
/* For each block */
for (i = 0; i < mtype->nblock; i++) {
byte_offset = dt_offset + i * mtype->stride;
/* For each byte */
for (j = 0; j < mtype->blksize; j++) {
p[byte_offset + j] = (unsigned char) (0xff ^ (nc & 0xff));
nc++;
}
}
dt_offset += size;
}
}
else {
mtype->buf = 0;
}
return mtype->buf;
}
/*
* Setup hvector type info and handlers.
*
* A hvector datatype is created by using following parameters.
* nblock: Number of blocks.
* blocklen: Number of elements in each block.
* stride: Strided number of elements between blocks.
* lb: Lower bound of the new datatype (ignored).
* oldtype: Datatype of element.
*/
static int MTestTypeHvectorCreate(MPI_Aint nblock, MPI_Aint blocklen, MPI_Aint stride, MPI_Aint lb,
MPI_Datatype oldtype, const char *typename_prefix,
MTestDatatype * mtype)
{
int merr;
char type_name[128];
MTestTypeReset(mtype);
merr = MPI_Type_size(oldtype, &mtype->basesize);
if (merr)
MTestPrintError(merr);
/* These sizes are in bytes (see the VectorInit code) */
mtype->stride = stride * mtype->basesize;
mtype->blksize = blocklen * mtype->basesize;
mtype->nblock = nblock;
/* Hvector uses stride in bytes */
merr = MPI_Type_create_hvector(nblock, blocklen, mtype->stride, oldtype, &mtype->datatype);
if (merr)
MTestPrintError(merr);
merr = MPI_Type_commit(&mtype->datatype);
if (merr)
MTestPrintError(merr);
memset(type_name, 0, sizeof(type_name));
sprintf(type_name, "%s %s (%ld nblock %ld blocklen %ld stride)", typename_prefix, "hvector",
nblock, blocklen, stride);
merr = MPI_Type_set_name(mtype->datatype, (char *) type_name);
if (merr)
MTestPrintError(merr);
/* User the same functions as vector, because mtype->stride is in bytes */
mtype->InitBuf = MTestTypeVectorInit;
mtype->FreeBuf = MTestTypeFree;
mtype->CheckBuf = MTestTypeVectorCheckbuf;
return merr;
}
/*
* Setup a buffer for one copy of an indexed datatype.
*/
static void *MTestTypeIndexedInit( MTestDatatype *mtype )
{
MPI_Aint totsize;
int merr;
if (mtype->count > 1) {
MTestError( "This datatype is supported only for a single count" );
}
if (mtype->count == 1) {
signed char *p;
int i, k, offset, j;
/* Allocate the send/recv buffer */
merr = MPI_Type_extent( mtype->datatype, &totsize );
if (merr) MTestPrintError( merr );
if (!mtype->buf) {
mtype->buf = (void *) malloc( totsize );
}
p = (signed char *)(mtype->buf);
if (!p) {
MTestError( "Out of memory in type buffer init\n" );
}
/* Initialize the elements */
/* First, set to -1 */
for (i=0; i<totsize; i++) p[i] = 0xff;
/* Now, set the actual elements to the successive values.
We require that the base type is a contiguous type */
k = 0;
for (i=0; i<mtype->nelm; i++) {
int b;
/* Compute the offset: */
offset = mtype->displs[i] * mtype->basesize;
/* For each element in the block */
for (b=0; b<mtype->index[i]; b++) {
for (j=0; j<mtype->basesize; j++) {
p[offset+j] = 0xff ^ (k++ & 0xff);
}
offset += mtype->basesize;
}
}
}
else {
/* count == 0 */
if (mtype->buf) {
free( mtype->buf );
}
mtype->buf = 0;
}
return mtype->buf;
}
/* Free the storage associated with a datatype */
void MTestFreeDatatype( MTestDatatype *mtype )
{
int merr;
/* Invoke a datatype-specific free function to handle
both the datatype and the send/receive buffers */
if (mtype->FreeBuf) {
(mtype->FreeBuf)( mtype );
}
/* Free the datatype itself if it was created */
if (!mtype->isBasic) {
merr = MPI_Type_free( &mtype->datatype );
if (merr) MTestPrintError( merr );
}
}
/*
* Setup dup type info and handlers.
*
* A dup datatype is created by using following parameters.
* oldtype: Datatype of element.
*/
int MTestTypeDupCreate(MPI_Datatype oldtype, MTestDatatype * mtype)
{
int merr = 0;
MTestTypeReset(mtype);
merr = MPI_Type_size(oldtype, &mtype->basesize);
if (merr)
MTestPrintError(merr);
merr = MPI_Type_dup(oldtype, &mtype->datatype);
if (merr)
MTestPrintError(merr);
/* dup'ed types are already committed if the original type
* was committed (MPI-2, section 8.8) */
mtype->InitBuf = MTestTypeContigInit;
mtype->FreeBuf = MTestTypeFree;
mtype->CheckBuf = MTestTypeContigCheckbuf;
return merr;
}
static void *MTestTypeVectorInit( MTestDatatype *mtype )
{
MPI_Aint size;
int merr;
if (mtype->count > 0) {
unsigned char *p;
int i, j, k, nc, totsize;
merr = MPI_Type_extent( mtype->datatype, &size );
if (merr) MTestPrintError( merr );
totsize = mtype->count * size;
if (!mtype->buf) {
mtype->buf = (void *) malloc( totsize );
}
p = (unsigned char *)(mtype->buf);
if (!p) {
/* Error - out of memory */
MTestError( "Out of memory in type buffer init" );
}
/* First, set to -1 */
for (i=0; i<totsize; i++) p[i] = 0xff;
/* Now, set the actual elements to the successive values.
To do this, we need to run 3 loops */
nc = 0;
/* count is usually one for a vector type */
for (k=0; k<mtype->count; k++) {
/* For each element (block) */
for (i=0; i<mtype->nelm; i++) {
/* For each value */
for (j=0; j<mtype->blksize; j++) {
p[j] = (0xff ^ (nc & 0xff));
nc++;
}
p += mtype->stride;
}
}
}
else {
mtype->buf = 0;
}
return mtype->buf;
}
/*
* Check value of received indexed datatype buffer
*/
static int MTestTypeIndexedCheckbuf(MTestDatatype * mtype)
{
unsigned char *p;
unsigned char expected;
int err = 0, merr;
MPI_Aint size = 0, offset, dt_offset, extent = 0, lb = 0;
p = (unsigned char *) mtype->buf;
if (p) {
MPI_Aint k, b;
int i, j, nc;
merr = MPI_Type_get_extent(mtype->datatype, &lb, &extent);
if (merr)
MTestPrintError(merr);
size = lb + extent;
nc = 0;
dt_offset = 0;
/* For each datatype */
for (k = 0; k < mtype->count; k++) {
/* For each block */
for (i = 0; i < mtype->nblock; i++) {
/* For each element in the block */
for (j = 0; j < mtype->index[i]; j++) {
offset = dt_offset + mtype->displ_in_bytes[i]
+ j * mtype->basesize;
/* For each byte in the element */
for (b = 0; b < mtype->basesize; b++) {
expected = (unsigned char) (0xff ^ (nc++ & 0xff));
if (p[offset + b] != expected) {
err++;
if (mtype->printErrors && err < 10) {
printf("Data expected = %x but got p[%d,%d] = %x\n",
expected, i, j, p[offset + b]);
fflush(stdout);
}
}
}
}
}
dt_offset += size;
}
}
return err;
}
/*
* Setup basic type info and handlers.
*/
int MTestTypeBasicCreate(MPI_Datatype oldtype, MTestDatatype * mtype)
{
int merr = 0;
MTestTypeReset(mtype);
merr = MPI_Type_size(oldtype, &mtype->basesize);
if (merr)
MTestPrintError(merr);
mtype->datatype = oldtype;
mtype->isBasic = 1;
mtype->InitBuf = MTestTypeContigInit;
mtype->FreeBuf = MTestTypeFree;
mtype->CheckBuf = MTestTypeContigCheckbuf;
return merr;
}
/*
* Check value of received vector datatype buffer
*/
static int MTestTypeVectorCheckbuf(MTestDatatype * mtype)
{
unsigned char *p;
unsigned char expected;
int i, err = 0, merr;
MPI_Aint size = 0, byte_offset, dt_offset, extent, lb;
p = (unsigned char *) mtype->buf;
if (p) {
MPI_Aint k, j;
int nc;
merr = MPI_Type_get_extent(mtype->datatype, &lb, &extent);
if (merr)
MTestPrintError(merr);
size = extent + lb;
nc = 0;
dt_offset = 0;
/* For each datatype */
for (k = 0; k < mtype->count; k++) {
/* For each block */
for (i = 0; i < mtype->nblock; i++) {
byte_offset = dt_offset + i * mtype->stride;
/* For each byte */
for (j = 0; j < mtype->blksize; j++) {
expected = (unsigned char) (0xff ^ (nc & 0xff));
if (p[byte_offset + j] != expected) {
err++;
if (mtype->printErrors && err < 10) {
printf("Data expected = %x but got p[%d,%ld] = %x\n", expected, i, j,
p[byte_offset + j]);
fflush(stdout);
}
}
nc++;
}
}
dt_offset += size;
}
}
return err;
}
/* Check that a message was received correctly. Returns the number of
errors detected. Status may be NULL or MPI_STATUS_IGNORE */
int MTestCheckRecv( MPI_Status *status, MTestDatatype *recvtype )
{
int count;
int errs = 0, merr;
if (status && status != MPI_STATUS_IGNORE) {
merr = MPI_Get_count( status, recvtype->datatype, &count );
if (merr) MTestPrintError( merr );
/* Check count against expected count */
if (count != recvtype->count) {
errs ++;
}
}
/* Check received data */
if (!errs && recvtype->CheckBuf( recvtype )) {
errs++;
}
return errs;
}
static int MTestTypeIndexedCheckbuf( MTestDatatype *mtype )
{
unsigned char *p;
unsigned char expected;
int i, err = 0, merr;
MPI_Aint totsize;
p = (unsigned char *)mtype->buf;
if (p) {
int j, k, offset;
merr = MPI_Type_extent( mtype->datatype, &totsize );
if (merr) MTestPrintError( merr );
k = 0;
for (i=0; i<mtype->nelm; i++) {
int b;
/* Compute the offset: */
offset = mtype->displs[i] * mtype->basesize;
for (b=0; b<mtype->index[i]; b++) {
for (j=0; j<mtype->basesize; j++) {
expected = (0xff ^ (k & 0xff));
if (p[offset+j] != expected) {
err++;
if (mtype->printErrors && err < 10) {
printf( "Data expected = %x but got p[%d,%d] = %x\n",
expected, i,j, p[offset+j] );
fflush( stdout );
}
}
k++;
}
offset += mtype->basesize;
}
}
}
return err;
}
int main( int argc, char *argv[] )
{
int errs = 0, err;
int rank, size, root;
int minsize = 2, count;
MPI_Comm comm;
MTestDatatype sendtype, recvtype;
MTest_Init( &argc, &argv );
/* The following illustrates the use of the routines to
run through a selection of communicators and datatypes.
Use subsets of these for tests that do not involve combinations
of communicators, datatypes, and counts of datatypes */
while (MTestGetIntracommGeneral( &comm, minsize, 1 )) {
if (comm == MPI_COMM_NULL) continue;
/* Determine the sender and receiver */
MPI_Comm_rank( comm, &rank );
MPI_Comm_size( comm, &size );
/* To improve reporting of problems about operations, we
change the error handler to errors return */
MPI_Errhandler_set( comm, MPI_ERRORS_RETURN );
/* The max value of count must be very large to ensure that we
reach the long message algorithms */
for (count = 1; count < 2800; count = count * 4) {
while (MTestGetDatatypes( &sendtype, &recvtype, count )) {
for (root=0; root<size; root++) {
if (rank == root) {
sendtype.InitBuf( &sendtype );
err = MPI_Bcast( sendtype.buf, sendtype.count,
sendtype.datatype, root, comm );
if (err) {
errs++;
MTestPrintError( err );
}
}
else {
recvtype.InitBuf( &recvtype );
err = MPI_Bcast( recvtype.buf, recvtype.count,
recvtype.datatype, root, comm );
if (err) {
errs++;
fprintf( stderr, "Error with communicator %s and datatype %s\n",
MTestGetIntracommName(),
MTestGetDatatypeName( &recvtype ) );
MTestPrintError( err );
}
err = MTestCheckRecv( 0, &recvtype );
if (err) {
errs += errs;
}
}
}
MTestFreeDatatype( &recvtype );
MTestFreeDatatype( &sendtype );
}
}
MTestFreeComm( &comm );
}
MTest_Finalize( errs );
MPI_Finalize();
return 0;
}
int main( int argc, char *argv[] )
{
int errs = 0, err;
int *sendbuf = 0, *recvbuf = 0;
int leftGroup, i, j, idx, count, rrank, rsize;
MPI_Comm comm;
MPI_Datatype datatype;
MTest_Init( &argc, &argv );
datatype = MPI_INT;
while (MTestGetIntercomm( &comm, &leftGroup, 4 )) {
if (comm == MPI_COMM_NULL) continue;
for (count = 1; count < 66000; count = 2 * count) {
/* Get an intercommunicator */
MPI_Comm_remote_size( comm, &rsize );
MPI_Comm_rank( comm, &rrank );
sendbuf = (int *)malloc( rsize * count * sizeof(int) );
recvbuf = (int *)malloc( rsize * count * sizeof(int) );
for (i=0; i<rsize*count; i++) recvbuf[i] = -1;
if (leftGroup) {
idx = 0;
for (j=0; j<rsize; j++) {
for (i=0; i<count; i++) {
sendbuf[idx++] = i + rrank;
}
}
err = MPI_Alltoall( sendbuf, count, datatype,
NULL, 0, datatype, comm );
if (err) {
errs++;
MTestPrintError( err );
}
}
else {
int rank, size;
MPI_Comm_rank( comm, &rank );
MPI_Comm_size( comm, &size );
/* In the right group */
err = MPI_Alltoall( NULL, 0, datatype,
recvbuf, count, datatype, comm );
if (err) {
errs++;
MTestPrintError( err );
}
/* Check that we have received the correct data */
idx = 0;
for (j=0; j<rsize; j++) {
for (i=0; i<count; i++) {
if (recvbuf[idx++] != i + j) {
errs++;
if (errs < 10)
fprintf( stderr, "buf[%d] = %d on %d\n",
i, recvbuf[i], rank );
}
}
}
}
free( recvbuf );
free( sendbuf );
}
MTestFreeComm( &comm );
}
MTest_Finalize( errs );
MPI_Finalize();
return 0;
}
