1 /*
2  * Copyright (C) by Argonne National Laboratory
3  *     See COPYRIGHT in top-level directory
4  */
5 
6 #include "mpi.h"
7 #include "mpitest.h"
8 #include <stdio.h>
9 #include <stdlib.h>
10 #ifdef HAVE_STRINGS_H
11 #include <strings.h>
12 #endif
13 #ifdef HAVE_STRING_H
14 #include <string.h>
15 #endif
16 
17 #define IF_VERBOSE(a) if (verbose) { printf a ; fflush(stdout); }
18 #define DATA_VALUE 123
19 #define DATA_TAG 100
20 #define SENDER_RANK 0
21 #define RECEIVER_RANK 1
22 
23 /*
24 static char MTEST_Descrip[] = "A simple test of Comm_disconnect";
25 */
26 
main(int argc,char * argv[])27 int main(int argc, char *argv[])
28 {
29     int errs = 0;
30     int rank, size, rsize, i, data = -1;
31     int np = 3;
32     MPI_Comm parentcomm, intercomm;
33     MPI_Status status;
34     int verbose = 0;
35     char *env;
36     int can_spawn;
37 
38     env = getenv("MPITEST_VERBOSE");
39     if (env) {
40         if (*env != '0')
41             verbose = 1;
42     }
43 
44     MTest_Init(&argc, &argv);
45 
46     errs += MTestSpawnPossible(&can_spawn);
47 
48     if (can_spawn) {
49         MPI_Comm_get_parent(&parentcomm);
50 
51         if (parentcomm == MPI_COMM_NULL) {
52             IF_VERBOSE(("spawning %d processes\n", np));
53             /* Create 3 more processes */
54             MPI_Comm_spawn((char *) "./disconnect2", MPI_ARGV_NULL, np,
55                            MPI_INFO_NULL, 0, MPI_COMM_WORLD, &intercomm, MPI_ERRCODES_IGNORE);
56         } else {
57             intercomm = parentcomm;
58         }
59 
60         /* We now have a valid intercomm */
61 
62         MPI_Comm_remote_size(intercomm, &rsize);
63         MPI_Comm_size(intercomm, &size);
64         MPI_Comm_rank(intercomm, &rank);
65 
66         if (parentcomm == MPI_COMM_NULL) {
67             IF_VERBOSE(("parent rank %d alive.\n", rank));
68             /* Parent */
69             if (rsize != np) {
70                 errs++;
71                 printf("Did not create %d processes (got %d)\n", np, rsize);
72                 fflush(stdout);
73             }
74             if (rank == SENDER_RANK) {
75                 IF_VERBOSE(("sending int\n"));
76                 i = DATA_VALUE;
77                 MPI_Send(&i, 1, MPI_INT, RECEIVER_RANK, DATA_TAG, intercomm);
78                 MPI_Recv(&data, 1, MPI_INT, RECEIVER_RANK, DATA_TAG, intercomm, &status);
79                 if (data != i) {
80                     errs++;
81                 }
82             }
83             IF_VERBOSE(("disconnecting child communicator\n"));
84             MPI_Comm_disconnect(&intercomm);
85 
86             /* Errors cannot be sent back to the parent because there is no
87              * communicator connected to the children
88              * for (i=0; i<rsize; i++)
89              * {
90              * MPI_Recv(&err, 1, MPI_INT, i, 1, intercomm, MPI_STATUS_IGNORE);
91              * errs += err;
92              * }
93              */
94         } else {
95             IF_VERBOSE(("child rank %d alive.\n", rank));
96             /* Child */
97             if (size != np) {
98                 errs++;
99                 printf("(Child) Did not create %d processes (got %d)\n", np, size);
100                 fflush(stdout);
101             }
102 
103             if (rank == RECEIVER_RANK) {
104                 IF_VERBOSE(("receiving int\n"));
105                 i = -1;
106                 MPI_Recv(&i, 1, MPI_INT, SENDER_RANK, DATA_TAG, intercomm, &status);
107                 if (i != DATA_VALUE) {
108                     errs++;
109                     printf("expected %d but received %d\n", DATA_VALUE, i);
110                     fflush(stdout);
111                     MPI_Abort(intercomm, 1);
112                 }
113                 MPI_Send(&i, 1, MPI_INT, SENDER_RANK, DATA_TAG, intercomm);
114             }
115 
116             IF_VERBOSE(("disconnecting communicator\n"));
117             MPI_Comm_disconnect(&intercomm);
118 
119             /* Send the errs back to the parent process */
120             /* Errors cannot be sent back to the parent because there is no
121              * communicator connected to the parent */
122             /*MPI_Ssend(&errs, 1, MPI_INT, 0, 1, intercomm); */
123         }
124 
125         /* Note that the MTest_Finalize get errs only over COMM_WORLD */
126         /* Note also that both the parent and child will generate "No Errors"
127          * if both call MTest_Finalize */
128         if (parentcomm == MPI_COMM_NULL) {
129             MTest_Finalize(errs);
130         } else {
131             MPI_Finalize();
132         }
133     } else {
134         MTest_Finalize(errs);
135     }
136 
137     IF_VERBOSE(("calling finalize\n"));
138     return MTestReturnValue(errs);
139 }
140