aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/test
diff options
context:
space:
mode:
Diffstat (limited to 'stdlib/source/test')
-rw-r--r--stdlib/source/test/aedifex/artifact/versioning.lux24
-rw-r--r--stdlib/source/test/lux/control/concurrency/atom.lux60
-rw-r--r--stdlib/source/test/lux/control/concurrency/semaphore.lux26
-rw-r--r--stdlib/source/test/lux/type.lux2
-rw-r--r--stdlib/source/test/lux/type/refinement.lux88
5 files changed, 162 insertions, 38 deletions
diff --git a/stdlib/source/test/aedifex/artifact/versioning.lux b/stdlib/source/test/aedifex/artifact/versioning.lux
index c0704440e..ab0e94236 100644
--- a/stdlib/source/test/aedifex/artifact/versioning.lux
+++ b/stdlib/source/test/aedifex/artifact/versioning.lux
@@ -13,14 +13,17 @@
[math
["." random (#+ Random)]]]
{#program
- ["." /]})
+ ["." /]}
+ ["$." // #_
+ ["#." snapshot
+ ["#/." version]]])
(def: #export random
(Random /.Versioning)
($_ random.and
+ $//snapshot.random
random.instant
- random.nat
- (random.list 5 (random.ascii/lower_alpha 3))
+ (random.list 5 $//snapshot/version.random)
))
(def: #export test
@@ -32,12 +35,19 @@
($equivalence.spec /.equivalence ..random))
(do random.monad
- [expected ..random
- version (random.ascii/upper_alpha 3)]
+ [expected ..random]
(_.cover [/.format /.parser]
(|> expected
- (/.format version)
- (<xml>.run (/.parser version))
+ /.format
+ list
+ (<xml>.run /.parser)
(try\map (\ /.equivalence = expected))
(try.default false))))
+ (_.cover [/.init]
+ (|> /.init
+ /.format
+ list
+ (<xml>.run /.parser)
+ (try\map (\ /.equivalence = /.init))
+ (try.default false)))
)))
diff --git a/stdlib/source/test/lux/control/concurrency/atom.lux b/stdlib/source/test/lux/control/concurrency/atom.lux
index c8496c210..ab86747e5 100644
--- a/stdlib/source/test/lux/control/concurrency/atom.lux
+++ b/stdlib/source/test/lux/control/concurrency/atom.lux
@@ -15,25 +15,49 @@
(def: #export test
Test
(<| (_.covering /._)
- (do random.monad
- [value random.nat
- swap_value random.nat
- set_value random.nat
- #let [box (/.atom value)]]
- ($_ _.and
+ ($_ _.and
+ (do random.monad
+ [expected random.nat
+ #let [box (/.atom expected)]]
(_.cover [/.Atom /.atom /.read]
- (n.= value
- (io.run (/.read box))))
+ (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]
- (and (io.run (/.compare_and_swap value swap_value box))
- (n.= swap_value
- (io.run (/.read box)))))
+ (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]
- (exec (io.run (/.update inc box))
- (n.= (inc swap_value)
- (io.run (/.read box)))))
+ (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]
- (exec (io.run (/.write set_value box))
- (n.= set_value
- (io.run (/.read box)))))
- ))))
+ (io.run
+ (do io.monad
+ [old (/.write post box)
+ new (/.read box)]
+ (wrap (and (is? pre old)
+ (is? post new)))))))
+ )))
diff --git a/stdlib/source/test/lux/control/concurrency/semaphore.lux b/stdlib/source/test/lux/control/concurrency/semaphore.lux
index 729e986c2..a8e64124c 100644
--- a/stdlib/source/test/lux/control/concurrency/semaphore.lux
+++ b/stdlib/source/test/lux/control/concurrency/semaphore.lux
@@ -154,26 +154,26 @@
_
false)))
(do {! random.monad}
- [limit (|> random.nat (\ ! map (|>> (n.% 10) (n.max 1))))
+ [limit (\ ! map (|>> (n.% 9) inc) random.nat)
#let [barrier (/.barrier (maybe.assume (/.limit limit)))
resource (atom.atom "")]]
(wrap (do {! promise.monad}
- [#let [ending (|> "_"
- (list.repeat limit)
- (text.join_with ""))
- ids (enum.range n.enum 0 (dec limit))
- waiters (list\map (function (_ id)
- (exec (io.run (atom.update (|>> (format "_")) resource))
- (waiter resource barrier id)))
- ids)]
- _ (monad.seq ! waiters)
+ [#let [suffix "_"
+ expected_ending (|> suffix
+ (list.repeat limit)
+ (text.join_with ""))
+ expected_ids (enum.range n.enum 0 (dec limit))]
+ _ (|> expected_ids
+ (list\map (function (_ id)
+ (exec (io.run (atom.update (|>> (format suffix)) resource))
+ (waiter resource barrier id))))
+ (monad.seq !))
#let [outcome (io.run (atom.read resource))]]
(_.cover' [/.barrier /.block]
- (and (text.ends_with? ending outcome)
+ (and (text.ends_with? expected_ending outcome)
(list.every? (function (_ id)
(text.contains? (%.nat id) outcome))
- ids)
- )))))
+ expected_ids))))))
)))
(def: #export test
diff --git a/stdlib/source/test/lux/type.lux b/stdlib/source/test/lux/type.lux
index b1d205e4a..0b3f3b4d8 100644
--- a/stdlib/source/test/lux/type.lux
+++ b/stdlib/source/test/lux/type.lux
@@ -22,6 +22,7 @@
["#." dynamic]
["#." implicit]
["#." quotient]
+ ["#." refinement]
["#." resource]])
(def: short
@@ -171,5 +172,6 @@
/dynamic.test
/implicit.test
/quotient.test
+ /refinement.test
/resource.test
)))
diff --git a/stdlib/source/test/lux/type/refinement.lux b/stdlib/source/test/lux/type/refinement.lux
new file mode 100644
index 000000000..260f5f51f
--- /dev/null
+++ b/stdlib/source/test/lux/type/refinement.lux
@@ -0,0 +1,88 @@
+(.module:
+ [lux #*
+ ["_" test (#+ Test)]
+ [abstract
+ [predicate (#+ Predicate)]
+ [monad (#+ do)]]
+ [data
+ ["." maybe ("#\." monad)]
+ [collection
+ ["." list ("#\." functor)]]]
+ [math
+ ["." random]
+ [number
+ ["n" nat]]]]
+ {1
+ ["." /]})
+
+(def: _refiner
+ (/.refinement (n.> 123)))
+
+(def: _type
+ (/.type _refiner))
+
+(def: #export test
+ Test
+ (<| (_.covering /._)
+ (_.for [/.Refined])
+ (do {! random.monad}
+ [raw random.nat
+ modulus (\ ! map (|>> (n.% 10) (n.+ 2)) random.nat)
+ #let [predicate (: (Predicate Nat)
+ (|>> (n.% modulus) (n.= 0)))]
+ total_raws (\ ! map (|>> (n.% 20) inc) random.nat)
+ raws (random.list total_raws random.nat)]
+ ($_ _.and
+ (_.for [/.Refiner]
+ ($_ _.and
+ (_.cover [/.refinement]
+ (case (/.refinement predicate raw)
+ (#.Some refined)
+ (predicate raw)
+
+ #.None
+ (not (predicate raw))))
+ (_.cover [/.predicate]
+ (|> (/.refinement predicate modulus)
+ (maybe\map (|>> /.predicate (is? predicate)))
+ (maybe.default false)))
+ ))
+ (_.cover [/.un_refine]
+ (|> (/.refinement predicate modulus)
+ (maybe\map (|>> /.un_refine (n.= modulus)))
+ (maybe.default false)))
+ (_.cover [/.lift]
+ (and (|> (/.refinement predicate modulus)
+ (maybe\map (/.lift (n.+ modulus)))
+ maybe\join
+ (maybe\map (|>> /.un_refine (n.= (n.+ modulus modulus))))
+ (maybe.default false))
+ (|> (/.refinement predicate modulus)
+ (maybe\map (/.lift (n.+ (inc modulus))))
+ maybe\join
+ (maybe\map (|>> /.un_refine (n.= (n.+ modulus (inc modulus)))))
+ (maybe.default false)
+ not)))
+ (_.cover [/.filter]
+ (let [expected (list.filter predicate raws)
+ actual (/.filter (/.refinement predicate) raws)]
+ (and (n.= (list.size expected)
+ (list.size actual))
+ (\ (list.equivalence n.equivalence) =
+ expected
+ (list\map /.un_refine actual)))))
+ (_.cover [/.partition]
+ (let [expected (list.filter predicate raws)
+ [actual alternative] (/.partition (/.refinement predicate) raws)]
+ (and (n.= (list.size expected)
+ (list.size actual))
+ (n.= (n.- (list.size expected) total_raws)
+ (list.size alternative))
+ (\ (list.equivalence n.equivalence) =
+ expected
+ (list\map /.un_refine actual)))))
+ (_.cover [/.type]
+ (exec (: (Maybe .._type)
+ (.._refiner raw))
+ true))
+ ))))
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-29 09:36:41 +0000