File: test_ref.ml

package info (click to toggle)
janest-base 0.14.0-1
  • links: PTS, VCS
  • area: main
  • in suites: bullseye
  • size: 2,896 kB
  • sloc: ml: 37,596; ansic: 251; javascript: 114; makefile: 21
file content (63 lines) | stat: -rw-r--r-- 1,511 bytes parent folder | download | duplicates (2)
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
53
54
55
56
57
58
59
60
61
62
63
open! Import
open Ref

let%test_unit "[set_temporarily] without raise" =
  let r = ref 0 in
  [%test_result: int] ~expect:1 (set_temporarily r 1 ~f:(fun () -> !r));
  [%test_result: int] ~expect:0 !r
;;

let%test_unit "[set_temporarily] with raise" =
  let r = ref 0 in
  try Nothing.unreachable_code (set_temporarily r 1 ~f:(fun () -> failwith "")) with
  | _ -> [%test_result: int] ~expect:0 !r
;;

let%test_unit "[set_temporarily] where [f] sets the ref" =
  let r = ref 0 in
  set_temporarily r 1 ~f:(fun () -> r := 2);
  [%test_result: int] ~expect:0 !r
;;

let%expect_test "[sets_temporarily] without raise" =
  let r1 = ref 1 in
  let r2 = ref 2 in
  let test and_values =
    let i1 = !r1 in
    let i2 = !r2 in
    sets_temporarily and_values ~f:(fun () ->
      print_s [%message (r1 : int ref) (r2 : int ref)]);
    require_equal
      [%here]
      (module struct
        type t = int * int [@@deriving equal, sexp_of]
      end)
      (!r1, !r2)
      (i1, i2)
  in
  test [];
  [%expect {|
    ((r1 1)
     (r2 2)) |}];
  test [ T (r1, 13) ];
  [%expect {|
    ((r1 13)
     (r2 2)) |}];
  test [ T (r1, 13); T (r1, 17) ];
  [%expect {|
    ((r1 17)
     (r2 2)) |}];
  test [ T (r1, 13); T (r2, 17) ];
  [%expect {|
    ((r1 13)
     (r2 17)) |}]
;;

let%expect_test "[sets_temporarily] with raise" =
  let r = ref 0 in
  (try
     Nothing.unreachable_code (sets_temporarily [ T (r, 1) ] ~f:(fun () -> failwith ""))
   with
   | _ -> print_s [%message (r : int ref)]);
  [%expect {| (r 0) |}]
;;