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
16typedef MPI_Datatype Ty;
17
18typedef  unsigned char  Bool;
19#define False ((Bool)0)
20#define True  ((Bool)1)
21
22void* walk_type_fn = NULL;
23
24static 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
32static 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
51static 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
60static 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
69static 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
85static 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
103char characterise ( unsigned char b )
104{
105   if (b == 0x00) return 'D';
106   if (b == 0xFF) return '.';
107   return '?';
108}
109
110void 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
119void 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
220typedef  char*  Nm;
221
222int 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