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

   1 /*
   2  * This file tests that message truncation errors are properly detected and
   3  * handled (in particular, that data is NOT overwritten).
   4  *
   5  * This version checks the multiple completion routines
   6  */
   7
   8 #include "mpi.h"
   9 #include <stdio.h>
  10 #include <stdlib.h>
  11 #include "test.h"
  12 /* Prototypes for picky compilers */
  13 int SetupRecvBuf ( int * );
  14 int CheckRecvErr ( int, MPI_Status *, int *, const char * );
  15 int CheckRecvOk  ( MPI_Status *, int *, int, const char * );
  16
  17 int main( int argc, char **argv )
  18 {
  19     int         err = 0, toterr;
  20     int         world_rank;
  21     MPI_Comm    comm, dupcomm;
  22     int         rank, size;
  23     int         partner, merr;
  24     MPI_Status  statuses[4], status;
  25     MPI_Request requests[4];
  26     int         i, sendbuf[10],
  27                 recvbuf1[10], recvbuf2[10], recvbuf3[10], recvbuf4[10];
  28
  29     MPI_Init( &argc, &argv );
  30     MPI_Comm_rank( MPI_COMM_WORLD, &world_rank );
  31
  32     comm = MPI_COMM_WORLD;
  33     MPI_Comm_dup( comm, &dupcomm );
  34     MPI_Comm_rank( comm, &rank );
  35     MPI_Comm_size( comm, &size );
  36
  37 /* We'll RECEIVE into rank 0, just to simplify any debugging.  Just in
  38    case the MPI implementation tests for errors when the irecv is issued,
  39    we make sure that the matching sends don't occur until the receives
  40    are posted.
  41
  42    sender                                     receiver
  43                                               irecv(tag=1,count=1)
  44                                               irecv(tag=2,count=1)
  45    sendrecv                                   sendrecv
  46    send(tag=1,count=1)
  47    send(tag=2,count=10)
  48                                               waitall()
  49                                                 error in status, err trunc
  50                                                 wait for tag = 1 if necessary
  51    sendrecv                                   sendrecv
  52    Ditto, but with 2 truncated messages
  53    Ditto, but with testall. (not done yet)
  54    All of the above, but with waitsome/testsome (not done yet)
  55  */
  56
  57     if (rank == 0) {
  58         /* Only return on the RECEIVERS side */
  59         MPI_Errhandler_set( comm, MPI_ERRORS_RETURN );
  60         partner = size - 1;
  61
  62         SetupRecvBuf( recvbuf1 );
  63         SetupRecvBuf( recvbuf2 );
  64         merr = MPI_Irecv( recvbuf1, 1, MPI_INT, partner, 1, comm,
  65                           &requests[0] );  /* this will succeed */
  66         merr = MPI_Irecv( recvbuf2, 1, MPI_INT, partner, 2, comm,
  67                           &requests[1] );  /* this will fail */
  68         MPI_Sendrecv( MPI_BOTTOM, 0, MPI_INT, partner, 0,
  69                       MPI_BOTTOM, 0, MPI_INT, partner, 0,
  70                       dupcomm, &status );
  71         merr = MPI_Waitall( 2, requests, statuses );
  72         if (merr != MPI_ERR_IN_STATUS) {
  73             err++;
  74             fprintf( stderr, "Did not return MPI_ERR_IN_STATUS\n" );
  75             MPI_Abort( MPI_COMM_WORLD, 1 );
  76         }
  77         if (statuses[0].MPI_ERROR == MPI_ERR_PENDING) {
  78             /* information - first send is not yet complete */
  79             if ((statuses[0].MPI_ERROR = MPI_Wait( &requests[0], &statuses[0] )) == MPI_SUCCESS) {
  80                 err++;
  81                 fprintf( stderr, "failed to complete legal request (1)\n" );
  82             }
  83         }
  84         if (statuses[0].MPI_ERROR != MPI_SUCCESS) {
  85             err ++;
  86             fprintf( stderr, "Could not complete legal send-receive\n" );
  87             MPI_Abort( MPI_COMM_WORLD, 1 );
  88         }
  89         err += CheckRecvErr( merr, &statuses[1], recvbuf2, "Irecv" );
  90
  91         SetupRecvBuf( recvbuf1 );
  92         SetupRecvBuf( recvbuf2 );
  93         SetupRecvBuf( recvbuf3 );
  94         SetupRecvBuf( recvbuf4 );
  95         merr = MPI_Irecv( recvbuf1, 1, MPI_INT, partner, 1, comm,
  96                           &requests[0] );  /* this will succeed */
  97         merr = MPI_Irecv( recvbuf2, 1, MPI_INT, partner, 2, comm,
  98                           &requests[1] );  /* this will fail */
  99         merr = MPI_Irecv( recvbuf3, 1, MPI_INT, partner, 3, comm,
 100                           &requests[2] );  /* this will fail */
 101         merr = MPI_Irecv( recvbuf4, 1, MPI_INT, partner, 4, comm,
 102                           &requests[3] );  /* this will succeed */
 103         MPI_Sendrecv( MPI_BOTTOM, 0, MPI_INT, partner, 0,
 104                       MPI_BOTTOM, 0, MPI_INT, partner, 0,
 105                       dupcomm, &status );
 106         merr = MPI_Waitall( 4, requests, statuses );
 107         if (merr != MPI_ERR_IN_STATUS) {
 108             err++;
 109             fprintf( stderr, "Did not return MPI_ERR_IN_STATUS (4)\n" );
 110             MPI_Abort( MPI_COMM_WORLD, 1 );
 111         }
 112         if (statuses[0].MPI_ERROR == MPI_ERR_PENDING) {
 113             /* information - first send is not yet complete */
 114             if ((statuses[0].MPI_ERROR = MPI_Wait( &requests[0], &statuses[0] )) != MPI_SUCCESS) {
 115                 err++;
 116                 fprintf( stderr, "failed to complete legal request (1a)\n" );
 117             }
 118         }
 119         /* Check for correct completion */
 120         err += CheckRecvOk( &statuses[0], recvbuf1, 1, "4-1" );
 121
 122         if (statuses[3].MPI_ERROR == MPI_ERR_PENDING) {
 123             /* information - first send is not yet complete */
 124             if ((statuses[3].MPI_ERROR = MPI_Wait( &requests[3], &statuses[3] )) != MPI_SUCCESS) {
 125                 err++;
 126                 fprintf( stderr, "failed to complete legal request (3a)\n" );
 127             }
 128         }
 129         /* Check for correct completion */
 130         err += CheckRecvOk( &statuses[3], recvbuf4, 4, "4-4" );
 131
 132         if (statuses[0].MPI_ERROR != MPI_SUCCESS) {
 133             err ++;
 134             fprintf( stderr, "Could not complete legal send-receive-0\n" );
 135             MPI_Abort( MPI_COMM_WORLD, 1 );
 136         }
 137         if (statuses[3].MPI_ERROR != MPI_SUCCESS) {
 138             err ++;
 139             fprintf( stderr, "Could not complete legal send-receive-3\n" );
 140             MPI_Abort( MPI_COMM_WORLD, 1 );
 141         }
 142
 143         if (statuses[1].MPI_ERROR == MPI_ERR_PENDING) {
 144             statuses[1].MPI_ERROR = MPI_Wait( &requests[1], &statuses[1] );
 145         }
 146         err += CheckRecvErr( merr, &statuses[1], recvbuf2, "Irecv-2" );
 147         if (statuses[2].MPI_ERROR == MPI_ERR_PENDING) {
 148             statuses[2].MPI_ERROR = MPI_Wait( &requests[2], &statuses[2] );
 149         }
 150         err += CheckRecvErr( merr, &statuses[2], recvbuf3, "Irecv-3" );
 151         MPI_Sendrecv( MPI_BOTTOM, 0, MPI_INT, partner, 0,
 152                       MPI_BOTTOM, 0, MPI_INT, partner, 0,
 153                       dupcomm, &status );
 154     }
 155     else if (rank == size - 1) {
 156         partner = 0;
 157         for (i=0; i<10; i++)
 158             sendbuf[i] = 100 + i;
 159         MPI_Sendrecv( MPI_BOTTOM, 0, MPI_INT, partner, 0,
 160                       MPI_BOTTOM, 0, MPI_INT, partner, 0,
 161                       dupcomm, &status );
 162         MPI_Send( sendbuf, 1, MPI_INT, partner, 1, comm );
 163         MPI_Send( sendbuf, 10, MPI_INT, partner, 2, comm );
 164
 165         MPI_Sendrecv( MPI_BOTTOM, 0, MPI_INT, partner, 0,
 166                       MPI_BOTTOM, 0, MPI_INT, partner, 0,
 167                       dupcomm, &status );
 168         MPI_Send( sendbuf, 1, MPI_INT, partner, 1, comm );
 169         MPI_Send( sendbuf, 10, MPI_INT, partner, 2, comm );
 170         MPI_Send( sendbuf, 10, MPI_INT, partner, 3, comm );
 171         MPI_Send( sendbuf, 1, MPI_INT, partner, 4, comm );
 172         MPI_Sendrecv( MPI_BOTTOM, 0, MPI_INT, partner, 0,
 173                       MPI_BOTTOM, 0, MPI_INT, partner, 0,
 174                       dupcomm, &status );
 175     }
 176     MPI_Comm_free( &dupcomm );
 177
 178     MPI_Allreduce( &err, &toterr, 1, MPI_INT, MPI_SUM, MPI_COMM_WORLD );
 179     if (world_rank == 0) {
 180         if (toterr == 0)
 181             printf( " No Errors\n" );
 182         else
 183             printf( "Found %d errors in Truncated Message Multiple Completion test\n", toterr );
 184     }
 185     MPI_Finalize( );
 186     return toterr;
 187 }
 188
 189 int SetupRecvBuf( recvbuf )
 190 int *recvbuf;
 191 {
 192     int i;
 193     for (i=0; i<10; i++)
 194         recvbuf[i] = i+1;
 195     return 0;
 196 }
 197
 198 int CheckRecvOk( status, recvbuf, tag, msg )
 199 int        *recvbuf, tag;
 200 MPI_Status *status;
 201 const char       *msg;
 202 {
 203     int err = 0, count;
 204
 205     if (status->MPI_TAG != tag) {
 206         err++;
 207         fprintf( stderr, "Wrong tag; was %d should be %d (%s)\n",
 208                  status->MPI_TAG, tag, msg );
 209     }
 210     MPI_Get_count( status, MPI_INT, &count );
 211     if (count != 1) {
 212         err++;
 213         fprintf( stderr, "Wrong count; was %d expected 1 (%s)\n", count, msg );
 214     }
 215     return err;
 216 }
 217
 218 int CheckRecvErr( merr, status, recvbuf, msg )
 219 int        merr, *recvbuf;
 220 MPI_Status *status;
 221 const char       *msg;
 222 {
 223     int  class;
 224     int  err = 0, rlen;
 225     char buf[MPI_MAX_ERROR_STRING];
 226
 227 /* Get the MPI Error class from merr */
 228     MPI_Error_class( merr, &class );
 229     switch (class) {
 230     case MPI_ERR_TRUNCATE:
 231         /* Check that data buf is ok */
 232         if (recvbuf[1] != 2) {
 233             err++;
 234             fprintf( stderr,
 235                      "Receive buffer overwritten!  Found %d in 2nd pos.\n",
 236                      recvbuf[1] );
 237         }
 238         break;
 239
 240     case MPI_ERR_IN_STATUS:
 241         /* Check for correct message */
 242         MPI_Error_class(status->MPI_ERROR, &class);
 243         if (class != MPI_ERR_TRUNCATE) {
 244             MPI_Error_string( status->MPI_ERROR, buf, &rlen );
 245             fprintf( stderr,
 246                  "Unexpected error message for err in status for %s: %s\n",
 247                  msg, buf );
 248         }
 249         break;
 250     default:
 251         /* Wrong error; get message and print */
 252         MPI_Error_string( merr, buf, &rlen );
 253         fprintf( stderr,
 254                  "Got unexpected error message from %s: %s\n", msg, buf );
 255         err++;
 256     }
 257     return err;
 258 }