@@ -13,12 +13,13 @@ module Streamly.Test.Prelude.Fold where
1313import Control.Concurrent (threadDelay)
1414#endif
1515import Control.Exception (ErrorCall(..), catch)
16−import Data.IORef ( newIORef, readIORef, writeIORef, IORef )
16+import Data.IORef (newIORef, readIORef, writeIORef, IORef)
1717#ifdef COVERAGE_BUILD
1818import Test.Hspec.QuickCheck (modifyMaxSuccess)
1919#endif
2020import Test.Hspec as H
2121#ifdef DEVBUILD
22+import Data.IORef (modifyIORef)
2223import System.Mem (performMajorGC)
2324#endif
2425
@@ -63,14 +64,20 @@ checkCleanupFold :: IsStream t
6364 -> (SerialT IO Int -> IO (Maybe Int))
6465 -> IO ()
6566checkCleanupFold t op = do
66− r <- newIORef (-1 :: Int)
67+ r <- newIORef ([] :: [Int])
6768 _ <- op $ t $ delay r 0 S.|: delay r 2 S.|: delay r 3 S.|: S.nil
6869 performMajorGC
69− threadDelay 700000
70+ -- In case the actions are not killed let them fire before we check so that
71+ -- the test fails.
72+ threadDelay (4 * delayUnit)
7073 res <- readIORef r
71− res `shouldBe` 0
74+ res `shouldBe` [0]
75+
7276 where
73− delay ref i = threadDelay (i*200000) >> writeIORef ref i >> return i
77+
78+ delayUnit = 400000
79+ delay ref i =
80+ threadDelay (i * delayUnit) >> modifyIORef ref (i :) >> return i
7481
7582testFoldOpsCleanup :: String -> (SerialT IO Int -> IO a) -> Spec
7683testFoldOpsCleanup name f = do