blob: 19d27a9b63f5a27ec459538d64d12e2e550214c5 (
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
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
|
(.require
[lux (.except i64 int primitive)
[abstract
["[0]" monad (.only do)]]
[data
["%" text/format (.only format)]]
["r" math/random (.only Random)]
["_" test (.only Test)]
[control
[io (.only IO)]
["[0]" pipe]
["[0]" try]
[concurrency
["[0]" atom]]]
[data
["[0]" product]]
["[0]" type (.use "[1]#[0]" equivalence)]
[macro
["[0]" code]]
[meta
["[0]" symbol]]]
[////
[analysis
["_[0]" primitive]]]
[\\
["[0]" / (.only)
["///[1]" ////
[analysis
["[1][0]" scope]
["[1][0]" type]]
[////
["[0]" phase]
[meta
["[0]" archive]]]]]])
(with_template [<name> <success> <failure>]
[(def (<name> procedure params output_type)
(-> Text (List Code) Type Bit)
(|> (////scope.with_scope ""
(////type.with_type output_type
(_primitive.phase archive.empty (` ((~ (code.text procedure)) (~+ params))))))
(phase.result _primitive.state)
(pipe.case
{try.#Success _}
<success>
{try.#Failure _}
<failure>)))]
[check_success+ true false]
[check_failure+ false true]
)
(def primitive
(Random [Type Code])
(r.only (|>> product.left (same? Any) not) _primitive.primitive))
(def lux
Test
(do r.monad
[[primT primC] ..primitive
[antiT antiC] (|> ..primitive
(r.only (|>> product.left (type#= primT) not)))]
(all _.and
(_.property "Can test for reference equality."
(check_success+ "lux is" (list primC primC) Bit))
(_.property "Reference equality must be done with elements of the same type."
(check_failure+ "lux is" (list primC antiC) Bit))
(_.property "Can 'try' risky IO computations."
(check_success+ "lux try"
(list (` ("lux io error" "YOLO")))
(type_literal (Either Text primT))))
)))
(def i64
Test
(do [! r.monad]
[subjectC (|> r.nat (at ! each code.nat))
signedC (|> r.int (at ! each code.int))
paramC (|> r.nat (at ! each code.nat))]
(all _.and
(_.property "i64 'and'."
(check_success+ "lux i64 and" (list paramC subjectC) Nat))
(_.property "i64 'or'."
(check_success+ "lux i64 or" (list paramC subjectC) Nat))
(_.property "i64 'xor'."
(check_success+ "lux i64 xor" (list paramC subjectC) Nat))
(_.property "i64 left-shift."
(check_success+ "lux i64 left-shift" (list paramC subjectC) Nat))
(_.property "i64 logical-right-shift."
(check_success+ "lux i64 logical-right-shift" (list paramC subjectC) Nat))
(_.property "i64 arithmetic-right-shift."
(check_success+ "lux i64 arithmetic-right-shift" (list paramC signedC) Int))
(_.property "i64 equivalence."
(check_success+ "lux i64 =" (list paramC subjectC) Bit))
(_.property "i64 addition."
(check_success+ "lux i64 +" (list paramC subjectC) Int))
(_.property "i64 subtraction."
(check_success+ "lux i64 -" (list paramC subjectC) Int))
)))
(def int
Test
(do [! r.monad]
[subjectC (|> r.int (at ! each code.int))
paramC (|> r.int (at ! each code.int))]
(all _.and
(_.property "Can multiply integers."
(check_success+ "lux i64 *" (list paramC subjectC) Int))
(_.property "Can divide integers."
(check_success+ "lux i64 /" (list paramC subjectC) Int))
(_.property "Can calculate remainder of integers."
(check_success+ "lux i64 %" (list paramC subjectC) Int))
(_.property "Can compare integers."
(check_success+ "lux i64 <" (list paramC subjectC) Bit))
(_.property "Can convert integer to text."
(check_success+ "lux i64 char" (list subjectC) Text))
(_.property "Can convert integer to fraction."
(check_success+ "lux i64 f64" (list subjectC) Frac))
)))
(def frac
Test
(do [! r.monad]
[subjectC (|> r.safe_frac (at ! each code.frac))
paramC (|> r.safe_frac (at ! each code.frac))
encodedC (|> r.safe_frac (at ! each (|>> %.frac code.text)))]
(all _.and
(_.property "Can add frac numbers."
(check_success+ "lux f64 +" (list paramC subjectC) Frac))
(_.property "Can subtract frac numbers."
(check_success+ "lux f64 -" (list paramC subjectC) Frac))
(_.property "Can multiply frac numbers."
(check_success+ "lux f64 *" (list paramC subjectC) Frac))
(_.property "Can divide frac numbers."
(check_success+ "lux f64 /" (list paramC subjectC) Frac))
(_.property "Can calculate remainder of frac numbers."
(check_success+ "lux f64 %" (list paramC subjectC) Frac))
(_.property "Can test equivalence of frac numbers."
(check_success+ "lux f64 =" (list paramC subjectC) Bit))
(_.property "Can compare frac numbers."
(check_success+ "lux f64 <" (list paramC subjectC) Bit))
(_.property "Can obtain minimum frac number."
(check_success+ "lux f64 min" (list) Frac))
(_.property "Can obtain maximum frac number."
(check_success+ "lux f64 max" (list) Frac))
(_.property "Can obtain smallest frac number."
(check_success+ "lux f64 smallest" (list) Frac))
(_.property "Can convert frac number to integer."
(check_success+ "lux f64 i64" (list subjectC) Int))
(_.property "Can convert frac number to text."
(check_success+ "lux f64 encode" (list subjectC) Text))
(_.property "Can convert text to frac number."
(check_success+ "lux f64 decode" (list encodedC) (type_literal (Maybe Frac))))
)))
(def text
Test
(do [! r.monad]
[subjectC (|> (r.unicode 5) (at ! each code.text))
paramC (|> (r.unicode 5) (at ! each code.text))
replacementC (|> (r.unicode 5) (at ! each code.text))
fromC (|> r.nat (at ! each code.nat))
toC (|> r.nat (at ! each code.nat))]
(all _.and
(_.property "Can test text equivalence."
(check_success+ "lux text =" (list paramC subjectC) Bit))
(_.property "Compare texts in lexicographical order."
(check_success+ "lux text <" (list paramC subjectC) Bit))
(_.property "Can concatenate one text to another."
(check_success+ "lux text concat" (list subjectC paramC) Text))
(_.property "Can find the index of a piece of text inside a larger one that (may) contain it."
(check_success+ "lux text index" (list fromC paramC subjectC) (type_literal (Maybe Nat))))
(_.property "Can query the size/length of a text."
(check_success+ "lux text size" (list subjectC) Nat))
(_.property "Can obtain the character code of a text at a given index."
(check_success+ "lux text char" (list fromC subjectC) Nat))
(_.property "Can clip a piece of text between 2 indices."
(check_success+ "lux text clip" (list fromC toC subjectC) Text))
)))
(def io
Test
(do [! r.monad]
[logC (|> (r.unicode 5) (at ! each code.text))
exitC (|> r.int (at ! each code.int))]
(all _.and
(_.property "Can log messages to standard output."
(check_success+ "lux io log" (list logC) Any))
(_.property "Can throw a run-time error."
(check_success+ "lux io error" (list logC) Nothing))
(_.property "Can query the current time (as milliseconds since epoch)."
(check_success+ "lux io current-time" (list) Int))
)))
(def .public test
Test
(<| (_.context (symbol.module (symbol /._)))
(all _.and
..lux
..i64
..int
..frac
..text
..io
)))
|
