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
