diff options
Diffstat (limited to 'stdlib/source/test/lux.lux')
-rw-r--r-- | stdlib/source/test/lux.lux | 435 |
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)))) |