open! Base open Base_test_helpers let%test_module _ = (module ( struct open Queue module type S = S let does_raise = Exn.does_raise type nonrec 'a t = 'a t [@@deriving sexp, sexp_grammar] let globalize = globalize let%expect_test _ = let open Expect_test_helpers_base in let check t = require_does_not_raise [%here] (fun () -> invariant ignore t; print_s [%sexp (t : int t)]) in let a = of_list [ 1; 2; 3 ] in check a; [%expect {| (1 2 3) |}]; let b = globalize globalize_int a in check b; [%expect {| (1 2 3) |}]; enqueue b 4; print_s [%sexp (dequeue a : int option)]; [%expect {| (1) |}]; check a; [%expect {| (2 3) |}]; check b; [%expect {| (1 2 3 4) |}] ;; let capacity = capacity let set_capacity = set_capacity let%test_unit _ = let t = create () in [%test_result: int] (capacity t) ~expect:2; enqueue t 1; [%test_result: int] (capacity t) ~expect:2; enqueue t 2; [%test_result: int] (capacity t) ~expect:2; enqueue t 3; [%test_result: int] (capacity t) ~expect:4; set_capacity t 0; [%test_result: int] (capacity t) ~expect:4; set_capacity t 3; [%test_result: int] (capacity t) ~expect:4; set_capacity t 100; [%test_result: int] (capacity t) ~expect:128; enqueue t 4; enqueue t 5; set_capacity t 0; [%test_result: int] (capacity t) ~expect:8; set_capacity t (-1); [%test_result: int] (capacity t) ~expect:8 ;; let round_trip_sexp t = let sexp = sexp_of_t Int.sexp_of_t t in let t' = t_of_sexp Int.t_of_sexp sexp in [%test_result: int list] ~expect:(to_list t) (to_list t') ;; let%test_unit _ = round_trip_sexp (of_list [ 1; 2; 3; 4 ]) let%test_unit _ = round_trip_sexp (create ()) let%test_unit _ = round_trip_sexp (of_list []) let invariant = invariant let create = create let%test_unit _ = let t = create () in [%test_result: int] (length t) ~expect:0; [%test_result: int] (capacity t) ~expect:2 ;; let%test_unit _ = let t = create ~capacity:0 () in [%test_result: int] (length t) ~expect:0; [%test_result: int] (capacity t) ~expect:1 ;; let%test_unit _ = let t = create ~capacity:6 () in [%test_result: int] (length t) ~expect:0; [%test_result: int] (capacity t) ~expect:8 ;; let%test_unit _ = assert (does_raise (fun () : _ Queue.t -> create ~capacity:(-1) ())) ;; let singleton = singleton let%test_unit _ = let t = singleton 7 in [%test_result: int] (length t) ~expect:1; [%test_result: int] (capacity t) ~expect:1; [%test_result: int option] (dequeue t) ~expect:(Some 7); [%test_result: int option] (dequeue t) ~expect:None ;; let init = init let%test_unit _ = let t = init 0 ~f:(fun _ -> assert false) in [%test_result: int] (length t) ~expect:0; [%test_result: int] (capacity t) ~expect:1; [%test_result: int option] (dequeue t) ~expect:None ;; let%test_unit _ = let t = init 3 ~f:(fun i -> i * 2) in [%test_result: int] (length t) ~expect:3; [%test_result: int] (capacity t) ~expect:4; [%test_result: int option] (dequeue t) ~expect:(Some 0); [%test_result: int option] (dequeue t) ~expect:(Some 2); [%test_result: int option] (dequeue t) ~expect:(Some 4); [%test_result: int option] (dequeue t) ~expect:None ;; let%test_unit _ = assert (does_raise (fun () : unit Queue.t -> init (-1) ~f:(fun _ -> ()))) ;; let get = get let set = set let%test_unit _ = let t = create () in let get_opt t i = Option.try_with (fun () -> get t i) in [%test_result: int option] (get_opt t 0) ~expect:None; [%test_result: int option] (get_opt t (-1)) ~expect:None; [%test_result: int option] (get_opt t 10) ~expect:None; List.iter [ -1; 0; 1 ] ~f:(fun i -> assert (does_raise (fun () -> set t i 0))); enqueue t 0; enqueue t 1; enqueue t 2; [%test_result: int option] (get_opt t 0) ~expect:(Some 0); [%test_result: int option] (get_opt t 1) ~expect:(Some 1); [%test_result: int option] (get_opt t 2) ~expect:(Some 2); [%test_result: int option] (get_opt t 3) ~expect:None; ignore (dequeue_exn t : int); [%test_result: int option] (get_opt t 0) ~expect:(Some 1); [%test_result: int option] (get_opt t 1) ~expect:(Some 2); [%test_result: int option] (get_opt t 2) ~expect:None; set t 0 3; [%test_result: int option] (get_opt t 0) ~expect:(Some 3); [%test_result: int option] (get_opt t 1) ~expect:(Some 2); List.iter [ -1; 2 ] ~f:(fun i -> assert (does_raise (fun () -> set t i 0))) ;; let map = map let%test_unit _ = for i = 0 to 5 do let l = List.init i ~f:Fn.id in let t = of_list l in let f x = x * 2 in let t' = map t ~f in [%test_result: int list] (to_list t') ~expect:(List.map l ~f) done ;; let%test_unit _ = let t = create () in let t' = map t ~f:(fun x -> x * 2) in [%test_result: int] (length t') ~expect:(length t); [%test_result: int] (length t') ~expect:0; [%test_result: int list] (to_list t') ~expect:[] ;; let mapi = mapi let%test_unit _ = for i = 0 to 5 do let l = List.init i ~f:Fn.id in let t = of_list l in let f i x = i, x * 2 in let t' = mapi t ~f in [%test_result: (int * int) list] (to_list t') ~expect:(List.mapi l ~f) done ;; let%test_unit _ = let t = create () in let t' = mapi t ~f:(fun i x -> i, x * 2) in [%test_result: int] (length t') ~expect:(length t); [%test_result: int] (length t') ~expect:0; [%test_result: (int * int) list] (to_list t') ~expect:[] ;; include Test_container.Test_S1 (Queue) let dequeue_exn = dequeue_exn let enqueue = enqueue let enqueue_front = enqueue_front let dequeue_back = dequeue_back let dequeue_back_exn = dequeue_back_exn let peek = peek let peek_exn = peek_exn let peek_back = peek_back let peek_back_exn = peek_back_exn let last = last let last_exn = last_exn let%test_unit _ = let t = create () in [%test_result: int option] (peek t) ~expect:None; [%test_result: int option] (last t) ~expect:None; enqueue t 1; enqueue t 2; [%test_result: int option] (peek t) ~expect:(Some 1); [%test_result: int] (peek_exn t) ~expect:1; [%test_result: int option] (last t) ~expect:(Some 2); [%test_result: int] (last_exn t) ~expect:2; [%test_result: int] (dequeue_exn t) ~expect:1; [%test_result: int] (dequeue_exn t) ~expect:2; assert (does_raise (fun () -> dequeue_exn t)); assert (does_raise (fun () -> peek_exn t)); assert (does_raise (fun () -> peek_back_exn t)); assert (does_raise (fun () -> last_exn t)); enqueue_front t 1; enqueue t 2; enqueue_front t 0; enqueue t 3; enqueue t 4; enqueue t 5; [%test_result: int option] (peek_back t) ~expect:(Some 5); [%test_result: int] (peek_back_exn t) ~expect:5; [%test_result: int] (dequeue_exn t) ~expect:0; [%test_result: int] (dequeue_exn t) ~expect:1; [%test_result: int] (dequeue_exn t) ~expect:2; [%test_result: int] (dequeue_back_exn t) ~expect:5; [%test_result: int] (dequeue_back_exn t) ~expect:4; [%test_result: int] (dequeue_back_exn t) ~expect:3 ;; let dequeue_and_ignore_exn = dequeue_and_ignore_exn let%test_unit _ = let t = create () in enqueue t 1; enqueue t 2; enqueue t 3; [%test_result: int] (peek_exn t) ~expect:1; dequeue_and_ignore_exn t; [%test_result: int] (peek_exn t) ~expect:2; dequeue_and_ignore_exn t; [%test_result: int] (peek_exn t) ~expect:3; dequeue_and_ignore_exn t; [%test_result: int option] (peek t) ~expect:None; assert (does_raise (fun () -> dequeue_and_ignore_exn t)); assert (does_raise (fun () -> dequeue_and_ignore_exn t)); [%test_result: int option] (peek t) ~expect:None ;; let drain = drain let%test_unit _ = let t = create () in for i = 0 to 10 do enqueue t i done; [%test_result: int] (peek_exn t) ~expect:0; [%test_result: int] (length t) ~expect:11; let r = ref 0 in let add i = r := !r + i in drain t ~f:add ~while_:(fun i -> i < 7); [%test_result: int] (peek_exn t) ~expect:7; [%test_result: int] (length t) ~expect:4; [%test_result: int] !r ~expect:21; drain t ~f:add ~while_:(fun i -> i > 7); [%test_result: int] (peek_exn t) ~expect:7; [%test_result: int] (length t) ~expect:4; [%test_result: int] !r ~expect:21; drain t ~f:add ~while_:(fun i -> i > 0); [%test_result: int option] (peek t) ~expect:None; [%test_result: int] (length t) ~expect:0; [%test_result: int] !r ~expect:55 ;; let enqueue_all = enqueue_all let%test_unit _ = let t = create () in enqueue_all t [ 1; 2; 3 ]; [%test_result: int] (dequeue_exn t) ~expect:1; [%test_result: int] (dequeue_exn t) ~expect:2; [%test_result: int option] (last t) ~expect:(Some 3); enqueue_all t [ 4; 5 ]; [%test_result: int option] (last t) ~expect:(Some 5); [%test_result: int] (dequeue_exn t) ~expect:3; [%test_result: int] (dequeue_exn t) ~expect:4; [%test_result: int] (dequeue_exn t) ~expect:5; assert (does_raise (fun () -> dequeue_exn t)); enqueue_all t []; assert (does_raise (fun () -> dequeue_exn t)) ;; let of_list = of_list let to_list = to_list let%test_unit _ = for i = 0 to 4 do let list = List.init i ~f:Fn.id in [%test_result: int list] (to_list (of_list list)) ~expect:list done ;; let%test _ = let t = create () in for i = 1 to 5 do enqueue t i done; [%equal: int list] (to_list t) [ 1; 2; 3; 4; 5 ] ;; let of_array = of_array let to_array = to_array let%test_unit _ = for len = 0 to 4 do let array = Array.init len ~f:Fn.id in [%test_result: int array] (to_array (of_array array)) ~expect:array done ;; let compare = compare let compare__local = compare__local let equal = equal let equal__local = equal__local let%test_module "comparisons" = (module struct let sign x = if x < 0 then ~-1 else if x > 0 then 1 else 0 let test t1 t2 = [%test_result: bool] (equal Int.equal t1 t2) ~expect:(List.equal Int.equal (to_list t1) (to_list t2)); [%test_result: int] (sign (compare Int.compare t1 t2)) ~expect:(sign (List.compare Int.compare (to_list t1) (to_list t2))); [%test_result: bool] (equal__local Int.equal__local t1 t2) ~expect: (List.equal__local Int.equal__local (to_list t1) (to_list t2)); [%test_result: int] (sign (compare__local Int.compare__local t1 t2)) ~expect: (sign (List.compare__local Int.compare__local (to_list t1) (to_list t2))) ;; let lists = [ [] ; [ 1 ] ; [ 2 ] ; [ 1; 1 ] ; [ 1; 2 ] ; [ 2; 1 ] ; [ 1; 1; 1 ] ; [ 1; 2; 3 ] ; [ 1; 2; 4 ] ; [ 1; 2; 4; 8 ] ; [ 1; 2; 3; 4; 5 ] ] ;; let%test_unit _ = (* [phys_equal] inputs *) List.iter lists ~f:(fun list -> let t = of_list list in test t t) ;; let%test_unit _ = List.iter lists ~f:(fun list1 -> List.iter lists ~f:(fun list2 -> test (of_list list1) (of_list list2))) ;; end) ;; let clear = clear let%test_unit "clear" = let q = of_list [ 1; 2; 3; 4 ] in [%test_result: int] (length q) ~expect:4; clear q; [%test_result: int] (length q) ~expect:0 ;; let blit_transfer = blit_transfer let%test_unit _ = let q_list = [ 1; 2; 3; 4 ] in let q = of_list q_list in let q' = create () in blit_transfer ~src:q ~dst:q' (); [%test_result: int list] (to_list q') ~expect:q_list; [%test_result: int list] (to_list q) ~expect:[] ;; let%test_unit _ = let q = of_list [ 1; 2; 3; 4 ] in let q' = create () in blit_transfer ~src:q ~dst:q' ~len:2 (); [%test_result: int list] (to_list q') ~expect:[ 1; 2 ]; [%test_result: int list] (to_list q) ~expect:[ 3; 4 ] ;; let%test_unit "blit_transfer on wrapped queues" = let list = [ 1; 2; 3; 4 ] in let q = of_list list in let q' = copy q in ignore (dequeue_exn q : int); ignore (dequeue_exn q : int); ignore (dequeue_exn q' : int); ignore (dequeue_exn q' : int); ignore (dequeue_exn q' : int); enqueue q 5; enqueue q 6; blit_transfer ~src:q ~dst:q' ~len:3 (); [%test_result: int list] (to_list q') ~expect:[ 4; 3; 4; 5 ]; [%test_result: int list] (to_list q) ~expect:[ 6 ] ;; let copy = copy let%test_unit "copies behave independently" = let q = of_list [ 1; 2; 3; 4 ] in let q' = copy q in enqueue q 5; ignore (dequeue_exn q' : int); [%test_result: int list] (to_list q) ~expect:[ 1; 2; 3; 4; 5 ]; [%test_result: int list] (to_list q') ~expect:[ 2; 3; 4 ] ;; let dequeue = dequeue let filter = filter let filteri = filteri let filter_inplace = filter_inplace let filteri_inplace = filteri_inplace let concat_map = concat_map let concat_mapi = concat_mapi let filter_map = filter_map let filter_mapi = filter_mapi let counti = counti let existsi = existsi let for_alli = for_alli let iter = iter let iteri = iteri let foldi = foldi let findi = findi let find_mapi = find_mapi let%test_module "Linked_queue bisimulation" = (module struct module type Queue_intf = sig type 'a t [@@deriving sexp_of] val create : unit -> 'a t val enqueue : 'a t -> 'a -> unit val dequeue : 'a t -> 'a option val drain : 'a t -> f:('a -> unit) -> while_:('a -> bool) -> unit val to_array : 'a t -> 'a array val fold : 'a t -> init:'b -> f:('b -> 'a -> 'b) -> 'b val foldi : 'a t -> init:'b -> f:(int -> 'b -> 'a -> 'b) -> 'b val iter : 'a t -> f:('a -> unit) -> unit val iteri : 'a t -> f:(int -> 'a -> unit) -> unit val length : 'a t -> int val clear : 'a t -> unit val concat_map : 'a t -> f:('a -> 'b list) -> 'b t val concat_mapi : 'a t -> f:(int -> 'a -> 'b list) -> 'b t val filter_map : 'a t -> f:('a -> 'b option) -> 'b t val filter_mapi : 'a t -> f:(int -> 'a -> 'b option) -> 'b t val filter : 'a t -> f:('a -> bool) -> 'a t val filteri : 'a t -> f:(int -> 'a -> bool) -> 'a t val filter_inplace : 'a t -> f:('a -> bool) -> unit val filteri_inplace : 'a t -> f:(int -> 'a -> bool) -> unit val map : 'a t -> f:('a -> 'b) -> 'b t val mapi : 'a t -> f:(int -> 'a -> 'b) -> 'b t val counti : 'a t -> f:(int -> 'a -> bool) -> int val existsi : 'a t -> f:(int -> 'a -> bool) -> bool val for_alli : 'a t -> f:(int -> 'a -> bool) -> bool val findi : 'a t -> f:(int -> 'a -> bool) -> (int * 'a) option val find_mapi : 'a t -> f:(int -> 'a -> 'b option) -> 'b option val transfer : src:'a t -> dst:'a t -> unit val copy : 'a t -> 'a t end module That_queue : Queue_intf = Linked_queue module This_queue : Queue_intf = struct include Queue let create () = create () let transfer ~src ~dst = blit_transfer ~src ~dst () end let this_to_string this_t = Sexp.to_string (this_t |> [%sexp_of: int This_queue.t]) ;; let that_to_string that_t = Sexp.to_string (that_t |> [%sexp_of: int That_queue.t]) ;; let array_string arr = Sexp.to_string (arr |> [%sexp_of: int array]) let create () = This_queue.create (), That_queue.create () let enqueue (t_a, t_b) v = let start_a = This_queue.to_array t_a in let start_b = That_queue.to_array t_b in This_queue.enqueue t_a v; That_queue.enqueue t_b v; let end_a = This_queue.to_array t_a in let end_b = That_queue.to_array t_b in if not ([%equal: int array] end_a end_b) then Printf.failwithf "enqueue transition failure of: %s -> %s vs. %s -> %s" (array_string start_a) (array_string end_a) (array_string start_b) (array_string end_b) () ;; let iter (t_a, t_b) = let r_a, r_b = ref 0, ref 0 in This_queue.iter t_a ~f:(fun x -> r_a := !r_a + x); That_queue.iter t_b ~f:(fun x -> r_b := !r_b + x); if !r_a <> !r_b then Printf.failwithf "error in iter: %s (from %s) <> %s (from %s)" (Int.to_string !r_a) (this_to_string t_a) (Int.to_string !r_b) (that_to_string t_b) () ;; let iteri (t_a, t_b) = let r_a, r_b = ref 0, ref 0 in This_queue.iteri t_a ~f:(fun i x -> r_a := !r_a + (x lxor i)); That_queue.iteri t_b ~f:(fun i x -> r_b := !r_b + (x lxor i)); if !r_a <> !r_b then Printf.failwithf "error in iteri: %s (from %s) <> %s (from %s)" (Int.to_string !r_a) (this_to_string t_a) (Int.to_string !r_b) (that_to_string t_b) () ;; let dequeue (t_a, t_b) = let start_a = This_queue.to_array t_a in let start_b = That_queue.to_array t_b in let a, b = This_queue.dequeue t_a, That_queue.dequeue t_b in let end_a = This_queue.to_array t_a in let end_b = That_queue.to_array t_b in if (not ([%equal: int option] a b)) || not ([%equal: int array] end_a end_b) then Printf.failwithf "error in dequeue: %s (%s -> %s) <> %s (%s -> %s)" (Option.value ~default:"None" (Option.map a ~f:Int.to_string)) (array_string start_a) (array_string end_a) (Option.value ~default:"None" (Option.map b ~f:Int.to_string)) (array_string start_b) (array_string end_b) () ;; let is_even x = x land 1 = 0 let drain (t_a, t_b) = let orig_a = This_queue.to_array t_a in let orig_b = That_queue.to_array t_b in let r_a = ref 0 in let r_b = ref 0 in let add r i = r := !r + i in This_queue.drain t_a ~f:(fun i -> add r_a i) ~while_:is_even; That_queue.drain t_b ~f:(fun i -> add r_b i) ~while_:is_even; if not ([%equal: int array] (This_queue.to_array t_a) (That_queue.to_array t_b) && !r_a = !r_b) then Printf.failwithf "error in drain: %s -> %s, %d vs. %s -> %s, %d" (array_string orig_a) (this_to_string t_a) !r_a (array_string orig_b) (that_to_string t_b) !r_b () ;; let clear (t_a, t_b) = This_queue.clear t_a; That_queue.clear t_b ;; let filter (t_a, t_b) = let t_a' = This_queue.filter t_a ~f:is_even in let t_b' = That_queue.filter t_b ~f:is_even in if not ([%equal: int array] (This_queue.to_array t_a') (That_queue.to_array t_b')) then Printf.failwithf "error in filter: %s -> %s vs. %s -> %s" (this_to_string t_a) (this_to_string t_a') (that_to_string t_b) (that_to_string t_b') () ;; let filteri (t_a, t_b) = let t_a' = This_queue.filteri t_a ~f:(fun i j -> [%equal: bool] (is_even i) (is_even j)) in let t_b' = That_queue.filteri t_b ~f:(fun i j -> [%equal: bool] (is_even i) (is_even j)) in if not ([%equal: int array] (This_queue.to_array t_a') (That_queue.to_array t_b')) then Printf.failwithf "error in filteri: %s -> %s vs. %s -> %s" (this_to_string t_a) (this_to_string t_a') (that_to_string t_b) (that_to_string t_b') () ;; let filter_inplace (t_a, t_b) = let start_a = This_queue.to_array t_a in let start_b = That_queue.to_array t_b in This_queue.filter_inplace t_a ~f:is_even; That_queue.filter_inplace t_b ~f:is_even; let end_a = This_queue.to_array t_a in let end_b = That_queue.to_array t_b in if not ([%equal: int array] end_a end_b) then Printf.failwithf "error in filter_inplace: %s -> %s vs. %s -> %s" (array_string start_a) (array_string end_a) (array_string start_b) (array_string end_b) () ;; let filteri_inplace (t_a, t_b) = let start_a = This_queue.to_array t_a in let start_b = That_queue.to_array t_b in let f i x = [%equal: bool] (is_even i) (is_even x) in This_queue.filteri_inplace t_a ~f; That_queue.filteri_inplace t_b ~f; let end_a = This_queue.to_array t_a in let end_b = That_queue.to_array t_b in if not ([%equal: int array] end_a end_b) then Printf.failwithf "error in filteri_inplace: %s -> %s vs. %s -> %s" (array_string start_a) (array_string end_a) (array_string start_b) (array_string end_b) () ;; let concat_map (t_a, t_b) = let f x = [ x; x + 1; x + 2 ] in let t_a' = This_queue.concat_map t_a ~f in let t_b' = That_queue.concat_map t_b ~f in if not ([%equal: int array] (This_queue.to_array t_a') (That_queue.to_array t_b')) then Printf.failwithf "error in concat_map: %s (for %s) <> %s (for %s)" (this_to_string t_a') (this_to_string t_a) (that_to_string t_b') (that_to_string t_b) () ;; let concat_mapi (t_a, t_b) = let f i x = [ x; x + 1; x + 2; x + i ] in let t_a' = This_queue.concat_mapi t_a ~f in let t_b' = That_queue.concat_mapi t_b ~f in if not ([%equal: int array] (This_queue.to_array t_a') (That_queue.to_array t_b')) then Printf.failwithf "error in concat_mapi: %s (for %s) <> %s (for %s)" (this_to_string t_a') (this_to_string t_a) (that_to_string t_b') (that_to_string t_b) () ;; let filter_map (t_a, t_b) = let f x = if is_even x then None else Some (x + 1) in let t_a' = This_queue.filter_map t_a ~f in let t_b' = That_queue.filter_map t_b ~f in if not ([%equal: int array] (This_queue.to_array t_a') (That_queue.to_array t_b')) then Printf.failwithf "error in filter_map: %s (for %s) <> %s (for %s)" (this_to_string t_a') (this_to_string t_a) (that_to_string t_b') (that_to_string t_b) () ;; let filter_mapi (t_a, t_b) = let f i x = if [%equal: bool] (is_even i) (is_even x) then None else Some (x + 1 + i) in let t_a' = This_queue.filter_mapi t_a ~f in let t_b' = That_queue.filter_mapi t_b ~f in if not ([%equal: int array] (This_queue.to_array t_a') (That_queue.to_array t_b')) then Printf.failwithf "error in filter_mapi: %s (for %s) <> %s (for %s)" (this_to_string t_a') (this_to_string t_a) (that_to_string t_b') (that_to_string t_b) () ;; let map (t_a, t_b) = let f x = x * 7 in let t_a' = This_queue.map t_a ~f in let t_b' = That_queue.map t_b ~f in if not ([%equal: int array] (This_queue.to_array t_a') (That_queue.to_array t_b')) then Printf.failwithf "error in map: %s (for %s) <> %s (for %s)" (this_to_string t_a') (this_to_string t_a) (that_to_string t_b') (that_to_string t_b) () ;; let mapi (t_a, t_b) = let f i x = (x + 3) lxor i in let t_a' = This_queue.mapi t_a ~f in let t_b' = That_queue.mapi t_b ~f in if not ([%equal: int array] (This_queue.to_array t_a') (That_queue.to_array t_b')) then Printf.failwithf "error in mapi: %s (for %s) <> %s (for %s)" (this_to_string t_a') (this_to_string t_a) (that_to_string t_b') (that_to_string t_b) () ;; let counti (t_a, t_b) = let f i x = i < 7 && i % 7 = x % 7 in let a' = This_queue.counti t_a ~f in let b' = That_queue.counti t_b ~f in if a' <> b' then Printf.failwithf "error in counti: %d (for %s) <> %d (for %s)" a' (this_to_string t_a) b' (that_to_string t_b) () ;; let existsi (t_a, t_b) = let f i x = i < 7 && i % 7 = x % 7 in let a' = This_queue.existsi t_a ~f in let b' = That_queue.existsi t_b ~f in if not ([%equal: bool] a' b') then Printf.failwithf "error in existsi: %b (for %s) <> %b (for %s)" a' (this_to_string t_a) b' (that_to_string t_b) () ;; let for_alli (t_a, t_b) = let f i x = i >= 7 || i % 7 <> x % 7 in let a' = This_queue.for_alli t_a ~f in let b' = That_queue.for_alli t_b ~f in if not ([%equal: bool] a' b') then Printf.failwithf "error in for_alli: %b (for %s) <> %b (for %s)" a' (this_to_string t_a) b' (that_to_string t_b) () ;; let findi (t_a, t_b) = let f i x = i < 7 && i % 7 = x % 7 in let a' = This_queue.findi t_a ~f in let b' = That_queue.findi t_b ~f in if not ([%equal: (int * int) option] a' b') then Printf.failwithf "error in findi: %s (for %s) <> %s (for %s)" (Sexp.to_string ([%sexp_of: (int * int) option] a')) (this_to_string t_a) (Sexp.to_string ([%sexp_of: (int * int) option] b')) (that_to_string t_b) () ;; let find_mapi (t_a, t_b) = let f i x = if i < 7 && i % 7 = x % 7 then Some (i + x) else None in let a' = This_queue.find_mapi t_a ~f in let b' = That_queue.find_mapi t_b ~f in if not ([%equal: int option] a' b') then Printf.failwithf "error in find_mapi: %s (for %s) <> %s (for %s)" (Sexp.to_string ([%sexp_of: int option] a')) (this_to_string t_a) (Sexp.to_string ([%sexp_of: int option] b')) (that_to_string t_b) () ;; let copy (t_a, t_b) = let copy_a = This_queue.copy t_a in let copy_b = That_queue.copy t_b in let start_a = This_queue.to_array t_a in let start_b = That_queue.to_array t_b in let end_a = This_queue.to_array copy_a in let end_b = That_queue.to_array copy_b in if not ([%equal: int array] end_a end_b) then Printf.failwithf "error in copy: %s -> %s vs. %s -> %s" (array_string start_a) (array_string end_a) (array_string start_b) (array_string end_b) () ;; let transfer (t_a, t_b) = let dst_a = This_queue.create () in let dst_b = That_queue.create () in (* sometimes puts some elements in the destination queues *) if Random.bool () then List.iter [ 1; 2; 3; 4; 5 ] ~f:(fun elem -> This_queue.enqueue dst_a elem; That_queue.enqueue dst_b elem); let start_a = This_queue.to_array t_a in let start_b = That_queue.to_array t_b in This_queue.transfer ~src:t_a ~dst:dst_a; That_queue.transfer ~src:t_b ~dst:dst_b; let end_a = This_queue.to_array t_a in let end_b = That_queue.to_array t_b in let end_a' = This_queue.to_array dst_a in let end_b' = That_queue.to_array dst_b in if (not ([%equal: int array] end_a' end_b')) || not ([%equal: int array] end_a end_b) then Printf.failwithf "error in transfer: %s -> (%s, %s) vs. %s -> (%s, %s)" (array_string start_a) (array_string end_a) (array_string end_a') (array_string start_b) (array_string end_b) (array_string end_b) () ;; let fold_check (t_a, t_b) = let make_list fold t = fold t ~init:[] ~f:(fun acc x -> x :: acc) in let this_l = make_list This_queue.fold t_a in let that_l = make_list That_queue.fold t_b in if not ([%equal: int list] this_l that_l) then Printf.failwithf "error in fold: %s (from %s) <> %s (from %s)" (Sexp.to_string (this_l |> [%sexp_of: int list])) (this_to_string t_a) (Sexp.to_string (that_l |> [%sexp_of: int list])) (that_to_string t_b) () ;; let foldi_check (t_a, t_b) = let make_list foldi t = foldi t ~init:[] ~f:(fun i acc x -> (i, x) :: acc) in let this_l = make_list This_queue.foldi t_a in let that_l = make_list That_queue.foldi t_b in if not ([%equal: (int * int) list] this_l that_l) then Printf.failwithf "error in foldi: %s (from %s) <> %s (from %s)" (Sexp.to_string (this_l |> [%sexp_of: (int * int) list])) (this_to_string t_a) (Sexp.to_string (that_l |> [%sexp_of: (int * int) list])) (that_to_string t_b) () ;; let length_check (t_a, t_b) = let this_len = This_queue.length t_a in let that_len = That_queue.length t_b in if this_len <> that_len then Printf.failwithf "error in length: %i (for %s) <> %i (for %s)" this_len (this_to_string t_a) that_len (that_to_string t_b) () ;; let%test_unit _ = let t = create () in let rec loop ~all_ops ~non_empty_ops = if all_ops <= 0 && non_empty_ops <= 0 then ( let t_a, t_b = t in let arr_a = This_queue.to_array t_a in let arr_b = That_queue.to_array t_b in if not ([%equal: int array] arr_a arr_b) then Printf.failwithf "queue final states not equal: %s vs. %s" (array_string arr_a) (array_string arr_b) ()) else ( let queue_was_empty = This_queue.length (fst t) = 0 in let r = Random.int 200 in if r < 60 then enqueue t (Random.int 10_000) else if r < 65 then dequeue t else if r < 70 then clear t else if r < 80 then iter t else if r < 85 then iteri t else if r < 90 then fold_check t else if r < 95 then foldi_check t else if r < 100 then filter t else if r < 105 then filteri t else if r < 110 then concat_map t else if r < 115 then concat_mapi t else if r < 120 then transfer t else if r < 130 then filter_map t else if r < 135 then filter_mapi t else if r < 140 then copy t else if r < 150 then filter_inplace t else if r < 155 then for_alli t else if r < 160 then existsi t else if r < 165 then counti t else if r < 170 then findi t else if r < 175 then find_mapi t else if r < 180 then map t else if r < 185 then mapi t else if r < 190 then filteri_inplace t else if r < 195 then length_check t else if r < 200 then drain t else failwith "Impossible: We did [Random.int 200] above"; loop ~all_ops:(all_ops - 1) ~non_empty_ops: (if queue_was_empty then non_empty_ops else non_empty_ops - 1)) in loop ~all_ops:30_000 ~non_empty_ops:20_000 ;; end) ;; let%test_unit "modification-during-iteration" = let x = `A 0 in let t = of_list [ x; x ] in let f (`A n) = ignore n; clear t in assert (does_raise (fun () -> iter t ~f)) ;; let%test_unit "more-modification-during-iteration" = let nested_iter_okay = ref false in let t = of_list [ `iter; `clear ] in assert ( does_raise (fun () -> iter t ~f:(function | `iter -> iter t ~f:ignore; nested_iter_okay := true | `clear -> clear t))); assert !nested_iter_okay ;; let%test_unit "modification-during-filter" = let reached_unreachable = ref false in let t = of_list [ `clear; `unreachable ] in let f x = match x with | `clear -> clear t; false | `unreachable -> reached_unreachable := true; false in assert (does_raise (fun () -> filter t ~f)); assert (not !reached_unreachable) ;; let%test_unit "modification-during-filter-inplace" = let reached_unreachable = ref false in let t = of_list [ `drop_this; `enqueue_new_element; `unreachable ] in let f x = (match x with | `drop_this | `new_element -> () | `enqueue_new_element -> enqueue t `new_element | `unreachable -> reached_unreachable := true); false in assert (does_raise (fun () -> filter_inplace t ~f)); (* even though we said to drop the first element, the aborted call to [filter_inplace] shouldn't have made that change *) (match peek_exn t with | `drop_this -> () | `new_element | `enqueue_new_element | `unreachable -> failwith "Expected the first element to be `drop_this"); assert (not !reached_unreachable) ;; let%test_unit "filter-inplace-during-iteration" = let reached_unreachable = ref false in let t = of_list [ `filter_inplace; `unreachable ] in let f x = match x with | `filter_inplace -> filter_inplace t ~f:(fun _ -> false) | `unreachable -> reached_unreachable := true in assert (does_raise (fun () -> iter t ~f)); assert (not !reached_unreachable) ;; module Iteration = struct type t = Iteration.t let start = Iteration.start let assert_no_mutation_since_start = Iteration.assert_no_mutation_since_start ;; let%expect_test "mutation-detection" = let open Expect_test_helpers_base in let t = of_list [ `elt ] in let token = start t in let `elt = get t 0 in require_does_not_raise [%here] (fun () -> assert_no_mutation_since_start token t); [%expect {| |}]; enqueue t `elt; require_does_raise [%here] (fun () -> assert_no_mutation_since_start token t); [%expect {| ("mutation of queue during iteration" ( (num_mutations 2) (front 0) (mask 1) (length 2) (elts ( (_) (_))))) |}] ;; end end (* This signature is here to remind us to update the unit tests whenever we change [Queue]. *) : module type of Queue)) ;;