@@ -14,7 +14,7 @@ import Data.Foldable (forM_, fold)
1414import Data.List (sort)
1515
1616import Data.IORef
17−import Test.Hspec
17+import Test.Hspec as H
1818
1919import Streamly
2020import Streamly.Prelude ((.:), nil)
@@ -37,6 +37,76 @@ toListParallel = S.toList . wAsyncly
3737
3838main :: IO ()
3939main = hspec $ do
40+ parallelTests
41+
42+ describe "Nested parallel and serial compositions" $ do
43+ let t = timed
44+ p = wAsyncly
45+ s = serially
46+ {-
47+ -- This is not correct, the result can also be [4,4,8,0,8,0,2,2]
48+ -- because of parallelism of [8,0] and [8,0].
49+ it "Nest <|>, <>, <|> (1)" $
50+ let t = timed
51+ in toListSerial (
52+ ((t 8 <|> t 4) <> (t 2 <|> t 0))
53+ <|> ((t 8 <|> t 4) <> (t 2 <|> t 0)))
54+ `shouldReturn` ([4,4,8,8,0,0,2,2])
55+ -}
56+ it "Nest <|>, <>, <|> (2)" $
57+ (S.toList . wAsyncly) (
58+ s (p (t 4 <> t 8) <> p (t 1 <> t 2))
59+ <> s (p (t 4 <> t 8) <> p (t 1 <> t 2)))
60+ `shouldReturn` ([4,4,8,8,1,1,2,2])
61+ -- FIXME: These two keep failing intermittently on Mac OS X
62+ -- Need to examine and fix the tests.
63+ {-
64+ it "Nest <|>, <=>, <|> (1)" $
65+ let t = timed
66+ in toListSerial (
67+ ((t 8 <|> t 4) <=> (t 2 <|> t 0))
68+ <|> ((t 9 <|> t 4) <=> (t 2 <|> t 0)))
69+ `shouldReturn` ([4,4,0,0,8,2,9,2])
70+ it "Nest <|>, <=>, <|> (2)" $
71+ let t = timed
72+ in toListSerial (
73+ ((t 4 <|> t 8) <=> (t 1 <|> t 2))
74+ <|> ((t 4 <|> t 9) <=> (t 1 <|> t 2)))
75+ `shouldReturn` ([4,4,1,1,8,2,9,2])
76+ -}
77+ it "Nest <|>, <|>, <|>" $
78+ (S.toList . wAsyncly) (
79+ ((t 4 <> t 8) <> (t 0 <> t 2))
80+ <> ((t 4 <> t 8) <> (t 0 <> t 2)))
81+ `shouldReturn` ([0,0,2,2,4,4,8,8])
82+
83+ ---------------------------------------------------------------------------
84+ -- Semigroup/Monoidal Composition strict ordering checks
85+ ---------------------------------------------------------------------------
86+
87+ -- test both (<>) and mappend to make sure we are using correct instance
88+ -- for Monoid that is using the right version of semigroup. Instance
89+ -- deriving can cause us to pick wrong instances sometimes.
90+
91+ describe "WSerial interleaved (<>) ordering check" $ interleaveCheck wSerially (<>)
92+ describe "WSerial interleaved mappend ordering check" $ interleaveCheck wSerially mappend
93+
94+ -- describe "WAsync interleaved (<>) ordering check" $ interleaveCheck wAsyncly (<>)
95+ -- describe "WAsync interleaved mappend ordering check" $ interleaveCheck wAsyncly mappend
96+
97+ describe "Async (<>) time order check" $ parallelCheck asyncly (<>)
98+ describe "Async mappend time order check" $ parallelCheck asyncly mappend
99+
100+ -- XXX this keeps failing intermittently, need to investigate
101+ -- describe "WAsync (<>) time order check" $ parallelCheck wAsyncly (<>)
102+ -- describe "WAsync mappend time order check" $ parallelCheck wAsyncly mappend
103+
104+ describe "Parallel (<>) time order check" $ parallelCheck parallely (<>)
105+ describe "Parallel mappend time order check" $ parallelCheck parallely mappend
106+
107+
108+parallelTests :: SpecWith ()
109+parallelTests = H.parallel $ do
40110 describe "Runners" $ do
41111 -- XXX move these to property tests
42112 -- XXX use an IORef to store and check the side effects
@@ -142,47 +212,6 @@ main = hspec $ do
142212 , [1, 7, 4, 8, 2, 9, 5, 3, 6]
143213 ])
144214
145− describe "Nested parallel and serial compositions" $ do
146− let t = timed
147− p = wAsyncly
148− s = serially
149− {-
150− -- This is not correct, the result can also be [4,4,8,0,8,0,2,2]
151− -- because of parallelism of [8,0] and [8,0].
152− it "Nest <|>, <>, <|> (1)" $
153− let t = timed
154− in toListSerial (
155− ((t 8 <|> t 4) <> (t 2 <|> t 0))
156− <|> ((t 8 <|> t 4) <> (t 2 <|> t 0)))
157− `shouldReturn` ([4,4,8,8,0,0,2,2])
158− -}
159− it "Nest <|>, <>, <|> (2)" $
160− (S.toList . wAsyncly) (
161− s (p (t 4 <> t 8) <> p (t 1 <> t 2))
162− <> s (p (t 4 <> t 8) <> p (t 1 <> t 2)))
163− `shouldReturn` ([4,4,8,8,1,1,2,2])
164− -- FIXME: These two keep failing intermittently on Mac OS X
165− -- Need to examine and fix the tests.
166− {-
167− it "Nest <|>, <=>, <|> (1)" $
168− let t = timed
169− in toListSerial (
170− ((t 8 <|> t 4) <=> (t 2 <|> t 0))
171− <|> ((t 9 <|> t 4) <=> (t 2 <|> t 0)))
172− `shouldReturn` ([4,4,0,0,8,2,9,2])
173− it "Nest <|>, <=>, <|> (2)" $
174− let t = timed
175− in toListSerial (
176− ((t 4 <|> t 8) <=> (t 1 <|> t 2))
177− <|> ((t 4 <|> t 9) <=> (t 1 <|> t 2)))
178− `shouldReturn` ([4,4,1,1,8,2,9,2])
179− -}
180− it "Nest <|>, <|>, <|>" $
181− (S.toList . wAsyncly) (
182− ((t 4 <> t 8) <> (t 0 <> t 2))
183− <> ((t 4 <> t 8) <> (t 0 <> t 2)))
184− `shouldReturn` ([0,0,2,2,4,4,8,8])
185−
186215 ---------------------------------------------------------------------------
187216 -- Monoidal composition recursion loops
188217 ---------------------------------------------------------------------------
@@ -387,30 +416,6 @@ main = hspec $ do
387416 -- Slower tests are at the end
388417 ---------------------------------------------------------------------------
389418
390− ---------------------------------------------------------------------------
391− -- Semigroup/Monoidal Composition strict ordering checks
392− ---------------------------------------------------------------------------
393−
394− -- test both (<>) and mappend to make sure we are using correct instance
395− -- for Monoid that is using the right version of semigroup. Instance
396− -- deriving can cause us to pick wrong instances sometimes.
397−
398− describe "WSerial interleaved (<>) ordering check" $ interleaveCheck wSerially (<>)
399− describe "WSerial interleaved mappend ordering check" $ interleaveCheck wSerially mappend
400−
401− -- describe "WAsync interleaved (<>) ordering check" $ interleaveCheck wAsyncly (<>)
402− -- describe "WAsync interleaved mappend ordering check" $ interleaveCheck wAsyncly mappend
403−
404− describe "Async (<>) time order check" $ parallelCheck asyncly (<>)
405− describe "Async mappend time order check" $ parallelCheck asyncly mappend
406−
407− -- XXX this keeps failing intermittently, need to investigate
408− -- describe "WAsync (<>) time order check" $ parallelCheck wAsyncly (<>)
409− -- describe "WAsync mappend time order check" $ parallelCheck wAsyncly mappend
410−
411− describe "Parallel (<>) time order check" $ parallelCheck parallely (<>)
412− describe "Parallel mappend time order check" $ parallelCheck parallely mappend
413−
414419 ---------------------------------------------------------------------------
415420 -- Thread limits
416421 ---------------------------------------------------------------------------