1{-# LANGUAGE DeriveDataTypeable, BangPatterns #-} 2module Test.Tasty.HUnit.Steps (testCaseSteps) where 3 4import Control.Applicative 5import Control.Exception 6import Data.IORef 7import Data.List (foldl') 8import Data.Typeable (Typeable) 9import Prelude -- Silence AMP import warnings 10import Test.Tasty.HUnit.Orig 11import Test.Tasty.Providers 12import Test.Tasty.Runners (getTime) 13import Text.Printf (printf) 14 15newtype TestCaseSteps = TestCaseSteps ((String -> IO ()) -> Assertion) 16 deriving Typeable 17 18instance IsTest TestCaseSteps where 19 run _ (TestCaseSteps assertionFn) _ = do 20 ref <- newIORef [] 21 22 let 23 stepFn :: String -> IO () 24 stepFn msg = do 25 tme <- getTime 26 atomicModifyIORef ref (\l -> ((tme,msg):l, ())) 27 28 hunitResult <- (Right <$> assertionFn stepFn) `catches` 29 [ Handler (\(HUnitFailure mbloc errMsg) -> return $ Left (prependLocation mbloc errMsg)) 30 , Handler (\(SomeException ex) -> return $ Left (show ex)) 31 ] 32 33 endTime <- getTime 34 35 maxMsgLength <- foldl' max 0 . map (length . snd) <$> readIORef ref 36 37 let msgFormat = "%-" ++ show (min maxMsgLength 62) ++ "s (%.02fs)" 38 39 msgs <- snd . foldl' 40 (\(lastTime, acc) (curTime, msg) -> 41 let !duration = lastTime - curTime 42 !msg' = if duration >= 0.01 then printf msgFormat msg duration else msg 43 in (curTime, msg':acc)) 44 (endTime, []) 45 <$> readIORef ref 46 47 return $ 48 case hunitResult of 49 50 Right {} -> testPassed (unlines msgs) 51 52 Left errMsg -> testFailed $ 53 if null msgs 54 then 55 errMsg 56 else 57 -- Indent the error msg w.r.t. step messages 58 unlines $ 59 msgs ++ map (" " ++) (lines errMsg) 60 61 testOptions = return [] 62 63-- | Create a multi-step unit test. 64-- 65-- Example: 66-- 67-- >main = defaultMain $ testCaseSteps "Multi-step test" $ \step -> do 68-- > step "Preparing..." 69-- > -- do something 70-- > 71-- > step "Running part 1" 72-- > -- do something 73-- > 74-- > step "Running part 2" 75-- > -- do something 76-- > assertFailure "BAM!" 77-- > 78-- > step "Running part 3" 79-- > -- do something 80-- 81-- The @step@ calls are mere annotations. They let you see which steps were 82-- performed successfully, and which step failed. 83-- 84-- You can think of @step@ 85-- as 'putStrLn', except 'putStrLn' would mess up the output with the 86-- console reporter and get lost with the others. 87-- 88-- For the example above, the output will be 89-- 90-- >Multi-step test: FAIL 91-- > Preparing... 92-- > Running part 1 93-- > Running part 2 94-- > BAM! 95-- > 96-- >1 out of 1 tests failed (0.00s) 97-- 98-- Note that: 99-- 100-- * Tasty still treats this as a single test, even though it consists of 101-- multiple steps. 102-- 103-- * The execution stops after the first failure. When we are looking at 104-- a failed test, we know that all /displayed/ steps but the last one were 105-- successful, and the last one failed. The steps /after/ the failed one 106-- are /not displayed/, since they didn't run. 107testCaseSteps :: TestName -> ((String -> IO ()) -> Assertion) -> TestTree 108testCaseSteps name = singleTest name . TestCaseSteps 109