Comment message to be developed.

But this partially fix NorfairKing#92
by introducing a timeout of 2s on the diff computatation.

The 2s is hardcoded yada yada

sydtest-test/test/Test/Syd/TimingSpec.hs

@@ -6,7 +6,11 @@
 module Test.Syd.TimingSpec (spec) where
 
 import Control.Concurrent
+import Control.Exception (try)
+import Control.Monad
+import GHC.IO.Exception (ExitCode)
 import System.IO.Unsafe
+import System.Timeout (timeout)
 import Test.QuickCheck
 import Test.Syd
 
@@ -28,6 +32,31 @@ spec = doNotRandomiseExecutionOrder $ do
   it "takes at least 100 milliseconds (property) " $
     property $ \() -> do
       threadDelay 10_000
+  -- Ensure that long diff timeouts
+  -- See https://github.com/NorfairKing/sydtest/issues/92
+  it "long diff timing is bounded" $ do
+    -- with n = 1000 it takes 30s on my laptop, so 10k is enough to trigger the
+    -- 2s timeout.
+    let n = 10_0000
+    let test = do
+          res <- try $ sydTest $ do
+            it "test" $ do
+              let numbers = [0, 1 .. n]
+                  numbers' = reverse numbers
+
+              numbers `shouldBe` numbers'
+
+          case res of
+            Right () -> fail "The subtest must fail"
+            Left (_ :: ExitCode) -> pure ()
+
+    -- We timeout after 10s. If the test timeouts by itself, it means that the
+    -- diff timeout worked after 2seconds.
+    --
+    -- Why 10s? Because it's more than 2s, and gives enough room for scheduling
+    -- and additional operations (such as generating the random numbers)
+    -- without too much risk of generating a flaky test.
+    timeout 10_000_000 test `shouldReturn` Just ()
 
 {-# NOINLINE take10ms #-}
 take10ms :: IO ()

sydtest/default.nix

@@ -1,5 +1,5 @@
 { mkDerivation, async, autodocodec, base, bytestring, containers
-, dlist, fast-myers-diff, filepath, lib, MonadRandom, mtl
+, deepseq, dlist, fast-myers-diff, filepath, lib, MonadRandom, mtl
 , opt-env-conf, path, path-io, pretty-show, QuickCheck
 , quickcheck-io, random, random-shuffle, safe, safe-coloured-text
 , safe-coloured-text-terminfo, stm, svg-builder, text, vector
@@ -9,9 +9,9 @@ mkDerivation {
   version = "0.17.0.0";
   src = ./.;
   libraryHaskellDepends = [
-    async autodocodec base bytestring containers dlist fast-myers-diff
-    filepath MonadRandom mtl opt-env-conf path path-io pretty-show
-    QuickCheck quickcheck-io random random-shuffle safe
+    async autodocodec base bytestring containers deepseq dlist
+    fast-myers-diff filepath MonadRandom mtl opt-env-conf path path-io
+    pretty-show QuickCheck quickcheck-io random random-shuffle safe
     safe-coloured-text safe-coloured-text-terminfo stm svg-builder text
     vector
   ];

sydtest/src/Test/Syd/Output.hs

@@ -1,9 +1,11 @@
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE MultiWayIf #-}
+{-# LANGUAGE NumDecimals #-}
 {-# LANGUAGE NumericUnderscores #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeSynonymInstances #-}
 
 module Test.Syd.Output where
 
@@ -16,16 +18,20 @@ import qualified Data.List.NonEmpty as NE
 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.Generics
+import GHC.IO (unsafePerformIO)
 import GHC.Stack
 import Myers.Diff
 import Safe
+import System.Timeout (timeout)
 import Test.QuickCheck.IO ()
 import Test.Syd.OptParse
 import Test.Syd.Run
@@ -463,8 +469,36 @@ splitChunksIntoLines =
 
 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
+  let diffM = unsafePerformIO $ do
+        let diff = getTextDiff (T.pack actual) (T.pack expected)
+        -- we want to evaluate the diff in order to ensure that its
+        -- computation happen in the timeout block
+        -- and is not instead lazyly passed to the caller.
+        --
+        -- The safe option would be to @force diff@ to normal form, however
+        -- there are no 'NFData' instances on 'Diff Text'.
+        --
+        -- The option right now is to force the vector to WHNF, which should
+        -- work because the length of a vector must be known when in WHNF,
+        -- meaning that the diff algorithm at least computed the number of
+        -- diffs.
+        --
+        -- If a future optimisation of the diff algo happen which leads to
+        -- more lazyness, let's hope that the unit test will catch it.
+        timeout 2e6 (V.toList <$> evaluate diff)
+   in 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.