87e4341c17ecbbf44bf70ba0bc8734f3f2e91274
[ghc.git] / testsuite / timeout / WinCBindings.hsc
1 {-# LANGUAGE CPP, ForeignFunctionInterface #-}
2 module WinCBindings where
3
4 #if defined(mingw32_HOST_OS)
5
6 ##if defined(i386_HOST_ARCH)
7 ## define WINDOWS_CCONV stdcall
8 ##elif defined(x86_64_HOST_ARCH)
9 ## define WINDOWS_CCONV ccall
10 ##else
11 ## error Unknown mingw32 arch
12 ##endif
13
14 import Foreign
15 import Foreign.C.Types
16 import System.Win32.File
17 import System.Win32.Types
18
19 #include <windows.h>
20
21 type LPPROCESS_INFORMATION = Ptr PROCESS_INFORMATION
22 data PROCESS_INFORMATION = PROCESS_INFORMATION
23     { piProcess :: HANDLE
24     , piThread :: HANDLE
25     , piProcessId :: DWORD
26     , piThreadId :: DWORD
27     } deriving Show
28
29 instance Storable PROCESS_INFORMATION where
30     sizeOf = const #size PROCESS_INFORMATION
31     alignment = sizeOf
32     poke buf pi = do
33         (#poke PROCESS_INFORMATION, hProcess)    buf (piProcess   pi)
34         (#poke PROCESS_INFORMATION, hThread)     buf (piThread    pi)
35         (#poke PROCESS_INFORMATION, dwProcessId) buf (piProcessId pi)
36         (#poke PROCESS_INFORMATION, dwThreadId)  buf (piThreadId  pi)
37
38     peek buf = do
39         vhProcess    <- (#peek PROCESS_INFORMATION, hProcess)    buf
40         vhThread     <- (#peek PROCESS_INFORMATION, hThread)     buf
41         vdwProcessId <- (#peek PROCESS_INFORMATION, dwProcessId) buf
42         vdwThreadId  <- (#peek PROCESS_INFORMATION, dwThreadId)  buf
43         return $ PROCESS_INFORMATION {
44             piProcess   = vhProcess,
45             piThread    = vhThread,
46             piProcessId = vdwProcessId,
47             piThreadId  = vdwThreadId}
48
49 type LPSTARTUPINFO = Ptr STARTUPINFO
50 data STARTUPINFO = STARTUPINFO
51     { siCb :: DWORD
52     , siDesktop :: LPTSTR
53     , siTitle :: LPTSTR
54     , siX :: DWORD
55     , siY :: DWORD
56     , siXSize :: DWORD
57     , siYSize :: DWORD
58     , siXCountChars :: DWORD
59     , siYCountChars :: DWORD
60     , siFillAttribute :: DWORD
61     , siFlags :: DWORD
62     , siShowWindow :: WORD
63     , siStdInput :: HANDLE
64     , siStdOutput :: HANDLE
65     , siStdError :: HANDLE
66     } deriving Show
67
68 instance Storable STARTUPINFO where
69     sizeOf = const #size STARTUPINFO
70     alignment = sizeOf
71     poke buf si = do
72         (#poke STARTUPINFO, cb)              buf (siCb si)
73         (#poke STARTUPINFO, lpDesktop)       buf (siDesktop si)
74         (#poke STARTUPINFO, lpTitle)         buf (siTitle si)
75         (#poke STARTUPINFO, dwX)             buf (siX si)
76         (#poke STARTUPINFO, dwY)             buf (siY si)
77         (#poke STARTUPINFO, dwXSize)         buf (siXSize si)
78         (#poke STARTUPINFO, dwYSize)         buf (siYSize si)
79         (#poke STARTUPINFO, dwXCountChars)   buf (siXCountChars si)
80         (#poke STARTUPINFO, dwYCountChars)   buf (siYCountChars si)
81         (#poke STARTUPINFO, dwFillAttribute) buf (siFillAttribute si)
82         (#poke STARTUPINFO, dwFlags)         buf (siFlags si)
83         (#poke STARTUPINFO, wShowWindow)     buf (siShowWindow si)
84         (#poke STARTUPINFO, hStdInput)       buf (siStdInput si)
85         (#poke STARTUPINFO, hStdOutput)      buf (siStdOutput si)
86         (#poke STARTUPINFO, hStdError)       buf (siStdError si)
87
88     peek buf = do
89         vcb              <- (#peek STARTUPINFO, cb)              buf
90         vlpDesktop       <- (#peek STARTUPINFO, lpDesktop)       buf
91         vlpTitle         <- (#peek STARTUPINFO, lpTitle)         buf
92         vdwX             <- (#peek STARTUPINFO, dwX)             buf
93         vdwY             <- (#peek STARTUPINFO, dwY)             buf
94         vdwXSize         <- (#peek STARTUPINFO, dwXSize)         buf
95         vdwYSize         <- (#peek STARTUPINFO, dwYSize)         buf
96         vdwXCountChars   <- (#peek STARTUPINFO, dwXCountChars)   buf
97         vdwYCountChars   <- (#peek STARTUPINFO, dwYCountChars)   buf
98         vdwFillAttribute <- (#peek STARTUPINFO, dwFillAttribute) buf
99         vdwFlags         <- (#peek STARTUPINFO, dwFlags)         buf
100         vwShowWindow     <- (#peek STARTUPINFO, wShowWindow)     buf
101         vhStdInput       <- (#peek STARTUPINFO, hStdInput)       buf
102         vhStdOutput      <- (#peek STARTUPINFO, hStdOutput)      buf
103         vhStdError       <- (#peek STARTUPINFO, hStdError)       buf
104         return $ STARTUPINFO {
105             siCb            =  vcb,
106             siDesktop       =  vlpDesktop,
107             siTitle         =  vlpTitle,
108             siX             =  vdwX,
109             siY             =  vdwY,
110             siXSize         =  vdwXSize,
111             siYSize         =  vdwYSize,
112             siXCountChars   =  vdwXCountChars,
113             siYCountChars   =  vdwYCountChars,
114             siFillAttribute =  vdwFillAttribute,
115             siFlags         =  vdwFlags,
116             siShowWindow    =  vwShowWindow,
117             siStdInput      =  vhStdInput,
118             siStdOutput     =  vhStdOutput,
119             siStdError      =  vhStdError}
120
121 data JOBOBJECT_EXTENDED_LIMIT_INFORMATION = JOBOBJECT_EXTENDED_LIMIT_INFORMATION
122     { jeliBasicLimitInformation :: JOBOBJECT_BASIC_LIMIT_INFORMATION
123     , jeliIoInfo                :: IO_COUNTERS
124     , jeliProcessMemoryLimit    :: SIZE_T
125     , jeliJobMemoryLimit        :: SIZE_T
126     , jeliPeakProcessMemoryUsed :: SIZE_T
127     , jeliPeakJobMemoryUsed     :: SIZE_T
128     } deriving Show
129
130 instance Storable JOBOBJECT_EXTENDED_LIMIT_INFORMATION where
131     sizeOf = const #size JOBOBJECT_EXTENDED_LIMIT_INFORMATION
132     alignment = const #alignment JOBOBJECT_EXTENDED_LIMIT_INFORMATION
133     poke buf jeli = do
134         (#poke JOBOBJECT_EXTENDED_LIMIT_INFORMATION, BasicLimitInformation) buf (jeliBasicLimitInformation jeli)
135         (#poke JOBOBJECT_EXTENDED_LIMIT_INFORMATION, IoInfo)                buf (jeliIoInfo jeli)
136         (#poke JOBOBJECT_EXTENDED_LIMIT_INFORMATION, ProcessMemoryLimit)    buf (jeliProcessMemoryLimit jeli)
137         (#poke JOBOBJECT_EXTENDED_LIMIT_INFORMATION, JobMemoryLimit)        buf (jeliJobMemoryLimit jeli)
138         (#poke JOBOBJECT_EXTENDED_LIMIT_INFORMATION, PeakProcessMemoryUsed) buf (jeliPeakProcessMemoryUsed jeli)
139         (#poke JOBOBJECT_EXTENDED_LIMIT_INFORMATION, PeakJobMemoryUsed)     buf (jeliPeakJobMemoryUsed jeli)
140     peek buf = do
141         vBasicLimitInformation <- (#peek JOBOBJECT_EXTENDED_LIMIT_INFORMATION, BasicLimitInformation) buf
142         vIoInfo                <- (#peek JOBOBJECT_EXTENDED_LIMIT_INFORMATION, IoInfo)                buf
143         vProcessMemoryLimit    <- (#peek JOBOBJECT_EXTENDED_LIMIT_INFORMATION, ProcessMemoryLimit)    buf
144         vJobMemoryLimit        <- (#peek JOBOBJECT_EXTENDED_LIMIT_INFORMATION, JobMemoryLimit)        buf
145         vPeakProcessMemoryUsed <- (#peek JOBOBJECT_EXTENDED_LIMIT_INFORMATION, PeakProcessMemoryUsed) buf
146         vPeakJobMemoryUsed     <- (#peek JOBOBJECT_EXTENDED_LIMIT_INFORMATION, PeakJobMemoryUsed)     buf
147         return $ JOBOBJECT_EXTENDED_LIMIT_INFORMATION {
148             jeliBasicLimitInformation = vBasicLimitInformation,
149             jeliIoInfo                = vIoInfo,
150             jeliProcessMemoryLimit    = vProcessMemoryLimit,
151             jeliJobMemoryLimit        = vJobMemoryLimit,
152             jeliPeakProcessMemoryUsed = vPeakProcessMemoryUsed,
153             jeliPeakJobMemoryUsed     = vPeakJobMemoryUsed}
154
155 type ULONGLONG = #type ULONGLONG
156
157 data IO_COUNTERS = IO_COUNTERS
158     { icReadOperationCount  :: ULONGLONG
159     , icWriteOperationCount :: ULONGLONG
160     , icOtherOperationCount :: ULONGLONG
161     , icReadTransferCount   :: ULONGLONG
162     , icWriteTransferCount  :: ULONGLONG
163     , icOtherTransferCount  :: ULONGLONG
164     } deriving Show
165
166 instance Storable IO_COUNTERS where
167     sizeOf = const #size IO_COUNTERS
168     alignment = const #alignment IO_COUNTERS
169     poke buf ic = do
170         (#poke IO_COUNTERS, ReadOperationCount)  buf (icReadOperationCount ic)
171         (#poke IO_COUNTERS, WriteOperationCount) buf (icWriteOperationCount ic)
172         (#poke IO_COUNTERS, OtherOperationCount) buf (icOtherOperationCount ic)
173         (#poke IO_COUNTERS, ReadTransferCount)   buf (icReadTransferCount ic)
174         (#poke IO_COUNTERS, WriteTransferCount)  buf (icWriteTransferCount ic)
175         (#poke IO_COUNTERS, OtherTransferCount)  buf (icOtherTransferCount ic)
176     peek buf = do
177         vReadOperationCount  <- (#peek IO_COUNTERS, ReadOperationCount)  buf
178         vWriteOperationCount <- (#peek IO_COUNTERS, WriteOperationCount) buf
179         vOtherOperationCount <- (#peek IO_COUNTERS, OtherOperationCount) buf
180         vReadTransferCount   <- (#peek IO_COUNTERS, ReadTransferCount)   buf
181         vWriteTransferCount  <- (#peek IO_COUNTERS, WriteTransferCount)  buf
182         vOtherTransferCount  <- (#peek IO_COUNTERS, OtherTransferCount)  buf
183         return $ IO_COUNTERS {
184             icReadOperationCount  = vReadOperationCount,
185             icWriteOperationCount = vWriteOperationCount,
186             icOtherOperationCount = vOtherOperationCount,
187             icReadTransferCount   = vReadTransferCount,
188             icWriteTransferCount  = vWriteTransferCount,
189             icOtherTransferCount  = vOtherTransferCount}
190
191 data JOBOBJECT_BASIC_LIMIT_INFORMATION = JOBOBJECT_BASIC_LIMIT_INFORMATION
192     { jbliPerProcessUserTimeLimit :: LARGE_INTEGER
193     , jbliPerJobUserTimeLimit     :: LARGE_INTEGER
194     , jbliLimitFlags              :: DWORD
195     , jbliMinimumWorkingSetSize   :: SIZE_T
196     , jbliMaximumWorkingSetSize   :: SIZE_T
197     , jbliActiveProcessLimit      :: DWORD
198     , jbliAffinity                :: ULONG_PTR
199     , jbliPriorityClass           :: DWORD
200     , jbliSchedulingClass         :: DWORD
201     } deriving Show
202
203 instance Storable JOBOBJECT_BASIC_LIMIT_INFORMATION where
204     sizeOf = const #size JOBOBJECT_BASIC_LIMIT_INFORMATION
205     alignment = const #alignment JOBOBJECT_BASIC_LIMIT_INFORMATION
206     poke buf jbli = do
207         (#poke JOBOBJECT_BASIC_LIMIT_INFORMATION, PerProcessUserTimeLimit) buf (jbliPerProcessUserTimeLimit jbli)
208         (#poke JOBOBJECT_BASIC_LIMIT_INFORMATION, PerJobUserTimeLimit)     buf (jbliPerJobUserTimeLimit jbli)
209         (#poke JOBOBJECT_BASIC_LIMIT_INFORMATION, LimitFlags)              buf (jbliLimitFlags jbli)
210         (#poke JOBOBJECT_BASIC_LIMIT_INFORMATION, MinimumWorkingSetSize)   buf (jbliMinimumWorkingSetSize jbli)
211         (#poke JOBOBJECT_BASIC_LIMIT_INFORMATION, MaximumWorkingSetSize)   buf (jbliMaximumWorkingSetSize jbli)
212         (#poke JOBOBJECT_BASIC_LIMIT_INFORMATION, ActiveProcessLimit)      buf (jbliActiveProcessLimit jbli)
213         (#poke JOBOBJECT_BASIC_LIMIT_INFORMATION, Affinity)                buf (jbliAffinity jbli)
214         (#poke JOBOBJECT_BASIC_LIMIT_INFORMATION, PriorityClass)           buf (jbliPriorityClass jbli)
215         (#poke JOBOBJECT_BASIC_LIMIT_INFORMATION, SchedulingClass)         buf (jbliSchedulingClass jbli)
216     peek buf = do
217         vPerProcessUserTimeLimit <- (#peek JOBOBJECT_BASIC_LIMIT_INFORMATION, PerProcessUserTimeLimit) buf
218         vPerJobUserTimeLimit     <- (#peek JOBOBJECT_BASIC_LIMIT_INFORMATION, PerJobUserTimeLimit)     buf
219         vLimitFlags              <- (#peek JOBOBJECT_BASIC_LIMIT_INFORMATION, LimitFlags)              buf
220         vMinimumWorkingSetSize   <- (#peek JOBOBJECT_BASIC_LIMIT_INFORMATION, MinimumWorkingSetSize)   buf
221         vMaximumWorkingSetSize   <- (#peek JOBOBJECT_BASIC_LIMIT_INFORMATION, MaximumWorkingSetSize)   buf
222         vActiveProcessLimit      <- (#peek JOBOBJECT_BASIC_LIMIT_INFORMATION, ActiveProcessLimit)      buf
223         vAffinity                <- (#peek JOBOBJECT_BASIC_LIMIT_INFORMATION, Affinity)                buf
224         vPriorityClass           <- (#peek JOBOBJECT_BASIC_LIMIT_INFORMATION, PriorityClass)           buf
225         vSchedulingClass         <- (#peek JOBOBJECT_BASIC_LIMIT_INFORMATION, SchedulingClass)         buf
226         return $ JOBOBJECT_BASIC_LIMIT_INFORMATION {
227             jbliPerProcessUserTimeLimit = vPerProcessUserTimeLimit,
228             jbliPerJobUserTimeLimit     = vPerJobUserTimeLimit,
229             jbliLimitFlags              = vLimitFlags,
230             jbliMinimumWorkingSetSize   = vMinimumWorkingSetSize,
231             jbliMaximumWorkingSetSize   = vMaximumWorkingSetSize,
232             jbliActiveProcessLimit      = vActiveProcessLimit,
233             jbliAffinity                = vAffinity,
234             jbliPriorityClass           = vPriorityClass,
235             jbliSchedulingClass         = vSchedulingClass}
236
237 data JOBOBJECT_ASSOCIATE_COMPLETION_PORT = JOBOBJECT_ASSOCIATE_COMPLETION_PORT
238     { jacpCompletionKey  :: PVOID
239     , jacpCompletionPort :: HANDLE
240     } deriving Show
241
242 instance Storable JOBOBJECT_ASSOCIATE_COMPLETION_PORT where
243     sizeOf = const #size JOBOBJECT_ASSOCIATE_COMPLETION_PORT
244     alignment = const #alignment JOBOBJECT_ASSOCIATE_COMPLETION_PORT
245     poke buf jacp = do
246         (#poke JOBOBJECT_ASSOCIATE_COMPLETION_PORT, CompletionKey)  buf (jacpCompletionKey jacp)
247         (#poke JOBOBJECT_ASSOCIATE_COMPLETION_PORT, CompletionPort) buf (jacpCompletionPort jacp)
248     peek buf = do
249         vCompletionKey  <- (#peek JOBOBJECT_ASSOCIATE_COMPLETION_PORT, CompletionKey)  buf
250         vCompletionPort <- (#peek JOBOBJECT_ASSOCIATE_COMPLETION_PORT, CompletionPort) buf
251         return $ JOBOBJECT_ASSOCIATE_COMPLETION_PORT {
252             jacpCompletionKey  = vCompletionKey,
253             jacpCompletionPort = vCompletionPort}
254
255
256 foreign import WINDOWS_CCONV unsafe "windows.h WaitForSingleObject"
257     waitForSingleObject :: HANDLE -> DWORD -> IO DWORD
258
259 type JOBOBJECTINFOCLASS = CInt
260
261 type PVOID = Ptr ()
262
263 type ULONG_PTR  = CUIntPtr
264 type PULONG_PTR = Ptr ULONG_PTR
265
266 jobObjectExtendedLimitInformation :: JOBOBJECTINFOCLASS
267 jobObjectExtendedLimitInformation = #const JobObjectExtendedLimitInformation
268
269 jobObjectAssociateCompletionPortInformation :: JOBOBJECTINFOCLASS
270 jobObjectAssociateCompletionPortInformation = #const JobObjectAssociateCompletionPortInformation
271
272 cJOB_OBJECT_LIMIT_KILL_ON_JOB_CLOSE :: DWORD
273 cJOB_OBJECT_LIMIT_KILL_ON_JOB_CLOSE = #const JOB_OBJECT_LIMIT_KILL_ON_JOB_CLOSE
274
275 cJOB_OBJECT_MSG_ACTIVE_PROCESS_ZERO :: DWORD
276 cJOB_OBJECT_MSG_ACTIVE_PROCESS_ZERO = #const JOB_OBJECT_MSG_ACTIVE_PROCESS_ZERO
277
278 cJOB_OBJECT_MSG_EXIT_PROCESS :: DWORD
279 cJOB_OBJECT_MSG_EXIT_PROCESS = #const JOB_OBJECT_MSG_EXIT_PROCESS
280
281 cJOB_OBJECT_MSG_NEW_PROCESS :: DWORD
282 cJOB_OBJECT_MSG_NEW_PROCESS = #const JOB_OBJECT_MSG_NEW_PROCESS
283
284 cWAIT_ABANDONED :: DWORD
285 cWAIT_ABANDONED = #const WAIT_ABANDONED
286
287 cWAIT_OBJECT_0 :: DWORD
288 cWAIT_OBJECT_0 = #const WAIT_OBJECT_0
289
290 cWAIT_TIMEOUT :: DWORD
291 cWAIT_TIMEOUT = #const WAIT_TIMEOUT
292
293 cCREATE_SUSPENDED :: DWORD
294 cCREATE_SUSPENDED = #const CREATE_SUSPENDED
295
296 foreign import WINDOWS_CCONV unsafe "windows.h GetExitCodeProcess"
297     getExitCodeProcess :: HANDLE -> LPDWORD -> IO BOOL
298
299 foreign import WINDOWS_CCONV unsafe "windows.h CloseHandle"
300     closeHandle :: HANDLE -> IO BOOL
301
302 foreign import WINDOWS_CCONV unsafe "windows.h TerminateJobObject"
303     terminateJobObject :: HANDLE -> UINT -> IO BOOL
304
305 foreign import WINDOWS_CCONV unsafe "windows.h AssignProcessToJobObject"
306     assignProcessToJobObject :: HANDLE -> HANDLE -> IO BOOL
307
308 foreign import WINDOWS_CCONV unsafe "windows.h CreateJobObjectW"
309     createJobObjectW :: LPSECURITY_ATTRIBUTES -> LPCTSTR -> IO HANDLE
310
311 foreign import WINDOWS_CCONV unsafe "windows.h CreateProcessW"
312     createProcessW :: LPCTSTR -> LPTSTR
313                    -> LPSECURITY_ATTRIBUTES -> LPSECURITY_ATTRIBUTES
314                    -> BOOL -> DWORD -> LPVOID -> LPCTSTR -> LPSTARTUPINFO
315                    -> LPPROCESS_INFORMATION -> IO BOOL
316
317 foreign import WINDOWS_CCONV unsafe "string.h" memset :: Ptr a -> CInt -> CSize -> IO (Ptr a)
318
319 foreign import WINDOWS_CCONV unsafe "windows.h SetInformationJobObject"
320     setInformationJobObject :: HANDLE -> JOBOBJECTINFOCLASS -> LPVOID -> DWORD -> IO BOOL
321
322 foreign import WINDOWS_CCONV unsafe "windows.h CreateIoCompletionPort"
323     createIoCompletionPort :: HANDLE -> HANDLE -> ULONG_PTR -> DWORD -> IO HANDLE
324
325 foreign import WINDOWS_CCONV unsafe "windows.h GetQueuedCompletionStatus"
326     getQueuedCompletionStatus :: HANDLE -> LPDWORD -> PULONG_PTR -> Ptr LPOVERLAPPED -> DWORD -> IO BOOL
327
328 setJobParameters :: HANDLE -> IO BOOL
329 setJobParameters hJob = alloca $ \p_jeli -> do
330     let jeliSize = sizeOf (undefined :: JOBOBJECT_EXTENDED_LIMIT_INFORMATION)
331     _ <- memset p_jeli 0 $ fromIntegral jeliSize
332     -- Configure all child processes associated with the job to terminate when the
333     -- Last process in the job terminates. This prevent half dead processes and that
334     -- hanging ghc-iserv.exe process that happens when you interrupt the testsuite.
335     (#poke JOBOBJECT_EXTENDED_LIMIT_INFORMATION, BasicLimitInformation.LimitFlags)
336       p_jeli cJOB_OBJECT_LIMIT_KILL_ON_JOB_CLOSE
337     setInformationJobObject hJob jobObjectExtendedLimitInformation
338                             p_jeli (fromIntegral jeliSize)
339
340 createCompletionPort :: HANDLE -> IO HANDLE
341 createCompletionPort hJob = do
342     ioPort <- createIoCompletionPort iNVALID_HANDLE_VALUE nullPtr 0 1
343     if ioPort == nullPtr
344        then do err_code <- getLastError
345                putStrLn $ "CreateIoCompletionPort error: " ++ show err_code
346                return nullPtr
347        else with (JOBOBJECT_ASSOCIATE_COMPLETION_PORT {
348                     jacpCompletionKey  = hJob,
349                     jacpCompletionPort = ioPort}) $ \p_Port -> do
350               res <- setInformationJobObject hJob jobObjectAssociateCompletionPortInformation
351                          (castPtr p_Port) (fromIntegral (sizeOf (undefined :: JOBOBJECT_ASSOCIATE_COMPLETION_PORT)))
352               if res
353                  then return ioPort
354                  else do err_code <- getLastError
355                          putStrLn $ "SetInformation, error: " ++ show err_code
356                          return nullPtr
357
358 waitForJobCompletion :: HANDLE -> HANDLE -> DWORD -> IO BOOL
359 waitForJobCompletion hJob ioPort timeout
360   = alloca $ \p_CompletionCode ->
361     alloca $ \p_CompletionKey ->
362     alloca $ \p_Overlapped -> do
363
364     -- getQueuedCompletionStatus is a blocking call,
365     -- it will wake up for each completion event. So if it's
366     -- not the one we want, sleep again.
367     let loop :: IO ()
368         loop = do
369           res <- getQueuedCompletionStatus ioPort p_CompletionCode p_CompletionKey
370                                            p_Overlapped timeout
371           completionCode <- peek p_CompletionCode
372
373           if completionCode == cJOB_OBJECT_MSG_ACTIVE_PROCESS_ZERO
374                      then return ()
375              else if completionCode == cJOB_OBJECT_MSG_EXIT_PROCESS
376                      then loop
377              else if completionCode == cJOB_OBJECT_MSG_NEW_PROCESS
378                      then loop
379                      else loop
380
381     loop
382
383     overlapped    <- peek p_Overlapped
384     completionKey <- peek $ castPtr p_CompletionKey
385     return $ if overlapped == nullPtr && completionKey /= hJob
386                 then False -- Timeout occurred. *dark voice* YOU HAVE FAILED THIS TEST!.
387                 else True
388 #endif
389