teshsuite/smpi/mpich-test/pt2pt/sendrecv4.c

   1 #include "mpi.h"
   2 #include <stdio.h>
   3 #include "dtypes.h"
   4 #include "gcomm.h"
   5
   6 #if defined(NEEDS_STDLIB_PROTOTYPES)
   7 #include "protofix.h"
   8 #endif
   9
  10 int verbose = 0;
  11 /*
  12    This program is from mpich/tsuite/pt2pt and should be changed there only.
  13    It needs gcomm and dtype from mpich/tsuite, and can be run with
  14    any number of processes > 1.
  15
  16    This version sends and receives EVERYTHING from MPI_BOTTOM, by putting
  17    the data into a structure.
  18
  19    This code isn't quite correct, since the MPI_Type_struct that is
  20    created for the type may not have the correct extent.
  21    One possible change is to make the struct type include the count, and
  22    send/receive one instance of the data item.
  23
  24    The GenerateData call should return extents; when the extent of the
  25    created structure doesn't match, we can at least issue an error message.
  26  */
  27 int main( int argc, char **argv )
  28 {
  29 MPI_Datatype *types;
  30 void         **inbufs, **outbufs;
  31 char         **names;
  32 int          *counts, *bytesize, ntype;
  33 MPI_Comm     comms[20];
  34 int          ncomm = 20, rank, np, partner, tag, count;
  35 int          i, j, k, err, toterr, world_rank, errloc;
  36 MPI_Status   status;
  37 char         *obuf;
  38 MPI_Datatype offsettype;
  39 int          blen;
  40 MPI_Aint     displ, extent, natural_extent;
  41
  42 MPI_Init( &argc, &argv );
  43
  44 AllocateForData( &types, &inbufs, &outbufs, &counts, &bytesize,
  45                  &names, &ntype );
  46 GenerateData( types, inbufs, outbufs, counts, bytesize, names, &ntype );
  47
  48 MPI_Comm_rank( MPI_COMM_WORLD, &world_rank );
  49 MakeComms( comms, 20, &ncomm, 0 );
  50
  51 /* Test over a wide range of datatypes and communicators */
  52 err = 0;
  53 for (i=0; i<ncomm; i++) {
  54     MPI_Comm_rank( comms[i], &rank );
  55     MPI_Comm_size( comms[i], &np );
  56     if (np < 2) continue;
  57     tag = i;
  58     for (j=0; j<ntype; j++) {
  59         if (world_rank == 0 && verbose)
  60             fprintf( stdout, "Testing type %s\n", names[j] );
  61         if (rank == 0) {
  62             MPI_Address( inbufs[j], &displ );
  63             blen = 1;
  64             MPI_Type_struct( 1, &blen, &displ, types + j, &offsettype );
  65             MPI_Type_commit( &offsettype );
  66             /* Warning: if the type has an explicit MPI_UB, then using a
  67                simple shift of the offset won't work.  For now, we skip
  68                types whose extents are negative; the correct solution is
  69                to add, where required, an explicit MPI_UB */
  70             MPI_Type_extent( offsettype, &extent );
  71             if (extent < 0) {
  72                 if (world_rank == 0)
  73                     fprintf( stdout,
  74                         "... skipping (appears to have explicit MPI_UB\n" );
  75                 MPI_Type_free( &offsettype );
  76                 continue;
  77                 }
  78             MPI_Type_extent( types[j], &natural_extent );
  79             if (natural_extent != extent) {
  80                 MPI_Type_free( &offsettype );
  81                 continue;
  82             }
  83             partner = np - 1;
  84 #if 0
  85                 MPIR_PrintDatatypePack( stdout, counts[j], offsettype,
  86                                           0, 0 );
  87 #endif
  88             MPI_Send( MPI_BOTTOM, counts[j], offsettype, partner, tag,
  89                       comms[i] );
  90             MPI_Type_free( &offsettype );
  91             }
  92         else if (rank == np-1) {
  93             partner = 0;
  94             obuf = outbufs[j];
  95             for (k=0; k<bytesize[j]; k++)
  96                 obuf[k] = 0;
  97             MPI_Address( outbufs[j], &displ );
  98             blen = 1;
  99             MPI_Type_struct( 1, &blen, &displ, types + j, &offsettype );
 100             MPI_Type_commit( &offsettype );
 101             /* Warning: if the type has an explicit MPI_UB, then using a
 102                simple shift of the offset won't work.  For now, we skip
 103                types whose extents are negative; the correct solution is
 104                to add, where required, an explicit MPI_UB */
 105             MPI_Type_extent( offsettype, &extent );
 106             if (extent < 0) {
 107                 MPI_Type_free( &offsettype );
 108                 continue;
 109                 }
 110             MPI_Type_extent( types[j], &natural_extent );
 111             if (natural_extent != extent) {
 112                 MPI_Type_free( &offsettype );
 113                 continue;
 114             }
 115             MPI_Recv( MPI_BOTTOM, counts[j], offsettype,
 116                      partner, tag, comms[i], &status );
 117             /* Test correct */
 118             MPI_Get_count( &status, types[j], &count );
 119             if (count != counts[j]) {
 120                 fprintf( stderr,
 121                         "Error in counts (got %d expected %d) with type %s\n",
 122                          count, counts[j], names[j] );
 123                 err++;
 124                 }
 125             if (status.MPI_SOURCE != partner) {
 126                 fprintf( stderr,
 127                         "Error in source (got %d expected %d) with type %s\n",
 128                          status.MPI_SOURCE, partner, names[j] );
 129                 err++;
 130                 }
 131             if ((errloc = CheckData( inbufs[j], outbufs[j], bytesize[j] ))) {
 132                 fprintf( stderr,
 133                   "Error in data with type %s (type %d on %d) at byte %d\n",
 134                          names[j], j, world_rank, errloc - 1 );
 135                 if (err < 10) {
 136                     /* Give details on only the first 10 errors */
 137                     unsigned char *in_p = (unsigned char *)inbufs[j],
 138                         *out_p = (unsigned char *)outbufs[j];
 139                     int jj;
 140                     jj = errloc - 1;
 141                     jj &= 0xfffffffc; /* lop off a few bits */
 142                     in_p += jj;
 143                     out_p += jj;
 144                     fprintf( stderr, "%02x%02x%02x%02x should be %02x%02x%02x%02x\n",
 145                              out_p[0], out_p[1], out_p[2], out_p[3],
 146                              in_p[0], in_p[1], in_p[2], in_p[3] );
 147                 }
 148                 err++;
 149 #if 0
 150                 MPIR_PrintDatatypeUnpack( stdout, counts[j], offsettype,
 151                                           0, 0 );
 152 #endif
 153                 }
 154             MPI_Type_free( &offsettype );
 155             }
 156         }
 157     }
 158 if (err > 0) {
 159     fprintf( stderr, "%d errors on %d\n", err, rank );
 160     }
 161 MPI_Allreduce( &err, &toterr, 1, MPI_INT, MPI_SUM, MPI_COMM_WORLD );
 162  if (world_rank == 0) {
 163      if (toterr == 0) {
 164          printf( " No Errors\n" );
 165      }
 166      else {
 167          printf (" Found %d errors\n", toterr );
 168      }
 169  }
 170
 171 FreeDatatypes( types, inbufs, outbufs, counts, bytesize, names, ntype );
 172 FreeComms( comms, ncomm );
 173 MPI_Finalize();
 174 return err;
 175 }