diff options
Diffstat (limited to 'stdlib/source/test/lux/data')
| -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 |
9 files changed, 233 insertions, 255 deletions
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")))) + )))) |