1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 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 ]
|