Source file `ppx_assert.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
open Ppxlib

let expand_test_pred ~loc:_ ~path:_ typ =
  let loc = { typ.ptyp_loc with loc_ghost = true } in
  [%expr
    fun ?(here = []) ?message predicate t ->
      let pos = [%e Ppx_here_expander.lift_position_as_string ~loc] in
      let sexpifier = [%e Ppx_sexp_conv_expander.Sexp_of.core_type typ] in
      Ppx_assert_lib.Runtime.test_pred ~pos ~sexpifier ~here ?message predicate t]
;;

let expand_test_eq ~loc:_ ~path:_ typ =
  let loc = { typ.ptyp_loc with loc_ghost = true } in
  [%expr
    fun ?(here = []) ?message ?equal t1 t2 ->
      let pos = [%e Ppx_here_expander.lift_position_as_string ~loc] in
      let sexpifier = [%e Ppx_sexp_conv_expander.Sexp_of.core_type typ] in
      let comparator =
        [%e
          Merlin_helpers.hide_expression
            (Ppx_compare_expander.Compare.core_type ~with_local:false typ)]
      in
      Ppx_assert_lib.Runtime.test_eq
        ~pos
        ~sexpifier
        ~comparator
        ~here
        ?message
        ?equal
        t1
        t2]
;;

let expand_test_result ~loc:_ ~path:_ typ =
  let loc = { typ.ptyp_loc with loc_ghost = true } in
  [%expr
    fun ?(here = []) ?message ?equal ~expect got ->
      let pos = [%e Ppx_here_expander.lift_position_as_string ~loc] in
      let sexpifier = [%e Ppx_sexp_conv_expander.Sexp_of.core_type typ] in
      let comparator =
        [%e
          Merlin_helpers.hide_expression
            (Ppx_compare_expander.Compare.core_type ~with_local:false typ)]
      in
      Ppx_assert_lib.Runtime.test_result
        ~pos
        ~sexpifier
        ~comparator
        ~here
        ?message
        ?equal
        ~expect
        ~got]
;;

let extensions =
  let declare name expand =
    [ Extension.declare name Extension.Context.expression Ast_pattern.(ptyp __) expand
    ; Extension.declare
        name
        Extension.Context.core_type
        Ast_pattern.(ptyp __)
        (fun ~loc ~path:_ ty ->
          let loc = { loc with loc_ghost = true } in
          let open Ast_builder.Default in
          let ident = Located.lident ~loc ("Ppx_assert_lib.Runtime." ^ name) in
          ptyp_constr ~loc ident [ ty ])
    ]
  in
  List.concat
    [ declare "test_pred" expand_test_pred
    ; declare "test_eq" expand_test_eq
    ; declare "test_result" expand_test_result
    ]
;;

let () = Driver.register_transformation "assert" ~extensions