From 6263e1079a2d203fbd2e668ca99c0e901fcd1548 Mon Sep 17 00:00:00 2001
From: Tamar Christina <tamar@zhox.com>
Date: Mon, 19 Dec 2016 00:18:57 +0000
Subject: [PATCH] Fix timeout's timeout on Windows
Summary:
Timeout has been broken by my previous patch.
The timeout event was not being processed correctly,
as such hanging processes would not be killed as they should
have been.
This corrects it.
Test Plan:
./validate
~/ghc/testsuite/timeout/install-inplace/bin/timeout.exe 10 "sleep 10000s"
Reviewers: austin, RyanGlScott, bgamari
Reviewed By: bgamari
Subscribers: thomie, #ghc_windows_task_force
Differential Revision: https://phabricator.haskell.org/D2880
GHC Trac Issues: #13004
---
testsuite/timeout/WinCBindings.hsc | 33 ++++++++++++++++--------------
1 file changed, 18 insertions(+), 15 deletions(-)
diff --git a/testsuite/timeout/WinCBindings.hsc b/testsuite/timeout/WinCBindings.hsc
index d9c08ee3a297..36ba01e5438b 100644
--- a/testsuite/timeout/WinCBindings.hsc
+++ b/testsuite/timeout/WinCBindings.hsc
@@ -369,21 +369,24 @@ waitForJobCompletion hJob ioPort timeout
loop = do
res <- getQueuedCompletionStatus ioPort p_CompletionCode p_CompletionKey
p_Overlapped timeout
- completionCode <- peek p_CompletionCode
-
- if completionCode == cJOB_OBJECT_MSG_ACTIVE_PROCESS_ZERO
- then return ()
- else if completionCode == cJOB_OBJECT_MSG_EXIT_PROCESS
- then loop
- else if completionCode == cJOB_OBJECT_MSG_NEW_PROCESS
- then loop
- else loop
-
- loop
-
- overlapped <- peek p_Overlapped
- completionKey <- peek $ castPtr p_CompletionKey
- return $ if overlapped == nullPtr && completionKey /= hJob
+ case res of
+ False -> return ()
+ True -> do
+ completionCode <- peek p_CompletionCode
+ if completionCode == cJOB_OBJECT_MSG_ACTIVE_PROCESS_ZERO
+ then return ()
+ else if completionCode == cJOB_OBJECT_MSG_EXIT_PROCESS
+ then loop -- Debug point, do nothing for now
+ else if completionCode == cJOB_OBJECT_MSG_NEW_PROCESS
+ then loop -- Debug point, do nothing for now
+ else loop
+
+ loop -- Kick it all off
+
+ overlapped <- peek p_Overlapped
+ code <- peek $ p_CompletionCode
+
+ return $ if overlapped == nullPtr && code /= cJOB_OBJECT_MSG_ACTIVE_PROCESS_ZERO
then False -- Timeout occurred. *dark voice* YOU HAVE FAILED THIS TEST!.
else True
#endif
--
GitLab