unikernel/duniverse/psq/test/test.ml

@@ -0,0 +1,201 @@
+(* Copyright (c) 2016 David Kaloper Meršinjak. All rights reserved.
+   See LICENSE.md *)
+
+let id x = x
+let (%) f g x = f (g x)
+
+module I = struct type t = int let compare (a: int) b = compare a b end
+module Q = Psq.Make (I) (I)
+
+let list_of_iter_2 i =
+  let xs = ref [] in i (fun a b -> xs := (a, b) :: !xs); List.rev !xs
+let rec unfold f s = match f s with Some (x, s) -> x :: unfold f s | _ -> []
+
+let cmpi (a: int) b = compare a b
+let (%%) f g a b = f (g a) (g b)
+let (=>) cmp1 cmp2 a b = match cmp1 a b with 0 -> cmp2 a b | r -> r
+let k_order xs = List.sort (cmpi %% fst) xs
+let pk_order xs = List.sort (cmpi %% snd => cmpi %% fst) xs
+let k_order_uniq xs =
+  let cmp_kp = cmpi %% fst => cmpi %% snd and cmp_k = cmpi %% fst in
+  match List.sort_uniq cmp_kp xs with
+  | [] -> []
+  | kp0::kps ->
+      let f kp xs kp0 = if cmp_k kp kp0 = 0 then xs kp0 else kp :: xs kp in
+      kp0 :: List.fold_right f kps (fun _ -> []) kp0
+
+let is_balanced q =
+  let (n, d) = Q.(size q, depth q) in
+  n <= 1 || float d < log (float n) *. log 10. *. 3.75
+
+let (!) q = `Sem (Q.to_list q)
+let sem xs = `Sem (k_order_uniq xs)
+
+let g_size = QCheck.Gen.(small_nat >|= fun x -> x mod 1_000)
+let bindings = QCheck.(
+  make Gen.(list_size g_size (pair small_nat small_nat))
+    ~print:Fmt.(to_to_string Dump.(pair int int |> list))
+    ~shrink:Shrink.list)
+let psq = QCheck.(
+  map Q.of_list bindings ~rev:Q.to_list |>
+    set_print Fmt.(to_to_string (Q.pp_dump int int)))
+let kv = QCheck.small_nat
+let psq_w arb = QCheck.pair psq arb
+let psq_w_any_key = psq_w kv
+
+let test name gen p =
+  QCheck.Test.make ~count:200 ~name gen p |> QCheck_alcotest.to_alcotest
+
+let () = Alcotest.run "psq" [
+
+  "of_list", [
+    test "sem" bindings (fun xs -> !(Q.of_list xs) = sem xs);
+    test "of_sorted_list sem" bindings
+      (fun xs -> !(Q.of_sorted_list (k_order_uniq xs)) = sem xs);
+    test "bal" bindings (fun xs -> is_balanced (Q.of_list xs));
+  ];
+
+  "to_list", [
+    test "order" psq (fun q -> Q.to_list q = k_order (Q.to_list q));
+  ];
+
+  "to_priority_list", [
+    test "sem" psq (fun q -> Q.to_priority_list q = pk_order (Q.to_list q))
+  ];
+
+  "size", [
+    test "sem" psq (fun q -> Q.size q = List.length (Q.to_list q));
+  ];
+
+  "sg", [
+    test "sem" kv (fun x -> !Q.(sg x x) = sem [x, x]);
+  ];
+
+  "(++)", [
+    test "sem" QCheck.(pair bindings bindings)
+      (fun (xs1, xs2) -> !Q.(of_list xs1 ++ of_list xs2) = sem (xs1 @ xs2));
+    test "comm" QCheck.(pair psq psq)
+      (fun (q1, q2) -> !Q.(q1 ++ q2) = !Q.(q2 ++ q1));
+    test "assoc" QCheck.(pair psq psq |> pair psq)
+      (fun (q1, (q2, q3)) -> !Q.((q1 ++ q2) ++ q3) = !Q.(q1 ++ (q2 ++ q3)));
+  ];
+
+  "split_at", [
+    test "sem" psq_w_any_key (fun (q, k) ->
+      let q1, q2 = Q.split_at k q
+      and xs1, xs2 = List.partition (fun (k1, _) -> k1 <= k) (Q.to_list q) in
+      !q1 = sem xs1 && !q2 = sem xs2);
+    test "inv" psq_w_any_key (fun (q, k) ->
+      let q1, q2 = Q.split_at k q in !q = !Q.(q1 ++ q2));
+  ];
+
+  "membership", [
+    test "find sem" psq_w_any_key
+      (fun (q, x) -> Q.find x q = List.assoc_opt x (Q.to_list q));
+    test "mem ==> find" psq_w_any_key
+      (fun (q, k) -> QCheck.assume Q.(mem k q); Q.find k q <> None);
+    test "find ==> mem" psq_w_any_key
+      (fun (q, k) -> QCheck.assume (Q.find k q <> None); Q.mem k q);
+  ];
+
+  "update", [
+    test "sem" (psq_w QCheck.(pair kv (option kv)))
+      (fun (q, (x, yy)) ->
+        let kp = match yy with Some y -> [x, y] | _ -> [] in
+        !(Q.update x (fun _ -> yy) q) =
+          sem (kp @ List.remove_assoc x (Q.to_list q)));
+    test "bal" (psq_w QCheck.(pair kv (option kv)))
+      (fun (q, (x, yy)) -> is_balanced (Q.update x (fun _ -> yy) q));
+    test "phys" psq_w_any_key (fun (q, x) -> Q.update x id q == q);
+  ];
+
+  "add", [
+    test "sem" psq_w_any_key
+      (fun (q, x) ->
+        !(Q.add x x q) = sem ((x, x) :: List.remove_assoc x (Q.to_list q)));
+    test "bal" psq_w_any_key (fun (q, k) -> is_balanced (Q.add k k q));
+  ];
+
+  "push", [
+    test "sem" psq_w_any_key
+      (fun (q, x) ->
+        let p = match List.assoc_opt x (Q.to_list q) with
+        | Some p0 -> min x p0
+        | None -> x in
+        !(Q.push x x q) = sem ((x, p) :: List.remove_assoc x (Q.to_list q)));
+    test "mono" psq_w_any_key
+       (fun (q, x) ->
+         QCheck.assume (Q.mem x q);
+         Q.find x (Q.push x x q) <= Q.find x q);
+    test "comm" (psq_w (QCheck.pair kv kv))
+      (fun (q, (x, y)) ->
+        !Q.(q |> push x x |> push x y) = !Q.(q |> push x y |> push x x));
+    test "= of_list" bindings
+      (fun xs ->
+        !(Q.of_list xs) =
+          !(List.fold_left (fun q (k, p) -> Q.push k p q) Q.empty xs));
+  ];
+
+  "remove", [
+    test "sem" psq_w_any_key
+      (fun (q, k) ->
+        !(Q.remove k q) = sem (List.remove_assoc k (Q.to_list q)));
+    test "phys" psq_w_any_key
+      (fun (q, k) -> QCheck.assume (not (Q.mem k q)); Q.remove k q == q);
+    test "bal" psq_w_any_key (fun (q, k) -> Q.(remove k q |> is_balanced));
+  ];
+
+  "adjust", [
+    test "sem" psq_w_any_key
+      (fun (q, x) ->
+        !(Q.adjust x succ q) =
+          sem (Q.to_list q |>
+            List.map (fun (k, p) -> (k, if k = x then succ p else p))));
+  ];
+
+  "pop", [
+    test "sem1" psq (fun q -> unfold Q.pop q = pk_order (Q.to_list q));
+    test "sem2" psq (fun q -> unfold Q.pop q = Q.to_priority_list q);
+    test "min, rest" psq
+      (fun q ->
+        QCheck.assume (not (Q.is_empty q));
+        match Q.(pop q, min q, rest q) with
+          Some (kp1, q1), Some kp2, Some q2 -> kp1 = kp2 && !q1 = !q2
+        | _ -> false);
+  ];
+
+  "at_most", [
+    test "sem" psq_w_any_key
+      (fun (q, x) ->
+        List.of_seq (Q.to_seq_at_most x q) =
+          List.filter (fun kp -> snd kp <= x) (Q.to_list q));
+    test "seq = fold" psq_w_any_key
+      (fun (q, x) ->
+        List.of_seq (Q.to_seq_at_most x q) =
+          Q.fold_at_most x (fun k p xs -> (k, p)::xs) [] q);
+    test "seq = iter" psq_w_any_key
+      (fun (q, x) ->
+        List.of_seq (Q.to_seq_at_most x q) =
+          list_of_iter_2 (fun f -> Q.iter_at_most x f q));
+  ];
+
+  "to_stuff", [
+    test "to_list = to_seq" psq
+      (fun q -> Q.to_list q = (Q.to_seq q |> List.of_seq));
+    test "to_list = fold" psq
+      (fun q -> Q.to_list q = Q.fold (fun k p xs -> (k, p) :: xs) [] q);
+    test "to_list = iter" psq
+      (fun q -> Q.to_list q = list_of_iter_2 (fun f -> Q.iter f q));
+    test "to_priority_seq" psq
+      (fun q -> Q.to_priority_list q = List.of_seq (Q.to_priority_seq q));
+  ];
+
+  "filter", [
+    test "sem" psq_w_any_key
+      (fun (q, k0) ->
+        !(Q.filter (fun k _ -> k <= k0) q) =
+          sem (List.filter (fun (k, _) -> k <= k0) (Q.to_list q)));
+    test "bal" psq_w_any_key
+      (fun (q, k0) -> is_balanced (Q.filter (fun k _ -> k <= k0) q));
+  ];
+]