aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/test
diff options
context:
space:
mode:
Diffstat (limited to 'stdlib/source/test')
-rw-r--r--stdlib/source/test/lux/data/collection/tree/zipper.lux3
-rw-r--r--stdlib/source/test/lux/data/color.lux97
-rw-r--r--stdlib/source/test/lux/data/color/named.lux13
-rw-r--r--stdlib/source/test/lux/data/color/rgb.lux49
-rw-r--r--stdlib/source/test/lux/data/text.lux5
-rw-r--r--stdlib/source/test/lux/math.lux12
-rw-r--r--stdlib/source/test/lux/math/arithmetic/fixed_point.lux119
-rw-r--r--stdlib/source/test/lux/math/arithmetic/infix.lux (renamed from stdlib/source/test/lux/math/infix.lux)0
-rw-r--r--stdlib/source/test/lux/math/arithmetic/modular.lux (renamed from stdlib/source/test/lux/math/modular.lux)16
-rw-r--r--stdlib/source/test/lux/world/money.lux42
-rw-r--r--stdlib/source/test/lux/world/money/currency.lux4
-rw-r--r--stdlib/source/test/lux/world/net/http/response.lux2
12 files changed, 263 insertions, 99 deletions
diff --git a/stdlib/source/test/lux/data/collection/tree/zipper.lux b/stdlib/source/test/lux/data/collection/tree/zipper.lux
index fe764d955..4325a30ef 100644
--- a/stdlib/source/test/lux/data/collection/tree/zipper.lux
+++ b/stdlib/source/test/lux/data/collection/tree/zipper.lux
@@ -155,7 +155,8 @@
(def .public test
Test
(<| (_.covering /._)
- (_.for [/.Zipper])
+ (_.for [/.Zipper
+ /.#family /.#node])
(do [! random.monad]
[[size sample] (//.tree random.nat)
expected random.nat
diff --git a/stdlib/source/test/lux/data/color.lux b/stdlib/source/test/lux/data/color.lux
index c72ee2c1f..ee2eb70b2 100644
--- a/stdlib/source/test/lux/data/color.lux
+++ b/stdlib/source/test/lux/data/color.lux
@@ -48,12 +48,6 @@
(-> Frac Frac)
(f.pow +0.5))
-(def (distance/1 from to)
- (-> Frac Frac Frac)
- (square_root
- (square
- (f.- from to))))
-
(def (distance/3 from to)
(-> /.Color /.Color Frac)
(let [from (/.rgb from)
@@ -78,52 +72,31 @@
[luminance hsl.luminance]
)
-(def (encoding expected)
- (-> /.Color Test)
- (all _.and
- (_.coverage [/.rgb /.of_rgb]
- (|> expected /.rgb /.of_rgb
- (of /.equivalence = expected)))
- ))
-
-(def transformation
- Test
- (do random.monad
- [colorful (|> ..random
- (random.only (function (_ color) (and (|> (distance/3 color /.black) (f.>= +100.0))
- (|> (distance/3 color /.white) (f.>= +100.0))))))
- mediocre (|> ..random
- (random.only (|>> saturation
- ((function (_ saturation)
- (and (f.>= +0.25 saturation)
- (f.<= +0.75 saturation)))))))
- ratio (|> random.safe_frac (random.only (f.>= +0.5)))]
- (all _.and
- (_.coverage [/.darker /.brighter]
- (and (f.<= (distance/3 colorful /.black)
- (distance/3 (/.darker ratio colorful) /.black))
- (f.<= (distance/3 colorful /.white)
- (distance/3 (/.brighter ratio colorful) /.white))))
- (_.coverage [/.interpolated]
- (and (f.<= (distance/3 colorful /.black)
- (distance/3 (/.interpolated ratio /.black colorful) /.black))
- (f.<= (distance/3 colorful /.white)
- (distance/3 (/.interpolated ratio /.white colorful) /.white))))
- (_.coverage [/.saturated]
- (f.> (saturation mediocre)
- (saturation (/.saturated ratio mediocre))))
- (_.coverage [/.un_saturated]
- (f.< (saturation mediocre)
- (saturation (/.un_saturated ratio mediocre))))
- (_.coverage [/.gray_scale]
- (let [gray'ed (/.gray_scale mediocre)]
- (and (f.= +0.0
- (saturation gray'ed))
- (|> (luminance gray'ed)
- (f.- (luminance mediocre))
- f.abs
- (f.<= ..rgb_error_margin)))))
- )))
+... (def transformation
+... Test
+... (do random.monad
+... [mediocre (|> ..random
+... (random.only (|>> saturation
+... ((function (_ saturation)
+... (and (f.>= +0.25 saturation)
+... (f.<= +0.75 saturation)))))))
+... ratio (|> random.safe_frac (random.only (f.>= +0.5)))]
+... (all _.and
+... (_.coverage [/.saturated]
+... (f.> (saturation mediocre)
+... (saturation (/.saturated ratio mediocre))))
+... (_.coverage [/.un_saturated]
+... (f.< (saturation mediocre)
+... (saturation (/.un_saturated ratio mediocre))))
+... (_.coverage [/.gray_scale]
+... (let [gray'ed (/.gray_scale mediocre)]
+... (and (f.= +0.0
+... (saturation gray'ed))
+... (|> (luminance gray'ed)
+... (f.- (luminance mediocre))
+... f.abs
+... (f.<= ..rgb_error_margin)))))
+... )))
... (def palette
... Test
@@ -181,25 +154,7 @@
(do [! random.monad]
[expected ..random]
(all _.and
- (_.for [/.equivalence]
- ($equivalence.spec /.equivalence ..random))
- (_.for [/.hash]
- ($hash.spec /.hash ..random))
- (_.for [/.addition]
- ($monoid.spec /.equivalence /.addition ..random))
- (_.for [/.subtraction]
- ($monoid.spec /.equivalence /.addition ..random))
-
- (..encoding expected)
- (_.coverage [/.complement]
- (let [~expected (/.complement expected)
- (open "/#[0]") /.equivalence]
- (and (not (/#= expected ~expected))
- (/#= expected (/.complement ~expected)))))
- (_.coverage [/.black /.white]
- (and (of /.equivalence = /.white (/.complement /.black))
- (of /.equivalence = /.black (/.complement /.white))))
- ..transformation
+ ... ..transformation
... ..palette
/rgb.test
diff --git a/stdlib/source/test/lux/data/color/named.lux b/stdlib/source/test/lux/data/color/named.lux
index cb1201c74..4af869cb4 100644
--- a/stdlib/source/test/lux/data/color/named.lux
+++ b/stdlib/source/test/lux/data/color/named.lux
@@ -20,7 +20,8 @@
["_" property (.only Test)]]]]
[\\library
["[0]" / (.only)
- ["/[1]" //]]])
+ [//
+ ["[0]" rgb (.only RGB)]]]])
(with_expansions [<colors> (these [letter/a
[/.alice_blue
@@ -206,7 +207,7 @@
)]
(def all_colors
(list.together (`` (list (,, (with_template [<definition> <by_letter>]
- [((is (-> Any (List //.Color))
+ [((is (-> Any (List RGB))
(function (_ _)
(`` (list (,, (template.spliced <by_letter>))))))
123)]
@@ -214,10 +215,10 @@
<colors>))))))
(def unique_colors
- (set.of_list //.hash ..all_colors))
+ (set.of_list rgb.hash ..all_colors))
(def .public random
- (Random //.Color)
+ (Random RGB)
(do [! random.monad]
[choice (of ! each (n.% (set.size ..unique_colors))
random.nat)]
@@ -244,8 +245,8 @@
<colors>))
(_.coverage [/.aqua]
- (of //.equivalence = /.cyan /.aqua))
+ (of rgb.equivalence = /.cyan /.aqua))
(_.coverage [/.fuchsia]
- (of //.equivalence = /.magenta /.fuchsia))
+ (of rgb.equivalence = /.magenta /.fuchsia))
))))
)
diff --git a/stdlib/source/test/lux/data/color/rgb.lux b/stdlib/source/test/lux/data/color/rgb.lux
index 5c81582eb..19094bfe2 100644
--- a/stdlib/source/test/lux/data/color/rgb.lux
+++ b/stdlib/source/test/lux/data/color/rgb.lux
@@ -13,7 +13,9 @@
[math
["[0]" random (.only Random) (.use "[1]#[0]" functor)]
[number
- ["n" nat]]]
+ ["n" nat]
+ ["i" int]
+ ["f" frac]]]
[test
["_" property (.only Test)]]]]
[\\library
@@ -32,6 +34,31 @@
blue ..value]
(in (/.rgb red green blue))))
+(def scale
+ (-> Nat
+ Frac)
+ (|>> .int
+ i.frac))
+
+(def square
+ (-> Frac
+ Frac)
+ (f.pow +2.0))
+
+(def square_root
+ (-> Frac
+ Frac)
+ (f.pow +0.5))
+
+(def (distance/3 from to)
+ (-> /.RGB /.RGB
+ Frac)
+ (square_root
+ (all f.+
+ (|> (scale (/.red to)) (f.- (scale (/.red from))) square)
+ (|> (scale (/.green to)) (f.- (scale (/.green from))) square)
+ (|> (scale (/.blue to)) (f.- (scale (/.blue from))) square))))
+
(def .public test
Test
(<| (_.covering /._)
@@ -41,7 +68,14 @@
expected_red ..value
expected_green ..value
- expected_blue ..value])
+ expected_blue ..value
+
+ colorful (random.only (function (_ it)
+ (and (|> it (distance/3 /.black) (f.>= +100.0))
+ (|> it (distance/3 /.white) (f.>= +100.0))))
+ ..random)
+ ratio (random.only (f.>= +0.5)
+ random.safe_frac)])
(all _.and
(_.for [/.Value]
(all _.and
@@ -93,5 +127,16 @@
(_.coverage [/.black /.white]
(and (of /.equivalence = /.white (/.complement /.black))
(of /.equivalence = /.black (/.complement /.white))))
+
+ (_.coverage [/.interpolated]
+ (and (f.<= (distance/3 /.black colorful)
+ (distance/3 /.black (/.interpolated /.black ratio colorful)))
+ (f.<= (distance/3 /.white colorful)
+ (distance/3 /.white (/.interpolated /.white ratio colorful)))))
+ (_.coverage [/.darker /.brighter]
+ (and (f.<= (distance/3 /.black colorful)
+ (distance/3 /.black (/.darker ratio colorful)))
+ (f.<= (distance/3 /.white colorful)
+ (distance/3 /.white (/.brighter ratio colorful)))))
))
)))
diff --git a/stdlib/source/test/lux/data/text.lux b/stdlib/source/test/lux/data/text.lux
index dd867436b..6dadb8aa6 100644
--- a/stdlib/source/test/lux/data/text.lux
+++ b/stdlib/source/test/lux/data/text.lux
@@ -35,13 +35,14 @@
[math
["[0]" random (.only Random) (.use "[1]#[0]" monad)]
["[0]" modulus]
- ["[0]" modular]
[number
["[0]" nat]
["[0]" int]
["[0]" rev]
["[0]" frac]
- ["[0]" ratio]]]
+ ["[0]" ratio]]
+ [arithmetic
+ ["[0]" modular]]]
[meta
["[0]" location]
["[0]" symbol]
diff --git a/stdlib/source/test/lux/math.lux b/stdlib/source/test/lux/math.lux
index 6cee94642..c3cd49270 100644
--- a/stdlib/source/test/lux/math.lux
+++ b/stdlib/source/test/lux/math.lux
@@ -22,16 +22,17 @@
[\\library
["[0]" /]]
["[0]" /
- ["[1][0]" infix]
["[1][0]" modulus]
- ["[1][0]" modular]
["[1][0]" number]
["[1][0]" random]
["[1][0]" logic
["[1]/[0]" continuous]
["[1]/[0]" fuzzy]]
["[1][0]" arithmetic
- ["[1]/[0]" saturation]]])
+ ["[1]/[0]" infix]
+ ["[1]/[0]" modular]
+ ["[1]/[0]" saturation]
+ ["[1]/[0]" fixed_point]]])
(def ratio/0
Ratio
@@ -140,12 +141,13 @@
[ratio.>= parameter/ subject/]]]
))
- /infix.test
/modulus.test
- /modular.test
/number.test
/random.test
/logic/continuous.test
/logic/fuzzy.test
+ /arithmetic/infix.test
+ /arithmetic/modular.test
/arithmetic/saturation.test
+ /arithmetic/fixed_point.test
))))
diff --git a/stdlib/source/test/lux/math/arithmetic/fixed_point.lux b/stdlib/source/test/lux/math/arithmetic/fixed_point.lux
new file mode 100644
index 000000000..bff8264f2
--- /dev/null
+++ b/stdlib/source/test/lux/math/arithmetic/fixed_point.lux
@@ -0,0 +1,119 @@
+(.require
+ [library
+ [lux (.except)
+ [abstract
+ [monad (.only do)]
+ [\\specification
+ ["[0]S" equivalence]
+ ["[0]S" order]]]
+ [control
+ ["[0]" try (.use "[1]#[0]" functor)]
+ ["[0]" exception]]
+ [data
+ ["[0]" bit (.use "[1]#[0]" equivalence)]
+ ["[0]" text (.only)
+ ["%" \\format]]]
+ [math
+ ["[0]" random (.only Random)]
+ [number
+ ["n" nat]]
+ ["[0]" arithmetic
+ ["[1]S" \\specification]]]
+ [test
+ ["_" property (.only Test)]]]]
+ [\\library
+ ["[0]" /]])
+
+(def .public (random @)
+ (All (_ @)
+ (-> (/.Point @)
+ (Random (/.Fixed @))))
+ (do random.monad
+ [units random.int
+ sub_units random.rev]
+ (in (/.fixed @ units sub_units))))
+
+(def .public test
+ Test
+ (<| (_.covering /._)
+ (do [! random.monad]
+ [candidate_point random.nat
+ expected_point (of ! each (n.% (++ /.maximum)) random.nat)
+ .let [@ (try.trusted (/.point expected_point))]
+ expected (..random @)
+ parameter (..random @)
+ subject (..random @)])
+ (all _.and
+ (<| (_.for [/.Point])
+ (all _.and
+ (_.coverage [/.point /.location]
+ (|> (/.point expected_point)
+ (try#each (|>> /.location
+ (same? expected_point)))
+ (try.else false)))
+ (_.coverage [/.maximum /.point_exceeds_maximum]
+ (when (/.point candidate_point)
+ {try.#Success it}
+ (n.<= /.maximum candidate_point)
+
+ {try.#Failure error}
+ (and (n.> /.maximum candidate_point)
+ (exception.match? /.point_exceeds_maximum error))))
+ ))
+ (<| (_.for [/.Fixed])
+ (all _.and
+ (_.for [/.equivalence /.=]
+ (equivalenceS.spec (/.equivalence @) (..random @)))
+ (_.for [/.order /.<]
+ (orderS.spec (/.order @) (..random @)))
+ (_.for [/.arithmetic]
+ (arithmeticS.spec (/.equivalence @) (/.arithmetic @) (..random @)))
+
+ (_.coverage [/.fixed /.units /.sub_units]
+ (/.= @
+ expected
+ (/.fixed @ (/.units @ expected) (/.sub_units @ expected))))
+ (_.coverage [/.of_int /.of_rev]
+ (/.= @
+ expected
+ (/.+ @
+ (/.of_int @ (/.units @ expected))
+ (/.of_rev @ (/.sub_units @ expected)))))
+
+ (_.coverage [/.>]
+ (bit#= (/.> @ parameter subject)
+ (/.< @ subject parameter)))
+ (_.coverage [/.<= /.>=]
+ (bit#= (/.<= @ parameter subject)
+ (/.>= @ subject parameter)))
+
+ (_.coverage [/.-]
+ (and (/.= @
+ (/.of_int @ +0)
+ (/.- @ expected expected))
+ (/.= @
+ (/.of_rev @ .0)
+ (/.- @ expected expected))))
+ (_.coverage [/.+]
+ (|> subject
+ (/.+ @ parameter)
+ (/.- @ parameter)
+ (/.= @ subject)))
+ (_.coverage [/./]
+ (/.= @
+ (/.of_int @ +1)
+ (/./ @ expected expected)))
+ (_.coverage [/.* /.%]
+ (let [rem (/.% @ parameter subject)
+ div (|> subject (/.- @ rem) (/./ @ parameter))]
+ (/.= @ subject
+ (|> div (/.* @ parameter) (/.+ @ rem)))))
+
+ (_.coverage [/.format]
+ (let [it (/.format @ expected)]
+ (and (text.contains? (%.int (/.units @ expected))
+ it)
+ (text.contains? (%.rev (/.sub_units @ expected))
+ it))))
+ ))
+ )))
diff --git a/stdlib/source/test/lux/math/infix.lux b/stdlib/source/test/lux/math/arithmetic/infix.lux
index 5f4143556..5f4143556 100644
--- a/stdlib/source/test/lux/math/infix.lux
+++ b/stdlib/source/test/lux/math/arithmetic/infix.lux
diff --git a/stdlib/source/test/lux/math/modular.lux b/stdlib/source/test/lux/math/arithmetic/modular.lux
index 686977544..4d05bacbe 100644
--- a/stdlib/source/test/lux/math/modular.lux
+++ b/stdlib/source/test/lux/math/arithmetic/modular.lux
@@ -24,15 +24,17 @@
["[0]" type (.use "[1]#[0]" equivalence)]]
[test
["_" property (.only Test)]]]]
- ["$[0]" //
- ["[1]" modulus]]
+ [///
+ ["//T" modulus]]
[\\library
["[0]" / (.only)
- ["/[1]" //
- ["[1]" modulus]]]])
+ [///
+ ["//" modulus]]]])
(def .public (random modulus)
- (All (_ %) (-> (//.Modulus %) (Random (/.Mod %))))
+ (All (_ %)
+ (-> (//.Modulus %)
+ (Random (/.Mod %))))
(of random.monad each
(/.modular modulus)
random.int))
@@ -42,12 +44,12 @@
(<| (_.covering /._)
(_.for [/.Mod])
(do random.monad
- [param::% ($//.random +1,000,000)
+ [param::% (//T.random +1,000,000)
param (..random param::%)
subject::% (random.only (predicate.and (|>> //.divisor (i.> +2))
(|>> (//.= param::%) not))
- ($//.random +1,000,000))
+ (//T.random +1,000,000))
subject (..random subject::%)
another (..random subject::%)]
(`` (all _.and
diff --git a/stdlib/source/test/lux/world/money.lux b/stdlib/source/test/lux/world/money.lux
index 4ebd46bf2..4cddc38ee 100644
--- a/stdlib/source/test/lux/world/money.lux
+++ b/stdlib/source/test/lux/world/money.lux
@@ -4,10 +4,12 @@
[abstract
[monad (.only do)]
[\\specification
- ["[0]S" equivalence]]]
+ ["[0]S" equivalence]
+ ["[0]S" order]]]
[control
["[0]" maybe (.use "[1]#[0]" functor)]]
[data
+ ["[0]" bit (.use "[1]#[0]" equivalence)]
["[0]" text (.only)
["%" \\format]]]
[math
@@ -41,8 +43,10 @@
expected_subject random.nat])
(_.for [/.Money])
(all _.and
- (_.for [/.equivalence]
+ (_.for [/.equivalence /.=]
(equivalenceS.spec /.equivalence ..random))
+ (_.for [/.order /.<]
+ (orderS.spec /.order ..random))
(_.coverage [/.money /.currency /.amount]
(let [it (/.money expected_currency expected_amount)]
@@ -60,6 +64,40 @@
(/.- parameter)
(maybe#each (of /.equivalence = subject))
(maybe.else false)))))
+ (_.coverage [/.min]
+ (let [expected_parameter (/.money expected_currency expected_parameter)
+ expected_subject (/.money expected_currency expected_subject)]
+ (and (/.<= expected_parameter
+ (/.min expected_parameter expected_subject))
+ (/.<= expected_subject
+ (/.min expected_parameter expected_subject)))))
+ (_.coverage [/.max]
+ (let [expected_parameter (/.money expected_currency expected_parameter)
+ expected_subject (/.money expected_currency expected_subject)]
+ (and (/.>= expected_parameter
+ (/.max expected_parameter expected_subject))
+ (/.>= expected_subject
+ (/.max expected_parameter expected_subject)))))
+ (let [expected_parameter (/.money expected_currency expected_parameter)
+ expected_subject (/.money expected_currency expected_subject)]
+ (all _.and
+ (_.coverage [/.>]
+ (bit#= (/.> expected_parameter expected_subject)
+ (/.< expected_subject expected_parameter)))
+ (_.coverage [/.<= /.>=]
+ (bit#= (/.<= expected_parameter expected_subject)
+ (/.>= expected_subject expected_parameter)))
+ ))
+ (_.coverage [/.units /.sub_units]
+ (let [expected (/.money expected_currency expected_amount)
+ actual (/.money expected_currency (n.+ (/.units expected)
+ (/.sub_units expected)))]
+ (/.= expected actual)))
+ (_.coverage [/.of_units /.of_sub_units]
+ (let [expected (/.money expected_currency expected_amount)
+ actual (/.+ (/.of_units expected_currency (/.units expected))
+ (/.of_sub_units expected_currency (/.sub_units expected)))]
+ (/.= expected actual)))
(do !
[it ..random]
(_.coverage [/.format]
diff --git a/stdlib/source/test/lux/world/money/currency.lux b/stdlib/source/test/lux/world/money/currency.lux
index 927ffd8f3..eeb59e9fc 100644
--- a/stdlib/source/test/lux/world/money/currency.lux
+++ b/stdlib/source/test/lux/world/money/currency.lux
@@ -240,8 +240,8 @@
(set.of_list n.hash))]
(n.= (list.size options)
(set.size uniques))))
- (_.coverage [/.subdivisions]
- (list.every? (|>> /.subdivisions (n.> 0))
+ (_.coverage [/.sub_divisions]
+ (list.every? (|>> /.sub_divisions (n.> 0))
options))
)))
(<| (_.for [/.currency /.type])
diff --git a/stdlib/source/test/lux/world/net/http/response.lux b/stdlib/source/test/lux/world/net/http/response.lux
index d25d3ce7f..bd3ee75aa 100644
--- a/stdlib/source/test/lux/world/net/http/response.lux
+++ b/stdlib/source/test/lux/world/net/http/response.lux
@@ -11,7 +11,7 @@
["[0]" product]
["[0]" binary (.use "[1]#[0]" equivalence)]
["[0]" color
- [named
+ [rgb
["[1]T" \\test]]]
["[0]" text (.use "[1]#[0]" equivalence)
[encoding
generated by cgit v1.2.3 (git 2.25.1) at 2024-07-01 06:21:22 +0000