unikernel/duniverse/bigstringaf/lib_test/dune

@@ -0,0 +1,4 @@
+(test
+ (name test_bigstringaf)
+ (libraries alcotest bigstringaf)
+ (modules test_bigstringaf s))

unikernel/duniverse/bigstringaf/lib_test/s.ml

@@ -0,0 +1,42 @@
+module type Getters = sig
+  val get : Bigstringaf.t -> int -> char
+
+  val get_int16_le : Bigstringaf.t -> int -> int
+  val get_int16_sign_extended_le : Bigstringaf.t -> int -> int
+  val get_int32_le : Bigstringaf.t -> int -> int32
+  val get_int64_le : Bigstringaf.t -> int -> int64
+
+  val get_int16_be : Bigstringaf.t -> int -> int
+  val get_int16_sign_extended_be : Bigstringaf.t -> int -> int
+  val get_int32_be : Bigstringaf.t -> int -> int32
+  val get_int64_be : Bigstringaf.t -> int -> int64
+end
+
+module type Setters = sig
+  val set : Bigstringaf.t -> int -> char -> unit
+
+  val set_int16_le : Bigstringaf.t -> int -> int -> unit
+  val set_int32_le : Bigstringaf.t -> int -> int32 -> unit
+  val set_int64_le : Bigstringaf.t -> int -> int64 -> unit
+
+  val set_int16_be : Bigstringaf.t -> int -> int -> unit
+  val set_int32_be : Bigstringaf.t -> int -> int32 -> unit
+  val set_int64_be : Bigstringaf.t -> int -> int64 -> unit
+end
+
+module type Blit = sig
+  val blit : Bigstringaf.t -> src_off:int -> Bigstringaf.t -> dst_off:int -> len:int -> unit
+  val blit_from_string : String.t -> src_off:int -> Bigstringaf.t -> dst_off:int -> len:int -> unit
+  val blit_from_bytes  : Bytes.t  -> src_off:int -> Bigstringaf.t -> dst_off:int -> len:int -> unit
+
+  val blit_to_bytes : Bigstringaf.t -> src_off:int -> Bytes.t -> dst_off:int -> len:int -> unit
+end
+
+module type Memcmp = sig
+  val memcmp : Bigstringaf.t -> int -> Bigstringaf.t -> int -> int -> int
+  val memcmp_string : Bigstringaf.t -> int -> String.t -> int -> int -> int
+end
+
+module type Memchr = sig
+  val memchr : Bigstringaf.t -> int -> char -> int -> int
+end

unikernel/duniverse/bigstringaf/lib_test/test_bigstringaf.ml

@@ -0,0 +1,385 @@
+let of_string () =
+  let open Bigstringaf in
+  let exn = Invalid_argument (Printf.sprintf "Bigstringaf.of_string invalid range: { buffer_len: 3, off: %d, len: 2 }" max_int) in
+  Alcotest.check_raises "safe overflow" exn (fun () -> ignore (of_string ~off:max_int ~len:2 "abc"))
+;;
+
+let constructors =
+  [ "of_string", `Quick, of_string ]
+
+let index_out_of_bounds () =
+  let open Bigstringaf in
+  let exn    = Invalid_argument "index out of bounds" in
+  let string = "\xde\xad\xbe\xef" in
+  let buffer = of_string ~off:0 ~len:(String.length string) string in
+  Alcotest.check_raises "get empty 0" exn (fun () -> ignore (get empty  0));
+  let check_safe_getter name get =
+    Alcotest.check_raises name exn (fun () -> ignore (get buffer (-1)));
+    Alcotest.check_raises name exn (fun () -> ignore (get buffer (length buffer)));
+  in
+  check_safe_getter "get" get;
+  check_safe_getter "get_int16_le" get_int16_le;
+  check_safe_getter "get_int16_be" get_int16_be;
+  check_safe_getter "get_int16_sign_extended_le" get_int16_sign_extended_le;
+  check_safe_getter "get_int16_sign_extended_be" get_int16_sign_extended_be;
+  check_safe_getter "get_int32_le" get_int32_le;
+  check_safe_getter "get_int32_be" get_int32_be;
+  check_safe_getter "get_int64_le" get_int64_le;
+  check_safe_getter "get_int64_be" get_int64_be;
+;;
+
+let getters m () =
+  let module Getters = (val m : S.Getters) in
+  let open Getters in
+  let string = "\xde\xad\xbe\xef\x8b\xad\xf0\x0d" in
+  let buffer = Bigstringaf.of_string ~off:0 ~len:(String.length string) string in
+
+  Alcotest.(check char "get" '\xde' (get buffer 0));
+  Alcotest.(check char "get" '\xbe' (get buffer 2));
+
+  Alcotest.(check int "get_int16_be" 0xdead (get_int16_be buffer 0));
+  Alcotest.(check int "get_int16_be" 0xbeef (get_int16_be buffer 2));
+  Alcotest.(check int "get_int16_le" 0xadde (get_int16_le buffer 0));
+  Alcotest.(check int "get_int16_le" 0xefbe (get_int16_le buffer 2));
+  Alcotest.(check int "get_int16_sign_extended_be" (Int64.to_int 0x7fffffffffffdeadL) (get_int16_sign_extended_be buffer 0));
+  Alcotest.(check int "get_int16_sign_extended_le" (Int64.to_int 0x7fffffffffffaddeL) (get_int16_sign_extended_le buffer 0));
+  Alcotest.(check int "get_int16_sign_extended_le" 0x0df0 (get_int16_sign_extended_le buffer 6));
+
+  Alcotest.(check int32 "get_int32_be" 0xdeadbeefl (get_int32_be buffer 0));
+  Alcotest.(check int32 "get_int32_be" 0xbeef8badl (get_int32_be buffer 2));
+  Alcotest.(check int32 "get_int32_le" 0xefbeaddel (get_int32_le buffer 0));
+  Alcotest.(check int32 "get_int32_le" 0xad8befbel (get_int32_le buffer 2));
+
+  Alcotest.(check int64 "get_int64_be" 0xdeadbeef8badf00dL (get_int64_be buffer 0));
+  Alcotest.(check int64 "get_int64_le" 0x0df0ad8befbeaddeL (get_int64_le buffer 0));
+;;
+
+let setters m () =
+  let module Setters = (val m : S.Setters) in
+  let open Setters in
+  let string = Bytes.make 16 '_' |> Bytes.unsafe_to_string in
+  let with_buffer ~f =
+    let buffer = Bigstringaf.of_string ~off:0 ~len:(String.length string) string in
+    f buffer
+  in
+  let substring ~len buffer = Bigstringaf.substring ~off:0 ~len buffer in
+
+  with_buffer ~f:(fun buffer ->
+    set buffer 0 '\xde';
+    Alcotest.(check string "set" "\xde___" (substring ~len:4 buffer)));
+
+  with_buffer ~f:(fun buffer ->
+    set buffer 2 '\xbe';
+    Alcotest.(check string "set" "__\xbe_" (substring ~len:4 buffer)));
+
+  with_buffer ~f:(fun buffer ->
+    set_int16_be buffer 0 0xdead;
+    Alcotest.(check string "set_int16_be" "\xde\xad__" (substring ~len:4 buffer)));
+
+  with_buffer ~f:(fun buffer ->
+    set_int16_be buffer 2 0xbeef;
+    Alcotest.(check string "set_int16_be" "__\xbe\xef" (substring ~len:4 buffer)));
+
+  with_buffer ~f:(fun buffer ->
+    set_int16_le buffer 0 0xdead;
+    Alcotest.(check string "set_int16_le" "\xad\xde__" (substring ~len:4 buffer)));
+
+  with_buffer ~f:(fun buffer ->
+    set_int16_le buffer 2 0xbeef;
+    Alcotest.(check string "set_int16_le" "__\xef\xbe" (substring ~len:4 buffer)));
+
+  with_buffer ~f:(fun buffer ->
+    set_int32_be buffer 0 0xdeadbeefl;
+    Alcotest.(check string "set_int32_be" "\xde\xad\xbe\xef____" (substring ~len:8 buffer)));
+
+  with_buffer ~f:(fun buffer ->
+    set_int32_le buffer 0 0xdeadbeefl;
+    Alcotest.(check string "set_int32_le" "\xef\xbe\xad\xde____" (substring ~len:8 buffer)));
+
+  with_buffer ~f:(fun buffer ->
+    set_int32_be buffer 2 0xbeef8badl;
+    Alcotest.(check string "set_int32_be" "__\xbe\xef\x8b\xad__" (substring ~len:8 buffer)));
+
+  with_buffer ~f:(fun buffer ->
+    set_int32_le buffer 2 0xbeef8badl;
+    Alcotest.(check string "set_int32_le" "__\xad\x8b\xef\xbe__" (substring ~len:8 buffer)));
+
+  with_buffer ~f:(fun buffer ->
+    set_int64_be buffer 0 0xdeadbeef8badf00dL;
+    Alcotest.(check string "set_int64_be" "\xde\xad\xbe\xef\x8b\xad\xf0\x0d" (substring ~len:8 buffer)));
+
+  with_buffer ~f:(fun buffer ->
+    set_int64_le buffer 0 0xdeadbeef8badf00dL;
+    Alcotest.(check string "set_int64_le" "\x0d\xf0\xad\x8b\xef\xbe\xad\xde" (substring ~len:8 buffer)));
+;;
+
+let string1 = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
+let string2 = "abcdefghijklmnopqrstuvwxyz"
+
+let blit m () =
+  let module Blit = (val m : S.Blit) in
+  let open Blit in
+  let with_buffers ~f =
+    let buffer1 = Bigstringaf.of_string string1 ~off:0 ~len:(String.length string1) in
+    let buffer2 = Bigstringaf.of_string string2 ~off:0 ~len:(String.length string2) in
+    f buffer1 buffer2
+  in
+  with_buffers ~f:(fun buf1 buf2 ->
+    blit buf1 ~src_off:0 buf2 ~dst_off:0 ~len:0;
+    let new_string2 = Bigstringaf.substring buf2 ~off:0 ~len:(Bigstringaf.length buf2) in
+    Alcotest.(check string "empty blit" string2 new_string2));
+
+  with_buffers ~f:(fun buf1 buf2 ->
+    blit buf1 ~src_off:0 buf2 ~dst_off:0 ~len:(Bigstringaf.length buf2);
+    let new_string2 = Bigstringaf.substring buf2 ~off:0 ~len:(Bigstringaf.length buf2) in
+    Alcotest.(check string "full blit to another buffer" string1 new_string2));
+
+  with_buffers ~f:(fun buf1 _buf2 ->
+    blit buf1 ~src_off:0 buf1 ~dst_off:0 ~len:(Bigstringaf.length buf1);
+    let new_string1 = Bigstringaf.substring buf1 ~off:0 ~len:(Bigstringaf.length buf1) in
+    Alcotest.(check string "entirely overlapping blit (unchanged)" string1 new_string1));
+
+  with_buffers ~f:(fun buf1 buf2 ->
+    blit buf1 ~src_off:0 buf2 ~dst_off:4 ~len:8;
+    let new_string2 = Bigstringaf.substring buf2 ~off:0 ~len:(Bigstringaf.length buf2) in
+    Alcotest.(check string "partial blit to another buffer" "abcdABCDEFGHmnopqrstuvwxyz" new_string2));
+
+  with_buffers ~f:(fun buf1 _buf2 ->
+    blit buf1 ~src_off:0 buf1 ~dst_off:4 ~len:8;
+    let new_string1 = Bigstringaf.substring buf1 ~off:0 ~len:(Bigstringaf.length buf1) in
+    Alcotest.(check string "partially overlapping" "ABCDABCDEFGHMNOPQRSTUVWXYZ" new_string1));
+;;
+
+let blit_to_bytes m () =
+  let module Blit = (val m : S.Blit) in
+  let open Blit in
+  let with_buffers ~f =
+    let buffer1 = string1 in
+    let buffer2 = Bigstringaf.of_string string2 ~off:0 ~len:(String.length string2) in
+    f buffer1 buffer2
+  in
+  with_buffers ~f:(fun buf1 buf2 ->
+    blit_from_string buf1 ~src_off:0 buf2 ~dst_off:0 ~len:0;
+    let new_string2 = Bigstringaf.substring buf2 ~off:0 ~len:(Bigstringaf.length buf2) in
+    Alcotest.(check string "empty blit" string2 new_string2));
+
+  with_buffers ~f:(fun buf1 buf2 ->
+    blit_from_string buf1 ~src_off:0 buf2 ~dst_off:0 ~len:(Bigstringaf.length buf2);
+    let new_string2 = Bigstringaf.substring buf2 ~off:0 ~len:(Bigstringaf.length buf2) in
+    Alcotest.(check string "full blit to another buffer" string1 new_string2));
+
+  with_buffers ~f:(fun buf1 buf2 ->
+    blit_from_string buf1 ~src_off:0 buf2 ~dst_off:4 ~len:8;
+    let new_string2 = Bigstringaf.substring buf2 ~off:0 ~len:(Bigstringaf.length buf2) in
+    Alcotest.(check string "partial blit to another buffer" "abcdABCDEFGHmnopqrstuvwxyz" new_string2));
+;;
+
+let blit_from_bytes m () =
+  let module Blit = (val m : S.Blit) in
+  let open Blit in
+  let with_buffers ~f =
+    let buffer1 = Bytes.of_string string1 in
+    let buffer2 = Bigstringaf.of_string string2 ~off:0 ~len:(String.length string2) in
+    f buffer1 buffer2
+  in
+  with_buffers ~f:(fun buf1 buf2 ->
+    blit_from_bytes buf1 ~src_off:0 buf2 ~dst_off:0 ~len:0;
+    let new_string2 = Bigstringaf.substring buf2 ~off:0 ~len:(Bigstringaf.length buf2) in
+    Alcotest.(check string "empty blit" string2 new_string2));
+
+  with_buffers ~f:(fun buf1 buf2 ->
+    blit_from_bytes buf1 ~src_off:0 buf2 ~dst_off:0 ~len:(Bigstringaf.length buf2);
+    let new_string2 = Bigstringaf.substring buf2 ~off:0 ~len:(Bigstringaf.length buf2) in
+    Alcotest.(check string "full blit to another buffer" string1 new_string2));
+
+  with_buffers ~f:(fun buf1 buf2 ->
+    blit_from_bytes buf1 ~src_off:0 buf2 ~dst_off:4 ~len:8;
+    let new_string2 = Bigstringaf.substring buf2 ~off:0 ~len:(Bigstringaf.length buf2) in
+    Alcotest.(check string "partial blit to another buffer" "abcdABCDEFGHmnopqrstuvwxyz" new_string2));
+;;
+
+let memcmp m () =
+  let module Memcmp = (val m : S.Memcmp) in
+  let open Memcmp in
+  let buffer1 = Bigstringaf.of_string ~off:0 ~len:(String.length string1) string1 in
+  let buffer2 = Bigstringaf.of_string ~off:0 ~len:(String.length string2) string2 in
+  Alcotest.(check bool "identical buffers are equal" true
+    (memcmp buffer1 0 buffer1 0 (Bigstringaf.length buffer1) = 0));
+  Alcotest.(check bool "prefix of identical buffers are equal" true
+    (memcmp buffer1 0 buffer1 0 (Bigstringaf.length buffer1 - 10 ) = 0));
+  Alcotest.(check bool "suffix of identical buffers are equal" true
+    (memcmp buffer1 10 buffer1 10 (Bigstringaf.length buffer1 - 10) = 0));
+  Alcotest.(check bool "uppercase is less than uppercase" true
+    (memcmp buffer1 0 buffer2 0 (Bigstringaf.length buffer1) < 0));
+  Alcotest.(check bool "lowercase is greater than uppercase" true
+    (memcmp buffer2 0 buffer1 0 (Bigstringaf.length buffer1) > 0));
+;;
+
+let memcmp_string m () =
+  let module Memcmp = (val m : S.Memcmp) in
+  let open Memcmp in
+  let buffer1 = Bigstringaf.of_string ~off:0 ~len:(String.length string1) string1 in
+  let buffer2 = Bigstringaf.of_string ~off:0 ~len:(String.length string2) string2 in
+  Alcotest.(check bool "of_string'd and original buffer are equal" true
+    (memcmp_string buffer1 0 string1 0 (Bigstringaf.length buffer1) = 0));
+  Alcotest.(check bool "prefix of of_string'd and original buffer are equal" true
+    (memcmp_string buffer1 10 string1 10 (Bigstringaf.length buffer1 - 10) = 0));
+  Alcotest.(check bool "suffix of identical buffers are equal" true
+    (memcmp_string buffer1 10 string1 10 (Bigstringaf.length buffer1 - 10) = 0));
+  Alcotest.(check bool "uppercase is less than uppercase" true
+    (memcmp_string buffer1 0 string2 0 (Bigstringaf.length buffer1) < 0));
+  Alcotest.(check bool "lowercase is greater than uppercase" true
+    (memcmp_string buffer2 0 string1 0 (Bigstringaf.length buffer1) > 0));
+  ()
+;;
+
+let memchr m () =
+  let module Memchr = (val m : S.Memchr) in
+  let open Memchr in
+  let string = "hello world foo bar baz" in
+  let buffer = Bigstringaf.of_string ~off:0 ~len:(String.length string) string in
+  let buffer_len = Bigstringaf.length buffer in
+  Alcotest.(check int) "memchr starting at offset 0" (String.index_from string 0 ' ')
+    (memchr buffer 0 ' ' buffer_len);
+  Alcotest.(check int) "memchr with an offset" (String.index_from string 7 ' ')
+    (memchr buffer 7 ' ' (buffer_len - 7));
+  Alcotest.(check int) "memchr char not found" (-1)
+    (memchr buffer 0 'Z' buffer_len)
+
+let negative_bounds_check () =
+  let open Bigstringaf in
+  let buf = Bigstringaf.empty in
+  let exn_str fn =
+    Invalid_argument
+      (Printf.sprintf
+        "Bigstringaf.%s invalid range: { buffer_len: 0, off: 0, len: -8 }"
+        fn)
+  in
+  let exn_ba fn =
+    Invalid_argument
+      (Printf.sprintf
+        "Bigstringaf.%s invalid range: { src_len: 0, src_off: 0, dst_len: 0, dst_off: 4, len: -8 }"
+        fn)
+  in
+  let exn_cmp fn =
+    Invalid_argument
+      (Printf.sprintf
+        "Bigstringaf.%s invalid range: { buf1_len: 0, buf1_off: 0, buf2_len: 0, buf2_off: 0, len: -8 }"
+    fn)
+  in
+  Alcotest.check_raises "copy"
+    (exn_str "copy")
+    (fun () -> ignore (copy buf ~off:0 ~len:(-8)));
+  Alcotest.check_raises "substring"
+    (exn_str "substring")
+    (fun () -> ignore (substring buf ~off:0 ~len:(-8)));
+  Alcotest.check_raises "of_string"
+    (exn_str "of_string")
+    (fun () -> ignore (of_string "" ~off:0 ~len:(-8)));
+  Alcotest.check_raises "blit"
+    (exn_ba "blit")
+    (fun () -> ignore (blit buf ~src_off:0 buf ~dst_off:4 ~len:(-8)));
+  Alcotest.check_raises "blit_from_string"
+    (exn_ba "blit_from_string")
+    (fun () ->
+      ignore (blit_from_string "" ~src_off:0 buf ~dst_off:4 ~len:(-8)));
+  Alcotest.check_raises "blit_from_bytes"
+    (exn_ba "blit_from_bytes")
+    (fun () ->
+      ignore (blit_from_bytes (Bytes.of_string "") ~src_off:0 buf ~dst_off:4 ~len:(-8)));
+  Alcotest.check_raises "blit_to_bytes"
+    (exn_ba "blit_to_bytes")
+    (fun () ->
+      ignore (blit_to_bytes buf ~src_off:0 (Bytes.of_string "") ~dst_off:4 ~len:(-8)));
+  Alcotest.check_raises "memcmp"
+    (exn_cmp "memcmp")
+    (fun () ->
+      ignore (memcmp buf 0 buf 0 (-8)));
+  Alcotest.check_raises "memcmp_string"
+    (exn_cmp "memcmp_string")
+    (fun () ->
+      ignore (memcmp_string buf 0 "" 0 (-8)));
+;;
+
+let safe_operations =
+  let module Getters : S.Getters = Bigstringaf in
+  let module Setters : S.Setters = Bigstringaf in
+  let module Blit    : S.Blit    = Bigstringaf in
+  let module Memcmp  : S.Memcmp  = Bigstringaf in
+  let module Memchr  : S.Memchr  = Bigstringaf in
+  [ "index out of bounds", `Quick, index_out_of_bounds
+  ; "getters"            , `Quick, getters         (module Getters)
+  ; "setters"            , `Quick, setters         (module Setters)
+  ; "blit"               , `Quick, blit            (module Blit)
+  ; "blit_to_bytes"      , `Quick, blit_to_bytes   (module Blit)
+  ; "blit_from_bytes"    , `Quick, blit_from_bytes (module Blit)
+  ; "memcmp"             , `Quick, memcmp          (module Memcmp)
+  ; "memcmp_string"      , `Quick, memcmp_string   (module Memcmp)
+  ; "negative length"    , `Quick, negative_bounds_check
+  ; "memchr"             , `Quick, memchr          (module Memchr)
+  ]
+
+let unsafe_operations =
+  let module Getters : S.Getters = struct
+    open Bigstringaf
+
+    let get = unsafe_get
+
+    let get_int16_le = unsafe_get_int16_le
+    let get_int16_sign_extended_le = unsafe_get_int16_sign_extended_le
+    let get_int32_le = unsafe_get_int32_le
+    let get_int64_le = unsafe_get_int64_le
+
+    let get_int16_be = unsafe_get_int16_be
+    let get_int16_sign_extended_be = unsafe_get_int16_sign_extended_be
+    let get_int32_be = unsafe_get_int32_be
+    let get_int64_be = unsafe_get_int64_be
+  end in
+  let module Setters : S.Setters = struct
+    open Bigstringaf
+
+    let set = unsafe_set
+
+    let set_int16_le = unsafe_set_int16_le
+    let set_int32_le = unsafe_set_int32_le
+    let set_int64_le = unsafe_set_int64_le
+
+    let set_int16_be = unsafe_set_int16_be
+    let set_int32_be = unsafe_set_int32_be
+    let set_int64_be = unsafe_set_int64_be
+  end in
+  let module Blit : S.Blit = struct
+    open Bigstringaf
+
+    let blit = unsafe_blit
+    let blit_from_string = unsafe_blit_from_string
+    let blit_from_bytes = unsafe_blit_from_bytes
+
+    let blit_to_bytes = unsafe_blit_to_bytes
+  end in
+  let module Memcmp : S.Memcmp = struct
+    open Bigstringaf
+
+    let memcmp = unsafe_memcmp
+    let memcmp_string = unsafe_memcmp_string
+  end in
+  let module Memchr : S.Memchr = struct
+    open Bigstringaf
+
+    let memchr = unsafe_memchr
+  end in
+  [ "getters"        , `Quick, getters         (module Getters)
+  ; "setters"        , `Quick, setters         (module Setters)
+  ; "blit"           , `Quick, blit            (module Blit)
+  ; "blit_to_bytes"  , `Quick, blit_to_bytes   (module Blit)
+  ; "blit_from_bytes", `Quick, blit_from_bytes (module Blit)
+  ; "memcmp"         , `Quick, memcmp          (module Memcmp)
+  ; "memcmp_string"  , `Quick, memcmp_string   (module Memcmp)
+  ; "memchr"         , `Quick, memchr          (module Memchr)
+  ]
+
+let () =
+  Alcotest.run "test suite"
+    [ "constructors"     , constructors
+    ; "safe operations"  , safe_operations
+    ; "unsafe operations", unsafe_operations ]