<commit_before>(*
 * Copyright (C) 2013 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

module Producer = Block_ring.Producer(Mirage_block.Block)
module Consumer = Block_ring.Consumer(Mirage_block.Block)

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

exception Cstruct_differ

let cstruct_equal a b =
  let check_contents a b =
    try
      for i = 0 to Cstruct.len a - 1 do
        let a' = Cstruct.get_char a i in
        let b' = Cstruct.get_char b i in
        if a' <> b' then raise Cstruct_differ
      done;
      true
    with _ -> false in
      (Cstruct.len a = (Cstruct.len b)) && (check_contents a b)

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;
]

(* ring too small *)
(* ring too full *)

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 size = 16384L

(* number of pushes before we pop *)
let interesting_batch_sizes = [
  1;
  2;
  3;
  4;
  5;
]
 
let test_push_pop length batch () =
  let t =
    let name = find_unused_file () in
    Lwt_unix.openfile name [ Lwt_unix.O_CREAT; Lwt_unix.O_WRONLY ] 0o0666 >>= fun fd ->
    let size = 16384L in
    (* Write the last sector to make sure the file has the intended size *)
    Lwt_unix.LargeFile.lseek fd Int64.(sub size 512L) Lwt_unix.SEEK_CUR >>= fun _ ->
    let sector = Mirage_block.Block.Memory.alloc 512 in
    fill_with_message sector "\xde\xead\xbe\xef";
    Mirage_block.Block.really_write fd sector >>= fun () ->

    let payload = Cstruct.create length in
    let message = "All work and no play makes Dave a dull boy.\n" in
    fill_with_message payload message;

    Mirage_block.Block.connect name >>= function
    | `Error _ -> failwith (Printf.sprintf "Block.connect %s failed" name)
    | `Ok device ->
    Producer.create device (Mirage_block.Block.Memory.alloc 512) >>= function
    | `Error x -> failwith (Printf.sprintf "Producer.create %s" name)
    | `Ok producer ->
    Consumer.create device (Mirage_block.Block.Memory.alloc 512) >>= function
    | `Error x -> failwith (Printf.sprintf "Consumer.create %s" name)
    | `Ok consumer ->
    let rec loop = function
      | 0 -> return ()
      | n ->
        Consumer.pop consumer >>= function
        | `Ok _ | `Error _ -> failwith "empty pop"
        | `Retry ->
        let rec push = function
        | 0 -> return ()
        | m ->
          Producer.push producer payload >>= function
          | `Error _ | `TooBig | `Retry -> failwith "push"
          | `Ok () -> push (m - 1) in
        push batch >>= fun () ->
        let rec pop = function
        | 0 -> return ()
        | m ->
          Consumer.pop consumer >>= function
          | `Error _ | `Retry -> failwith "pop"
          | `Ok buffer ->
            assert_equal ~printer:Cstruct.to_string ~cmp:cstruct_equal payload buffer;
            pop (m - 1) in
        pop batch >>= fun () ->
        loop (n - 1) in
    (* push/pop 2 * the number of sectors to guarantee we experience some wraparound *)
    loop Int64.(to_int (mul 2L (div size 512L))) in
  Lwt_main.run t

let rec allpairs xs ys = match xs with
  | [] -> []
  | x :: xs -> List.map (fun y -> x, y) ys @ (allpairs xs ys)

let _ =
  let verbose = ref false in<commit_msg>test: check we can fill the ring with the expected number of messages<commit_after>(*
 * Copyright (C) 2013 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

module Producer = Block_ring.Producer(Mirage_block.Block)
module Consumer = Block_ring.Consumer(Mirage_block.Block)

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

exception Cstruct_differ

let cstruct_equal a b =
  let check_contents a b =
    try
      for i = 0 to Cstruct.len a - 1 do
        let a' = Cstruct.get_char a i in
        let b' = Cstruct.get_char b i in
        if a' <> b' then raise Cstruct_differ
      done;
      true
    with _ -> false in
      (Cstruct.len a = (Cstruct.len b)) && (check_contents a b)

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;
]

(* ring too small *)

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 size = 16384L

(* number of pushes before we pop *)
let interesting_batch_sizes = [
  1;
  2;
  3;
  4;
  5;
]
 
let test_push_pop length batch () =
  let t =
    let name = find_unused_file () in
    Lwt_unix.openfile name [ Lwt_unix.O_CREAT; Lwt_unix.O_WRONLY ] 0o0666 >>= fun fd ->
    let size = 16384L in
    (* Write the last sector to make sure the file has the intended size *)
    Lwt_unix.LargeFile.lseek fd Int64.(sub size 512L) Lwt_unix.SEEK_CUR >>= fun _ ->
    let sector = Mirage_block.Block.Memory.alloc 512 in
    fill_with_message sector "\xde\xead\xbe\xef";
    Mirage_block.Block.really_write fd sector >>= fun () ->

    let payload = Cstruct.create length in
    let message = "All work and no play makes Dave a dull boy.\n" in
    fill_with_message payload message;

    Mirage_block.Block.connect name >>= function
    | `Error _ -> failwith (Printf.sprintf "Block.connect %s failed" name)
    | `Ok device ->
    Producer.create device (Mirage_block.Block.Memory.alloc 512) >>= function
    | `Error x -> failwith (Printf.sprintf "Producer.create %s" name)
    | `Ok producer ->
    Consumer.create device (Mirage_block.Block.Memory.alloc 512) >>= function
    | `Error x -> failwith (Printf.sprintf "Consumer.create %s" name)
    | `Ok consumer ->
    let rec loop = function
      | 0 -> return ()
      | n ->
        Consumer.pop consumer >>= function
        | `Ok _ | `Error _ -> failwith "empty pop"
        | `Retry ->
        let rec push = function
        | 0 -> return ()
        | m ->
          Producer.push producer payload >>= function
          | `Error _ | `TooBig | `Retry -> failwith "push"
          | `Ok () -> push (m - 1) in
        push batch >>= fun () ->
        let rec pop = function
        | 0 -> return ()
        | m ->
          Consumer.pop consumer >>= function
          | `Error _ | `Retry -> failwith "pop"
          | `Ok buffer ->
            assert_equal ~printer:Cstruct.to_string ~cmp:cstruct_equal payload buffer;
            pop (m - 1) in
        pop batch >>= fun () ->
        loop (n - 1) in
    (* push/pop 2 * the number of sectors to guarantee we experience some wraparound *)
    loop Int64.(to_int (mul 2L (div size 512L))) >>= fun () ->
    (* count how many items we can push in total *)
    let rec loop acc =
      Producer.push producer payload >>= function
      | `Retry -> return acc
      | `Error _ | `TooBig -> failwith "counting the number of pushes"
      | `Ok () -> loop (acc + 1) in
    loop 0 >>= fun n ->
    let expected = Int64.(to_int (div (sub (div size 512L) 3L) (div (of_int (Cstruct.len payload + 511 + 4)) 512L))) in
    assert_equal ~printer:string_of_int expected n;
    return () in
  Lwt_main.run t

let rec allpairs xs ys = match xs with
  | [] -> []
  | x :: xs -> List.map (fun y -> x, y) ys @ (allpairs xs ys)

let _ =
  let verbose = ref false in
{'fraction_non_alphanumeric': 0.10202315265606404, 'fraction_numerical': 0.01763496700205561, 'mean_word_length': 2.5732508697332817, 'pattern_counts': {'":': 0, '<': 5, '<?xml version=': 0, '>': 114, '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': '757913', 'n_tokens_mistral': 3091, 'n_tokens_neox': 2904, 'n_words': 1084}