summaryrefslogtreecommitdiff
path: root/testsuite/tests/lib-fun/test.ml
blob: ba534db2628a3987352cac0098ba7f0533fc62bd (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
(* TEST
*)

let test_id () =
  assert (Fun.id true = true);
  assert (Fun.id 1 = 1);
  assert (not (Fun.id nan = nan));
  ()

let test_const () =
  assert (Fun.const true false = true);
  assert (Fun.const 0 false = 0);
  assert (Fun.const 0 4 = 0);
  ()

let test_flip () =
  assert (Fun.flip ( ^ ) "of order" "out " = "out of order");
  assert (Fun.flip List.append [2] [1] = [1;2]);
  assert (Fun.flip List.cons [2] 1 = [1;2]);
  ()

let test_negate () =
  assert (Fun.negate (Bool.equal true) true = false);
  assert (Fun.negate (Bool.equal true) false = true);
  ()

let test_protect () =
  let does_raise f x =
    try f x ; false
    with _ -> true
  in
  let double_raise () =
    let f () = raise Exit in
    try
      Fun.protect ~finally:f f ()
    with
    | Exit -> ()
  in
  assert (does_raise double_raise ())

let tests () =
  test_id ();
  test_const ();
  test_flip ();
  test_negate ();
  test_protect ();
  ()

let () =
  tests ();
  print_endline "OK";
  ()