1 files changed, 435 insertions, 0 deletions
diff --git a/stdlib/source/test/lux.lux b/stdlib/source/test/lux.lux
new file mode 100644
index 000000000..51f5c8277
--- /dev/null
+++ b/stdlib/source/test/lux.lux
@@ -0,0 +1,435 @@
+(.module:
+  [lux #*
+   [cli (#+ program:)]
+   ["." io (#+ io)]
+   [control
+    [monad (#+ do)]
+    [predicate (#+ Predicate)]]
+   [data
+    [number
+     ["." i64]]]
+   ["." function]
+   ["." math
+    ["r" random (#+ Random) ("r/." functor)]]
+   ["_" test (#+ Test)]
+   ## These modules do not need to be tested.
+   [type
+    [variance (#+)]]
+   [locale (#+)
+    [language (#+)]
+    [territory (#+)]]
+   ## TODO: Test these modules
+   [data
+    [format
+     [css (#+)]
+     [markdown (#+)]]]
+   ## [control
+   ##  ["._" contract]
+   ##  ["._" concatenative]
+   ##  ["._" predicate]
+   ##  [monad
+   ##   ["._" free]]]
+   ## [data
+   ##  ["._" env]
+   ##  ["._" trace]
+   ##  ["._" store]
+   ##  [format
+   ##   ["._" context]
+   ##   ["._" html]
+   ##   ["._" css]
+   ##   ["._" binary]]
+   ##  [collection
+   ##   [tree
+   ##    [rose
+   ##     ["._" parser]]]
+   ##   [dictionary
+   ##    ["._" plist]]
+   ##   [set
+   ##    ["._" multi]]]
+   ##  [text
+   ##   ["._" buffer]]]
+   ## ["._" macro
+   ##  [poly
+   ##   ["._" json]]]
+   ## [type
+   ##  ["._" unit]
+   ##  ["._" refinement]
+   ##  ["._" quotient]]
+   ## [world
+   ##  ["._" environment]
+   ##  ["._" console]]
+   ## [compiler
+   ##  [host
+   ##   [".H" scheme]]
+   ##  ["._" cli]
+   ##  ["._" default
+   ##   ["._" evaluation]
+   ##   [phase
+   ##    ["._" translation
+   ##     [scheme
+   ##      ["._scheme" primitive]
+   ##      ["._scheme" structure]
+   ##      ["._scheme" reference]
+   ##      ["._scheme" function]
+   ##      ["._scheme" loop]
+   ##      ["._scheme" case]
+   ##      ["._scheme" extension]
+   ##      ["._scheme" extension/common]
+   ##      ["._scheme" expression]]]
+   ##    [extension
+   ##     ["._" statement]]]
+   ##   ["._default" cache]]
+   ##  [meta
+   ##   ["._meta" io
+   ##    ["._meta_io" context]
+   ##    ["._meta_io" archive]]
+   ##   ["._meta" archive]
+   ##   ["._meta" cache]]]
+   ## ["._" interpreter
+   ##  ["._interpreter" type]]
+   ]
+  ## TODO: Must have 100% coverage on tests.
+  [/
+   ["/." cli]
+   ["/." io]
+   ["/." host
+    ["/." jvm]]
+   ["/." control]]
+  ## [control
+  ##  ## [interval (#+)]
+  ##  ## [pipe (#+)]
+  ##  ## [continuation (#+)]
+  ##  ## [reader (#+)]
+  ##  ## [writer (#+)]
+  ##  ## [state (#+)]
+  ##  ## [parser (#+)]
+  ##  ## [thread (#+)]
+  ##  ## [region (#+)]
+  ##  ## [security
+  ##  ##  [privacy (#+)]
+  ##  ##  [integrity (#+)]]
+  ##  [concurrency
+  ##   [actor (#+)]
+  ##   [atom (#+)]
+  ##   [frp (#+)]
+  ##   [promise (#+)]
+  ##   [stm (#+)]
+  ##   ## [semaphore (#+)]
+  ##   ]]
+  ## [data
+  ##  [bit (#+)]
+  ##  [color (#+)]
+  ##  [error (#+)]
+  ##  [name (#+)]
+  ##  [identity (#+)]
+  ##  [lazy (#+)]
+  ##  [maybe (#+)]
+  ##  [product (#+)]
+  ##  [sum (#+)]
+  ##  [number (#+) ## TODO: FIX Specially troublesome...
+  ##   [i64 (#+)]
+  ##   [ratio (#+)]
+  ##   [complex (#+)]]
+  ##  [text (#+)
+  ##   ## [format (#+)]
+  ##   [lexer (#+)]
+  ##   [regex (#+)]]
+  ##  [format
+  ##   ## [json (#+)]
+  ##   [xml (#+)]]
+  ##  ## [collection
+  ##  ##  [array (#+)]
+  ##  ##  [bits (#+)]
+  ##  ##  [list (#+)]
+  ##  ##  [stack (#+)]
+  ##  ##  [row (#+)]
+  ##  ##  [sequence (#+)]
+  ##  ##  [dictionary (#+)
+  ##  ##   ["dictionary_." ordered]]
+  ##  ##  [set (#+)
+  ##  ##   ["set_." ordered]]
+  ##  ##  [queue (#+)
+  ##  ##   [priority (#+)]]
+  ##  ##  [tree
+  ##  ##   [rose (#+)
+  ##  ##    [zipper (#+)]]]]
+  ##  ]
+  ## [math (#+)
+  ##  [random (#+)]
+  ##  [modular (#+)]
+  ##  [logic
+  ##   [continuous (#+)]
+  ##   [fuzzy (#+)]]]
+  ## [macro
+  ##  [code (#+)]
+  ##  [syntax (#+)]
+  ##  [poly
+  ##   ["poly_." equivalence]
+  ##   ["poly_." functor]]]
+  ## [type ## (#+)
+  ##  ## [check (#+)]
+  ##  ## [implicit (#+)] ## TODO: FIX Specially troublesome...
+  ##  ## [resource (#+)]
+  ##  [dynamic (#+)]]
+  ## [time
+  ##  [instant (#+)]
+  ##  [duration (#+)]
+  ##  [date (#+)]]
+  ## [compiler
+  ##  [default
+  ##   ["_default/." syntax]
+  ##   [phase
+  ##    [analysis
+  ##     ["_.A" primitive]
+  ##     ["_.A" structure]
+  ##     ["_.A" reference]
+  ##     ["_.A" case]
+  ##     ["_.A" function]
+  ##     [procedure
+  ##      ["_.A" common]]]
+  ##    [synthesis
+  ##     ["_.S" primitive]
+  ##     ["_.S" structure]
+  ##     ["_.S" case]
+  ##     ["_.S" function]]]]]
+  ## [world
+  ##  [binary (#+)]
+  ##  [file (#+)]
+  ##  [net
+  ##   [tcp (#+)]
+  ##   [udp (#+)]]]
+  )
+
+(def: identity
+  Test
+  (do r.monad
+    [self (r.unicode 1)]
+    ($_ _.and
+        (_.test "Every value is identical to itself."
+                (is? self self))
+        (_.test "The identity function doesn't change values in any way."
+                (is? self (function.identity 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
+    [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
+    [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
+    [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
+    [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 map (|>> (i64.left-shift 11) (i64.logical-right-shift 11)))))
+
+(def: prelude-macros
+  Test
+  ($_ _.and
+      (do r.monad
+        [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
+        [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))))
+      ))
+
+(template: (hypotenuse cat0 cat1)
+  (n/+ (n/* cat0 cat0) (n/* cat1 cat1)))
+
+(def: template
+  Test
+  (do r.monad
+    [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
+    [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)
+      (<| (_.context "/cli Command-Line Interface.")
+          /cli.test)
+      (<| (_.context "/io I/O (input/output)")
+          /io.test)
+      (<| (_.context "/host Host-platform interoperation")
+          ($_ _.and
+              /host.test
+              (<| (_.context "/jvm JVM (Java Virtual Machine)")
+                  /jvm.test)))
+      (<| (_.context "/control")
+          /control.test)
+      ))
+
+(program: args
+  (io (_.run! (<| (_.times 100)
+                  ..test))))