diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -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 diff --git a/src/Test/Syd/Def/Golden.hs b/src/Test/Syd/Def/Golden.hs --- a/src/Test/Syd/Def/Golden.hs +++ b/src/Test/Syd/Def/Golden.hs @@ -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. diff --git a/src/Test/Syd/Expectation.hs b/src/Test/Syd/Expectation.hs --- a/src/Test/Syd/Expectation.hs +++ b/src/Test/Syd/Expectation.hs @@ -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 -- diff --git a/src/Test/Syd/Output.hs b/src/Test/Syd/Output.hs --- a/src/Test/Syd/Output.hs +++ b/src/Test/Syd/Output.hs @@ -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. diff --git a/src/Test/Syd/Run.hs b/src/Test/Syd/Run.hs --- a/src/Test/Syd/Run.hs +++ b/src/Test/Syd/Run.hs @@ -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 diff --git a/sydtest.cabal b/sydtest.cabal --- a/sydtest.cabal +++ b/sydtest.cabal @@ -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