Add a (rather ingenious, if I do say so myself) program to test the
type-walking stuff in mpiwrap.c.



git-svn-id: svn://svn.valgrind.org/valgrind/trunk@5741 a5019735-40e9-0310-863c-91ae7b9d1cf9
diff --git a/auxprogs/Makefile.am b/auxprogs/Makefile.am
index 29a3add..3bbcb96 100644
--- a/auxprogs/Makefile.am
+++ b/auxprogs/Makefile.am
@@ -5,7 +5,7 @@
 
 noinst_SCRIPTS = gen-mdg DotToScc.hs primes.c \
 		gsl16test gsl16-badfree.patch gsl16-wavelet.patch \
-		ppcfround.c ppc64shifts.c mpiwrap.c
+		ppcfround.c ppc64shifts.c mpiwrap.c mpiwrap_type_test.c
 
 EXTRA_DIST = $(noinst_SCRIPTS)
 
diff --git a/auxprogs/mpiwrap_type_test.c b/auxprogs/mpiwrap_type_test.c
new file mode 100644
index 0000000..a11eb9e
--- /dev/null
+++ b/auxprogs/mpiwrap_type_test.c
@@ -0,0 +1,295 @@
+
+/* A test program to check whether the type-traversal functions in
+   mpiwrap.c (walk_type, walk_type_array) are correct.  It does this
+   by sending a message to itself, thereby discovering what areas of
+   memory the MPI implementation itself believe constitute the type.
+   It then gets walk_type to enumerate the type, and compares the
+   results. */
+
+#include <stdio.h>
+#include <stdlib.h>
+#include <assert.h>
+#include <dlfcn.h>
+#include "mpi.h"
+#include "valgrind/memcheck.h"
+
+typedef MPI_Datatype Ty;
+
+typedef  unsigned char  Bool;
+#define False ((Bool)0)
+#define True  ((Bool)1)
+
+static Ty tycon_Contiguous ( int count, Ty t )
+{
+   Ty t2;  
+   int r = MPI_Type_contiguous( count, t, &t2 );
+   assert(r == MPI_SUCCESS);
+   return t2;
+}
+
+static Ty tycon_Struct2 ( int d1, int copies1, Ty t1,
+                          int d2, int copies2, Ty t2 )
+{
+   int blocklens[2];
+   MPI_Aint disps[2];
+   Ty tys[2];
+   Ty tres;
+   int r;
+   blocklens[0] = copies1;
+   blocklens[1] = copies2;
+   disps[0] = d1;
+   disps[1] = d2;
+   tys[0] = t1;
+   tys[1] = t2;
+   r = MPI_Type_struct( 2, blocklens, disps, tys, &tres );
+   assert(r == MPI_SUCCESS);
+   return tres;
+}
+
+static Ty tycon_Vector ( int count, int blocklen, int stride, Ty t )
+{
+   Ty tres;
+   int r;
+   r = MPI_Type_vector( count, blocklen, stride, t, &tres );
+   assert(r == MPI_SUCCESS);
+   return tres;
+}
+
+static Ty tycon_HVector ( int count, int blocklen, MPI_Aint stride, Ty t )
+{
+   Ty tres;
+   int r;
+   r = MPI_Type_hvector( count, blocklen, stride, t, &tres );
+   assert(r == MPI_SUCCESS);
+   return tres;
+}
+
+static Ty tycon_Indexed2 ( int d1, int copies1, 
+                           int d2, int copies2, Ty t )
+{
+   int blocklens[2];
+   int disps[2];
+   Ty tres;
+   int r;
+   blocklens[0] = copies1;
+   blocklens[1] = copies2;
+   disps[0] = d1;
+   disps[1] = d2;
+   r = MPI_Type_indexed( 2, blocklens, disps, t, &tres );
+   assert(r == MPI_SUCCESS);
+   return tres;
+}
+
+static Ty tycon_HIndexed2 ( MPI_Aint d1, int copies1, 
+                            MPI_Aint d2, int copies2, Ty t )
+{
+   int blocklens[2];
+   MPI_Aint disps[2];
+   Ty tres;
+   int r;
+   blocklens[0] = copies1;
+   blocklens[1] = copies2;
+   disps[0] = d1;
+   disps[1] = d2;
+   r = MPI_Type_hindexed( 2, blocklens, disps, t, &tres );
+   assert(r == MPI_SUCCESS);
+   return tres;
+}
+
+//////////////////////////////////////
+
+char characterise ( unsigned char b )
+{
+   if (b == 0x00) return 'D';
+   if (b == 0xFF) return '.';
+   return '?';
+}
+
+void sendToMyself_callback( void* v, long n )
+{
+   long i;
+   unsigned char* p = (unsigned char*)v;
+   if (0) printf("callback: %p %ld\n", v, n);
+   for (i = 0; i < n; i++)
+      p[i] = 0x00;
+}
+
+void sendToMyself ( Bool commit_free, Ty* tyP, char* name )
+{
+   int i;
+   MPI_Aint lb, ub, ex;
+   MPI_Request req;
+   MPI_Status status;
+   char* sbuf;
+   char* rbuf;
+   char* rbuf_walk;
+   int r;
+
+   void* dl_handle = NULL;
+
+   /* C: what a fabulous functional programming language :-) */
+   void(*dl_walk_type)(void(*)(void*,long),char*,MPI_Datatype) = NULL;
+
+   /* NULL: gives a handle which is RTLD_GLOBAL syms in current
+      process image */
+   dl_handle = dlopen(NULL, RTLD_LAZY);
+   if (!dl_handle) {
+      printf("sendToMyself: can't dlopen current process image\n");
+      return;
+   }
+   dl_walk_type = dlsym(dl_handle, "mpiwrap_walk_type_EXTERNALLY_VISIBLE");
+   if (!dl_walk_type) {
+      printf("sendToMyself: can't find mpiwrap_walk_type_EXTERNALLY_VISIBLE"
+             " in current process image\n");
+      dlclose(dl_handle);
+      return;
+   }
+
+   printf("\nsendToMyself: trying %s\n", name);
+
+   if (commit_free) {
+      r = MPI_Type_commit( tyP );
+      assert(r == MPI_SUCCESS);
+   }
+
+   r = MPI_Type_lb( *tyP, &lb );
+   assert(r == MPI_SUCCESS);
+   r = MPI_Type_ub( *tyP, &ub );
+   assert(r == MPI_SUCCESS);
+   r = MPI_Type_extent( *tyP, &ex );
+   assert(r == MPI_SUCCESS);
+   printf("sendToMyself: ex=%d (%d,%d)\n", (int)ex, (int)lb, (int)ub);
+   assert(lb >= 0);
+
+   /* Fill send buffer with zeroes */
+   sbuf = malloc(ub);
+   assert(sbuf);
+   for (i = 0; i < ub; i++)
+      sbuf[i] = 0;
+
+   r = MPI_Isend( sbuf,1,*tyP, 0,99,MPI_COMM_WORLD, &req);
+   assert(r == MPI_SUCCESS);
+
+   /* Fill recv buffer with 0xFFs */
+   rbuf = malloc(ub);
+   assert(rbuf);
+   for (i = 0; i < ub; i++)
+      rbuf[i] = 0xFF;
+
+   r = MPI_Recv( rbuf,1,*tyP, 0,99,MPI_COMM_WORLD, &status);
+   assert(r == MPI_SUCCESS);
+
+   /* Now: rbuf should contain 0x00s where data was transferred and
+      undefined 0xFFs where data was not transferred.  Get
+      libmpiwrap.so to walk the transferred type, using the callback
+      to set to 0x00 all parts of rbuf_walk it considers part of the
+      type. */
+
+   rbuf_walk = malloc(ub);
+   assert(rbuf_walk);
+   for (i = 0; i < ub; i++)
+      rbuf_walk[i] = 0xFF;
+
+   dl_walk_type( sendToMyself_callback, rbuf_walk, *tyP );
+
+   dlclose(dl_handle);
+   if (commit_free) {
+      r = MPI_Type_free( tyP );
+      assert(r == MPI_SUCCESS);
+   }
+
+   for (i = 0; i < ub; i++) {
+      if (rbuf_walk[i] == rbuf[i])
+         continue; /* ok */
+      else
+         break; /* discrepancy */
+   }
+
+   if (i == ub)
+      printf("SUCCESS\n");
+   else
+      printf("FAILED\n");
+
+   for (i = 0; i < ub; i++)
+      printf("%c", characterise(rbuf_walk[i]));
+   printf("\n");
+
+   for (i = 0; i < ub; i++)
+      printf("%c", characterise(rbuf[i]));
+   printf("\n");
+}
+
+
+typedef  char*  Nm;
+
+int main ( int argc, char** argv )
+{
+    int rank, size;
+
+    if (!RUNNING_ON_VALGRIND) {
+       printf("error: this program must be run on valgrind\n");
+       return 1;
+    }
+
+    MPI_Init( &argc, &argv );
+    MPI_Comm_size( MPI_COMM_WORLD, &size );
+    MPI_Comm_rank( MPI_COMM_WORLD, &rank );
+
+    if (rank == 0) {
+
+    Ty t2, t3, t4, t5, t6, t7, t8, t9, t10, t11, t12, t13;
+    Nm n2, n3, n4, n5, n6, n7, n8, n9, n10, n11, n12, n13;
+
+    t2 = tycon_Contiguous(3, MPI_INT);
+    n2 = "Contig{3xINT}";
+
+    t3 = tycon_Struct2(3,2,MPI_CHAR, 8,1,MPI_DOUBLE);
+    n3 = "Struct{h3:2xCHAR, h8:1xDOUBLE}";
+
+    t4 = tycon_Struct2(0,1,MPI_CHAR, 8,1,tycon_Contiguous(4, MPI_DOUBLE));
+    n4 = "Struct{h0:1xCHAR, h8:1xContig{4xDOUBLE}}";
+
+    t5 = tycon_Contiguous(10, tycon_Struct2(1,1,MPI_CHAR, 4,1,MPI_FLOAT));
+    n5 = "Contig{10xStruct{h1:1xCHAR, h4:1xFLOAT}}";
+
+    t6 = tycon_Vector(5, 2,3,MPI_DOUBLE);
+    n6 = "Vector{5x(2,3)xDOUBLE}";
+
+    t7 = tycon_Vector(3, 1,2,MPI_LONG_DOUBLE);
+    n7 = "Vector{3x(1,2)xLONG_DOUBLE}";
+
+    t8 = tycon_HVector(4, 1,3,MPI_SHORT);
+    n8 = "HVector{4x(1,h3)xSHORT}";
+
+    t9 = tycon_Indexed2(1,3, 5,2, MPI_UNSIGNED_CHAR);
+    n9 = "Indexed{1:3x,5:2x,UNSIGNED_CHAR}";
+
+    t10 = tycon_HIndexed2(1,2, 6,3, MPI_UNSIGNED_SHORT);
+    n10 = "HIndexed{h1:2x,h6:3x,UNSIGNED_SHORT}";
+
+    t11 = MPI_LONG_INT;
+    n11 = "LONG_INT";
+
+    t12 = MPI_DOUBLE_INT;
+    n12 = "DOUBLE_INT";
+
+    t13 = MPI_SHORT_INT;
+    n13 = "SHORT_INT";
+
+    sendToMyself(True,  &t2,  n2);
+    sendToMyself(True,  &t3,  n3);
+    sendToMyself(True,  &t4,  n4);
+    sendToMyself(True,  &t5,  n5);
+    sendToMyself(True,  &t6,  n6);
+    sendToMyself(True,  &t7,  n7);
+    sendToMyself(True,  &t8,  n8);
+    sendToMyself(True,  &t9,  n9);
+    sendToMyself(True,  &t10, n10);
+    sendToMyself(False, &t11, n11);
+    sendToMyself(False, &t12, n12);
+    sendToMyself(False, &t13, n13);
+    }
+
+    MPI_Finalize();
+    return 0;
+}