unikernel/duniverse/base/test/test_blit.ml

@@ -0,0 +1,89 @@
+open! Import
+open! Blit
+
+(* This unit test checks that when [blit] calls [unsafe_blit], the slices are valid.
+   It also checks that [blit] doesn't call [unsafe_blit] when there is a range error. *)
+let%test_module _ =
+  (module struct
+    let blit_was_called = ref false
+    let slices_are_valid = ref (Ok ())
+
+    module B = Make (struct
+      type t = bool array
+
+      let create ~len = Array.create false ~len
+      let length = Array.length
+
+      let unsafe_blit ~src ~src_pos ~dst ~dst_pos ~len =
+        blit_was_called := true;
+        slices_are_valid
+          := Or_error.try_with (fun () ->
+               assert (len >= 0);
+               assert (src_pos >= 0);
+               assert (src_pos + len <= Array.length src);
+               assert (dst_pos >= 0);
+               assert (dst_pos + len <= Array.length dst));
+        Array.blit ~src ~src_pos ~dst ~dst_pos ~len
+      ;;
+    end)
+
+    let%test_module "Bool" =
+      (module Test_blit.Test
+                (struct
+                  type t = bool
+
+                  let equal = Bool.equal
+                  let of_bool = Fn.id
+                end)
+                (struct
+                  type t = bool array [@@deriving sexp_of]
+
+                  let create ~len = Array.create false ~len
+                  let length = Array.length
+                  let get = Array.get
+                  let set = Array.set
+                end)
+                (B))
+    ;;
+
+    let%test_unit _ =
+      let opts = [ None; Some (-1); Some 0; Some 1; Some 2 ] in
+      List.iter [ 0; 1; 2 ] ~f:(fun src ->
+        List.iter [ 0; 1; 2 ] ~f:(fun dst ->
+          List.iter opts ~f:(fun src_pos ->
+            List.iter opts ~f:(fun src_len ->
+              List.iter opts ~f:(fun dst_pos ->
+                try
+                  let check f =
+                    blit_was_called := false;
+                    slices_are_valid := Ok ();
+                    match Or_error.try_with f with
+                    | Error _ -> assert (not !blit_was_called)
+                    | Ok () -> ok_exn !slices_are_valid
+                  in
+                  check (fun () ->
+                    B.blito
+                      ~src:(Array.create ~len:src false)
+                      ?src_pos
+                      ?src_len
+                      ~dst:(Array.create ~len:dst false)
+                      ?dst_pos
+                      ());
+                  check (fun () ->
+                    ignore
+                      (B.subo (Array.create ~len:src false) ?pos:src_pos ?len:src_len
+                        : bool array))
+                with
+                | exn ->
+                  raise_s
+                    [%message
+                      "failure"
+                        (exn : exn)
+                        (src : int)
+                        (src_pos : int option)
+                        (src_len : int option)
+                        (dst : int)
+                        (dst_pos : int option)])))))
+    ;;
+  end)
+;;