Commit 5ecf94de authored by novadenizen's avatar novadenizen
Browse files

Now allows UserInterrupt to pass through

parent 97f3395f
...@@ -29,7 +29,9 @@ import Distribution.TestSuite ...@@ -29,7 +29,9 @@ import Distribution.TestSuite
import Distribution.Text import Distribution.Text
import Distribution.Verbosity import Distribution.Verbosity
import Control.Exception ( bracket, catch, SomeException ) import Control.Exception ( bracket, catch, fromException, SomeException,
AsyncException(UserInterrupt) )
import Control.Exception.Base ( throwIO )
import System.Directory import System.Directory
( createDirectoryIfMissing, doesDirectoryExist, doesFileExist ( createDirectoryIfMissing, doesDirectoryExist, doesFileExist
, getCurrentDirectory, removeDirectoryRecursive, removeFile , getCurrentDirectory, removeDirectoryRecursive, removeFile
...@@ -212,14 +214,16 @@ stubMain :: IO [Test] -> IO () ...@@ -212,14 +214,16 @@ stubMain :: IO [Test] -> IO ()
stubMain tests = do stubMain tests = do
(f, n) <- fmap read getContents (f, n) <- fmap read getContents
dir <- getCurrentDirectory dir <- getCurrentDirectory
results <- ((tests >>= stubRunTests) `catch` errHandler) results <- (tests >>= stubRunTests) `catch` errHandler
setCurrentDirectory dir setCurrentDirectory dir
stubWriteLog f n results stubWriteLog f n results
where where
errHandler :: SomeException -> IO TestLogs errHandler :: SomeException -> IO TestLogs
errHandler e = return $ TestLog { testName = "Cabal test suite exception", errHandler e = case fromException e of
testOptionsReturned = [], Just UserInterrupt -> throwIO e
testResult = Error $ show e } _ -> return $ TestLog { testName = "Cabal test suite exception",
testOptionsReturned = [],
testResult = Error $ show e }
-- | The test runner used in library "TestSuite" stub executables. Runs a list -- | The test runner used in library "TestSuite" stub executables. Runs a list
-- of 'Test's. An executable calling this function is meant to be invoked as -- of 'Test's. An executable calling this function is meant to be invoked as
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment