@@ -9,6 +9,47 @@ let capture_tree ?(filter = Tree.dfs_with_depth) to_string tree =
99 Regression. capture ~eol: false string ) ;
1010 Regression. capture " "
1111
12+ let of_seq_order () =
13+ Test. register ~__FILE__ ~title: " Gen.of_seq order" ~tags: [" gen" ; " of_seq" ]
14+ @@ fun () ->
15+ let gen =
16+ [1 ; 2 ; 3 ] |> List. to_seq |> Gen. of_seq
17+ in
18+ let run () = Gen. run gen (Gen.Random. make [|0 |]) |> Tree. root in
19+ let values = List. rev [run () ; run () ; run () ; run () ] in
20+ match values with
21+ | [Some 1 ; Some 2 ; Some 3 ; None ] -> Lwt. return_unit
22+ | _ ->
23+ let pp = function None -> " None" | Some i -> string_of_int i in
24+ Test. fail " unexpected sequence: %s" (values |> List. map pp |> String. concat " , " )
25+
26+ let run_failure () =
27+ Test. register ~__FILE__ ~title: " Gen.run failure" ~tags: [" gen" ; " run" ]
28+ @@ fun () ->
29+ (* [Gen.sequence] creates a generator that may return several root values.
30+ Running such a generator with [Gen.run] should fail. *)
31+ let faulty_gen : int Gen.t =
32+ Gen. sequence (Gen. return 1 ) (Seq. return (Gen. return 2 ))
33+ in
34+ let state = Gen.Random. make [|0 |] in
35+ ( try
36+ ignore (Gen. run faulty_gen state) ;
37+ Test. fail " Gen.run should have failed"
38+ with Failure msg ->
39+ let expected =
40+ " [Gen.run] was called with an erroneous generator. The generator is \
41+ expected to return a single value. Instead: multiple values were \
42+ returned. You should probably fix your generator or provide a \
43+ [on_failure] argument to [Gen.run]."
44+ in
45+ if String. equal msg expected then ()
46+ else Test. fail " unexpected message: %s" msg ) ;
47+ let tree =
48+ Gen. run ~on_failure: (fun _ -> Tree. return 42 ) faulty_gen state
49+ in
50+ if Tree. root tree = 42 then Lwt. return_unit
51+ else Test. fail " on_failure callback not used"
52+
1253let z_range_regression () =
1354 Regression. register ~__FILE__ ~title: " Gen.z_range" ~tags: [" gen" ; " z_range" ]
1455 @@ fun () ->
@@ -190,4 +231,6 @@ let register () =
190231 crunch () ;
191232 map_bind_return () ;
192233 root () ;
234+ of_seq_order () ;
235+ run_failure () ;
193236 hard_coded_values ()
0 commit comments