Source file test_stack.ml

open! Base
open! Stack

module Debug (Stack : S) : S with type 'a t = 'a Stack.t = struct
  open Stack

  type nonrec 'a t = 'a t

  let invariant = invariant
  let t_sexp_grammar = t_sexp_grammar

  let check_and_return t =
    invariant ignore t;
    t
  ;;

  let debug t f =
    let result = Result.try_with f in
    invariant ignore t;
    Result.ok_exn result
  ;;

  (* The return-type annotations are to prevent an error where we don't supply all the
     arguments to the function, and thus wouldn't be checking the invariant after fully
     applying the function. *)
  let clear t : unit = debug t (fun () -> clear t)
  let copy t : _ t = check_and_return (debug t (fun () -> copy t))
  let count t ~f : int = debug t (fun () -> count t ~f) [@nontail]
  let sum m t ~f = debug t (fun () -> sum m t ~f) [@nontail]
  let create () : _ t = check_and_return (create ())
  let exists t ~f : bool = debug t (fun () -> exists t ~f) [@nontail]
  let find t ~f : _ option = debug t (fun () -> find t ~f) [@nontail]
  let find_map t ~f : _ option = debug t (fun () -> find_map t ~f) [@nontail]
  let fold (type a) t ~init ~f : a = debug t (fun () -> fold t ~init ~f) [@nontail]
  let for_all t ~f : bool = debug t (fun () -> for_all t ~f) [@nontail]
  let is_empty t : bool = debug t (fun () -> is_empty t)
  let iter t ~f : unit = debug t (fun () -> iter t ~f) [@nontail]
  let iter_until t ~f ~finish = debug t (fun () -> iter_until t ~f ~finish) [@nontail]
  let length t : int = debug t (fun () -> length t)
  let mem t a ~equal : bool = debug t (fun () -> mem t a ~equal) [@nontail]
  let of_list l : _ t = check_and_return (of_list l)
  let pop t : _ option = debug t (fun () -> pop t)
  let pop_exn (type a) t : a = debug t (fun () -> pop_exn t)
  let push t a : unit = debug t (fun () -> push t a)
  let sexp_of_t sexp_of_a t : Sexp.t = debug t (fun () -> [%sexp_of: a t] t)
  let singleton x : _ t = check_and_return (singleton x)
  let t_of_sexp a_of_sexp sexp : _ t = check_and_return ([%of_sexp: a t] sexp)
  let to_array t : _ array = debug t (fun () -> to_array t)
  let to_list t : _ list = debug t (fun () -> to_list t)
  let top t : _ option = debug t (fun () -> top t)
  let top_exn (type a) t : a = debug t (fun () -> top_exn t)
  let until_empty t f : unit = debug t (fun () -> until_empty t f) [@nontail]
  let min_elt t ~compare : _ option = debug t (fun () -> min_elt t ~compare) [@nontail]
  let max_elt t ~compare : _ option = debug t (fun () -> max_elt t ~compare) [@nontail]
  let fold_result t ~init ~f = debug t (fun () -> fold_result t ~init ~f) [@nontail]

  let fold_until t ~init ~f ~finish =
    debug t (fun () -> fold_until t ~init ~f ~finish) [@nontail]
  ;;

  let filter_map t ~f = debug t (fun () -> filter_map t ~f) [@nontail]
  let filter t ~f = debug t (fun () -> filter t ~f) [@nontail]
  let filter_inplace t ~f = debug t (fun () -> filter_inplace t ~f) [@nontail]
end

module Test (Stack : S) : S with type 'a t = 'a Stack.t =
(* This signature is here to remind us to add a unit test whenever we add something to the
   stack interface. *)
struct
  open Stack

  type nonrec 'a t = 'a t

  include Test_container.Test_S1 (Stack)

  let t_sexp_grammar = t_sexp_grammar
  let invariant = invariant
  let create = create
  let is_empty = is_empty
  let top_exn = top_exn
  let pop_exn = pop_exn
  let pop = pop
  let top = top
  let singleton = singleton

  let%test_unit _ =
    let empty = create () in
    invariant ignore empty;
    invariant (fun b -> assert b) (of_list [ true ]);
    assert (is_empty empty);
    let t = create () in
    push t 0;
    assert (not (is_empty t));
    assert (Exn.does_raise (fun () -> top_exn empty));
    let t = create () in
    push t 0;
    [%test_result: int] (top_exn t) ~expect:0;
    assert (Exn.does_raise (fun () -> pop_exn empty));
    let t = create () in
    push t 0;
    [%test_result: int] (pop_exn t) ~expect:0;
    assert (Option.is_none (pop empty));
    assert (Option.is_some (pop (of_list [ 0 ])));
    assert (Option.is_none (top empty));
    assert (Option.is_some (top (of_list [ 0 ])));
    assert (Option.is_some (top (singleton 0)));
    assert (Option.is_some (pop (singleton 0)));
    assert (
      let t = singleton 0 in
      ignore (pop_exn t : int);
      Option.is_none (top t))
  ;;

  let min_elt = min_elt
  let max_elt = max_elt

  let%test_unit _ =
    let empty = create () in
    [%test_result: _ option] (min_elt ~compare:Int.compare empty) ~expect:None;
    [%test_result: _ option] (max_elt ~compare:Int.compare empty) ~expect:None;
    [%test_result: int] (sum (module Int) ~f:Fn.id empty) ~expect:0
  ;;

  let push = push
  let copy = copy
  let until_empty = until_empty

  let%test_unit _ =
    let t =
      let t = create () in
      push t 0;
      push t 1;
      push t 2;
      t
    in
    [%test_result: bool] (is_empty t) ~expect:false;
    [%test_result: int] (length t) ~expect:3;
    [%test_result: int option] (top t) ~expect:(Some 2);
    [%test_result: int] (top_exn t) ~expect:2;
    [%test_result: int option] (min_elt ~compare:Int.compare t) ~expect:(Some 0);
    [%test_result: int option] (max_elt ~compare:Int.compare t) ~expect:(Some 2);
    [%test_result: int] (sum (module Int) ~f:Fn.id t) ~expect:3;
    let t' = copy t in
    [%test_result: int] (pop_exn t') ~expect:2;
    [%test_result: int] (pop_exn t') ~expect:1;
    [%test_result: int] (pop_exn t') ~expect:0;
    [%test_result: int] (length t') ~expect:0;
    [%test_result: bool] (is_empty t') ~expect:true;
    let t' = copy t in
    [%test_result: int option] (pop t') ~expect:(Some 2);
    [%test_result: int option] (pop t') ~expect:(Some 1);
    [%test_result: int option] (pop t') ~expect:(Some 0);
    [%test_result: int] (length t') ~expect:0;
    [%test_result: bool] (is_empty t') ~expect:true;
    (* test that t was not modified by pops applied to copies *)
    [%test_result: int] (length t) ~expect:3;
    [%test_result: int] (top_exn t) ~expect:2;
    [%test_result: int list] (to_list t) ~expect:[ 2; 1; 0 ];
    [%test_result: int array] (to_array t) ~expect:[| 2; 1; 0 |];
    [%test_result: int] (length t) ~expect:3;
    [%test_result: int] (top_exn t) ~expect:2;
    let t' = copy t in
    let n = ref 0 in
    until_empty t' (fun x -> n := !n + x);
    [%test_result: int] !n ~expect:3;
    [%test_result: bool] (is_empty t') ~expect:true;
    [%test_result: int] (length t') ~expect:0
  ;;

  let%test_unit _ =
    let t = create () in
    [%test_result: bool] (is_empty t) ~expect:true;
    [%test_result: int] (length t) ~expect:0;
    [%test_result: _ list] (to_list t) ~expect:[];
    [%test_result: _ option] (pop t) ~expect:None;
    push t 13;
    [%test_result: bool] (is_empty t) ~expect:false;
    [%test_result: int] (length t) ~expect:1;
    [%test_result: int option] (min_elt ~compare:Int.compare t) ~expect:(Some 13);
    [%test_result: int option] (max_elt ~compare:Int.compare t) ~expect:(Some 13);
    [%test_result: int] (sum (module Int) ~f:Fn.id t) ~expect:13;
    [%test_result: int] (pop_exn t) ~expect:13;
    [%test_result: bool] (is_empty t) ~expect:true;
    [%test_result: int] (length t) ~expect:0;
    push t 13;
    push t 14;
    [%test_result: bool] (is_empty t) ~expect:false;
    [%test_result: int] (length t) ~expect:2;
    [%test_result: int list] (to_list t) ~expect:[ 14; 13 ];
    [%test_result: int option] (min_elt ~compare:Int.compare t) ~expect:(Some 13);
    [%test_result: int option] (max_elt ~compare:Int.compare t) ~expect:(Some 14);
    [%test_result: int] (sum (module Int) ~f:Fn.id t) ~expect:27;
    [%test_result: bool] (Option.is_some (pop t)) ~expect:true;
    [%test_result: bool] (Option.is_some (pop t)) ~expect:true
  ;;

  let of_list = of_list

  let%test_unit _ =
    for n = 0 to 5 do
      let l = List.init n ~f:Fn.id in
      [%test_result: int list] (to_list (of_list l)) ~expect:l
    done
  ;;

  let clear = clear

  let%test_unit _ =
    for n = 0 to 5 do
      let t = of_list (List.init n ~f:Fn.id) in
      clear t;
      assert (is_empty t);
      push t 13;
      [%test_result: int] (length t) ~expect:1
    done
  ;;

  let%test_unit "float test" =
    let s = create () in
    push s 1.0;
    push s 2.0;
    push s 3.0
  ;;

  let filter_map = filter_map

  let%test_unit "filter_map" =
    let s = create () in
    push s 0;
    push s 1;
    push s 2;
    push s 3;
    [%test_result: int list] (to_list s) ~expect:[ 3; 2; 1; 0 ];
    let s = filter_map s ~f:(fun i -> if i % 2 <> 0 then Some (i * 2) else None) in
    [%test_result: int list] (to_list s) ~expect:[ 6; 2 ];
    let s = filter_map s ~f:(fun i -> if i < 4 then Some (i * 2) else None) in
    [%test_result: int list] (to_list s) ~expect:[ 4 ]
  ;;

  let filter = filter

  let%test_unit "filter" =
    let s = create () in
    push s 0;
    push s 1;
    push s 2;
    push s 3;
    [%test_result: int list] (to_list s) ~expect:[ 3; 2; 1; 0 ];
    let s = filter s ~f:(fun i -> i % 2 <> 0) in
    [%test_result: int list] (to_list s) ~expect:[ 3; 1 ];
    let s = filter s ~f:(fun i -> i < 2) in
    [%test_result: int list] (to_list s) ~expect:[ 1 ]
  ;;

  let filter_inplace = filter_inplace

  let%test_unit "filter_inplace" =
    let s = create () in
    push s 0;
    push s 1;
    push s 2;
    push s 3;
    [%test_result: int list] (to_list s) ~expect:[ 3; 2; 1; 0 ];
    filter_inplace s ~f:(fun i -> i % 2 <> 0);
    [%test_result: int list] (to_list s) ~expect:[ 3; 1 ];
    filter_inplace s ~f:(fun i -> i < 2);
    [%test_result: int list] (to_list s) ~expect:[ 1 ]
  ;;

  let%test_unit "filter_inplace raises after removing" =
    let s = create () in
    push s 0;
    push s 1;
    push s 2;
    push s 3;
    [%test_result: int list] (to_list s) ~expect:[ 3; 2; 1; 0 ];
    assert (
      Exn.does_raise (fun () ->
        filter_inplace s ~f:(fun i ->
          if Int.(i = 2) then raise_s [%message "exn"] else false)));
    [%test_result: int list] (to_list s) ~expect:[]
  ;;

  let%test_unit "filter_inplace raises after keeping" =
    let s = create () in
    push s 0;
    push s 1;
    push s 2;
    push s 3;
    [%test_result: int list] (to_list s) ~expect:[ 3; 2; 1; 0 ];
    assert (
      Exn.does_raise (fun () ->
        filter_inplace s ~f:(fun i ->
          if Int.(i = 2) then raise_s [%message "exn"] else true)));
    [%test_result: int list] (to_list s) ~expect:[ 1; 0 ]
  ;;
end