File tree Expand file tree Collapse file tree
Expand file tree Collapse file tree Original file line number Diff line number Diff line change @@ -187,6 +187,7 @@ test-suite tests
187187 , QuickCheck
188188 , serialise
189189 , typed-protocols-examples
190+ , HUnit
190191 build-tool-depends :
191192 hspec-discover :hspec-discover
192193 ghc-options :
Original file line number Diff line number Diff line change @@ -55,7 +55,7 @@ import Test.Hspec (
5555 shouldNotBe ,
5656 shouldReturn ,
5757 )
58- import Test.Util (failAfter )
58+ import Test.Util (failAfter , failure )
5959import Prelude (error )
6060
6161spec :: Spec
@@ -298,8 +298,7 @@ startHydraNode' snapshotStrategy nodeId connectToChain = do
298298 atomically $ do
299299 st' <- queryLedgerState node
300300 check (st == st')
301- -- TODO(SN): use MonadThrow instead?
302- when (isNothing result) $ error (" Expected ledger state of node " <> show nodeId <> " to be " <> show st)
301+ when (isNothing result) $ failure (" Expected ledger state of node " <> show nodeId <> " to be " <> show st)
303302 , nodeId
304303 , capturedLogs
305304 }
Original file line number Diff line number Diff line change 11module Test.Util where
22
3- import Cardano.Prelude
3+ import Cardano.Prelude hiding (callStack , throwIO )
4+ import Control.Monad.Class.MonadThrow (MonadThrow (throwIO ))
45import Control.Monad.Class.MonadTimer (DiffTime , MonadTimer , timeout )
5- import Prelude (error )
6+ import Data.String (String )
7+ import GHC.Stack (callStack )
8+ import Test.HUnit.Lang (FailureReason (Reason ), HUnitFailure (HUnitFailure ))
69
7- failAfter :: (HasCallStack , MonadTimer m ) => DiffTime -> m () -> m ()
10+ failure :: (HasCallStack , MonadThrow m ) => String -> m a
11+ failure msg =
12+ throwIO (HUnitFailure location $ Reason msg)
13+ where
14+ location = case reverse $ getCallStack callStack of
15+ (_, loc) : _ -> Just loc
16+ _ -> Nothing
17+
18+ failAfter :: (HasCallStack , MonadTimer m , MonadThrow m ) => DiffTime -> m () -> m ()
819failAfter seconds action =
920 timeout seconds action >>= \ case
10- -- TODO(SN): use MonadThrow instead?
11- Nothing -> error $ " Test timed out after " <> show seconds <> " seconds"
21+ Nothing -> failure $ " Test timed out after " <> show seconds <> " seconds"
1222 Just _ -> pure ()
You can’t perform that action at this time.
0 commit comments