2 * This file tests that message truncation errors are properly detected and
3 * handled (in particular, that data is NOT overwritten).
5 * This version checks the multiple completion routines
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 * );
17 int main( int argc, char **argv )
21 MPI_Comm comm, dupcomm;
24 MPI_Status statuses[4], status;
25 MPI_Request requests[4];
27 recvbuf1[10], recvbuf2[10], recvbuf3[10], recvbuf4[10];
29 MPI_Init( &argc, &argv );
30 MPI_Comm_rank( MPI_COMM_WORLD, &world_rank );
32 comm = MPI_COMM_WORLD;
33 MPI_Comm_dup( comm, &dupcomm );
34 MPI_Comm_rank( comm, &rank );
35 MPI_Comm_size( comm, &size );
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
49 error in status, err trunc
50 wait for tag = 1 if necessary
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)
58 /* Only return on the RECEIVERS side */
59 MPI_Errhandler_set( comm, MPI_ERRORS_RETURN );
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,
71 merr = MPI_Waitall( 2, requests, statuses );
72 if (merr != MPI_ERR_IN_STATUS) {
74 fprintf( stderr, "Did not return MPI_ERR_IN_STATUS\n" );
75 MPI_Abort( MPI_COMM_WORLD, 1 );
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) {
81 fprintf( stderr, "failed to complete legal request (1)\n" );
84 if (statuses[0].MPI_ERROR != MPI_SUCCESS) {
86 fprintf( stderr, "Could not complete legal send-receive\n" );
87 MPI_Abort( MPI_COMM_WORLD, 1 );
89 err += CheckRecvErr( merr, &statuses[1], recvbuf2, "Irecv" );
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,
106 merr = MPI_Waitall( 4, requests, statuses );
107 if (merr != MPI_ERR_IN_STATUS) {
109 fprintf( stderr, "Did not return MPI_ERR_IN_STATUS (4)\n" );
110 MPI_Abort( MPI_COMM_WORLD, 1 );
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) {
116 fprintf( stderr, "failed to complete legal request (1a)\n" );
119 /* Check for correct completion */
120 err += CheckRecvOk( &statuses[0], recvbuf1, 1, "4-1" );
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) {
126 fprintf( stderr, "failed to complete legal request (3a)\n" );
129 /* Check for correct completion */
130 err += CheckRecvOk( &statuses[3], recvbuf4, 4, "4-4" );
132 if (statuses[0].MPI_ERROR != MPI_SUCCESS) {
134 fprintf( stderr, "Could not complete legal send-receive-0\n" );
135 MPI_Abort( MPI_COMM_WORLD, 1 );
137 if (statuses[3].MPI_ERROR != MPI_SUCCESS) {
139 fprintf( stderr, "Could not complete legal send-receive-3\n" );
140 MPI_Abort( MPI_COMM_WORLD, 1 );
143 if (statuses[1].MPI_ERROR == MPI_ERR_PENDING) {
144 statuses[1].MPI_ERROR = MPI_Wait( &requests[1], &statuses[1] );
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] );
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,
155 else if (rank == size - 1) {
158 sendbuf[i] = 100 + i;
159 MPI_Sendrecv( MPI_BOTTOM, 0, MPI_INT, partner, 0,
160 MPI_BOTTOM, 0, MPI_INT, partner, 0,
162 MPI_Send( sendbuf, 1, MPI_INT, partner, 1, comm );
163 MPI_Send( sendbuf, 10, MPI_INT, partner, 2, comm );
165 MPI_Sendrecv( MPI_BOTTOM, 0, MPI_INT, partner, 0,
166 MPI_BOTTOM, 0, MPI_INT, partner, 0,
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,
176 MPI_Comm_free( &dupcomm );
178 MPI_Allreduce( &err, &toterr, 1, MPI_INT, MPI_SUM, MPI_COMM_WORLD );
179 if (world_rank == 0) {
181 printf( " No Errors\n" );
183 printf( "Found %d errors in Truncated Message Multiple Completion test\n", toterr );
189 int SetupRecvBuf( recvbuf )
198 int CheckRecvOk( status, recvbuf, tag, msg )
205 if (status->MPI_TAG != tag) {
207 fprintf( stderr, "Wrong tag; was %d should be %d (%s)\n",
208 status->MPI_TAG, tag, msg );
210 MPI_Get_count( status, MPI_INT, &count );
213 fprintf( stderr, "Wrong count; was %d expected 1 (%s)\n", count, msg );
218 int CheckRecvErr( merr, status, recvbuf, msg )
225 char buf[MPI_MAX_ERROR_STRING];
227 /* Get the MPI Error class from merr */
228 MPI_Error_class( merr, &class );
230 case MPI_ERR_TRUNCATE:
231 /* Check that data buf is ok */
232 if (recvbuf[1] != 2) {
235 "Receive buffer overwritten! Found %d in 2nd pos.\n",
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 );
246 "Unexpected error message for err in status for %s: %s\n",
251 /* Wrong error; get message and print */
252 MPI_Error_string( merr, buf, &rlen );
254 "Got unexpected error message from %s: %s\n", msg, buf );