Home | History | Annotate | Download | only in mpi 
      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 }
    378