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

   1 #include "mpi.h"
   2 #include <stdio.h>
   3 #include <stdlib.h>
   4 #include "dtypes.h"
   5 #include "gcomm.h"
   6
   7 #if defined(NEEDS_STDLIB_PROTOTYPES)
   8 #include "protofix.h"
   9 #endif
  10
  11 int verbose = 0;
  12 /* Nonblocking ready persistent sends
  13
  14    This is similar to a test in allpair.f, but with an expanded range of
  15    datatypes and communicators.
  16
  17    This is like irsend.c, but with multiple starts of the same persistent
  18    request.
  19  */
  20
  21 int main( int argc, char **argv )
  22 {
  23     MPI_Datatype *types;
  24     void         **inbufs, **outbufs;
  25     char         **names;
  26     int          *counts, *bytesize, ntype;
  27     MPI_Comm     comms[20];
  28     int          ncomm = 20, rank, np, partner, tag;
  29     int          i, j, k, err, toterr, world_rank, errloc;
  30     MPI_Status   status;
  31     int          flag, index;
  32     char         *obuf;
  33     MPI_Request  requests[2];
  34     int          mcnt;
  35
  36
  37     MPI_Init( &argc, &argv );
  38
  39     AllocateForData( &types, &inbufs, &outbufs, &counts, &bytesize,
  40                      &names, &ntype );
  41     GenerateData( types, inbufs, outbufs, counts, bytesize, names, &ntype );
  42
  43     MPI_Comm_rank( MPI_COMM_WORLD, &world_rank );
  44     MakeComms( comms, 20, &ncomm, 0 );
  45
  46 /* Test over a wide range of datatypes and communicators */
  47     err = 0;
  48     for (i=0; i<ncomm; i++) {
  49         MPI_Comm_rank( comms[i], &rank );
  50         MPI_Comm_size( comms[i], &np );
  51         if (np < 2) continue;
  52         tag = i;
  53         for (j=0; j<ntype; j++) {
  54             if (world_rank == 0 && verbose)
  55                 fprintf( stdout, "Testing type %s\n", names[j] );
  56             /* This test does an irsend between both partners, with
  57                a sendrecv after the irecv used to guarentee that the
  58                irsend has a matching receive
  59                */
  60             if (rank == 0) {
  61                 partner = np - 1;
  62 #if 0
  63                 MPIR_PrintDatatypePack( stdout, counts[j], types[j], 0, 0 );
  64 #endif
  65                 obuf = outbufs[j];
  66                 for (k=0; k<bytesize[j]; k++)
  67                     obuf[k] = 0;
  68
  69                 MPI_Recv_init(outbufs[j], counts[j], types[j], partner, tag,
  70                               comms[i], &requests[0] );
  71                 MPI_Rsend_init( inbufs[j], counts[j], types[j], partner, tag,
  72                                 comms[i], &requests[1] );
  73
  74                 for (mcnt=0; mcnt<10; mcnt++) {
  75                     MPI_Start( &requests[0] );
  76                     MPI_Sendrecv( MPI_BOTTOM, 0, MPI_INT, partner, ncomm+i,
  77                                   MPI_BOTTOM, 0, MPI_INT, partner, ncomm+i,
  78                                   comms[i], &status );
  79                     MPI_Start( &requests[1] );
  80                     do {
  81                         MPI_Waitany( 2, requests, &index, &status );
  82                     } while (index != 0);
  83
  84                     if ((errloc = CheckData( inbufs[j], outbufs[j],
  85                                              bytesize[j] ))) {
  86                         char *p1, *p2;
  87                         fprintf( stderr,
  88     "Error in data with type %s (type %d on %d) at byte %d in %dth test\n",
  89                                  names[j], j, world_rank, errloc - 1, mcnt );
  90                         p1 = (char *)inbufs[j];
  91                         p2 = (char *)outbufs[j];
  92                         fprintf( stderr,
  93                         "Got %x expected %x\n", p1[errloc-1], p2[errloc-1] );
  94                         err++;
  95 #if 0
  96                         MPIR_PrintDatatypeUnpack( stderr, counts[j], types[j],
  97                                                   0, 0 );
  98 #endif
  99                     }
 100                     MPI_Waitall(1, &requests[1], &status );
 101                 }
 102                 MPI_Request_free( &requests[0] );
 103                 MPI_Request_free( &requests[1] );
 104             }
 105             else if (rank == np - 1) {
 106                 partner = 0;
 107                 obuf = outbufs[j];
 108                 for (k=0; k<bytesize[j]; k++)
 109                     obuf[k] = 0;
 110
 111                 MPI_Recv_init(outbufs[j], counts[j], types[j], partner, tag,
 112                               comms[i], &requests[0] );
 113                 MPI_Rsend_init( inbufs[j], counts[j], types[j], partner, tag,
 114                                 comms[i], &requests[1] );
 115                 for (mcnt=0; mcnt<10; mcnt++) {
 116                     MPI_Start( &requests[0] );
 117                     MPI_Sendrecv( MPI_BOTTOM, 0, MPI_INT, partner, ncomm+i,
 118                                   MPI_BOTTOM, 0, MPI_INT, partner, ncomm+i,
 119                                   comms[i], &status );
 120                     MPI_Start( &requests[1] );
 121                     /* Wait for irecv to complete */
 122                     do {
 123                         MPI_Test( &requests[0], &flag, &status );
 124                     } while (!flag);
 125                     if ((errloc = CheckData( inbufs[j], outbufs[j],
 126                                              bytesize[j] ))) {
 127                         char *p1, *p2;
 128                         fprintf( stderr,
 129                     "Error in data with type %s (type %d on %d) at byte %d\n",
 130                                  names[j], j, world_rank, errloc - 1 );
 131                         p1 = (char *)inbufs[j];
 132                         p2 = (char *)outbufs[j];
 133                         fprintf( stderr,
 134                         "Got %x expected %x\n", p1[errloc-1], p2[errloc-1] );
 135                         err++;
 136 #if 0
 137                         MPIR_PrintDatatypeUnpack( stderr, counts[j], types[j],
 138                                               0, 0 );
 139 #endif
 140                     }
 141
 142                     MPI_Waitall(1, &requests[1], &status );
 143                 }
 144                 MPI_Request_free( &requests[0] );
 145                 MPI_Request_free( &requests[1] );
 146             }
 147         }
 148     }
 149
 150     if (err > 0) {
 151         fprintf( stderr, "%d errors on %d\n", err, rank );
 152     }
 153     MPI_Allreduce( &err, &toterr, 1, MPI_INT, MPI_SUM, MPI_COMM_WORLD );
 154     if (world_rank == 0) {
 155         if (toterr == 0) {
 156             printf( " No Errors\n" );
 157         }
 158         else {
 159             printf (" Found %d errors\n", toterr );
 160         }
 161     }
 162     FreeDatatypes( types, inbufs, outbufs, counts, bytesize, names, ntype );
 163     FreeComms( comms, ncomm );
 164     MPI_Finalize();
 165
 166     return err;
 167 }