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