blob: 9e1abb0fbc56eb0e38a92af2c27060a2878c6d1e (
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
|
(.module: {#.doc "Tools for unit & property-based/generative testing."}
[lux (#- and)
[abstract
["." monad (#+ Monad do)]]
[control
["ex" exception (#+ exception:)]
["." io]
[concurrency
["." promise (#+ Promise) ("#;." monad)]]]
[data
["." product]
[number
["n" nat]]
["." text
["%" format (#+ format)]]
[collection
["." list ("#;." functor)]]]
[time
["." instant]
["." duration]]
[math
["r" random ("#;." monad)]]])
(type: #export Counters
{#successes Nat
#failures Nat})
(def: (add-counters parameter subject)
(-> Counters Counters Counters)
{#successes (n.+ (get@ #successes parameter) (get@ #successes subject))
#failures (n.+ (get@ #failures parameter) (get@ #failures subject))})
(def: start
Counters
{#successes 0
#failures 0})
(template [<name> <category>]
[(def: <name> Counters (update@ <category> .inc start))]
[success #successes]
[failure #failures]
)
(type: #export Test
(r.Random (Promise [Counters Text])))
(def: separator text.new-line)
(def: #export (and left right)
{#.doc "Sequencing combinator."}
(-> Test Test Test)
(do r.monad
[left left
right right]
(wrap (do promise.monad
[[l-counter l-documentation] left
[r-counter r-documentation] right]
(wrap [(add-counters l-counter r-counter)
(format l-documentation ..separator r-documentation)])))))
(def: context-prefix text.tab)
(def: #export (context description)
(-> Text Test Test)
(r;map (promise;map (function (_ [counters documentation])
[counters (|> documentation
(text.split-all-with ..separator)
(list;map (|>> (format context-prefix)))
(text.join-with ..separator)
(format description ..separator))]))))
(def: failure-prefix "[Failure] ")
(def: success-prefix "[Success] ")
(def: #export fail
(-> Text Test)
(|>> (format ..failure-prefix)
[failure]
promise;wrap
r;wrap))
(def: #export (assert message condition)
{#.doc "Check that a condition is #1, and fail with the given message otherwise."}
(-> Text Bit (Promise [Counters Text]))
(<| promise;wrap
(if condition
[success (format ..success-prefix message)]
[failure (format ..failure-prefix message)])))
(def: #export (test message condition)
{#.doc "Check that a condition is #1, and fail with the given message otherwise."}
(-> Text Bit Test)
(:: r.monad wrap (assert message condition)))
(def: pcg-32-magic-inc Nat 12345)
(type: #export Seed
{#.doc "The seed value used for random testing (if that feature is used)."}
Nat)
(def: #export (seed value test)
(-> Seed Test Test)
(function (_ prng)
(let [[_ result] (r.run (r.pcg-32 [..pcg-32-magic-inc value])
test)]
[prng result])))
(def: failed?
(-> Counters Bit)
(|>> product.right (n.> 0)))
(def: (times-failure seed documentation)
(-> Seed Text Text)
(format documentation ..separator ..separator
"Failed with this seed: " (%.nat seed)))
(exception: #export (must-try-test-at-least-once) "")
(def: #export (times amount test)
(-> Nat Test Test)
(cond (n.= 0 amount)
(fail (ex.construct must-try-test-at-least-once []))
(n.= 1 amount)
test
## else
(do r.monad
[seed r.nat]
(function (_ prng)
(let [[prng' instance] (r.run (r.pcg-32 [..pcg-32-magic-inc seed]) test)]
[prng' (do promise.monad
[[counters documentation] instance]
(if (failed? counters)
(wrap [counters (times-failure seed documentation)])
(product.right (r.run prng' (times (dec amount) test)))))])))))
(def: (tally counters)
(-> Counters Text)
(let [successes (get@ #successes counters)
failures (get@ #failures counters)]
(ex.report ["Tests" (%.nat (n.+ successes failures))]
["Successes" (%.nat successes)]
["Failures" (%.nat failures)])))
(def: failure-exit-code -1)
(def: success-exit-code +0)
(def: #export (run! test)
(-> Test (Promise Nothing))
(do promise.monad
[pre (promise.future instant.now)
#let [seed (instant.to-millis pre)
prng (r.pcg-32 [..pcg-32-magic-inc seed])]
[counters documentation] (|> test (r.run prng) product.right)
post (promise.future instant.now)
#let [duration (instant.span pre post)
_ (log! (format documentation text.new-line text.new-line
"(" (%.duration duration) ")" text.new-line
(tally counters)))]]
(promise.future (io.exit (case (get@ #failures counters)
0 ..success-exit-code
_ ..failure-exit-code)))))
|
