1 static char help[] = "Test resource recycling and MPI_Comm and keyval creation in mpi or mpiuni, no PETSc\n"; 2 3 #include <petscsys.h> 4 5 #define CHKMPIERR(err) \ 6 do { \ 7 if (err) MPI_Abort(MPI_COMM_WORLD, err); \ 8 } while (0) 9 10 int main(int argc, char **argv) 11 { 12 int err; 13 PetscInt i; 14 PetscMPIInt key1, key2, attr1 = 100, attr2 = 200, *attr, iflg; 15 MPI_Comm newcomm; 16 17 err = MPI_Init(&argc, &argv); 18 CHKMPIERR(err); 19 20 /* Repeated keyval or comm create/free should not blow up MPI */ 21 for (i = 0; i < 500; i++) { 22 err = MPI_Comm_create_keyval(MPI_COMM_NULL_COPY_FN, MPI_COMM_NULL_DELETE_FN, &key1, NULL); 23 CHKMPIERR(err); 24 err = MPI_Comm_free_keyval(&key1); 25 CHKMPIERR(err); 26 err = MPI_Comm_dup(MPI_COMM_WORLD, &newcomm); 27 CHKMPIERR(err); 28 err = MPI_Comm_free(&newcomm); 29 CHKMPIERR(err); 30 } 31 32 /* The following keyval/attr code exposes a bug in old mpiuni code, where it had wrong newcomm returned in MPI_Comm_dup. */ 33 err = MPI_Comm_create_keyval(MPI_COMM_NULL_COPY_FN, MPI_COMM_NULL_DELETE_FN, &key1, NULL); 34 CHKMPIERR(err); 35 err = MPI_Comm_create_keyval(MPI_COMM_NULL_COPY_FN, MPI_COMM_NULL_DELETE_FN, &key2, NULL); 36 CHKMPIERR(err); 37 err = MPI_Comm_dup(MPI_COMM_WORLD, &newcomm); 38 CHKMPIERR(err); 39 if (MPI_COMM_WORLD == newcomm) printf("Error: wrong newcomm returned by MPI_Comm_dup()\n"); 40 41 err = MPI_Comm_set_attr(MPI_COMM_WORLD, key1, &attr1); 42 CHKMPIERR(err); 43 err = MPI_Comm_set_attr(newcomm, key2, &attr2); 44 CHKMPIERR(err); 45 err = MPI_Comm_get_attr(newcomm, key1, &attr, &iflg); 46 CHKMPIERR(err); 47 if (iflg) printf("Error: newcomm should not have attribute for keyval %d\n", key1); 48 err = MPI_Comm_get_attr(MPI_COMM_WORLD, key1, &attr, &iflg); 49 CHKMPIERR(err); 50 if (*attr != attr1) printf("Error: expected attribute %d, but got %d\n", attr1, *attr); 51 err = MPI_Comm_get_attr(newcomm, key2, &attr, &iflg); 52 CHKMPIERR(err); 53 if (*attr != attr2) printf("Error: expected attribute %d, but got %d\n", attr2, *attr); 54 55 err = MPI_Comm_delete_attr(MPI_COMM_WORLD, key1); 56 CHKMPIERR(err); 57 err = MPI_Comm_delete_attr(newcomm, key2); 58 CHKMPIERR(err); 59 err = MPI_Comm_free_keyval(&key1); 60 CHKMPIERR(err); 61 err = MPI_Comm_free_keyval(&key2); 62 CHKMPIERR(err); 63 err = MPI_Comm_free(&newcomm); 64 CHKMPIERR(err); 65 66 /* Init/Finalize PETSc multiple times when MPI is initialized */ 67 for (i = 0; i < 500; i++) { 68 PetscFunctionBeginUser; 69 PetscCall(PetscInitialize(&argc, &argv, NULL, help)); 70 PetscCall(PetscFinalize(); if (err) return err); 71 } 72 73 err = MPI_Finalize(); 74 return err; 75 } 76 77 /*TEST 78 # Elemental in debug mode has bugs that it can not be repeatedly init/finalize'd for more than 300 times 79 testset: 80 output_file: output/empty.out 81 test: 82 suffix: 1 83 requires: !elemental 84 85 test: 86 suffix: 2 87 requires: elemental !defined(PETSC_USE_DEBUG) 88 TEST*/ 89