Fix stack_overflow in #156 and update expected output

src/core/QCheck2.ml

@@ -527,14 +527,16 @@ module Gen = struct
 
   let ui64 : int64 t = map Int64.abs int64
 
+  (* A tail-recursive implementation over Tree.t *)
   let list_size (size : int t) (gen : 'a t) : 'a list t =
-    size >>= fun size ->
-    let rec loop n =
+    fun st ->
+    Tree.bind (size st) @@ fun size ->
+    let rec loop n acc =
       if n <= 0
-      then pure []
-      else liftA2 List.cons gen (loop (n - 1))
+      then acc
+      else (loop [@tailcall]) (n - 1) (Tree.liftA2 List.cons (gen st) acc)
     in
-    loop size
+    loop size (Tree.pure [])
 
   let list (gen : 'a t) : 'a list t = list_size nat gen
 

test/core/qcheck2_output.txt.expected

@@ -316,27 +316,21 @@ Test lists shorter than 10 failed (16 shrink steps):
 
 --- Failure --------------------------------------------------------------------
 
-Test lists shorter than 432 failed:
+Test lists shorter than 432 failed (412 shrink steps):
 
-ERROR: uncaught exception in generator for test lists shorter than 432 after 100 steps:
-Exception: Stack overflow
-Backtrace: 
+[...] list length: 432
 
 --- Failure --------------------------------------------------------------------
 
-Test lists shorter than 4332 failed:
+Test lists shorter than 4332 failed (4022 shrink steps):
 
-ERROR: uncaught exception in generator for test lists shorter than 4332 after 100 steps:
-Exception: Stack overflow
-Backtrace: 
+[...] list length: 4332
 
 --- Failure --------------------------------------------------------------------
 
-Test lists equal to duplication failed:
+Test lists equal to duplication failed (4 shrink steps):
 
-ERROR: uncaught exception in generator for test lists equal to duplication after 100 steps:
-Exception: Stack overflow
-Backtrace: 
+[...] list length: 1
 
 --- Failure --------------------------------------------------------------------