xref: /petsc/src/sys/tests/ex53.c (revision d5b43468fb8780a8feea140ccd6fa3e6a50411cc)
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 {
12   int         err;
13   PetscInt    i;
14   PetscMPIInt key1, key2, attr1 = 100, attr2 = 200, *attr, flag;
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, &flag);
46   CHKMPIERR(err);
47   if (flag) printf("Error: newcomm should not have attribute for keyval %d\n", (int)key1);
48   err = MPI_Comm_get_attr(MPI_COMM_WORLD, key1, &attr, &flag);
49   CHKMPIERR(err);
50   if (*attr != attr1) printf("Error: expected attribute %d, but got %d\n", (int)attr1, (int)*attr);
51   err = MPI_Comm_get_attr(newcomm, key2, &attr, &flag);
52   CHKMPIERR(err);
53   if (*attr != attr2) printf("Error: expected attribute %d, but got %d\n", (int)attr2, (int)*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, (char *)0, 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/ex53_1.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