1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
|
/*
* Copyright (C) by Argonne National Laboratory
* See COPYRIGHT in top-level directory
*/
#include "mpi.h"
#include "mpitest.h"
#include <stdio.h>
#include <stdlib.h>
#ifdef HAVE_STRINGS_H
#include <strings.h>
#endif
#ifdef HAVE_STRING_H
#include <string.h>
#endif
#ifdef HAVE_UNISTD_H
/* Needed for getcwd */
#include <unistd.h>
#endif
#include <assert.h>
/*
static char MTEST_Descrip[] = "A simple test of Comm_spawn with info";
*/
int main(int argc, char *argv[])
{
int errs = 0, err;
int rank, size, rsize, i;
int np = 2;
int errcodes[2];
MPI_Comm parentcomm, intercomm;
MPI_Status status;
MPI_Info spawninfo;
char curdir[1024], wd[1024], childwd[1024];
int can_spawn;
MTest_Init(&argc, &argv);
errs += MTestSpawnPossible(&can_spawn);
if (can_spawn) {
char *s = getcwd(curdir, sizeof(curdir));
assert(s != NULL);
MPI_Comm_get_parent(&parentcomm);
if (parentcomm == MPI_COMM_NULL) {
char *p;
/* Create 2 more processes. Make the working directory the
* directory above the current running directory */
strncpy(wd, curdir, sizeof(wd));
/* Lop off the last element of the directory */
p = wd + strlen(wd) - 1;
while (p > wd && *p != '/' && *p != '\\')
p--;
*p = 0;
MPI_Info_create(&spawninfo);
MPI_Info_set(spawninfo, (char *) "path", curdir);
MPI_Info_set(spawninfo, (char *) "wdir", wd);
MPI_Comm_spawn((char *) "spawninfo1", MPI_ARGV_NULL, np,
spawninfo, 0, MPI_COMM_WORLD, &intercomm, errcodes);
MPI_Info_free(&spawninfo);
} else
intercomm = parentcomm;
/* We now have a valid intercomm */
MPI_Comm_remote_size(intercomm, &rsize);
MPI_Comm_size(intercomm, &size);
MPI_Comm_rank(intercomm, &rank);
if (parentcomm == MPI_COMM_NULL) {
/* Parent */
if (rsize != np) {
errs++;
printf("Did not create %d processes (got %d)\n", np, rsize);
}
if (rank == 0) {
for (i = 0; i < rsize; i++) {
MPI_Send(&i, 1, MPI_INT, i, 0, intercomm);
}
/* We could use intercomm reduce to get the errors from the
* children, but we'll use a simpler loop to make sure that
* we get valid data */
for (i = 0; i < rsize; i++) {
MPI_Recv(&err, 1, MPI_INT, i, 1, intercomm, MPI_STATUS_IGNORE);
errs += err;
}
for (i = 0; i < rsize; i++) {
MPI_Recv(childwd, sizeof(childwd), MPI_CHAR, i, 2, intercomm,
MPI_STATUS_IGNORE);
if (strcmp(childwd, wd) != 0) {
printf("Expected a working dir of %s but child is in %s\n", wd, childwd);
errs++;
}
}
}
} else {
/* Child */
char cname[MPI_MAX_OBJECT_NAME];
int rlen;
if (size != np) {
errs++;
printf("(Child) Did not create %d processes (got %d)\n", np, size);
}
/* Check the name of the parent */
cname[0] = 0;
MPI_Comm_get_name(intercomm, cname, &rlen);
/* MPI-2 section 8.4 requires that the parent have this
* default name */
if (strcmp(cname, "MPI_COMM_PARENT") != 0) {
errs++;
printf("Name of parent is not correct\n");
if (rlen > 0 && cname[0]) {
printf(" Got %s but expected MPI_COMM_PARENT\n", cname);
} else {
printf(" Expected MPI_COMM_PARENT but no name set\n");
}
}
MPI_Recv(&i, 1, MPI_INT, 0, 0, intercomm, &status);
if (i != rank) {
errs++;
printf("Unexpected rank on child %d (%d)\n", rank, i);
}
/* Send our notion of the current directory to the parent */
MPI_Send(curdir, strlen(curdir) + 1, MPI_CHAR, 0, 2, intercomm);
/* Send the errs back to the parent process */
MPI_Ssend(&errs, 1, MPI_INT, 0, 1, intercomm);
}
/* It isn't necessary to free the intercomm, but it should not hurt */
MPI_Comm_free(&intercomm);
/* Note that the MTest_Finalize get errs only over COMM_WORLD */
/* Note also that both the parent and child will generate "No Errors"
* if both call MTest_Finalize */
if (parentcomm == MPI_COMM_NULL) {
MTest_Finalize(errs);
} else {
MPI_Finalize();
}
} else {
MTest_Finalize(errs);
}
return MTestReturnValue(errs);
}
|
