aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/test
diff options
context:
space:
mode:
authorEduardo Julian2019-03-29 22:58:33 -0400
committerEduardo Julian2019-03-29 22:58:33 -0400
commit6bb6029f426ecb2da772f6f9c70cdb81c897f0db (patch)
tree0e33d20265838704b9c2be556f9c09c86e86b4da /stdlib/source/test
parenta869f51e0ea3fe0c224de1188ad5bbd5db080f47 (diff)
Fixed more tests.
Diffstat (limited to 'stdlib/source/test')
-rw-r--r--stdlib/source/test/lux.lux140
-rw-r--r--stdlib/source/test/lux/control/enum.lux10
-rw-r--r--stdlib/source/test/lux/control/number.lux32
-rw-r--r--stdlib/source/test/lux/data/collection/row.lux26
-rw-r--r--stdlib/source/test/lux/data/collection/stack.lux13
-rw-r--r--stdlib/source/test/lux/data/number/complex.lux35
-rw-r--r--stdlib/source/test/lux/data/number/frac.lux69
-rw-r--r--stdlib/source/test/lux/data/number/i64.lux129
-rw-r--r--stdlib/source/test/lux/data/number/int.lux58
-rw-r--r--stdlib/source/test/lux/data/number/nat.lux58
-rw-r--r--stdlib/source/test/lux/data/number/ratio.lux40
-rw-r--r--stdlib/source/test/lux/data/number/rev.lux60
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"))))
+ ))))