1 /* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil ; -*- */
3 * (C) 2001 by Argonne National Laboratory.
4 * See COPYRIGHT in top-level directory.
6 /* Warning - this test will fail for MPI_PROD & maybe MPI_SUM
7 * if more than 10 MPI processes are used. Loss of precision
8 * will occur as the number of processors is increased.
13 #include "smpi_cocci.h"
21 SMPI_VARINIT_GLOBAL(count, int);
22 SMPI_VARINIT_GLOBAL(size, int);
23 SMPI_VARINIT_GLOBAL(rank, int);
24 SMPI_VARINIT_GLOBAL(cerrcnt, int);
26 struct int_test { int a; int b; };
27 struct long_test { long a; int b; };
28 struct short_test { short a; int b; };
29 struct float_test { float a; int b; };
30 struct double_test { double a; int b; };
32 #define mpi_op2str(op) \
33 ((op == MPI_SUM) ? "MPI_SUM" : \
34 (op == MPI_PROD) ? "MPI_PROD" : \
35 (op == MPI_MAX) ? "MPI_MAX" : \
36 (op == MPI_MIN) ? "MPI_MIN" : \
37 (op == MPI_LOR) ? "MPI_LOR" : \
38 (op == MPI_LXOR) ? "MPI_LXOR" : \
39 (op == MPI_LAND) ? "MPI_LAND" : \
40 (op == MPI_BOR) ? "MPI_BOR" : \
41 (op == MPI_BAND) ? "MPI_BAND" : \
42 (op == MPI_BXOR) ? "MPI_BXOR" : \
43 (op == MPI_MAXLOC) ? "MPI_MAXLOC" : \
44 (op == MPI_MINLOC) ? "MPI_MINLOC" : \
47 /* calloc to avoid spurious valgrind warnings when "type" has padding bytes */
48 #define DECL_MALLOC_IN_OUT_SOL(type) \
49 type *in, *out, *sol; \
50 in = (type *) calloc(SMPI_VARGET_GLOBAL(count), sizeof(type)); \
51 out = (type *) calloc(SMPI_VARGET_GLOBAL(count), sizeof(type)); \
52 sol = (type *) calloc(SMPI_VARGET_GLOBAL(count), sizeof(type));
54 #define SET_INDEX_CONST(arr, val) \
57 for (i = 0; i < SMPI_VARGET_GLOBAL(count); i++) \
61 #define SET_INDEX_SUM(arr, val) \
64 for (i = 0; i < SMPI_VARGET_GLOBAL(count); i++) \
68 #define SET_INDEX_FACTOR(arr, val) \
71 for (i = 0; i < SMPI_VARGET_GLOBAL(count); i++) \
75 #define SET_INDEX_POWER(arr, val) \
78 for (i = 0; i < SMPI_VARGET_GLOBAL(count); i++) { \
80 for (j = 0; j < (val); j++) \
85 #define ERROR_CHECK_AND_FREE(lerrcnt, mpi_type, mpi_op) \
87 char name[MPI_MAX_OBJECT_NAME] = {0}; \
90 MPI_Type_get_name(mpi_type, name, &len); \
91 fprintf(stderr, "(%d) Error for type %s and op %s\n", \
92 SMPI_VARGET_GLOBAL(rank), name, mpi_op2str(mpi_op)); \
94 free(in); free(out); free(sol); \
97 /* The logic on the error check on MPI_Allreduce assumes that all
98 MPI_Allreduce routines return a failure if any do - this is sufficient
99 for MPI implementations that reject some of the valid op/datatype pairs
100 (and motivated this addition, as some versions of the IBM MPI
101 failed in just this way).
103 #define ALLREDUCE_AND_FREE(mpi_type, mpi_op, in, out, sol) \
105 int i, rc, lerrcnt = 0; \
106 rc = MPI_Allreduce(in, out, SMPI_VARGET_GLOBAL(count), mpi_type, mpi_op, MPI_COMM_WORLD); \
107 if (rc) { lerrcnt++; SMPI_VARGET_GLOBAL(cerrcnt)++; MTestPrintError( rc ); } \
109 for (i = 0; i < SMPI_VARGET_GLOBAL(count); i++) { \
110 if (out[i] != sol[i]) { \
111 SMPI_VARGET_GLOBAL(cerrcnt)++; \
116 ERROR_CHECK_AND_FREE(lerrcnt, mpi_type, mpi_op); \
119 #define STRUCT_ALLREDUCE_AND_FREE(mpi_type, mpi_op, in, out, sol) \
121 int i, rc, lerrcnt = 0; \
122 rc = MPI_Allreduce(in, out, SMPI_VARGET_GLOBAL(count), mpi_type, mpi_op, MPI_COMM_WORLD); \
123 if (rc) { lerrcnt++; SMPI_VARGET_GLOBAL(cerrcnt)++; MTestPrintError( rc ); } \
125 for (i = 0; i < SMPI_VARGET_GLOBAL(count); i++) { \
126 if ((out[i].a != sol[i].a) || (out[i].b != sol[i].b)) { \
127 SMPI_VARGET_GLOBAL(cerrcnt)++; \
132 ERROR_CHECK_AND_FREE(lerrcnt, mpi_type, mpi_op); \
135 #define SET_INDEX_STRUCT_CONST(arr, val, el) \
138 for (i = 0; i < SMPI_VARGET_GLOBAL(count); i++) \
142 #define SET_INDEX_STRUCT_SUM(arr, val, el) \
145 for (i = 0; i < SMPI_VARGET_GLOBAL(count); i++) \
146 arr[i].el = i + (val); \
149 #define sum_test1(type, mpi_type) \
151 DECL_MALLOC_IN_OUT_SOL(type); \
152 SET_INDEX_SUM(in, 0); \
153 SET_INDEX_FACTOR(sol, SMPI_VARGET_GLOBAL(size)); \
154 SET_INDEX_CONST(out, 0); \
155 ALLREDUCE_AND_FREE(mpi_type, MPI_SUM, in, out, sol); \
158 #define prod_test1(type, mpi_type) \
160 DECL_MALLOC_IN_OUT_SOL(type); \
161 SET_INDEX_SUM(in, 0); \
162 SET_INDEX_POWER(sol, SMPI_VARGET_GLOBAL(size)); \
163 SET_INDEX_CONST(out, 0); \
164 ALLREDUCE_AND_FREE(mpi_type, MPI_PROD, in, out, sol); \
167 #define max_test1(type, mpi_type) \
169 DECL_MALLOC_IN_OUT_SOL(type); \
170 SET_INDEX_SUM(in, SMPI_VARGET_GLOBAL(rank)); \
171 SET_INDEX_SUM(sol, SMPI_VARGET_GLOBAL(size) - 1); \
172 SET_INDEX_CONST(out, 0); \
173 ALLREDUCE_AND_FREE(mpi_type, MPI_MAX, in, out, sol); \
176 #define min_test1(type, mpi_type) \
178 DECL_MALLOC_IN_OUT_SOL(type); \
179 SET_INDEX_SUM(in, SMPI_VARGET_GLOBAL(rank)); \
180 SET_INDEX_SUM(sol, 0); \
181 SET_INDEX_CONST(out, 0); \
182 ALLREDUCE_AND_FREE(mpi_type, MPI_MIN, in, out, sol); \
185 #define const_test(type, mpi_type, mpi_op, val1, val2, val3) \
187 DECL_MALLOC_IN_OUT_SOL(type); \
188 SET_INDEX_CONST(in, (val1)); \
189 SET_INDEX_CONST(sol, (val2)); \
190 SET_INDEX_CONST(out, (val3)); \
191 ALLREDUCE_AND_FREE(mpi_type, mpi_op, in, out, sol); \
194 #define lor_test1(type, mpi_type) \
195 const_test(type, mpi_type, MPI_LOR, (SMPI_VARGET_GLOBAL(rank) & 0x1), (SMPI_VARGET_GLOBAL(size) > 1), 0)
196 #define lor_test2(type, mpi_type) \
197 const_test(type, mpi_type, MPI_LOR, 0, 0, 0)
198 #define lxor_test1(type, mpi_type) \
199 const_test(type, mpi_type, MPI_LXOR, (SMPI_VARGET_GLOBAL(rank) == 1), (SMPI_VARGET_GLOBAL(size) > 1), 0)
200 #define lxor_test2(type, mpi_type) \
201 const_test(type, mpi_type, MPI_LXOR, 0, 0, 0)
202 #define lxor_test3(type, mpi_type) \
203 const_test(type, mpi_type, MPI_LXOR, 1, (SMPI_VARGET_GLOBAL(size) & 0x1), 0)
204 #define land_test1(type, mpi_type) \
205 const_test(type, mpi_type, MPI_LAND, (SMPI_VARGET_GLOBAL(rank) & 0x1), 0, 0)
206 #define land_test2(type, mpi_type) \
207 const_test(type, mpi_type, MPI_LAND, 1, 1, 0)
208 #define bor_test1(type, mpi_type) \
209 const_test(type, mpi_type, MPI_BOR, (SMPI_VARGET_GLOBAL(rank) & 0x3), ((SMPI_VARGET_GLOBAL(size) < 3) ? SMPI_VARGET_GLOBAL(size) - 1 : 0x3), 0)
210 #define bxor_test1(type, mpi_type) \
211 const_test(type, mpi_type, MPI_BXOR, (SMPI_VARGET_GLOBAL(rank) == 1) * 0xf0, (SMPI_VARGET_GLOBAL(size) > 1) * 0xf0, 0)
212 #define bxor_test2(type, mpi_type) \
213 const_test(type, mpi_type, MPI_BXOR, 0, 0, 0)
214 #define bxor_test3(type, mpi_type) \
215 const_test(type, mpi_type, MPI_BXOR, ~0, (SMPI_VARGET_GLOBAL(size) &0x1) ? ~0 : 0, 0)
217 #define band_test1(type, mpi_type) \
219 DECL_MALLOC_IN_OUT_SOL(type); \
220 if (SMPI_VARGET_GLOBAL(rank) == SMPI_VARGET_GLOBAL(size)-1) { \
221 SET_INDEX_SUM(in, 0); \
224 SET_INDEX_CONST(in, ~0); \
226 SET_INDEX_SUM(sol, 0); \
227 SET_INDEX_CONST(out, 0); \
228 ALLREDUCE_AND_FREE(mpi_type, MPI_BAND, in, out, sol); \
231 #define band_test2(type, mpi_type) \
233 DECL_MALLOC_IN_OUT_SOL(type); \
234 if (SMPI_VARGET_GLOBAL(rank) == SMPI_VARGET_GLOBAL(size)-1) { \
235 SET_INDEX_SUM(in, 0); \
238 SET_INDEX_CONST(in, 0); \
240 SET_INDEX_CONST(sol, 0); \
241 SET_INDEX_CONST(out, 0); \
242 ALLREDUCE_AND_FREE(mpi_type, MPI_BAND, in, out, sol); \
245 #define maxloc_test(type, mpi_type) \
247 DECL_MALLOC_IN_OUT_SOL(type); \
248 SET_INDEX_STRUCT_SUM(in, SMPI_VARGET_GLOBAL(rank), a); \
249 SET_INDEX_STRUCT_CONST(in, SMPI_VARGET_GLOBAL(rank), b); \
250 SET_INDEX_STRUCT_SUM(sol, SMPI_VARGET_GLOBAL(size) - 1, a); \
251 SET_INDEX_STRUCT_CONST(sol, SMPI_VARGET_GLOBAL(size) - 1, b); \
252 SET_INDEX_STRUCT_CONST(out, 0, a); \
253 SET_INDEX_STRUCT_CONST(out, -1, b); \
254 STRUCT_ALLREDUCE_AND_FREE(mpi_type, MPI_MAXLOC, in, out, sol); \
257 #define minloc_test(type, mpi_type) \
259 DECL_MALLOC_IN_OUT_SOL(type); \
260 SET_INDEX_STRUCT_SUM(in, SMPI_VARGET_GLOBAL(rank), a); \
261 SET_INDEX_STRUCT_CONST(in, SMPI_VARGET_GLOBAL(rank), b); \
262 SET_INDEX_STRUCT_SUM(sol, 0, a); \
263 SET_INDEX_STRUCT_CONST(sol, 0, b); \
264 SET_INDEX_STRUCT_CONST(out, 0, a); \
265 SET_INDEX_STRUCT_CONST(out, -1, b); \
266 STRUCT_ALLREDUCE_AND_FREE(mpi_type, MPI_MINLOC, in, out, sol); \
269 #if MTEST_HAVE_MIN_MPI_VERSION(2,2)
270 #define test_types_set_mpi_2_2_integer(op,post) do { \
271 op##_test##post(int8_t, MPI_INT8_T); \
272 op##_test##post(int16_t, MPI_INT16_T); \
273 op##_test##post(int32_t, MPI_INT32_T); \
274 op##_test##post(int64_t, MPI_INT64_T); \
275 op##_test##post(uint8_t, MPI_UINT8_T); \
276 op##_test##post(uint16_t, MPI_UINT16_T); \
277 op##_test##post(uint32_t, MPI_UINT32_T); \
278 op##_test##post(uint64_t, MPI_UINT64_T); \
279 op##_test##post(MPI_Aint, MPI_AINT); \
280 op##_test##post(MPI_Offset, MPI_OFFSET); \
283 #define test_types_set_mpi_2_2_integer(op,post) do { } while (0)
286 #if MTEST_HAVE_MIN_MPI_VERSION(3,0)
287 #define test_types_set_mpi_3_0_integer(op,post) do { \
288 op##_test##post(MPI_SMPI_VARGET_GLOBAL(count), MPI_SMPI_VARGET_GLOBAL(count)); \
291 #define test_types_set_mpi_3_0_integer(op,post) do { } while (0)
294 #define test_types_set1(op, post) \
296 op##_test##post(int, MPI_INT); \
297 op##_test##post(long, MPI_LONG); \
298 op##_test##post(short, MPI_SHORT); \
299 op##_test##post(unsigned short, MPI_UNSIGNED_SHORT); \
300 op##_test##post(unsigned, MPI_UNSIGNED); \
301 op##_test##post(unsigned long, MPI_UNSIGNED_LONG); \
302 op##_test##post(unsigned char, MPI_UNSIGNED_CHAR); \
303 test_types_set_mpi_2_2_integer(op,post); \
304 test_types_set_mpi_3_0_integer(op,post); \
307 #define test_types_set2(op, post) \
309 test_types_set1(op, post); \
310 op##_test##post(float, MPI_FLOAT); \
311 op##_test##post(double, MPI_DOUBLE); \
314 #define test_types_set3(op, post) \
316 op##_test##post(unsigned char, MPI_BYTE); \
319 /* Make sure that we test complex and double complex, even if long
320 double complex is not available */
321 #if defined(USE_LONG_DOUBLE_COMPLEX)
323 #if MTEST_HAVE_MIN_MPI_VERSION(2,2) && defined(HAVE_FLOAT__COMPLEX) \
324 && defined(HAVE_DOUBLE__COMPLEX) \
325 && defined(HAVE_LONG_DOUBLE__COMPLEX)
326 #define test_types_set4(op, post) \
328 op##_test##post(float _Complex, MPI_C_FLOAT_COMPLEX); \
329 op##_test##post(double _Complex, MPI_C_DOUBLE_COMPLEX); \
330 if (MPI_C_LONG_DOUBLE_COMPLEX != MPI_DATATYPE_NULL) { \
331 op##_test##post(long double _Complex, MPI_C_LONG_DOUBLE_COMPLEX); \
336 #define test_types_set4(op, post) do { } while (0)
340 #if MTEST_HAVE_MIN_MPI_VERSION(2,2) && defined(HAVE_FLOAT__COMPLEX) \
341 && defined(HAVE_DOUBLE__COMPLEX)
342 #define test_types_set4(op, post) \
344 op##_test##post(float _Complex, MPI_C_FLOAT_COMPLEX); \
345 op##_test##post(double _Complex, MPI_C_DOUBLE_COMPLEX); \
349 #define test_types_set4(op, post) do { } while (0)
352 #endif /* defined(USE_LONG_DOUBLE_COMPLEX) */
354 #if MTEST_HAVE_MIN_MPI_VERSION(2,2) && defined(HAVE__BOOL)
355 #define test_types_set5(op, post) \
357 op##_test##post(_Bool, MPI_C_BOOL); \
361 #define test_types_set5(op, post) do { } while (0)
364 int main( int argc, char **argv )
366 MTest_Init( &argc, &argv );
368 MPI_Comm_size(MPI_COMM_WORLD, &SMPI_VARGET_GLOBAL(size));
369 MPI_Comm_rank(MPI_COMM_WORLD, &SMPI_VARGET_GLOBAL(rank));
371 if (SMPI_VARGET_GLOBAL(size) < 2) {
372 fprintf( stderr, "At least 2 processes required\n" );
373 MPI_Abort( MPI_COMM_WORLD, 1 );
377 /* Set errors return so that we can provide better information
378 should a routine reject one of the operand/datatype pairs */
379 MPI_Errhandler_set( MPI_COMM_WORLD, MPI_ERRORS_RETURN );
381 SMPI_VARGET_GLOBAL(count) = 10;
382 /* Allow an argument to override the count.
383 Note that the product tests may fail if the count is very large.
386 SMPI_VARGET_GLOBAL(count) = atoi( argv[1] );
387 if (SMPI_VARGET_GLOBAL(count) <= 0) {
388 fprintf( stderr, "Invalid count argument %s\n", argv[1] );
389 MPI_Abort( MPI_COMM_WORLD, 1 );
394 test_types_set2(sum, 1);
395 test_types_set2(prod, 1);
396 test_types_set2(max, 1);
397 test_types_set2(min, 1);
399 test_types_set1(lor, 1);
400 test_types_set1(lor, 2);
402 test_types_set1(lxor, 1);
403 test_types_set1(lxor, 2);
404 test_types_set1(lxor, 3);
406 test_types_set1(land, 1);
407 test_types_set1(land, 2);
409 test_types_set1(bor, 1);
410 test_types_set1(band, 1);
411 test_types_set1(band, 2);
413 test_types_set1(bxor, 1);
414 test_types_set1(bxor, 2);
415 test_types_set1(bxor, 3);
417 test_types_set3(bor, 1);
418 test_types_set3(band, 1);
419 test_types_set3(band, 2);
421 test_types_set3(bxor, 1);
422 test_types_set3(bxor, 2);
423 test_types_set3(bxor, 3);
425 test_types_set4(sum, 1);
426 test_types_set4(prod, 1);
428 test_types_set5(lor, 1);
429 test_types_set5(lor, 2);
430 test_types_set5(lxor, 1);
431 test_types_set5(lxor, 2);
432 test_types_set5(lxor, 3);
433 test_types_set5(land, 1);
434 test_types_set5(land, 2);
436 maxloc_test(struct int_test, MPI_2INT);
437 maxloc_test(struct long_test, MPI_LONG_INT);
438 maxloc_test(struct short_test, MPI_SHORT_INT);
439 maxloc_test(struct float_test, MPI_FLOAT_INT);
440 maxloc_test(struct double_test, MPI_DOUBLE_INT);
442 minloc_test(struct int_test, MPI_2INT);
443 minloc_test(struct long_test, MPI_LONG_INT);
444 minloc_test(struct short_test, MPI_SHORT_INT);
445 minloc_test(struct float_test, MPI_FLOAT_INT);
446 minloc_test(struct double_test, MPI_DOUBLE_INT);
448 MPI_Errhandler_set( MPI_COMM_WORLD, MPI_ERRORS_ARE_FATAL );
449 MTest_Finalize( SMPI_VARGET_GLOBAL(cerrcnt) );