package ppx_assert

You can search for identifiers within the package.

in-package search v0.2.0

Assert-like extension nodes that raise useful errors on failure

Install

Dune Dependency

github.com Readme Changelog MIT License Edit opam file Versions (6)

Authors

J

Jane Street Group, LLC

Maintainers

J

Jane Street developers

Sources

ppx_assert-v0.16.0.tar.gz

sha256=57dc6e241827eb1d5112c958f2f682ddd0addf5a8e9d589f5361ec2669883fd5

doc/src/ppx_assert.runtime-lib/runtime.ml.html

Source file `runtime.ml`

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
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
open Base

type 'a test_pred
  = ?here:Lexing.position list
  -> ?message:string
  -> ('a -> bool)
  -> 'a
  -> unit

type 'a test_eq
  = ?here:Lexing.position list
  -> ?message:string
  -> ?equal:('a -> 'a -> bool)
  -> 'a
  -> 'a
  -> unit

type 'a test_result
  = ?here:Lexing.position list
  -> ?message:string
  -> ?equal:('a -> 'a -> bool)
  -> expect:'a
  -> 'a
  -> unit

exception E of string * Sexp.t [@@deriving sexp]

let exn_sexp_style ~message ~pos ~here ~tag body =
  let message =
    match message with
    | None -> tag
    | Some s -> s ^ ": " ^ tag
  in
  let sexp =
    Sexp.List (
      body
      @ [ Sexp.List [ Sexp.Atom "Loc"; Sexp.Atom pos ] ]
      @ begin match here with
        | [] -> []
        | _ -> [ Sexp.List [ Sexp.Atom "Stack"
                           ; [%sexp_of: Source_code_position.t list] here
                           ] ]
      end
    )
  in
  (* Here and in other places we return exceptions, rather than directly raising, and
     instead raise at the latest moment possible, so backtrace don't include noise from
     these functions that construct exceptions. *)
  E (message, sexp)

let [@cold] exn_test_pred ~message ~pos ~here ~sexpifier t =
  exn_sexp_style ~message ~pos ~here ~tag:"predicate failed" [
    Sexp.List [Sexp.Atom "Value"; sexpifier t]
  ]

let test_pred ~pos ~sexpifier ~here ?message predicate t =
  if not (predicate t) then
    raise (exn_test_pred ~message ~pos ~here ~sexpifier t)

let r_diff : (from_:string -> to_:string -> unit) option ref = ref   None
let set_diff_function f = r_diff := f

let [@cold] test_result_or_eq_failed ~sexpifier ~expect ~got =
  let got = sexpifier got in
  let expect = sexpifier expect in
  begin match !r_diff with
  | None -> ()
  | Some diff ->
    let from_ = Sexp.to_string_hum expect in
    let to_   = Sexp.to_string_hum got in
    diff ~from_ ~to_
  end;
  `Fail (expect, got)

let test_result_or_eq ~sexpifier ~comparator ~equal ~expect ~got =
  let pass =
    match equal with
    | None -> comparator got expect = 0
    | Some f -> f got expect
  in
  if pass
  then `Pass
  else test_result_or_eq_failed ~sexpifier ~expect ~got

let [@cold] exn_test_eq ~message ~pos ~here ~t1 ~t2 =
  exn_sexp_style ~message ~pos ~here ~tag:"comparison failed" [
    t1;
    Sexp.Atom "vs";
    t2;
  ]

let test_eq ~pos ~sexpifier ~comparator ~here ?message ?equal t1 t2 =
  match test_result_or_eq ~sexpifier ~comparator ~equal ~expect:t1 ~got:t2 with
  | `Pass -> ()
  | `Fail (t1, t2) -> raise (exn_test_eq ~message ~pos ~here ~t1 ~t2)

let [@cold] exn_test_result ~message ~pos ~here ~expect ~got =
  exn_sexp_style ~message ~pos ~here ~tag:"got unexpected result" [
    Sexp.List [Sexp.Atom "expected"; expect];
    Sexp.List [Sexp.Atom "got"; got];
  ]

let[@warning "-16"] test_result ~pos ~sexpifier ~comparator ~here ?message ?equal ~expect ~got =
  match test_result_or_eq ~sexpifier ~comparator ~equal ~expect ~got with
  | `Pass -> ()
  | `Fail (expect, got) -> raise (exn_test_result ~message ~pos ~here ~expect ~got)