test.c 4.47 KB
Newer Older
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
/* -*- Mode: C; c-basic-offset:4 ; -*- */
/*
 *
 *  (C) 2001 by Argonne National Laboratory.
 *      See COPYRIGHT in top-level directory.
 */

#include "mpiimpl.h"

/* -- Begin Profiling Symbol Block for routine MPI_Test */
#if defined(HAVE_PRAGMA_WEAK)
#pragma weak MPI_Test = PMPI_Test
#elif defined(HAVE_PRAGMA_HP_SEC_DEF)
#pragma _HP_SECONDARY_DEF PMPI_Test  MPI_Test
#elif defined(HAVE_PRAGMA_CRI_DUP)
#pragma _CRI duplicate MPI_Test as PMPI_Test
#endif
/* -- End Profiling Symbol Block */

/* Define MPICH_MPI_FROM_PMPI if weak symbols are not supported to build
   the MPI routines */
#ifndef MPICH_MPI_FROM_PMPI
#undef MPI_Test
#define MPI_Test PMPI_Test

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
#undef FUNCNAME
#define FUNCNAME MPIR_Test_impl
#undef FCNAME
#define FCNAME MPIU_QUOTE(FUNCNAME)
int MPIR_Test_impl(MPI_Request *request, int *flag, MPI_Status *status)
{
    int mpi_errno = MPI_SUCCESS;
    int active_flag;
    MPID_Request *request_ptr = NULL;

    /* If this is a null request handle, then return an empty status */
    if (*request == MPI_REQUEST_NULL) {
	MPIR_Status_set_empty(status);
	*flag = TRUE;
	goto fn_exit;
    }
    
    *flag = FALSE;

    MPID_Request_get_ptr( *request, request_ptr );

    /* If the request is already completed AND we want to avoid calling
     the progress engine, we could make the call to MPID_Progress_test
     conditional on the request not being completed. */
    mpi_errno = MPID_Progress_test();
    if (mpi_errno != MPI_SUCCESS) goto fn_fail;

    if (request_ptr->kind == MPID_UREQUEST && request_ptr->poll_fn != NULL) {
	mpi_errno = (request_ptr->poll_fn)(request_ptr->grequest_extra_state,
                                           status);
	if (mpi_errno != MPI_SUCCESS) goto fn_fail;
    }
    
    if (MPID_Request_is_complete(request_ptr)) {
	mpi_errno = MPIR_Request_complete(request, request_ptr, status,
					  &active_flag);
	*flag = TRUE;
	if (mpi_errno) MPIU_ERR_POP(mpi_errno);
	/* Fall through to the exit */
    }
        
 fn_exit:
    return mpi_errno;
 fn_fail:
    goto fn_exit;
}

73
74
75
76
#endif

#undef FUNCNAME
#define FUNCNAME MPI_Test
77
78
#undef FCNAME
#define FCNAME MPIU_QUOTE(FUNCNAME)
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
/*@
    MPI_Test  - Tests for the completion of a request

Input Parameter:
. request - MPI request (handle) 

Output Parameter:
+ flag - true if operation completed (logical) 
- status - status object (Status).  May be 'MPI_STATUS_IGNORE'.

.N ThreadSafe

.N waitstatus

.N Fortran

.N FortranStatus

.N Errors
.N MPI_SUCCESS
.N MPI_ERR_REQUEST
.N MPI_ERR_ARG
@*/
int MPI_Test(MPI_Request *request, int *flag, MPI_Status *status)
{
    int mpi_errno = MPI_SUCCESS;
105
106
    MPID_Request *request_ptr = NULL;
   MPID_MPI_STATE_DECL(MPID_STATE_MPI_TEST);
107
108
109

    MPIR_ERRTEST_INITIALIZED_ORDIE();
    
110
    MPIU_THREAD_CS_ENTER(ALLFUNC,);
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
    MPID_MPI_PT2PT_FUNC_ENTER(MPID_STATE_MPI_TEST);

    /* Validate parameters, especially handles needing to be converted */
#   ifdef HAVE_ERROR_CHECKING
    {
        MPID_BEGIN_ERROR_CHECKS;
        {
	    MPIR_ERRTEST_ARGNULL(request, "request", mpi_errno);
	    if (mpi_errno) goto fn_fail;
	    
	    MPIR_ERRTEST_REQUEST_OR_NULL(*request, mpi_errno);
	    if (mpi_errno) goto fn_fail;
	}
        MPID_END_ERROR_CHECKS;
    }
#   endif /* HAVE_ERROR_CHECKING */
    
    MPID_Request_get_ptr( *request, request_ptr );
    
130
   /* Validate parameters and objects (post conversion) */
131
132
133
134
135
#   ifdef HAVE_ERROR_CHECKING
    {
        MPID_BEGIN_ERROR_CHECKS;
        {
	    if (*request != MPI_REQUEST_NULL)
136
	    {
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
		/* Validate request_ptr */
		MPID_Request_valid_ptr( request_ptr, mpi_errno );
	    }
	    
	    MPIR_ERRTEST_ARGNULL(flag, "flag", mpi_errno);
	    /* NOTE: MPI_STATUS_IGNORE != NULL */
	    MPIR_ERRTEST_ARGNULL(status, "status", mpi_errno);
	    
            if (mpi_errno) goto fn_fail;
        }
        MPID_END_ERROR_CHECKS;
    }
#   endif /* HAVE_ERROR_CHECKING */

    /* ... body of routine ...  */

153
154
    mpi_errno = MPIR_Test_impl(request, flag, status);
    if (mpi_errno) goto fn_fail;
155
156
157
158
159
    
    /* ... end of body of routine ... */
    
  fn_exit:
	MPID_MPI_PT2PT_FUNC_EXIT(MPID_STATE_MPI_TEST);
160
	MPIU_THREAD_CS_EXIT(ALLFUNC,);
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
	return mpi_errno;
    
  fn_fail:
    /* --BEGIN ERROR HANDLING-- */
#   ifdef HAVE_ERROR_CHECKING
    {
	mpi_errno = MPIR_Err_create_code(
	    mpi_errno, MPIR_ERR_RECOVERABLE, FCNAME, __LINE__, MPI_ERR_OTHER, 
	    "**mpi_test",
	    "**mpi_test %p %p %p", request, flag, status);
    }
#   endif
    mpi_errno = MPIR_Err_return_comm(request_ptr ? request_ptr->comm : NULL, 
				     FCNAME, mpi_errno);
    goto fn_exit;
    /* --END ERROR HANDLING-- */
}