1 /*
2  * Copyright (C) by Argonne National Laboratory
3  *     See COPYRIGHT in top-level directory
4  */
5 
6 #include "mpi.h"
7 #include <stdio.h>
8 #include <stdlib.h>
9 #include "mpitest.h"
10 
11 /* Test the given operation within a Fence epoch */
12 #define TEST_FENCE_OP(op_name_, fcn_call_)                              \
13     do {                                                                \
14         err = fcn_call_                                                 \
15         if (err) {                                                      \
16             errs++;                                                     \
17             if (errs < 10) {                                            \
18                 MTestPrintErrorMsg("PROC_NULL to " op_name_, err);    \
19             }                                                           \
20         }                                                               \
21         err = MPI_Win_fence(0, win);                                  \
22         if (err) {                                                      \
23             errs++;                                                     \
24             if (errs < 10) {                                            \
25                 MTestPrintErrorMsg("Fence after " op_name_, err);     \
26             }                                                           \
27         }                                                               \
28     } while (0)
29 
30 
31 /* Test the given operation within a passive target epoch */
32 #define TEST_PT_OP(op_name_, fcn_call_)                                 \
33     do {                                                                \
34         err = MPI_Win_lock(MPI_LOCK_EXCLUSIVE, MPI_PROC_NULL, 0, win);  \
35         if (err) {                                                      \
36             errs++;                                                     \
37             if (errs < 10) {                                            \
38                 MTestPrintErrorMsg("Lock before" op_name_, err);      \
39             }                                                           \
40         }                                                               \
41         err = fcn_call_                                                 \
42         if (err) {                                                      \
43             errs++;                                                     \
44             if (errs < 10) {                                            \
45                 MTestPrintErrorMsg("PROC_NULL to " op_name_, err);    \
46             }                                                           \
47         }                                                               \
48         err = MPI_Win_unlock(MPI_PROC_NULL, win);                     \
49         if (err) {                                                      \
50             errs++;                                                     \
51             if (errs < 10) {                                            \
52                 MTestPrintErrorMsg("Unlock after " op_name_, err);    \
53             }                                                           \
54         }                                                               \
55     } while (0)
56 
57 
58 /* Test the given request-based operation within a passive target epoch */
59 #define TEST_REQ_OP(op_name_, req_, fcn_call_)                          \
60     do {                                                                \
61         err = MPI_Win_lock(MPI_LOCK_EXCLUSIVE, MPI_PROC_NULL, 0, win);  \
62         if (err) {                                                      \
63             errs++;                                                     \
64             if (errs < 10) {                                            \
65                 MTestPrintErrorMsg("Lock before" op_name_, err);      \
66             }                                                           \
67         }                                                               \
68         err = fcn_call_                                                 \
69         if (err) {                                                      \
70             errs++;                                                     \
71             if (errs < 10) {                                            \
72                 MTestPrintErrorMsg("PROC_NULL to " op_name_, err);    \
73             }                                                           \
74         }                                                               \
75         err = MPI_Win_unlock(MPI_PROC_NULL, win);                     \
76         if (err) {                                                      \
77             errs++;                                                     \
78             if (errs < 10) {                                            \
79                 MTestPrintErrorMsg("Unlock after " op_name_, err);    \
80             }                                                           \
81         }                                                               \
82         err = MPI_Wait(&req_, MPI_STATUS_IGNORE);                     \
83         if (err) {                                                      \
84             errs++;                                                     \
85             if (errs < 10) {                                            \
86                 MTestPrintErrorMsg("Wait after " op_name_, err);      \
87             }                                                           \
88         }                                                               \
89     } while (0)
90 
91 /*
92 static char MTEST_Descrip[] = "Test the MPI_PROC_NULL is a valid target";
93 */
94 
main(int argc,char * argv[])95 int main(int argc, char *argv[])
96 {
97     int errs = 0, err;
98     int rank, size;
99     int *buf, bufsize;
100     int *result;
101     int *rmabuf, rsize, rcount;
102     MPI_Comm comm;
103     MPI_Win win;
104     MPI_Request req;
105 
106     MTest_Init(&argc, &argv);
107 
108     bufsize = 256 * sizeof(int);
109     buf = (int *) malloc(bufsize);
110     if (!buf) {
111         fprintf(stderr, "Unable to allocated %d bytes\n", bufsize);
112         MPI_Abort(MPI_COMM_WORLD, 1);
113     }
114     result = (int *) malloc(bufsize);
115     if (!result) {
116         fprintf(stderr, "Unable to allocated %d bytes\n", bufsize);
117         MPI_Abort(MPI_COMM_WORLD, 1);
118     }
119     rcount = 16;
120     rsize = rcount * sizeof(int);
121     rmabuf = (int *) malloc(rsize);
122     if (!rmabuf) {
123         fprintf(stderr, "Unable to allocated %d bytes\n", rsize);
124         MPI_Abort(MPI_COMM_WORLD, 1);
125     }
126 
127     /* The following illustrates the use of the routines to
128      * run through a selection of communicators and datatypes.
129      * Use subsets of these for tests that do not involve combinations
130      * of communicators, datatypes, and counts of datatypes */
131     while (MTestGetIntracommGeneral(&comm, 1, 1)) {
132         if (comm == MPI_COMM_NULL)
133             continue;
134         /* Determine the sender and receiver */
135         MPI_Comm_rank(comm, &rank);
136         MPI_Comm_size(comm, &size);
137 
138         MPI_Win_create(buf, bufsize, sizeof(int), MPI_INFO_NULL, comm, &win);
139         /* To improve reporting of problems about operations, we
140          * change the error handler to errors return */
141         MPI_Win_set_errhandler(win, MPI_ERRORS_RETURN);
142 
143         /** TEST OPERATIONS USING ACTIVE TARGET (FENCE) SYNCHRONIZATION **/
144         MPI_Win_fence(0, win);
145 
146         TEST_FENCE_OP("Put",
147                       MPI_Put(rmabuf, rcount, MPI_INT, MPI_PROC_NULL, 0, rcount, MPI_INT, win);
148 );
149 
150         TEST_FENCE_OP("Get",
151                       MPI_Get(rmabuf, rcount, MPI_INT, MPI_PROC_NULL, 0, rcount, MPI_INT, win);
152 );
153         TEST_FENCE_OP("Accumulate",
154                       MPI_Accumulate(rmabuf, rcount, MPI_INT, MPI_PROC_NULL,
155                                      0, rcount, MPI_INT, MPI_SUM, win);
156 );
157         TEST_FENCE_OP("Get accumulate",
158                       MPI_Get_accumulate(rmabuf, rcount, MPI_INT, result,
159                                          rcount, MPI_INT, MPI_PROC_NULL, 0,
160                                          rcount, MPI_INT, MPI_SUM, win);
161 );
162         TEST_FENCE_OP("Fetch and op",
163                       MPI_Fetch_and_op(rmabuf, result, MPI_INT, MPI_PROC_NULL, 0, MPI_SUM, win);
164 );
165         TEST_FENCE_OP("Compare and swap",
166                       MPI_Compare_and_swap(rmabuf, &rank, result, MPI_INT, MPI_PROC_NULL, 0, win);
167 );
168 
169         /** TEST OPERATIONS USING PASSIVE TARGET SYNCHRONIZATION **/
170 
171         TEST_PT_OP("Put", MPI_Put(rmabuf, rcount, MPI_INT, MPI_PROC_NULL, 0, rcount, MPI_INT, win);
172 );
173         TEST_PT_OP("Get", MPI_Get(rmabuf, rcount, MPI_INT, MPI_PROC_NULL, 0, rcount, MPI_INT, win);
174 );
175         TEST_PT_OP("Accumulate",
176                    MPI_Accumulate(rmabuf, rcount, MPI_INT, MPI_PROC_NULL, 0, rcount, MPI_INT,
177                                   MPI_SUM, win);
178 );
179         TEST_PT_OP("Get accumulate",
180                    MPI_Get_accumulate(rmabuf, rcount, MPI_INT, result, rcount, MPI_INT,
181                                       MPI_PROC_NULL, 0, rcount, MPI_INT, MPI_SUM, win);
182 );
183         TEST_PT_OP("Fetch and op",
184                    MPI_Fetch_and_op(rmabuf, result, MPI_INT, MPI_PROC_NULL, 0, MPI_SUM, win);
185 );
186         TEST_PT_OP("Compare and swap",
187                    MPI_Compare_and_swap(rmabuf, &rank, result, MPI_INT, MPI_PROC_NULL, 0, win);
188 );
189 
190         /** TEST REQUEST-BASED OPERATIONS (PASSIVE TARGET ONLY) **/
191 
192         TEST_REQ_OP("Rput", req,
193                     MPI_Rput(rmabuf, rcount, MPI_INT, MPI_PROC_NULL, 0, rcount, MPI_INT, win, &req);
194 );
195         TEST_REQ_OP("Rget", req,
196                     MPI_Rget(rmabuf, rcount, MPI_INT, MPI_PROC_NULL, 0, rcount, MPI_INT, win, &req);
197 );
198         TEST_REQ_OP("Raccumulate", req,
199                     MPI_Raccumulate(rmabuf, rcount, MPI_INT, MPI_PROC_NULL, 0, rcount, MPI_INT,
200                                     MPI_SUM, win, &req);
201 );
202         TEST_REQ_OP("Rget_accumulate", req,
203                     MPI_Rget_accumulate(rmabuf, rcount, MPI_INT, result, rcount, MPI_INT,
204                                         MPI_PROC_NULL, 0, rcount, MPI_INT, MPI_SUM, win, &req);
205 );
206 
207         MPI_Win_free(&win);
208         MTestFreeComm(&comm);
209     }
210 
211     free(result);
212     free(buf);
213     free(rmabuf);
214     MTest_Finalize(errs);
215     return MTestReturnValue(errs);
216 }
217