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

(def: .public 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)]
                        (in (same? expected actual))))))
          (do random.monad
            [target random.nat
             unknown (random.only (|>> (same? 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)]
                        (in (and (not swapped_unknown?)
                                 swapped_target?
                                 (same? 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)]
                        (in (and (same? 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)]
                        (in (and (same? pre old)
                                 (same? post new)))))))
          )))