void cfreekeys_(void)
{
MPI_Keyval_free( &ccomm1Key );
MPI_Comm_free_keyval( &ccomm2Key );
MPI_Type_free_keyval( &ctype2Key );
MPI_Win_free_keyval( &cwin2Key );
}
int main(int argc, char *argv[]) {
int errs = 0;
int key[3], attrval[3];
int i;
MPI_Comm comm;
MPI_Init(&argc, &argv);
comm = MPI_COMM_WORLD;
/* Create key values */
for (i=0; i<3; i++) {
MPI_Comm_create_keyval(MPI_NULL_COPY_FN, MPI_NULL_DELETE_FN,
&key[i], (void*)0);
attrval[i] = 1024*i;
}
/* Insert attribute in several orders. Test after put with get. */
MPI_Comm_set_attr(comm, key[2], &attrval[2]);
MPI_Comm_set_attr(comm, key[1], &attrval[1]);
MPI_Comm_set_attr(comm, key[0], &attrval[0]);
errs += checkAttrs(comm, 3, key, attrval);
MPI_Comm_delete_attr(comm, key[0]);
MPI_Comm_delete_attr(comm, key[1]);
MPI_Comm_delete_attr(comm, key[2]);
errs += checkNoAttrs(comm,3,key);
for (i=0;i<3;i++) {
MPI_Comm_free_keyval(&key[i]);
}
MPI_Finalize();
return 0;
}
int main( int argc, char *argv[] )
{
int attrval[10];
int wrank, i;
MPI_Comm comm;
MPI_Init( &argc, &argv );
MPI_Comm_rank( MPI_COMM_WORLD, &wrank );
comm = MPI_COMM_SELF;
/* Create key values */
for (nkeys=0; nkeys<NKEYS; nkeys++) {
MPI_Comm_create_keyval( MPI_NULL_COPY_FN, delete_fn,
&key[nkeys], (void *)0 );
attrval[nkeys] = 1024 * nkeys;
}
/* Insert attribute in several orders. Test after put with get,
then delete, then confirm delete with get. */
MPI_Comm_set_attr( comm, key[3], &attrval[3] );
keyorder[0] = 3;
MPI_Comm_set_attr( comm, key[2], &attrval[2] );
keyorder[1] = 2;
MPI_Comm_set_attr( comm, key[0], &attrval[0] );
keyorder[2] = 0;
MPI_Comm_set_attr( comm, key[1], &attrval[1] );
keyorder[3] = 1;
MPI_Comm_set_attr( comm, key[4], &attrval[4] );
keyorder[4] = 4;
errs += checkAttrs( comm, NKEYS, key, attrval );
for (i=0; i<NKEYS; i++) {
/* Save the key value so that we can compare it in the
delete function */
int keyval = key[i];
MPI_Comm_free_keyval( &keyval );
}
MPI_Finalize();
if (wrank == 0) {
if (ncall != nkeys) {
printf( "Deleted %d keys but should have deleted %d\n",
ncall, nkeys );
errs++;
}
if (errs == 0) printf( " No Errors\n" );
else printf( " Found %d errors\n", errs );
}
return 0;
}
void ompi_comm_free_keyval_f(MPI_Fint *comm_keyval, MPI_Fint *ierr)
{
int c_ierr;
OMPI_SINGLE_NAME_DECL(comm_keyval);
OMPI_SINGLE_FINT_2_INT(comm_keyval);
c_ierr = MPI_Comm_free_keyval(OMPI_SINGLE_NAME_CONVERT(comm_keyval));
if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);
if (MPI_SUCCESS == c_ierr) {
OMPI_SINGLE_INT_2_FINT(comm_keyval);
}
}
int main(int argc, char **argv)
{
MPI_Comm scomm;
int errs = 0;
MTest_Init(&argc, &argv);
MPI_Comm_split(MPI_COMM_WORLD, 1, 0, &scomm);
MPI_Comm_create_keyval(MPI_NULL_COPY_FN, delete_fn, &key, &errs);
MPI_Comm_set_attr(scomm, key, a);
MPI_Comm_free(&scomm);
MPI_Comm_free_keyval(&key);
MTest_Finalize(errs);
return MTestReturnValue(errs);
}
/*--------------------------------------------------------------------------
* NAME
* H5_init_library -- Initialize library-global information
* USAGE
* herr_t H5_init_library()
*
* RETURNS
* Non-negative on success/Negative on failure
*
* DESCRIPTION
* Initializes any library-global data or routines.
*
*--------------------------------------------------------------------------
*/
herr_t
H5_init_library(void)
{
herr_t ret_value = SUCCEED;
FUNC_ENTER_NOAPI(FAIL)
#ifdef H5_HAVE_PARALLEL
{
int mpi_initialized;
int mpi_finalized;
int mpi_code;
MPI_Initialized(&mpi_initialized);
MPI_Finalized(&mpi_finalized);
#ifdef H5_HAVE_MPE
/* Initialize MPE instrumentation library. */
if (!H5_MPEinit_g) {
int mpe_code;
if (mpi_initialized && !mpi_finalized) {
mpe_code = MPE_Init_log();
HDassert(mpe_code >=0);
H5_MPEinit_g = TRUE;
}
}
#endif /*H5_HAVE_MPE*/
/* add an attribute on MPI_COMM_SELF to call H5_term_library
when it is destroyed, i.e. on MPI_Finalize */
if (mpi_initialized && !mpi_finalized) {
int key_val;
if(MPI_SUCCESS != (mpi_code = MPI_Comm_create_keyval(MPI_COMM_NULL_COPY_FN,
(MPI_Comm_delete_attr_function *)H5_mpi_delete_cb,
&key_val, NULL)))
HMPI_GOTO_ERROR(FAIL, "MPI_Comm_create_keyval failed", mpi_code)
if(MPI_SUCCESS != (mpi_code = MPI_Comm_set_attr(MPI_COMM_SELF, key_val, NULL)))
HMPI_GOTO_ERROR(FAIL, "MPI_Comm_set_attr failed", mpi_code)
if(MPI_SUCCESS != (mpi_code = MPI_Comm_free_keyval(&key_val)))
HMPI_GOTO_ERROR(FAIL, "MPI_Comm_free_keyval failed", mpi_code)
}
}
int main(int argc, char *argv[])
{
int comm_keyval, win_keyval, type_keyval;
int comm_aval;
int err, errs = 0;
int buf, flag;
MPI_Win win;
void *rval;
MPI_Datatype dtype;
MTest_Init(&argc, &argv);
MPI_Comm_create_keyval(MPI_COMM_NULL_COPY_FN, MPI_COMM_NULL_DELETE_FN, &comm_keyval, 0);
MPI_Win_create_keyval(MPI_WIN_NULL_COPY_FN, MPI_WIN_NULL_DELETE_FN, &win_keyval, 0);
MPI_Type_create_keyval(MPI_TYPE_NULL_COPY_FN, MPI_TYPE_NULL_DELETE_FN, &type_keyval, 0);
MPI_Type_contiguous(4, MPI_DOUBLE, &dtype);
MPI_Win_create(&buf, sizeof(int), sizeof(int), MPI_INFO_NULL, MPI_COMM_WORLD, &win);
MPI_Errhandler_set(MPI_COMM_WORLD, MPI_ERRORS_RETURN);
err = MPI_Comm_set_attr(MPI_COMM_WORLD, win_keyval, &comm_aval);
if (err == MPI_SUCCESS) {
errs++;
fprintf(stderr, "Comm_set_attr accepted win keyval\n");
}
err = MPI_Comm_set_attr(MPI_COMM_WORLD, type_keyval, &comm_aval);
if (err == MPI_SUCCESS) {
errs++;
fprintf(stderr, "Comm_set_attr accepted type keyval\n");
}
err = MPI_Type_set_attr(dtype, win_keyval, &comm_aval);
if (err == MPI_SUCCESS) {
errs++;
fprintf(stderr, "Type_set_attr accepted win keyval\n");
}
err = MPI_Type_set_attr(dtype, comm_keyval, &comm_aval);
if (err == MPI_SUCCESS) {
errs++;
fprintf(stderr, "Comm_set_attr accepted type keyval\n");
}
err = MPI_Win_set_attr(win, comm_keyval, &comm_aval);
if (err == MPI_SUCCESS) {
errs++;
fprintf(stderr, "Win_set_attr accepted comm keyval\n");
}
err = MPI_Win_set_attr(win, type_keyval, &comm_aval);
if (err == MPI_SUCCESS) {
errs++;
fprintf(stderr, "Win_set_attr accepted type keyval\n");
}
err = MPI_Comm_get_attr(MPI_COMM_WORLD, win_keyval, &rval, &flag);
if (err == MPI_SUCCESS) {
errs++;
fprintf(stderr, "Comm_get_attr accepted win keyval\n");
}
err = MPI_Comm_get_attr(MPI_COMM_WORLD, type_keyval, &rval, &flag);
if (err == MPI_SUCCESS) {
errs++;
fprintf(stderr, "Comm_get_attr accepted type keyval\n");
}
err = MPI_Comm_free_keyval(&win_keyval);
if (err == MPI_SUCCESS) {
errs++;
fprintf(stderr, "Comm_free_keyval accepted win keyval\n");
}
err = MPI_Comm_free_keyval(&type_keyval);
if (err == MPI_SUCCESS) {
errs++;
fprintf(stderr, "Comm_free_keyval accepted type keyval\n");
}
if (win_keyval != MPI_KEYVAL_INVALID) {
err = MPI_Type_free_keyval(&win_keyval);
if (err == MPI_SUCCESS) {
errs++;
fprintf(stderr, "Type_free_keyval accepted win keyval\n");
}
}
err = MPI_Type_free_keyval(&comm_keyval);
if (err == MPI_SUCCESS) {
errs++;
fprintf(stderr, "Type_free_keyval accepted comm keyval\n");
}
if (type_keyval != MPI_KEYVAL_INVALID) {
err = MPI_Win_free_keyval(&type_keyval);
if (err == MPI_SUCCESS) {
errs++;
fprintf(stderr, "Win_free_keyval accepted type keyval\n");
}
}
if (comm_keyval != MPI_KEYVAL_INVALID) {
err = MPI_Win_free_keyval(&comm_keyval);
if (err == MPI_SUCCESS) {
errs++;
fprintf(stderr, "Win_free_keyval accepted comm keyval\n");
}
}
/* Now, free for real */
if (comm_keyval != MPI_KEYVAL_INVALID) {
err = MPI_Comm_free_keyval(&comm_keyval);
if (err != MPI_SUCCESS) {
errs++;
fprintf(stderr, "Could not free comm keyval\n");
}
}
if (type_keyval != MPI_KEYVAL_INVALID) {
err = MPI_Type_free_keyval(&type_keyval);
if (err != MPI_SUCCESS) {
errs++;
fprintf(stderr, "Could not free type keyval\n");
}
}
if (win_keyval != MPI_KEYVAL_INVALID) {
err = MPI_Win_free_keyval(&win_keyval);
if (err != MPI_SUCCESS) {
errs++;
fprintf(stderr, "Could not free win keyval\n");
}
}
MPI_Win_free(&win);
MPI_Type_free(&dtype);
MTest_Finalize(errs);
return MTestReturnValue(errs);
}
int test_communicators(void)
{
MPI_Comm dup_comm_world, d2;
int world_rank, world_size, key_1;
int err, errs = 0;
MPI_Aint value;
MPI_Comm_rank(MPI_COMM_WORLD, &world_rank);
MPI_Comm_size(MPI_COMM_WORLD, &world_size);
#ifdef DEBUG
if (world_rank == 0) {
printf("*** Attribute copy/delete return codes ***\n");
}
#endif
MPI_Comm_dup(MPI_COMM_WORLD, &dup_comm_world);
MPI_Barrier(dup_comm_world);
MPI_Errhandler_set(dup_comm_world, MPI_ERRORS_RETURN);
value = -11;
if ((err = MPI_Comm_create_keyval(copybomb_fn, deletebomb_fn, &key_1, &value)))
abort_msg("Keyval_create", err);
err = MPI_Comm_set_attr(dup_comm_world, key_1, (void *) (MPI_Aint) world_rank);
if (err) {
errs++;
printf("Error with first put\n");
}
err = MPI_Comm_set_attr(dup_comm_world, key_1, (void *) (MPI_Aint) (2 * world_rank));
if (err == MPI_SUCCESS) {
errs++;
printf("delete function return code was MPI_SUCCESS in put\n");
}
/* Because the attribute delete function should fail, the attribute
* should *not be removed* */
err = MPI_Comm_delete_attr(dup_comm_world, key_1);
if (err == MPI_SUCCESS) {
errs++;
printf("delete function return code was MPI_SUCCESS in delete\n");
}
err = MPI_Comm_dup(dup_comm_world, &d2);
if (err == MPI_SUCCESS) {
errs++;
printf("copy function return code was MPI_SUCCESS in dup\n");
}
if (err != MPI_ERR_OTHER) {
int lerrclass;
MPI_Error_class(err, &lerrclass);
if (lerrclass != MPI_ERR_OTHER) {
errs++;
printf("dup did not return an error code of class ERR_OTHER; ");
printf("err = %d, class = %d\n", err, lerrclass);
}
}
#ifndef USE_STRICT_MPI
/* Another interpretation is to leave d2 unchanged on error */
if (err && d2 != MPI_COMM_NULL) {
errs++;
printf("dup did not return MPI_COMM_NULL on error\n");
}
#endif
delete_flag = 1;
MPI_Comm_free(&dup_comm_world);
MPI_Comm_free_keyval(&key_1);
return errs;
}
int main(int argc, char *argv[])
{
int errs = 0;
int attrval;
int i, key[32], keyval, saveKeyval;
MPI_Comm comm, dupcomm;
MTest_Init(&argc, &argv);
while (MTestGetIntracomm(&comm, 1)) {
if (comm == MPI_COMM_NULL)
continue;
MPI_Comm_create_keyval(copy_fn, delete_fn, &keyval, (void *) 0);
saveKeyval = keyval; /* in case we need to free explicitly */
attrval = 1;
MPI_Comm_set_attr(comm, keyval, (void *) &attrval);
/* See MPI-1, 5.7.1. Freeing the keyval does not remove it if it
* is in use in an attribute */
MPI_Comm_free_keyval(&keyval);
/* We create some dummy keyvals here in case the same keyval
* is reused */
for (i = 0; i < 32; i++) {
MPI_Comm_create_keyval(MPI_NULL_COPY_FN, MPI_NULL_DELETE_FN, &key[i], (void *) 0);
}
MPI_Comm_dup(comm, &dupcomm);
/* Check that the attribute was copied */
if (attrval != 2) {
errs++;
printf("Attribute not incremented when comm dup'ed (%s)\n", MTestGetIntracommName());
}
MPI_Comm_free(&dupcomm);
if (attrval != 1) {
errs++;
printf("Attribute not decremented when dupcomm %s freed\n", MTestGetIntracommName());
}
/* Check that the attribute was freed in the dupcomm */
if (comm != MPI_COMM_WORLD && comm != MPI_COMM_SELF) {
MPI_Comm_free(&comm);
/* Check that the original attribute was freed */
if (attrval != 0) {
errs++;
printf("Attribute not decremented when comm %s freed\n", MTestGetIntracommName());
}
}
else {
/* Explicitly delete the attributes from world and self */
MPI_Comm_delete_attr(comm, saveKeyval);
}
/* Free those other keyvals */
for (i = 0; i < 32; i++) {
MPI_Comm_free_keyval(&key[i]);
}
}
MTest_Finalize(errs);
MPI_Finalize();
/* The attributes on comm self and world were deleted by finalize
* (see separate test) */
return 0;
}
FORT_DLL_SPEC void FORT_CALL mpi_comm_free_keyval_ ( MPI_Fint *v1, MPI_Fint *ierr ){
*ierr = MPI_Comm_free_keyval( v1 );
}
int main(int argc, char **argv)
{
int errs = 0, wrank;
int i;
MTest_Init(&argc, &argv);
MPI_Comm_rank(MPI_COMM_WORLD, &wrank);
#if MTEST_HAVE_MIN_MPI_VERSION(2,2)
for (i = 0; i < NUM_TEST_ATTRS; ++i) {
exit_keys[i] = MPI_KEYVAL_INVALID;
was_called[i] = 0;
/* create the keyval for the exit handler */
MPI_Comm_create_keyval(MPI_COMM_NULL_COPY_FN, delete_fn, &exit_keys[i], NULL);
/* attach to comm_self */
MPI_Comm_set_attr(MPI_COMM_SELF, exit_keys[i], (void *) (long) i);
}
/* we can free the keys now */
for (i = 0; i < NUM_TEST_ATTRS; ++i) {
MPI_Comm_free_keyval(&exit_keys[i]);
}
/* now, exit MPI */
MPI_Finalize();
/* check that the exit handlers were called in LIFO order, and without error */
if (wrank == 0) {
/* In case more than one process exits MPI_Finalize */
for (i = 0; i < NUM_TEST_ATTRS; ++i) {
if (was_called[i] < 1) {
errs++;
printf("Attribute delete function on MPI_COMM_SELF was not called for idx=%d\n", i);
}
else if (was_called[i] > 1) {
errs++;
printf
("Attribute delete function on MPI_COMM_SELF was called multiple times for idx=%d\n",
i);
}
}
if (foundError != 0) {
errs++;
printf("Found %d errors while executing delete function in MPI_COMM_SELF\n",
foundError);
}
if (errs == 0) {
printf(" No Errors\n");
}
else {
printf(" Found %d errors\n", errs);
}
fflush(stdout);
}
#else /* this is a pre-MPI-2.2 implementation, ordering is not defined */
MPI_Finalize();
if (wrank == 0)
printf(" No Errors\n");
#endif
return 0;
}
