mte/unikernel/duniverse/lwt/test/unix/test_lwt_unix.ml

(* 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 Test
open Lwt.Infix

(* An instance of the tester for the wait/waitpid tests. *)
let () =
  match Sys.argv with
  | [|_; "--child"|] ->
    exit 42
  | _ ->
    ()

let wait_tests = [
  test "wait" ~sequential:true ~only_if:(fun () -> not Sys.win32) begin fun () ->
    match Lwt_unix.fork () with
    | 0 ->
      Unix.execv Sys.argv.(0) [|""; "--child"|]
    | child_pid ->
      Lwt_unix.wait () >|= function
      | exited_pid, Lwt_unix.WEXITED 42 when exited_pid = child_pid -> true
      | _ -> false
  end;

  test "waitpid" ~sequential:true ~only_if:(fun () -> not Sys.win32)
      begin fun () ->
    match Lwt_unix.fork () with
    | 0 ->
      Unix.execv Sys.argv.(0) [|""; "--child"|]
    | child_pid ->
      Lwt_unix.waitpid [] child_pid >|= function
      | exited_pid, Lwt_unix.WEXITED 42 when exited_pid = child_pid -> true
      | _ -> false
  end;

  test "waitpid: any child" ~sequential:true ~only_if:(fun () -> not Sys.win32)
      begin fun () ->
    match Lwt_unix.fork () with
    | 0 ->
      Unix.execv Sys.argv.(0) [|""; "--child"|]
    | child_pid ->
      Lwt_unix.waitpid [] 0 >|= function
      | exited_pid, Lwt_unix.WEXITED 42 when exited_pid = child_pid -> true
      | _ -> false
  end;

  test "wait4" ~sequential:true ~only_if:(fun () -> not Sys.win32)
      begin fun () ->
    match Lwt_unix.fork () with
    | 0 ->
      Unix.execv Sys.argv.(0) [|""; "--child"|]
    | child_pid ->
      Lwt_unix.wait4 [] child_pid >|= function
      | exited_pid, Lwt_unix.WEXITED 42, _ when exited_pid = child_pid -> true
      | _ -> false
  end;

  test "wait4: any child" ~sequential:true ~only_if:(fun () -> not Sys.win32)
      begin fun () ->
    match Lwt_unix.fork () with
    | 0 ->
      Unix.execv Sys.argv.(0) [|""; "--child"|]
    | child_pid ->
      Lwt_unix.wait4 [] 0 >|= function
      | exited_pid, Lwt_unix.WEXITED 42, _ when exited_pid = child_pid -> true
      | _ -> false
  end;
]

(* The CLOEXEC tests use execv(2) to execute this code, by passing --cloexec to
   the copy of the tester in the child process. This is a module side effect
   that interprets that --cloexec argument. *)
let () =
  let is_fd_open fd =
    let fd  = (Obj.magic (int_of_string fd) : Unix.file_descr) in
    let buf = Bytes.create 1 in
    try
      ignore (Unix.read fd buf 0 1);
      true
    with Unix.Unix_error (Unix.EBADF, _, _) ->
      false
  in

  match Sys.argv with
  | [|_; "--cloexec"; fd; "--open"|] ->
    if is_fd_open fd then
      exit 0
    else
      exit 1
  | [|_; "--cloexec"; fd; "--closed"|] ->
    if is_fd_open fd then
      exit 1
    else
      exit 0
  | _ ->
    ()

let test_cloexec ~closed flags =
  Lwt_unix.openfile "/dev/zero" (Unix.O_RDONLY :: flags) 0o644 >>= fun fd ->
  match Lwt_unix.fork () with
  | 0 ->
    let fd = string_of_int (Obj.magic (Lwt_unix.unix_file_descr fd)) in
    let expected_status = if closed then "--closed" else "--open" in
    (* There's no portable way to obtain the tester executable name (which may
       even no longer exist at this point), but argv[0] fortunately has the
       right value when the tests are run in the Lwt dev environment. *)
    Unix.execv Sys.argv.(0) [|""; "--cloexec"; fd; expected_status|]
  | n ->
    Lwt_unix.close fd >>= fun () ->
    Lwt_unix.waitpid [] n >>= function
    | _, Unix.WEXITED 0 -> Lwt.return_true
    | _, (Unix.WEXITED _ | Unix.WSIGNALED _ | Unix.WSTOPPED _) ->
      Lwt.return_false

let openfile_tests = [
  test "openfile: O_CLOEXEC" ~only_if:(fun () -> not Sys.win32)
    (fun () -> test_cloexec ~closed:true [Unix.O_CLOEXEC]);

  test "openfile: O_CLOEXEC not given" ~only_if:(fun () -> not Sys.win32)
    (fun () -> test_cloexec ~closed:false []);

  test "openfile: O_KEEPEXEC" ~only_if:(fun () -> not Sys.win32)
    (fun () -> test_cloexec ~closed:false [Unix.O_KEEPEXEC]);

  test "openfile: O_CLOEXEC, O_KEEPEXEC" ~only_if:(fun () -> not Sys.win32)
    (fun () -> test_cloexec ~closed:true [Unix.O_CLOEXEC; Unix.O_KEEPEXEC]);

  test "openfile: O_KEEPEXEC, O_CLOEXEC" ~only_if:(fun () -> not Sys.win32)
    (fun () -> test_cloexec ~closed:true [Unix.O_KEEPEXEC; Unix.O_CLOEXEC]);
]

let utimes_tests = [
  test "utimes: basic"
    (fun () ->
      let temporary_file = Test_unix.temp_file () in

      Lwt_unix.utimes temporary_file 1. 2. >>= fun () ->
      let stat = Unix.stat temporary_file in
      let c1 = stat.Unix.st_atime = 1. in
      let c2 = stat.Unix.st_mtime = 2. in

      Lwt.return (instrument (c1 && c2)
        "utimes: basic: %f %f" stat.Unix.st_atime stat.Unix.st_mtime));

  test "utimes: current time"
    (fun () ->
      (* Unix.stat reports times about an hour away from those set by
         Unix.utimes on Windows on MinGW. Have not searched for the root cause
         yet. *)
      let acceptable_delta = if Sys.win32 then 7200. else 2. in
      let now = Unix.gettimeofday () in

      let temporary_file = Test_unix.temp_file () in

      Lwt_unix.utimes temporary_file 1. 2. >>= fun () ->
      Lwt_unix.utimes temporary_file 0. 0. >>= fun () ->
      let stat = Unix.stat temporary_file in
      let c1 = abs_float (stat.Unix.st_atime -. now) < acceptable_delta in
      let c2 = abs_float (stat.Unix.st_mtime -. now) < acceptable_delta in

      Lwt.return (instrument (c1 && c2)
        "utimes: current time: %f %f %f"
        now stat.Unix.st_atime stat.Unix.st_mtime));

  test "utimes: missing file"
    (fun () ->
      Lwt.catch
        (fun () -> Lwt_unix.utimes "non-existent-file" 0. 0.)
        (function
        | Unix.Unix_error (Unix.ENOENT, "utimes", _) -> Lwt.return_unit
        | Unix.Unix_error (Unix.EUNKNOWNERR _, "utimes", _) -> Lwt.return_unit
        | e -> Lwt.reraise e) >>= fun () ->
      Lwt.return_true);
]

let readdir_tests =
  let populate n =
    let path = Test_unix.temp_directory () in

    let filenames =
      let rec loop n acc =
        if n <= 0 then acc
        else loop (n - 1) ((string_of_int n)::acc)
      in
      loop n []
    in

    List.iter (fun filename ->
      let fd =
        Unix.(openfile
          (Filename.concat path filename) [O_WRONLY; O_CREAT] 0o644)
      in
      Unix.close fd)
      filenames;

    path, ["."; ".."] @ filenames
  in

  let equal, subset =
    let module StringSet = Set.Make (String) in
    (fun filenames filenames' ->
      StringSet.equal
       (StringSet.of_list filenames) (StringSet.of_list filenames')),

    (fun filenames filenames' ->
      StringSet.subset
       (StringSet.of_list filenames) (StringSet.of_list filenames'))
  in

  let read_all directory =
    let rec loop acc =
      Lwt.catch
        (fun () ->
          Lwt_unix.readdir directory >>= fun filename ->
          Lwt.return (Some filename))
        (function
          | End_of_file -> Lwt.return_none
          | exn -> Lwt.reraise exn)
      >>= function
        | None -> Lwt.return acc
        | Some filename -> loop (filename::acc)
    in
    loop []
  in

  let read_n directory n =
    let rec loop n acc =
      if n <= 0 then Lwt.return acc
      else
        Lwt_unix.readdir directory >>= fun filename ->
        loop (n - 1) (filename::acc)
    in
    loop n []
  in

  [
    test "readdir: basic"
      (fun () ->
        let path, filenames = populate 5 in

        Lwt_unix.opendir path >>= fun directory ->
        read_all directory >>= fun filenames' ->
        Lwt_unix.closedir directory >>= fun () ->

        Lwt.return (List.length filenames' = 7 && equal filenames filenames'));

    test "readdir: rewinddir"
      (fun () ->
        let path, filenames = populate 5 in

        Lwt_unix.opendir path >>= fun directory ->
        read_n directory 3 >>= fun filenames' ->
        Lwt_unix.rewinddir directory >>= fun () ->
        read_all directory >>= fun filenames'' ->
        Lwt_unix.closedir directory >>= fun () ->

        Lwt.return
          (List.length filenames' = 3 &&
           subset filenames' filenames &&
           List.length filenames'' = 7 &&
           equal filenames'' filenames));

    test "readdir: readdir_n"
      (fun () ->
        let path, filenames = populate 5 in

        Lwt_unix.opendir path >>= fun directory ->
        Lwt_unix.readdir_n directory 3 >>= fun filenames' ->
        Lwt_unix.readdir_n directory 10 >>= fun filenames'' ->
        Lwt_unix.closedir directory >>= fun () ->

        let all = (Array.to_list filenames') @ (Array.to_list filenames'') in

        Lwt.return
          (Array.length filenames' = 3 &&
           Array.length filenames'' = 4 &&
           equal all filenames));

    test "readdir: files_of_directory"
      (fun () ->
        let path, filenames = populate 5 in

        let stream = Lwt_unix.files_of_directory path in
        Lwt_stream.to_list stream >>= fun filenames' ->

        Lwt.return (equal filenames' filenames));

    (* Should make sure Win32 behaves in the same way as well. *)
    test "readdir: already closed" ~only_if:(fun () -> not Sys.win32)
      (fun () ->
        let path, _ = populate 0 in

        Lwt_unix.opendir path >>= fun directory ->
        Lwt_unix.closedir directory >>= fun () ->

        let expect_ebadf tag t =
          let tag = "Lwt_unix." ^ tag in
          Lwt.catch
            (fun () ->
              t () >>= fun () ->
              Lwt.return_false)
            (function
              | Unix.Unix_error (Unix.EBADF, tag', _) when tag' = tag ->
                Lwt.return_true
              | exn -> Lwt.reraise exn)
        in

        Lwt_list.for_all_s (fun (tag, t) -> expect_ebadf tag t)
          ["readdir", (fun () -> Lwt_unix.readdir directory >|= ignore);
           "readdir_n", (fun () -> Lwt_unix.readdir_n directory 1 >|= ignore);
           "rewinddir", (fun () -> Lwt_unix.rewinddir directory);
           "closedir", (fun () -> Lwt_unix.closedir directory)]);
  ]

let io_vectors_byte_count_tests =
  let open Lwt_unix.IO_vectors in
  [ test "io_vector_byte_count: basic"
      (fun () ->
         let iov = create () in
         append_bytes iov (Bytes.create 10) 0 10;
         append_bigarray iov (Lwt_bytes.create 10) 0 10;
         Lwt.return (byte_count iov = 20));

    test "io_vector_byte_count: offsets, partials"
      (fun () ->
         let iov = create () in
         append_bytes iov (Bytes.create 10) 5 1;
         append_bigarray iov (Lwt_bytes.create 10) 1 1;
         Lwt.return (byte_count iov = 2));

    test "io_vector_byte_count: drops"
      (fun () ->
         let iov = create () in
         append_bytes iov (Bytes.create 10) 5 1;
         append_bigarray iov (Lwt_bytes.create 10) 1 1;
         drop iov 1;
         Lwt.return (byte_count iov = 1));
  ]

let readv_tests =
  (* All buffers are initially filled with '_'. *)
  let make_io_vectors vecs =
    let open Lwt_unix.IO_vectors in
    let io_vectors = create () in
    let underlying =
      List.map (function
        | `Bytes (prefix, slice_length, suffix) ->
          let buffer = Bytes.make (prefix + slice_length + suffix) '_' in
          append_bytes io_vectors buffer prefix slice_length;
          `Bytes buffer
        | `Bigarray (prefix, slice_length, suffix) ->
          let total_length = prefix + slice_length + suffix in
          let buffer = Lwt_bytes.create total_length in
          Lwt_bytes.fill buffer 0 total_length '_';
          append_bigarray io_vectors buffer prefix slice_length;
          `Bigarray buffer)
        vecs
    in
    io_vectors, underlying
  in

  let writer write_fd data = fun () ->
    let data = Bytes.unsafe_of_string data in
    Lwt_unix.write write_fd data 0 (Bytes.length data) >>= fun bytes_written ->
    Lwt_unix.close write_fd >>= fun () ->
    (* Instrumentation for debugging an unreliable test. *)
    if bytes_written <> Bytes.length data then
      Printf.eprintf "\nwritev: expected to write %i bytes; wrote %i\n"
        (Bytes.length data) bytes_written;
    Lwt.return (bytes_written = Bytes.length data)
  in

  let reader
      ?(close = true)
      read_fd
      io_vectors
      underlying
      expected_count
      expected_data =
      fun () ->
    Gc.full_major ();
    let t = Lwt_unix.readv read_fd io_vectors in
    Gc.full_major ();
    t >>= fun bytes_read ->
    (if close then
      Lwt_unix.close read_fd
    else
      Lwt.return_unit) >>= fun () ->

    let actual =
      List.fold_left (fun acc -> function
        | `Bytes buffer -> acc ^ (Bytes.unsafe_to_string buffer)
        | `Bigarray buffer -> acc ^ (Lwt_bytes.to_string buffer))
        "" underlying
    in

    (* Instrumentation for an unreliable test. *)
    if bytes_read <> expected_count then
      Printf.eprintf "\nreadv: expected to read %i bytes; read %i\n"
        expected_count bytes_read;
    if actual <> expected_data then
      Printf.eprintf "\nreadv: expected to read %s; read %s\n"
        expected_data actual;

    Lwt.return (actual = expected_data && bytes_read = expected_count)
  in

  [
    test "readv: basic non-blocking" ~only_if:(fun () -> not Sys.win32)
      (fun () ->
        let io_vectors, underlying =
          make_io_vectors
            [`Bytes (1, 3, 1);
             `Bigarray (1, 4, 1)]
        in

        let read_fd, write_fd = Lwt_unix.pipe ~cloexec:true () in

        Lwt_list.for_all_s (fun t -> t ())
          [writer write_fd "foobar";
           reader read_fd io_vectors underlying 6 "_foo__bar__"]);

    test "readv: basic blocking" ~only_if:(fun () -> not Sys.win32)
      (fun () ->
        let io_vectors, underlying =
          make_io_vectors
            [`Bytes (1, 3, 1);
             `Bigarray (1, 4, 1)]
        in

        let read_fd, write_fd = Lwt_unix.pipe ~cloexec:true () in
        Lwt_unix.set_blocking read_fd true;

        Lwt_list.for_all_s (fun t -> t ())
          [writer write_fd "foobar";
           reader read_fd io_vectors underlying 6 "_foo__bar__"]);

    test "readv: buffer retention" ~sequential:true
        ~only_if:(fun () -> not Sys.win32) begin fun () ->
      let io_vectors, _ =
        make_io_vectors [
          `Bigarray (3, 0, 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 io_vectors in
      Lwt_unix.readv read_fd io_vectors >>= fun _ ->

      Lwt_unix.close write_fd >>= fun () ->
      Lwt_unix.close read_fd >|= fun () ->

      !retained
    end;

    test "readv: drop" ~only_if:(fun () -> not Sys.win32)
      (fun () ->
        let io_vectors, underlying =
          make_io_vectors
            [`Bytes (0, 1, 0);
             `Bytes (1, 4, 1)]
        in
        Lwt_unix.IO_vectors.drop io_vectors 2;

        let read_fd, write_fd = Lwt_unix.pipe ~cloexec:true () in

        Lwt_list.for_all_s (fun t -> t ())
          [writer write_fd "foobar";
           reader read_fd io_vectors underlying 3 "___foo_"]);

    test "readv: iovecs exceeding limit"
      ~only_if:(fun () -> not Sys.win32 &&
                          Lwt_unix.IO_vectors.system_limit <> None)
      (fun () ->
        let limit =
          match Lwt_unix.IO_vectors.system_limit with
          | Some limit -> limit
          | None -> assert false
        in

        let underlying =
          Array.init (limit + 1) (fun _ -> `Bytes (Bytes.make 1 '_'))
          |> Array.to_list
        in

        let io_vectors = Lwt_unix.IO_vectors.create () in
        List.iter (fun (`Bytes buffer) ->
          Lwt_unix.IO_vectors.append_bytes io_vectors buffer 0 1) underlying;

        let expected = String.make limit 'a' in

        let read_fd, write_fd = Lwt_unix.pipe ~cloexec:true () in

        Lwt_list.for_all_s (fun t -> t ())
          [writer write_fd (expected ^ "a");
           reader read_fd io_vectors underlying limit (expected ^ "_")]);

    test "readv: windows" ~only_if:(fun () -> Sys.win32) begin fun () ->
      let read_fd, write_fd = Lwt_unix.pipe ~cloexec:true () in

      let io_vectors, underlying =
        make_io_vectors [
          `Bytes (1, 3, 1);
          `Bigarray (1, 4, 1)
        ]
      in

      Lwt_list.for_all_s (fun t -> t ()) [
        writer write_fd "foobar";
        reader ~close:false read_fd io_vectors underlying 3 "_foo_______";
        (fun () -> Lwt_unix.IO_vectors.drop io_vectors 3; Lwt.return_true);
        reader read_fd io_vectors underlying 3 "_foo__bar__";
      ]
    end;
  ]

let writev_tests =
  let make_io_vectors vecs =
    let open Lwt_unix.IO_vectors in
    let io_vectors = create () in
    List.iter (function
      | `Bytes (s, offset, length) ->
        append_bytes io_vectors (Bytes.unsafe_of_string s) offset length
      | `Bigarray (s, offset, length) ->
        append_bigarray io_vectors (Lwt_bytes.of_string s) offset length)
      vecs;
    io_vectors
  in

  let writer ?(close = true) ?blocking write_fd io_vectors data_length =
      fun () ->
    Lwt_unix.blocking write_fd >>= fun is_blocking ->
    Gc.full_major ();
    let t = Lwt_unix.writev write_fd io_vectors in
    Gc.full_major ();
    t >>= fun bytes_written ->
    (if close then
      Lwt_unix.close write_fd
    else
      Lwt.return_unit) >>= fun () ->
    let blocking_matches =
      match blocking, is_blocking with
      | Some v, v' when v <> v' ->
        Printf.eprintf "\nblocking: v = %b, v' = %b\n" v v';
        false
      | _ -> true
    in
    if bytes_written <> data_length then
      Printf.eprintf "\nwritev: expected to write %i bytes; wrote %i\n"
        data_length bytes_written;
    Lwt.return (bytes_written = data_length && blocking_matches)
  in

  let reader read_fd ?(not_readable = false) expected_data = fun () ->
    if not_readable then
      let readable = Lwt_unix.readable read_fd in
      Lwt_unix.close read_fd >>= fun () ->
      if readable then
        Printf.eprintf "\nreadable: %b\n" readable;
      Lwt.return (not readable)
    else
      let open! Lwt_io in
      let channel = of_fd ~mode:input read_fd in
      read channel >>= fun read_data ->
      close channel >>= fun () ->
      if read_data <> expected_data then
        Printf.eprintf "\nreadv: expected to read %s; read %s (length %i)\n"
          expected_data read_data (String.length read_data);
      Lwt.return (read_data = expected_data)
  in

  [
    test "writev: basic non-blocking" ~only_if:(fun () -> not Sys.win32)
      (fun () ->
        let io_vectors =
          make_io_vectors
            [`Bytes ("foo", 0, 3);
             `Bytes ("bar", 0, 3);
             `Bigarray ("baz", 0, 3)]
        in

        let read_fd, write_fd = Lwt_unix.pipe ~cloexec:true () in

        Lwt_list.for_all_s (fun t -> t ())
          [writer ~blocking:false write_fd io_vectors 9;
           reader read_fd "foobarbaz"]);

    test "writev: basic blocking" ~only_if:(fun () -> not Sys.win32)
      (fun () ->
        let io_vectors =
          make_io_vectors
            [`Bytes ("foo", 0, 3);
             `Bytes ("bar", 0, 3);
             `Bigarray ("baz", 0, 3)]
        in

        let read_fd, write_fd = Lwt_unix.pipe ~cloexec:true () in
        Lwt_unix.set_blocking write_fd true;

        Lwt_list.for_all_s (fun t -> t ())
          [writer ~blocking:true write_fd io_vectors 9;
           reader read_fd "foobarbaz"]);

    test "writev: buffer retention" ~sequential:true
        ~only_if:(fun () -> not Sys.win32) begin fun () ->
      let io_vectors =
        make_io_vectors [
          `Bigarray ("foo", 0, 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 io_vectors in
      Lwt_unix.writev write_fd io_vectors >>= fun _ ->

      Lwt_unix.close write_fd >>= fun () ->
      Lwt_unix.close read_fd >|= fun () ->

      !retained
    end;

    test "writev: slices" ~only_if:(fun () -> not Sys.win32)
      (fun () ->
        let io_vectors =
          make_io_vectors [`Bytes ("foo", 1, 2); `Bigarray ("bar", 1, 2)] in

        let read_fd, write_fd = Lwt_unix.pipe ~cloexec:true () in

        Lwt_list.for_all_s (fun t -> t ())
          [writer write_fd io_vectors 4;
           reader read_fd "ooar"]);

    test "writev: drop, is_empty" ~only_if:(fun () -> not Sys.win32)
      (fun () ->
        let io_vectors =
          make_io_vectors
            [`Bytes ("foo", 0, 3);
             `Bytes ("bar", 0, 3);
             `Bigarray ("baz", 0, 3)]
        in

        let read_fd, write_fd = Lwt_unix.pipe ~cloexec:true () in

        let initially_empty = Lwt_unix.IO_vectors.is_empty io_vectors in

        Lwt_unix.IO_vectors.drop io_vectors 4;
        let empty_after_partial_drop =
          Lwt_unix.IO_vectors.is_empty io_vectors in

        Lwt_list.for_all_s (fun t -> t ())
          [writer write_fd io_vectors 5;
           reader read_fd "arbaz"] >>= fun io_correct ->

        Lwt_unix.IO_vectors.drop io_vectors 5;
        let empty_after_exact_drop = Lwt_unix.IO_vectors.is_empty io_vectors in

        Lwt_unix.IO_vectors.drop io_vectors 100;
        let empty_after_excess_drop = Lwt_unix.IO_vectors.is_empty io_vectors in

        Lwt.return
          (not initially_empty &&
           not empty_after_partial_drop &&
           io_correct &&
           empty_after_exact_drop &&
           empty_after_excess_drop));

    test "writev: degenerate vectors" ~only_if:(fun () -> not Sys.win32)
      (fun () ->
        let io_vectors =
          make_io_vectors
            [`Bytes ("foo", 0, 0);
             `Bigarray ("bar", 0, 0)]
        in

        let read_fd, write_fd = Lwt_unix.pipe ~cloexec:true () in

        let initially_empty = Lwt_unix.IO_vectors.is_empty io_vectors in

        Lwt_list.for_all_s (fun t -> t ())
          [writer write_fd io_vectors 0;
           reader read_fd ""] >>= fun io_correct ->

        Lwt.return (initially_empty && io_correct));

    test "writev: bad iovec" ~only_if:(fun () -> not Sys.win32)
      (fun () ->
        let negative_offset = make_io_vectors [`Bytes ("foo", -1, 3)] in
        let negative_length = make_io_vectors [`Bytes ("foo", 0, -1)] in
        let out_of_bounds = make_io_vectors [`Bytes ("foo", 1, 3)] in

        let negative_offset' = make_io_vectors [`Bigarray ("foo", -1, 3)] in
        let negative_length' = make_io_vectors [`Bigarray ("foo", 0, -1)] in
        let out_of_bounds' = make_io_vectors [`Bigarray ("foo", 1, 3)] in

        let read_fd, write_fd = Lwt_unix.pipe ~cloexec:true () in

        let writer io_vectors =
          fun () ->
            Lwt.catch
              (fun () ->
                Lwt_unix.writev write_fd io_vectors >>= fun _ ->
                Lwt.return_false)
              (function
                | Invalid_argument _ -> Lwt.return_true
                | e -> Lwt.reraise e)
        in

        let close write_fd = fun () ->
          Lwt_unix.close write_fd >>= fun () -> Lwt.return_true in

        Lwt_list.for_all_s (fun t -> t ())
          [writer negative_offset;
           writer negative_length;
           writer out_of_bounds;
           writer negative_offset';
           writer negative_length';
           writer out_of_bounds';
           reader read_fd ~not_readable:true "";
           close write_fd]);

    test "writev: iovecs exceeding limit"
      ~only_if:(fun () -> not Sys.win32 &&
                          Lwt_unix.IO_vectors.system_limit <> None)
      (fun () ->
        let limit =
          match Lwt_unix.IO_vectors.system_limit with
          | Some limit -> limit
          | None -> assert false
        in

        let io_vectors =
          let open Lwt_unix.IO_vectors in
          let io_vectors = create () in
          let rec loop count =
            if count < 1 then io_vectors
            else
              (append_bytes io_vectors (Bytes.unsafe_of_string "a") 0 1;
              loop (count - 1))
          in
          loop (limit + 1)
        in

        let read_fd, write_fd = Lwt_unix.pipe ~cloexec:true () in

        Lwt_list.for_all_s (fun t -> t ())
          [writer write_fd io_vectors limit;
           reader read_fd (String.make limit 'a')]);

    test "writev: negative drop" ~only_if:(fun () -> not Sys.win32)
      (fun () ->
        let io_vectors = make_io_vectors [`Bytes ("foo", 0, 3)] in
        Lwt_unix.IO_vectors.drop io_vectors (-1);

        let read_fd, write_fd = Lwt_unix.pipe ~cloexec:true () in

        Lwt_list.for_all_s (fun t -> t ())
          [writer write_fd io_vectors 3;
           reader read_fd "foo"] >>= fun io_correct ->

        Lwt.return
          (io_correct &&
           not (Lwt_unix.IO_vectors.is_empty io_vectors)));

    test "writev: windows" ~only_if:(fun () -> Sys.win32) begin fun () ->
      let io_vectors =
        make_io_vectors [
          `Bytes ("foo", 0, 3);
          `Bigarray ("bar", 0, 3);
        ]
      in

      let read_fd, write_fd = Lwt_unix.pipe ~cloexec:true () in

      Lwt_list.for_all_s (fun t -> t ()) [
        writer ~close:false write_fd io_vectors 3;
        (fun () -> Lwt_unix.IO_vectors.drop io_vectors 3; Lwt.return_true);
        writer write_fd io_vectors 3;
        reader read_fd "foobar";
      ]
    end;
  ]

let send_recv_msg_tests = [
  test "send_msg, recv_msg" ~only_if:(fun () -> not Sys.win32) begin fun () ->
    let socket_1, socket_2 = Lwt_unix.(socketpair PF_UNIX SOCK_STREAM 0) in
    let pipe_read, pipe_write = Lwt_unix.pipe ~cloexec:true () in

    let source_buffer = Bytes.of_string "_foo_bar_" in
    let source_iovecs = Lwt_unix.IO_vectors.create () in
    Lwt_unix.IO_vectors.append_bytes source_iovecs source_buffer 1 3;
    Lwt_unix.IO_vectors.append_bytes source_iovecs source_buffer 5 3;

    Lwt_unix.send_msg
      ~socket:socket_1
      ~io_vectors:source_iovecs
      ~fds:[Lwt_unix.unix_file_descr pipe_write] >>= fun n ->
    if n <> 6 then
      Lwt.return_false

    else
      let destination_buffer = Bytes.of_string "_________" in
      let destination_iovecs = Lwt_unix.IO_vectors.create () in
      Lwt_unix.IO_vectors.append_bytes
        destination_iovecs destination_buffer 5 3;
      Lwt_unix.IO_vectors.append_bytes
        destination_iovecs destination_buffer 1 3;

      Lwt_unix.recv_msg
        ~socket:socket_2 ~io_vectors:destination_iovecs >>= fun (n, fds) ->
      let succeeded =
        match n, fds, Bytes.to_string destination_buffer with
        | 6, [fd], "_bar_foo_" -> Some fd
        | _ -> None
      in
      match succeeded with
      | None ->
        Lwt.return_false
      | Some fd ->

        let n = Unix.write fd (Bytes.of_string "baz") 0 3 in
        if n <> 3 then
          Lwt.return_false

        else
          let buffer = Bytes.create 3 in
          Lwt_unix.read pipe_read buffer 0 3 >>= fun n ->
          match n, Bytes.to_string buffer with
          | 3, "baz" ->
            Lwt_unix.close socket_1 >>= fun () ->
            Lwt_unix.close socket_2 >>= fun () ->
            Lwt_unix.close pipe_read >>= fun () ->
            Lwt_unix.close pipe_write >>= fun () ->
            Unix.close fd;
            Lwt.return_true

          | _ ->
            Lwt.return_false
  end;

  test "send_msg, recv_msg (Lwt_bytes, old)" ~only_if:(fun () -> not Sys.win32)
      begin fun () ->

    let socket_1, socket_2 = Lwt_unix.(socketpair PF_UNIX SOCK_STREAM 0) in
    let pipe_read, pipe_write = Lwt_unix.pipe ~cloexec:true () in

    let source_buffer = Lwt_bytes.of_string "_foo_bar_" in
    let source_iovecs = Lwt_bytes.[
      {
        iov_buffer = source_buffer;
        iov_offset = 1;
        iov_length = 3;
      };
      {
        iov_buffer = source_buffer;
        iov_offset = 5;
        iov_length = 3;
      };
    ]
    in

    (Lwt_bytes.send_msg [@ocaml.warning "-3"])
      ~socket:socket_1
      ~io_vectors:source_iovecs
      ~fds:[Lwt_unix.unix_file_descr pipe_write] >>= fun n ->
    if n <> 6 then
      Lwt.return_false

    else
      let destination_buffer = Lwt_bytes.of_string "_________" in
      let destination_iovecs = Lwt_bytes.[
        {
          iov_buffer = destination_buffer;
          iov_offset = 5;
          iov_length = 3;
        };
        {
          iov_buffer = destination_buffer;
          iov_offset = 1;
          iov_length = 3;
        };
      ]
      in

      (Lwt_bytes.recv_msg [@ocaml.warning "-3"])
        ~socket:socket_2 ~io_vectors:destination_iovecs >>= fun (n, fds) ->
      let succeeded =
        match n, fds, Lwt_bytes.to_string destination_buffer with
        | 6, [fd], "_bar_foo_" -> Some fd
        | _ -> None
      in
      match succeeded with
      | None ->
        Lwt.return_false
      | Some fd ->

        let n = Unix.write fd (Bytes.of_string "baz") 0 3 in
        if n <> 3 then
          Lwt.return_false

        else
          let buffer = Bytes.create 3 in
          Lwt_unix.read pipe_read buffer 0 3 >>= fun n ->
          match n, Bytes.to_string buffer with
          | 3, "baz" ->
            Lwt_unix.close socket_1 >>= fun () ->
            Lwt_unix.close socket_2 >>= fun () ->
            Lwt_unix.close pipe_read >>= fun () ->
            Lwt_unix.close pipe_write >>= fun () ->
            Unix.close fd;
            Lwt.return_true

          | _ ->
            Lwt.return_false
  end;
]

let bind_tests_address = Unix.(ADDR_INET (inet_addr_loopback, 56100))

let bind_tests =
  let directory_exists dir =
    try Sys.is_directory dir
    with Sys_error _ -> false
  in

  [
  test "bind: basic"
    (fun () ->
      let socket = Lwt_unix.(socket PF_INET SOCK_STREAM 0) in

      Lwt.finalize
        (fun () ->
          Lwt_unix.bind socket bind_tests_address >>= fun () ->
          Lwt.return (Unix.getsockname (Lwt_unix.unix_file_descr socket)))
        (fun () ->
          Lwt_unix.close socket)

      >>= fun address' ->

      Lwt.return (address' = bind_tests_address));

  test "bind: Unix domain" ~only_if:(fun () -> not Sys.win32 &&
                                               not (directory_exists "/hurd"))
    (fun () ->
      let socket = Lwt_unix.(socket PF_UNIX SOCK_STREAM 0) in

      let rec bind_loop attempts =
        let path = Test_unix.temp_name () in
        let address = Unix.(ADDR_UNIX path) in
        Lwt.catch
          (fun () ->
            Lwt_unix.bind socket address >>= fun () ->
            Lwt.return path)
          (function
            | Unix.Unix_error (Unix.EADDRINUSE, "bind", _)
            | Unix.Unix_error (Unix.EISDIR, "bind", _) as exn ->
              if attempts <= 1 then
                Lwt.reraise exn
              else
                bind_loop (attempts - 1)
            | Unix.Unix_error (Unix.EPERM, "bind", _) ->
              (* On EPERM, assume that we are under WSL, but in the Windows
                 filesystem. If this ever results in a false positive, this
                 test should add a check for WSL by checking for the existence
                 of /proc/version, reading it, and checking its contents for the
                 string "WSL". *)
              raise Skip
            | e -> Lwt.reraise e)
      in

      Lwt.finalize
        (fun () ->
          bind_loop 5 >>= fun chosen_path ->
          let actual_path =
            Unix.getsockname (Lwt_unix.unix_file_descr socket) in
          Lwt.return (chosen_path, actual_path))
        (fun () ->
          Lwt_unix.close socket)
      >>= fun (chosen_path, actual_path) ->

      let actual_path =
        match actual_path with
        | Unix.ADDR_UNIX path -> path
        | Unix.ADDR_INET _ -> assert false
      in

      (try Unix.unlink chosen_path
      with _ -> ());
      (try Unix.unlink actual_path
      with _ -> ());

      (* Compare with a prefix of the actual path, due to
         https://github.com/ocaml/ocaml/pull/987 *)
      try
        Lwt.return
          (chosen_path = String.sub actual_path 0 (String.length chosen_path))
      with Invalid_argument _ -> Lwt.return_false);

  test "bind: closed"
    (fun () ->
      let socket = Lwt_unix.(socket PF_INET SOCK_STREAM 0) in
      Lwt_unix.close socket >>= fun () ->
      Lwt.catch
        (fun () ->
          Lwt_unix.bind socket bind_tests_address >>= fun () ->
          Lwt.return_false)
        (function
          | Unix.Unix_error (Unix.EBADF, _, _) -> Lwt.return_true
          | e -> Lwt.reraise e));

  test "bind: aborted"
    (fun () ->
      let socket = Lwt_unix.(socket PF_INET SOCK_STREAM 0) in
      Lwt_unix.abort socket Exit;
      Lwt.finalize
        (fun () ->
          Lwt.catch
            (fun () ->
              Lwt_unix.bind socket bind_tests_address >>= fun () ->
              Lwt.return_false)
            (function
              | Exit -> Lwt.return_true
              | e -> Lwt.reraise e))
        (fun () -> Lwt_unix.close socket));
]

let dir_tests = [
    test "getcwd"
    (fun () ->
      Lwt_unix.getcwd () >>= fun (_:string) ->
      Lwt.return_true
    );
    test "getcwd and chdir"
    (fun () ->
      Lwt_unix.getcwd () >>= fun here ->
      Lwt_unix.chdir here >>= fun () ->
      Lwt_unix.getcwd () >>= fun there ->
      Lwt.return (here = there)
    );
    test "getcwd and Unix.getcwd"
    (fun () ->
      let unix_here = Unix.getcwd () in
      Lwt_unix.getcwd () >>= fun here ->
      Lwt.return (here = unix_here)
    );
]

let lwt_preemptive_tests = [
  test "run_in_main" begin fun () ->
    let f () =
      Lwt_preemptive.run_in_main (fun () ->
        Lwt_unix.sleep 0.01 >>= fun () ->
        Lwt.return 42)
    in
    Lwt_preemptive.detach f () >>= fun x ->
    Lwt.return (x = 42)
  end;
  test "run_in_main_dont_wait" begin fun () ->
    let p, r = Lwt.wait () in
    let f () =
      Lwt_preemptive.run_in_main_dont_wait
        (fun () ->
          Lwt.pause () >>= fun () ->
          Lwt.pause () >>= fun () ->
          Lwt.wakeup r 42;
          Lwt.return ())
        (fun _ -> assert false)
    in
    Lwt_preemptive.detach f () >>= fun () ->
    p >>= fun x ->
    Lwt.return (x = 42)
  end;
  test "run_in_main_dont_wait_fail" begin fun () ->
    let p, r = Lwt.wait () in
    let f () =
      Lwt_preemptive.run_in_main_dont_wait
        (fun () ->
          Lwt.pause () >>= fun () ->
          Lwt.pause () >>= fun () ->
          raise Exit)
        (function Exit -> Lwt.wakeup r 45 | _ -> assert false)
    in
    Lwt_preemptive.detach f () >>= fun () ->
    p >>= fun x ->
    Lwt.return (x = 45)
  end;
  test "run_in_main_with_dont_wait" begin fun () ->
    let p, r = Lwt.wait () in
    let f () =
      Lwt_preemptive.run_in_main (fun () ->
        Lwt.dont_wait
          (fun () ->
            Lwt.pause () >>= fun () ->
            Lwt.pause () >>= fun () ->
            Lwt.wakeup r 42;
            Lwt.return ())
          (function _ -> Stdlib.exit 2);
        Lwt.return ())
    in
    Lwt_preemptive.detach f () >>= fun () ->
    p >>= fun x ->
    Lwt.return (x = 42)
  end;
]

let getlogin_works =
  if Sys.win32 then
    false
  else
    match Unix.getlogin () with
    | _ -> true
    | exception Unix.Unix_error _ -> false

let lwt_user_tests = [
  test "getlogin and Unix.getlogin" ~only_if:(fun () -> getlogin_works) begin fun () ->
    let unix_user = Unix.getlogin () in
    Lwt_unix.getlogin () >>= fun user ->
    Lwt.return (user = unix_user)
  end;
  test "getpwnam and Unix.getpwnam" ~only_if:(fun () -> getlogin_works) begin fun () ->
    let unix_user = Unix.getlogin () in
    let unix_password = Unix.getpwnam unix_user in
    Lwt_unix.getpwnam unix_user >>= fun password ->
    Lwt.return (password = unix_password)
  end;
  test "getpwuid and Unix.getpwuid" ~only_if:(fun () -> getlogin_works) begin fun () ->
    let pwnam = Unix.getpwnam (Unix.getlogin ()) in
    let unix_pwuid = Unix.getpwuid pwnam.pw_uid in
    Lwt_unix.getpwuid pwnam.pw_uid >>= fun pwuid ->
    Lwt.return (pwuid = unix_pwuid)
  end;
  test "getgrgid and Unix.getgrgid" ~only_if:(fun () -> not Sys.win32) begin fun () ->
    let group_id = Unix.getgid () in
    let unix_group = Unix.getgrgid group_id in
    Lwt_unix.getgrgid group_id >>= fun group ->
    Lwt.return (group = unix_group)
  end;
  test "getgrnam and Unix.getgrnam" ~only_if:(fun () -> not Sys.win32) begin fun () ->
    let group_id = Unix.getgid () in
    let unix_group = Unix.getgrgid group_id in
    let group_name = unix_group.gr_name in
    Lwt_unix.getgrnam group_name >>= fun group ->
    Lwt.return (group = unix_group)
  end
]

let file_suffix =
  let last_file_suffix = ref 0 in
  fun () ->
    incr last_file_suffix;
    !last_file_suffix

let test_filename name =
  Printf.sprintf "%s_%i" name (file_suffix ())

let pread_tests ~blocking =
  let test_file = test_filename "test_pread_pwrite" in
  let file_contents = "01234567890123456789" in
  let blocking_string =
    if blocking then
      " blocking"
    else
      " nonblocking"
  in
  [
  test ~sequential:true ("basic pread" ^ blocking_string)
    (fun () ->
       Lwt_unix.openfile test_file [O_RDWR; O_TRUNC; O_CREAT] 0o666
       >>= fun fd ->
       if not blocking then Lwt_unix.set_blocking ~set_flags:false fd false;
       Lwt_unix.write_string fd file_contents 0 (String.length file_contents)
       >>= fun n ->
       assert(n = String.length file_contents);
       (* This should always be true in practice, show it if this is the reason
          for failing *)
       let buf = Bytes.make 3 '\x00' in
       Lwt_unix.pread fd buf ~file_offset:3 0 3 >>= fun n ->
       assert(n = 3);
       let read1 = Bytes.to_string buf in
       Lwt_unix.pread fd buf ~file_offset:15 0 3 >>= fun n ->
       assert(n = 3);
       let read2 = Bytes.to_string buf in
       Lwt_unix.close fd >>= fun () ->
       Lwt.return (read1 = "345" && read2 = "567"));

  test ~sequential:true ("basic pwrite" ^ blocking_string)
    (fun () ->
       Lwt_unix.openfile test_file [O_RDWR] 0o666 >>= fun fd ->
       if not blocking then Lwt_unix.set_blocking ~set_flags:false fd false;
       let t1 = Lwt_unix.pwrite_string fd "abcd" ~file_offset:5 0 4 in
       let t2 = Lwt_unix.pwrite_string fd "efg" ~file_offset:15 0 3 in
       t2 >>= fun l2 ->
       t1 >>= fun l1 ->
       assert(l1 = 4);
       assert(l2 = 3);
       Lwt_unix.lseek fd 0 Lwt_unix.SEEK_SET >>= fun _pos ->
       let buf = Bytes.make (String.length file_contents) '\x00' in
       Lwt_unix.read fd buf 0 (String.length file_contents) >>= fun n ->
       assert(n = (String.length file_contents));
       Lwt_unix.close fd >>= fun () ->
       let read = Bytes.to_string buf in
       Lwt.return (read = "01234abcd901234efg89"));

  test ~sequential:true ("remove file" ^ blocking_string)
    (fun () ->
      Unix.unlink test_file;
      Lwt.return_true);
]

let dup_tests ~blocking =
  let test_file = test_filename "test_dup" in
  let file_contents = "01234567890123456789" in
  let len = String.length file_contents in
  let buf = Bytes.make len '\x00' in
  let blocking_string =
    if blocking then
      " blocking"
    else
      " nonblocking"
  in
  [
  test ~sequential:true ("dup on socket" ^ blocking_string)
    (fun () ->
      let s1, s2 =
        if Sys.win32 then Lwt_unix.socketpair Unix.PF_INET6 Unix.SOCK_STREAM 0
        else Lwt_unix.socketpair Unix.PF_UNIX Unix.SOCK_STREAM 0
      in
      if not blocking then Lwt_unix.set_blocking ~set_flags:false s1 false;
      let s1' = Lwt_unix.dup s1 in
      Lwt_unix.blocking s1
      >>= fun s1_is_blocking ->
      Lwt_unix.blocking s1'
      >>= fun s1'_is_blocking ->
      assert(s1_is_blocking = s1'_is_blocking);
      Lwt_unix.write_string s1 file_contents 0 len
      >>= fun n ->
      assert(n = len);
      Lwt_unix.read s2 buf 0 len
      >>= fun n ->
      assert(n = len);
      let read = Bytes.to_string buf in
      assert(read = file_contents);
      Lwt_unix.write_string s1' file_contents 0 len
      >>= fun n ->
      assert(n = len);
      Lwt_unix.read s2 buf 0 len
      >>= fun n ->
      assert(n = len);
      let read = Bytes.to_string buf in
      assert(read = file_contents);
      Lwt_list.iter_p Lwt_unix.close [s1; s1'; s2] >>= fun () ->
      Lwt.return_true);

    test ~sequential:true ("dup on file" ^ blocking_string)
    (fun () ->
      Lwt_unix.openfile test_file [O_RDWR; O_TRUNC; O_CREAT] 0o666
      >>= fun fd ->
      if not blocking then Lwt_unix.set_blocking ~set_flags:false fd false;
      let fd' = Lwt_unix.dup fd in
      Lwt_unix.blocking fd
      >>= fun fd_is_blocking ->
      Lwt_unix.blocking fd'
      >>= fun fd'_is_blocking ->
      assert(fd_is_blocking = fd'_is_blocking);
      Lwt_unix.write_string fd file_contents 0 len
      >>= fun n ->
      assert(n = len);
      Lwt_unix.lseek fd 0 Lwt_unix.SEEK_SET >>= fun _pos ->
      let buf = Bytes.make (String.length file_contents) '\x00' in
      Lwt_unix.read fd buf 0 (String.length file_contents) >>= fun n ->
      assert(n = (String.length file_contents));
      let read = Bytes.to_string buf in
      assert (read = file_contents);
      Lwt_unix.write_string fd' file_contents 0 len
      >>= fun n ->
      assert(n = len);
      Lwt_unix.lseek fd' 0 Lwt_unix.SEEK_SET >>= fun _pos ->
      let buf = Bytes.make (String.length file_contents) '\x00' in
      Lwt_unix.read fd' buf 0 (String.length file_contents) >>= fun n ->
      assert(n = (String.length file_contents));
      let read = Bytes.to_string buf in
      assert (read = file_contents);
      Lwt.return_true);
]

let suite =
  suite "lwt_unix"
    (wait_tests @
     openfile_tests @
     utimes_tests @
     readdir_tests @
     io_vectors_byte_count_tests @
     readv_tests @
     writev_tests @
     send_recv_msg_tests @
     bind_tests @
     dir_tests @
     lwt_preemptive_tests @
     lwt_user_tests @
     pread_tests ~blocking:true @
     pread_tests ~blocking:false @
     dup_tests ~blocking:true @
     dup_tests ~blocking:false
    )