teshsuite/smpi/mpich3-test/coll/allred.c

   1 /* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil ; -*- */
   2 /*
   3  *  (C) 2001 by Argonne National Laboratory.
   4  *      See COPYRIGHT in top-level directory.
   5  */
   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.
   9  */
  10
  11 #include "mpi.h"
  12 #include "mpitest.h"
  13 #include <stdio.h>
  14 #include <stdlib.h>
  15 #include <string.h>
  16 #ifdef HAVE_STDINT_H
  17 #include <stdint.h>
  18 #endif
  19
  20 int count, size, rank;
  21 int cerrcnt;
  22
  23 struct int_test { int a; int b; };
  24 struct long_test { long a; int b; };
  25 struct short_test { short a; int b; };
  26 struct float_test { float a; int b; };
  27 struct double_test { double a; int b; };
  28
  29 #define mpi_op2str(op)                   \
  30     ((op == MPI_SUM) ? "MPI_SUM" :       \
  31      (op == MPI_PROD) ? "MPI_PROD" :     \
  32      (op == MPI_MAX) ? "MPI_MAX" :       \
  33      (op == MPI_MIN) ? "MPI_MIN" :       \
  34      (op == MPI_LOR) ? "MPI_LOR" :       \
  35      (op == MPI_LXOR) ? "MPI_LXOR" :     \
  36      (op == MPI_LAND) ? "MPI_LAND" :     \
  37      (op == MPI_BOR) ? "MPI_BOR" :       \
  38      (op == MPI_BAND) ? "MPI_BAND" :     \
  39      (op == MPI_BXOR) ? "MPI_BXOR" :     \
  40      (op == MPI_MAXLOC) ? "MPI_MAXLOC" : \
  41      (op == MPI_MINLOC) ? "MPI_MINLOC" : \
  42      "MPI_NO_OP")
  43
  44 /* calloc to avoid spurious valgrind warnings when "type" has padding bytes */
  45 #define DECL_MALLOC_IN_OUT_SOL(type)                 \
  46     type *in, *out, *sol;                            \
  47     in  = (type *) calloc(count, sizeof(type));      \
  48     out = (type *) calloc(count, sizeof(type));      \
  49     sol = (type *) calloc(count, sizeof(type));
  50
  51 #define SET_INDEX_CONST(arr, val)               \
  52     {                                           \
  53         int i;                                  \
  54         for (i = 0; i < count; i++)             \
  55             arr[i] = val;                       \
  56     }
  57
  58 #define SET_INDEX_SUM(arr, val)                 \
  59     {                                           \
  60         int i;                                  \
  61         for (i = 0; i < count; i++)             \
  62             arr[i] = i + val;                   \
  63     }
  64
  65 #define SET_INDEX_FACTOR(arr, val)              \
  66     {                                           \
  67         int i;                                  \
  68         for (i = 0; i < count; i++)             \
  69             arr[i] = i * (val);                 \
  70     }
  71
  72 #define SET_INDEX_POWER(arr, val)               \
  73     {                                           \
  74         int i, j;                               \
  75         for (i = 0; i < count; i++) {           \
  76             (arr)[i] = 1;                       \
  77             for (j = 0; j < (val); j++)         \
  78                 arr[i] *= i;                    \
  79         }                                       \
  80     }
  81
  82 #define ERROR_CHECK_AND_FREE(lerrcnt, mpi_type, mpi_op)                 \
  83     do {                                                                \
  84         char name[MPI_MAX_OBJECT_NAME] = {0};                           \
  85         int len = 0;                                                    \
  86         if (lerrcnt) {                                                  \
  87             MPI_Type_get_name(mpi_type, name, &len);                    \
  88             fprintf(stderr, "(%d) Error for type %s and op %s\n",       \
  89                     rank, name, mpi_op2str(mpi_op));                    \
  90         }                                                               \
  91         free(in); free(out); free(sol);                                 \
  92     } while(0)
  93
  94 /* The logic on the error check on MPI_Allreduce assumes that all
  95    MPI_Allreduce routines return a failure if any do - this is sufficient
  96    for MPI implementations that reject some of the valid op/datatype pairs
  97    (and motivated this addition, as some versions of the IBM MPI
  98    failed in just this way).
  99 */
 100 #define ALLREDUCE_AND_FREE(mpi_type, mpi_op, in, out, sol)              \
 101     {                                                                   \
 102         int i, rc, lerrcnt = 0;                                         \
 103         rc = MPI_Allreduce(in, out, count, mpi_type, mpi_op, MPI_COMM_WORLD); \
 104         if (rc) { lerrcnt++; cerrcnt++; MTestPrintError( rc ); }        \
 105         else {                                                          \
 106           for (i = 0; i < count; i++) {                                   \
 107               if (out[i] != sol[i]) {                                     \
 108                   cerrcnt++;                                              \
 109                   lerrcnt++;                                              \
 110               }                                                           \
 111            }                                                              \
 112         }                                                               \
 113         ERROR_CHECK_AND_FREE(lerrcnt, mpi_type, mpi_op);                \
 114     }
 115
 116 #define STRUCT_ALLREDUCE_AND_FREE(mpi_type, mpi_op, in, out, sol)       \
 117     {                                                                   \
 118         int i, rc, lerrcnt = 0;                                         \
 119         rc = MPI_Allreduce(in, out, count, mpi_type, mpi_op, MPI_COMM_WORLD); \
 120         if (rc) { lerrcnt++; cerrcnt++; MTestPrintError( rc ); }        \
 121         else {                                                            \
 122           for (i = 0; i < count; i++) {                                   \
 123               if ((out[i].a != sol[i].a) || (out[i].b != sol[i].b)) {     \
 124                   cerrcnt++;                                              \
 125                   lerrcnt++;                                              \
 126               }                                                           \
 127             }                                                             \
 128         }                                                               \
 129         ERROR_CHECK_AND_FREE(lerrcnt, mpi_type, mpi_op);                \
 130     }
 131
 132 #define SET_INDEX_STRUCT_CONST(arr, val, el)                    \
 133     {                                                           \
 134         int i;                                                  \
 135         for (i = 0; i < count; i++)                             \
 136             arr[i].el = val;                                    \
 137     }
 138
 139 #define SET_INDEX_STRUCT_SUM(arr, val, el)                      \
 140     {                                                           \
 141         int i;                                                  \
 142         for (i = 0; i < count; i++)                             \
 143             arr[i].el = i + (val);                              \
 144     }
 145
 146 #define sum_test1(type, mpi_type)                                       \
 147     {                                                                   \
 148         DECL_MALLOC_IN_OUT_SOL(type);                                   \
 149         SET_INDEX_SUM(in, 0);                                           \
 150         SET_INDEX_FACTOR(sol, size);                                    \
 151         SET_INDEX_CONST(out, 0);                                        \
 152         ALLREDUCE_AND_FREE(mpi_type, MPI_SUM, in, out, sol);            \
 153     }
 154
 155 #define prod_test1(type, mpi_type)                                      \
 156     {                                                                   \
 157         DECL_MALLOC_IN_OUT_SOL(type);                                   \
 158         SET_INDEX_SUM(in, 0);                                           \
 159         SET_INDEX_POWER(sol, size);                                     \
 160         SET_INDEX_CONST(out, 0);                                        \
 161         ALLREDUCE_AND_FREE(mpi_type, MPI_PROD, in, out, sol);           \
 162     }
 163
 164 #define max_test1(type, mpi_type)                                       \
 165     {                                                                   \
 166         DECL_MALLOC_IN_OUT_SOL(type);                                   \
 167         SET_INDEX_SUM(in, rank);                                        \
 168         SET_INDEX_SUM(sol, size - 1);                                   \
 169         SET_INDEX_CONST(out, 0);                                        \
 170         ALLREDUCE_AND_FREE(mpi_type, MPI_MAX, in, out, sol);            \
 171     }
 172
 173 #define min_test1(type, mpi_type)                                       \
 174     {                                                                   \
 175         DECL_MALLOC_IN_OUT_SOL(type);                                   \
 176         SET_INDEX_SUM(in, rank);                                        \
 177         SET_INDEX_SUM(sol, 0);                                          \
 178         SET_INDEX_CONST(out, 0);                                        \
 179         ALLREDUCE_AND_FREE(mpi_type, MPI_MIN, in, out, sol);            \
 180     }
 181
 182 #define const_test(type, mpi_type, mpi_op, val1, val2, val3)            \
 183     {                                                                   \
 184         DECL_MALLOC_IN_OUT_SOL(type);                                   \
 185         SET_INDEX_CONST(in, (val1));                                    \
 186         SET_INDEX_CONST(sol, (val2));                                   \
 187         SET_INDEX_CONST(out, (val3));                                   \
 188         ALLREDUCE_AND_FREE(mpi_type, mpi_op, in, out, sol);             \
 189     }
 190
 191 #define lor_test1(type, mpi_type)                                       \
 192     const_test(type, mpi_type, MPI_LOR, (rank & 0x1), (size > 1), 0)
 193 #define lor_test2(type, mpi_type)                       \
 194     const_test(type, mpi_type, MPI_LOR, 0, 0, 0)
 195 #define lxor_test1(type, mpi_type)                                      \
 196     const_test(type, mpi_type, MPI_LXOR, (rank == 1), (size > 1), 0)
 197 #define lxor_test2(type, mpi_type)                      \
 198     const_test(type, mpi_type, MPI_LXOR, 0, 0, 0)
 199 #define lxor_test3(type, mpi_type)                      \
 200     const_test(type, mpi_type, MPI_LXOR, 1, (size & 0x1), 0)
 201 #define land_test1(type, mpi_type)                              \
 202     const_test(type, mpi_type, MPI_LAND, (rank & 0x1), 0, 0)
 203 #define land_test2(type, mpi_type)                      \
 204     const_test(type, mpi_type, MPI_LAND, 1, 1, 0)
 205 #define bor_test1(type, mpi_type)                                       \
 206     const_test(type, mpi_type, MPI_BOR, (rank & 0x3), ((size < 3) ? size - 1 : 0x3), 0)
 207 #define bxor_test1(type, mpi_type)                                      \
 208     const_test(type, mpi_type, MPI_BXOR, (rank == 1) * 0xf0, (size > 1) * 0xf0, 0)
 209 #define bxor_test2(type, mpi_type)                      \
 210     const_test(type, mpi_type, MPI_BXOR, 0, 0, 0)
 211 #define bxor_test3(type, mpi_type)                      \
 212     const_test(type, mpi_type, MPI_BXOR, ~0, (size &0x1) ? ~0 : 0, 0)
 213
 214 #define band_test1(type, mpi_type)                                      \
 215     {                                                                   \
 216         DECL_MALLOC_IN_OUT_SOL(type);                                   \
 217         if (rank == size-1) {                                           \
 218             SET_INDEX_SUM(in, 0);                                       \
 219         }                                                               \
 220         else {                                                          \
 221             SET_INDEX_CONST(in, ~0);                                    \
 222         }                                                               \
 223         SET_INDEX_SUM(sol, 0);                                          \
 224         SET_INDEX_CONST(out, 0);                                        \
 225         ALLREDUCE_AND_FREE(mpi_type, MPI_BAND, in, out, sol);           \
 226     }
 227
 228 #define band_test2(type, mpi_type)                                      \
 229     {                                                                   \
 230         DECL_MALLOC_IN_OUT_SOL(type);                                   \
 231         if (rank == size-1) {                                           \
 232             SET_INDEX_SUM(in, 0);                                       \
 233         }                                                               \
 234         else {                                                          \
 235             SET_INDEX_CONST(in, 0);                                     \
 236         }                                                               \
 237         SET_INDEX_CONST(sol, 0);                                        \
 238         SET_INDEX_CONST(out, 0);                                        \
 239         ALLREDUCE_AND_FREE(mpi_type, MPI_BAND, in, out, sol);           \
 240     }
 241
 242 #define maxloc_test(type, mpi_type)                                     \
 243     {                                                                   \
 244         DECL_MALLOC_IN_OUT_SOL(type);                                   \
 245         SET_INDEX_STRUCT_SUM(in, rank, a);                              \
 246         SET_INDEX_STRUCT_CONST(in, rank, b);                            \
 247         SET_INDEX_STRUCT_SUM(sol, size - 1, a);                         \
 248         SET_INDEX_STRUCT_CONST(sol, size - 1, b);                       \
 249         SET_INDEX_STRUCT_CONST(out, 0, a);                              \
 250         SET_INDEX_STRUCT_CONST(out, -1, b);                             \
 251         STRUCT_ALLREDUCE_AND_FREE(mpi_type, MPI_MAXLOC, in, out, sol);   \
 252     }
 253
 254 #define minloc_test(type, mpi_type)                                     \
 255     {                                                                   \
 256         DECL_MALLOC_IN_OUT_SOL(type);                                   \
 257         SET_INDEX_STRUCT_SUM(in, rank, a);                              \
 258         SET_INDEX_STRUCT_CONST(in, rank, b);                            \
 259         SET_INDEX_STRUCT_SUM(sol, 0, a);                                \
 260         SET_INDEX_STRUCT_CONST(sol, 0, b);                              \
 261         SET_INDEX_STRUCT_CONST(out, 0, a);                              \
 262         SET_INDEX_STRUCT_CONST(out, -1, b);                             \
 263         STRUCT_ALLREDUCE_AND_FREE(mpi_type, MPI_MINLOC, in, out, sol);  \
 264     }
 265
 266 #if MTEST_HAVE_MIN_MPI_VERSION(2,2)
 267 #define test_types_set_mpi_2_2_integer(op,post) do {                \
 268         op##_test##post(int8_t, MPI_INT8_T);                        \
 269         op##_test##post(int16_t, MPI_INT16_T);                      \
 270         op##_test##post(int32_t, MPI_INT32_T);                      \
 271         op##_test##post(int64_t, MPI_INT64_T);                      \
 272         op##_test##post(uint8_t, MPI_UINT8_T);                      \
 273         op##_test##post(uint16_t, MPI_UINT16_T);                    \
 274         op##_test##post(uint32_t, MPI_UINT32_T);                    \
 275         op##_test##post(uint64_t, MPI_UINT64_T);                    \
 276         op##_test##post(MPI_Aint, MPI_AINT);                        \
 277         op##_test##post(MPI_Offset, MPI_OFFSET);                    \
 278     } while (0)
 279 #else
 280 #define test_types_set_mpi_2_2_integer(op,post) do { } while (0)
 281 #endif
 282
 283 #if MTEST_HAVE_MIN_MPI_VERSION(3,0)
 284 #define test_types_set_mpi_3_0_integer(op,post) do {                \
 285         op##_test##post(MPI_Count, MPI_COUNT);                      \
 286     } while (0)
 287 #else
 288 #define test_types_set_mpi_3_0_integer(op,post) do { } while (0)
 289 #endif
 290
 291 #define test_types_set1(op, post)                                   \
 292     {                                                               \
 293         op##_test##post(int, MPI_INT);                              \
 294         op##_test##post(long, MPI_LONG);                            \
 295         op##_test##post(short, MPI_SHORT);                          \
 296         op##_test##post(unsigned short, MPI_UNSIGNED_SHORT);        \
 297         op##_test##post(unsigned, MPI_UNSIGNED);                    \
 298         op##_test##post(unsigned long, MPI_UNSIGNED_LONG);          \
 299         op##_test##post(unsigned char, MPI_UNSIGNED_CHAR);          \
 300         test_types_set_mpi_2_2_integer(op,post);                    \
 301         test_types_set_mpi_3_0_integer(op,post);                    \
 302     }
 303
 304 #define test_types_set2(op, post)               \
 305     {                                           \
 306         test_types_set1(op, post);              \
 307         op##_test##post(float, MPI_FLOAT);      \
 308         op##_test##post(double, MPI_DOUBLE);    \
 309     }
 310
 311 #define test_types_set3(op, post)                                   \
 312     {                                                               \
 313         op##_test##post(unsigned char, MPI_BYTE);                   \
 314     }
 315
 316 /* Make sure that we test complex and double complex, even if long
 317    double complex is not available */
 318 #if defined(USE_LONG_DOUBLE_COMPLEX)
 319
 320 #if MTEST_HAVE_MIN_MPI_VERSION(2,2) && defined(HAVE_FLOAT__COMPLEX) \
 321     && defined(HAVE_DOUBLE__COMPLEX) \
 322     && defined(HAVE_LONG_DOUBLE__COMPLEX)
 323 #define test_types_set4(op, post)                                             \
 324     do {                                                                      \
 325         op##_test##post(float _Complex, MPI_C_FLOAT_COMPLEX);                 \
 326         op##_test##post(double _Complex, MPI_C_DOUBLE_COMPLEX);               \
 327         if (MPI_C_LONG_DOUBLE_COMPLEX != MPI_DATATYPE_NULL) {                 \
 328             op##_test##post(long double _Complex, MPI_C_LONG_DOUBLE_COMPLEX); \
 329         }                                                                     \
 330     } while (0)
 331
 332 #else
 333 #define test_types_set4(op, post) do { } while (0)
 334 #endif
 335 #else
 336
 337 #if MTEST_HAVE_MIN_MPI_VERSION(2,2) && defined(HAVE_FLOAT__COMPLEX) \
 338     && defined(HAVE_DOUBLE__COMPLEX)
 339 #define test_types_set4(op, post)                                         \
 340     do {                                                                  \
 341         op##_test##post(float _Complex, MPI_C_FLOAT_COMPLEX);             \
 342         op##_test##post(double _Complex, MPI_C_DOUBLE_COMPLEX);           \
 343     } while (0)
 344
 345 #else
 346 #define test_types_set4(op, post) do { } while (0)
 347 #endif
 348
 349 #endif /* defined(USE_LONG_DOUBLE_COMPLEX) */
 350
 351 #if MTEST_HAVE_MIN_MPI_VERSION(2,2) && defined(HAVE__BOOL)
 352 #define test_types_set5(op, post)           \
 353     do {                                    \
 354         op##_test##post(_Bool, MPI_C_BOOL); \
 355     } while (0)
 356
 357 #else
 358 #define test_types_set5(op, post) do { } while (0)
 359 #endif
 360
 361 int main( int argc, char **argv )
 362 {
 363     MTest_Init( &argc, &argv );
 364
 365     MPI_Comm_size(MPI_COMM_WORLD, &size);
 366     MPI_Comm_rank(MPI_COMM_WORLD, &rank);
 367
 368     if (size < 2) {
 369         fprintf( stderr, "At least 2 processes required\n" );
 370         MPI_Abort( MPI_COMM_WORLD, 1 );
 371         exit(1);
 372     }
 373
 374     /* Set errors return so that we can provide better information
 375        should a routine reject one of the operand/datatype pairs */
 376     MPI_Errhandler_set( MPI_COMM_WORLD, MPI_ERRORS_RETURN );
 377
 378     count = 10;
 379     /* Allow an argument to override the count.
 380        Note that the product tests may fail if the count is very large.
 381      */
 382     if (argc >= 2) {
 383         count = atoi( argv[1] );
 384         if  (count <= 0) {
 385             fprintf( stderr, "Invalid count argument %s\n", argv[1] );
 386             MPI_Abort( MPI_COMM_WORLD, 1 );
 387             exit(1);
 388         }
 389     }
 390
 391     test_types_set2(sum, 1);
 392     test_types_set2(prod, 1);
 393     test_types_set2(max, 1);
 394     test_types_set2(min, 1);
 395
 396     test_types_set1(lor, 1);
 397     test_types_set1(lor, 2);
 398
 399     test_types_set1(lxor, 1);
 400     test_types_set1(lxor, 2);
 401     test_types_set1(lxor, 3);
 402
 403     test_types_set1(land, 1);
 404     test_types_set1(land, 2);
 405
 406     test_types_set1(bor, 1);
 407     test_types_set1(band, 1);
 408     test_types_set1(band, 2);
 409
 410     test_types_set1(bxor, 1);
 411     test_types_set1(bxor, 2);
 412     test_types_set1(bxor, 3);
 413
 414     test_types_set3(bor, 1);
 415     test_types_set3(band, 1);
 416     test_types_set3(band, 2);
 417
 418     test_types_set3(bxor, 1);
 419     test_types_set3(bxor, 2);
 420     test_types_set3(bxor, 3);
 421
 422     test_types_set4(sum, 1);
 423     test_types_set4(prod, 1);
 424
 425     test_types_set5(lor, 1);
 426     test_types_set5(lor, 2);
 427     test_types_set5(lxor, 1);
 428     test_types_set5(lxor, 2);
 429     test_types_set5(lxor, 3);
 430     test_types_set5(land, 1);
 431     test_types_set5(land, 2);
 432
 433     maxloc_test(struct int_test, MPI_2INT);
 434     maxloc_test(struct long_test, MPI_LONG_INT);
 435     maxloc_test(struct short_test, MPI_SHORT_INT);
 436     maxloc_test(struct float_test, MPI_FLOAT_INT);
 437     maxloc_test(struct double_test, MPI_DOUBLE_INT);
 438
 439     minloc_test(struct int_test, MPI_2INT);
 440     minloc_test(struct long_test, MPI_LONG_INT);
 441     minloc_test(struct short_test, MPI_SHORT_INT);
 442     minloc_test(struct float_test, MPI_FLOAT_INT);
 443     minloc_test(struct double_test, MPI_DOUBLE_INT);
 444
 445     MPI_Errhandler_set( MPI_COMM_WORLD, MPI_ERRORS_ARE_FATAL );
 446     MTest_Finalize( cerrcnt );
 447     MPI_Finalize();
 448     return 0;
 449 }