sydtest 0.17.0.2 → 0.18.0.0
raw patch · 6 files changed
+147/−43 lines, 6 filesdep +deepseqdep ~fast-myers-diff
Dependencies added: deepseq
Dependency ranges changed: fast-myers-diff
Files
- CHANGELOG.md +42/−0
- src/Test/Syd/Def/Golden.hs +29/−24
- src/Test/Syd/Expectation.hs +15/−10
- src/Test/Syd/Output.hs +18/−6
- src/Test/Syd/Run.hs +40/−1
- sydtest.cabal +3/−2
CHANGELOG.md view
@@ -1,5 +1,47 @@ # Changelog +## [0.18.0.0] - 2024-09-26++### Added++- The test `Assertion` which displays a diff in case of error (so `shouldBe`,+ `shouldReturn`, golden tests and variations) will now timeout (after `2s`)+ when computing the diff between expected and actual value.+ In case of timeout, the values are displayed without any diff formatting.+ This ensure that test suite runtime won't be dominated by computing diff on+ some pathological cases.+- The smart constructor `mkNotEqualButShouldHaveBeenEqual` +- You can use your own diff algorithm using the constructor+ `NotEqualButShouldHaveBeenEqualWithDiff`.+- Test suite does not crash if failed assertion tries to print values+ containing lazy exception.+ For example `shouldBe (1, error "nop") (2, 3)` was crashing before.+ The exception is now reported as the failure reason for the test.+ Note that this can be counter intuitive, because the test is failing because+ values are not equal (e.g. `(1, _) != (2, _)`), and this will be reported+ differently.+++### Changed++The diff computation between actual value and reference changed so diff can+timeout.++This does not change the usual API (`shouldBe` or `GoldenTest`), but some+internal changed and you may need to adapt.+The change is straightforward, most of the functions are not `IO`:++- `stringsNotEqualButShouldHaveBeenEqual`,+ `textsNotEqualButShouldHaveBeenEqual` and+ `bytestringsNotEqualButShouldHaveBeenEqual` are now `IO Assertion` (was+ `Assertion`) in order to implement the timeout logic described for+ `shouldBe`.+ The `Assertion` `NotEqualButShouldHaveBeenEqual` is removed and replaced by+ `NotEqualButShouldHaveBeenEqualWithDiff` which embed the difference between+ both values.+- The record field `goldenTestCompare` of `GoldenTest` changed from `a -> a ->+ Maybe Assertion` to `a -> a -> IO (Maybe Assertion)`.+ ## [0.17.0.2] - 2024-09-26 ### Changed
src/Test/Syd/Def/Golden.hs view
@@ -34,10 +34,11 @@ ensureDir $ parent resolvedFile SB.writeFile (fromAbsFile resolvedFile) actual, goldenTestCompare = \actual expected ->- pure $- if actual == expected- then Nothing- else Just $ Context (bytestringsNotEqualButShouldHaveBeenEqual actual expected) (goldenContext fp)+ if actual == expected+ then pure Nothing+ else do+ assertion <- bytestringsNotEqualButShouldHaveBeenEqual actual expected+ pure $ Just $ Context assertion (goldenContext fp) } -- | Test that the given lazy bytestring is the same as what we find in the given golden file.@@ -61,12 +62,13 @@ ensureDir $ parent resolvedFile SB.writeFile (fromAbsFile resolvedFile) (LB.toStrict actual), goldenTestCompare = \actual expected ->- pure $- let actualBS = LB.toStrict actual- expectedBS = LB.toStrict expected- in if actualBS == expectedBS- then Nothing- else Just $ Context (bytestringsNotEqualButShouldHaveBeenEqual actualBS expectedBS) (goldenContext fp)+ let actualBS = LB.toStrict actual+ expectedBS = LB.toStrict expected+ in if actualBS == expectedBS+ then pure Nothing+ else do+ assertion <- bytestringsNotEqualButShouldHaveBeenEqual actualBS expectedBS+ pure $ Just $ Context assertion (goldenContext fp) } -- | Test that the given lazy bytestring is the same as what we find in the given golden file.@@ -90,12 +92,13 @@ ensureDir $ parent resolvedFile SB.writeFile (fromAbsFile resolvedFile) (LB.toStrict (SBB.toLazyByteString actual)), goldenTestCompare = \actual expected ->- pure $- let actualBS = LB.toStrict (SBB.toLazyByteString actual)- expectedBS = LB.toStrict (SBB.toLazyByteString expected)- in if actualBS == expectedBS- then Nothing- else Just $ Context (bytestringsNotEqualButShouldHaveBeenEqual actualBS expectedBS) (goldenContext fp)+ let actualBS = LB.toStrict (SBB.toLazyByteString actual)+ expectedBS = LB.toStrict (SBB.toLazyByteString expected)+ in if actualBS == expectedBS+ then pure Nothing+ else do+ assertion <- bytestringsNotEqualButShouldHaveBeenEqual actualBS expectedBS+ pure $ Just $ Context assertion (goldenContext fp) } -- | Test that the given text is the same as what we find in the given golden file.@@ -115,10 +118,11 @@ ensureDir $ parent resolvedFile SB.writeFile (fromAbsFile resolvedFile) (TE.encodeUtf8 actual), goldenTestCompare = \actual expected ->- pure $- if actual == expected- then Nothing- else Just $ Context (textsNotEqualButShouldHaveBeenEqual actual expected) (goldenContext fp)+ if actual == expected+ then pure Nothing+ else do+ assertion <- textsNotEqualButShouldHaveBeenEqual actual expected+ pure $ Just $ Context assertion (goldenContext fp) } -- | Test that the given string is the same as what we find in the given golden file.@@ -138,10 +142,11 @@ ensureDir $ parent resolvedFile SB.writeFile (fromAbsFile resolvedFile) (TE.encodeUtf8 (T.pack actual)), goldenTestCompare = \actual expected ->- pure $- if actual == expected- then Nothing- else Just $ Context (stringsNotEqualButShouldHaveBeenEqual actual expected) (goldenContext fp)+ if actual == expected+ then pure Nothing+ else do+ assertion <- stringsNotEqualButShouldHaveBeenEqual actual expected+ pure $ Just $ Context assertion (goldenContext fp) } -- | Test that the show instance has not changed for the given value.
src/Test/Syd/Expectation.hs view
@@ -11,20 +11,25 @@ #if MIN_VERSION_mtl(2,3,0) import Control.Monad (unless, when) #endif+import Control.DeepSeq (force) import Control.Monad.Reader import Data.ByteString (ByteString) import Data.List import Data.Text (Text) import qualified Data.Text as T import Data.Typeable+import qualified Data.Vector as V import GHC.Stack+import Myers.Diff (Diff, getTextDiff)+import System.Timeout (timeout) import Test.QuickCheck.IO () import Test.Syd.Run+import Text.Colour (Chunk) import Text.Show.Pretty -- | Assert that two values are equal according to `==`. shouldBe :: (HasCallStack, Show a, Eq a) => a -> a -> IO ()-shouldBe actual expected = unless (actual == expected) $ throwIO $ NotEqualButShouldHaveBeenEqual (ppShow actual) (ppShow expected)+shouldBe actual expected = unless (actual == expected) $ throwIO =<< mkNotEqualButShouldHaveBeenEqual actual expected infix 1 `shouldBe` @@ -58,7 +63,7 @@ shouldReturn :: (HasCallStack, Show a, Eq a) => IO a -> a -> IO () shouldReturn computeActual expected = do actual <- computeActual- unless (actual == expected) $ throwIO $ NotEqualButShouldHaveBeenEqual (ppShow actual) (ppShow expected)+ unless (actual == expected) $ throwIO =<< mkNotEqualButShouldHaveBeenEqual actual expected infix 1 `shouldReturn` @@ -100,32 +105,32 @@ -- Note that using function could mess up the colours in your terminal if the Texts contain ANSI codes. -- In that case you may want to `show` your values first or use `shouldBe` instead. stringShouldBe :: (HasCallStack) => String -> String -> IO ()-stringShouldBe actual expected = unless (actual == expected) $ throwIO $ stringsNotEqualButShouldHaveBeenEqual actual expected+stringShouldBe actual expected = unless (actual == expected) $ throwIO =<< stringsNotEqualButShouldHaveBeenEqual actual expected -- | Assert that two 'Text's are equal according to `==`. -- -- Note that using function could mess up the colours in your terminal if the Texts contain ANSI codes. -- In that case you may want to `show` your values first or use `shouldBe` instead. textShouldBe :: (HasCallStack) => Text -> Text -> IO ()-textShouldBe actual expected = unless (actual == expected) $ throwIO $ textsNotEqualButShouldHaveBeenEqual actual expected+textShouldBe actual expected = unless (actual == expected) $ throwIO =<< textsNotEqualButShouldHaveBeenEqual actual expected -- | An assertion that says two 'String's should have been equal according to `==`. -- -- Note that using function could mess up the colours in your terminal if the Texts contain ANSI codes. -- In that case you may want to `show` your values first or use `shouldBe` instead.-stringsNotEqualButShouldHaveBeenEqual :: String -> String -> Assertion-stringsNotEqualButShouldHaveBeenEqual actual expected = NotEqualButShouldHaveBeenEqual actual expected+stringsNotEqualButShouldHaveBeenEqual :: String -> String -> IO Assertion+stringsNotEqualButShouldHaveBeenEqual actual expected = mkNotEqualButShouldHaveBeenEqual actual expected -- | An assertion that says two 'Text's should have been equal according to `==`. -- -- Note that using function could mess up the colours in your terminal if the Texts contain ANSI codes. -- In that case you may want to `show` your values first or use `shouldBe` instead.-textsNotEqualButShouldHaveBeenEqual :: Text -> Text -> Assertion-textsNotEqualButShouldHaveBeenEqual actual expected = NotEqualButShouldHaveBeenEqual (T.unpack actual) (T.unpack expected)+textsNotEqualButShouldHaveBeenEqual :: Text -> Text -> IO Assertion+textsNotEqualButShouldHaveBeenEqual actual expected = mkNotEqualButShouldHaveBeenEqual (T.unpack actual) (T.unpack expected) -- | An assertion that says two 'ByteString's should have been equal according to `==`.-bytestringsNotEqualButShouldHaveBeenEqual :: ByteString -> ByteString -> Assertion-bytestringsNotEqualButShouldHaveBeenEqual actual expected = NotEqualButShouldHaveBeenEqual (show actual) (show expected)+bytestringsNotEqualButShouldHaveBeenEqual :: ByteString -> ByteString -> IO Assertion+bytestringsNotEqualButShouldHaveBeenEqual actual expected = mkNotEqualButShouldHaveBeenEqual (show actual) (show expected) -- | Make a test fail --
src/Test/Syd/Output.hs view
@@ -4,6 +4,7 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeSynonymInstances #-} module Test.Syd.Output where @@ -16,12 +17,12 @@ import Data.Map (Map) import qualified Data.Map as M import Data.Maybe+import Data.String (IsString (..)) import Data.Text (Text) import qualified Data.Text as T import qualified Data.Text.Lazy.Builder as LTB import qualified Data.Text.Lazy.Builder as Text import qualified Data.Text.Lazy.IO as LTIO-import qualified Data.Vector as V import Data.Word import GHC.Stack import Myers.Diff@@ -413,7 +414,7 @@ outputAssertion :: Assertion -> [[Chunk]] outputAssertion = \case- NotEqualButShouldHaveBeenEqual actual expected -> outputEqualityAssertionFailed actual expected+ NotEqualButShouldHaveBeenEqualWithDiff actual expected diffM -> outputEqualityAssertionFailed actual expected diffM EqualButShouldNotHaveBeenEqual actual notExpected -> outputNotEqualAssertionFailed actual notExpected PredicateFailedButShouldHaveSucceeded actual mName -> outputPredicateSuccessAssertionFailed actual mName PredicateSucceededButShouldHaveFailed actual mName -> outputPredicateFailAssertionFailed actual mName@@ -461,10 +462,21 @@ -- We skip them one by one. Just ne -> currentLine : go ne cs -outputEqualityAssertionFailed :: String -> String -> [[Chunk]]-outputEqualityAssertionFailed actual expected =- let diff = V.toList $ getTextDiff (T.pack actual) (T.pack expected)- -- Add a header to a list of lines of chunks+outputEqualityAssertionFailed :: String -> String -> Maybe [PolyDiff Text Text] -> [[Chunk]]+outputEqualityAssertionFailed actual expected diffM =+ case diffM of+ Just diff -> formatDiff actual expected diff+ Nothing ->+ concat+ [ [[chunk "Expected these values to be equal:"]],+ [[chunk "Diff computation took too long and was canceled"]],+ [[fromString actual]],+ [[fromString expected]]+ ]++formatDiff :: String -> String -> [PolyDiff Text Text] -> [[Chunk]]+formatDiff actual expected diff =+ let -- Add a header to a list of lines of chunks chunksLinesWithHeader :: Chunk -> [[Chunk]] -> [[Chunk]] chunksLinesWithHeader header = \case -- If there is only one line, put the header on that line.
src/Test/Syd/Run.hs view
@@ -4,6 +4,7 @@ {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE LambdaCase #-}+{-# LANGUAGE NumDecimals #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE RecordWildCards #-}@@ -16,17 +17,23 @@ import Autodocodec import Control.Concurrent import Control.Concurrent.STM+import Control.DeepSeq (force) import Control.Exception import Control.Monad.IO.Class import Control.Monad.Reader import Data.IORef import Data.Map (Map) import qualified Data.Map as M+import Data.Text (Text)+import qualified Data.Text as T import Data.Typeable+import qualified Data.Vector as V import Data.Word import GHC.Clock (getMonotonicTimeNSec) import GHC.Generics (Generic)+import Myers.Diff (Diff, getTextDiff) import OptEnvConf+import System.Timeout (timeout) import Test.QuickCheck import Test.QuickCheck.Gen import Test.QuickCheck.IO ()@@ -34,6 +41,7 @@ import qualified Test.QuickCheck.Property as QCP import Test.QuickCheck.Random import Text.Printf+import Text.Show.Pretty (ppShow) class IsTest e where -- | The argument from 'aroundAll'@@ -486,7 +494,9 @@ -- -- You will probably not want to use this directly in everyday tests, use `shouldBe` or a similar function instead. data Assertion- = NotEqualButShouldHaveBeenEqual !String !String+ = -- | Both strings are not equal. The latest argument is a diff between both+ -- arguments. If `Nothing`, the raw values will be displayed instead of the diff.+ NotEqualButShouldHaveBeenEqualWithDiff !String !String !(Maybe [Diff Text]) | EqualButShouldNotHaveBeenEqual !String !String | PredicateSucceededButShouldHaveFailed !String -- Value@@ -497,6 +507,35 @@ | ExpectationFailed !String | Context !Assertion !String deriving (Show, Eq, Typeable, Generic)++-- | Returns the diff between two strings+--+-- Be careful, this function runtime is not bounded and it can take a lot of+-- time (hours) if the input strings are complex. This is exposed for+-- reference, but you may want to use 'mkNotEqualButShouldHaveBeenEqual' which+-- ensures that diff computation timeouts.+computeDiff :: String -> String -> [Diff Text]+computeDiff a b = V.toList $ getTextDiff (T.pack a) (T.pack b)++-- | Assertion when both arguments are not equal. While display a diff between+-- both at the end of tests. The diff computation is cancelled after 2s.+mkNotEqualButShouldHaveBeenEqual ::+ (Show a) =>+ a ->+ a ->+ IO Assertion+mkNotEqualButShouldHaveBeenEqual actual expected = do+ let ppActual = ppShow actual+ let ppExpected = ppShow expected++ let diffNotEvaluated = computeDiff ppActual ppExpected+ -- we want to evaluate the diff in order to ensure that its+ -- computation happen in the timeout block+ -- and is not instead later because of lazy evaluation.+ --+ -- The safe option here is to evaluate to normal form with `force`.+ diff <- timeout 2e6 (evaluate (force diffNotEvaluated))+ pure $ NotEqualButShouldHaveBeenEqualWithDiff ppActual ppExpected diff instance Exception Assertion
sydtest.cabal view
@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack name: sydtest-version: 0.17.0.2+version: 0.18.0.0 synopsis: A modern testing framework for Haskell with good defaults and advanced testing features. description: A modern testing framework for Haskell with good defaults and advanced testing features. Sydtest aims to make the common easy and the hard possible. See https://github.com/NorfairKing/sydtest#readme for more information. category: Testing@@ -66,8 +66,9 @@ , base >=4.7 && <5 , bytestring , containers+ , deepseq , dlist- , fast-myers-diff+ , fast-myers-diff >=0.0.1 , filepath , mtl , opt-env-conf >=0.5