1: static char help[] = "Test resource recycling and MPI_Comm and keyval creation in mpi or mpiuni, no PETSc\n";

  3: #include <petscsys.h>

  5: #define CHKMPIERR(err) \
  6:   do { \
  7:     if (err) MPI_Abort(MPI_COMM_WORLD, err); \
  8:   } while (0)

 10: int main(int argc, char **argv)
 11: {
 12:   int         err;
 13:   PetscMPIInt key1, key2, attr1 = 100, attr2 = 200, *attr, iflg;
 14:   MPI_Comm    newcomm;

 16:   err = MPI_Init(&argc, &argv);
 17:   CHKMPIERR(err);

 19:   /* Repeated keyval or comm create/free should not blow up MPI */
 20:   for (PetscInt i = 0; i < 500; i++) {
 21:     err = MPI_Comm_create_keyval(MPI_COMM_NULL_COPY_FN, MPI_COMM_NULL_DELETE_FN, &key1, NULL);
 22:     CHKMPIERR(err);
 23:     err = MPI_Comm_free_keyval(&key1);
 24:     CHKMPIERR(err);
 25:     err = MPI_Comm_dup(MPI_COMM_WORLD, &newcomm);
 26:     CHKMPIERR(err);
 27:     err = MPI_Comm_free(&newcomm);
 28:     CHKMPIERR(err);
 29:   }

 31:   /* The following keyval/attr code exposes a bug in old mpiuni code, where it had wrong newcomm returned in MPI_Comm_dup. */
 32:   err = MPI_Comm_create_keyval(MPI_COMM_NULL_COPY_FN, MPI_COMM_NULL_DELETE_FN, &key1, NULL);
 33:   CHKMPIERR(err);
 34:   err = MPI_Comm_create_keyval(MPI_COMM_NULL_COPY_FN, MPI_COMM_NULL_DELETE_FN, &key2, NULL);
 35:   CHKMPIERR(err);
 36:   err = MPI_Comm_dup(MPI_COMM_WORLD, &newcomm);
 37:   CHKMPIERR(err);
 38:   if (MPI_COMM_WORLD == newcomm) printf("Error: wrong newcomm returned by MPI_Comm_dup()\n");

 40:   err = MPI_Comm_set_attr(MPI_COMM_WORLD, key1, &attr1);
 41:   CHKMPIERR(err);
 42:   err = MPI_Comm_set_attr(newcomm, key2, &attr2);
 43:   CHKMPIERR(err);
 44:   err = MPI_Comm_get_attr(newcomm, key1, &attr, &iflg);
 45:   CHKMPIERR(err);
 46:   if (iflg) printf("Error: newcomm should not have attribute for keyval %d\n", key1);
 47:   err = MPI_Comm_get_attr(MPI_COMM_WORLD, key1, &attr, &iflg);
 48:   CHKMPIERR(err);
 49:   if (*attr != attr1) printf("Error: expected attribute %d, but got %d\n", attr1, *attr);
 50:   err = MPI_Comm_get_attr(newcomm, key2, &attr, &iflg);
 51:   CHKMPIERR(err);
 52:   if (*attr != attr2) printf("Error: expected attribute %d, but got %d\n", attr2, *attr);

 54:   err = MPI_Comm_delete_attr(MPI_COMM_WORLD, key1);
 55:   CHKMPIERR(err);
 56:   err = MPI_Comm_delete_attr(newcomm, key2);
 57:   CHKMPIERR(err);
 58:   err = MPI_Comm_free_keyval(&key1);
 59:   CHKMPIERR(err);
 60:   err = MPI_Comm_free_keyval(&key2);
 61:   CHKMPIERR(err);
 62:   err = MPI_Comm_free(&newcomm);
 63:   CHKMPIERR(err);

 65:   /* Init/Finalize PETSc multiple times when MPI is initialized */
 66:   for (PetscInt i = 0; i < 500; i++) {
 67:     PetscFunctionBeginUser;
 68:     PetscCall(PetscInitialize(&argc, &argv, NULL, help));
 69:     PetscCall(PetscFinalize(); if (err) return err);
 70:   }

 72:   err = MPI_Finalize();
 73:   return err;
 74: }

 76: /*TEST
 77:    # Elemental in debug mode has bugs that it can not be repeatedly init/finalize'd for more than 300 times
 78:    testset:
 79:     output_file: output/empty.out
 80:     test:
 81:       suffix: 1
 82:       requires: !elemental

 84:     test:
 85:       suffix: 2
 86:       requires: elemental !defined(PETSC_USE_DEBUG)
 87: TEST*/