(.module: ["/" lux #* [abstract [monad (#+ do)] [predicate (#+ Predicate)]] [control ["." io (#+ io)] [function [mixin (#+)]] [parser [cli (#+ program:)]]] [data ["." name] [number ["." i64] ["n" nat] ["i" int] ["r" rev] ["f" frac]]] ["." math] ["_" test (#+ Test)] ## These modules do not need to be tested. [type [variance (#+)]] [locale (#+) [language (#+)] [territory (#+)]] ["%" data/text/format (#+ format)] [math ["." random (#+ Random) ("#\." functor)]] ## TODO: Test these modules ## [data ## [format ## [css (#+)] ## [markdown (#+)]]] ["@" target ## [js (#+)] ## [python (#+)] ## [lua (#+)] ## [ruby (#+)] ## [php (#+)] ## [common-lisp (#+)] ## [scheme (#+)] ] ## [tool ## [compiler ## [language ## [lux ## [phase ## [generation ## [jvm (#+)] ## [js (#+)] ## ## [python (#+)] ## ## [lua (#+)] ## ## [ruby (#+)] ## ## [php (#+)] ## ## [common-lisp (#+)] ## ## [scheme (#+)] ## ] ## [extension ## [generation ## [jvm (#+)] ## [js (#+)] ## ## [python (#+)] ## ## [lua (#+)] ## ## [ruby (#+)] ## ]] ## ]]]]] ## [control ## ["._" predicate] ## [function ## ["._" contract]] ## [monad ## ["._" free]] ## [parser ## [type (#+)]]] ## [data ## ["._" env] ## ["._" trace] ## ["._" store] ## [format ## ["._" context] ## ["._" html] ## ["._" css] ## ["._" binary]] ## [collection ## [tree ## [rose ## ["._" parser]]] ## [dictionary ## ["._" plist]] ## [set ## ["._" multi]]] ## [text ## ["._" buffer]]] ## ["._" macro] ## [type ## ["._" unit] ## ["._" refinement] ## ["._" quotient]] ## [world ## ["._" environment] ## ["._" console]] ## [compiler ## ["._" cli] ## ["._" default ## ["._" evaluation] ## [phase ## ["._" generation] ## [extension ## ["._" directive]]] ## ["._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. ["." / #_ ["#." abstract] ["#." control] ["#." data] ["#." locale] ["#." macro] ["#." math] ["#." meta] ["#." time] ## ["#." tool] ["#." type] ["#." world] ["#." host] ["#." extension] ["#." target #_ ["#/." jvm]]]) ## TODO: Get rid of this ASAP (template: (!bundle body) (: Test (do random.monad [_ (wrap [])] body))) (def: identity Test (do {! random.monad} [self (random.unicode 1)] ($_ _.and (_.test "Every value is identical to itself." (is? self self)) (do ! [other (random.unicode 1)] (_.test "Values created separately can't be identical." (not (is? self other)))) ))) (def: increment-and-decrement Test (do random.monad [value random.i64] ($_ _.and (_.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." (and (|> (inc value) (n.- value) (n.= 1)) (|> value (n.- (dec value)) (n.= 1))))))) (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 random.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 random.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 random.monad [value rand-gen] (_.test "Can convert between types in a lossless way." (|> value forward backward (= value))))) (def: frac-rev (Random Rev) (let [bits-to-ignore 11] (\ random.functor map (i64.left-shift bits-to-ignore) random.rev))) (def: prelude-macros Test ($_ _.and (do random.monad [factor (random\map (|>> (n.% 10) (n.max 1)) random.nat) iterations (random\map (n.% 100) random.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 random.monad [first random.nat second random.nat third random.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: (quadrance cat0 cat1) (n.+ (n.* cat0 cat0) (n.* cat1 cat1))) (def: templates Test (do random.monad [cat0 random.nat cat1 random.nat] (_.test "Template application is a stand-in for the templated code." (n.= (n.+ (n.* cat0 cat0) (n.* cat1 cat1)) (quadrance cat0 cat1))))) (def: cross-platform-support Test (do random.monad [on-default random.nat on-fake-host random.nat on-valid-host random.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 {@.old on-valid-host @.jvm on-valid-host @.js on-valid-host} on-default)))))) (def: sub-tests Test (_.in-parallel (list& /abstract.test /control.test /data.test /locale.test /macro.test /math.test /meta.test /time.test ## /tool.test /type.test /world.test /host.test /target/jvm.test (for {@.old (list)} (list /extension.test)) ))) (def: test (<| (_.context (name.module (name-of /._))) ($_ _.and (!bundle ($_ _.and (<| (_.context "Identity.") ..identity) (<| (_.context "Increment & decrement.") ..increment-and-decrement) (<| (_.context "Even or odd.") ($_ _.and (<| (_.context "Natural numbers.") (..even-or-odd random.nat n.even? n.odd?)) (<| (_.context "Integers.") (..even-or-odd random.int i.even? i.odd?)))) (<| (_.context "Minimum and maximum.") (`` ($_ _.and (~~ (template [<=> ] [(<| (_.context ) (..minimum-and-maximum <=> [ ] [ ]))] [i.= i.< i.min i.> i.max random.int "Integers."] [n.= n.< n.min n.> n.max random.nat "Natural numbers."] [r.= r.< r.min r.> r.max random.rev "Revolutions."] [f.= f.< f.min f.> f.max random.safe-frac "Fractions."] ))))) (<| (_.context "Conversion.") (`` ($_ _.and (~~ (template [<=> ] [(<| (_.context (format (%.name (name-of )) " " (%.name (name-of )))) (..conversion <=>))] [i.= .nat .int (random\map (i.% +1,000,000) random.int)] [n.= .int .nat (random\map (n.% 1,000,000) random.nat)] [i.= i.frac f.int (random\map (i.% +1,000,000) random.int)] [f.= f.int i.frac (random\map (|>> (i.% +1,000,000) i.frac) random.int)] [r.= r.frac f.rev frac-rev] ))))) (<| (_.context "Prelude macros.") ..prelude-macros) (<| (_.context "Templates.") ..templates) (<| (_.context "Cross-platform support.") ..cross-platform-support))) ..sub-tests ))) (program: args (<| io _.run! (_.times 100) ..test))