aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/test/lux/control/parser/code.lux
blob: 987f0ad9d8d995392ff4fd480e903e91413aa555 (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
(.module:
  [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]]]]
  [\\
   ["." /]])

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

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

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

                    [/.any /.this! (\ ! map 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>]
                                (|> (/.run (<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]
                         (|> (/.run (/.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]
                         (|> (/.run (<>.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 (\ ! map code.bit random.bit)]
                (_.cover [/.end?]
                         (|> (/.run (do <>.monad
                                      [pre /.end?
                                       _ /.any
                                       post /.end?]
                                      (wrap (and (not pre)
                                                 post)))
                                    (list dummy))
                             (!expect (^multi (#try.Success verdict)
                                              verdict)))))
              (do {! random.monad}
                [dummy (\ ! map code.bit random.bit)]
                (_.cover [/.end!]
                         (and (|> (/.run /.end! (list))
                                  (!expect (#try.Success [])))
                              (|> (/.run /.end! (list dummy))
                                  (!expect (#try.Failure _))))))
              ))))