(* This file is part of Lwt, released under the MIT license. See LICENSE.md for details, or visit https://github.com/ocsigen/lwt/blob/master/LICENSE.md. *) open Lwt.Infix open Test let bytes_equal (b1:Bytes.t) (b2:Bytes.t) = b1 = b2 let tcp_server_client_exchange server_logic client_logic = let server_is_ready, notify_server_is_ready = Lwt.wait () in let server () = let sock = Lwt_unix.socket Lwt_unix.PF_INET Lwt_unix.SOCK_STREAM 0 in let sockaddr = Lwt_unix.ADDR_INET (Unix.inet_addr_loopback, 0) in Lwt_unix.bind sock sockaddr >>= fun () -> let server_address = Lwt_unix.getsockname sock in let () = Lwt_unix.listen sock 5 in Lwt.wakeup_later notify_server_is_ready server_address; Lwt_unix.accept sock >>= fun (fd_client, _) -> server_logic fd_client >>= fun _n -> Lwt_unix.close fd_client >>= fun () -> Lwt_unix.close sock in let client () = server_is_ready >>= fun sockaddr -> let sock = Lwt_unix.socket Lwt_unix.PF_INET Lwt_unix.SOCK_STREAM 0 in Lwt_unix.connect sock sockaddr >>= fun () -> client_logic sock >>= fun _n -> Lwt_unix.close sock in Lwt.join [client (); server ()] let udp_server_client_exchange server_logic client_logic = let server_is_ready, notify_server_is_ready = Lwt.wait () in let server () = let sock = Lwt_unix.socket Lwt_unix.PF_INET Lwt_unix.SOCK_DGRAM 0 in let sockaddr = Lwt_unix.ADDR_INET (Unix.inet_addr_loopback, 0) in Lwt_unix.bind sock sockaddr >>= fun () -> let server_address = Lwt_unix.getsockname sock in Lwt.wakeup_later notify_server_is_ready server_address; server_logic sock >>= fun (_n, _sockaddr) -> Lwt_unix.close sock in let client () = server_is_ready >>= fun sockaddr -> let sock = Lwt_unix.socket Lwt_unix.PF_INET Lwt_unix.SOCK_DGRAM 0 in client_logic sock sockaddr >>= fun (_n) -> Lwt_unix.close sock in Lwt.join [client (); server ()] let gen_buf n = let buf = Lwt_bytes.create n in let () = Lwt_bytes.fill buf 0 n '\x00' in buf (* The two following helpers only focus on the behavior of * Lwt_bytes.mincore and Lwt_bytes.wait_mincore with different arguments that * represents correct or bad bounds. * * The main purposes of those functions are not tested. * *) let file_suffix = let last_file_suffix = ref 0 in fun () -> incr last_file_suffix; !last_file_suffix let test_mincore buff_len offset n_states = let test_file = Printf.sprintf "bytes_mincore_write_%i" (file_suffix ()) in Lwt_unix.openfile test_file [O_RDWR;O_TRUNC; O_CREAT] 0o666 >>= fun fd -> let buf_write = gen_buf buff_len in Lwt_bytes.write fd buf_write 0 buff_len >>= fun _n -> Lwt_unix.close fd >>= fun () -> let fd = Unix.openfile test_file [O_RDONLY] 0 in let shared = false in let size = buff_len in let buffer = Lwt_bytes.map_file ~fd ~shared ~size () in let states = Array.make n_states false in let () = Lwt_bytes.mincore buffer offset states in Lwt.return_unit let test_wait_mincore buff_len offset = let test_file = Printf.sprintf "bytes_mincore_write_%i" (file_suffix ()) in Lwt_unix.openfile test_file [O_RDWR;O_TRUNC; O_CREAT] 0o666 >>= fun fd -> let buf_write = gen_buf buff_len in Lwt_bytes.write fd buf_write 0 buff_len >>= fun _n -> Lwt_unix.close fd >>= fun () -> let fd = Unix.openfile test_file [O_RDONLY] 0 in let shared = false in let size = buff_len in let buffer = Lwt_bytes.map_file ~fd ~shared ~size () in Lwt_bytes.wait_mincore buffer offset let suite = suite "lwt_bytes" [ test "create" begin fun () -> let len = 5 in let buff = Lwt_bytes.create len in let len' = Bigarray.Array1.dim buff in Lwt.return (len = len') end; test "get/set" begin fun () -> let buff = Lwt_bytes.create 4 in let () = Lwt_bytes.set buff 0 'a' in let () = Lwt_bytes.set buff 1 'b' in let () = Lwt_bytes.set buff 2 'c' in let check = Lwt_bytes.get buff 0 = 'a' && Lwt_bytes.get buff 1 = 'b' && Lwt_bytes.get buff 2 = 'c' in Lwt.return check end; test "get out of bounds : lower limit" begin fun () -> let buff = Lwt_bytes.create 3 in match Lwt_bytes.get buff (-1) with | exception Invalid_argument _ -> Lwt.return_true | _ -> Lwt.return_false end; test "get out of bounds : upper limit" begin fun () -> let buff = Lwt_bytes.create 3 in match Lwt_bytes.get buff 3 with | exception Invalid_argument _ -> Lwt.return_true | _ -> Lwt.return_false end; test "set out of bounds : lower limit" begin fun () -> let buff = Lwt_bytes.create 3 in match Lwt_bytes.set buff (-1) 'a' with | exception Invalid_argument _ -> Lwt.return_true | () -> Lwt.return_false end; test "set out of bounds : upper limit" begin fun () -> let buff = Lwt_bytes.create 3 in match Lwt_bytes.set buff 3 'a' with | exception Invalid_argument _ -> Lwt.return_true | () -> Lwt.return_false end; test "unsafe_get/unsafe_set" begin fun () -> let buff = Lwt_bytes.create 4 in let () = Lwt_bytes.unsafe_set buff 0 'a' in let () = Lwt_bytes.unsafe_set buff 1 'b' in let () = Lwt_bytes.unsafe_set buff 2 'c' in let check = Lwt_bytes.unsafe_get buff 0 = 'a' && Lwt_bytes.unsafe_get buff 1 = 'b' && Lwt_bytes.unsafe_get buff 2 = 'c' in Lwt.return check end; test "of bytes" begin fun () -> let bytes = Bytes.of_string "abc" in let buff = Lwt_bytes.of_bytes bytes in let check = Lwt_bytes.get buff 0 = Bytes.get bytes 0 && Lwt_bytes.get buff 1 = Bytes.get bytes 1 && Lwt_bytes.get buff 2 = Bytes.get bytes 2 in Lwt.return check end; test "of string" begin fun () -> let buff = Lwt_bytes.of_string "abc" in let check = Lwt_bytes.get buff 0 = 'a' && Lwt_bytes.get buff 1 = 'b' && Lwt_bytes.get buff 2 = 'c' in Lwt.return check end; test "to bytes" begin fun () -> let bytes = Bytes.of_string "abc" in let buff = Lwt_bytes.of_bytes bytes in let bytes' = Lwt_bytes.to_bytes buff in let check = bytes_equal bytes bytes' in Lwt.return check end; test "to string" begin fun () -> let str = "abc" in let buff = Lwt_bytes.of_string str in let str' = Lwt_bytes.to_string buff in let check = str = str' in Lwt.return check end; test "blit" begin fun () -> let str1 = "abc" in let buf1 = Lwt_bytes.of_string str1 in let str2 = "abcdef" in let buf2 = Lwt_bytes.of_string str2 in let () = Lwt_bytes.blit buf1 0 buf2 3 3 in let check = "abcabc" = Lwt_bytes.to_string buf2 in Lwt.return check end; test "blit source out of bounds: lower limit" begin fun () -> let str1 = "abc" in let buf1 = Lwt_bytes.of_string str1 in let str2 = "abcdef" in let buf2 = Lwt_bytes.of_string str2 in match Lwt_bytes.blit buf1 (-1) buf2 3 3 with | exception Invalid_argument _ -> Lwt.return_true | () -> Lwt.return_false end; test "blit source out of bounds: upper limit" begin fun () -> let str1 = "abc" in let buf1 = Lwt_bytes.of_string str1 in let str2 = "abcdef" in let buf2 = Lwt_bytes.of_string str2 in match Lwt_bytes.blit buf1 1 buf2 3 3 with | exception Invalid_argument _ -> Lwt.return_true | () -> Lwt.return_false end; test "blit destination out of bounds: lower limit" begin fun () -> let str1 = "abc" in let buf1 = Lwt_bytes.of_string str1 in let str2 = "abcdef" in let buf2 = Lwt_bytes.of_string str2 in match Lwt_bytes.blit buf1 0 buf2 (-1) 3 with | exception Invalid_argument _ -> Lwt.return_true | () -> Lwt.return_false end; test "blit destination out of bounds: upper limit" begin fun () -> let str1 = "abc" in let buf1 = Lwt_bytes.of_string str1 in let str2 = "abcdef" in let buf2 = Lwt_bytes.of_string str2 in match Lwt_bytes.blit buf1 0 buf2 4 3 with | exception Invalid_argument _ -> Lwt.return_true | () -> Lwt.return_false end; test "blit length out of bounds: lower limit" begin fun () -> let str1 = "abc" in let buf1 = Lwt_bytes.of_string str1 in let str2 = "abcdef" in let buf2 = Lwt_bytes.of_string str2 in match Lwt_bytes.blit buf1 0 buf2 3 (-1) with | exception Invalid_argument _ -> Lwt.return_true | () -> Lwt.return_false end; test "blit from bytes" begin fun () -> let bytes1 = Bytes.of_string "abc" in let str2 = "abcdef" in let buf2 = Lwt_bytes.of_string str2 in let () = Lwt_bytes.blit_from_bytes bytes1 0 buf2 3 3 in let check = "abcabc" = Lwt_bytes.to_string buf2 in Lwt.return check end; test "blit from bytes source out of bounds: lower limit" begin fun () -> let bytes1 = Bytes.of_string "abc" in let str2 = "abcdef" in let buf2 = Lwt_bytes.of_string str2 in match Lwt_bytes.blit_from_bytes bytes1 (-1) buf2 3 3 with | exception Invalid_argument _ -> Lwt.return_true | () -> Lwt.return_false end; test "blit from bytes source out of bounds: upper limit" begin fun () -> let bytes1 = Bytes.of_string "abc" in let str2 = "abcdef" in let buf2 = Lwt_bytes.of_string str2 in match Lwt_bytes.blit_from_bytes bytes1 1 buf2 3 3 with | exception Invalid_argument _ -> Lwt.return_true | () -> Lwt.return_false end; test "blit from bytes destination out of bounds: lower limit" begin fun () -> let bytes1 = Bytes.of_string "abc" in let str2 = "abcdef" in let buf2 = Lwt_bytes.of_string str2 in match Lwt_bytes.blit_from_bytes bytes1 0 buf2 (-1) 3 with | exception Invalid_argument _ -> Lwt.return_true | () -> Lwt.return_false end; test "blit from bytes destination out of bounds: upper limit" begin fun () -> let bytes1 = Bytes.of_string "abc" in let str2 = "abcdef" in let buf2 = Lwt_bytes.of_string str2 in match Lwt_bytes.blit_from_bytes bytes1 0 buf2 4 3 with | exception Invalid_argument _ -> Lwt.return_true | () -> Lwt.return_false end; test "blit from bytes length out of bounds: lower limit" begin fun () -> let bytes1 = Bytes.of_string "abc" in let str2 = "abcdef" in let buf2 = Lwt_bytes.of_string str2 in match Lwt_bytes.blit_from_bytes bytes1 0 buf2 3 (-1) with | exception Invalid_argument _ -> Lwt.return_true | () -> Lwt.return_false end; test "blit from string" begin fun () -> let string1 = "abc" in let str2 = "abcdef" in let buf2 = Lwt_bytes.of_string str2 in let () = Lwt_bytes.blit_from_string string1 0 buf2 3 3 in let check = "abcabc" = Lwt_bytes.to_string buf2 in Lwt.return check end; test "blit from string source out of bounds: lower limit" begin fun () -> let string1 = "abc" in let str2 = "abcdef" in let buf2 = Lwt_bytes.of_string str2 in match Lwt_bytes.blit_from_string string1 (-1) buf2 3 3 with | exception Invalid_argument _ -> Lwt.return_true | () -> Lwt.return_false end; test "blit from string source out of bounds: upper limit" begin fun () -> let string1 = "abc" in let str2 = "abcdef" in let buf2 = Lwt_bytes.of_string str2 in match Lwt_bytes.blit_from_string string1 1 buf2 3 3 with | exception Invalid_argument _ -> Lwt.return_true | () -> Lwt.return_false end; test "blit from string destination out of bounds: lower limit" begin fun () -> let string1 = "abc" in let str2 = "abcdef" in let buf2 = Lwt_bytes.of_string str2 in match Lwt_bytes.blit_from_string string1 0 buf2 (-1) 3 with | exception Invalid_argument _ -> Lwt.return_true | () -> Lwt.return_false end; test "blit from string destination out of bounds: upper limit" begin fun () -> let string1 = "abc" in let str2 = "abcdef" in let buf2 = Lwt_bytes.of_string str2 in match Lwt_bytes.blit_from_string string1 0 buf2 4 3 with | exception Invalid_argument _ -> Lwt.return_true | () -> Lwt.return_false end; test "blit from string length out of bounds: lower limit" begin fun () -> let string1 = "abc" in let str2 = "abcdef" in let buf2 = Lwt_bytes.of_string str2 in match Lwt_bytes.blit_from_string string1 0 buf2 3 (-1) with | exception Invalid_argument _ -> Lwt.return_true | () -> Lwt.return_false end; test "blit from string length out of bounds: upper limit" begin fun () -> let string1 = "abc" in let str2 = "abcdef" in let buf2 = Lwt_bytes.of_string str2 in match Lwt_bytes.blit_from_string string1 0 buf2 3 10 with | exception Invalid_argument _ -> Lwt.return_true | () -> Lwt.return_false end; test "blit to bytes" begin fun () -> let str1 = "abc" in let buf1 = Lwt_bytes.of_string str1 in let str2 = "abcdef" in let bytes2 = Bytes.of_string str2 in let () = Lwt_bytes.blit_to_bytes buf1 0 bytes2 3 3 in let check = "abcabc" = Bytes.to_string bytes2 in Lwt.return check end; test "blit to bytes source out of bounds: lower limit" begin fun () -> let str1 = "abc" in let buf1 = Lwt_bytes.of_string str1 in let str2 = "abcdef" in let bytes2 = Bytes.of_string str2 in match Lwt_bytes.blit_to_bytes buf1 (-1) bytes2 3 3 with | exception Invalid_argument _ -> Lwt.return_true | () -> Lwt.return_false end; test "blit to bytes source out of bounds: upper limit" begin fun () -> let str1 = "abc" in let buf1 = Lwt_bytes.of_string str1 in let str2 = "abcdef" in let bytes2 = Bytes.of_string str2 in match Lwt_bytes.blit_to_bytes buf1 1 bytes2 3 3 with | exception Invalid_argument _ -> Lwt.return_true | () -> Lwt.return_false end; test "blit to bytes destination out of bounds: lower limit" begin fun () -> let str1 = "abc" in let buf1 = Lwt_bytes.of_string str1 in let str2 = "abcdef" in let bytes2 = Bytes.of_string str2 in match Lwt_bytes.blit_to_bytes buf1 0 bytes2 (-1) 3 with | exception Invalid_argument _ -> Lwt.return_true | () -> Lwt.return_false end; test "blit to bytes destination out of bounds: upper limit" begin fun () -> let str1 = "abc" in let buf1 = Lwt_bytes.of_string str1 in let str2 = "abcdef" in let bytes2 = Bytes.of_string str2 in match Lwt_bytes.blit_to_bytes buf1 0 bytes2 4 3 with | exception Invalid_argument _ -> Lwt.return_true | () -> Lwt.return_false end; test "blit to bytes length out of bounds: lower limit" begin fun () -> let str1 = "abc" in let buf1 = Lwt_bytes.of_string str1 in let str2 = "abcdef" in let bytes2 = Bytes.of_string str2 in match Lwt_bytes.blit_to_bytes buf1 0 bytes2 3 (-1) with | exception Invalid_argument _ -> Lwt.return_true | () -> Lwt.return_false end; test "unsafe blit" begin fun () -> let str1 = "abc" in let buf1 = Lwt_bytes.of_string str1 in let str2 = "abcdef" in let buf2 = Lwt_bytes.of_string str2 in let () = Lwt_bytes.unsafe_blit buf1 0 buf2 3 3 in let check = "abcabc" = Lwt_bytes.to_string buf2 in Lwt.return check end; test "unsafe blit from bytes" begin fun () -> let bytes1 = Bytes.of_string "abc" in let str2 = "abcdef" in let buf2 = Lwt_bytes.of_string str2 in let () = Lwt_bytes.unsafe_blit_from_bytes bytes1 0 buf2 3 3 in let check = "abcabc" = Lwt_bytes.to_string buf2 in Lwt.return check end; test "unsafe blit from string" begin fun () -> let string1 = "abc" in let str2 = "abcdef" in let buf2 = Lwt_bytes.of_string str2 in let () = Lwt_bytes.unsafe_blit_from_string string1 0 buf2 3 3 in let check = "abcabc" = Lwt_bytes.to_string buf2 in Lwt.return check end; test "unsafe blit to bytes" begin fun () -> let str1 = "abc" in let buf1 = Lwt_bytes.of_string str1 in let str2 = "abcdef" in let bytes2 = Bytes.of_string str2 in let () = Lwt_bytes.unsafe_blit_to_bytes buf1 0 bytes2 3 3 in let check = "abcabc" = Bytes.to_string bytes2 in Lwt.return check end; test "proxy" begin fun () -> let str = "abcdef" in let buf = Lwt_bytes.of_string str in let buf' = Lwt_bytes.proxy buf 3 3 in let check1 = "def" = Lwt_bytes.to_string buf' in let () = Lwt_bytes.set buf 3 'a' in let check2 = "aef" = Lwt_bytes.to_string buf' in Lwt.return (check1 && check2) end; test "proxy offset out of bounds: lower limit" begin fun () -> let str = "abcdef" in let buf = Lwt_bytes.of_string str in match Lwt_bytes.proxy buf (-1) 3 with | exception Invalid_argument _ -> Lwt.return_true | _ -> Lwt.return_false end; test "proxy offset out of bounds: upper limit" begin fun () -> let str = "abcdef" in let buf = Lwt_bytes.of_string str in match Lwt_bytes.proxy buf 4 3 with | exception Invalid_argument _ -> Lwt.return_true | _ -> Lwt.return_false end; test "proxy length out of bounds: lower limit" begin fun () -> let str = "abcdef" in let buf = Lwt_bytes.of_string str in match Lwt_bytes.proxy buf 3 (-1) with | exception Invalid_argument _ -> Lwt.return_true | _ -> Lwt.return_false end; test "extract" begin fun () -> let str = "abcdef" in let buf = Lwt_bytes.of_string str in let buf' = Lwt_bytes.extract buf 3 3 in let check = "def" = Lwt_bytes.to_string buf' in Lwt.return check end; test "extract offset out of bounds: lower limit" begin fun () -> let str = "abcdef" in let buf = Lwt_bytes.of_string str in match Lwt_bytes.extract buf (-1) 3 with | exception Invalid_argument _ -> Lwt.return_true | _ -> Lwt.return_false end; test "extract offset out of bounds: upper limit" begin fun () -> let str = "abcdef" in let buf = Lwt_bytes.of_string str in match Lwt_bytes.extract buf 4 3 with | exception Invalid_argument _ -> Lwt.return_true | _ -> Lwt.return_false end; test "extract length out of bounds: lower limit" begin fun () -> let str = "abcdef" in let buf = Lwt_bytes.of_string str in match Lwt_bytes.extract buf 3 (-1) with | exception Invalid_argument _ -> Lwt.return_true | _ -> Lwt.return_false end; test "copy" begin fun () -> let str = "abc" in let buf = Lwt_bytes.of_string str in let buf' = Lwt_bytes.copy buf in let check = str = Lwt_bytes.to_string buf' in Lwt.return check end; test "fill" begin fun () -> let str = "abcdef" in let buf = Lwt_bytes.of_string str in let () = Lwt_bytes.fill buf 3 3 'a' in let check = "abcaaa" = Lwt_bytes.to_string buf in Lwt.return check end; test "fill offset out of bounds: lower limit" begin fun () -> let str = "abcdef" in let buf = Lwt_bytes.of_string str in match Lwt_bytes.fill buf (-1) 3 'a' with | exception Invalid_argument _ -> Lwt.return_true | () -> Lwt.return_false end; test "fill offset out of bounds: upper limit" begin fun () -> let str = "abcdef" in let buf = Lwt_bytes.of_string str in match Lwt_bytes.fill buf 4 3 'a' with | exception Invalid_argument _ -> Lwt.return_true | () -> Lwt.return_false end; test "fill length out of bounds lower limit" begin fun () -> let str = "abcdef" in let buf = Lwt_bytes.of_string str in match Lwt_bytes.fill buf 3 (-1) 'a' with | exception Invalid_argument _ -> Lwt.return_true | () -> Lwt.return_false end; test "unsafe fill" begin fun () -> let str = "abcdef" in let buf = Lwt_bytes.of_string str in let () = Lwt_bytes.unsafe_fill buf 3 3 'a' in let check = "abcaaa" = Lwt_bytes.to_string buf in Lwt.return check end; test "bytes read" begin fun () -> let test_file = "bytes_io_data" in Lwt_unix.openfile test_file [O_RDONLY] 0 >>= fun fd -> let buf = Lwt_bytes.create 6 in Lwt_bytes.read fd buf 0 6 >>= fun _n -> let check = "abcdef" = Lwt_bytes.to_string buf in Lwt_unix.close fd >>= fun () -> Lwt.return check end; test "read: buffer retention" ~sequential:true begin fun () -> let buffer = Lwt_bytes.create 3 in let read_fd, write_fd = Lwt_unix.pipe ~cloexec:true () in Lwt_unix.set_blocking read_fd true; Lwt_unix.write_string write_fd "foo" 0 3 >>= fun _ -> let retained = Lwt_unix.retained buffer in Lwt_bytes.read read_fd buffer 0 3 >>= fun _ -> Lwt_unix.close write_fd >>= fun () -> Lwt_unix.close read_fd >|= fun () -> !retained end; test "bytes write" begin fun () -> let test_file = "bytes_io_data_write" in Lwt_unix.openfile test_file [O_RDWR;O_TRUNC; O_CREAT] 0o666 >>= fun fd -> let buf_write = Lwt_bytes.of_string "abc" in Lwt_bytes.write fd buf_write 0 3 >>= fun _n -> Lwt_unix.close fd >>= fun () -> Lwt_unix.openfile test_file [O_RDONLY] 0 >>= fun fd -> let buf_read = Lwt_bytes.create 3 in Lwt_bytes.read fd buf_read 0 3 >>= fun _n -> let check = buf_write = buf_read in Lwt_unix.close fd >>= fun () -> Lwt.return check end; test "write: buffer retention" ~sequential:true begin fun () -> let buffer = Lwt_bytes.create 3 in let read_fd, write_fd = Lwt_unix.pipe ~cloexec:true () in Lwt_unix.set_blocking write_fd true; let retained = Lwt_unix.retained buffer in Lwt_bytes.write write_fd buffer 0 3 >>= fun _ -> Lwt_unix.close write_fd >>= fun () -> Lwt_unix.close read_fd >|= fun () -> !retained end; test "bytes recv" ~only_if:(fun () -> not Sys.win32) begin fun () -> let buf = gen_buf 6 in let server_logic socket = Lwt_unix.write_string socket "abcdefghij" 0 9 in let client_logic socket = Lwt_bytes.recv socket buf 0 6 [] in tcp_server_client_exchange server_logic client_logic >>= fun () -> let check = "abcdef" = Lwt_bytes.to_string buf in Lwt.return check end; test "bytes send" ~only_if:(fun () -> not Sys.win32) begin fun () -> let buf = gen_buf 6 in let server_logic socket = Lwt_bytes.send socket (Lwt_bytes.of_string "abcdef") 0 6 [] in let client_logic socket = Lwt_bytes.recv socket buf 0 6 [] in tcp_server_client_exchange server_logic client_logic >>= fun () -> let check = "abcdef" = Lwt_bytes.to_string buf in Lwt.return check end; test "bytes recvfrom" ~only_if:(fun () -> not Sys.win32) begin fun () -> let buf = gen_buf 6 in let server_logic socket = Lwt_bytes.recvfrom socket buf 0 6 [] in let client_logic socket sockaddr = Lwt_unix.sendto socket (Bytes.of_string "abcdefghij") 0 9 [] sockaddr in udp_server_client_exchange server_logic client_logic >>= fun () -> let check = "abcdef" = Lwt_bytes.to_string buf in Lwt.return check end; test "bytes sendto" ~only_if:(fun () -> not Sys.win32) begin fun () -> let buf = gen_buf 6 in let server_logic socket = Lwt_bytes.recvfrom socket buf 0 6 [] in let client_logic socket sockaddr = let message = Lwt_bytes.of_string "abcdefghij" in Lwt_bytes.sendto socket message 0 9 [] sockaddr in udp_server_client_exchange server_logic client_logic >>= fun () -> let check = "abcdef" = Lwt_bytes.to_string buf in Lwt.return check end; test "bytes recv_msg" ~only_if:(fun () -> not Sys.win32) begin fun () -> let buffer = gen_buf 6 in let offset = 0 in let io_vectors = [Lwt_bytes.io_vector ~buffer ~offset ~length:6] in let server_logic socket = (Lwt_bytes.recv_msg [@ocaml.warning "-3"]) ~socket ~io_vectors in let client_logic socket sockaddr = let message = Lwt_bytes.of_string "abcdefghij" in Lwt_bytes.sendto socket message 0 9 [] sockaddr in udp_server_client_exchange server_logic client_logic >>= fun () -> let check = "abcdef" = Lwt_bytes.to_string buffer in Lwt.return check end; test "bytes send_msg" ~only_if:(fun () -> not Sys.win32) begin fun () -> let buffer = gen_buf 6 in let offset = 0 in let server_logic socket = let io_vectors = [Lwt_bytes.io_vector ~buffer ~offset ~length:6] in (Lwt_bytes.recv_msg [@ocaml.warning "-3"]) ~socket ~io_vectors in let client_logic socket sockaddr = Lwt_unix.connect socket sockaddr >>= fun () -> let message = Lwt_bytes.of_string "abcdefghij" in let io_vectors = [Lwt_bytes.io_vector ~buffer:message ~offset ~length:9] in (Lwt_bytes.send_msg [@ocaml.warning "-3"]) ~socket ~io_vectors ~fds:[] in udp_server_client_exchange server_logic client_logic >>= fun () -> let check = "abcdef" = Lwt_bytes.to_string buffer in Lwt.return check end; test "send_msgto" ~only_if:(fun () -> not Sys.win32) begin fun () -> let buffer = gen_buf 6 in let offset = 0 in let server_logic socket = let io_vectors = [Lwt_bytes.io_vector ~buffer ~offset ~length:6] in (Lwt_bytes.recv_msg [@ocaml.warning "-3"]) ~socket ~io_vectors in let client_logic socket sockaddr = let message = Lwt_bytes.of_string "abcdefghij" in let io_vectors = Lwt_unix.IO_vectors.create () in Lwt_unix.IO_vectors.append_bigarray io_vectors message offset 9; Lwt_unix.send_msgto ~socket ~io_vectors ~fds:[] ~dest:sockaddr in udp_server_client_exchange server_logic client_logic >>= fun () -> let check = "abcdef" = Lwt_bytes.to_string buffer in Lwt.return check end; test "map_file" begin fun () -> let test_file = "bytes_io_data" in let fd = Unix.openfile test_file [O_RDONLY] 0 in let shared = false in let size = 6 in let buffer = Lwt_bytes.map_file ~fd ~shared ~size () in let check = "abcdef" = Lwt_bytes.to_string buffer in let () = Unix.close fd in Lwt.return check end; test "page_size" begin fun () -> let sizes = [4096; 16384; 65536] in Lwt.return (List.mem Lwt_bytes.page_size sizes) end; test "mincore buffer length = page_size * 2, n_states = 1" ~only_if:(fun () -> not Sys.win32) begin fun () -> test_mincore (Lwt_bytes.page_size * 2) Lwt_bytes.page_size 1 >>= fun () -> Lwt.return_true end; test "mincore buffer length = page_size * 2, n_states = 2" ~only_if:(fun () -> not Sys.win32) begin fun () -> Lwt.catch (fun () -> test_mincore (Lwt_bytes.page_size * 2) Lwt_bytes.page_size 2 >>= fun () -> Lwt.return_false ) (function | Invalid_argument _message -> Lwt.return_true | exn -> Lwt.reraise exn ) end; test "mincore buffer length = page_size * 2 + 1, n_states = 2" ~only_if:(fun () -> not Sys.win32) begin fun () -> test_mincore (Lwt_bytes.page_size * 2 + 1) Lwt_bytes.page_size 2 >>= fun () -> Lwt.return_true end; test "mincore buffer length = page_size , n_states = 0" ~only_if:(fun () -> not Sys.win32) begin fun () -> test_mincore (Lwt_bytes.page_size * 2 + 1) Lwt_bytes.page_size 0 >>= fun () -> Lwt.return_true end; test "wait_mincore correct bounds" ~only_if:(fun () -> not Sys.win32) begin fun () -> test_wait_mincore (Lwt_bytes.page_size * 2 + 1) Lwt_bytes.page_size >>= fun () -> Lwt.return_true end; test "wait_mincore offset < 0" ~only_if:(fun () -> not Sys.win32) begin fun () -> Lwt.catch (fun () -> test_wait_mincore (Lwt_bytes.page_size * 2 + 1) (-1) >>= fun () -> Lwt.return_false ) (function | Invalid_argument _message -> Lwt.return_true | exn -> Lwt.reraise exn ) end; test "wait_mincore offset > buffer length" ~only_if:(fun () -> not Sys.win32) begin fun () -> Lwt.catch (fun () -> let buff_len = Lwt_bytes.page_size * 2 + 1 in test_wait_mincore buff_len (buff_len + 1) >>= fun () -> Lwt.return_false ) (function | Invalid_argument _message -> Lwt.return_true | exn -> Lwt.reraise exn ) end; ]