diff options
Diffstat (limited to '')
| -rw-r--r-- | stdlib/source/test/lux.lux | 140 | ||||
| -rw-r--r-- | stdlib/source/test/lux/control/enum.lux | 10 | ||||
| -rw-r--r-- | stdlib/source/test/lux/control/number.lux | 32 | ||||
| -rw-r--r-- | stdlib/source/test/lux/data/collection/row.lux | 26 | ||||
| -rw-r--r-- | stdlib/source/test/lux/data/collection/stack.lux | 13 | ||||
| -rw-r--r-- | stdlib/source/test/lux/data/number/complex.lux | 35 | ||||
| -rw-r--r-- | stdlib/source/test/lux/data/number/frac.lux | 69 | ||||
| -rw-r--r-- | stdlib/source/test/lux/data/number/i64.lux | 129 | ||||
| -rw-r--r-- | stdlib/source/test/lux/data/number/int.lux | 58 | ||||
| -rw-r--r-- | stdlib/source/test/lux/data/number/nat.lux | 58 | ||||
| -rw-r--r-- | stdlib/source/test/lux/data/number/ratio.lux | 40 | ||||
| -rw-r--r-- | stdlib/source/test/lux/data/number/rev.lux | 60 |
12 files changed, 321 insertions, 349 deletions
diff --git a/stdlib/source/test/lux.lux b/stdlib/source/test/lux.lux index 30abe1b37..a52c70fd4 100644 --- a/stdlib/source/test/lux.lux +++ b/stdlib/source/test/lux.lux @@ -9,7 +9,7 @@ [common (#+)] [host (#+)]])] (.module: - [lux #* + ["/" lux #* [cli (#+ program:)] ["." io (#+ io)] [control @@ -19,8 +19,7 @@ [number ["." i64]]] ["." function] - ["." math - ["r" random (#+ Random) ("#@." functor)]] + ["." math] ["_" test (#+ Test)] ## These modules do not need to be tested. [type @@ -28,11 +27,8 @@ [locale (#+) [language (#+)] [territory (#+)]] - [data - [text - [format (#+)]]] - ## [math - ## [random (#+)]] + data/text/format + ["r" math/random (#+ Random) ("#@." functor)] ## TODO: Test these modules [data [format @@ -235,8 +231,8 @@ (def: frac-rev (r.Random Rev) - (|> r.rev - (:: r.functor map (|>> (i64.left-shift 11) (i64.logic-right-shift 11))))) + (let [bits-to-ignore 11] + (:: r.functor map (i64.left-shift bits-to-ignore) r.rev))) (def: prelude-macros Test @@ -314,73 +310,71 @@ on-default)))))) (def: test - ($_ _.and - (<| (_.context "Identity.") - ..identity) - (<| (_.context "Increment & decrement.") - ..increment-and-decrement) - (<| (_.context "Even or odd.") - ($_ _.and - (<| (_.context "Natural numbers.") - (..even-or-odd r.nat n/even? n/odd?)) - (<| (_.context "Integers.") - (..even-or-odd r.int i/even? i/odd?)))) - (<| (_.context "Minimum and maximum.") - (`` ($_ _.and - (~~ (do-template [<=> <lt> <min> <gt> <max> <gen> <context>] - [(<| (_.context <context>) - (..minimum-and-maximum <gen> <=> [<lt> <min>] [<gt> <max>]))] + (<| (_.context (%name (name-of /._))) + ($_ _.and + (<| (_.context "Identity.") + ..identity) + (<| (_.context "Increment & decrement.") + ..increment-and-decrement) + (<| (_.context "Even or odd.") + ($_ _.and + (<| (_.context "Natural numbers.") + (..even-or-odd r.nat n/even? n/odd?)) + (<| (_.context "Integers.") + (..even-or-odd r.int i/even? i/odd?)))) + (<| (_.context "Minimum and maximum.") + (`` ($_ _.and + (~~ (do-template [<=> <lt> <min> <gt> <max> <gen> <context>] + [(<| (_.context <context>) + (..minimum-and-maximum <gen> <=> [<lt> <min>] [<gt> <max>]))] - [i/= i/< i/min i/> i/max r.int "Integers."] - [n/= n/< n/min n/> n/max r.nat "Natural numbers."] - [r/= r/< r/min r/> r/max r.rev "Revolutions."] - [f/= f/< f/min f/> f/max r.frac "Fractions."] - ))))) - (<| (_.context "Conversion.") - (`` ($_ _.and - (~~ (do-template [<context> <=> <forward> <backward> <gen>] - [(<| (_.context <context>) - (..conversion <gen> <forward> <backward> <=>))] + [i/= i/< i/min i/> i/max r.int "Integers."] + [n/= n/< n/min n/> n/max r.nat "Natural numbers."] + [r/= r/< r/min r/> r/max r.rev "Revolutions."] + [f/= f/< f/min f/> f/max r.frac "Fractions."] + ))))) + (<| (_.context "Conversion.") + (`` ($_ _.and + (~~ (do-template [<=> <forward> <backward> <gen>] + [(<| (_.context (format (%name (name-of <forward>)) + " " (%name (name-of <backward>)))) + (..conversion <gen> <forward> <backward> <=>))] - ["Int -> Nat" - i/= .nat .int (r@map (i/% +1,000,000) r.int)] - ["Nat -> Int" - n/= .int .nat (r@map (n/% 1,000,000) r.nat)] - ["Int -> Frac" - i/= int-to-frac frac-to-int (r@map (i/% +1,000,000) r.int)] - ["Frac -> Int" - f/= frac-to-int int-to-frac (r@map math.floor r.frac)] - ["Rev -> Frac" - r/= rev-to-frac frac-to-rev frac-rev] - ))))) - (<| (_.context "Prelude macros.") - ..prelude-macros) - (<| (_.context "Templates.") - ..template) - (<| (_.context "Cross-platform support.") - ..cross-platform-support) - /cli.test - /io.test - (<| (_.context "/control") - /control.test) - (<| (_.context "/data") - /data.test) - /macro.test - (<| (_.context "/math") - /math.test) - (<| (_.context "/time") - /time.test) - /type.test - /world.test - (<| (_.context "/host Host-platform interoperation") - ($_ _.and - /host.test - (<| (_.context "/jvm JVM (Java Virtual Machine)") - /host/jvm.test))) - )) + [i/= .nat .int (r@map (i/% +1,000,000) r.int)] + [n/= .int .nat (r@map (n/% 1,000,000) r.nat)] + [i/= .int-to-frac .frac-to-int (r@map (i/% +1,000,000) r.int)] + [f/= .frac-to-int .int-to-frac (r@map (|>> (i/% +1,000,000) .int-to-frac) r.int)] + [r/= .rev-to-frac .frac-to-rev frac-rev] + ))))) + (<| (_.context "Prelude macros.") + ..prelude-macros) + (<| (_.context "Templates.") + ..template) + (<| (_.context "Cross-platform support.") + ..cross-platform-support) + /cli.test + /io.test + (<| (_.context "/control") + /control.test) + (<| (_.context "/data") + /data.test) + /macro.test + (<| (_.context "/math") + /math.test) + (<| (_.context "/time") + /time.test) + /type.test + /world.test + (<| (_.context "/host Host-platform interoperation") + ($_ _.and + /host.test + (<| (_.context "/jvm JVM (Java Virtual Machine)") + /host/jvm.test))) + ))) (program: args (<| io _.run! - (_.times 100) + ## (_.times 100) + (_.seed 4035274984803317370) ..test)) diff --git a/stdlib/source/test/lux/control/enum.lux b/stdlib/source/test/lux/control/enum.lux index 030dee037..5c7832260 100644 --- a/stdlib/source/test/lux/control/enum.lux +++ b/stdlib/source/test/lux/control/enum.lux @@ -10,19 +10,19 @@ {1 ["." / (#+ Enum)]}) -(def: #export (spec (^open "_@.") gen-sample) +(def: #export (spec (^open "/@.") gen-sample) (All [a] (-> (Enum a) (Random a) Test)) (do r.monad [sample gen-sample] (<| (_.context (%name (name-of /.Order))) ($_ _.and (_.test "Successor and predecessor are inverse functions." - (and (_@= (|> sample _@succ _@pred) + (and (/@= (|> sample /@succ /@pred) (function.identity sample)) - (_@= (|> sample _@pred _@succ) + (/@= (|> sample /@pred /@succ) (function.identity sample)) - (not (_@= (|> sample _@succ) + (not (/@= (|> sample /@succ) (function.identity sample))) - (not (_@= (|> sample _@pred) + (not (/@= (|> sample /@pred) (function.identity sample))))) )))) diff --git a/stdlib/source/test/lux/control/number.lux b/stdlib/source/test/lux/control/number.lux index c1ffb0075..57bee6ee3 100644 --- a/stdlib/source/test/lux/control/number.lux +++ b/stdlib/source/test/lux/control/number.lux @@ -13,35 +13,35 @@ [// [order (#+ Order)]]]}) -(def: #export (spec (^open "_@.") (^open "_@.") gen-sample) +(def: #export (spec (^open "/@.") (^open "/@.") gen-sample) (All [a] (-> (Order a) (Number a) (Random a) Test)) (do r.monad [#let [non-zero (r.filter (function (_ sample) - (|> sample (_@+ sample) (_@= sample) not)) + (|> sample (/@+ sample) (/@= sample) not)) gen-sample)] parameter non-zero subject non-zero] (<| (_.context (%name (name-of /.Number))) ($_ _.and (_.test "Addition and subtraction are inverse functions." - (|> subject (_@+ parameter) (_@- parameter) (_@= subject))) + (|> subject (/@+ parameter) (/@- parameter) (/@= subject))) (_.test "Multiplication and division are inverse functions." - (|> subject (_@* parameter) (_@/ parameter) (_@= subject))) + (|> subject (/@* parameter) (/@/ parameter) (/@= subject))) (_.test "Modulus fills all the information division misses." - (let [modulus (_@% parameter subject) - multiple (_@- modulus subject) - times (_@/ modulus multiple)] - (|> parameter (_@* times) (_@+ modulus) (_@= subject)))) + (let [modulus (/@% parameter subject) + multiple (/@- modulus subject) + factor (/@/ parameter multiple)] + (|> parameter (/@* factor) (/@+ modulus) (/@= subject)))) (_.test "Negation flips the sign of a number and mimics subtraction." - (let [unsigned? (_@= (_@signum parameter) - (_@signum (_@negate parameter)))] + (let [unsigned? (/@= (/@signum parameter) + (/@signum (/@negate parameter)))] (or unsigned? - (_@= (_@+ (_@negate parameter) subject) - (_@- parameter subject))))) + (/@= (/@+ (/@negate parameter) subject) + (/@- parameter subject))))) (_.test "The absolute value is always positive." - (let [unsigned? (_@= (_@abs parameter) - (_@abs (_@negate parameter)))] + (let [unsigned? (/@= parameter + (/@negate parameter))] (if unsigned? - (_@= subject (_@abs subject)) - (_@>= subject (_@abs subject))))) + (/@= subject (/@abs subject)) + (/@>= subject (/@abs subject))))) )))) diff --git a/stdlib/source/test/lux/data/collection/row.lux b/stdlib/source/test/lux/data/collection/row.lux index cf678e0b4..1fa55e135 100644 --- a/stdlib/source/test/lux/data/collection/row.lux +++ b/stdlib/source/test/lux/data/collection/row.lux @@ -25,9 +25,9 @@ (def: #export test Test - (<| (_.context (%name (name-of /.Row))) + (<| (_.context (%name (name-of /._))) (do r.monad - [size (|> r.nat (:: @ map (|>> (n/% 100) (n/max 1))))] + [size (|> r.nat (:: @ map (|>> (n/% 100) (n/max 10))))] ($_ _.and ($equivalence.spec (/.equivalence nat.equivalence) (r.row size r.nat)) ($monoid.spec (/.equivalence nat.equivalence) /.monoid (r.row size r.nat)) @@ -43,34 +43,38 @@ non-member (|> r.nat (r.filter (|>> (/.member? nat.equivalence sample) not))) #let [(^open "/@.") (/.equivalence nat.equivalence)]] ($_ _.and - (_.test "Can query size of row." + (_.test (format (%name (name-of /.size)) + " " (%name (name-of /.empty?))) (if (/.empty? sample) (and (n/= 0 size) (n/= 0 (/.size sample))) (n/= size (/.size sample)))) - (_.test "Can add and remove elements to rows." + (_.test (format (%name (name-of /.add)) + " " (%name (name-of /.pop))) (and (n/= (inc size) (/.size (/.add non-member sample))) (n/= (dec size) (/.size (/.pop sample))))) - (_.test "Can put and get elements into rows." + (_.test (format (%name (name-of /.put)) + " " (%name (name-of /.nth))) (|> sample (/.put idx non-member) (/.nth idx) maybe.assume (is? non-member))) - (_.test "Can update elements of rows." + (_.test (%name (name-of /.update)) (|> sample (/.put idx non-member) (/.update idx inc) (/.nth idx) maybe.assume (n/= (inc non-member)))) - (_.test "Can safely transform to/from lists." + (_.test (format (%name (name-of /.to-list)) + " " (%name (name-of /.from-list))) (|> sample /.to-list /.from-list (/@= sample))) - (_.test "Can identify members of a row." + (_.test (%name (name-of /.member?)) (and (not (/.member? nat.equivalence sample non-member)) (/.member? nat.equivalence (/.add non-member sample) non-member))) - (_.test "Can reverse." + (_.test (%name (name-of /.reverse)) (and (not (/@= sample (/.reverse sample))) - (not (/@= sample - (/.reverse (/.reverse sample)))))) + (/@= sample + (/.reverse (/.reverse sample))))) )) )))) diff --git a/stdlib/source/test/lux/data/collection/stack.lux b/stdlib/source/test/lux/data/collection/stack.lux index 0a6fcf698..2886fa815 100644 --- a/stdlib/source/test/lux/data/collection/stack.lux +++ b/stdlib/source/test/lux/data/collection/stack.lux @@ -28,7 +28,7 @@ (def: #export test Test - (<| (_.context (%name (name-of /.Stack))) + (<| (_.context (%name (name-of /._))) (do r.monad [size gen-nat sample (r.stack size gen-nat) @@ -37,14 +37,13 @@ ($equivalence.spec (/.equivalence nat.equivalence) (r.stack size r.nat)) ($functor.spec ..injection /.equivalence /.functor) - (_.test "Can query the size of a stack." + (_.test (%name (name-of /.size)) (n/= size (/.size sample))) - (_.test "Can peek inside non-empty stacks." + (_.test (%name (name-of /.peek)) (case (/.peek sample) #.None (/.empty? sample) (#.Some _) (not (/.empty? sample)))) - (_.test (format "Popping empty stacks doesn't change anything." - "But, if they're non-empty, the top of the stack is removed.") + (_.test (%name (name-of /.pop)) (case (/.size sample) 0 (case (/.pop sample) #.None @@ -54,12 +53,12 @@ false) expected (case (/.pop sample) (#.Some sample') - (and (n/= expected (/.size sample')) + (and (n/= (dec expected) (/.size sample')) (not (/.empty? sample))) #.None false))) - (_.test "Pushing onto a stack always increases it by 1, adding a new value at the top." + (_.test (%name (name-of /.push)) (and (is? sample (|> sample (/.push new-top) /.pop maybe.assume)) (n/= (inc (/.size sample)) diff --git a/stdlib/source/test/lux/data/number/complex.lux b/stdlib/source/test/lux/data/number/complex.lux index 278e8ec58..19db6081d 100644 --- a/stdlib/source/test/lux/data/number/complex.lux +++ b/stdlib/source/test/lux/data/number/complex.lux @@ -56,7 +56,6 @@ (let [r+i (/.complex real imaginary)] (and (f/= real (get@ #/.real r+i)) (f/= imaginary (get@ #/.imaginary r+i))))) - (_.test "If either the real part or the imaginary part is NaN, the composite is NaN." (and (/.not-a-number? (/.complex frac.not-a-number imaginary)) (/.not-a-number? (/.complex real frac.not-a-number)))) @@ -73,11 +72,9 @@ abs (get@ #/.real (/.abs r+i))] (and (f/>= (frac@abs real) abs) (f/>= (frac@abs imaginary) abs)))) - (_.test "The absolute value of a complex number involving a NaN on either dimension, results in a NaN value." (and (frac.not-a-number? (get@ #/.real (/.abs (/.complex frac.not-a-number imaginary)))) (frac.not-a-number? (get@ #/.real (/.abs (/.complex real frac.not-a-number)))))) - (_.test "The absolute value of a complex number involving an infinity on either dimension, results in an infinite value." (and (f/= frac.positive-infinity (get@ #/.real (/.abs (/.complex frac.positive-infinity imaginary)))) (f/= frac.positive-infinity (get@ #/.real (/.abs (/.complex real frac.positive-infinity)))) @@ -99,7 +96,6 @@ (get@ #/.real x)) (f/+ (get@ #/.imaginary y) (get@ #/.imaginary x))))))) - (_.test "Subtracting 2 complex numbers is the same as adding their parts." (let [z (/.- y x)] (and (/.= z @@ -107,17 +103,13 @@ (get@ #/.real x)) (f/- (get@ #/.imaginary y) (get@ #/.imaginary x))))))) - (_.test "Subtraction is the inverse of addition." (and (|> x (/.+ y) (/.- y) (within? margin-of-error x)) (|> x (/.- y) (/.+ y) (within? margin-of-error x)))) - (_.test "Division is the inverse of multiplication." (|> x (/.* y) (/./ y) (within? margin-of-error x))) - (_.test "Scalar division is the inverse of scalar multiplication." (|> x (/.*' factor) (/./' factor) (within? margin-of-error x))) - (_.test "If you subtract the remainder, all divisions must be exact." (let [rem (/.% y x) quotient (|> x (/.- rem) (/./ y)) @@ -140,25 +132,20 @@ (get@ #/.real cx)) (f/= (frac@negate (get@ #/.imaginary x)) (get@ #/.imaginary cx))))) - (_.test "The reciprocal functions is its own inverse." (|> x /.reciprocal /.reciprocal (within? margin-of-error x))) - (_.test "x*(x^-1) = 1" (|> x (/.* (/.reciprocal x)) (within? margin-of-error /.one))) - (_.test "Absolute value of signum is always root2(2), 1 or 0." (let [signum-abs (|> x /.signum /.abs (get@ #/.real))] (or (f/= +0.0 signum-abs) (f/= +1.0 signum-abs) (f/= (math.pow +0.5 +2.0) signum-abs)))) - (_.test "Negation is its own inverse." (let [there (/.negate x) back-again (/.negate there)] (and (not (/.= there x)) (/.= back-again x)))) - (_.test "Negation doesn't change the absolute value." (f/= (get@ #/.real (/.abs x)) (get@ #/.real (/.abs (/.negate x))))) @@ -178,10 +165,8 @@ ($_ _.and (_.test "Arc-sine is the inverse of sine." (trigonometric-symmetry /.sin /.asin angle)) - (_.test "Arc-cosine is the inverse of cosine." (trigonometric-symmetry /.cos /.acos angle)) - (_.test "Arc-tangent is the inverse of tangent." (trigonometric-symmetry /.tan /.atan angle)))))) @@ -192,7 +177,6 @@ ($_ _.and (_.test "Root 2 is inverse of power 2." (|> x (/.pow' +2.0) (/.pow' +0.5) (within? margin-of-error x))) - (_.test "Logarithm is inverse of exponentiation." (|> x /.log /.exp (within? margin-of-error x))) ))) @@ -210,12 +194,13 @@ (def: #export test Test - ($_ _.and - ..construction - ..absolute-value - ..number - ..conjugate&reciprocal&signum&negation - ..trigonometry - ..exponentiation&logarithm - ..root - )) + (<| (_.context (%name (name-of /._))) + ($_ _.and + ..construction + ..absolute-value + ..number + ..conjugate&reciprocal&signum&negation + ..trigonometry + ..exponentiation&logarithm + ..root + ))) diff --git a/stdlib/source/test/lux/data/number/frac.lux b/stdlib/source/test/lux/data/number/frac.lux index 319debddd..87b937a93 100644 --- a/stdlib/source/test/lux/data/number/frac.lux +++ b/stdlib/source/test/lux/data/number/frac.lux @@ -9,8 +9,6 @@ ["$." equivalence] ["$." order] ["$." number] - ["$." enum] - ["$." interval] ["$." monoid] ["$." codec]]}] [math @@ -21,40 +19,35 @@ (def: #export test Test - (<| (_.context (%name (name-of .Frac))) - ($_ _.and - ($equivalence.spec /.equivalence r.frac) - ($order.spec /.order r.frac) - ($number.spec /.order /.number r.frac) - ($enum.spec /.enum r.frac) - ($interval.spec /.interval r.frac) - (<| (_.context "Addition.") - ($monoid.spec /.equivalence /.addition r.frac)) - (<| (_.context "Multiplication.") - ($monoid.spec /.equivalence /.multiplication r.frac)) - (<| (_.context "Minimum.") - ($monoid.spec /.equivalence /.minimum r.frac)) - (<| (_.context "Maximum.") - ($monoid.spec /.equivalence /.multiplication r.frac)) - ## TODO: Uncomment ASAP - ## (<| (_.context "Binary.") - ## ($codec.spec /.equivalence /.binary r.frac)) - ## (<| (_.context "Octal.") - ## ($codec.spec /.equivalence /.octal r.frac)) - ## (<| (_.context "Decimal.") - ## ($codec.spec /.equivalence /.decimal r.frac)) - ## (<| (_.context "Hexadecimal.") - ## ($codec.spec /.equivalence /.hex r.frac)) + (let [gen-frac (:: r.monad map (|>> (i/% +100) .int-to-frac) r.int)] + (<| (_.context (%name (name-of /._))) + (`` ($_ _.and + ($equivalence.spec /.equivalence gen-frac) + ($order.spec /.order gen-frac) + ($number.spec /.order /.number gen-frac) + (~~ (do-template [<monoid>] + [(<| (_.context (%name (name-of <monoid>))) + ($monoid.spec /.equivalence <monoid> gen-frac))] - (_.test "Alternate notations." - (and (f/= (bin "+1100.1001") - (bin "+11,00.10,01")) - (f/= (oct "-6152.43") - (oct "-615,2.43")) - (f/= (hex "+deadBE.EF") - (hex "+dead,BE.EF")))) - (do r.monad - [sample r.frac] - (_.test "Can convert frac values to/from their bit patterns." - (|> sample /.frac-to-bits /.bits-to-frac (f/= sample)))) - ))) + [/.addition] [/.multiplication] [/.minimum] [/.maximum] + )) + ## TODO: Uncomment ASAP + ## (~~ (do-template [<codec>] + ## [(<| (_.context (%name (name-of /.binary))) + ## ($codec.spec /.equivalence <codec> gen-frac))] + + ## [/.binary] [/.octal] [/.decimal] [/.hex] + ## )) + + (_.test "Alternate notations." + (and (f/= (bin "+1100.1001") + (bin "+11,00.10,01")) + (f/= (oct "-6152.43") + (oct "-615,2.43")) + (f/= (hex "+deadBE.EF") + (hex "+dead,BE.EF")))) + (do r.monad + [sample gen-frac] + (_.test (format (%name (name-of /.frac-to-bits)) " " (%name (name-of /.bits-to-frac))) + (|> sample /.frac-to-bits /.bits-to-frac (f/= sample)))) + ))))) diff --git a/stdlib/source/test/lux/data/number/i64.lux b/stdlib/source/test/lux/data/number/i64.lux index 1eb207e19..3e251d1e6 100644 --- a/stdlib/source/test/lux/data/number/i64.lux +++ b/stdlib/source/test/lux/data/number/i64.lux @@ -16,68 +16,69 @@ (def: #export test Test - (do r.monad - [pattern r.nat - idx (:: @ map (n/% /.width) r.nat)] - ($_ _.and - ($monoid.spec //nat.equivalence /.disjunction r.nat) - ($monoid.spec //nat.equivalence /.conjunction r.nat) - - (_.test "Clearing and settings bits should alter the count." - (and (n/= (dec (/.count (/.set idx pattern))) - (/.count (/.clear idx pattern))) - (|> (/.count pattern) - (n/- (/.count (/.clear idx pattern))) - (n/<= 1)) - (|> (/.count (/.set idx pattern)) - (n/- (/.count pattern)) - (n/<= 1)))) - (_.test "Can query whether a bit is set." - (and (or (and (/.set? idx pattern) - (not (/.set? idx (/.clear idx pattern)))) - (and (not (/.set? idx pattern)) - (/.set? idx (/.set idx pattern)))) + (<| (_.context (%name (name-of /._))) + (do r.monad + [pattern r.nat + idx (:: @ map (n/% /.width) r.nat)] + ($_ _.and + ($monoid.spec //nat.equivalence /.disjunction r.nat) + ($monoid.spec //nat.equivalence /.conjunction r.nat) + + (_.test "Clearing and settings bits should alter the count." + (and (n/= (dec (/.count (/.set idx pattern))) + (/.count (/.clear idx pattern))) + (|> (/.count pattern) + (n/- (/.count (/.clear idx pattern))) + (n/<= 1)) + (|> (/.count (/.set idx pattern)) + (n/- (/.count pattern)) + (n/<= 1)))) + (_.test "Can query whether a bit is set." + (and (or (and (/.set? idx pattern) + (not (/.set? idx (/.clear idx pattern)))) + (and (not (/.set? idx pattern)) + (/.set? idx (/.set idx pattern)))) - (or (and (/.set? idx pattern) - (not (/.set? idx (/.flip idx pattern)))) - (and (not (/.set? idx pattern)) - (/.set? idx (/.flip idx pattern)))))) - (_.test "The negation of a bit pattern should have a complementary bit-count." - (n/= /.width - (n/+ (/.count pattern) - (/.count (/.not pattern))))) - (_.test "Can do simple binary logic." - (and (n/= 0 - (/.and pattern - (/.not pattern))) - (n/= (/.not 0) - (/.or pattern - (/.not pattern))) - (n/= (/.not 0) - (/.xor pattern - (/.not pattern))) - (n/= 0 - (/.xor pattern - pattern)))) - (_.test "rotate-left and rotate-right are inverses of one another." - (and (|> pattern - (/.rotate-left idx) - (/.rotate-right idx) - (n/= pattern)) - (|> pattern - (/.rotate-right idx) - (/.rotate-left idx) - (n/= pattern)))) - (_.test "Rotate as many spaces as the bit-pattern's width leaves the pattern unchanged." - (and (|> pattern - (/.rotate-left /.width) - (n/= pattern)) - (|> pattern - (/.rotate-right /.width) - (n/= pattern)))) - (_.test "Shift right respect the sign of ints." - (let [value (.int pattern)] - (if (i/< +0 value) - (i/< +0 (/.arithmetic-right-shift idx value)) - (i/>= +0 (/.arithmetic-right-shift idx value))))) - ))) + (or (and (/.set? idx pattern) + (not (/.set? idx (/.flip idx pattern)))) + (and (not (/.set? idx pattern)) + (/.set? idx (/.flip idx pattern)))))) + (_.test "The negation of a bit pattern should have a complementary bit-count." + (n/= /.width + (n/+ (/.count pattern) + (/.count (/.not pattern))))) + (_.test "Can do simple binary logic." + (and (n/= 0 + (/.and pattern + (/.not pattern))) + (n/= (/.not 0) + (/.or pattern + (/.not pattern))) + (n/= (/.not 0) + (/.xor pattern + (/.not pattern))) + (n/= 0 + (/.xor pattern + pattern)))) + (_.test "rotate-left and rotate-right are inverses of one another." + (and (|> pattern + (/.rotate-left idx) + (/.rotate-right idx) + (n/= pattern)) + (|> pattern + (/.rotate-right idx) + (/.rotate-left idx) + (n/= pattern)))) + (_.test "Rotate as many spaces as the bit-pattern's width leaves the pattern unchanged." + (and (|> pattern + (/.rotate-left /.width) + (n/= pattern)) + (|> pattern + (/.rotate-right /.width) + (n/= pattern)))) + (_.test "Shift right respect the sign of ints." + (let [value (.int pattern)] + (if (i/< +0 value) + (i/< +0 (/.arithmetic-right-shift idx value)) + (i/>= +0 (/.arithmetic-right-shift idx value))))) + )))) diff --git a/stdlib/source/test/lux/data/number/int.lux b/stdlib/source/test/lux/data/number/int.lux index e83571653..b9ed4f856 100644 --- a/stdlib/source/test/lux/data/number/int.lux +++ b/stdlib/source/test/lux/data/number/int.lux @@ -21,35 +21,31 @@ (def: #export test Test - (<| (_.context (%name (name-of .Int))) - ($_ _.and - ($equivalence.spec /.equivalence r.int) - ($order.spec /.order r.int) - ($number.spec /.order /.number r.int) - ($enum.spec /.enum r.int) - ($interval.spec /.interval r.int) - (<| (_.context "Addition.") - ($monoid.spec /.equivalence /.addition r.int)) - (<| (_.context "Multiplication.") - ($monoid.spec /.equivalence /.multiplication r.int)) - (<| (_.context "Minimum.") - ($monoid.spec /.equivalence /.minimum r.int)) - (<| (_.context "Maximum.") - ($monoid.spec /.equivalence /.multiplication r.int)) - (<| (_.context "Binary.") - ($codec.spec /.equivalence /.binary r.int)) - (<| (_.context "Octal.") - ($codec.spec /.equivalence /.octal r.int)) - (<| (_.context "Decimal.") - ($codec.spec /.equivalence /.decimal r.int)) - (<| (_.context "Hexadecimal.") - ($codec.spec /.equivalence /.hex r.int)) + (<| (_.context (%name (name-of /._))) + (`` ($_ _.and + ($equivalence.spec /.equivalence r.int) + ($order.spec /.order r.int) + ($number.spec /.order /.number (:: r.monad map (i/% +1,000,000) r.int)) + ($enum.spec /.enum r.int) + ($interval.spec /.interval r.int) + (~~ (do-template [<monoid>] + [(<| (_.context (%name (name-of <monoid>))) + ($monoid.spec /.equivalence <monoid> r.int))] - (_.test "Alternate notations." - (and (i/= (bin "+11001001") - (bin "+11,00,10,01")) - (i/= (oct "-615243") - (oct "-615,243")) - (i/= (hex "+deadBEEF") - (hex "+dead,BEEF")))) - ))) + [/.addition] [/.multiplication] [/.minimum] [/.maximum] + )) + (~~ (do-template [<codec>] + [(<| (_.context (%name (name-of /.binary))) + ($codec.spec /.equivalence <codec> r.int))] + + [/.binary] [/.octal] [/.decimal] [/.hex] + )) + + (_.test "Alternate notations." + (and (i/= (bin "+11001001") + (bin "+11,00,10,01")) + (i/= (oct "-615243") + (oct "-615,243")) + (i/= (hex "+deadBEEF") + (hex "+dead,BEEF")))) + )))) diff --git a/stdlib/source/test/lux/data/number/nat.lux b/stdlib/source/test/lux/data/number/nat.lux index e570de094..17ee0503b 100644 --- a/stdlib/source/test/lux/data/number/nat.lux +++ b/stdlib/source/test/lux/data/number/nat.lux @@ -21,35 +21,31 @@ (def: #export test Test - (<| (_.context (%name (name-of .Nat))) - ($_ _.and - ($equivalence.spec /.equivalence r.nat) - ($order.spec /.order r.nat) - ($number.spec /.order /.number r.nat) - ($enum.spec /.enum r.nat) - ($interval.spec /.interval r.nat) - (<| (_.context "Addition.") - ($monoid.spec /.equivalence /.addition r.nat)) - (<| (_.context "Multiplication.") - ($monoid.spec /.equivalence /.multiplication r.nat)) - (<| (_.context "Minimum.") - ($monoid.spec /.equivalence /.minimum r.nat)) - (<| (_.context "Maximum.") - ($monoid.spec /.equivalence /.multiplication r.nat)) - (<| (_.context "Binary.") - ($codec.spec /.equivalence /.binary r.nat)) - (<| (_.context "Octal.") - ($codec.spec /.equivalence /.octal r.nat)) - (<| (_.context "Decimal.") - ($codec.spec /.equivalence /.decimal r.nat)) - (<| (_.context "Hexadecimal.") - ($codec.spec /.equivalence /.hex r.nat)) + (<| (_.context (%name (name-of /._))) + (`` ($_ _.and + ($equivalence.spec /.equivalence r.nat) + ($order.spec /.order r.nat) + ($number.spec /.order /.number (:: r.monad map (n/% 1,000,000) r.nat)) + ($enum.spec /.enum r.nat) + ($interval.spec /.interval r.nat) + (~~ (do-template [<monoid>] + [(<| (_.context (%name (name-of <monoid>))) + ($monoid.spec /.equivalence <monoid> r.nat))] - (_.test "Alternate notations." - (and (n/= (bin "11001001") - (bin "11,00,10,01")) - (n/= (oct "615243") - (oct "615,243")) - (n/= (hex "deadBEEF") - (hex "dead,BEEF")))) - ))) + [/.addition] [/.multiplication] [/.minimum] [/.maximum] + )) + (~~ (do-template [<codec>] + [(<| (_.context (%name (name-of /.binary))) + ($codec.spec /.equivalence <codec> r.nat))] + + [/.binary] [/.octal] [/.decimal] [/.hex] + )) + + (_.test "Alternate notations." + (and (n/= (bin "11001001") + (bin "11,00,10,01")) + (n/= (oct "615243") + (oct "615,243")) + (n/= (hex "deadBEEF") + (hex "dead,BEEF")))) + )))) diff --git a/stdlib/source/test/lux/data/number/ratio.lux b/stdlib/source/test/lux/data/number/ratio.lux index 654c489c3..5b74956c4 100644 --- a/stdlib/source/test/lux/data/number/ratio.lux +++ b/stdlib/source/test/lux/data/number/ratio.lux @@ -9,6 +9,7 @@ ["$." equivalence] ["$." order] ["$." number] + ["$." monoid] ["$." codec]]}] [math ["r" random (#+ Random)]]] @@ -17,30 +18,35 @@ (def: part (Random Nat) - (|> r.nat (:: r.monad map (|>> (n/% 1000) (n/max 1))))) + (|> r.nat (:: r.monad map (|>> (n/% 1,000,000) (n/max 1))))) (def: #export ratio (Random Ratio) (do r.monad [numerator ..part - denominator (|> ..part - (r.filter (|>> (n/= 0) not)) - (r.filter (|>> (n/= numerator) not)))] + denominator (r.filter (|>> (n/= 0) not) ..part)] (wrap (/.ratio numerator denominator)))) (def: #export test Test - (do r.monad - [denom0 ..part - denom1 ..part] - ($_ _.and - ($equivalence.spec /.equivalence ..ratio) - ($order.spec /.order ..ratio) - ($number.spec /.order /.number ..ratio) - ($codec.spec /.equivalence /.codec ..ratio) + (<| (_.context (%name (name-of /._))) + (`` ($_ _.and + ($equivalence.spec /.equivalence ..ratio) + ($order.spec /.order ..ratio) + ($number.spec /.order /.number ..ratio) + (~~ (do-template [<monoid>] + [(<| (_.context (%name (name-of <monoid>))) + ($monoid.spec /.equivalence <monoid> ..ratio))] + + [/.addition] [/.multiplication] + )) + ($codec.spec /.equivalence /.codec ..ratio) - (_.test "All zeroes are the same." - (let [(^open "/@.") /.equivalence] - (/@= (/.ratio 0 denom0) - (/.ratio 0 denom1)))) - ))) + (do r.monad + [denom0 ..part + denom1 ..part] + (_.test "All zeroes are the same." + (let [(^open "/@.") /.equivalence] + (/@= (/.ratio 0 denom0) + (/.ratio 0 denom1))))) + )))) diff --git a/stdlib/source/test/lux/data/number/rev.lux b/stdlib/source/test/lux/data/number/rev.lux index 427ce4edf..dba639ae9 100644 --- a/stdlib/source/test/lux/data/number/rev.lux +++ b/stdlib/source/test/lux/data/number/rev.lux @@ -13,6 +13,10 @@ ["$." interval] ["$." monoid] ["$." codec]]}] + [data + ["." error] + [number + ["." i64]]] [math ["r" random]]] {1 @@ -21,35 +25,29 @@ (def: #export test Test - (<| (_.context (%name (name-of .Rev))) - ($_ _.and - ($equivalence.spec /.equivalence r.rev) - ($order.spec /.order r.rev) - ($number.spec /.order /.number r.rev) - ($enum.spec /.enum r.rev) - ($interval.spec /.interval r.rev) - (<| (_.context "Addition.") - ($monoid.spec /.equivalence /.addition r.rev)) - (<| (_.context "Multiplication.") - ($monoid.spec /.equivalence /.multiplication r.rev)) - (<| (_.context "Minimum.") - ($monoid.spec /.equivalence /.minimum r.rev)) - (<| (_.context "Maximum.") - ($monoid.spec /.equivalence /.multiplication r.rev)) - (<| (_.context "Binary.") - ($codec.spec /.equivalence /.binary r.rev)) - (<| (_.context "Octal.") - ($codec.spec /.equivalence /.octal r.rev)) - (<| (_.context "Decimal.") - ($codec.spec /.equivalence /.decimal r.rev)) - (<| (_.context "Hexadecimal.") - ($codec.spec /.equivalence /.hex r.rev)) + (<| (_.context (%name (name-of /._))) + (`` ($_ _.and + ($equivalence.spec /.equivalence r.rev) + ($order.spec /.order r.rev) + ($enum.spec /.enum r.rev) + ($interval.spec /.interval r.rev) + (~~ (do-template [<monoid>] + [(<| (_.context (%name (name-of <monoid>))) + ($monoid.spec /.equivalence <monoid> r.rev))] - (_.test "Alternate notations." - (and (r/= (bin ".11001001") - (bin ".11,00,10,01")) - (r/= (oct ".615243") - (oct ".615,243")) - (r/= (hex ".deadBEEF") - (hex ".dead,BEEF")))) - ))) + [/.addition] [/.minimum] [/.maximum] + )) + (~~ (do-template [<codec>] + [(<| (_.context (%name (name-of /.binary))) + ($codec.spec /.equivalence <codec> r.rev))] + + [/.binary] [/.octal] [/.decimal] [/.hex] + )) + (_.test "Alternate notations." + (and (r/= (bin ".11001001") + (bin ".11,00,10,01")) + (r/= (oct ".615243") + (oct ".615,243")) + (r/= (hex ".deadBEEF") + (hex ".dead,BEEF")))) + )))) |