Skip to content

Commit

Permalink
Add and use a 'failure' helper instead of 'error'
Browse files Browse the repository at this point in the history
  • Loading branch information
ch1bo committed Jun 8, 2021
1 parent a6efcc3 commit d99cd36
Show file tree
Hide file tree
Showing 3 changed files with 18 additions and 8 deletions.
1 change: 1 addition & 0 deletions hydra-node/hydra-node.cabal
Expand Up @@ -187,6 +187,7 @@ test-suite tests
, QuickCheck
, serialise
, typed-protocols-examples
, HUnit
build-tool-depends:
hspec-discover:hspec-discover
ghc-options:
Expand Down
5 changes: 2 additions & 3 deletions hydra-node/test/Hydra/BehaviorSpec.hs
Expand Up @@ -55,7 +55,7 @@ import Test.Hspec (
shouldNotBe,
shouldReturn,
)
import Test.Util (failAfter)
import Test.Util (failAfter, failure)
import Prelude (error)

spec :: Spec
Expand Down Expand Up @@ -298,8 +298,7 @@ startHydraNode' snapshotStrategy nodeId connectToChain = do
atomically $ do
st' <- queryLedgerState node
check (st == st')
-- TODO(SN): use MonadThrow instead?
when (isNothing result) $ error ("Expected ledger state of node " <> show nodeId <> " to be " <> show st)
when (isNothing result) $ failure ("Expected ledger state of node " <> show nodeId <> " to be " <> show st)
, nodeId
, capturedLogs
}
Expand Down
20 changes: 15 additions & 5 deletions hydra-node/test/Test/Util.hs
@@ -1,12 +1,22 @@
module Test.Util where

import Cardano.Prelude
import Cardano.Prelude hiding (callStack, throwIO)
import Control.Monad.Class.MonadThrow (MonadThrow (throwIO))
import Control.Monad.Class.MonadTimer (DiffTime, MonadTimer, timeout)
import Prelude (error)
import Data.String (String)
import GHC.Stack (callStack)
import Test.HUnit.Lang (FailureReason (Reason), HUnitFailure (HUnitFailure))

failAfter :: (HasCallStack, MonadTimer m) => DiffTime -> m () -> m ()
failure :: (HasCallStack, MonadThrow m) => String -> m a
failure msg =
throwIO (HUnitFailure location $ Reason msg)
where
location = case reverse $ getCallStack callStack of
(_, loc) : _ -> Just loc
_ -> Nothing

failAfter :: (HasCallStack, MonadTimer m, MonadThrow m) => DiffTime -> m () -> m ()
failAfter seconds action =
timeout seconds action >>= \case
-- TODO(SN): use MonadThrow instead?
Nothing -> error $ "Test timed out after " <> show seconds <> " seconds"
Nothing -> failure $ "Test timed out after " <> show seconds <> " seconds"
Just _ -> pure ()

0 comments on commit d99cd36

Please sign in to comment.