<commit_before>(*
 * Copyright (C) 2013-2015 Citrix Inc
 *
 * Permission to use, copy, modify, and/or 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.
 *)

open Lwt
open OUnit

(* Let's try to adopt the conventions of Rresult.R *)
let get_ok, get_error = Shared_block.Result.(get_ok, get_error)

module Lwt_result = struct
  let (>>=) m f = m >>= fun x -> f (get_ok x)
end

module Time = struct
  type 'a io = 'a Lwt.t
  let sleep = Lwt_unix.sleep
end

let find_unused_file () =
  (* Find a filename which doesn't exist *)
  let rec does_not_exist i =
    let name = Printf.sprintf "%s/mirage-block-test.%d.%d"
      Filename.temp_dir_name (Unix.getpid ()) i in
    if Sys.file_exists name
    then does_not_exist (i + 1)
    else name in
  does_not_exist 0

let alloc sector_size =
  let page = Io_page.(to_cstruct (get 1)) in
  let sector = Cstruct.sub page 0 sector_size in
  sector

let fill_with_message buffer message =
  for i = 0 to Cstruct.len buffer - 1 do
    Cstruct.set_char buffer i (message.[i mod (String.length message)])
  done

let fresh_file nbytes =
  let name = find_unused_file () in
  Lwt_unix.openfile name [ Lwt_unix.O_CREAT; Lwt_unix.O_WRONLY; Lwt_unix.O_TRUNC ] 0o0666 >>= fun fd ->
  (* Write the last sector to make sure the file has the intended size *)
  Lwt_unix.LargeFile.lseek fd Int64.(sub nbytes 512L) Lwt_unix.SEEK_CUR >>= fun _ ->
  let sector = alloc 512 in
  fill_with_message sector "\xde\xead\xbe\xef";
  Block.really_write fd sector >>= fun () ->
  return name

let interesting_lengths = [
  0; (* possible base case *)
  1; (* easily fits inside a sector with the 4 byte header *)
  512 - 4 - 1;
  512 - 4;
  512 - 4 + 1;
  2000; (* More than 3 sectors *)
]

(* number of pushes before we pop *)
let interesting_batch_sizes = [
  1;
  2;
  3;
  4;
  5;
]

module Op = struct
  type t = string
  let to_cstruct x =
    let c = Cstruct.create (String.length x) in
    Cstruct.blit_from_string x 0 c 0 (String.length x);
    c
  let of_cstruct x = Some (Cstruct.to_string x)
end
module Int = struct
  type t = int32
  let to_cstruct x =
    let c = Cstruct.create 4 in
    Cstruct.LE.set_uint32 c 0 x;
    c
  let of_cstruct x = Some (Cstruct.LE.get_uint32 x 0)
end

module R = Shared_block.Ring.Make(Log)(Block)(Op)
open R

let size = 16384L

let test_push_pop length batch () =
  let t : unit Lwt.t =
    fresh_file size
    >>= fun name ->

    let payload = "All work and no play makes Dave a dull boy.\n" in
    let toobig = String.create Int64.(to_int size) in
    let open Lwt_result in
    Block.connect name
    >>= fun disk ->
    Producer.create ~disk () >>= fun () ->
    Producer.attach ~client:"test" ~queue:"test_push_pop" ~disk () >>= fun producer ->
    Consumer.attach ~client:"test" ~queue:"test_push_pop" ~disk () >>= fun consumer ->
    let rec loop = function
      | 0 -> return ()
      | n ->
        let open Lwt in
        Consumer.pop ~t:consumer () >>= fun r ->
        assert_equal `Retry (get_error r);
        let rec push = function
        | 0 -> return ()<commit_msg>test: check that debug_info seems to work<commit_after>(*
 * Copyright (C) 2013-2015 Citrix Inc
 *
 * Permission to use, copy, modify, and/or 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.
 *)

open Lwt
open OUnit

(* Let's try to adopt the conventions of Rresult.R *)
let get_ok, get_error = Shared_block.Result.(get_ok, get_error)

module Lwt_result = struct
  let (>>=) m f = m >>= fun x -> f (get_ok x)
end

module Time = struct
  type 'a io = 'a Lwt.t
  let sleep = Lwt_unix.sleep
end

let find_unused_file () =
  (* Find a filename which doesn't exist *)
  let rec does_not_exist i =
    let name = Printf.sprintf "%s/mirage-block-test.%d.%d"
      Filename.temp_dir_name (Unix.getpid ()) i in
    if Sys.file_exists name
    then does_not_exist (i + 1)
    else name in
  does_not_exist 0

let alloc sector_size =
  let page = Io_page.(to_cstruct (get 1)) in
  let sector = Cstruct.sub page 0 sector_size in
  sector

let fill_with_message buffer message =
  for i = 0 to Cstruct.len buffer - 1 do
    Cstruct.set_char buffer i (message.[i mod (String.length message)])
  done

let fresh_file nbytes =
  let name = find_unused_file () in
  Lwt_unix.openfile name [ Lwt_unix.O_CREAT; Lwt_unix.O_WRONLY; Lwt_unix.O_TRUNC ] 0o0666 >>= fun fd ->
  (* Write the last sector to make sure the file has the intended size *)
  Lwt_unix.LargeFile.lseek fd Int64.(sub nbytes 512L) Lwt_unix.SEEK_CUR >>= fun _ ->
  let sector = alloc 512 in
  fill_with_message sector "\xde\xead\xbe\xef";
  Block.really_write fd sector >>= fun () ->
  return name

let interesting_lengths = [
  0; (* possible base case *)
  1; (* easily fits inside a sector with the 4 byte header *)
  512 - 4 - 1;
  512 - 4;
  512 - 4 + 1;
  2000; (* More than 3 sectors *)
]

(* number of pushes before we pop *)
let interesting_batch_sizes = [
  1;
  2;
  3;
  4;
  5;
]

module Op = struct
  type t = string
  let to_cstruct x =
    let c = Cstruct.create (String.length x) in
    Cstruct.blit_from_string x 0 c 0 (String.length x);
    c
  let of_cstruct x = Some (Cstruct.to_string x)
end
module Int = struct
  type t = int32
  let to_cstruct x =
    let c = Cstruct.create 4 in
    Cstruct.LE.set_uint32 c 0 x;
    c
  let of_cstruct x = Some (Cstruct.LE.get_uint32 x 0)
end

module R = Shared_block.Ring.Make(Log)(Block)(Op)
open R

let size = 16384L

let test_push_pop length batch () =
  let t : unit Lwt.t =
    fresh_file size
    >>= fun name ->

    let payload = "All work and no play makes Dave a dull boy.\n" in
    let toobig = String.create Int64.(to_int size) in
    let open Lwt_result in
    Block.connect name
    >>= fun disk ->
    Producer.create ~disk () >>= fun () ->
    Producer.attach ~client:"test" ~queue:"test_push_pop" ~disk () >>= fun producer ->
    Consumer.attach ~client:"test" ~queue:"test_push_pop" ~disk () >>= fun consumer ->
    (* check debug_info works *)
    let _ = Producer.debug_info producer in
    let _ = Consumer.debug_info consumer in
    let rec loop = function
      | 0 -> return ()
      | n ->
        let open Lwt in
        Consumer.pop ~t:consumer () >>= fun r ->
        assert_equal `Retry (get_error r);
        let rec push = function
        | 0 -> return ()
{'fraction_non_alphanumeric': 0.09545999201171615, 'fraction_numerical': 0.019704433497536946, 'mean_word_length': 3.0474137931034484, 'pattern_counts': {'":': 0, '<': 3, '<?xml version=': 0, '>': 73, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '2527719', 'n_tokens_mistral': 2661, 'n_tokens_neox': 2483, 'n_words': 945}