1 /* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil ; -*- */
4 * (C) 2012 by Argonne National Laboratory.
5 * See COPYRIGHT in top-level directory.
17 #if defined (FOP_TYPE_CHAR)
19 # define TYPE_MPI MPI_CHAR
20 # define TYPE_FMT "%d"
21 #elif defined (FOP_TYPE_SHORT)
23 # define TYPE_MPI MPI_SHORT
24 # define TYPE_FMT "%d"
25 #elif defined (FOP_TYPE_LONG)
27 # define TYPE_MPI MPI_LONG
28 # define TYPE_FMT "%ld"
29 #elif defined (FOP_TYPE_DOUBLE)
30 # define TYPE_C double
31 # define TYPE_MPI MPI_DOUBLE
32 # define TYPE_FMT "%f"
33 #elif defined (FOP_TYPE_LONG_DOUBLE)
34 # define TYPE_C long double
35 # define TYPE_MPI MPI_LONG_DOUBLE
36 # define TYPE_FMT "%Lf"
39 # define TYPE_MPI MPI_INT
40 # define TYPE_FMT "%d"
43 #define CMP(x, y) ((x - ((TYPE_C) (y))) > 1.0e-9)
44 void reset_vars(TYPE_C * val_ptr, TYPE_C * res_ptr, MPI_Win win);
45 void reset_vars(TYPE_C * val_ptr, TYPE_C * res_ptr, MPI_Win win)
49 MPI_Comm_rank(MPI_COMM_WORLD, &rank);
50 MPI_Comm_size(MPI_COMM_WORLD, &nproc);
52 MPI_Win_lock(MPI_LOCK_EXCLUSIVE, rank, 0, win);
53 for (i = 0; i < nproc; i++) {
57 MPI_Win_unlock(rank, win);
59 MPI_Barrier(MPI_COMM_WORLD);
62 int main(int argc, char **argv)
64 int i, rank, nproc, mpi_type_size;
65 int errors = 0, all_errors = 0;
66 TYPE_C *val_ptr, *res_ptr;
69 MPI_Init(&argc, &argv);
71 MPI_Comm_rank(MPI_COMM_WORLD, &rank);
72 MPI_Comm_size(MPI_COMM_WORLD, &nproc);
74 MPI_Type_size(TYPE_MPI, &mpi_type_size);
75 assert(mpi_type_size == sizeof(TYPE_C));
77 val_ptr = malloc(sizeof(TYPE_C) * nproc);
78 res_ptr = malloc(sizeof(TYPE_C) * nproc);
79 MTEST_VG_MEM_INIT(val_ptr, sizeof(TYPE_C) * nproc);
80 MTEST_VG_MEM_INIT(res_ptr, sizeof(TYPE_C) * nproc);
82 MPI_Win_create(val_ptr, sizeof(TYPE_C) * nproc, sizeof(TYPE_C), MPI_INFO_NULL, MPI_COMM_WORLD,
85 /* Test self communication */
87 reset_vars(val_ptr, res_ptr, win);
89 for (i = 0; i < ITER; i++) {
90 TYPE_C one = 1, result = -1;
91 MPI_Win_lock(MPI_LOCK_EXCLUSIVE, rank, 0, win);
92 MPI_Fetch_and_op(&one, &result, TYPE_MPI, rank, 0, MPI_SUM, win);
93 MPI_Win_unlock(rank, win);
96 MPI_Win_lock(MPI_LOCK_EXCLUSIVE, rank, 0, win);
97 if (CMP(val_ptr[0], ITER)) {
99 ("%d->%d -- SELF: expected " TYPE_FMT ", got " TYPE_FMT "\n", rank, rank,
100 (TYPE_C) ITER, val_ptr[0]););
103 MPI_Win_unlock(rank, win);
105 /* Test neighbor communication */
107 reset_vars(val_ptr, res_ptr, win);
109 for (i = 0; i < ITER; i++) {
110 TYPE_C one = 1, result = -1;
111 MPI_Win_lock(MPI_LOCK_EXCLUSIVE, (rank + 1) % nproc, 0, win);
112 MPI_Fetch_and_op(&one, &result, TYPE_MPI, (rank + 1) % nproc, 0, MPI_SUM, win);
113 MPI_Win_unlock((rank + 1) % nproc, win);
114 if (CMP(result, i)) {
116 ("%d->%d -- NEIGHBOR[%d]: expected result " TYPE_FMT ", got " TYPE_FMT "\n",
117 (rank + 1) % nproc, rank, i, (TYPE_C) i, result););
122 MPI_Barrier(MPI_COMM_WORLD);
124 MPI_Win_lock(MPI_LOCK_EXCLUSIVE, rank, 0, win);
125 if (CMP(val_ptr[0], ITER)) {
127 ("%d->%d -- NEIGHBOR: expected " TYPE_FMT ", got " TYPE_FMT "\n",
128 (rank + 1) % nproc, rank, (TYPE_C) ITER, val_ptr[0]););
131 MPI_Win_unlock(rank, win);
133 /* Test contention */
135 reset_vars(val_ptr, res_ptr, win);
138 for (i = 0; i < ITER; i++) {
139 TYPE_C one = 1, result;
140 MPI_Win_lock(MPI_LOCK_EXCLUSIVE, 0, 0, win);
141 MPI_Fetch_and_op(&one, &result, TYPE_MPI, 0, 0, MPI_SUM, win);
142 MPI_Win_unlock(0, win);
146 MPI_Barrier(MPI_COMM_WORLD);
148 MPI_Win_lock(MPI_LOCK_EXCLUSIVE, rank, 0, win);
149 if (rank == 0 && nproc > 1) {
150 if (CMP(val_ptr[0], ITER * (nproc - 1))) {
152 ("*->%d - CONTENTION: expected=" TYPE_FMT " val=" TYPE_FMT "\n", rank,
153 (TYPE_C) ITER * (nproc - 1), val_ptr[0]););
157 MPI_Win_unlock(rank, win);
159 /* Test all-to-all communication (fence) */
161 reset_vars(val_ptr, res_ptr, win);
163 for (i = 0; i < ITER; i++) {
166 MPI_Win_fence(MPI_MODE_NOPRECEDE, win);
167 for (j = 0; j < nproc; j++) {
168 TYPE_C rank_cnv = (TYPE_C) rank;
169 MPI_Fetch_and_op(&rank_cnv, &res_ptr[j], TYPE_MPI, j, rank, MPI_SUM, win);
171 MPI_Win_fence(MPI_MODE_NOSUCCEED, win);
172 MPI_Barrier(MPI_COMM_WORLD);
174 for (j = 0; j < nproc; j++) {
175 if (CMP(res_ptr[j], i * rank)) {
177 ("%d->%d -- ALL-TO-ALL (FENCE) [%d]: expected result " TYPE_FMT ", got "
178 TYPE_FMT "\n", rank, j, i, (TYPE_C) i * rank, res_ptr[j]););
184 MPI_Barrier(MPI_COMM_WORLD);
185 MPI_Win_lock(MPI_LOCK_EXCLUSIVE, rank, 0, win);
186 for (i = 0; i < nproc; i++) {
187 if (CMP(val_ptr[i], ITER * i)) {
189 ("%d->%d -- ALL-TO-ALL (FENCE): expected " TYPE_FMT ", got " TYPE_FMT "\n", i,
190 rank, (TYPE_C) ITER * i, val_ptr[i]););
194 MPI_Win_unlock(rank, win);
196 /* Test all-to-all communication (lock-all) */
198 reset_vars(val_ptr, res_ptr, win);
200 for (i = 0; i < ITER; i++) {
203 MPI_Win_lock_all(0, win);
204 for (j = 0; j < nproc; j++) {
205 TYPE_C rank_cnv = (TYPE_C) rank;
206 MPI_Fetch_and_op(&rank_cnv, &res_ptr[j], TYPE_MPI, j, rank, MPI_SUM, win);
208 MPI_Win_unlock_all(win);
209 MPI_Barrier(MPI_COMM_WORLD);
211 for (j = 0; j < nproc; j++) {
212 if (CMP(res_ptr[j], i * rank)) {
214 ("%d->%d -- ALL-TO-ALL (LOCK-ALL) [%d]: expected result " TYPE_FMT ", got "
215 TYPE_FMT "\n", rank, j, i, (TYPE_C) i * rank, res_ptr[j]););
221 MPI_Barrier(MPI_COMM_WORLD);
222 MPI_Win_lock(MPI_LOCK_EXCLUSIVE, rank, 0, win);
223 for (i = 0; i < nproc; i++) {
224 if (CMP(val_ptr[i], ITER * i)) {
226 ("%d->%d -- ALL-TO-ALL (LOCK-ALL): expected " TYPE_FMT ", got " TYPE_FMT "\n",
227 i, rank, (TYPE_C) ITER * i, val_ptr[i]););
231 MPI_Win_unlock(rank, win);
233 /* Test all-to-all communication (lock-all+flush) */
235 reset_vars(val_ptr, res_ptr, win);
237 for (i = 0; i < ITER; i++) {
240 MPI_Win_lock_all(0, win);
241 for (j = 0; j < nproc; j++) {
242 TYPE_C rank_cnv = (TYPE_C) rank;
243 MPI_Fetch_and_op(&rank_cnv, &res_ptr[j], TYPE_MPI, j, rank, MPI_SUM, win);
244 MPI_Win_flush(j, win);
246 MPI_Win_unlock_all(win);
247 MPI_Barrier(MPI_COMM_WORLD);
249 for (j = 0; j < nproc; j++) {
250 if (CMP(res_ptr[j], i * rank)) {
252 ("%d->%d -- ALL-TO-ALL (LOCK-ALL+FLUSH) [%d]: expected result " TYPE_FMT
253 ", got " TYPE_FMT "\n", rank, j, i, (TYPE_C) i * rank, res_ptr[j]););
259 MPI_Barrier(MPI_COMM_WORLD);
260 MPI_Win_lock(MPI_LOCK_EXCLUSIVE, rank, 0, win);
261 for (i = 0; i < nproc; i++) {
262 if (CMP(val_ptr[i], ITER * i)) {
264 ("%d->%d -- ALL-TO-ALL (LOCK-ALL+FLUSH): expected " TYPE_FMT ", got " TYPE_FMT
265 "\n", i, rank, (TYPE_C) ITER * i, val_ptr[i]););
269 MPI_Win_unlock(rank, win);
271 /* Test NO_OP (neighbor communication) */
273 MPI_Barrier(MPI_COMM_WORLD);
274 reset_vars(val_ptr, res_ptr, win);
276 MPI_Win_lock(MPI_LOCK_EXCLUSIVE, rank, 0, win);
277 for (i = 0; i < nproc; i++)
278 val_ptr[i] = (TYPE_C) rank;
279 MPI_Win_unlock(rank, win);
280 MPI_Barrier(MPI_COMM_WORLD);
282 for (i = 0; i < ITER; i++) {
283 int target = (rank + 1) % nproc;
285 MPI_Win_lock(MPI_LOCK_EXCLUSIVE, target, 0, win);
286 MPI_Fetch_and_op(NULL, res_ptr, TYPE_MPI, target, 0, MPI_NO_OP, win);
287 MPI_Win_unlock(target, win);
289 if (res_ptr[0] != (TYPE_C) target) {
290 SQUELCH(printf("%d->%d -- NOP[%d]: expected " TYPE_FMT ", got " TYPE_FMT "\n",
291 target, rank, i, (TYPE_C) target, res_ptr[0]););
296 /* Test NO_OP (self communication) */
298 MPI_Barrier(MPI_COMM_WORLD);
299 reset_vars(val_ptr, res_ptr, win);
301 MPI_Win_lock(MPI_LOCK_EXCLUSIVE, rank, 0, win);
302 for (i = 0; i < nproc; i++)
303 val_ptr[i] = (TYPE_C) rank;
304 MPI_Win_unlock(rank, win);
305 MPI_Barrier(MPI_COMM_WORLD);
307 for (i = 0; i < ITER; i++) {
310 MPI_Win_lock(MPI_LOCK_EXCLUSIVE, target, 0, win);
311 MPI_Fetch_and_op(NULL, res_ptr, TYPE_MPI, target, 0, MPI_NO_OP, win);
312 MPI_Win_unlock(target, win);
314 if (res_ptr[0] != (TYPE_C) target) {
315 SQUELCH(printf("%d->%d -- NOP_SELF[%d]: expected " TYPE_FMT ", got " TYPE_FMT "\n",
316 target, rank, i, (TYPE_C) target, res_ptr[0]););
323 MPI_Reduce(&errors, &all_errors, 1, MPI_INT, MPI_SUM, 0, MPI_COMM_WORLD);
325 if (rank == 0 && all_errors == 0)
326 printf(" No Errors\n");