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;
}
/*@C
PETSC_VIEWER_SOCKET_ - Creates a socket viewer shared by all processors in a communicator.
Collective on MPI_Comm
Input Parameter:
. comm - the MPI communicator to share the socket PetscViewer
Level: intermediate
Options Database Keys:
For use with the default PETSC_VIEWER_SOCKET_WORLD or if
NULL is passed for machine or PETSC_DEFAULT is passed for port
$ -viewer_socket_machine <machine>
$ -viewer_socket_port <port>
Environmental variables:
+ PETSC_VIEWER_SOCKET_PORT portnumber
- PETSC_VIEWER_SOCKET_MACHINE machine name
Notes:
Unlike almost all other PETSc routines, PetscViewer_SOCKET_ does not return
an error code. The socket PetscViewer is usually used in the form
$ XXXView(XXX object,PETSC_VIEWER_SOCKET_(comm));
Currently the only socket client available is MATLAB. See
src/dm/examples/tests/ex12.c and ex12.m for an example of usage.
Connects to a waiting socket and stays connected until PetscViewerDestroy() is called.
Use this for communicating with an interactive MATLAB session, see PETSC_VIEWER_MATLAB_() for writing output to a
.mat file. Use PetscMatlabEngineCreate() or PETSC_MATLAB_ENGINE_(), PETSC_MATLAB_ENGINE_SELF, or PETSC_MATLAB_ENGINE_WORLD
for communicating with a MATLAB Engine
.seealso: PETSC_VIEWER_SOCKET_WORLD, PETSC_VIEWER_SOCKET_SELF, PetscViewerSocketOpen(), PetscViewerCreate(),
PetscViewerSocketSetConnection(), PetscViewerDestroy(), PETSC_VIEWER_SOCKET_(), PetscViewerBinaryWrite(), PetscViewerBinaryRead(),
PetscViewerBinaryWriteStringArray(), PetscViewerBinaryGetDescriptor(), PETSC_VIEWER_MATLAB_()
@*/
PetscViewer PETSC_VIEWER_SOCKET_(MPI_Comm comm)
{
PetscErrorCode ierr;
PetscBool flg;
PetscViewer viewer;
MPI_Comm ncomm;
PetscFunctionBegin;
ierr = PetscCommDuplicate(comm,&ncomm,NULL);if (ierr) {PetscError(PETSC_COMM_SELF,__LINE__,"PETSC_VIEWER_SOCKET_",__FILE__,PETSC_ERR_PLIB,PETSC_ERROR_INITIAL," ");PetscFunctionReturn(0);}
if (Petsc_Viewer_Socket_keyval == MPI_KEYVAL_INVALID) {
ierr = MPI_Comm_create_keyval(MPI_COMM_NULL_COPY_FN,MPI_COMM_NULL_DELETE_FN,&Petsc_Viewer_Socket_keyval,0);
if (ierr) {PetscError(PETSC_COMM_SELF,__LINE__,"PETSC_VIEWER_SOCKET_",__FILE__,PETSC_ERR_PLIB,PETSC_ERROR_INITIAL," ");PetscFunctionReturn(0);}
}
ierr = MPI_Comm_get_attr(ncomm,Petsc_Viewer_Socket_keyval,(void**)&viewer,(int*)&flg);
if (ierr) {PetscError(PETSC_COMM_SELF,__LINE__,"PETSC_VIEWER_SOCKET_",__FILE__,PETSC_ERR_PLIB,PETSC_ERROR_INITIAL," ");PetscFunctionReturn(0);}
if (!flg) { /* PetscViewer not yet created */
ierr = PetscViewerSocketOpen(ncomm,0,0,&viewer);
if (ierr) {PetscError(PETSC_COMM_SELF,__LINE__,"PETSC_VIEWER_SOCKET_",__FILE__,PETSC_ERR_PLIB,PETSC_ERROR_INITIAL," ");PetscFunctionReturn(0);}
ierr = PetscObjectRegisterDestroy((PetscObject)viewer);
if (ierr) {PetscError(PETSC_COMM_SELF,__LINE__,"PETSC_VIEWER_SOCKET_",__FILE__,PETSC_ERR_PLIB,PETSC_ERROR_INITIAL," ");PetscFunctionReturn(0);}
ierr = MPI_Comm_set_attr(ncomm,Petsc_Viewer_Socket_keyval,(void*)viewer);
if (ierr) {PetscError(PETSC_COMM_SELF,__LINE__,"PETSC_VIEWER_SOCKET_",__FILE__,PETSC_ERR_PLIB,PETSC_ERROR_INITIAL," ");PetscFunctionReturn(0);}
}
ierr = PetscCommDestroy(&ncomm);
if (ierr) {PetscError(PETSC_COMM_SELF,__LINE__,"PETSC_VIEWER_SOCKET_",__FILE__,PETSC_ERR_PLIB,PETSC_ERROR_INITIAL," ");PetscFunctionReturn(0);}
PetscFunctionReturn(viewer);
}
void MPIR_MPIOInit(int * error_code) {
int flag;
char myname[] = "MPIR_MPIOInit";
/* first check if ADIO has been initialized. If not, initialize it */
if (ADIO_Init_keyval == MPI_KEYVAL_INVALID) {
MPI_Initialized(&flag);
/* --BEGIN ERROR HANDLING-- */
if (!flag) {
*error_code = MPIO_Err_create_code(MPI_SUCCESS,
MPIR_ERR_RECOVERABLE, myname, __LINE__,
MPI_ERR_OTHER, "**initialized", 0);
*error_code = MPIO_Err_return_file(MPI_FILE_NULL, *error_code);
return;
}
/* --END ERROR HANDLING-- */
MPI_Comm_create_keyval (MPI_COMM_NULL_COPY_FN, ADIOI_End_call, &ADIO_Init_keyval,
(void *) 0);
/* put a dummy attribute on MPI_COMM_SELF, because we want the delete
function to be called when MPI_COMM_SELF is freed. Clarified
in MPI-2 section 4.8, the standard mandates that attributes on
MPI_COMM_SELF get cleaned up early in MPI_Finalize */
MPI_Comm_set_attr (MPI_COMM_SELF, ADIO_Init_keyval, (void *) 0);
/* initialize ADIO */
ADIO_Init( (int *)0, (char ***)0, error_code);
}
*error_code = MPI_SUCCESS;
}
/*@C
PETSC_MATLAB_ENGINE_ - Creates a matlab engine shared by all processors
in a communicator.
Not Collective
Input Parameter:
. comm - the MPI communicator to share the engine
Level: developer
Notes:
Unlike almost all other PETSc routines, this does not return
an error code. Usually used in the form
$ PetscMatlabEngineYYY(XXX object,PETSC_MATLAB_ENGINE_(comm));
.seealso: PetscMatlabEngineDestroy(), PetscMatlabEnginePut(), PetscMatlabEngineGet(),
PetscMatlabEngineEvaluate(), PetscMatlabEngineGetOutput(), PetscMatlabEnginePrintOutput(),
PetscMatlabEngineCreate(), PetscMatlabEnginePutArray(), PetscMatlabEngineGetArray(), PetscMatlabEngine,
PETSC_MATLAB_ENGINE_WORLD, PETSC_MATLAB_ENGINE_SELF
@*/
PetscMatlabEngine PETSC_MATLAB_ENGINE_(MPI_Comm comm)
{
PetscErrorCode ierr;
PetscBool flg;
PetscMatlabEngine mengine;
PetscFunctionBegin;
if (Petsc_Matlab_Engine_keyval == MPI_KEYVAL_INVALID) {
ierr = MPI_Comm_create_keyval(MPI_COMM_NULL_COPY_FN,MPI_COMM_NULL_DELETE_FN,&Petsc_Matlab_Engine_keyval,0);
if (ierr) {PetscError(PETSC_COMM_SELF,__LINE__,"PETSC_MATLAB_ENGINE_",__FILE__,PETSC_ERR_PLIB,PETSC_ERROR_INITIAL," "); mengine = 0;}
}
ierr = MPI_Comm_get_attr(comm,Petsc_Matlab_Engine_keyval,(void**)&mengine,(int*)&flg);
if (ierr) {PetscError(PETSC_COMM_SELF,__LINE__,"PETSC_MATLAB_ENGINE_",__FILE__,PETSC_ERR_PLIB,PETSC_ERROR_INITIAL," "); mengine = 0;}
if (!flg) { /* viewer not yet created */
char *machinename = 0,machine[64];
ierr = PetscOptionsGetString(NULL,NULL,"-matlab_engine_machine",machine,64,&flg);
if (ierr) {PetscError(PETSC_COMM_SELF,__LINE__,"PETSC_MATLAB_ENGINE_",__FILE__,PETSC_ERR_PLIB,PETSC_ERROR_INITIAL," "); mengine = 0;}
if (flg) machinename = machine;
ierr = PetscMatlabEngineCreate(comm,machinename,&mengine);
if (ierr) {PetscError(PETSC_COMM_SELF,__LINE__,"PETSC_MATLAB_ENGINE_",__FILE__,PETSC_ERR_PLIB,PETSC_ERROR_INITIAL," "); mengine = 0;}
ierr = PetscObjectRegisterDestroy((PetscObject)mengine);
if (ierr) {PetscError(PETSC_COMM_SELF,__LINE__,"PETSC_MATLAB_ENGINE_",__FILE__,PETSC_ERR_PLIB,PETSC_ERROR_INITIAL," "); mengine = 0;}
ierr = MPI_Comm_set_attr(comm,Petsc_Matlab_Engine_keyval,mengine);
if (ierr) {PetscError(PETSC_COMM_SELF,__LINE__,"PETSC_MATLAB_ENGINE_",__FILE__,PETSC_ERR_PLIB,PETSC_ERROR_INITIAL," "); mengine = 0;}
}
PetscFunctionReturn(mengine);
}
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);
}
void csetmpi2_( MPI_Fint *fcomm, MPI_Fint *fkey, MPI_Aint *val, MPI_Fint *errs )
{
MPI_Comm comm = MPI_Comm_f2c( *fcomm );
MPI_Comm_set_attr( comm, *fkey, (void *)*val );
}
void ctoctest_( MPI_Fint *errs )
{
int errcnt = *errs;
int baseattrval = (1 << (sizeof(int)*8-2))-3;
MPI_Datatype cduptype;
MPI_Comm cdup;
/* MPI-1 function */
ccomm1Attr = baseattrval;
MPI_Attr_put( MPI_COMM_SELF, ccomm1Key, &ccomm1Attr );
/* Test that we have the same value */
errcnt += cmpi1read( MPI_COMM_SELF, ccomm1Key, &ccomm1Attr, "C to C" );
/* Dup, check that the copy routine does what is expected */
MPI_Comm_dup( MPI_COMM_SELF, &cdup );
errcnt += cmpi1read( cdup, ccomm1Key, &ccomm1Attr, "C to C dup" );
if (ccomm1Attr != baseattrval + 1) {
printf( " Did not increment int in C to C dup: %d %d\n",
ccomm1Attr, baseattrval + 1 );
errcnt ++;
}
MPI_Comm_free( &cdup );
if (ccomm1Attr != baseattrval) {
printf( " Did not increment int in C to C delete: %d %d\n",
ccomm1Attr, baseattrval );
errcnt ++;
}
/* MPI-2 functions */
ccomm1Attr = 0;
ccomm2Attr = baseattrval;
MPI_Comm_set_attr( MPI_COMM_SELF, ccomm2Key, &ccomm2Attr );
/* Test that we have the same value */
errcnt += cmpi2read( MPI_COMM_SELF, ccomm2Key, &ccomm2Attr, "C to C (2)" );
/* Dup, check that the copy routine does what is expected */
MPI_Comm_dup( MPI_COMM_SELF, &cdup );
errcnt += cmpi2read( cdup, ccomm2Key, &ccomm2Attr, "C to C dup (2)" );
if (ccomm2Attr != baseattrval + 1) {
printf( " Did not increment int in C to C dup: %d %d\n",
ccomm2Attr, baseattrval + 1 );
errcnt ++;
}
MPI_Comm_free( &cdup );
if (ccomm2Attr != baseattrval) {
printf( " Did not increment int in C to C delete (2): %d %d\n",
ccomm2Attr, baseattrval );
errcnt ++;
}
/* MPI-2 functions */
ctype2Attr = baseattrval;
MPI_Type_set_attr( MPI_INTEGER, ctype2Key, &ctype2Attr );
/* Test that we have the same value */
errcnt += cmpi2readtype( MPI_INTEGER, ctype2Key, &ctype2Attr, "C to C type (2)" );
/* Dup, check that the copy routine does what is expected */
MPI_Type_dup( MPI_INTEGER, &cduptype );
errcnt += cmpi2readtype( cduptype, ctype2Key, &ctype2Attr, "C to C typedup (2)" );
if (ctype2Attr != baseattrval + 1) {
printf( " Did not increment int in C to C typedup: %d %d\n",
ctype2Attr, baseattrval + 1 );
errcnt ++;
}
ccomm1Attr = 0;
MPI_Type_free( &cduptype );
if (ctype2Attr != baseattrval) {
printf( " Did not increment int in C to C typedelete (2): %d %d\n",
ctype2Attr, baseattrval );
errcnt ++;
}
*errs = errcnt;
}
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;
}
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;
}
