From eef4422b1f16be2b8c651461f2c006dc4c11f314 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Sun, 11 Dec 2022 16:07:39 -0400 Subject: Added support for fixed-point arithmetic. --- .../test/lux/data/collection/tree/zipper.lux | 3 +- stdlib/source/test/lux/data/color.lux | 97 +++++----------- stdlib/source/test/lux/data/color/named.lux | 13 ++- stdlib/source/test/lux/data/color/rgb.lux | 49 +++++++- stdlib/source/test/lux/data/text.lux | 5 +- stdlib/source/test/lux/math.lux | 12 +- .../test/lux/math/arithmetic/fixed_point.lux | 119 +++++++++++++++++++ stdlib/source/test/lux/math/arithmetic/infix.lux | 57 +++++++++ stdlib/source/test/lux/math/arithmetic/modular.lux | 129 +++++++++++++++++++++ stdlib/source/test/lux/math/infix.lux | 57 --------- stdlib/source/test/lux/math/modular.lux | 127 -------------------- stdlib/source/test/lux/world/money.lux | 42 ++++++- stdlib/source/test/lux/world/money/currency.lux | 4 +- stdlib/source/test/lux/world/net/http/response.lux | 2 +- 14 files changed, 440 insertions(+), 276 deletions(-) create mode 100644 stdlib/source/test/lux/math/arithmetic/fixed_point.lux create mode 100644 stdlib/source/test/lux/math/arithmetic/infix.lux create mode 100644 stdlib/source/test/lux/math/arithmetic/modular.lux delete mode 100644 stdlib/source/test/lux/math/infix.lux delete mode 100644 stdlib/source/test/lux/math/modular.lux (limited to 'stdlib/source/test') 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 [ (these [letter/a [/.alice_blue @@ -206,7 +207,7 @@ )] (def all_colors (list.together (`` (list (,, (with_template [ ] - [((is (-> Any (List //.Color)) + [((is (-> Any (List RGB)) (function (_ _) (`` (list (,, (template.spliced )))))) 123)] @@ -214,10 +215,10 @@ )))))) (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 @@ )) (_.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/arithmetic/infix.lux b/stdlib/source/test/lux/math/arithmetic/infix.lux new file mode 100644 index 000000000..5f4143556 --- /dev/null +++ b/stdlib/source/test/lux/math/arithmetic/infix.lux @@ -0,0 +1,57 @@ +(.require + [library + [lux (.except) + [abstract + [monad (.only do)]] + [data + ["[0]" bit (.use "[1]#[0]" equivalence)]] + [math + ["[0]" random] + [number + ["n" nat] + ["f" frac]]] + [test + ["_" property (.only Test)]]]] + [\\library + ["[0]" /]]) + +(def .public test + Test + (<| (_.covering /._) + (do random.monad + [subject random.nat + parameter random.nat + extra random.nat + angle random.safe_frac + factor random.nat] + (_.coverage [/.infix] + (let [constant_values! + (n.= subject + (/.infix subject)) + + unary_functions! + (f.= (f.sin angle) + (/.infix [f.sin angle])) + + binary_functions! + (n.= (n.gcd parameter subject) + (/.infix [subject n.gcd parameter])) + + multiple_binary_functions! + (n.= (n.* factor (n.gcd parameter subject)) + (/.infix [subject n.gcd parameter n.* factor])) + + function_call! + (n.= (n.gcd extra (n.* parameter subject)) + (/.infix [(n.* parameter subject) n.gcd extra])) + + non_numeric! + (bit#= (and (n.< parameter subject) (n.< extra parameter)) + (/.infix [[subject n.< parameter] and [parameter n.< extra]]))] + (and constant_values! + unary_functions! + binary_functions! + multiple_binary_functions! + function_call! + non_numeric! + )))))) diff --git a/stdlib/source/test/lux/math/arithmetic/modular.lux b/stdlib/source/test/lux/math/arithmetic/modular.lux new file mode 100644 index 000000000..4d05bacbe --- /dev/null +++ b/stdlib/source/test/lux/math/arithmetic/modular.lux @@ -0,0 +1,129 @@ +(.require + [library + [lux (.except) + [abstract + [monad (.only do)] + [\\specification + ["$[0]" equivalence] + ["$[0]" order] + ["$[0]" monoid] + ["$[0]" codec]]] + [control + ["[0]" try] + ["[0]" exception] + [function + ["[0]" predicate]]] + [data + ["[0]" product] + ["[0]" bit (.use "[1]#[0]" equivalence)]] + [math + ["[0]" random (.only Random)] + [number + ["i" int]]] + [meta + ["[0]" type (.use "[1]#[0]" equivalence)]] + [test + ["_" property (.only Test)]]]] + [/// + ["//T" modulus]] + [\\library + ["[0]" / (.only) + [/// + ["//" modulus]]]]) + +(def .public (random modulus) + (All (_ %) + (-> (//.Modulus %) + (Random (/.Mod %)))) + (of random.monad each + (/.modular modulus) + random.int)) + +(def .public test + Test + (<| (_.covering /._) + (_.for [/.Mod]) + (do random.monad + [param::% (//T.random +1,000,000) + param (..random param::%) + + subject::% (random.only (predicate.and (|>> //.divisor (i.> +2)) + (|>> (//.= param::%) not)) + (//T.random +1,000,000)) + subject (..random subject::%) + another (..random subject::%)] + (`` (all _.and + (_.for [/.equivalence /.=] + ($equivalence.spec /.equivalence (..random subject::%))) + (_.for [/.order /.<] + ($order.spec /.order (..random subject::%))) + (,, (with_template [ ] + [(_.for [ ] + ($monoid.spec /.equivalence ( subject::%) (..random subject::%)))] + + [/.+ /.addition] + [/.* /.multiplication] + )) + (_.for [/.codec] + ($codec.spec /.equivalence (/.codec subject::%) (..random subject::%))) + + (_.coverage [/.incorrect_modulus] + (when (|> param + (of (/.codec param::%) encoded) + (of (/.codec subject::%) decoded)) + {try.#Failure error} + (exception.match? /.incorrect_modulus error) + + {try.#Success _} + false)) + (_.coverage [/.modulus] + (and (type#= (type_of (/.modulus subject)) + (type_of (/.modulus subject))) + (not (type#= (type_of (/.modulus subject)) + (type_of (/.modulus param)))))) + (_.coverage [/.modular /.value] + (/.= subject + (/.modular (/.modulus subject) (/.value subject)))) + (_.coverage [/.>] + (bit#= (/.> another subject) + (/.< subject another))) + (_.coverage [/.<= /.>=] + (bit#= (/.<= another subject) + (/.>= subject another))) + (_.coverage [/.-] + (let [zero (/.modular (/.modulus subject) +0)] + (and (/.= zero + (/.- subject subject)) + (/.= subject + (/.- zero subject))))) + (_.coverage [/.inverse] + (let [one (/.modular (/.modulus subject) +1) + co_prime? (i.co_prime? (//.divisor (/.modulus subject)) + (/.value subject))] + (when (/.inverse subject) + {.#Some subject^-1} + (and co_prime? + (|> subject + (/.* subject^-1) + (/.= one))) + + {.#None} + (not co_prime?)))) + (_.coverage [/.adapter] + (<| (try.else false) + (do try.monad + [copy::% (//.modulus (//.divisor subject::%)) + adapt (/.adapter subject::% copy::%)] + (in (|> subject + /.value + (/.modular copy::%) + adapt + (/.= subject)))))) + (_.coverage [/.moduli_are_not_equal] + (when (/.adapter subject::% param::%) + {try.#Failure error} + (exception.match? /.moduli_are_not_equal error) + + {try.#Success _} + false)) + ))))) diff --git a/stdlib/source/test/lux/math/infix.lux b/stdlib/source/test/lux/math/infix.lux deleted file mode 100644 index 5f4143556..000000000 --- a/stdlib/source/test/lux/math/infix.lux +++ /dev/null @@ -1,57 +0,0 @@ -(.require - [library - [lux (.except) - [abstract - [monad (.only do)]] - [data - ["[0]" bit (.use "[1]#[0]" equivalence)]] - [math - ["[0]" random] - [number - ["n" nat] - ["f" frac]]] - [test - ["_" property (.only Test)]]]] - [\\library - ["[0]" /]]) - -(def .public test - Test - (<| (_.covering /._) - (do random.monad - [subject random.nat - parameter random.nat - extra random.nat - angle random.safe_frac - factor random.nat] - (_.coverage [/.infix] - (let [constant_values! - (n.= subject - (/.infix subject)) - - unary_functions! - (f.= (f.sin angle) - (/.infix [f.sin angle])) - - binary_functions! - (n.= (n.gcd parameter subject) - (/.infix [subject n.gcd parameter])) - - multiple_binary_functions! - (n.= (n.* factor (n.gcd parameter subject)) - (/.infix [subject n.gcd parameter n.* factor])) - - function_call! - (n.= (n.gcd extra (n.* parameter subject)) - (/.infix [(n.* parameter subject) n.gcd extra])) - - non_numeric! - (bit#= (and (n.< parameter subject) (n.< extra parameter)) - (/.infix [[subject n.< parameter] and [parameter n.< extra]]))] - (and constant_values! - unary_functions! - binary_functions! - multiple_binary_functions! - function_call! - non_numeric! - )))))) diff --git a/stdlib/source/test/lux/math/modular.lux b/stdlib/source/test/lux/math/modular.lux deleted file mode 100644 index 686977544..000000000 --- a/stdlib/source/test/lux/math/modular.lux +++ /dev/null @@ -1,127 +0,0 @@ -(.require - [library - [lux (.except) - [abstract - [monad (.only do)] - [\\specification - ["$[0]" equivalence] - ["$[0]" order] - ["$[0]" monoid] - ["$[0]" codec]]] - [control - ["[0]" try] - ["[0]" exception] - [function - ["[0]" predicate]]] - [data - ["[0]" product] - ["[0]" bit (.use "[1]#[0]" equivalence)]] - [math - ["[0]" random (.only Random)] - [number - ["i" int]]] - [meta - ["[0]" type (.use "[1]#[0]" equivalence)]] - [test - ["_" property (.only Test)]]]] - ["$[0]" // - ["[1]" modulus]] - [\\library - ["[0]" / (.only) - ["/[1]" // - ["[1]" modulus]]]]) - -(def .public (random modulus) - (All (_ %) (-> (//.Modulus %) (Random (/.Mod %)))) - (of random.monad each - (/.modular modulus) - random.int)) - -(def .public test - Test - (<| (_.covering /._) - (_.for [/.Mod]) - (do random.monad - [param::% ($//.random +1,000,000) - param (..random param::%) - - subject::% (random.only (predicate.and (|>> //.divisor (i.> +2)) - (|>> (//.= param::%) not)) - ($//.random +1,000,000)) - subject (..random subject::%) - another (..random subject::%)] - (`` (all _.and - (_.for [/.equivalence /.=] - ($equivalence.spec /.equivalence (..random subject::%))) - (_.for [/.order /.<] - ($order.spec /.order (..random subject::%))) - (,, (with_template [ ] - [(_.for [ ] - ($monoid.spec /.equivalence ( subject::%) (..random subject::%)))] - - [/.+ /.addition] - [/.* /.multiplication] - )) - (_.for [/.codec] - ($codec.spec /.equivalence (/.codec subject::%) (..random subject::%))) - - (_.coverage [/.incorrect_modulus] - (when (|> param - (of (/.codec param::%) encoded) - (of (/.codec subject::%) decoded)) - {try.#Failure error} - (exception.match? /.incorrect_modulus error) - - {try.#Success _} - false)) - (_.coverage [/.modulus] - (and (type#= (type_of (/.modulus subject)) - (type_of (/.modulus subject))) - (not (type#= (type_of (/.modulus subject)) - (type_of (/.modulus param)))))) - (_.coverage [/.modular /.value] - (/.= subject - (/.modular (/.modulus subject) (/.value subject)))) - (_.coverage [/.>] - (bit#= (/.> another subject) - (/.< subject another))) - (_.coverage [/.<= /.>=] - (bit#= (/.<= another subject) - (/.>= subject another))) - (_.coverage [/.-] - (let [zero (/.modular (/.modulus subject) +0)] - (and (/.= zero - (/.- subject subject)) - (/.= subject - (/.- zero subject))))) - (_.coverage [/.inverse] - (let [one (/.modular (/.modulus subject) +1) - co_prime? (i.co_prime? (//.divisor (/.modulus subject)) - (/.value subject))] - (when (/.inverse subject) - {.#Some subject^-1} - (and co_prime? - (|> subject - (/.* subject^-1) - (/.= one))) - - {.#None} - (not co_prime?)))) - (_.coverage [/.adapter] - (<| (try.else false) - (do try.monad - [copy::% (//.modulus (//.divisor subject::%)) - adapt (/.adapter subject::% copy::%)] - (in (|> subject - /.value - (/.modular copy::%) - adapt - (/.= subject)))))) - (_.coverage [/.moduli_are_not_equal] - (when (/.adapter subject::% param::%) - {try.#Failure error} - (exception.match? /.moduli_are_not_equal error) - - {try.#Success _} - false)) - ))))) 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 -- cgit v1.2.3