From 191abebe920cfb4eb3a6e37d070ef9d100b517c9 Mon Sep 17 00:00:00 2001
From: Harendra Kumar <harendra@composewell.com>
Date: Thu, 4 Jan 2024 06:50:24 +0530
Subject: [PATCH] Fix serialize test taking too long, too much mem

---
 .../Streamly/Benchmark/Data/Serialize.hs      |  4 +---
 test/Streamly/Test/Data/Serialize.hs          | 21 ++++++++++++++++++-
 2 files changed, 21 insertions(+), 4 deletions(-)

diff --git a/benchmark/Streamly/Benchmark/Data/Serialize.hs b/benchmark/Streamly/Benchmark/Data/Serialize.hs
index 93e549e3f..b71e46a73 100644
--- a/benchmark/Streamly/Benchmark/Data/Serialize.hs
+++ b/benchmark/Streamly/Benchmark/Data/Serialize.hs
@@ -268,6 +268,7 @@ instance NFData a => NFData (BinTree a) where
   rnf (Leaf a) = rnf a `seq` ()
   rnf (Tree l r) = rnf l `seq` rnf r
 
+-- XXX This may not terminate, or could become really large.
 instance Arbitrary a => Arbitrary (BinTree a) where
   arbitrary = oneof [Leaf <$> arbitrary, Tree <$> arbitrary <*> arbitrary]
 
@@ -559,8 +560,6 @@ main = do
     let !len = length lInt -- evaluate the list
 #endif
 #ifndef FUSION_CHECK
-    -- This can take too much memory/CPU, need to restrict the test
-    -- runQC
 #ifdef USE_UNBOX
     runWithCLIOpts defaultStreamSize allBenchmarks
 #else
@@ -568,7 +567,6 @@ main = do
         `seq` runWithCLIOpts
                   defaultStreamSize
                   (allBenchmarks tInt lInt recL recR)
-
 #endif
 #else
     -- Enable FUSION_CHECK macro at the beginning of the file
diff --git a/test/Streamly/Test/Data/Serialize.hs b/test/Streamly/Test/Data/Serialize.hs
index 6c6e97caa..a8d55f752 100644
--- a/test/Streamly/Test/Data/Serialize.hs
+++ b/test/Streamly/Test/Data/Serialize.hs
@@ -109,9 +109,19 @@ $(Serialize.deriveSerializeWith
       CONF
       [d|instance Serialize a => Serialize (BinTree a)|])
 
+-- XXX This may not terminate, or could become really large.
 instance Arbitrary a => Arbitrary (BinTree a) where
   arbitrary = oneof [Leaf <$> arbitrary, Tree <$> arbitrary <*> arbitrary]
 
+-- Make a balanced tree of given level
+mkBinTree :: (Arbitrary a) => Int -> IO (BinTree a)
+mkBinTree = go (generate arbitrary)
+
+    where
+
+    go r 0 = Leaf <$> r
+    go r n = Tree <$> go r (n - 1) <*> go r (n - 1)
+
 --------------------------------------------------------------------------------
 -- Record syntax type
 --------------------------------------------------------------------------------
@@ -207,6 +217,10 @@ roundtrip
     -> IO ()
 roundtrip val = do
 
+    -- For debugging large size generated by arbitrary
+    -- let sz = Serialize.addSizeTo 0 val
+    -- putStrLn $ "Size is: " ++ show sz
+
     val `shouldBe` Array.deserialize (Array.pinnedSerialize val)
 
     res <- poke val
@@ -270,7 +284,12 @@ testCases = do
         $ \(x :: [CustomDatatype]) -> roundtrip x
 
     limitQC
-        $ prop "BinTree" $ \(x :: BinTree Int) -> roundtrip x
+        $ prop "BinTree"
+        $ forAll (elements [1..15])
+            (\(x :: Int) -> do
+                (r :: BinTree Int) <- mkBinTree x
+                roundtrip r
+            )
 
     where