[commit: ghc] ghc-8.0: Fix three broken tests involving exceptions (940aa47)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : ghc-8.0
Link       : http://ghc.haskell.org/trac/ghc/changeset/940aa477db84b373290d2d8e177a811cacbaa6f5/ghc

>---------------------------------------------------------------

commit 940aa477db84b373290d2d8e177a811cacbaa6f5
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!
    
    (cherry picked from commit 3798b2aad8f62cb18e6147b54c57a9a4ad6c23f4)


>---------------------------------------------------------------

940aa477db84b373290d2d8e177a811cacbaa6f5
 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))