1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
|
/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil ; -*- */
/*
*
* (C) 2003 by Argonne National Laboratory.
* See COPYRIGHT in top-level directory.
*/
#include "mpi.h"
#include <stdio.h>
#include "mpitest.h"
/*
static char MTEST_Descrip[] = "Test err in status return, using truncated \
messages for MPI_Waitsome";
*/
int main(int argc, char *argv[])
{
int errs = 0;
MPI_Comm comm;
MPI_Request r[2];
MPI_Status s[2];
int indices[2], outcount;
int errval, errclass;
int b1[20], b2[20], rank, size, src, dest, i, j;
MTest_Init(&argc, &argv);
/* Create some receive requests. tags 0-9 will succeed, tags 10-19
* will be used for ERR_TRUNCATE (fewer than 20 messages will be used) */
comm = MPI_COMM_WORLD;
MPI_Comm_rank(comm, &rank);
MPI_Comm_size(comm, &size);
src = 1;
dest = 0;
if (rank == dest) {
MPI_Errhandler_set(comm, MPI_ERRORS_RETURN);
errval = MPI_Irecv(b1, 10, MPI_INT, src, 0, comm, &r[0]);
if (errval) {
errs++;
MTestPrintError(errval);
printf("Error returned from Irecv\n");
}
errval = MPI_Irecv(b2, 10, MPI_INT, src, 10, comm, &r[1]);
if (errval) {
errs++;
MTestPrintError(errval);
printf("Error returned from Irecv\n");
}
/* Wait for Irecvs to be posted before the sender calls send. This
* prevents the operation from completing and returning an error in the
* Irecv. */
errval = MPI_Recv(NULL, 0, MPI_INT, src, 100, comm, MPI_STATUS_IGNORE);
if (errval) {
errs++;
MTestPrintError(errval);
printf("Error returned from Recv\n");
}
/* Wait for sends to complete at the sender before proceeding */
/* WARNING: This does not guarantee that the sends are ready to
* complete at the receiver. */
errval = MPI_Recv(NULL, 0, MPI_INT, src, 10, comm, MPI_STATUS_IGNORE);
if (errval) {
errs++;
MTestPrintError(errval);
printf("Error returned from Recv\n");
}
for (i = 0; i < 2; i++) {
s[i].MPI_ERROR = -1;
}
/* WARNING: The following assumes that Waitsome will complete both
* send/irecv pairs. This is *not* guaranteed by the MPI standard. */
errval = MPI_Waitsome(2, r, &outcount, indices, s);
MPI_Error_class(errval, &errclass);
if (errclass != MPI_ERR_IN_STATUS) {
errs++;
printf("Did not get ERR_IN_STATUS in Waitsome. Got %d.\n", errval);
}
else if (outcount != 2) {
errs++;
printf("Wait returned outcount = %d\n", outcount);
}
else {
/* Check for success */
for (i = 0; i < outcount; i++) {
j = i;
/* Indices is the request index */
if (s[j].MPI_TAG < 10 && s[j].MPI_ERROR != MPI_SUCCESS) {
errs++;
printf("correct msg had error class %d\n", s[j].MPI_ERROR);
}
else if (s[j].MPI_TAG >= 10 && s[j].MPI_ERROR == MPI_SUCCESS) {
errs++;
printf("truncated msg had MPI_SUCCESS\n");
}
}
}
}
else if (rank == src) {
/* Wait for Irecvs to be posted before the sender calls send */
MPI_Ssend(NULL, 0, MPI_INT, dest, 100, comm);
/* Send test messages, then send another message so that the test does
* not start until we are sure that the sends have begun */
MPI_Send(b1, 10, MPI_INT, dest, 0, comm);
MPI_Send(b2, 11, MPI_INT, dest, 10, comm);
/* Wait for sends to complete before proceeding to the testsome. */
MPI_Ssend(NULL, 0, MPI_INT, dest, 10, comm);
}
MTest_Finalize(errs);
MPI_Finalize();
return 0;
}
|
