Source file test.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
open Core
let%test_unit _ =
let change_tests =
[
"(const 13)", "foo", Some "13"
; "(const 13)", "()", Some "13"
; "(const 13)", "(foo bar)", Some "13"
;
"(alt)", "()", None
;
"delete", "foo", None
; "(seq delete fail)", "foo", None
; "(children delete)", "()", Some "()"
; "(children delete)", "(foo bar)", Some "()"
; "(children (alt (rewrite foo bar) delete))", "(foo zzz)", Some "(bar)"
;
"(record)", "foo", None
; "(record)", "()", Some "()"
; "(record)", "(foo)", None
; "(record)", "((foo 13))", Some "((foo 13))"
; "(record (foo (const 13)))", "((foo foo))", Some "((foo 13))"
; "(record (foo (const 13)))", "((foo foo) (bar bar))", Some "((foo 13) (bar bar))"
; ( "(record (foo (const 13)) (_ id))"
, "((foo foo) (bar bar))"
, Some "((foo 13) (bar bar))" )
; "(record (_ delete))", "((foo foo) (bar bar))", Some "()"
; "(record (foo id) (_ delete))", "((foo 13))", Some "((foo 13))"
; "(record (foo id) (_ delete))", "((foo 13) (bar 14))", Some "((foo 13))"
; "(record (foo id) (_ fail))", "((foo 13))", Some "((foo 13))"
; "(record (foo id) (_ fail))", "((foo 13) (bar 14))", None
; "(record (foo id))", "()", None
; "(record (foo (present ) id))", "()", None
; "(record (foo (absent ) id))", "()", Some "((foo ()))"
; "(record (foo (optional) id))", "()", Some "((foo ()))"
; "(record (foo ((rename bar)) id))", "((foo 13))", Some "((bar 13))"
; ( "(record (foo id) (bar (const 13)) (baz (rewrite $X ($X $X))))"
, "((foo 13) (bar 14) (baz 15) (bap 16))"
, Some "((foo 13) (bar 13) (baz (15 15)) (bap 16))" )
; "(record (a1 (optional) (const foo)))", "()", Some "((a1 foo))"
; ( "(record (a1 (optional) (const foo)) (a2 id))"
, "((a2 v2) (a3 v3))"
, Some "((a2 v2) (a3 v3) (a1 foo))" )
]
in
let module Bug = struct
type t =
{ program : string
; syntax : Syntax.Change.t
; input : string
; output : Sexp.t option
; expected_output : Sexp.t option
}
[@@deriving sexp_of]
end
in
let bugs =
List.filter_map change_tests ~f:(fun (program, input, expected_output) ->
let syntax = Syntax.Change.t_of_sexp (Sexp.of_string program) in
let output = Semantics.change syntax (Sexp.of_string input) in
let expected_output = Option.map expected_output ~f:Sexp.of_string in
if [%compare.equal: Sexp.t option] output expected_output
then None
else Some { Bug.program; syntax; input; output; expected_output })
in
if not (List.is_empty bugs)
then failwiths ~here:[%here] "bugs in Semantics.change" bugs [%sexp_of: Bug.t list]
;;
let%expect_test _ =
let run query inputs =
let syntax = Syntax.Query.t_of_sexp (Sexp.of_string query) in
List.iter inputs ~f:(fun input ->
let result =
Sexp.of_string input |> Semantics.query syntax |> Lazy_list.to_list |> Sexp.List
in
print_s result)
in
let examples =
[ {|((id "(a b c)") (value 1))|}
; {|((id "results: (a b c)") (value 1))|}
; {|((id "A" ) (value 1))|}
; {|((id "(" ) (value 1))|}
; {|((id " " ) (value 1))|}
]
in
run {|(field id)|} examples;
[%expect {|
("(a b c)")
("results: (a b c)")
(A)
("(")
(" ")
|}];
run {|(pipe (field id) restructure)|} examples;
[%expect {|
((a b c))
(results: (a b c))
(A)
()
()
|}]
;;