aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--lux-mode/lux-mode.el2
-rw-r--r--stdlib/source/lux/test.lux308
-rw-r--r--stdlib/test/test/lux.lux418
-rw-r--r--stdlib/test/tests.lux24
4 files changed, 340 insertions, 412 deletions
diff --git a/lux-mode/lux-mode.el b/lux-mode/lux-mode.el
index 8825438c7..46d0e77fe 100644
--- a/lux-mode/lux-mode.el
+++ b/lux-mode/lux-mode.el
@@ -299,7 +299,7 @@ Called by `imenu--generic-function'."
remember
;;;;;;;;;;;;;;;;;;;;;;;;
"\\.module:"
- "def:" "type:" "program:" "context:"
+ "def:" "type:" "program:"
"macro:" "syntax:"
"with-expansions"
"exception:"
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 [])))
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-06 02:22:13 +0000