git.iko.soy/streamly
on master help sign in
Fix serialize test taking too long, too much mem
191abebHarendra Kumar
benchmark/Streamly/Benchmark/Data/Serialize.hs+1−3
compare with master
unifiedsplit
@@ -268,6 +268,7 @@ instance NFData a => NFData (BinTree a) where
268 rnf (Leaf a) = rnf a `seq` ()
268 rnf (Leaf a) = rnf a `seq` ()
269 rnf (Tree l r) = rnf l `seq` rnf r
269 rnf (Tree l r) = rnf l `seq` rnf r
270
270
271+-- XXX This may not terminate, or could become really large.
271instance Arbitrary a => Arbitrary (BinTree a) where
272instance Arbitrary a => Arbitrary (BinTree a) where
272 arbitrary = oneof [Leaf <$> arbitrary, Tree <$> arbitrary <*> arbitrary]
273 arbitrary = oneof [Leaf <$> arbitrary, Tree <$> arbitrary <*> arbitrary]
273
274
@@ -559,8 +560,6 @@ main = do
559 let !len = length lInt -- evaluate the list
560 let !len = length lInt -- evaluate the list
560#endif
561#endif
561#ifndef FUSION_CHECK
562#ifndef FUSION_CHECK
562− -- This can take too much memory/CPU, need to restrict the test
563− -- runQC
564#ifdef USE_UNBOX
563#ifdef USE_UNBOX
565 runWithCLIOpts defaultStreamSize allBenchmarks
564 runWithCLIOpts defaultStreamSize allBenchmarks
566#else
565#else
@@ -568,7 +567,6 @@ main = do
568 `seq` runWithCLIOpts
567 `seq` runWithCLIOpts
569 defaultStreamSize
568 defaultStreamSize
570 (allBenchmarks tInt lInt recL recR)
569 (allBenchmarks tInt lInt recL recR)
571−
572#endif
570#endif
573#else
571#else
574 -- Enable FUSION_CHECK macro at the beginning of the file
572 -- Enable FUSION_CHECK macro at the beginning of the file
test/Streamly/Test/Data/Serialize.hs+20−1
@@ -109,9 +109,19 @@ $(Serialize.deriveSerializeWith
109 CONF
109 CONF
110 [d|instance Serialize a => Serialize (BinTree a)|])
110 [d|instance Serialize a => Serialize (BinTree a)|])
111
111
112+-- XXX This may not terminate, or could become really large.
112instance Arbitrary a => Arbitrary (BinTree a) where
113instance Arbitrary a => Arbitrary (BinTree a) where
113 arbitrary = oneof [Leaf <$> arbitrary, Tree <$> arbitrary <*> arbitrary]
114 arbitrary = oneof [Leaf <$> arbitrary, Tree <$> arbitrary <*> arbitrary]
114
115
116+-- Make a balanced tree of given level
117+mkBinTree :: (Arbitrary a) => Int -> IO (BinTree a)
118+mkBinTree = go (generate arbitrary)
119+
120+ where
121+
122+ go r 0 = Leaf <$> r
123+ go r n = Tree <$> go r (n - 1) <*> go r (n - 1)
124+
115--------------------------------------------------------------------------------
125--------------------------------------------------------------------------------
116-- Record syntax type
126-- Record syntax type
117--------------------------------------------------------------------------------
127--------------------------------------------------------------------------------
@@ -207,6 +217,10 @@ roundtrip
207 -> IO ()
217 -> IO ()
208roundtrip val = do
218roundtrip val = do
209
219
220+ -- For debugging large size generated by arbitrary
221+ -- let sz = Serialize.addSizeTo 0 val
222+ -- putStrLn $ "Size is: " ++ show sz
223+
210 val `shouldBe` Array.deserialize (Array.pinnedSerialize val)
224 val `shouldBe` Array.deserialize (Array.pinnedSerialize val)
211
225
212 res <- poke val
226 res <- poke val
@@ -270,7 +284,12 @@ testCases = do
270 $ \(x :: [CustomDatatype]) -> roundtrip x
284 $ \(x :: [CustomDatatype]) -> roundtrip x
271
285
272 limitQC
286 limitQC
273− $ prop "BinTree" $ \(x :: BinTree Int) -> roundtrip x
287+ $ prop "BinTree"
288+ $ forAll (elements [1..15])
289+ (\(x :: Int) -> do
290+ (r :: BinTree Int) <- mkBinTree x
291+ roundtrip r
292+ )
274
293
275 where
294 where
276
295