diff options
Diffstat (limited to '')
| -rw-r--r-- | stdlib/source/test/lux/abstract/codec.lux | 45 | ||||
| -rw-r--r-- | stdlib/source/test/lux/control.lux | 2 | ||||
| -rw-r--r-- | stdlib/source/test/lux/control/remember.lux | 122 |
3 files changed, 145 insertions, 24 deletions
diff --git a/stdlib/source/test/lux/abstract/codec.lux b/stdlib/source/test/lux/abstract/codec.lux index 0793ee371..3bb35f659 100644 --- a/stdlib/source/test/lux/abstract/codec.lux +++ b/stdlib/source/test/lux/abstract/codec.lux @@ -6,13 +6,10 @@ ["." try]] [data ["." bit ("#@." equivalence)] - ["%" text/format (#+ format)] [format - ["." json (#+ JSON)]] - [collection - [dictionary]]] + ["." json (#+ JSON)]]] [math - ["r" random (#+ Random)]]] + ["." random (#+ Random)]]] {1 ["." / (#+ Codec) [// @@ -36,26 +33,26 @@ (def: #export test Test - (do r.monad - [expected r.bit] - (<| (_.context (%.name (name-of /.Codec))) - (_.test (%.name (name-of /.compose)) - (case (|> expected (:: ..codec encode) (:: ..codec decode)) - (#try.Success actual) - (bit@= expected actual) - - (#try.Failure error) - false))))) + (do random.monad + [expected random.bit] + (<| (_.covering /._) + (_.cover [/.compose] + (case (|> expected (:: ..codec encode) (:: ..codec decode)) + (#try.Success actual) + (bit@= expected actual) + + (#try.Failure error) + false))))) (def: #export (spec (^open "/@.") (^open "/@.") generator) (All [m a] (-> (Equivalence a) (Codec m a) (Random a) Test)) - (do r.monad + (do random.monad [expected generator] - (<| (_.context (%.name (name-of /.Codec))) - (_.test "Isomorphism." - (case (|> expected /@encode /@decode) - (#try.Success actual) - (/@= expected actual) - - (#try.Failure _) - false))))) + (_.with-cover [/.Codec] + (_.test "Isomorphism." + (case (|> expected /@encode /@decode) + (#try.Success actual) + (/@= expected actual) + + (#try.Failure _) + false))))) diff --git a/stdlib/source/test/lux/control.lux b/stdlib/source/test/lux/control.lux index 3a6491f25..e90ab54f1 100644 --- a/stdlib/source/test/lux/control.lux +++ b/stdlib/source/test/lux/control.lux @@ -12,6 +12,7 @@ ["#." pipe] ["#." reader] ["#." region] + ["#." remember] ["#." state] ["#." thread] ["#." writer] @@ -72,6 +73,7 @@ /pipe.test /reader.test /region.test + /remember.test /state.test /thread.test /writer.test diff --git a/stdlib/source/test/lux/control/remember.lux b/stdlib/source/test/lux/control/remember.lux new file mode 100644 index 000000000..0b5537ef0 --- /dev/null +++ b/stdlib/source/test/lux/control/remember.lux @@ -0,0 +1,122 @@ +(.module: + [lux #* + ["_" test (#+ Test)] + [abstract + ["." monad (#+ do)]] + [control + ["." io] + ["." try (#+ Try)] + ["." exception] + [parser + ["<c>" code]]] + [data + ["." product] + ["." text + ["%" format (#+ format)]]] + [math + ["." random (#+ Random) ("#@." monad)]] + [time + ["." date (#+ Date)] + ["." instant] + ["." duration]] + ["." macro + ["." code] + ["." syntax (#+ syntax:)]]] + {1 + ["." /]}) + +(def: deadline (Random Date) random.date) +(def: message (Random Text) (random@map %.nat random.nat)) +(def: focus (Random Code) (random@map code.text (random.ascii/upper-alpha 10))) + +(def: (to-remember macro deadline message focus) + (-> Name Date Text (Maybe Code) Code) + (` ((~ (code.identifier macro)) + (~ (code.text (%.date deadline))) + (~ (code.text message)) + (~+ (case focus + #.None (list) + (#.Some focus) (list focus)))))) + +(def: (try computation) + (All [a] (-> (Meta a) (Meta (Try a)))) + (function (_ compiler) + (case (computation compiler) + (#try.Success [compiler output]) + (#try.Success [compiler (#try.Success output)]) + + (#try.Failure error) + (#try.Success [compiler (#try.Failure error)])))) + +(def: (test-failure deadline message focus failure) + (-> Date Text (Maybe Code) Text Bit) + (and (text.contains? (%.date deadline) failure) + (text.contains? message failure) + (case focus + #.None + true + + (#.Some focus) + (text.contains? (%.code focus) failure)))) + +(syntax: (test-macro {macro <c>.identifier} {extra <c>.text}) + (let [now (io.run instant.now) + today (instant.date now) + yesterday (instant.date (instant.shift (duration.inverse duration.week) now)) + tomorrow (instant.date (instant.shift duration.week now)) + prng (random.pcg-32 [123 (instant.to-millis now)]) + message (product.right (random.run prng ..message)) + expected (product.right (random.run prng ..focus))] + (do @ + [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))))] + (wrap (list (code.bit (and (case should-fail0 + (#try.Failure error) + (and (test-failure yesterday message #.None error) + (text.contains? extra error)) + + _ + false) + (case should-fail1 + (#try.Failure error) + (and (test-failure yesterday message (#.Some expected) error) + (text.contains? extra error)) + + _ + false) + (case should-succeed0 + (^ (#try.Success (list))) + true + + _ + false) + (case should-succeed1 + (^ (#try.Success (list actual))) + (is? expected actual) + + _ + false) + ))))))) + +(def: #export test + Test + (<| (_.covering /._) + (do random.monad + [deadline ..deadline + message ..message + focus ..focus] + ($_ _.and + (_.cover [/.must-remember] + (and (test-failure deadline message #.None + (exception.construct /.must-remember [deadline deadline message #.None])) + (test-failure deadline message (#.Some focus) + (exception.construct /.must-remember [deadline deadline message (#.Some focus)])))) + (_.cover [/.remember] + (..test-macro /.remember "")) + (_.cover [/.to-do] + (..test-macro /.to-do "TODO")) + (_.cover [/.fix-me] + (..test-macro /.fix-me "FIXME")) + )))) |