diff options
Diffstat (limited to 'stdlib/source/test')
| -rw-r--r-- | stdlib/source/test/lux/control.lux | 4 | ||||
| -rw-r--r-- | stdlib/source/test/lux/control/parser/text.lux | 19 | ||||
| -rw-r--r-- | stdlib/source/test/lux/control/parser/type.lux | 197 | ||||
| -rw-r--r-- | stdlib/source/test/lux/data/format/tar.lux | 6 |
4 files changed, 211 insertions, 15 deletions
diff --git a/stdlib/source/test/lux/control.lux b/stdlib/source/test/lux/control.lux index 9beb884b4..fe35c0500 100644 --- a/stdlib/source/test/lux/control.lux +++ b/stdlib/source/test/lux/control.lux @@ -26,7 +26,8 @@ ["#/." json] ["#/." synthesis] ["#/." text] - ["#/." tree]] + ["#/." tree] + ["#/." type]] ["#." pipe] ["#." reader] ["#." region] @@ -71,6 +72,7 @@ /parser/synthesis.test /parser/text.test /parser/tree.test + /parser/type.test )) (def: security diff --git a/stdlib/source/test/lux/control/parser/text.lux b/stdlib/source/test/lux/control/parser/text.lux index 30ebe0cad..08dddb051 100644 --- a/stdlib/source/test/lux/control/parser/text.lux +++ b/stdlib/source/test/lux/control/parser/text.lux @@ -16,7 +16,9 @@ ["n" nat]] [collection ["." set] - ["." list ("#@." functor)]]] + ["." list ("#@." functor)] + [tree + ["." finger]]]] [math ["." random]] [macro @@ -93,19 +95,19 @@ (..should-fail (text.from-code invalid) /.lower)))) (do {@ random.monad} [expected (:: @ map (n.% 10) random.nat) - invalid (random.char (unicode.set (list unicode.aegean-numbers)))] + invalid (random.char (unicode.set [unicode.aegean-numbers (list)]))] (_.cover [/.decimal] (and (..should-pass (:: n.decimal encode expected) /.decimal) (..should-fail (text.from-code invalid) /.decimal)))) (do {@ random.monad} [expected (:: @ map (n.% 8) random.nat) - invalid (random.char (unicode.set (list unicode.aegean-numbers)))] + invalid (random.char (unicode.set [unicode.aegean-numbers (list)]))] (_.cover [/.octal] (and (..should-pass (:: n.octal encode expected) /.octal) (..should-fail (text.from-code invalid) /.octal)))) (do {@ random.monad} [expected (:: @ map (n.% 16) random.nat) - invalid (random.char (unicode.set (list unicode.aegean-numbers)))] + invalid (random.char (unicode.set [unicode.aegean-numbers (list)]))] (_.cover [/.hexadecimal] (and (..should-pass (:: n.hex encode expected) /.hexadecimal) (..should-fail (text.from-code invalid) /.hexadecimal)))) @@ -315,14 +317,9 @@ (exception.match? /.cannot-match error))))))) (_.cover [/.Slice /.slice /.cannot-slice] (|> "" - (/.run (do <>.monad - [#let [_ (log! " PRE SLICE")] - slice (/.slice /.any!) - #let [_ (log! "POST SLICE")]] - (wrap slice))) + (/.run (/.slice /.any!)) (!expect (^multi (#try.Failure error) - (exec (log! (format "error = " error)) - (exception.match? /.cannot-slice error)))))) + (exception.match? /.cannot-slice error))))) (do {@ random.monad} [expected (random.unicode 1)] (_.cover [/.any /.any!] diff --git a/stdlib/source/test/lux/control/parser/type.lux b/stdlib/source/test/lux/control/parser/type.lux new file mode 100644 index 000000000..99e995f2d --- /dev/null +++ b/stdlib/source/test/lux/control/parser/type.lux @@ -0,0 +1,197 @@ +(.module: + [lux (#- primitive) + ["_" test (#+ Test)] + [abstract + [monad (#+ do)]] + [control + ["." try] + ["." exception]] + [data + ["." name ("#@." equivalence)] + [number + ["n" nat]]] + [math + ["." random (#+ Random)]] + ["." type ("#@." equivalence)]] + {1 + ["." / + ["/#" //]]}) + +(template: (!expect <pattern> <value>) + (case <value> + <pattern> + true + + _ + false)) + +(def: primitive + (Random Type) + (|> (random.ascii/alpha-num 1) + (:: random.monad map (function (_ name) + (#.Primitive name (list)))))) + +(def: matches + Test + (<| (_.with-cover [/.types-do-not-match]) + (do {@ random.monad} + [expected ..primitive + dummy (random.filter (|>> (type@= expected) not) + ..primitive)]) + ($_ _.and + (_.cover [/.exactly] + (and (|> (/.run (/.exactly expected) expected) + (!expect (#try.Success []))) + (|> (/.run (/.exactly expected) dummy) + (!expect (^multi (#try.Failure error) + (exception.match? /.types-do-not-match error)))))) + (_.cover [/.sub] + (and (|> (/.run (/.sub expected) expected) + (!expect (#try.Success []))) + (|> (/.run (/.sub Any) expected) + (!expect (#try.Success []))) + (|> (/.run (/.sub expected) Nothing) + (!expect (#try.Success []))) + (|> (/.run (/.sub expected) dummy) + (!expect (^multi (#try.Failure error) + (exception.match? /.types-do-not-match error)))))) + (_.cover [/.super] + (and (|> (/.run (/.super expected) expected) + (!expect (#try.Success []))) + (|> (/.run (/.super expected) Any) + (!expect (#try.Success []))) + (|> (/.run (/.super Nothing) expected) + (!expect (#try.Success []))) + (|> (/.run (/.super expected) dummy) + (!expect (^multi (#try.Failure error) + (exception.match? /.types-do-not-match error)))))) + ))) + +(def: aggregate + Test + (do {@ random.monad} + [expected-left ..primitive + expected-middle ..primitive + expected-right ..primitive] + (`` ($_ _.and + (~~ (template [<parser> <exception> <good-constructor> <bad-constructor>] + [(_.cover [<parser> <exception>] + (and (|> (/.run (<parser> ($_ //.and /.any /.any /.any)) + (<good-constructor> (list expected-left expected-middle expected-right))) + (!expect (^multi (#try.Success [actual-left actual-middle actual-right]) + (and (type@= expected-left actual-left) + (type@= expected-middle actual-middle) + (type@= expected-right actual-right))))) + (|> (/.run (<parser> ($_ //.and /.any /.any /.any)) + (<bad-constructor> (list expected-left expected-middle expected-right))) + (!expect (^multi (#try.Failure error) + (exception.match? <exception> error))))))] + + [/.variant /.not-variant type.variant type.tuple] + [/.tuple /.not-tuple type.tuple type.variant] + )) + + (_.cover [/.function /.not-function] + (and (|> (/.run (/.function ($_ //.and /.any /.any) /.any) + (type.function (list expected-left expected-middle) expected-right)) + (!expect (^multi (#try.Success [[actual-left actual-middle] actual-right]) + (and (type@= expected-left actual-left) + (type@= expected-middle actual-middle) + (type@= expected-right actual-right))))) + (|> (/.run (/.function ($_ //.and /.any /.any) /.any) + (type.variant (list expected-left expected-middle expected-right))) + (!expect (^multi (#try.Failure error) + (exception.match? /.not-function error)))))) + (_.cover [/.apply /.not-application] + (and (|> (/.run (/.apply ($_ //.and /.any /.any /.any)) + (type.application (list expected-middle expected-right) expected-left)) + (!expect (^multi (#try.Success [actual-left actual-middle actual-right]) + (and (type@= expected-left actual-left) + (type@= expected-middle actual-middle) + (type@= expected-right actual-right))))) + (|> (/.run (/.apply ($_ //.and /.any /.any /.any)) + (type.variant (list expected-left expected-middle expected-right))) + (!expect (^multi (#try.Failure error) + (exception.match? /.not-application error)))))) + )))) + +(def: #export test + Test + (<| (_.covering /._) + (_.with-cover [/.Parser]) + ($_ _.and + (do {@ random.monad} + [expected ..primitive] + (_.cover [/.run /.any] + (|> (/.run /.any expected) + (!expect (^multi (#try.Success actual) + (type@= expected actual)))))) + (do {@ random.monad} + [expected ..primitive] + (_.cover [/.peek /.unconsumed-input] + (and (|> (/.run (do //.monad + [actual /.peek + _ /.any] + (wrap actual)) + expected) + (!expect (^multi (#try.Success actual) + (type@= expected actual)))) + (|> (/.run /.peek expected) + (!expect (^multi (#try.Failure error) + (exception.match? /.unconsumed-input error))))))) + (do {@ random.monad} + [expected ..primitive] + (_.cover [/.empty-input] + (`` (and (~~ (template [<parser>] + [(|> (/.run (do //.monad + [_ /.any] + <parser>) + expected) + (!expect (^multi (#try.Failure error) + (exception.match? /.empty-input error))))] + + [/.any] + [/.peek] + )))))) + (do {@ random.monad} + [expected ..primitive] + (_.cover [/.Env /.env /.fresh] + (|> (/.run (do //.monad + [env /.env + _ /.any] + (wrap env)) + expected) + (!expect (^multi (#try.Success environment) + (is? /.fresh environment)))))) + (do {@ random.monad} + [expected ..primitive + dummy (random.filter (|>> (type@= expected) not) + ..primitive)] + (_.cover [/.local] + (|> (/.run (do //.monad + [_ /.any] + (/.local (list expected) + /.any)) + dummy) + (!expect (^multi (#try.Success actual) + (type@= expected actual)))))) + (do {@ random.monad} + [expected random.nat] + (_.cover [/.existential /.not-existential] + (|> (/.run /.existential + (#.Ex expected)) + (!expect (^multi (#try.Success actual) + (n.= expected actual)))))) + (do {@ random.monad} + [expected-name (random.and (random.ascii/alpha-num 1) + (random.ascii/alpha-num 1)) + expected-type ..primitive] + (_.cover [/.named /.not-named] + (|> (/.run /.named + (#.Named expected-name expected-type)) + (!expect (^multi (#try.Success [actual-name actual-type]) + (and (name@= expected-name actual-name) + (type@= expected-type actual-type))))))) + ..aggregate + ..matches + ))) diff --git a/stdlib/source/test/lux/data/format/tar.lux b/stdlib/source/test/lux/data/format/tar.lux index ebbdd8f1e..17f18e005 100644 --- a/stdlib/source/test/lux/data/format/tar.lux +++ b/stdlib/source/test/lux/data/format/tar.lux @@ -38,7 +38,7 @@ (do {@ random.monad} [expected (random.ascii/lower-alpha /.path-size) invalid (random.ascii/lower-alpha (inc /.path-size)) - not-ascii (random.text (random.char (unicode.set (list unicode.katakana))) + not-ascii (random.text (random.char (unicode.set [unicode.katakana (list)])) /.path-size)] (`` ($_ _.and (_.cover [/.path /.from-path] @@ -71,7 +71,7 @@ (do {@ random.monad} [expected (random.ascii/lower-alpha /.name-size) invalid (random.ascii/lower-alpha (inc /.name-size)) - not-ascii (random.text (random.char (unicode.set (list unicode.katakana))) + not-ascii (random.text (random.char (unicode.set [unicode.katakana (list)])) /.name-size)] (`` ($_ _.and (_.cover [/.name /.from-name] @@ -312,7 +312,7 @@ [path (random.ascii/lower-alpha /.path-size) expected (random.ascii/lower-alpha /.name-size) invalid (random.ascii/lower-alpha (inc /.name-size)) - not-ascii (random.text (random.char (unicode.set (list unicode.katakana))) + not-ascii (random.text (random.char (unicode.set [unicode.katakana (list)])) /.name-size)] (_.with-cover [/.Ownership /.Owner /.ID] ($_ _.and |