[commit: ghc] master: Fix three broken tests involving exceptions (3798b2a)
git at git.haskell.org
git at git.haskell.org
Tue Jan 26 12:36:09 UTC 2016
Repository : ssh://git@git.haskell.org/ghc
On branch : master
Link : http://ghc.haskell.org/trac/ghc/changeset/3798b2aad8f62cb18e6147b54c57a9a4ad6c23f4/ghc
>---------------------------------------------------------------
commit 3798b2aad8f62cb18e6147b54c57a9a4ad6c23f4
Author: Simon Peyton Jones <simonpj at microsoft.com>
Date: Tue Jan 26 12:36:21 2016 +0000
Fix three broken tests involving exceptions
See comment:16 in Trac #10712. The tests were wrong, not GHC!
>---------------------------------------------------------------
3798b2aad8f62cb18e6147b54c57a9a4ad6c23f4
testsuite/tests/concurrent/should_run/T3279.hs | 2 +-
testsuite/tests/concurrent/should_run/conc012.hs | 2 +-
testsuite/tests/concurrent/should_run/conc014.hs | 10 ++++------
3 files changed, 6 insertions(+), 8 deletions(-)
diff --git a/testsuite/tests/concurrent/should_run/T3279.hs b/testsuite/tests/concurrent/should_run/T3279.hs
index a90d38a..b721a61 100644
--- a/testsuite/tests/concurrent/should_run/T3279.hs
+++ b/testsuite/tests/concurrent/should_run/T3279.hs
@@ -7,7 +7,7 @@ import GHC.IO (unsafeUnmask)
f :: Int
f = (1 +) . unsafePerformIO $ do
- error "foo" `catch` \(SomeException e) -> do
+ throwIO (ErrorCall "foo") `catch` \(SomeException e) -> do
myThreadId >>= flip throwTo e
-- point X
unsafeUnmask $ return 1
diff --git a/testsuite/tests/concurrent/should_run/conc012.hs b/testsuite/tests/concurrent/should_run/conc012.hs
index a2f139e..753fa89 100644
--- a/testsuite/tests/concurrent/should_run/conc012.hs
+++ b/testsuite/tests/concurrent/should_run/conc012.hs
@@ -15,7 +15,7 @@ stackoverflow n = n + stackoverflow n
main = do
let x = stackoverflow 1
result <- newEmptyMVar
- forkIO $ Control.Exception.catch (x `seq` putMVar result Finished) $
+ forkIO $ Control.Exception.catch (evaluate x >> putMVar result Finished) $
\e -> putMVar result (Died e)
res <- takeMVar result
case res of
diff --git a/testsuite/tests/concurrent/should_run/conc014.hs b/testsuite/tests/concurrent/should_run/conc014.hs
index 76cb3c2..7171674 100644
--- a/testsuite/tests/concurrent/should_run/conc014.hs
+++ b/testsuite/tests/concurrent/should_run/conc014.hs
@@ -8,13 +8,11 @@ main = do
main_thread <- myThreadId
m <- newEmptyMVar
forkIO (do { takeMVar m; throwTo main_thread (ErrorCall "foo") })
- (do
- error "wibble"
- `Control.Exception.catch`
+ (do { throwIO (ErrorCall "wibble")
+ `Control.Exception.catch`
(\e -> let _ = e::ErrorCall in
- do putMVar m (); sum [1..10000] `seq` putStrLn "done.")
- myDelay 500000
- )
+ do putMVar m (); evaluate (sum [1..10000]); putStrLn "done.")
+ ; myDelay 500000 })
`Control.Exception.catch`
\e -> putStrLn ("caught: " ++ show (e::SomeException))
More information about the ghc-commits
mailing list