(* * Copyright (c) 2014 Anil Madhavapeddy * Copyright (c) 2013 Citrix Systems Inc * * Permission to use, copy, modify, and distribute this software for any * purpose with or without fee is hereby granted, provided that the above * copyright notice and this permission notice appear in all copies. * * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. *) let to_string { Cstruct.buffer; off; len } = Printf.sprintf "buffer length = %d; off=%d; len=%d" (Bigarray.Array1.dim buffer) off len (* Check we can create and use an empty cstruct *) let test_empty_cstruct () = let x = Cstruct.create 0 in Alcotest.(check int) "empty len" 0 (Cstruct.length x); let y = Cstruct.to_string x in Alcotest.(check string) "empty" "" y (* Check that we can't create a cstruct with a negative length *) let test_anti_cstruct () = try let x = Cstruct.create (-1) in failwith (Printf.sprintf "test_anti_cstruct: %s" (to_string x)) with Invalid_argument _ -> () (* Check we can shift in the +ve direction *) let test_positive_shift () = let x = Cstruct.create 1 in let y = Cstruct.shift x 1 in Alcotest.(check int) "positive shift" 0 (Cstruct.length y) (* Check that negative shifts are forbidden. *) let test_negative_shift () = let x = Cstruct.create 2 in let y = Cstruct.sub x 1 1 in try let z = Cstruct.shift x (-1) in failwith (Printf.sprintf "test_negative_shift/outer: %s" (to_string z)) with Invalid_argument _ -> try let z = Cstruct.shift y (-1) in failwith (Printf.sprintf "test_negative_shift/inner: %s" (to_string z)) with Invalid_argument _ -> () (* Check that an attempt to shift beyond the end of the buffer fails *) let test_bad_positive_shift () = let x = Cstruct.create 10 in try let y = Cstruct.shift x 11 in failwith (Printf.sprintf "test_bad_positive_shift: %s" (to_string y)) with Invalid_argument _ -> () (* Check that 'sub' works *) let test_sub () = let x = Cstruct.create 100 in let y = Cstruct.sub x 10 80 in Alcotest.(check int) "sub 1" 10 y.Cstruct.off; Alcotest.(check int) "sub 2" 80 y.Cstruct.len; let z = Cstruct.sub y 10 60 in Alcotest.(check int) "sub 3" 20 z.Cstruct.off; Alcotest.(check int) "sub 4" 60 z.Cstruct.len let test_sub_copy () = let x = Cstruct.create 100 in let y = Cstruct.sub_copy x 10 80 in Alcotest.(check int) "sub_copy 1" 0 y.Cstruct.off; Alcotest.(check int) "sub_copy 2" 80 y.Cstruct.len; let z = Cstruct.sub_copy y 10 60 in Alcotest.(check int) "sub_copy 3" 0 z.Cstruct.off; Alcotest.(check int) "sub_copy 4" 60 z.Cstruct.len; Cstruct.set_uint8 x 50 42; Alcotest.(check int) "x changed" 42 (Cstruct.get_uint8 x 50); Alcotest.(check int) "y unchanged" 0 (Cstruct.get_uint8 y 50); () let test_negative_sub () = let x = Cstruct.create 2 in let y = Cstruct.sub x 1 1 in try let z = Cstruct.sub x (-1) 0 in failwith (Printf.sprintf "test_negative_sub/outer: %s" (to_string z)) with Invalid_argument _ -> try let z = Cstruct.sub y (-1) 0 in failwith (Printf.sprintf "test_negative_sub/inner: %s" (to_string z)) with Invalid_argument _ -> () (* Check that 'sub' can't set 'len' too big *) let test_sub_len_too_big () = let x = Cstruct.create 0 in try let y = Cstruct.sub x 0 1 in failwith (Printf.sprintf "test_sub_len_too_big: %s" (to_string y)) with Invalid_argument _ -> () let test_sub_len_too_small () = let x = Cstruct.create 0 in try let y = Cstruct.sub x 0 (-1) in failwith (Printf.sprintf "test_sub_len_too_small: %s" (to_string y)) with Invalid_argument _ -> () let test_sub_offset_too_big () = let x = Cstruct.create 10 in begin try let y = Cstruct.sub x 11 0 in failwith (Printf.sprintf "test_sub_offset_too_big: %s" (to_string y)) with Invalid_argument _ -> () end; let y = Cstruct.sub x 1 9 in begin try let z = Cstruct.sub y 10 0 in failwith (Printf.sprintf "test_sub_offset_too_big: %s" (to_string z)) with Invalid_argument _ -> () end let test_of_bigarray_negative_params () = let ba = Bigarray.(Array1.create char c_layout 1) in try let x = Cstruct.of_bigarray ~off:(-1) ba in failwith (Printf.sprintf "test_of_bigarray_negative_params: negative ~off: %s" (to_string x)) with Invalid_argument _ -> try let x = Cstruct.of_bigarray ~len:(-1) ba in failwith (Printf.sprintf "test_of_bigarray_negative_params: negative ~len: %s" (to_string x)) with Invalid_argument _ -> () let test_of_bigarray_large_offset () = let ba = Bigarray.(Array1.create char c_layout 1) in let _ = Cstruct.of_bigarray ~off:1 ~len:0 ba and _ = Cstruct.of_bigarray ~off:1 ba in try let x = Cstruct.of_bigarray ~off:2 ~len:0 ba in failwith (Printf.sprintf "test_of_bigarray_large_offset: %s" (to_string x)) with Invalid_argument _ -> try let x = Cstruct.of_bigarray ~off:2 ba in failwith (Printf.sprintf "test_of_bigarray_large_offset: large ~off: %s" (to_string x)) with Invalid_argument _ -> () let test_of_bigarray_large_length () = let ba = Bigarray.(Array1.create char c_layout 1) in try let x = Cstruct.of_bigarray ~off:0 ~len:2 ba in failwith (Printf.sprintf "test_of_bigarray_large_length: %s" (to_string x)) with Invalid_argument _ -> try let x = Cstruct.of_bigarray ~off:1 ~len:1 ba in failwith (Printf.sprintf "test_of_bigarray_large_length: %s" (to_string x)) with Invalid_argument _ -> try let x = Cstruct.of_bigarray ~off:2 ~len:0 ba in failwith (Printf.sprintf "test_of_bigarray_large_length: %s" (to_string x)) with Invalid_argument _ -> try let x = Cstruct.of_bigarray ~off:2 ba in failwith (Printf.sprintf "test_of_bigarray_large_length: %s" (to_string x)) with Invalid_argument _ -> () let test_blit_offset_too_big () = let x = Cstruct.create 1 in let y = Cstruct.create 1 in try Cstruct.blit x 2 y 1 1; failwith "test_blit_offset_too_big" with Invalid_argument _ -> () let test_blit_offset_too_small () = let x = Cstruct.create 1 in let y = Cstruct.create 1 in try Cstruct.blit x (-1) y 1 1; failwith "test_blit_offset_too_small" with Invalid_argument _ -> () let test_blit_dst_offset_too_big () = let x = Cstruct.create 1 in let y = Cstruct.create 1 in try Cstruct.blit x 1 y 2 1; failwith "test_blit_dst_offset_too_big" with Invalid_argument _ -> () let test_blit_dst_offset_too_small () = let x = Cstruct.create 1 in let y = Cstruct.create 1 in try Cstruct.blit x 1 y (-1) 1; failwith "test_blit_dst_offset_too_small" with Invalid_argument _ -> () let test_blit_dst_offset_negative () = let x = Cstruct.create 1 in let y = Cstruct.create 1 in try Cstruct.blit x 0 y (-1) 1; failwith "test_blit_dst_offset_negative" with Invalid_argument _ -> () let test_blit_len_too_big () = let x = Cstruct.create 1 in let y = Cstruct.create 2 in try Cstruct.blit x 0 y 0 2; failwith "test_blit_len_too_big" with Invalid_argument _ -> () let test_blit_len_too_big2 () = let x = Cstruct.create 2 in let y = Cstruct.create 1 in try Cstruct.blit x 0 y 0 2; failwith "test_blit_len_too_big2" with Invalid_argument _ -> () let test_blit_len_too_small () = let x = Cstruct.create 1 in let y = Cstruct.create 1 in try Cstruct.blit x 0 y 0 (-1); failwith "test_blit_len_too_small" with Invalid_argument _ -> () let test_view_bounds_too_small () = let src = Cstruct.create 4 in let dst = Cstruct.create 4 in let dst_small = Cstruct.sub dst 0 2 in try Cstruct.blit src 0 dst_small 0 3; failwith "test_view_bounds_too_small" with Invalid_argument _ -> () let test_view_bounds_too_small_get_u8 () = let x = Cstruct.create 2 in let x' = Cstruct.sub x 0 1 in try let _ = Cstruct.get_uint8 x' 1 in failwith "test_view_bounds_too_small_get_u8" with Invalid_argument _ -> () let test_view_bounds_too_small_get_char () = let x = Cstruct.create 2 in let x' = Cstruct.sub x 0 1 in try let _ = Cstruct.get_char x' 1 in failwith "test_view_bounds_too_small_get_char" with Invalid_argument _ -> () let test_view_bounds_too_small_get_be16 () = let x = Cstruct.create 4 in let x' = Cstruct.sub x 0 1 in try let _ = Cstruct.BE.get_uint16 x' 0 in failwith "test_view_bounds_too_small_get_be16" with Invalid_argument _ -> () let test_view_bounds_too_small_get_be32 () = let x = Cstruct.create 8 in let x' = Cstruct.sub x 2 5 in try let _ = Cstruct.BE.get_uint32 x' 2 in failwith "test_view_bounds_too_small_get_be32" with Invalid_argument _ -> () let test_view_bounds_too_small_get_be64 () = let x = Cstruct.create 9 in let x' = Cstruct.sub x 1 5 in try let _ = Cstruct.BE.get_uint64 x' 0 in failwith "test_view_bounds_too_small_get_be64" with Invalid_argument _ -> () let test_view_bounds_too_small_get_le16 () = let x = Cstruct.create 4 in let x' = Cstruct.sub x 0 1 in try let _ = Cstruct.LE.get_uint16 x' 0 in failwith "test_view_bounds_too_small_get_le16" with Invalid_argument _ -> () let test_view_bounds_too_small_get_le32 () = let x = Cstruct.create 8 in let x' = Cstruct.sub x 2 5 in try let _ = Cstruct.LE.get_uint32 x' 2 in failwith "test_view_bounds_too_small_get_le32" with Invalid_argument _ -> () let test_view_bounds_too_small_get_le64 () = let x = Cstruct.create 9 in let x' = Cstruct.sub x 1 5 in try let _ = Cstruct.LE.get_uint64 x' 0 in failwith "test_view_bounds_too_small_get_le64" with Invalid_argument _ -> () let test_view_bounds_too_small_get_he16 () = let x = Cstruct.create 4 in let x' = Cstruct.sub x 0 1 in try let _ = Cstruct.HE.get_uint16 x' 0 in failwith "test_view_bounds_too_small_get_he16" with Invalid_argument _ -> () let test_view_bounds_too_small_get_he32 () = let x = Cstruct.create 8 in let x' = Cstruct.sub x 2 5 in try let _ = Cstruct.HE.get_uint32 x' 2 in failwith "test_view_bounds_too_small_get_he32" with Invalid_argument _ -> () let test_view_bounds_too_small_get_he64 () = let x = Cstruct.create 9 in let x' = Cstruct.sub x 1 5 in try let _ = Cstruct.HE.get_uint64 x' 0 in failwith "test_view_bounds_too_small_get_he64" with Invalid_argument _ -> () let test_lenv_overflow () = if Sys.word_size = 32 then ( (* free-up some space *) Gc.major (); let b = Cstruct.create max_int and c = Cstruct.create 3 in try let _ = Cstruct.lenv [b; b; c] in failwith "test_lenv_overflow" with Invalid_argument _ -> ()) let test_copyv_overflow () = if Sys.word_size = 32 then ( (* free-up some space *) Gc.major (); let b = Cstruct.create max_int and c = Cstruct.create 3 in try let _ = Cstruct.copyv [b; b; c] in failwith "test_copyv_overflow" with Invalid_argument _ -> ()) (* Steamroll over a buffer and a contained subview, checking that only the * contents of the subview is visible. *) let test_subview_containment_get_char, test_subview_containment_get_8, test_subview_containment_get_be16, test_subview_containment_get_be32, test_subview_containment_get_be64, test_subview_containment_get_le16, test_subview_containment_get_le32, test_subview_containment_get_le64, test_subview_containment_get_he16, test_subview_containment_get_he32, test_subview_containment_get_he64 = let open Cstruct in let test get zero () = let x = create 24 in let x' = sub x 8 8 in for i = 0 to length x - 1 do set_uint8 x i 0xff done ; for i = 0 to length x' - 1 do set_uint8 x' i 0x00 done ; for i = -8 to 8 do try let v = get x' i in if v <> zero then failwith "test_subview_containment_get" with Invalid_argument _ -> () done in test get_char '\000', test get_uint8 0, test BE.get_uint16 0, test BE.get_uint32 0l, test BE.get_uint64 0L, test LE.get_uint16 0, test LE.get_uint32 0l, test LE.get_uint64 0L, test HE.get_uint16 0, test HE.get_uint32 0l, test HE.get_uint64 0L (* Steamroll over a buffer and a contained subview, checking that only the * contents of the subview is writable. *) let test_subview_containment_set_char, test_subview_containment_set_8, test_subview_containment_set_be16, test_subview_containment_set_be32, test_subview_containment_set_be64, test_subview_containment_set_le16, test_subview_containment_set_le32, test_subview_containment_set_le64, test_subview_containment_set_he16, test_subview_containment_set_he32, test_subview_containment_set_he64 = let open Cstruct in let test set ff () = let x = create 24 in let x' = sub x 8 8 in for i = 0 to length x - 1 do set_uint8 x i 0x00 done ; for i = -8 to 8 do try set x' i ff with Invalid_argument _ -> () done; let acc = ref 0 in for i = 0 to length x - 1 do acc := !acc + get_uint8 x i done ; if !acc <> (length x' * 0xff) then failwith "test_subview_containment_set" in test set_char '\255', test set_uint8 0xff, test BE.set_uint16 0xffff, test BE.set_uint32 0xffffffffl, test BE.set_uint64 0xffffffffffffffffL, test LE.set_uint16 0xffff, test LE.set_uint32 0xffffffffl, test LE.set_uint64 0xffffffffffffffffL, test HE.set_uint16 0xffff, test HE.set_uint32 0xffffffffl, test HE.set_uint64 0xffffffffffffffffL let regression_244 () = let whole = Cstruct.create 44943 in let empty = Cstruct.sub whole 0 0 in try let _big = Cstruct.sub empty 0 204 in Alcotest.fail "could get a bigger buffer via sub" with Invalid_argument _ -> () let suite = [ "test empty cstruct", `Quick, test_empty_cstruct; "test anti cstruct", `Quick, test_anti_cstruct; "test positive shift", `Quick, test_positive_shift; "test negative shift", `Quick, test_negative_shift; "test bad positive shift", `Quick, test_bad_positive_shift; "test sub", `Quick, test_sub; "test sub_copy", `Quick, test_sub_copy; "test negative sub", `Quick, test_negative_sub; "test sub len too big", `Quick, test_sub_len_too_big; "test sub len too small", `Quick, test_sub_len_too_small; "test sub offset too big", `Quick, test_sub_offset_too_big; "test of_bigarray negative params", `Quick, test_of_bigarray_negative_params; "test of_bigarray large offset", `Quick, test_of_bigarray_large_offset; "test of_bigarray large length", `Quick, test_of_bigarray_large_length; "test blit offset too big", `Quick, test_blit_offset_too_big; "test blit offset too small", `Quick, test_blit_offset_too_small; "test blit dst offset too big", `Quick, test_blit_dst_offset_too_big; "test blit dst offset too small", `Quick, test_blit_dst_offset_too_small; "test blit dst offset negative", `Quick, test_blit_dst_offset_negative; "test blit len too big", `Quick, test_blit_len_too_big; "test blit len too big2", `Quick, test_blit_len_too_big2; "test blit len too small", `Quick, test_blit_len_too_small; "test view bounds too small", `Quick, test_view_bounds_too_small; "test_view_bounds_too_small_get_u8" , `Quick, test_view_bounds_too_small_get_u8; "test_view_bounds_too_small_get_char" , `Quick, test_view_bounds_too_small_get_char; "test_view_bounds_too_small_get_be16" , `Quick, test_view_bounds_too_small_get_be16; "test_view_bounds_too_small_get_be32" , `Quick, test_view_bounds_too_small_get_be32; "test_view_bounds_too_small_get_be64" , `Quick, test_view_bounds_too_small_get_be64; "test_view_bounds_too_small_get_le16" , `Quick, test_view_bounds_too_small_get_le16; "test_view_bounds_too_small_get_le32" , `Quick, test_view_bounds_too_small_get_le32; "test_view_bounds_too_small_get_le64" , `Quick, test_view_bounds_too_small_get_le64; "test_view_bounds_too_small_get_he16" , `Quick, test_view_bounds_too_small_get_he16; "test_view_bounds_too_small_get_he32" , `Quick, test_view_bounds_too_small_get_he32; "test_view_bounds_too_small_get_he64" , `Quick, test_view_bounds_too_small_get_he64; "test_lenv_overflow", `Quick, test_lenv_overflow; "test_copyv_overflow", `Quick, test_copyv_overflow; "test_subview_containment_get_char", `Quick, test_subview_containment_get_char; "test_subview_containment_get_8" , `Quick, test_subview_containment_get_8; "test_subview_containment_get_be16", `Quick, test_subview_containment_get_be16; "test_subview_containment_get_be32", `Quick, test_subview_containment_get_be32; "test_subview_containment_get_be64", `Quick, test_subview_containment_get_be64; "test_subview_containment_get_le16", `Quick, test_subview_containment_get_le16; "test_subview_containment_get_le32", `Quick, test_subview_containment_get_le32; "test_subview_containment_get_le64", `Quick, test_subview_containment_get_le64; "test_subview_containment_get_le16", `Quick, test_subview_containment_get_he16; "test_subview_containment_get_le32", `Quick, test_subview_containment_get_he32; "test_subview_containment_get_le64", `Quick, test_subview_containment_get_he64; "test_subview_containment_set_char", `Quick, test_subview_containment_set_char; "test_subview_containment_set_8" , `Quick, test_subview_containment_set_8; "test_subview_containment_set_be16", `Quick, test_subview_containment_set_be16; "test_subview_containment_set_be32", `Quick, test_subview_containment_set_be32; "test_subview_containment_set_be64", `Quick, test_subview_containment_set_be64; "test_subview_containment_set_le16", `Quick, test_subview_containment_set_le16; "test_subview_containment_set_le32", `Quick, test_subview_containment_set_le32; "test_subview_containment_set_le64", `Quick, test_subview_containment_set_le64; "test_subview_containment_set_le16", `Quick, test_subview_containment_set_he16; "test_subview_containment_set_le32", `Quick, test_subview_containment_set_he32; "test_subview_containment_set_le64", `Quick, test_subview_containment_set_he64; "regression 244", `Quick, regression_244; ]