mpi/mpiwrap_type_test.c

   1
   2 /* A test program to check whether the type-traversal functions in
   3    mpiwrap.c (walk_type, walk_type_array) are correct.  It does this
   4    by sending a message to itself, thereby discovering what areas of
   5    memory the MPI implementation itself believe constitute the type.
   6    It then gets walk_type to enumerate the type, and compares the
   7    results. */
   8
   9 #include <stdio.h>
  10 #include <stdlib.h>
  11 #include <string.h>
  12 #include <assert.h>
  13 #include "mpi.h"
  14 #include "../memcheck/memcheck.h"
  15
  16 typedef MPI_Datatype Ty;
  17
  18 typedef  unsigned char  Bool;
  19 #define False ((Bool)0)
  20 #define True  ((Bool)1)
  21
  22 void* walk_type_fn = NULL;
  23
  24 static Ty tycon_Contiguous ( int count, Ty t )
  25 {
  26    Ty t2;
  27    int r = MPI_Type_contiguous( count, t, &t2 );
  28    assert(r == MPI_SUCCESS);
  29    return t2;
  30 }
  31
  32 static Ty tycon_Struct2 ( int d1, int copies1, Ty t1,
  33                           int d2, int copies2, Ty t2 )
  34 {
  35    int blocklens[2];
  36    MPI_Aint disps[2];
  37    Ty tys[2];
  38    Ty tres;
  39    int r;
  40    blocklens[0] = copies1;
  41    blocklens[1] = copies2;
  42    disps[0] = d1;
  43    disps[1] = d2;
  44    tys[0] = t1;
  45    tys[1] = t2;
  46    r = MPI_Type_struct( 2, blocklens, disps, tys, &tres );
  47    assert(r == MPI_SUCCESS);
  48    return tres;
  49 }
  50
  51 static Ty tycon_Vector ( int count, int blocklen, int stride, Ty t )
  52 {
  53    Ty tres;
  54    int r;
  55    r = MPI_Type_vector( count, blocklen, stride, t, &tres );
  56    assert(r == MPI_SUCCESS);
  57    return tres;
  58 }
  59
  60 static Ty tycon_HVector ( int count, int blocklen, MPI_Aint stride, Ty t )
  61 {
  62    Ty tres;
  63    int r;
  64    r = MPI_Type_hvector( count, blocklen, stride, t, &tres );
  65    assert(r == MPI_SUCCESS);
  66    return tres;
  67 }
  68
  69 static Ty tycon_Indexed2 ( int d1, int copies1,
  70                            int d2, int copies2, Ty t )
  71 {
  72    int blocklens[2];
  73    int disps[2];
  74    Ty tres;
  75    int r;
  76    blocklens[0] = copies1;
  77    blocklens[1] = copies2;
  78    disps[0] = d1;
  79    disps[1] = d2;
  80    r = MPI_Type_indexed( 2, blocklens, disps, t, &tres );
  81    assert(r == MPI_SUCCESS);
  82    return tres;
  83 }
  84
  85 static Ty tycon_HIndexed2 ( MPI_Aint d1, int copies1,
  86                             MPI_Aint d2, int copies2, Ty t )
  87 {
  88    int blocklens[2];
  89    MPI_Aint disps[2];
  90    Ty tres;
  91    int r;
  92    blocklens[0] = copies1;
  93    blocklens[1] = copies2;
  94    disps[0] = d1;
  95    disps[1] = d2;
  96    r = MPI_Type_hindexed( 2, blocklens, disps, t, &tres );
  97    assert(r == MPI_SUCCESS);
  98    return tres;
  99 }
 100
 101 /* ------------------------------ */
 102
 103 char characterise ( unsigned char b )
 104 {
 105    if (b == 0x00) return 'D';
 106    if (b == 0xFF) return '.';
 107    return '?';
 108 }
 109
 110 void sendToMyself_callback( void* v, long n )
 111 {
 112    long i;
 113    unsigned char* p = (unsigned char*)v;
 114    if (0) printf("callback: %p %ld\n", v, n);
 115    for (i = 0; i < n; i++)
 116       p[i] = 0x00;
 117 }
 118
 119 void sendToMyself ( Bool commit_free, Ty* tyP, char* name )
 120 {
 121    int i;
 122    MPI_Aint lb, ub, ex;
 123    MPI_Request req;
 124    MPI_Status status;
 125    char* sbuf;
 126    char* rbuf;
 127    char* rbuf_walk;
 128    int r;
 129
 130    /* C: what a fabulous functional programming language :-) */
 131    void(*dl_walk_type)(void(*)(void*,long),char*,MPI_Datatype)
 132      = (void(*)(void(*)(void*,long),char*,MPI_Datatype))
 133        walk_type_fn;
 134
 135    if (!dl_walk_type) {
 136       printf("sendToMyself: can't establish type walker fn\n");
 137       return;
 138    }
 139
 140    printf("\nsendToMyself: trying %s\n", name);
 141
 142    if (commit_free) {
 143       r = MPI_Type_commit( tyP );
 144       assert(r == MPI_SUCCESS);
 145    }
 146
 147    r = MPI_Type_lb( *tyP, &lb );
 148    assert(r == MPI_SUCCESS);
 149    r = MPI_Type_ub( *tyP, &ub );
 150    assert(r == MPI_SUCCESS);
 151    r = MPI_Type_extent( *tyP, &ex );
 152    assert(r == MPI_SUCCESS);
 153    printf("sendToMyself: ex=%d (%d,%d)\n", (int)ex, (int)lb, (int)ub);
 154    assert(lb >= 0);
 155
 156    /* Fill send buffer with zeroes */
 157    sbuf = malloc(ub);
 158    assert(sbuf);
 159    for (i = 0; i < ub; i++)
 160       sbuf[i] = 0;
 161
 162    r = MPI_Isend( sbuf,1,*tyP, 0,99,MPI_COMM_WORLD, &req);
 163    assert(r == MPI_SUCCESS);
 164
 165    /* Fill recv buffer with 0xFFs */
 166    rbuf = malloc(ub);
 167    assert(rbuf);
 168    for (i = 0; i < ub; i++)
 169       rbuf[i] = 0xFF;
 170
 171    r = MPI_Recv( rbuf,1,*tyP, 0,99,MPI_COMM_WORLD, &status);
 172    assert(r == MPI_SUCCESS);
 173
 174    /* Now: rbuf should contain 0x00s where data was transferred and
 175       undefined 0xFFs where data was not transferred.  Get
 176       libmpiwrap.so to walk the transferred type, using the callback
 177       to set to 0x00 all parts of rbuf_walk it considers part of the
 178       type. */
 179
 180    rbuf_walk = malloc(ub);
 181    assert(rbuf_walk);
 182    for (i = 0; i < ub; i++)
 183       rbuf_walk[i] = 0xFF;
 184
 185    dl_walk_type( sendToMyself_callback, rbuf_walk, *tyP );
 186
 187    if (commit_free) {
 188       r = MPI_Type_free( tyP );
 189       assert(r == MPI_SUCCESS);
 190    }
 191
 192    for (i = 0; i < ub; i++) {
 193       if (rbuf_walk[i] == rbuf[i])
 194          continue; /* ok */
 195       else
 196          break; /* discrepancy */
 197    }
 198
 199    if (i == ub)
 200       printf("SUCCESS\n");
 201    else
 202       printf("FAILED\n");
 203
 204    printf(" libmpiwrap=");
 205    for (i = 0; i < ub; i++)
 206       printf("%c", characterise(rbuf_walk[i]));
 207    printf("\n");
 208
 209    printf("MPI library=");
 210    for (i = 0; i < ub; i++)
 211       printf("%c", characterise(rbuf[i]));
 212    printf("\n");
 213
 214    free(sbuf);
 215    free(rbuf);
 216    free(rbuf_walk);
 217 }
 218
 219
 220 typedef  char*  Nm;
 221
 222 int main ( int argc, char** argv )
 223 {
 224     int rank, size;
 225     char* opts;
 226
 227     if (!RUNNING_ON_VALGRIND) {
 228        printf("error: this program must be run on valgrind\n");
 229        return 1;
 230     }
 231     opts = getenv("MPIWRAP_DEBUG");
 232     if ((!opts) || NULL==strstr(opts, "initkludge")) {
 233        printf("error: program requires MPIWRAP_DEBUG=initkludge\n");
 234        return 1;
 235     }
 236
 237     /* Note: this trick doesn't work on 64-bit platforms,
 238        since MPI_Init returns int. */
 239     walk_type_fn = (void*)(long) MPI_Init( &argc, &argv );
 240     printf("mpiwrap_type_test: walk_type_fn = %p\n", walk_type_fn);
 241     assert(walk_type_fn);
 242
 243     MPI_Comm_size( MPI_COMM_WORLD, &size );
 244     MPI_Comm_rank( MPI_COMM_WORLD, &rank );
 245
 246     if (rank == 0) {
 247
 248 #define TRY(_commit_free,_type,_name)              \
 249        do { Ty ty = (_type);                       \
 250             Nm nm = (_name);                       \
 251             sendToMyself((_commit_free), &ty, nm); \
 252        } while (0)
 253
 254     TRY(True, tycon_Contiguous(3, MPI_INT),
 255               "Contig{3xINT}");
 256
 257     TRY(True, tycon_Struct2(3,2,MPI_CHAR, 8,1,MPI_DOUBLE),
 258               "Struct{h3:2xCHAR, h8:1xDOUBLE}");
 259
 260     TRY(True, tycon_Struct2(0,1,MPI_CHAR, 8,1,tycon_Contiguous(4, MPI_DOUBLE)),
 261               "Struct{h0:1xCHAR, h8:1xContig{4xDOUBLE}}");
 262
 263     TRY(True, tycon_Contiguous(10, tycon_Struct2(1,1,MPI_CHAR, 4,1,MPI_FLOAT)),
 264               "Contig{10xStruct{h1:1xCHAR, h4:1xFLOAT}}");
 265
 266     TRY(True, tycon_Vector(5, 2,3,MPI_DOUBLE),
 267               "Vector{5x(2,3)xDOUBLE}");
 268
 269     TRY(True, tycon_Vector(3, 1,2,MPI_LONG_DOUBLE),
 270               "Vector{3x(1,2)xLONG_DOUBLE}");
 271
 272     TRY(True, tycon_HVector(4, 1,3,MPI_SHORT),
 273               "HVector{4x(1,h3)xSHORT}");
 274
 275     TRY(True, tycon_Indexed2(1,3, 5,2, MPI_UNSIGNED_CHAR),
 276               "Indexed{1:3x,5:2x,UNSIGNED_CHAR}");
 277
 278     TRY(True,  tycon_HIndexed2(1,2, 6,3, MPI_UNSIGNED_SHORT),
 279               "HIndexed{h1:2x,h6:3x,UNSIGNED_SHORT}");
 280
 281     TRY(False, MPI_FLOAT_INT,        "FLOAT_INT");
 282     TRY(False, MPI_DOUBLE_INT,       "DOUBLE_INT");
 283     TRY(False, MPI_LONG_INT,         "LONG_INT");
 284     TRY(False, MPI_SHORT_INT,        "SHORT_INT");
 285     TRY(False, MPI_2INT,             "2INT");
 286     TRY(False, MPI_LONG_DOUBLE_INT,  "LONG_DOUBLE_INT");
 287
 288     /* The next 4 don't seem to exist on openmpi-1.2.2. */
 289
 290 #if defined(MPI_REAL8)
 291     TRY(False,  MPI_REAL8,            "REAL8");
 292 #endif
 293 #if defined(MPI_REAL4)
 294     TRY(False,  MPI_REAL4,            "REAL4");
 295 #endif
 296 #if defined(MPI_INTEGER8)
 297     TRY(False,  MPI_INTEGER8,         "INTEGER8");
 298 #endif
 299 #if defined(MPI_INTEGER4)
 300     TRY(False,  MPI_INTEGER4,         "INTEGER4");
 301 #endif
 302
 303     TRY(False, MPI_COMPLEX,           "COMPLEX");
 304     TRY(False, MPI_DOUBLE_COMPLEX,    "DOUBLE_COMPLEX");
 305
 306     // On openmpi-1.2.2 on x86-linux, sendToMyself bombs openmpi,
 307     // for some reason (openmpi thinks these all have zero size/extent
 308     // and therefore can't be MPI_Send-ed, AIUI).
 309     // TRY(False, MPI_LOGICAL,           "LOGICAL");
 310     // TRY(False, MPI_REAL,              "REAL");
 311     // TRY(False, MPI_DOUBLE_PRECISION,  "DOUBLE_PRECISION");
 312     // TRY(False, MPI_INTEGER,           "INTEGER");
 313     TRY(False, MPI_2INTEGER,          "2INTEGER");
 314     TRY(False, MPI_2COMPLEX,          "2COMPLEX");
 315     TRY(False, MPI_2DOUBLE_COMPLEX,   "2DOUBLE_COMPLEX");
 316     TRY(False, MPI_2REAL,             "2REAL");
 317     TRY(False, MPI_2DOUBLE_PRECISION, "2DOUBLE_PRECISION");
 318     TRY(False, MPI_CHARACTER,         "CHARACTER");
 319
 320     /* The following from a table in chapter 9 of the MPI2 spec
 321        date Nov 15, 2003, page 247. */
 322     TRY(False, MPI_PACKED, "PACKED");
 323     TRY(False, MPI_BYTE, "BYTE");
 324     TRY(False, MPI_CHAR, "CHAR");
 325     TRY(False, MPI_UNSIGNED_CHAR, "UNSIGNED_CHAR");
 326     TRY(False, MPI_SIGNED_CHAR, "SIGNED_CHAR");
 327     TRY(False, MPI_WCHAR, "WCHAR");
 328     TRY(False, MPI_SHORT, "SHORT");
 329     TRY(False, MPI_UNSIGNED_SHORT, "UNSIGNED_SHORT");
 330     TRY(False, MPI_INT, "INT");
 331     TRY(False, MPI_UNSIGNED, "UNSIGNED");
 332     TRY(False, MPI_LONG, "LONG");
 333     TRY(False, MPI_UNSIGNED_LONG, "UNSIGNED_LONG");
 334     TRY(False, MPI_FLOAT, "FLOAT");
 335     TRY(False, MPI_DOUBLE, "DOUBLE");
 336     TRY(False, MPI_LONG_DOUBLE, "LONG_DOUBLE");
 337     TRY(False, MPI_CHARACTER, "CHARACTER");
 338
 339     // Same deal as above
 340     // TRY(False, MPI_LOGICAL, "LOGICAL");
 341     // TRY(False, MPI_INTEGER, "INTEGER");
 342     // TRY(False, MPI_REAL, "REAL");
 343     // TRY(False, MPI_DOUBLE_PRECISION, "DOUBLE_PRECISION");
 344
 345     TRY(False, MPI_COMPLEX, "COMPLEX");
 346     TRY(False, MPI_DOUBLE_COMPLEX, "DOUBLE_COMPLEX");
 347 #if defined(MPI_INTEGER1)
 348     TRY(False, MPI_INTEGER1, "INTEGER1");
 349 #endif
 350 #if defined(MPI_INTEGER2)
 351     TRY(False, MPI_INTEGER2, "INTEGER2");
 352 #endif
 353 #if defined(MPI_INTEGER4)
 354     TRY(False, MPI_INTEGER4, "INTEGER4");
 355 #endif
 356 #if defined(MPI_INTEGER8)
 357     TRY(False, MPI_INTEGER8, "INTEGER8");
 358 #endif
 359     TRY(False, MPI_LONG_LONG, "LONG_LONG");
 360     TRY(False, MPI_UNSIGNED_LONG_LONG, "UNSIGNED_LONG_LONG");
 361 #if defined(MPI_REAL4)
 362     TRY(False, MPI_REAL4, "REAL4");
 363 #endif
 364 #if defined(MPI_REAL8)
 365     TRY(False, MPI_REAL8, "REAL8");
 366 #endif
 367 #if defined(MPI_REAL16)
 368     TRY(False, MPI_REAL16, "REAL16");
 369 #endif
 370
 371 #undef TRY
 372
 373     }
 374
 375     MPI_Finalize();
 376     return 0;
 377 }