aboutsummaryrefslogtreecommitdiff
path: root/stdlib/test/test/lux/control/region.lux
blob: 48b2b1b7ff874f585bf48111787cc54aecd4dcbc (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
(.module:
  lux
  (lux (control [monad #+ do]
                ["/" region]
                [thread #+ Thread]
                ["ex" exception #+ exception:])
       (data ["e" error #+ Error]
             (coll [list])
             text/format)
       ["r" math/random])
  lux/test)

(exception: oops)

(do-template [<name> <success> <error>]
  [(def: (<name> result)
     (All [a] (-> (Error a) Bool))
     (case result
       (#e.Success _) <success>
       (#e.Error _)   <error>))]

  [success? true  false]
  [error?   false true]
  )

(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<Thread>
                     [clean-up-counter (thread.box +0)
                      #let [@@ @
                            count-clean-up (function (_ value)
                                             (do @
                                               [_ (thread.update inc clean-up-counter)]
                                               (wrap (#e.Success []))))]
                      outcome (/.run @
                                     (do (/.Monad<Region> @)
                                       [_ (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<Thread>
                     [clean-up-counter (thread.box +0)
                      #let [@@ @
                            count-clean-up (function (_ value)
                                             (do @
                                               [_ (thread.update inc clean-up-counter)]
                                               (wrap (#e.Success []))))]
                      outcome (/.run @
                                     (do (/.Monad<Region> @)
                                       [_ (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<Thread>
                     [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<Region> @)
                                       [_ (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<Thread>
                     [clean-up-counter (thread.box +0)
                      #let [@@ @]
                      outcome (/.run @
                                     (do (/.Monad<Region> @)
                                       [_ (/.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))))))
            ))))