diff options
author | Eduardo Julian | 2019-01-30 09:28:51 -0400 |
---|---|---|
committer | Eduardo Julian | 2019-01-30 09:28:51 -0400 |
commit | b6202d7091965f9b4785ef6722fca31474c6c98f (patch) | |
tree | 3e0791d1afbfb6bb9b7725a3aa5bab3e63b1923d /stdlib | |
parent | a8851787291a0dcf41e28da829299c9102a15643 (diff) |
Tests are now first class.
Diffstat (limited to '')
-rw-r--r-- | stdlib/source/lux/test.lux | 308 | ||||
-rw-r--r-- | stdlib/test/test/lux.lux | 418 | ||||
-rw-r--r-- | stdlib/test/tests.lux | 24 |
3 files changed, 339 insertions, 411 deletions
diff --git a/stdlib/source/lux/test.lux b/stdlib/source/lux/test.lux index ea4e9b6de..f0ab87249 100644 --- a/stdlib/source/lux/test.lux +++ b/stdlib/source/lux/test.lux @@ -1,267 +1,161 @@ (.module: {#.doc "Tools for unit & property-based/generative testing."} - [lux #* + [lux (#- and) [control - ["." monad (#+ do Monad)] - ["p" parser] + ["." monad (#+ Monad do)] + ["ex" exception (#+ exception:)] [concurrency - ["." process] - ["." promise (#+ Promise)]]] + ["." promise (#+ Promise) ("promise/." Monad<Promise>)]]] [data ["." product] - ["." maybe] - ["e" error] ["." text format] [collection - ["." list ("list/." Monad<List> Fold<List>)]]] + ["." list ("list/." Functor<List>)]]] [time ["." instant] ["." duration]] [math - ["r" random]] - ["." macro (#+ with-gensyms) - ["s" syntax (#+ syntax: Syntax)] - ["." code]] - ["." io (#+ IO io)]]) + ["r" random ("random/." Monad<Random>)]] + ["." io]]) -## [Types] -(type: #export Counters [Nat Nat]) +(type: #export Counters + {#successes Nat + #failures Nat}) -(type: #export Seed - {#.doc "The seed value used for random testing (if that feature is used)."} - (I64 Any)) +(def: (add-counters parameter subject) + (-> Counters Counters Counters) + {#successes (n/+ (get@ #successes parameter) (get@ #successes subject)) + #failures (n/+ (get@ #failures parameter) (get@ #failures subject))}) + +(def: start + Counters + {#successes 0 + #failures 0}) + +(do-template [<name> <category>] + [(def: <name> Counters (update@ <category> .inc start))] + + [success #successes] + [failure #failures] + ) (type: #export Test (r.Random (Promise [Counters Text]))) -(def: pcg-32-magic-inc Nat 12345) +(def: separator text.new-line) -## [Values] -(def: success Counters [1 0]) -(def: failure Counters [0 1]) -(def: start Counters [0 0]) +(def: #export (and left right) + {#.doc "Sequencing combinator."} + (-> Test Test Test) + (do r.Monad<Random> + [left left + right right] + (wrap (do promise.Monad<Promise> + [[l-counter l-documentation] left + [r-counter r-documentation] right] + (wrap [(add-counters l-counter r-counter) + (format l-documentation ..separator r-documentation)]))))) -(def: (add-counters [s f] [ts tf]) - (-> Counters Counters Counters) - [(n/+ s ts) (n/+ f tf)]) +(def: context-prefix text.tab) + +(def: #export (context description) + (-> Text Test Test) + (random/map (promise/map (function (_ [counters documentation]) + [counters (|> documentation + (text.split-all-with ..separator) + (list/map (|>> (format context-prefix))) + (text.join-with ..separator) + (format description ..separator))])))) + +(def: failure-prefix " [Error] ") +(def: success-prefix "[Success] ") -(def: #export (fail message) - (All [a] (-> Text Test)) - (|> [failure (format " [Error] " message)] - (:: promise.Monad<Promise> wrap) - (:: r.Monad<Random> wrap))) +(def: #export fail + (-> Text Test) + (|>> (format ..failure-prefix) + [failure] + promise/wrap + random/wrap)) (def: #export (assert message condition) {#.doc "Check that a condition is #1, and fail with the given message otherwise."} (-> Text Bit (Promise [Counters Text])) - (<| (:: promise.Monad<Promise> wrap) + (<| promise/wrap (if condition - [success (format "[Success] " message)] - [failure (format " [Error] " message)]))) + [success (format ..success-prefix message)] + [failure (format ..failure-prefix message)]))) (def: #export (test message condition) {#.doc "Check that a condition is #1, and fail with the given message otherwise."} (-> Text Bit Test) (:: r.Monad<Random> wrap (assert message condition))) -(def: (run' tests) - (-> (List [Text (IO Test) Text]) (Promise Counters)) - (do promise.Monad<Promise> - [test-runs (|> tests - (list/map (: (-> [Text (IO Test) Text] (Promise Counters)) - (function (_ [module test description]) - (do @ - [#let [pre (io.run instant.now)] - [counters documentation] (|> (io.run test) - (r.run (r.pcg-32 [pcg-32-magic-inc - (instant.to-millis pre)])) - product.right) - #let [post (io.run instant.now) - _ (log! (format "@ " module " " - "(" (%duration (instant.span pre post)) ")" - text.new-line - description text.new-line - text.new-line documentation text.new-line))]] - (wrap counters))))) - (monad.seq @))] - (wrap (list/fold add-counters start test-runs)))) +(def: pcg-32-magic-inc Nat 12345) -(def: failed? - (-> Counters Bit) - (|>> product.right (n/> 0))) +(type: #export Seed + {#.doc "The seed value used for random testing (if that feature is used)."} + Nat) (def: #export (seed value test) (-> Seed Test Test) (function (_ prng) - (let [[_ result] (r.run (r.pcg-32 [pcg-32-magic-inc value]) + (let [[_ result] (r.run (r.pcg-32 [..pcg-32-magic-inc value]) test)] [prng result]))) +(def: failed? + (-> Counters Bit) + (|>> product.right (n/> 0))) + (def: (times-failure seed documentation) - (-> (I64 Any) Text Text) - (format "Failed with this seed: " (%n (.nat seed)) text.new-line - documentation)) + (-> Seed Text Text) + (format documentation ..separator ..separator + "Failed with this seed: " (%n seed))) + +(exception: #export (must-try-test-at-least-once) "") (def: #export (times amount test) (-> Nat Test Test) (cond (n/= 0 amount) - (fail "Cannot try a test 0 times.") + (fail (ex.construct must-try-test-at-least-once [])) (n/= 1 amount) test ## else (do r.Monad<Random> - [seed r.i64] + [seed r.nat] (function (_ prng) - (let [[prng' instance] (r.run (r.pcg-32 [pcg-32-magic-inc seed]) test)] + (let [[prng' instance] (r.run (r.pcg-32 [..pcg-32-magic-inc seed]) test)] [prng' (do promise.Monad<Promise> [[counters documentation] instance] (if (failed? counters) (wrap [counters (times-failure seed documentation)]) (product.right (r.run prng' (times (dec amount) test)))))]))))) -## [Syntax] -(syntax: #export (context: description test) - {#.doc (doc "Macro for definint tests." - (context: "Simple macros and constructs" - ($_ seq - (test "Can write easy loops for iterative programming." - (i/= +1000 - (loop [counter +0 - value +1] - (if (i/< +3 counter) - (recur (inc counter) (i/* +10 value)) - value)))) - - (test "Can create lists easily through macros." - (and (case (list +1 +2 +3) - (#.Cons +1 (#.Cons +2 (#.Cons +3 #.Nil))) - #1 - - _ - #0) - - (case (list& +1 +2 +3 (list +4 +5 +6)) - (#.Cons +1 (#.Cons +2 (#.Cons +3 (#.Cons +4 (#.Cons +5 (#.Cons +6 #.Nil)))))) - #1 - - _ - #0))) - - (test "Can have defaults for Maybe values." - (and (is? "yolo" (maybe.default "yolo" - #.None)) - - (is? "lol" (maybe.default "yolo" - (#.Some "lol"))))) - )) - - "Also works with random generation of values for property-based testing." - (context: "Addition & Substraction" - (do @ - [x (:: @ map <prep> rand-gen) - y (:: @ map <prep> rand-gen)] - (test "" - (and (|> x (- y) (+ y) (= x)) - (|> x (+ y) (- y) (= x)))))) - - "By default, random tests will be tried 100 times, you can specify the amount you want:" - (context: "Addition & Substraction" - (<| (times 1234) - (do @ - [x (:: @ map <prep> rand-gen) - y (:: @ map <prep> rand-gen)] - (test "" - (and (|> x (- y) (+ y) (= x)) - (|> x (+ y) (- y) (= x))))))) - - "If a test fails, you'll be shown a seed that you can then use to reproduce a failing scenario." - (context: "Addition & Substraction" - (<| (seed 987654321) - (do @ - [x (:: @ map <prep> rand-gen) - y (:: @ map <prep> rand-gen)] - (test "" - (and (|> x (- y) (+ y) (= x)) - (|> x (+ y) (- y) (= x))))))) - )} - (with-gensyms [g!context g!test g!error] - (wrap (list (` (def: #export (~ g!context) - {#..test ((~! code.text) (~ description))} - (~! (IO Test)) - ((~! io) (case ("lux try" ((~! io) ((~! do) - (~! r.Monad<Random>) - [] - (~ test)))) - (#.Right (~ g!test)) - (~ g!test) - - (#.Left (~ g!error)) - (..fail (~ g!error)))))))))) - -(def: (exported-tests module-name) - (-> Text (Meta (List [Text Text Text]))) - (do macro.Monad<Meta> - [defs (macro.exports module-name)] - (wrap (|> defs - (list/map (function (_ [def-name [_ def-anns _]]) - (case (macro.get-text-ann (name-of #..test) def-anns) - (#.Some description) - [#1 module-name def-name description] +(def: (tally counters) + (-> Counters Text) + (let [successes (get@ #successes counters) + failures (get@ #failures counters)] + (ex.report ["Tests" (%n (n/+ successes failures))] + ["Successes" (%n successes)] + ["Failures" (%n failures)]))) - _ - [#0 module-name def-name ""]))) - (list.filter product.left) - (list/map product.right))))) +(def: failure-exit-code -1) +(def: success-exit-code +0) -(def: (success-message successes failures) - (-> Nat Nat Text) - (format "Test-suite finished." text.new-line - (%n successes) " out of " (%n (n/+ failures successes)) " tests passed." text.new-line - (%n failures) " tests failed." text.new-line)) - -(syntax: #export (run) - {#.doc (doc "Runs all the tests defined on the current module, and in all imported modules." - (run))} - (with-gensyms [g!successes g!failures g!total-successes g!total-failures] - (do @ - [current-module macro.current-module-name - modules (macro.imported-modules current-module) - tests (: (Meta (List [Text Text Text])) - (|> modules - (#.Cons current-module) - list.reverse - (monad.map @ exported-tests) - (:: @ map list/join)))] - (wrap (list (` (: (~! (IO Any)) - ((~! io) (exec ((~! do) (~! promise.Monad<Promise>) - [(~' #let) [(~ g!total-successes) 0 - (~ g!total-failures) 0] - (~+ (|> tests - (list/map (function (_ [module-name test desc]) - (` [(~ (code.text module-name)) (~ (code.identifier [module-name test])) (~ (code.text desc))]))) - (list.split-all process.parallelism) - (list/map (function (_ group) - (list (` [(~ g!successes) (~ g!failures)]) (` ((~! run') (list (~+ group)))) - (' #let) (` [(~ g!total-successes) (n/+ (~ g!successes) (~ g!total-successes)) - (~ g!total-failures) (n/+ (~ g!failures) (~ g!total-failures))])))) - list/join))] - (exec (log! ((~! success-message) (~ g!total-successes) (~ g!total-failures))) - ((~! promise.future) - ((~! io.exit) (if (n/> 0 (~ g!total-failures)) - +1 - +0))))) - []))))))))) - -(def: #export (seq left right) - {#.doc "Sequencing combinator."} - (-> Test Test Test) - (do r.Monad<Random> - [left left - right right] - (wrap (do promise.Monad<Promise> - [[l-counter l-documentation] left - [r-counter r-documentation] right] - (wrap [(add-counters l-counter r-counter) - (format l-documentation text.new-line r-documentation)]))))) +(def: #export (run! test) + (-> Test (Promise Nothing)) + (do promise.Monad<Promise> + [pre (promise.future instant.now) + #let [seed (instant.to-millis pre) + prng (r.pcg-32 [..pcg-32-magic-inc seed])] + [counters documentation] (|> test (r.run prng) product.right) + post (promise.future instant.now) + #let [duration (instant.span pre post) + _ (log! (format documentation text.new-line text.new-line + "(" (%duration duration) ")" text.new-line + (tally counters)))]] + (promise.future (io.exit (case (get@ #failures counters) + 0 ..success-exit-code + _ ..failure-exit-code))))) diff --git a/stdlib/test/test/lux.lux b/stdlib/test/test/lux.lux index 61a0299ea..0ed5cbc2a 100644 --- a/stdlib/test/test/lux.lux +++ b/stdlib/test/test/lux.lux @@ -1,208 +1,240 @@ (.module: [lux #* [control - [monad (#+ do)]] + [monad (#+ do)] + [predicate (#+ Predicate)]] [data ["." maybe] [number - ["." i64]] - [text ("text/." Equivalence<Text>) - format]] + ["." i64]]] ["." math - ["r" random]] - ["." macro - ["s" syntax (#+ syntax:)]] - test]) - -(context: "Value identity." - (<| (times 100) - (do @ - [size (|> r.nat (:: @ map (|>> (n/% 100) (n/max 10)))) - x (r.unicode size) - y (r.unicode size)] - ($_ seq - (test "Every value is identical to itself, and the 'id' function doesn't change values in any way." - (and (is? x x) - (is? x (id x)))) - - (test "Values created separately can't be identical." - (not (is? x y))) - )))) - -(do-template [category rand-gen even? odd? = < >] - [(context: (format "[" category "] " "Simple operations.") - (<| (times 100) - (do @ - [value rand-gen] - ($_ seq - (test (format "[" category "] " "Moving up-down or down-up should result in same value.") - (and (|> value inc dec (= value)) - (|> value dec inc (= value)))) - (test (format "[" category "] " "(x1) > x && (x-1) < x") - (and (|> value inc (> value)) - (|> value dec (< value)))) - (test (format "[" category "] " "Every odd/even number is surrounded by two of the other kind.") - (if (even? value) - (and (|> value inc odd?) - (|> value dec odd?)) - (and (|> value inc even?) - (|> value dec even?))))))))] - - ["Nat" r.nat n/even? n/odd? n/= n/< n/>] - ["Int" r.int i/even? i/odd? i/= i/< i/>] - ) - -(do-template [category rand-gen = < > <= >= min max] - [(context: (format "[" category "] " "(More) simple operations.") - (<| (times 100) - (do @ - [x rand-gen - y rand-gen] - (seq (test (format "[" category "] " "The symmetry of numerical comparisons.") - (or (= x y) - (if (< y x) - (> x y) - (< x y)))) - (test (format "[" category "] " "Minimums and maximums.") - (and (and (<= x (min x y)) - (<= y (min x y))) - (and (>= x (max x y)) - (>= y (max x y)))))))))] - - ["Int" r.int i/= i/< i/> i/<= i/>= i/min i/max] - ["Nat" r.nat n/= n/< n/> n/<= n/>= n/min n/max] - ["Frac" r.frac f/= f/< f/> f/<= f/>= f/min f/max] - ["Rev" r.rev r/= r/< r/> r/<= r/>= r/min r/max] - ) - -(do-template [category rand-gen = + - * / <%> > <0> <1> <factor> <cap> <prep>] - [(context: (format "[" category "] " "Additive identity") - (<| (times 100) - (do @ - [x rand-gen] - (test "" - (and (|> x (+ <0>) (= x)) - (|> x (- <0>) (= x))))))) - - (context: (format "[" category "] " "Addition & Substraction") - (<| (times 100) - (do @ - [x (:: @ map <prep> rand-gen) - y (:: @ map <prep> rand-gen) - #let [x (* <factor> x) - y (* <factor> y)]] - (test "" - (and (|> x (- y) (+ y) (= x)) - (|> x (+ y) (- y) (= x))))))) - - (context: (format "[" category "] " "Multiplicative identity") - (<| (times 100) - (do @ - [x rand-gen] - (test "" - ## Skip this test for Rev - ## because Rev division loses the last - ## 32 bits of precision. - (or (text/= "Rev" category) - (and (|> x (* <1>) (= x)) - (|> x (/ <1>) (= x)))))))) - - (context: (format "[" category "] " "Multiplication & Division") - (<| (times 100) - (do @ - [x (:: @ map <cap> rand-gen) - y (|> rand-gen - (:: @ map <cap>) - (r.filter (|>> (= <0>) not))) - #let [r (<%> y x) - x' (- r x)]] - (test "" - ## Skip this test for Rev - ## because Rev division loses the last - ## 32 bits of precision. - (or (text/= "Rev" category) - (or (> x' y) - (|> x' (/ y) (* y) (= x')))) - ))))] - - ["Nat" r.nat n/= n/+ n/- n/* n// n/% n/> 0 1 1_000_000 (n/% 1_000) id] - ["Int" r.int i/= i/+ i/- i/* i// i/% i/> +0 +1 +1_000_000 (i/% +1_000) id] - ["Frac" r.frac f/= f/+ f/- f/* f// f/% f/> +0.0 +1.0 +1_000_000.0 id math.floor] - ["Rev" r.rev r/= r/+ r/- r/* r// r/% r/> .0 (.rev -1) (.rev -1) id id] - ) + ["r" random (#+ Random) ("r/." Functor<Random>)]] + ["_" test (#+ Test)]]) + +(def: identity + Test + (do r.Monad<Random> + [self (r.unicode 1)] + ($_ _.and + (_.test "Every value is identical to itself." + (is? self self)) + (_.test "The 'id' function doesn't change values in any way." + (is? self (id self))) + (do @ + [other (r.unicode 1)] + (_.test "Values created separately can't be identical." + (not (is? self other)))) + ))) + +(def: increment-and-decrement + Test + (do r.Monad<Random> + [value r.i64] + ($_ _.and + (_.test "'inc' and 'dec' are different." + (not (n/= (inc value) + (dec value)))) + (_.test "'inc' and 'dec' are opposites." + (and (|> value inc dec (n/= value)) + (|> value dec inc (n/= value)))) + (_.test "'inc' and 'dec' shift the number by 1." + (let [shift 1] + (and (n/= (n/+ shift value) + (inc value)) + (n/= (n/- shift value) + (dec value)))))))) + +(def: (check-neighbors has-property? value) + (All [a] (-> (Predicate (I64 a)) (I64 a) Bit)) + (and (|> value inc has-property?) + (|> value dec has-property?))) + +(def: (even-or-odd rand-gen even? odd?) + (All [a] (-> (Random (I64 a)) (Predicate (I64 a)) (Predicate (I64 a)) Test)) + (do r.Monad<Random> + [value rand-gen] + ($_ _.and + (_.test "Every number is either even or odd." + (if (even? value) + (not (odd? value)) + (odd? value))) + (_.test "Every odd/even number is surrounded by two of the other kind." + (if (even? value) + (check-neighbors odd? value) + (check-neighbors even? value)))))) + +(type: (Choice a) + (-> a a a)) + +(type: (Order a) + (-> a a Bit)) + +(type: (Equivalence a) + (-> a a Bit)) + +(def: (choice rand-gen = [< choose]) + (All [a] (-> (Random a) (Equivalence a) [(Order a) (Choice a)] Test)) + (do r.Monad<Random> + [left rand-gen + right rand-gen + #let [choice (choose left right)]] + ($_ _.and + (_.test "The choice between 2 values is one of them." + (or (= left choice) + (= right choice))) + (_.test "The choice between 2 values implies an order relationship between them." + (if (= left choice) + (< right choice) + (< left choice)))))) + +(def: (minimum-and-maximum rand-gen = min' max') + (All [a] (-> (Random a) (Equivalence a) [(Order a) (Choice a)] [(Order a) (Choice a)] Test)) + ($_ _.and + (<| (_.context "Minimum.") + (choice rand-gen = min')) + (<| (_.context "Maximum.") + (choice rand-gen = max')))) + +(def: (conversion rand-gen forward backward =) + (All [a b] (-> (Random a) (-> a b) (-> b a) (Equivalence a) Test)) + (do r.Monad<Random> + [value rand-gen] + (_.test "Can convert between types in a lossless way." + (|> value forward backward (= value))))) (def: frac-rev (r.Random Rev) (|> r.rev (:: r.Functor<Random> map (|>> (i64.left-shift 11) (i64.logical-right-shift 11))))) -(do-template [category rand-gen -> <- = <cap>] - [(context: (format "[" category "] " "Numeric conversions") - (<| (times 100) - (do @ - [value rand-gen - #let [value (<cap> value)]] - (test "" - (|> value -> <- (= value))))))] - - ["Int->Nat" r.int .nat .int i/= (i/% +1_000_000)] - ["Nat->Int" r.nat .int .nat n/= (n/% 1_000_000)] - ["Int->Frac" r.int int-to-frac frac-to-int i/= (i/% +1_000_000)] - ["Frac->Int" r.frac frac-to-int int-to-frac f/= math.floor] - ["Rev->Frac" frac-rev rev-to-frac frac-to-rev r/= id] - ) - -(context: "Simple macros and constructs" - ($_ seq - (test "Can write easy loops for iterative programming." - (i/= +1000 - (loop [counter +0 - value +1] - (if (i/< +3 counter) - (recur (inc counter) (i/* +10 value)) - value)))) - - (test "Can create lists easily through macros." - (and (case (list +1 +2 +3) - (#.Cons +1 (#.Cons +2 (#.Cons +3 #.Nil))) - #1 - - _ - #0) - - (case (list& +1 +2 +3 (list +4 +5 +6)) - (#.Cons +1 (#.Cons +2 (#.Cons +3 (#.Cons +4 (#.Cons +5 (#.Cons +6 #.Nil)))))) - #1 - - _ - #0))) - - (test "Can have defaults for Maybe values." - (and (is? "yolo" (maybe.default "yolo" - #.None)) - - (is? "lol" (maybe.default "yolo" - (#.Some "lol"))))) +(def: prelude-macros + Test + ($_ _.and + (do r.Monad<Random> + [factor (r/map (|>> (n/% 10) (n/max 1)) r.nat) + iterations (r/map (n/% 100) r.nat) + #let [expected (n/* factor iterations)]] + (_.test "Can write loops." + (n/= expected + (loop [counter 0 + value 0] + (if (n/< iterations counter) + (recur (inc counter) (n/+ factor value)) + value))))) + + (do r.Monad<Random> + [first r.nat + second r.nat + third r.nat] + (_.test "Can create lists easily through macros." + (and (case (list first second third) + (#.Cons first' (#.Cons second' (#.Cons third' #.Nil))) + (and (n/= first first') + (n/= second second') + (n/= third third')) + + _ + false) + (case (list& first (list second third)) + (#.Cons first' (#.Cons second' (#.Cons third' #.Nil))) + (and (n/= first first') + (n/= second second') + (n/= third third')) + + _ + false) + (case (list& first second (list third)) + (#.Cons first' (#.Cons second' (#.Cons third' #.Nil))) + (and (n/= first first') + (n/= second second') + (n/= third third')) + + _ + false)))) + (do r.Monad<Random> + [default r.nat + maybe r.nat] + (_.test "Can have defaults for Maybe values." + (and (is? default (maybe.default default + #.None)) + + (is? maybe (maybe.default default + (#.Some maybe)))))) )) -(template: (hypotenuse x y) - (i/+ (i/* x x) (i/* y y))) - -(context: "Templates." - (<| (times 100) - (do @ - [x r.int - y r.int] - (test "Template application is a stand-in for the templated code." - (i/= (i/+ (i/* x x) (i/* y y)) - (hypotenuse x y)))))) - -(context: "Cross-platform support." - ($_ seq - (test "Can provide default in case there is no particular platform support." - (for {"" #0} - #1)) - (test "Can pick code depending on the platform being targeted." - (for {"JVM" #1 - "JS" #1} - #0)))) +(template: (hypotenuse cat0 cat1) + (n/+ (n/* cat0 cat0) (n/* cat1 cat1))) + +(def: template + Test + (do r.Monad<Random> + [cat0 r.nat + cat1 r.nat] + (_.test "Template application is a stand-in for the templated code." + (n/= (n/+ (n/* cat0 cat0) (n/* cat1 cat1)) + (hypotenuse cat0 cat1))))) + +(def: cross-platform-support + Test + (do r.Monad<Random> + [on-default r.nat + on-fake-host r.nat + on-valid-host r.nat] + ($_ _.and + (_.test "Can provide default in case there is no particular host/platform support." + (n/= on-default + (for {"" on-fake-host} + on-default))) + (_.test "Can pick code depending on the host/platform being targeted." + (n/= on-valid-host + (for {"JVM" on-valid-host + "JS" on-valid-host} + on-default)))))) + +(def: #export 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>]))] + + [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> <=>))] + + ["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) + )) diff --git a/stdlib/test/tests.lux b/stdlib/test/tests.lux index a5c6919c5..738ef182b 100644 --- a/stdlib/test/tests.lux +++ b/stdlib/test/tests.lux @@ -1,7 +1,8 @@ (.module: [lux #* [cli (#+ program:)] - ["." test] + ["." io (#+ io)] + ["_" test] ## These modules do not need to be tested. [type @@ -81,12 +82,11 @@ ] ## TODO: Must have 100% coverage on tests. [test - ## [lux (#+)] - [lux + ["/." lux ## [cli (#+)] ## [host (#+)] - [host - [jvm (#+)]] + ## [host + ## [jvm (#+)]] ## [io (#+)] ## [time ## [instant (#+)] @@ -164,11 +164,11 @@ ## [poly ## ["poly_." equivalence] ## ["poly_." functor]]] - [type ## (#+) - ## [check (#+)] - ## [implicit (#+)] ## TODO: FIX Specially troublesome... - ## [resource (#+)] - [dynamic (#+)]] + ## [type ## (#+) + ## ## [check (#+)] + ## ## [implicit (#+)] ## TODO: FIX Specially troublesome... + ## ## [resource (#+)] + ## [dynamic (#+)]] ## [compiler ## [default ## ["_default/." syntax] @@ -196,4 +196,6 @@ ) (program: args - (test.run)) + (exec (_.run! (<| (_.times 100) + /lux.test)) + (io []))) |