@@ -12,6 +12,7 @@ import Control.Monad.Error.Class (throwError, MonadError)
1212import Control.Monad.Trans.Except (runExceptT, ExceptT)
1313import Data.Foldable (forM_, fold)
1414import Data.List (sort)
15+import System.Mem (performMajorGC)
1516
1617import Data.IORef
1718import Test.Hspec as H
@@ -88,17 +89,24 @@ main = hspec $ do
8889 it "take 1 aheadly" $ checkCleanup aheadly (S.take 1)
8990 it "take 1 parallely" $ checkCleanup parallely (S.take 1)
9091
91−{-
9292 it "takeWhile (< 0) asyncly" $ checkCleanup asyncly (S.takeWhile (< 0))
9393 it "takeWhile (< 0) wAsyncly" $ checkCleanup wAsyncly (S.takeWhile (< 0))
9494 it "takeWhile (< 0) aheadly" $ checkCleanup aheadly (S.takeWhile (< 0))
9595 it "takeWhile (< 0) parallely" $ checkCleanup parallely (S.takeWhile (< 0))
9696
97− it "head asyncly" $ checkCleanupFold asyncly (S.head)
98− it "head wAsyncly" $ checkCleanupFold wAsyncly (S.head)
99− it "head aheadly" $ checkCleanupFold aheadly (S.head)
100− it "head parallely" $ checkCleanupFold parallely (S.head)
101−-}
97+ testFoldOpsCleanup "head" S.head
98+ testFoldOpsCleanup "null" S.null
99+ testFoldOpsCleanup "elem" (S.elem 0)
100+ testFoldOpsCleanup "notElem" (S.notElem 0)
101+ testFoldOpsCleanup "elemIndex" (S.elemIndex 0)
102+ -- S.lookup
103+ testFoldOpsCleanup "notElem" (S.notElem 0)
104+ testFoldOpsCleanup "find" (S.find (==0))
105+ testFoldOpsCleanup "findIndex" (S.findIndex (==0))
106+ testFoldOpsCleanup "all" (S.all (==1))
107+ testFoldOpsCleanup "any" (S.any (==0))
108+ testFoldOpsCleanup "and" (S.and . S.map (==1))
109+ testFoldOpsCleanup "or" (S.or . S.map (==0))
102110
103111 ---------------------------------------------------------------------------
104112 -- Semigroup/Monoidal Composition strict ordering checks
@@ -133,13 +141,13 @@ checkCleanup t op = do
133141 runStream . serially $ do
134142 _ <- t $ op $ delay r 0 S.|: delay r 1 S.|: delay r 2 S.|: S.nil
135143 return ()
144+ performMajorGC
136145 threadDelay 500000
137146 res <- readIORef r
138147 res `shouldBe` 0
139148 where
140− delay ref i = threadDelay (i*100000) >> writeIORef ref i >> return i
149+ delay ref i = threadDelay (i*200000) >> writeIORef ref i >> return i
141150
142−{-
143151checkCleanupFold :: IsStream t
144152 => (t IO Int -> SerialT IO Int)
145153 -> (SerialT IO Int -> IO (Maybe Int))
@@ -147,12 +155,20 @@ checkCleanupFold :: IsStream t
147155checkCleanupFold t op = do
148156 r <- newIORef (-1 :: Int)
149157 _ <- op $ t $ delay r 0 S.|: delay r 1 S.|: delay r 2 S.|: S.nil
158+ performMajorGC
150159 threadDelay 500000
151160 res <- readIORef r
152161 res `shouldBe` 0
153162 where
154− delay ref i = threadDelay (i*100000) >> writeIORef ref i >> return i
155−-}
163+ delay ref i = threadDelay (i*200000) >> writeIORef ref i >> return i
164+
165+testFoldOpsCleanup :: String -> (SerialT IO Int -> IO a) -> Spec
166+testFoldOpsCleanup name f = do
167+ let testOp op x = op x >> return Nothing
168+ it (name ++ " asyncly") $ checkCleanupFold asyncly (testOp f)
169+ it (name ++ " wAsyncly") $ checkCleanupFold wAsyncly (testOp f)
170+ it (name ++ " aheadly") $ checkCleanupFold aheadly (testOp f)
171+ it (name ++ " parallely") $ checkCleanupFold parallely (testOp f)
156172
157173parallelTests :: SpecWith ()
158174parallelTests = H.parallel $ do