diff options
Diffstat (limited to '')
-rw-r--r-- | stdlib/source/test/lux/control/remember.lux | 13 | ||||
-rw-r--r-- | stdlib/source/test/lux/data/text/regex.lux | 5 | ||||
-rw-r--r-- | stdlib/source/test/lux/macro.lux | 2 | ||||
-rw-r--r-- | stdlib/source/test/lux/macro/poly/equivalence.lux | 2 | ||||
-rw-r--r-- | stdlib/source/test/lux/macro/syntax.lux | 2 | ||||
-rw-r--r-- | stdlib/source/test/lux/meta.lux | 295 |
6 files changed, 303 insertions, 16 deletions
diff --git a/stdlib/source/test/lux/control/remember.lux b/stdlib/source/test/lux/control/remember.lux index 66add3672..f9b261c9f 100644 --- a/stdlib/source/test/lux/control/remember.lux +++ b/stdlib/source/test/lux/control/remember.lux @@ -19,7 +19,8 @@ ["." date (#+ Date)] ["." instant] ["." duration]] - ["." macro + ["." meta] + [macro ["." code] ["." syntax (#+ syntax:)]]] {1 @@ -67,11 +68,11 @@ prng (random.pcg-32 [123 (instant.to-millis now)]) message (product.right (random.run prng ..message)) expected (product.right (random.run prng ..focus))] - (do macro.monad - [should-fail0 (..try (macro.expand (to-remember macro yesterday message #.None))) - should-fail1 (..try (macro.expand (to-remember macro yesterday message (#.Some expected)))) - should-succeed0 (..try (macro.expand (to-remember macro tomorrow message #.None))) - should-succeed1 (..try (macro.expand (to-remember macro tomorrow message (#.Some expected))))] + (do meta.monad + [should-fail0 (..try (meta.expand (to-remember macro yesterday message #.None))) + should-fail1 (..try (meta.expand (to-remember macro yesterday message (#.Some expected)))) + should-succeed0 (..try (meta.expand (to-remember macro tomorrow message #.None))) + should-succeed1 (..try (meta.expand (to-remember macro tomorrow message (#.Some expected))))] (wrap (list (code.bit (and (case should-fail0 (#try.Failure error) (and (test-failure yesterday message #.None error) diff --git a/stdlib/source/test/lux/data/text/regex.lux b/stdlib/source/test/lux/data/text/regex.lux index 49f20a726..bef97b853 100644 --- a/stdlib/source/test/lux/data/text/regex.lux +++ b/stdlib/source/test/lux/data/text/regex.lux @@ -14,7 +14,8 @@ ["." text ("#@." equivalence)]] [math ["r" random]] - ["." macro + ["." meta] + [macro [syntax (#+ syntax:)]]] {1 ["." /]}) @@ -50,7 +51,7 @@ false))) (syntax: (should-check pattern regex input) - (macro.with-gensyms [g!message g!_] + (meta.with-gensyms [g!message g!_] (wrap (list (` (|> (~ input) (<text>.run (~ regex)) (case> (^ (#try.Success (~ pattern))) diff --git a/stdlib/source/test/lux/macro.lux b/stdlib/source/test/lux/macro.lux index 3b95e6f3a..35476eee0 100644 --- a/stdlib/source/test/lux/macro.lux +++ b/stdlib/source/test/lux/macro.lux @@ -1,8 +1,6 @@ (.module: [lux #* ["_" test (#+ Test)]] - {1 - ["." /]} ["." / #_ ["#." code] ["#." template] diff --git a/stdlib/source/test/lux/macro/poly/equivalence.lux b/stdlib/source/test/lux/macro/poly/equivalence.lux index 8280e000e..bfd0a2540 100644 --- a/stdlib/source/test/lux/macro/poly/equivalence.lux +++ b/stdlib/source/test/lux/macro/poly/equivalence.lux @@ -18,7 +18,7 @@ ["." text] [collection ["." list]]] - ["." macro + [macro [poly (#+ derived:)]]]) (type: Variant diff --git a/stdlib/source/test/lux/macro/syntax.lux b/stdlib/source/test/lux/macro/syntax.lux index 549967643..77ede35f3 100644 --- a/stdlib/source/test/lux/macro/syntax.lux +++ b/stdlib/source/test/lux/macro/syntax.lux @@ -19,7 +19,7 @@ ["." int] ["." rev] ["." frac]]] - ["." macro + [macro ["." code]]] {1 ["." / (#+ syntax:)]}) diff --git a/stdlib/source/test/lux/meta.lux b/stdlib/source/test/lux/meta.lux index d0a531404..ec400d5e3 100644 --- a/stdlib/source/test/lux/meta.lux +++ b/stdlib/source/test/lux/meta.lux @@ -1,14 +1,301 @@ (.module: [lux #* - ["_" test (#+ Test)]] - ## {1 - ## ["." /]} + ["_" test (#+ Test)] + [abstract + [monad (#+ do)] + {[0 #spec] + [/ + ["$." functor (#+ Injection Comparison)] + ["$." apply] + ["$." monad]]}] + [control + ["." try]] + [data + ["." text ("#@." equivalence) + ["%" format (#+ format)]] + [number + ["n" nat]]] + [math + ["." random (#+ Random)]]] + {1 + ["." /]} ["." / #_ ["#." annotation]]) +(template: (!expect <pattern> <value>) + (case <value> + <pattern> true + _ false)) + +(def: compiler-related + Test + (do random.monad + [target (random.ascii/upper-alpha 1) + version (random.ascii/upper-alpha 1) + source-code (random.ascii/upper-alpha 1) + expected-current-module (random.ascii/upper-alpha 1) + primitive-type (random.ascii/upper-alpha 1) + expected-seed random.nat + expected random.nat + dummy (random.filter (|>> (n.= expected) not) random.nat) + expected-error (random.ascii/upper-alpha 1) + expected-short (random.ascii/upper-alpha 1) + dummy-module (random.filter (|>> (text@= expected-current-module) not) + (random.ascii/upper-alpha 1)) + expected-gensym (random.ascii/upper-alpha 1) + #let [expected-lux {#.info {#.target target + #.version version + #.mode #.Build} + #.source [..dummy-cursor 0 source-code] + #.cursor ..dummy-cursor + #.current-module (#.Some expected-current-module) + #.modules (list) + #.scopes (list) + #.type-context {#.ex-counter 0 + #.var-counter 0 + #.var-bindings (list)} + #.expected (#.Some (#.Primitive primitive-type (list))) + #.seed expected-seed + #.scope-type-vars (list) + #.extensions [] + #.host []}]] + ($_ _.and + (_.cover [/.run] + (|> (:: /.monad wrap expected) + (/.run expected-lux) + (!expect (^multi (#try.Success actual) + (n.= expected actual))))) + (_.cover [/.run'] + (|> (:: /.monad wrap expected) + (/.run' expected-lux) + (!expect (^multi (#try.Success [actual-lux actual]) + (and (is? expected-lux actual-lux) + (n.= expected actual)))))) + (_.cover [/.get-compiler] + (|> /.get-compiler + (/.run expected-lux) + (!expect (^multi (#try.Success actual-lux) + (is? expected-lux actual-lux))))) + ))) + +(def: error-handling + Test + (do random.monad + [target (random.ascii/upper-alpha 1) + version (random.ascii/upper-alpha 1) + source-code (random.ascii/upper-alpha 1) + expected-current-module (random.ascii/upper-alpha 1) + primitive-type (random.ascii/upper-alpha 1) + expected-seed random.nat + expected random.nat + dummy (random.filter (|>> (n.= expected) not) random.nat) + expected-error (random.ascii/upper-alpha 1) + #let [expected-lux {#.info {#.target target + #.version version + #.mode #.Build} + #.source [..dummy-cursor 0 source-code] + #.cursor ..dummy-cursor + #.current-module (#.Some expected-current-module) + #.modules (list) + #.scopes (list) + #.type-context {#.ex-counter 0 + #.var-counter 0 + #.var-bindings (list)} + #.expected (#.Some (#.Primitive primitive-type (list))) + #.seed expected-seed + #.scope-type-vars (list) + #.extensions [] + #.host []}]] + ($_ _.and + (_.cover [/.fail] + (|> (/.fail expected-error) + (: (Meta Any)) + (/.run expected-lux) + (!expect (^multi (#try.Failure actual-error) + (text@= expected-error actual-error))))) + (_.cover [/.assert] + (and (|> (/.assert expected-error true) + (: (Meta Any)) + (/.run expected-lux) + (!expect (#try.Success []))) + (|> (/.assert expected-error false) + (/.run expected-lux) + (!expect (^multi (#try.Failure actual-error) + (text@= expected-error actual-error)))))) + (_.cover [/.either] + (and (|> (/.either (:: /.monad wrap expected) + (: (Meta Nat) + (/.fail expected-error))) + (/.run expected-lux) + (!expect (^multi (#try.Success actual) + (n.= expected actual)))) + (|> (/.either (: (Meta Nat) + (/.fail expected-error)) + (:: /.monad wrap expected)) + (/.run expected-lux) + (!expect (^multi (#try.Success actual) + (n.= expected actual)))) + (|> (/.either (: (Meta Nat) + (/.fail expected-error)) + (: (Meta Nat) + (/.fail expected-error))) + (/.run expected-lux) + (!expect (^multi (#try.Failure actual-error) + (text@= expected-error actual-error)))) + (|> (/.either (:: /.monad wrap expected) + (:: /.monad wrap dummy)) + (/.run expected-lux) + (!expect (^multi (#try.Success actual) + (n.= expected actual)))))) + ))) + +(def: module-related + Test + (do random.monad + [target (random.ascii/upper-alpha 1) + version (random.ascii/upper-alpha 1) + source-code (random.ascii/upper-alpha 1) + expected-current-module (random.ascii/upper-alpha 1) + primitive-type (random.ascii/upper-alpha 1) + expected-seed random.nat + expected random.nat + dummy (random.filter (|>> (n.= expected) not) random.nat) + expected-error (random.ascii/upper-alpha 1) + expected-short (random.ascii/upper-alpha 1) + dummy-module (random.filter (|>> (text@= expected-current-module) not) + (random.ascii/upper-alpha 1)) + #let [expected-lux {#.info {#.target target + #.version version + #.mode #.Build} + #.source [..dummy-cursor 0 source-code] + #.cursor ..dummy-cursor + #.current-module (#.Some expected-current-module) + #.modules (list) + #.scopes (list) + #.type-context {#.ex-counter 0 + #.var-counter 0 + #.var-bindings (list)} + #.expected (#.Some (#.Primitive primitive-type (list))) + #.seed expected-seed + #.scope-type-vars (list) + #.extensions [] + #.host []}]] + ($_ _.and + (_.cover [/.current-module-name] + (|> /.current-module-name + (/.run expected-lux) + (!expect (^multi (#try.Success actual-current-module) + (text@= expected-current-module actual-current-module))))) + (_.cover [/.normalize] + (and (|> (/.normalize ["" expected-short]) + (/.run expected-lux) + (!expect (^multi (#try.Success [actual-module actual-short]) + (and (text@= expected-current-module actual-module) + (is? expected-short actual-short))))) + (|> (/.normalize [dummy-module expected-short]) + (/.run expected-lux) + (!expect (^multi (#try.Success [actual-module actual-short]) + (and (text@= dummy-module actual-module) + (is? expected-short actual-short))))))) + ))) + +(def: random-cursor + (Random Cursor) + ($_ random.and + (random.ascii/upper-alpha 1) + random.nat + random.nat)) + +(def: injection + (Injection Meta) + (:: /.monad wrap)) + +(def: (comparison init) + (-> Lux (Comparison Meta)) + (function (_ == left right) + (case [(/.run init left) + (/.run init right)] + [(#try.Success left) (#try.Success right)] + (== left right) + + _ + false))) + (def: #export test Test - (<| ## (_.covering /._) + (<| (_.covering /._) ($_ _.and + (do {@ random.monad} + [target (random.ascii/upper-alpha 1) + version (random.ascii/upper-alpha 1) + source-code (random.ascii/upper-alpha 1) + expected-current-module (random.ascii/upper-alpha 1) + expected-type (:: @ map (function (_ name) + (#.Primitive name (list))) + (random.ascii/upper-alpha 1)) + expected-seed random.nat + expected random.nat + dummy (random.filter (|>> (n.= expected) not) random.nat) + expected-error (random.ascii/upper-alpha 1) + expected-short (random.ascii/upper-alpha 1) + dummy-module (random.filter (|>> (text@= expected-current-module) not) + (random.ascii/upper-alpha 1)) + expected-gensym (random.ascii/upper-alpha 1) + expected-cursor ..random-cursor + #let [expected-lux {#.info {#.target target + #.version version + #.mode #.Build} + #.source [.dummy-cursor 0 source-code] + #.cursor expected-cursor + #.current-module (#.Some expected-current-module) + #.modules (list) + #.scopes (list) + #.type-context {#.ex-counter 0 + #.var-counter 0 + #.var-bindings (list)} + #.expected (#.Some expected-type) + #.seed expected-seed + #.scope-type-vars (list) + #.extensions [] + #.host []}]] + ($_ _.and + (_.with-cover [/.functor] + ($functor.spec ..injection (..comparison expected-lux) /.functor)) + (_.with-cover [/.apply] + ($apply.spec ..injection (..comparison expected-lux) /.apply)) + (_.with-cover [/.monad] + ($monad.spec ..injection (..comparison expected-lux) /.monad)) + + ..compiler-related + ..error-handling + ..module-related + (_.cover [/.count] + (|> (do /.monad + [pre /.count + post /.count] + (wrap [pre post])) + (/.run expected-lux) + (!expect (^multi (#try.Success [actual-pre actual-post]) + (and (n.= expected-seed actual-pre) + (n.= (inc expected-seed) actual-post)))))) + (_.cover [/.gensym] + (|> (/.gensym expected-gensym) + (:: /.monad map %.code) + (/.run expected-lux) + (!expect (^multi (#try.Success actual-gensym) + (and (text.contains? expected-gensym actual-gensym) + (text.contains? (%.nat expected-seed) actual-gensym)))))) + (_.cover [/.cursor] + (|> /.cursor + (/.run expected-lux) + (!expect (^multi (#try.Success actual-cursor) + (is? expected-cursor actual-cursor))))) + (_.cover [/.expected-type] + (|> /.expected-type + (/.run expected-lux) + (!expect (^multi (#try.Success actual-type) + (is? expected-type actual-type))))) + )) + /annotation.test ))) |