teshsuite/smpi/mpich3-test/rma/fetch_and_op.c

   1 /* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil ; -*- */
   2 /*
   3  *
   4  *  (C) 2012 by Argonne National Laboratory.
   5  *      See COPYRIGHT in top-level directory.
   6  */
   7
   8 #include <stdio.h>
   9 #include <stdlib.h>
  10 #include <assert.h>
  11 #include <mpi.h>
  12 #include "mpitest.h"
  13 #include "squelch.h"
  14
  15 #define ITER 100
  16
  17 #if defined (FOP_TYPE_CHAR)
  18 #  define TYPE_C   char
  19 #  define TYPE_MPI MPI_CHAR
  20 #  define TYPE_FMT "%d"
  21 #elif defined (FOP_TYPE_SHORT)
  22 #  define TYPE_C   short
  23 #  define TYPE_MPI MPI_SHORT
  24 #  define TYPE_FMT "%d"
  25 #elif defined (FOP_TYPE_LONG)
  26 #  define TYPE_C   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"
  37 #else
  38 #  define TYPE_C   int
  39 #  define TYPE_MPI MPI_INT
  40 #  define TYPE_FMT "%d"
  41 #endif
  42
  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)
  46 {
  47     int i, rank, nproc;
  48
  49     MPI_Comm_rank(MPI_COMM_WORLD, &rank);
  50     MPI_Comm_size(MPI_COMM_WORLD, &nproc);
  51
  52     MPI_Win_lock(MPI_LOCK_EXCLUSIVE, rank, 0, win);
  53     for (i = 0; i < nproc; i++) {
  54         val_ptr[i] = 0;
  55         res_ptr[i] = -1;
  56     }
  57     MPI_Win_unlock(rank, win);
  58
  59     MPI_Barrier(MPI_COMM_WORLD);
  60 }
  61
  62 int main(int argc, char **argv)
  63 {
  64     int i, rank, nproc, mpi_type_size;
  65     int errors = 0, all_errors = 0;
  66     TYPE_C *val_ptr, *res_ptr;
  67     MPI_Win win;
  68
  69     MPI_Init(&argc, &argv);
  70
  71     MPI_Comm_rank(MPI_COMM_WORLD, &rank);
  72     MPI_Comm_size(MPI_COMM_WORLD, &nproc);
  73
  74     MPI_Type_size(TYPE_MPI, &mpi_type_size);
  75     assert(mpi_type_size == sizeof(TYPE_C));
  76
  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);
  81
  82     MPI_Win_create(val_ptr, sizeof(TYPE_C) * nproc, sizeof(TYPE_C), MPI_INFO_NULL, MPI_COMM_WORLD,
  83                    &win);
  84
  85     /* Test self communication */
  86
  87     reset_vars(val_ptr, res_ptr, win);
  88
  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);
  94     }
  95
  96     MPI_Win_lock(MPI_LOCK_EXCLUSIVE, rank, 0, win);
  97     if (CMP(val_ptr[0], ITER)) {
  98         SQUELCH(printf
  99                 ("%d->%d -- SELF: expected " TYPE_FMT ", got " TYPE_FMT "\n", rank, rank,
 100                  (TYPE_C) ITER, val_ptr[0]););
 101         errors++;
 102     }
 103     MPI_Win_unlock(rank, win);
 104
 105     /* Test neighbor communication */
 106
 107     reset_vars(val_ptr, res_ptr, win);
 108
 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)) {
 115             SQUELCH(printf
 116                     ("%d->%d -- NEIGHBOR[%d]: expected result " TYPE_FMT ", got " TYPE_FMT "\n",
 117                      (rank + 1) % nproc, rank, i, (TYPE_C) i, result););
 118             errors++;
 119         }
 120     }
 121
 122     MPI_Barrier(MPI_COMM_WORLD);
 123
 124     MPI_Win_lock(MPI_LOCK_EXCLUSIVE, rank, 0, win);
 125     if (CMP(val_ptr[0], ITER)) {
 126         SQUELCH(printf
 127                 ("%d->%d -- NEIGHBOR: expected " TYPE_FMT ", got " TYPE_FMT "\n",
 128                  (rank + 1) % nproc, rank, (TYPE_C) ITER, val_ptr[0]););
 129         errors++;
 130     }
 131     MPI_Win_unlock(rank, win);
 132
 133     /* Test contention */
 134
 135     reset_vars(val_ptr, res_ptr, win);
 136
 137     if (rank != 0) {
 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);
 143         }
 144     }
 145
 146     MPI_Barrier(MPI_COMM_WORLD);
 147
 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))) {
 151             SQUELCH(printf
 152                     ("*->%d - CONTENTION: expected=" TYPE_FMT " val=" TYPE_FMT "\n", rank,
 153                      (TYPE_C) ITER * (nproc - 1), val_ptr[0]););
 154             errors++;
 155         }
 156     }
 157     MPI_Win_unlock(rank, win);
 158
 159     /* Test all-to-all communication (fence) */
 160
 161     reset_vars(val_ptr, res_ptr, win);
 162
 163     for (i = 0; i < ITER; i++) {
 164         int j;
 165
 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);
 170         }
 171         MPI_Win_fence(MPI_MODE_NOSUCCEED, win);
 172         MPI_Barrier(MPI_COMM_WORLD);
 173
 174         for (j = 0; j < nproc; j++) {
 175             if (CMP(res_ptr[j], i * rank)) {
 176                 SQUELCH(printf
 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]););
 179                 errors++;
 180             }
 181         }
 182     }
 183
 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)) {
 188             SQUELCH(printf
 189                     ("%d->%d -- ALL-TO-ALL (FENCE): expected " TYPE_FMT ", got " TYPE_FMT "\n", i,
 190                      rank, (TYPE_C) ITER * i, val_ptr[i]););
 191             errors++;
 192         }
 193     }
 194     MPI_Win_unlock(rank, win);
 195
 196     /* Test all-to-all communication (lock-all) */
 197
 198     reset_vars(val_ptr, res_ptr, win);
 199
 200     for (i = 0; i < ITER; i++) {
 201         int j;
 202
 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);
 207         }
 208         MPI_Win_unlock_all(win);
 209         MPI_Barrier(MPI_COMM_WORLD);
 210
 211         for (j = 0; j < nproc; j++) {
 212             if (CMP(res_ptr[j], i * rank)) {
 213                 SQUELCH(printf
 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]););
 216                 errors++;
 217             }
 218         }
 219     }
 220
 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)) {
 225             SQUELCH(printf
 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]););
 228             errors++;
 229         }
 230     }
 231     MPI_Win_unlock(rank, win);
 232
 233     /* Test all-to-all communication (lock-all+flush) */
 234
 235     reset_vars(val_ptr, res_ptr, win);
 236
 237     for (i = 0; i < ITER; i++) {
 238         int j;
 239
 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);
 245         }
 246         MPI_Win_unlock_all(win);
 247         MPI_Barrier(MPI_COMM_WORLD);
 248
 249         for (j = 0; j < nproc; j++) {
 250             if (CMP(res_ptr[j], i * rank)) {
 251                 SQUELCH(printf
 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]););
 254                 errors++;
 255             }
 256         }
 257     }
 258
 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)) {
 263             SQUELCH(printf
 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]););
 266             errors++;
 267         }
 268     }
 269     MPI_Win_unlock(rank, win);
 270
 271     /* Test NO_OP (neighbor communication) */
 272
 273     MPI_Barrier(MPI_COMM_WORLD);
 274     reset_vars(val_ptr, res_ptr, win);
 275
 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);
 281
 282     for (i = 0; i < ITER; i++) {
 283         int target = (rank + 1) % nproc;
 284
 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);
 288
 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]););
 292             errors++;
 293         }
 294     }
 295
 296     /* Test NO_OP (self communication) */
 297
 298     MPI_Barrier(MPI_COMM_WORLD);
 299     reset_vars(val_ptr, res_ptr, win);
 300
 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);
 306
 307     for (i = 0; i < ITER; i++) {
 308         int target = rank;
 309
 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);
 313
 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]););
 317             errors++;
 318         }
 319     }
 320
 321     MPI_Win_free(&win);
 322
 323     MPI_Reduce(&errors, &all_errors, 1, MPI_INT, MPI_SUM, 0, MPI_COMM_WORLD);
 324
 325     if (rank == 0 && all_errors == 0)
 326         printf(" No Errors\n");
 327
 328     free(val_ptr);
 329     free(res_ptr);
 330     MPI_Finalize();
 331
 332     return 0;
 333 }