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
main(int argc,char ** argv)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