Exemple #1
0
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;
}
Exemple #2
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;

}
Exemple #3
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);
}
Exemple #4
0
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;
}
Exemple #5
0
/*@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);
}
Exemple #6
0
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);
}
Exemple #7
0
/*--------------------------------------------------------------------------
 * 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)
        }
    }
Exemple #8
0
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);
}
Exemple #9
0
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 );
}
Exemple #10
0
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;
}
Exemple #11
0
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;
}
Exemple #12
0
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;

}
Exemple #13
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;
}