aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/test/lux/control/parser/code.lux
blob: a30535defc353cbcdb419fb38414a32d49689bd0 (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
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
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
(.module:
  [library
   [lux "*"
    ["_" test {"+" [Test]}]
    [abstract
     [monad {"+" [do]}]]
    [control
     ["." function]
     ["." try]
     ["<>" parser]]
    [data
     ["." bit]
     ["." name]
     ["." text]
     [collection
      ["." list]]]
    [macro
     ["." code]]
    [math
     ["." random {"+" [Random]}]
     [number
      ["." nat]
      ["." int]
      ["." rev]
      ["." frac]]]]]
  [\\library
   ["." /]])

(template: (!expect <pattern> <value>)
  [(case <value>
     <pattern>
     true
     
     _
     false)])

(def: random_name
  (Random Name)
  (random.and (random.unicode 1)
              (random.unicode 1)))

(def: .public test
  Test
  (<| (_.covering /._)
      (_.for [/.Parser])
      (`` ($_ _.and
              (do {! random.monad}
                [expected (\ ! each code.bit random.bit)]
                (_.cover [/.result]
                         (and (|> (/.result /.any (list expected))
                                  (!expect (#try.Success _)))
                              (|> (/.result /.any (list))
                                  (!expect (#try.Failure _))))))
              (~~ (template [<query> <check> <random> <code> <equivalence>]
                    [(do {! random.monad}
                       [expected <random>
                        dummy (|> <random> (random.only (|>> (\ <equivalence> = expected) not)))]
                       ($_ _.and
                           (_.cover [<query>]
                                    (|> (/.result <query> (list (<code> expected)))
                                        (!expect (^multi (#try.Success actual)
                                                         (\ <equivalence> = expected actual)))))
                           (_.cover [<check>]
                                    (and (|> (/.result (<check> expected) (list (<code> expected)))
                                             (!expect (#try.Success [])))
                                         (|> (/.result (<check> expected) (list (<code> dummy)))
                                             (!expect (#try.Failure _)))))
                           ))]

                    [/.any /.this! (\ ! each code.bit random.bit) function.identity code.equivalence]
                    [/.bit /.bit! random.bit code.bit bit.equivalence]
                    [/.nat /.nat! random.nat code.nat nat.equivalence]
                    [/.int /.int! random.int code.int int.equivalence]
                    [/.rev /.rev! random.rev code.rev rev.equivalence]
                    [/.frac /.frac! random.safe_frac code.frac frac.equivalence]
                    [/.text /.text! (random.unicode 1) code.text text.equivalence]
                    [/.identifier /.identifier! ..random_name code.identifier name.equivalence]
                    [/.tag /.tag! ..random_name code.tag name.equivalence]
                    [/.local_identifier /.local_identifier! (random.unicode 1) code.local_identifier text.equivalence]
                    [/.local_tag /.local_tag! (random.unicode 1) code.local_tag text.equivalence]
                    ))
              (~~ (template [<query> <code>]
                    [(do {! random.monad}
                       [expected_left random.nat
                        expected_right random.int]
                       (_.cover [<query>]
                                (|> (/.result (<query> (<>.and /.nat /.int))
                                              (list (<code> (list (code.nat expected_left)
                                                                  (code.int expected_right)))))
                                    (!expect (^multi (#try.Success [actual_left actual_right])
                                                     (and (\ nat.equivalence = expected_left actual_left)
                                                          (\ int.equivalence = expected_right actual_right)))))))]

                    [/.form code.form]
                    [/.tuple code.tuple]
                    ))
              (do {! random.monad}
                [expected_left random.nat
                 expected_right random.int]
                (_.cover [/.record]
                         (|> (/.result (/.record (<>.and /.nat /.int))
                                       (list (code.record (list [(code.nat expected_left)
                                                                 (code.int expected_right)]))))
                             (!expect (^multi (#try.Success [actual_left actual_right])
                                              (and (\ nat.equivalence = expected_left actual_left)
                                                   (\ int.equivalence = expected_right actual_right)))))))
              (do {! random.monad}
                [expected_local random.nat
                 expected_global random.int]
                (_.cover [/.local]
                         (|> (/.result (<>.and (/.local (list (code.nat expected_local)) /.nat)
                                               /.int)
                                       (list (code.int expected_global)))
                             (!expect (^multi (#try.Success [actual_local actual_global])
                                              (and (\ nat.equivalence = expected_local actual_local)
                                                   (\ int.equivalence = expected_global actual_global)))))))
              (do {! random.monad}
                [dummy (\ ! each code.bit random.bit)]
                (_.cover [/.end?]
                         (|> (/.result (do <>.monad
                                         [pre /.end?
                                          _ /.any
                                          post /.end?]
                                         (in (and (not pre)
                                                  post)))
                                       (list dummy))
                             (!expect (^multi (#try.Success verdict)
                                              verdict)))))
              (do {! random.monad}
                [dummy (\ ! each code.bit random.bit)]
                (_.cover [/.end!]
                         (and (|> (/.result /.end! (list))
                                  (!expect (#try.Success [])))
                              (|> (/.result /.end! (list dummy))
                                  (!expect (#try.Failure _))))))
              (do {! random.monad}
                [expected (\ ! each code.bit random.bit)]
                (_.cover [/.next]
                         (|> (/.result (do <>.monad
                                         [pre /.next
                                          post /.any]
                                         (in (and (same? expected pre)
                                                  (same? pre post))))
                                       (list expected))
                             (!expect (#try.Success _)))))
              (do {! random.monad}
                [expected (\ ! each code.bit random.bit)]
                (_.cover [/.not]
                         (and (|> (/.result (/.not /.nat) (list expected))
                                  (!expect (^multi (#try.Success actual)
                                                   (same? expected actual))))
                              (|> (/.result (/.not /.bit) (list expected))
                                  (!expect (#try.Failure _))))))
              ))))