aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/test
diff options
context:
space:
mode:
Diffstat (limited to 'stdlib/source/test')
-rw-r--r--stdlib/source/test/lux/control/order.lux14
-rw-r--r--stdlib/source/test/lux/data/collection/tree/rose.lux16
-rw-r--r--stdlib/source/test/lux/data/collection/tree/rose/zipper.lux119
-rw-r--r--stdlib/source/test/lux/macro/code.lux56
-rw-r--r--stdlib/source/test/lux/macro/syntax.lux3
-rw-r--r--stdlib/source/test/lux/math/modular.lux10
-rw-r--r--stdlib/source/test/lux/time/date.lux17
-rw-r--r--stdlib/source/test/lux/time/day.lux11
-rw-r--r--stdlib/source/test/lux/time/duration.lux47
-rw-r--r--stdlib/source/test/lux/time/instant.lux51
-rw-r--r--stdlib/source/test/lux/time/month.lux11
-rw-r--r--stdlib/source/test/lux/world/binary.lux8
12 files changed, 196 insertions, 167 deletions
diff --git a/stdlib/source/test/lux/control/order.lux b/stdlib/source/test/lux/control/order.lux
index b57489b0f..f18d110c2 100644
--- a/stdlib/source/test/lux/control/order.lux
+++ b/stdlib/source/test/lux/control/order.lux
@@ -11,7 +11,7 @@
{1
["." / (#+ Order)]})
-(def: #export (spec (^open "_@.") generator)
+(def: #export (spec (^open ",@.") generator)
(All [a] (-> (Order a) (Random a) Test))
(do r.monad
[left generator
@@ -19,9 +19,9 @@
(<| (_.context (%name (name-of /.Order)))
($_ _.and
(_.test "Values are either ordered, or they are equal. All options are mutually exclusive."
- (if (_@= left right)
- (not (or (_@< left right)
- (_@> left right)))
- (if (_@< left right)
- (not (_@> left right))
- (_@> left right))))))))
+ (if (,@= left right)
+ (not (or (,@< left right)
+ (,@> left right)))
+ (if (,@< left right)
+ (not (,@> left right))
+ (,@> left right))))))))
diff --git a/stdlib/source/test/lux/data/collection/tree/rose.lux b/stdlib/source/test/lux/data/collection/tree/rose.lux
index 383e250b5..987a72f45 100644
--- a/stdlib/source/test/lux/data/collection/tree/rose.lux
+++ b/stdlib/source/test/lux/data/collection/tree/rose.lux
@@ -28,20 +28,28 @@
1
singleton
+
+ 2
+ (do r.monad
+ [value gen-value
+ single (tree 1 gen-value)]
+ (wrap (/.branch value (list single))))
_
(do r.monad
[value gen-value
- children (r.list (n/+ 2 (n/% 2 size))
- (tree (n// 2 size) gen-value))]
- (wrap (/.branch value children)))
+ #let [size (dec size)]
+ left (tree (n// 2 size) gen-value)
+ right (tree (n/+ (n/% 2 size) (n// 2 size))
+ gen-value)]
+ (wrap (/.branch value (list left right))))
)))
(def: #export test
Test
(<| (_.context (%name (name-of /.Tree)))
(do r.monad
- [size (:: @ map (|>> (n/% 100) (n/max 10)) r.nat)]
+ [size (:: @ map (|>> (n/% 100) (n/+ 1)) r.nat)]
($_ _.and
($equivalence.spec (/.equivalence nat.equivalence) (..tree size r.nat))
($fold.spec /.leaf /.equivalence /.fold)
diff --git a/stdlib/source/test/lux/data/collection/tree/rose/zipper.lux b/stdlib/source/test/lux/data/collection/tree/rose/zipper.lux
index 379b17c16..3a3bd296c 100644
--- a/stdlib/source/test/lux/data/collection/tree/rose/zipper.lux
+++ b/stdlib/source/test/lux/data/collection/tree/rose/zipper.lux
@@ -21,19 +21,13 @@
["." / (#+ Zipper)]}
)
-(def: (to-end zipper)
- (All [a] (-> (Zipper a) (Zipper a)))
- (loop [zipper zipper]
- (if (/.end? zipper)
- zipper
- (recur (/.next zipper)))))
-
(def: #export test
Test
(<| (_.context (%name (name-of /.Zipper)))
(do r.monad
- [size (:: @ map (|>> (n/% 100) (n/max 10)) r.nat)
+ [size (:: @ map (|>> (n/% 90) (n/+ 10)) r.nat)
sample (//.tree size r.nat)
+ mid-val r.nat
new-val r.nat
pre-val r.nat
post-val r.nat
@@ -44,74 +38,79 @@
(|> sample
/.zip /.unzip
(tree@= sample)))
- (_.test "Creating a zipper gives you a root node."
- (|> sample /.zip /.root?))
+ (_.test "Creating a zipper gives you a start node."
+ (|> sample /.zip /.start?))
(_.test "Can move down inside branches. Can move up from lower nodes."
(let [zipper (/.zip sample)]
(if (/.branch? zipper)
(let [child (|> zipper /.down)]
(and (not (tree@= sample (/.unzip child)))
(|> child /.up (is? zipper) not)
- (|> child /.root (is? zipper) not)))
+ (|> child /.start (is? zipper) not)))
(and (/.leaf? zipper)
(|> zipper (/.prepend-child new-val) /.branch?)))))
- (_.test "Can prepend and append children."
- (let [zipper (/.zip sample)]
- (if (/.branch? zipper)
- (let [mid-val (|> zipper /.down /.value)
- zipper (|> zipper
- (/.prepend-child pre-val)
- (/.append-child post-val))]
- (and (|> zipper /.down /.value (is? pre-val))
- (|> zipper /.down /.right /.value (is? mid-val))
- (|> zipper /.down /.right /.right /.value (is? post-val))
- (|> zipper /.down /.rightmost /.leftmost /.value (is? pre-val))
- (|> zipper /.down /.right /.left /.value (is? pre-val))
- (|> zipper /.down /.rightmost /.value (is? post-val))))
- true)))
- (_.test "Can insert children around a node (unless it's root)."
- (let [zipper (/.zip sample)]
- (if (/.branch? zipper)
- (let [mid-val (|> zipper /.down /.value)
- zipper (|> zipper
- /.down
- (/.insert-left pre-val)
- maybe.assume
- (/.insert-right post-val)
- maybe.assume
- /.up)]
- (and (|> zipper /.down /.value (is? pre-val))
- (|> zipper /.down /.right /.value (is? mid-val))
- (|> zipper /.down /.right /.right /.value (is? post-val))
- (|> zipper /.down /.rightmost /.leftmost /.value (is? pre-val))
- (|> zipper /.down /.right /.left /.value (is? pre-val))
- (|> zipper /.down /.rightmost /.value (is? post-val))))
- (and (|> zipper (/.insert-left pre-val) (case> (#.Some _) false
- #.None true))
- (|> zipper (/.insert-right post-val) (case> (#.Some _) false
- #.None true))))))
+ (do @
+ [branch-value r.nat
+ #let [zipper (|> (/.zip (rose.branch branch-value (list (rose.leaf mid-val))))
+ (/.prepend-child pre-val)
+ (/.append-child post-val))]]
+ (_.test "Can prepend and append children."
+ (and (and (|> zipper /.down /.value (is? pre-val))
+ (|> zipper /.down /.right /.left /.value (is? pre-val))
+ (|> zipper /.down /.rightmost /.leftmost /.value (is? pre-val)))
+ (|> zipper /.down /.right /.value (is? mid-val))
+ (and (|> zipper /.down /.right /.right /.value (is? post-val))
+ (|> zipper /.down /.rightmost /.value (is? post-val))))))
+ (do @
+ [branch-value r.nat
+ #let [zipper (/.zip (rose.branch branch-value (list (rose.leaf mid-val))))]]
+ (_.test "Can insert children around a node (unless it's start)."
+ (and (let [zipper (|> zipper
+ /.down
+ (/.insert-left pre-val)
+ maybe.assume
+ (/.insert-right post-val)
+ maybe.assume
+ /.up)]
+ (and (|> zipper /.down /.value (is? pre-val))
+ (|> zipper /.down /.right /.value (is? mid-val))
+ (|> zipper /.down /.right /.right /.value (is? post-val))
+ (|> zipper /.down /.rightmost /.leftmost /.value (is? pre-val))
+ (|> zipper /.down /.right /.left /.value (is? pre-val))
+ (|> zipper /.down /.rightmost /.value (is? post-val))))
+ (and (|> zipper
+ (/.insert-left pre-val)
+ (case> (#.Some _) false
+ #.None true))
+ (|> zipper
+ (/.insert-right post-val)
+ (case> (#.Some _) false
+ #.None true))))))
(_.test "Can set and update the value of a node."
(|> sample /.zip (/.set new-val) /.value (n/= new-val)))
(_.test "Zipper traversal follows the outline of the tree depth-first."
- (list@= (rose.flatten sample)
- (loop [zipper (/.zip sample)]
- (if (/.end? zipper)
- (list (/.value zipper))
- (#.Cons (/.value zipper)
- (recur (/.next zipper)))))))
+ (let [root (/.zip sample)]
+ (list@= (rose.flatten sample)
+ (loop [zipper (/.start root)]
+ (let [zipper' (/.next zipper)]
+ (#.Cons (/.value zipper)
+ (if (:: (/.equivalence nat.equivalence) = root zipper')
+ (list)
+ (recur zipper'))))))))
(_.test "Backwards zipper traversal yield reverse tree flatten."
- (list@= (list.reverse (rose.flatten sample))
- (loop [zipper (to-end (/.zip sample))]
- (if (/.root? zipper)
- (list (/.value zipper))
+ (let [root (/.zip sample)]
+ (list@= (list.reverse (rose.flatten sample))
+ (loop [zipper (/.end root)]
(#.Cons (/.value zipper)
- (recur (/.prev zipper)))))))
- (_.test "Can remove nodes (except root nodes)."
+ (if (:: (/.equivalence nat.equivalence) = root zipper)
+ (list)
+ (recur (/.prev zipper))))))))
+ (_.test "Can remove nodes (except start nodes)."
(let [zipper (/.zip sample)]
(if (/.branch? zipper)
- (and (|> zipper /.down /.root? not)
+ (and (|> zipper /.down /.start? not)
(|> zipper /.down /.remove (case> #.None false
- (#.Some node) (/.root? node))))
+ (#.Some node) (/.start? node))))
(|> zipper /.remove (case> #.None true
(#.Some _) false)))))
))))
diff --git a/stdlib/source/test/lux/macro/code.lux b/stdlib/source/test/lux/macro/code.lux
index 3dc7ec7d4..5ec12e6e2 100644
--- a/stdlib/source/test/lux/macro/code.lux
+++ b/stdlib/source/test/lux/macro/code.lux
@@ -11,23 +11,41 @@
(def: #export test
Test
- (`` ($_ _.and
- (~~ (do-template [<expr> <text>]
- [(_.test (format "Can produce Code node: " <text>)
- (and (text@= <text> (/.to-text <expr>))
- (:: /.equivalence = <expr> <expr>)))]
+ (<| (_.context (%name (name-of /._)))
+ (do r.monad
+ [bit r.bit
+ nat r.nat
+ int r.int
+ rev r.rev
+ above (:: @ map (i/% +100) r.int)
+ below (:: @ map (i/% +100) r.int)
+ #let [frac (|> below
+ (i// +100)
+ .int-to-frac
+ (f/+ (.int-to-frac above))
+ (f/* -1.0))]
+ text (r.ascii 10)
+ short (r.ascii/alpha 10)
+ module (r.ascii/alpha 10)
+ #let [name [module short]]]
+ (`` ($_ _.and
+ (~~ (do-template [<desc> <code> <text>]
+ [(let [code <code>]
+ (_.test (format "Can produce " <desc> " code node.")
+ (and (text@= <text> (/.to-text code))
+ (:: /.equivalence = code code))))]
- [(/.bit #1) "#1"]
- [(/.bit #0) "#0"]
- [(/.nat 123) "123"]
- [(/.int +123) "+123"]
- [(/.frac +123.0) "+123.0"]
- [(/.text "1234") (format text.double-quote "1234" text.double-quote)]
- [(/.local-tag "lol") "#lol"]
- [(/.tag ["yolo" "lol"]) "#yolo.lol"]
- [(/.local-identifier "lol") "lol"]
- [(/.identifier ["yolo" "lol"]) "yolo.lol"]
- [(/.form (list (/.bit #1) (/.int +123))) "(#1 +123)"]
- [(/.tuple (list (/.bit #1) (/.int +123))) "[#1 +123]"]
- [(/.record (list [(/.bit #1) (/.int +123)])) "{#1 +123}"]
- )))))
+ ["bit" (/.bit bit) (%b bit)]
+ ["nat" (/.nat nat) (%n nat)]
+ ["int" (/.int int) (%i int)]
+ ["rev" (/.rev rev) (%r rev)]
+ ["frac" (/.frac frac) (%f frac)]
+ ["text" (/.text text) (%t text)]
+ ["local-ltag" (/.local-tag short) (format "#" short)]
+ ["lag" (/.tag [module short]) (format "#" (%name name))]
+ ["local-identifier" (/.local-identifier short) short]
+ ["identifier" (/.identifier [module short]) (%name name)]
+ ["form" (/.form (list (/.bit bit) (/.int int))) (format "(" (%b bit) " " (%i int) ")")]
+ ["tuple" (/.tuple (list (/.bit bit) (/.int int))) (format "[" (%b bit) " " (%i int) "]")]
+ ["record" (/.record (list [(/.bit bit) (/.int int)])) (format "{" (%b bit) " " (%i int) "}")]
+ )))))))
diff --git a/stdlib/source/test/lux/macro/syntax.lux b/stdlib/source/test/lux/macro/syntax.lux
index afe5f208e..e9f0428a1 100644
--- a/stdlib/source/test/lux/macro/syntax.lux
+++ b/stdlib/source/test/lux/macro/syntax.lux
@@ -152,5 +152,4 @@
/.end!))
(fails? (p.run (list (code.bit #1))
/.end!))))
- )
- )))
+ ))))
diff --git a/stdlib/source/test/lux/math/modular.lux b/stdlib/source/test/lux/math/modular.lux
index 242b08503..97655ee9b 100644
--- a/stdlib/source/test/lux/math/modular.lux
+++ b/stdlib/source/test/lux/math/modular.lux
@@ -106,7 +106,7 @@
(/.m/= (/.mod normalM +1)))
#.None
- #1))
+ true))
(_.test "Can encode/decode to text."
(let [(^open "mod/.") (/.codec normalM)]
(case (|> subject mod/encode mod/decode)
@@ -114,7 +114,7 @@
(/.m/= subject output)
(#error.Failure error)
- #0)))
+ false)))
(_.test "Can equalize 2 moduli if they are equal."
(case (/.equalize (/.mod normalM _subject)
(/.mod copyM _param))
@@ -122,15 +122,15 @@
(/.m/= param paramC)
(#error.Failure error)
- #0))
+ false))
(_.test "Cannot equalize 2 moduli if they are the different."
(case (/.equalize (/.mod normalM _subject)
(/.mod alternativeM _param))
(#error.Success paramA)
- #0
+ false
(#error.Failure error)
- #1))
+ true))
(_.test "All numbers are congruent to themselves."
(/.congruent? normalM _subject _subject))
(_.test "If 2 numbers are congruent under a modulus, then they must also be equal under the same modulus."
diff --git a/stdlib/source/test/lux/time/date.lux b/stdlib/source/test/lux/time/date.lux
index 935e59c51..ffd055e35 100644
--- a/stdlib/source/test/lux/time/date.lux
+++ b/stdlib/source/test/lux/time/date.lux
@@ -1,15 +1,14 @@
(.module:
[lux #*
data/text/format
+ ["r" math/random (#+ Random)]
["_" test (#+ Test)]
- [control
+ [control ["." monad (#+ do)]
{[0 #test]
[/
["$." equivalence]
["$." order]
["$." codec]]}]
- [math
- ["r" random (#+ Random)]]
[time
["@." instant]]]
[//
@@ -23,9 +22,9 @@
(def: #export test
Test
- ($_ _.and
- ($equivalence.spec /.equivalence ..date)
- ($order.spec /.order ..date)
- (<| (_.seed 6623983470548808292)
- ($codec.spec /.equivalence /.codec ..date))
- ))
+ (<| (_.context (%name (name-of /._)))
+ ($_ _.and
+ ($equivalence.spec /.equivalence ..date)
+ ($order.spec /.order ..date)
+ ($codec.spec /.equivalence /.codec ..date)
+ )))
diff --git a/stdlib/source/test/lux/time/day.lux b/stdlib/source/test/lux/time/day.lux
index e0142d1b4..84d404a21 100644
--- a/stdlib/source/test/lux/time/day.lux
+++ b/stdlib/source/test/lux/time/day.lux
@@ -25,8 +25,9 @@
(def: #export test
Test
- ($_ _.and
- ($equivalence.spec /.equivalence ..day)
- ($order.spec /.order ..day)
- ($enum.spec /.enum ..day)
- ))
+ (<| (_.context (%name (name-of /._)))
+ ($_ _.and
+ ($equivalence.spec /.equivalence ..day)
+ ($order.spec /.order ..day)
+ ($enum.spec /.enum ..day)
+ )))
diff --git a/stdlib/source/test/lux/time/duration.lux b/stdlib/source/test/lux/time/duration.lux
index ba0e35cf1..a7265f62f 100644
--- a/stdlib/source/test/lux/time/duration.lux
+++ b/stdlib/source/test/lux/time/duration.lux
@@ -23,27 +23,28 @@
(def: #export test
Test
- ($_ _.and
- ($equivalence.spec /.equivalence ..duration)
- ($order.spec /.order ..duration)
- ($monoid.spec /.equivalence /.monoid ..duration)
- ## TODO; Uncomment ASAP
- ## ($codec.spec /.equivalence /.codec ..duration)
+ (<| (_.context (%name (name-of /._)))
+ ($_ _.and
+ ($equivalence.spec /.equivalence ..duration)
+ ($order.spec /.order ..duration)
+ ($monoid.spec /.equivalence /.monoid ..duration)
+ ## TODO; Uncomment ASAP
+ ## ($codec.spec /.equivalence /.codec ..duration)
- (do r.monad
- [millis r.int]
- (_.test "Can convert from/to milliseconds."
- (|> millis /.from-millis /.to-millis (i/= millis))))
- (do r.monad
- [sample (|> duration (:: @ map (/.frame /.day)))
- frame duration
- factor (|> r.nat (:: @ map (|>> (n/% 10) (n/max 1))))
- #let [(^open "/@.") /.order]]
- ($_ _.and
- (_.test "Can scale a duration."
- (|> sample (/.scale-up factor) (/.query sample) (i/= (.int factor))))
- (_.test "Scaling a duration by one does not change it."
- (|> sample (/.scale-up 1) (/@= sample)))
- (_.test "Merging a duration with it's opposite yields an empty duration."
- (|> sample (/.merge (/.inverse sample)) (/@= /.empty)))))
- ))
+ (do r.monad
+ [millis r.int]
+ (_.test "Can convert from/to milliseconds."
+ (|> millis /.from-millis /.to-millis (i/= millis))))
+ (do r.monad
+ [sample (|> duration (:: @ map (/.frame /.day)))
+ frame duration
+ factor (|> r.nat (:: @ map (|>> (n/% 10) (n/max 1))))
+ #let [(^open "/@.") /.order]]
+ ($_ _.and
+ (_.test "Can scale a duration."
+ (|> sample (/.scale-up factor) (/.query sample) (i/= (.int factor))))
+ (_.test "Scaling a duration by one does not change it."
+ (|> sample (/.scale-up 1) (/@= sample)))
+ (_.test "Merging a duration with it's opposite yields an empty duration."
+ (|> sample (/.merge (/.inverse sample)) (/@= /.empty)))))
+ )))
diff --git a/stdlib/source/test/lux/time/instant.lux b/stdlib/source/test/lux/time/instant.lux
index ec4a9456c..9b903d993 100644
--- a/stdlib/source/test/lux/time/instant.lux
+++ b/stdlib/source/test/lux/time/instant.lux
@@ -31,29 +31,30 @@
(def: #export test
Test
- ($_ _.and
- ($equivalence.spec /.equivalence ..instant)
- ($order.spec /.order ..instant)
- ($enum.spec /.enum ..instant)
- ## TODO; Uncomment ASAP
- ## ($codec.spec /.equivalence /.codec ..instant)
+ (<| (_.context (%name (name-of /._)))
+ ($_ _.and
+ ($equivalence.spec /.equivalence ..instant)
+ ($order.spec /.order ..instant)
+ ($enum.spec /.enum ..instant)
+ ## TODO; Uncomment ASAP
+ ## ($codec.spec /.equivalence /.codec ..instant)
- (do r.monad
- [millis r.int]
- (_.test "Can convert from/to milliseconds."
- (|> millis /.from-millis /.to-millis (i/= millis))))
- (do r.monad
- [sample instant
- span _duration.duration
- #let [(^open "@/.") /.equivalence
- (^open "@d/.") @d.equivalence]]
- ($_ _.and
- (_.test "The span of a instant and itself has an empty duration."
- (|> sample (/.span sample) (@d/= @d.empty)))
- (_.test "Can shift a instant by a duration."
- (|> sample (/.shift span) (/.span sample) (@d/= span)))
- (_.test "Can obtain the time-span between the epoch and an instant."
- (|> sample /.relative /.absolute (@/= sample)))
- (_.test "All instants are relative to the epoch."
- (|> /.epoch (/.shift (/.relative sample)) (@/= sample)))))
- ))
+ (do r.monad
+ [millis r.int]
+ (_.test "Can convert from/to milliseconds."
+ (|> millis /.from-millis /.to-millis (i/= millis))))
+ (do r.monad
+ [sample instant
+ span _duration.duration
+ #let [(^open "@/.") /.equivalence
+ (^open "@d/.") @d.equivalence]]
+ ($_ _.and
+ (_.test "The span of a instant and itself has an empty duration."
+ (|> sample (/.span sample) (@d/= @d.empty)))
+ (_.test "Can shift a instant by a duration."
+ (|> sample (/.shift span) (/.span sample) (@d/= span)))
+ (_.test "Can obtain the time-span between the epoch and an instant."
+ (|> sample /.relative /.absolute (@/= sample)))
+ (_.test "All instants are relative to the epoch."
+ (|> /.epoch (/.shift (/.relative sample)) (@/= sample)))))
+ )))
diff --git a/stdlib/source/test/lux/time/month.lux b/stdlib/source/test/lux/time/month.lux
index 4c9365bb6..f0722af0b 100644
--- a/stdlib/source/test/lux/time/month.lux
+++ b/stdlib/source/test/lux/time/month.lux
@@ -30,8 +30,9 @@
(def: #export test
Test
- ($_ _.and
- ($equivalence.spec /.equivalence ..month)
- ($order.spec /.order ..month)
- ($enum.spec /.enum ..month)
- ))
+ (<| (_.context (%name (name-of /._)))
+ ($_ _.and
+ ($equivalence.spec /.equivalence ..month)
+ ($order.spec /.order ..month)
+ ($enum.spec /.enum ..month)
+ )))
diff --git a/stdlib/source/test/lux/world/binary.lux b/stdlib/source/test/lux/world/binary.lux
index 2f347c50d..2e463ea4b 100644
--- a/stdlib/source/test/lux/world/binary.lux
+++ b/stdlib/source/test/lux/world/binary.lux
@@ -39,9 +39,11 @@
(def: (bits-io bytes read write value)
(-> Nat (-> Nat Binary (Error Nat)) (-> Nat Nat Binary (Error Any)) Nat Bit)
- (let [binary (/.create 8)
- bits (n/* 8 bytes)
- capped-value (|> 1 (i64.left-shift bits) dec (i64.and value))]
+ (let [binary (/.create bytes)
+ cap (case bytes
+ 8 (dec 0)
+ _ (|> 1 (i64.left-shift (n/* 8 bytes)) dec))
+ capped-value (i64.and cap value)]
(succeed
(do error.monad
[_ (write 0 value binary)
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-05 14:17:57 +0000