blob: ff6bdaeaf17c790d5b77a7cbf6ad2557ce29b4a9 (
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
|
(.module:
[lux #*
[control
["." monad (#+ do)]
["/" region]
["." thread (#+ Thread)]
["ex" exception (#+ exception:)]]
[data
["." error (#+ Error)]
[collection
["." list]]]
[math
["r" random]]]
lux/test)
(exception: oops)
(do-template [<name> <success> <error>]
[(def: (<name> result)
(All [a] (-> (Error a) Bit))
(case result
(#error.Success _)
<success>
(#error.Failure _)
<error>))]
[success? #1 #0]
[error? #0 #1]
)
(context: "Regions."
(<| (times 100)
(do @
[expected-clean-ups (|> r.nat (:: @ map (|>> (n/% 100) (n/max 1))))]
($_ seq
(test "Clean-up functions are always run when region execution is done."
(thread.run
(do thread.monad
[clean-up-counter (thread.box 0)
#let [@@ @
count-clean-up (function (_ value)
(do @
[_ (thread.update inc clean-up-counter)]
(wrap (#error.Success []))))]
outcome (/.run @
(do (/.monad @)
[_ (monad.map @ (/.acquire @@ count-clean-up)
(list.n/range 1 expected-clean-ups))]
(wrap [])))
actual-clean-ups (thread.read clean-up-counter)]
(wrap (and (success? outcome)
(n/= expected-clean-ups
actual-clean-ups))))))
(test "Can clean-up despite errors."
(thread.run
(do thread.monad
[clean-up-counter (thread.box 0)
#let [@@ @
count-clean-up (function (_ value)
(do @
[_ (thread.update inc clean-up-counter)]
(wrap (#error.Success []))))]
outcome (/.run @
(do (/.monad @)
[_ (monad.map @ (/.acquire @@ count-clean-up)
(list.n/range 1 expected-clean-ups))
_ (/.throw @@ oops [])]
(wrap [])))
actual-clean-ups (thread.read clean-up-counter)]
(wrap (and (error? outcome)
(n/= expected-clean-ups
actual-clean-ups))))))
(test "Errors can propagate from the cleaners."
(thread.run
(do thread.monad
[clean-up-counter (thread.box 0)
#let [@@ @
count-clean-up (function (_ value)
(do @
[_ (thread.update inc clean-up-counter)]
(wrap (: (Error Any) (ex.throw oops [])))))]
outcome (/.run @
(do (/.monad @)
[_ (monad.map @ (/.acquire @@ count-clean-up)
(list.n/range 1 expected-clean-ups))]
(wrap [])))
actual-clean-ups (thread.read clean-up-counter)]
(wrap (and (or (n/= 0 expected-clean-ups)
(error? outcome))
(n/= expected-clean-ups
actual-clean-ups))))))
(test "Can lift operations."
(thread.run
(do thread.monad
[clean-up-counter (thread.box 0)
#let [@@ @]
outcome (/.run @
(do (/.monad @)
[_ (/.lift @@ (thread.write expected-clean-ups clean-up-counter))]
(wrap [])))
actual-clean-ups (thread.read clean-up-counter)]
(wrap (and (success? outcome)
(n/= expected-clean-ups
actual-clean-ups))))))
))))
|