diff options
Diffstat (limited to 'test')
-rw-r--r-- | test/runTests.hs | 12 |
1 files changed, 11 insertions, 1 deletions
diff --git a/test/runTests.hs b/test/runTests.hs index 8b6e1d4d..23891b77 100644 --- a/test/runTests.hs +++ b/test/runTests.hs | |||
@@ -4,6 +4,7 @@ | |||
4 | {-# LANGUAGE FlexibleContexts #-} | 4 | {-# LANGUAGE FlexibleContexts #-} |
5 | {-# LANGUAGE RecordWildCards #-} | 5 | {-# LANGUAGE RecordWildCards #-} |
6 | {-# LANGUAGE NoMonomorphismRestriction #-} | 6 | {-# LANGUAGE NoMonomorphismRestriction #-} |
7 | {-# LANGUAGE ScopedTypeVariables #-} | ||
7 | module Main where | 8 | module Main where |
8 | 9 | ||
9 | import Data.Char | 10 | import Data.Char |
@@ -18,7 +19,10 @@ import Control.Concurrent | |||
18 | import Control.Concurrent.Async | 19 | import Control.Concurrent.Async |
19 | import Control.Monad | 20 | import Control.Monad |
20 | import Control.Monad.Reader | 21 | import Control.Monad.Reader |
21 | import Control.Exception hiding (catch) | 22 | --import Control.Monad.Except |
23 | import Control.Monad.Catch | ||
24 | import Control.Exception hiding (catch, bracket, finally, mask) | ||
25 | --import Control.Exception hiding (catch) | ||
22 | import Control.Monad.Trans.Control | 26 | import Control.Monad.Trans.Control |
23 | import Control.DeepSeq | 27 | import Control.DeepSeq |
24 | import System.Exit | 28 | import System.Exit |
@@ -81,6 +85,12 @@ timeOut dt d m = | |||
81 | <*> m | 85 | <*> m |
82 | <*> liftIO getCurrentTime | 86 | <*> liftIO getCurrentTime |
83 | 87 | ||
88 | catchErr :: (MonadCatch m, NFData a, MonadIO m) => (String -> m a) -> m a -> m a | ||
89 | catchErr er m = (force <$> m >>= liftIO . evaluate) `catch` getErr `catch` getPMatchFail | ||
90 | where | ||
91 | getErr (e :: ErrorCall) = catchErr er $ er $ show e | ||
92 | getPMatchFail (e :: PatternMatchFail) = catchErr er $ er $ show e | ||
93 | |||
84 | ------------------------------------------ | 94 | ------------------------------------------ |
85 | 95 | ||
86 | testDataPath = "./testdata" | 96 | testDataPath = "./testdata" |