1 static char help[] = "Test resource recycling and MPI_Comm and keyval creation in mpi or mpiuni\n"; 2 3 #include <petscsys.h> 4 5 #define CHKMPIERR(ierr) \ 6 do { \ 7 if (ierr) MPI_Abort(MPI_COMM_WORLD, ierr); \ 8 } while (0) 9 10 int main(int argc, char **argv) { 11 int err; 12 PetscInt i; 13 PetscMPIInt key1, key2, attr1 = 100, attr2 = 200, *attr, flag; 14 MPI_Comm newcomm; 15 16 err = MPI_Init(&argc, &argv); 17 CHKMPIERR(err); 18 19 /* Repeated keyval or comm create/free should not blow up MPI */ 20 for (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 } 30 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"); 39 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, &flag); 45 CHKMPIERR(err); 46 if (flag) printf("Error: newcomm should not have attribute for keyval %d\n", (int)key1); 47 err = MPI_Comm_get_attr(MPI_COMM_WORLD, key1, &attr, &flag); 48 CHKMPIERR(err); 49 if (*attr != attr1) printf("Error: expected attribute %d, but got %d\n", (int)attr1, (int)*attr); 50 err = MPI_Comm_get_attr(newcomm, key2, &attr, &flag); 51 CHKMPIERR(err); 52 if (*attr != attr2) printf("Error: expected attribute %d, but got %d\n", (int)attr2, (int)*attr); 53 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); 64 65 /* Init/Finalize PETSc multiple times when MPI is initialized */ 66 for (i = 0; i < 500; i++) { 67 PetscFunctionBeginUser; 68 PetscCall(PetscInitialize(&argc, &argv, (char *)0, help)); 69 PetscCall(PetscFinalize(); if (err) return err); 70 } 71 72 err = MPI_Finalize(); 73 return err; 74 } 75 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/ex53_1.out 80 test: 81 suffix: 1 82 requires: !elemental 83 84 test: 85 suffix: 2 86 requires: elemental !defined(PETSC_USE_DEBUG) 87 TEST*/ 88