summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/Run.hs7
-rw-r--r--src/Run/Monad.hs2
-rw-r--r--src/TestMode.hs6
3 files changed, 11 insertions, 4 deletions
diff --git a/src/Run.hs b/src/Run.hs
index a646342..a253e51 100644
--- a/src/Run.hs
+++ b/src/Run.hs
@@ -156,8 +156,8 @@ runTest out opts gdefs test = do
[] <- readMVar procVar
failed <- atomically $ readTVar (teFailed tenv)
- case (res, failed) of
- (Right (), Nothing) -> do
+ fres <- case ( res, failed ) of
+ ( Right (), Nothing ) -> do
when (not $ optKeep opts) $ removeDirectoryRecursive testDir
return True
_ -> do
@@ -165,6 +165,9 @@ runTest out opts gdefs test = do
void $ outLine OutputGlobalError Nothing $ "Test ‘" <> textTestName (testName test) <> "’ failed."
return False
+ (optHookTestResult opts) (testName test) fres
+ return fres
+
data LoadedModules = LoadedModules
{ lmModules :: [ Module ]
diff --git a/src/Run/Monad.hs b/src/Run/Monad.hs
index efebe05..8c772d5 100644
--- a/src/Run/Monad.hs
+++ b/src/Run/Monad.hs
@@ -71,6 +71,7 @@ data TestOptions = TestOptions
, optRepeat :: Int
, optKeepGoing :: Bool
, optWait :: Bool
+ , optHookTestResult :: TestName -> Bool -> IO ()
}
defaultTestOptions :: TestOptions
@@ -86,6 +87,7 @@ defaultTestOptions = TestOptions
, optRepeat = 1
, optKeepGoing = False
, optWait = False
+ , optHookTestResult = \_ _ -> return ()
}
data Failed = Failed
diff --git a/src/TestMode.hs b/src/TestMode.hs
index 4d8c767..90ced30 100644
--- a/src/TestMode.hs
+++ b/src/TestMode.hs
@@ -88,6 +88,9 @@ runSingleTest test = do
{ optDefaultTool = fromMaybe "/bin/true" $ configTool =<< mbconfig
, optTestDir = ".test" <> show num
, optKeep = True
+ , optHookTestResult = \tname res -> do
+ flip runReaderT out $ outLine OutputTestRaw Nothing $
+ "run-test-result " <> testNameBase tname <> " " <> (if res then "done" else "failed")
}
liftIO (runTest out opts lmGlobalDefs test)
@@ -162,6 +165,5 @@ cmdRun = do
Left err -> showError "run-failed" err
Right tests -> do
forM_ tests $ \test -> do
- res <- runSingleTest test
- cmdOut $ "run-test-result " <> testNameBase (testName test) <> " " <> (if res then "done" else "failed")
+ runSingleTest test
cmdOut "run-done"