aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/test/lux/control/concurrency/atom.lux
blob: ab86747e5fd12431e8a9944f500664928ddb4994 (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
(.module:
  [lux #*
   ["_" test (#+ Test)]
   [abstract
    [monad (#+ do)]]
   [control
    ["." io]]
   [math
    ["." random]
    [number
     ["n" nat]]]]
  {1
   ["." /]})

(def: #export test
  Test
  (<| (_.covering /._)
      ($_ _.and
          (do random.monad
            [expected random.nat
             #let [box (/.atom expected)]]
            (_.cover [/.Atom /.atom /.read]
                     (io.run
                      (do io.monad
                        [actual (/.read box)]
                        (wrap (is? expected actual))))))
          (do random.monad
            [target random.nat
             unknown (random.filter (|>> (is? target) not) random.nat)
             expected random.nat
             #let [box (/.atom target)]]
            (_.cover [/.compare_and_swap]
                     (io.run
                      (do io.monad
                        [swapped_unknown? (/.compare_and_swap unknown expected box)
                         swapped_target? (/.compare_and_swap target expected box)
                         actual (/.read box)]
                        (wrap (and (not swapped_unknown?)
                                   swapped_target?
                                   (is? expected actual)))))))
          (do random.monad
            [init random.nat
             shift random.nat
             #let [box (/.atom init)]]
            (_.cover [/.update]
                     (io.run
                      (do io.monad
                        [[pre post] (/.update (n.+ shift) box)]
                        (wrap (and (is? init pre)
                                   (n.= (n.+ shift init)
                                        post)))))))
          (do random.monad
            [pre random.nat
             post random.nat
             #let [box (/.atom pre)]]
            (_.cover [/.write]
                     (io.run
                      (do io.monad
                        [old (/.write post box)
                         new (/.read box)]
                        (wrap (and (is? pre old)
                                   (is? post new)))))))
          )))