Add tests for Extra.it

lib/test-utils/cardano-wallet-test-utils.cabal

@@ -60,3 +60,31 @@ library
       Test.Utils.Time
       Test.Utils.Trace
       Test.Utils.Windows
+
+test-suite unit
+  default-language:
+      Haskell2010
+  default-extensions:
+      NoImplicitPrelude
+      OverloadedStrings
+  ghc-options:
+      -threaded -rtsopts
+      -Wall
+  if (flag(release))
+    ghc-options: -O2 -Werror
+  build-depends:
+      base
+    , hspec
+    , silently
+    , hspec-core
+    , cardano-wallet-test-utils
+  build-tools:
+      hspec-discover
+  type:
+     exitcode-stdio-1.0
+  hs-source-dirs:
+      test
+  main-is:
+      Main.hs
+  other-modules:
+      Test.Hspec.ExtraSpec

lib/test-utils/test/Main.hs

@@ -0,0 +1 @@
+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}

lib/test-utils/test/Test/Hspec/ExtraSpec.hs

@@ -0,0 +1,91 @@
+module Test.Hspec.ExtraSpec where
+
+import Prelude
+
+import Data.IORef
+    ( IORef, newIORef, readIORef, writeIORef )
+import Data.List
+    ( isPrefixOf )
+import System.IO.Silently
+    ( capture_ )
+import Test.Hspec
+    ( ActionWith
+    , Expectation
+    , Spec
+    , SpecWith
+    , beforeAll
+    , describe
+    , expectationFailure
+    , it
+    , shouldBe
+    )
+import Test.Hspec.Core.Runner
+    ( defaultConfig, runSpec )
+
+import qualified Test.Hspec.Extra as Extra
+
+spec :: Spec
+spec = do
+    describe "Extra.it" $ do
+        it "equals Hspec.it on success" $ do
+            let test = 1 `shouldBe` (1::Int)
+            test `shouldMatchHSpecIt` test
+
+        it "equals Hspec.it on failure" $ do
+            let test = (2+2) `shouldBe` (5::Int)
+            test `shouldMatchHSpecIt` test
+
+        describe "when first attempt fails due to flakiness" $ do
+            describe "when the retry succeeds" $ do
+                let flaky = expectationFailure "flaky test"
+                let succeed = 1 `shouldBe` (1 :: Int)
+                it "succeeds" $ do
+                    outcomes <- newIORef [flaky, succeed]
+                    (dynamically outcomes) `shouldMatchHSpecIt` succeed
+
+            describe "when the retry also fails" $ do
+                -- Some tests use limited resources and cannot be retried.
+                -- On failures, we should make sure to show the first failure
+                -- which is the interesting one.
+                it "fails with the first error" $ do
+                    let failure = expectationFailure "failure"
+                    let noRetry = expectationFailure "test can't be retried"
+                    outcomes <- newIORef [failure, noRetry]
+                    (dynamically outcomes) `shouldMatchHSpecIt` failure
+  where
+    -- | lhs `shouldMatchHSpecIt` rhs asserts that the output of running
+    -- (Extra.it "" lhs) and (Hspec.it "" rhs) are equal. Modulo random seed-
+    -- and execution time-information.
+    shouldMatchHSpecIt :: IO () -> IO () -> Expectation
+    shouldMatchHSpecIt extraTest hspecTest = do
+        extraRes <- run Extra.it extraTest
+        hspecRes <- run it hspecTest
+        extraRes `shouldBe` hspecRes
+      where
+        run
+            :: (String -> ActionWith () -> SpecWith ()) -- ^ it version
+            -> IO () -- ^ test body
+            -> IO String -- ^ hspec output
+        run anyIt prop = fmap stripTime
+            $ capture_
+            $ flip runSpec defaultConfig
+            $ beforeAll (return ())
+            $ anyIt "<test spec>" (const prop)
+
+        -- | Remove time and seed such that we can compare the captured stdout
+        -- of two different hspec runs.
+        stripTime :: String -> String
+        stripTime = unlines
+                . filter (not . ("Finished in" `isPrefixOf`))
+                . filter (not . ("Randomized" `isPrefixOf`))
+                . lines
+
+    -- | Returns an IO action that is different every time you run it!,
+    -- according to the supplied IORef of outcomes.
+    dynamically
+        :: IORef [IO ()]
+        -> IO ()
+    dynamically outcomes = do
+        outcome:rest <- readIORef outcomes
+        writeIORef outcomes rest
+        outcome