From f3e869d0246e956399ec31a074c6c6299ff73602 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Thu, 8 Jul 2021 23:59:00 -0400 Subject: Made sure the "phase" parameter of extensions is always usable (even across language boundaries) --- stdlib/source/test/lux/extension.lux | 151 +++++++++++++++++++--------------- stdlib/source/test/lux/time.lux | 154 ++++++++++++++++++++++++++++++++--- 2 files changed, 230 insertions(+), 75 deletions(-) (limited to 'stdlib/source/test') diff --git a/stdlib/source/test/lux/extension.lux b/stdlib/source/test/lux/extension.lux index 8ff1cdc00..e20189fa3 100644 --- a/stdlib/source/test/lux/extension.lux +++ b/stdlib/source/test/lux/extension.lux @@ -10,18 +10,24 @@ ["." php] ["." scheme]] [abstract - [monad (#+ do)]] + ["." monad (#+ do)]] [control ["." try] ["<>" parser - ["" code] - ["" analysis] - ["" synthesis]]] + ["<.>" code] + ["<.>" analysis] + ["<.>" synthesis]]] [data + ["." product] ["." text ("#\." equivalence) ["%" format (#+ format)]] [collection - ["." row]]] + ["." row] + ["." list ("#\." functor)]]] + [math + ["." random] + [number + ["n" nat]]] [tool [compiler ["." phase] @@ -40,81 +46,96 @@ (def: my_analysis "my analysis") (def: my_synthesis "my synthesis") (def: my_generation "my generation") +(def: dummy_generation "dummy generation") (def: my_directive "my directive") ## Generation (for {@.old (as_is)} - (as_is (analysis: (..my_generation self phase archive {parameters (<>.some .any)}) - (do phase.monad - [_ (type.infer .Text)] - (wrap (#analysis.Extension self (list))))) + (as_is + ## Analysis + (analysis: (..my_analysis self phase archive {pass_through .any}) + (phase archive pass_through)) - (synthesis: (..my_generation self phase archive {parameters (<>.some .any)}) - (do phase.monad - [] - (wrap (#synthesis.Extension self (list))))) - )) + ## Synthesis + (analysis: (..my_synthesis self phase archive {parameters (<>.some .any)}) + (let [! phase.monad] + (|> parameters + (monad.map ! (phase archive)) + (\ ! map (|>> (#analysis.Extension self)))))) -(for {@.old - (as_is)} - - (generation: (..my_generation self phase archive {parameters (<>.some .any)}) - (do phase.monad - [] - (wrap (for {@.jvm - (row.row (#jvm.Constant (#jvm.LDC (#jvm.String self)))) + (synthesis: (..my_synthesis self phase archive {pass_through .any}) + (phase archive pass_through)) - @.js (js.string self) - @.python (python.unicode self) - @.lua (lua.string self) - @.ruby (ruby.string self) - @.php (php.string self) - @.scheme (scheme.string self)}))))) + ## Generation + (analysis: (..my_generation self phase archive {parameters (<>.some .any)}) + (let [! phase.monad] + (|> parameters + (monad.map ! (phase archive)) + (\ ! map (|>> (#analysis.Extension self)))))) -(for {@.old - (as_is)} - - (as_is (analysis: (..my_analysis self phase archive {parameters (<>.some .any)}) - (do phase.monad - [_ (type.infer .Text)] - (wrap (#analysis.Primitive (#analysis.Text self))))) + (synthesis: (..my_generation self phase archive {parameters (<>.some .any)}) + (let [! phase.monad] + (|> parameters + (monad.map ! (phase archive)) + (\ ! map (|>> (#synthesis.Extension self)))))) + + (generation: (..my_generation self phase archive {pass_through .any}) + (for {@.jvm + (\ phase.monad map (|>> #jvm.Embedded row.row) + (phase archive pass_through))} + (phase archive pass_through))) + + (analysis: (..dummy_generation self phase archive) + (\ phase.monad wrap (#analysis.Extension self (list)))) + + (synthesis: (..dummy_generation self phase archive) + (\ phase.monad wrap (#synthesis.Extension self (list)))) + + (generation: (..dummy_generation self phase archive) + (\ phase.monad wrap + (for {@.jvm + (row.row (#jvm.Constant (#jvm.LDC (#jvm.String self)))) - ## Synthesis - (analysis: (..my_synthesis self phase archive {parameters (<>.some .any)}) - (do phase.monad - [_ (type.infer .Text)] - (wrap (#analysis.Extension self (list))))) + @.js (js.string self) + @.python (python.unicode self) + @.lua (lua.string self) + @.ruby (ruby.string self) + @.php (php.string self) + @.scheme (scheme.string self)}))) - (synthesis: (..my_synthesis self phase archive {parameters (<>.some .any)}) - (do phase.monad - [] - (wrap (synthesis.text self)))) - - ## Directive - (directive: (..my_directive self phase archive {parameters (<>.some .any)}) - (do phase.monad - [#let [_ (debug.log! (format "Successfully installed directive " (%.text self) "!"))]] - (wrap directive.no_requirements))) + ## Directive + (directive: (..my_directive self phase archive {parameters (<>.some .any)}) + (do phase.monad + [#let [_ (debug.log! (format "Successfully installed directive " (%.text self) "!"))]] + (wrap directive.no_requirements))) - (`` ((~~ (static ..my_directive)))) - )) + (`` ((~~ (static ..my_directive)))) + )) (def: #export test Test (<| (_.covering /._) - (`` ($_ _.and - (~~ (template [ ] - [(_.cover [] - (for {@.old - false} - (text\= (`` ((~~ (static )))) - )))] + (do random.monad + [expected random.nat] + (`` ($_ _.and + (~~ (template [ ] + [(_.cover [] + (for {@.old + false} + (n.= expected + (`` ((~~ (static )) expected)))))] - [/.analysis: ..my_analysis] - [/.synthesis: ..my_synthesis] - [/.generation: ..my_generation])) - (_.cover [/.directive:] - true) - )))) + [/.analysis: ..my_analysis] + [/.synthesis: ..my_synthesis])) + (_.cover [/.generation:] + (for {@.old + false} + (and (n.= expected + (`` ((~~ (static ..my_generation)) expected))) + (text\= ..dummy_generation + (`` ((~~ (static ..dummy_generation)))))))) + (_.cover [/.directive:] + true) + ))))) diff --git a/stdlib/source/test/lux/time.lux b/stdlib/source/test/lux/time.lux index cc18c20e0..b22823626 100644 --- a/stdlib/source/test/lux/time.lux +++ b/stdlib/source/test/lux/time.lux @@ -1,21 +1,155 @@ (.module: [lux #* - ["_" test (#+ Test)]] + ["_" test (#+ Test)] + [abstract + [monad (#+ do)] + {[0 #spec] + [/ + ["$." equivalence] + ["$." order] + ["$." enum] + ["$." codec]]}] + [control + [pipe (#+ case>)] + ["." try ("#\." functor)] + ["." exception] + [parser + ["<.>" text]]] + [data + ["." text + ["%" format (#+ format)]]] + [math + ["." random] + [number + ["n" nat]]]] ["." / #_ ["#." date] ["#." day] ["#." duration] ["#." instant] ["#." month] - ["#." year]]) + ["#." year]] + {1 + ["." / + ["." duration]]}) -(def: #export test +(def: for_implementation Test ($_ _.and - /date.test - /day.test - /duration.test - /instant.test - /month.test - /year.test - )) + (_.for [/.equivalence] + ($equivalence.spec /.equivalence random.time)) + (_.for [/.order] + ($order.spec /.order random.time)) + (_.for [/.enum] + ($enum.spec /.enum random.time)) + (_.for [/.codec] + ($codec.spec /.equivalence /.codec random.time)))) + +(def: for_clock + Test + (do {! random.monad} + [expected random.time] + (_.cover [/.clock /.time] + (|> expected + /.clock + /.time + (try\map (\ /.equivalence = expected)) + (try.default false))))) + +(def: for_ranges + Test + (do {! random.monad} + [valid_hour (\ ! map (|>> (n.% /.hours) (n.max 10)) random.nat) + valid_minute (\ ! map (|>> (n.% /.minutes) (n.max 10)) random.nat) + valid_second (\ ! map (|>> (n.% /.seconds) (n.max 10)) random.nat) + valid_milli_second (\ ! map (n.% /.milli_seconds) random.nat) + + #let [invalid_hour (|> valid_hour (n.+ /.hours)) + invalid_minute (|> valid_minute (n.+ /.minutes) (n.min 99)) + invalid_second (|> valid_second (n.+ /.seconds) (n.min 99))]] + (`` ($_ _.and + (~~ (template [ ] + [(_.cover [ ] + (let [valid! + (|> + %.nat + (text.prefix ) + (text.suffix ) + (\ /.codec decode) + (case> (#try.Success _) true + (#try.Failure error) false)) + + invalid! + (|> + %.nat + (text.prefix ) + (text.suffix ) + (\ /.codec decode) + (case> (#try.Success _) + false + + (#try.Failure error) + (exception.match? error)))] + (and valid! + invalid!)))] + + [/.hours /.invalid_hour "" ":00:00.000" valid_hour invalid_hour] + [/.minutes /.invalid_minute "00:" ":00.000" valid_minute invalid_minute] + [/.seconds /.invalid_second "00:00:" ".000" valid_second invalid_second] + )) + (_.cover [/.milli_seconds] + (|> valid_milli_second + %.nat + (format "00:00:00.") + (\ /.codec decode) + (case> (#try.Success _) true + (#try.Failure error) false))) + )))) + +(def: #export test + Test + (<| (_.covering /._) + (_.for [/.Time]) + (do {! random.monad} + [#let [day (.nat (duration.to_millis duration.day))] + expected random.time + + out_of_bounds (\ ! map (|>> /.to_millis (n.+ day)) + random.time)] + (`` ($_ _.and + ..for_implementation + + (_.cover [/.to_millis /.from_millis] + (|> expected + /.to_millis + /.from_millis + (try\map (\ /.equivalence = expected)) + (try.default false))) + (_.cover [/.time_exceeds_a_day] + (case (/.from_millis out_of_bounds) + (#try.Success _) + false + + (#try.Failure error) + (exception.match? /.time_exceeds_a_day error))) + (_.cover [/.midnight] + (|> /.midnight + /.to_millis + (n.= 0))) + (_.cover [/.parser] + (|> expected + (\ /.codec encode) + (.run /.parser) + (try\map (\ /.equivalence = expected)) + (try.default false))) + ..for_ranges + (_.for [/.Clock] + ..for_clock) + + /date.test + /day.test + /duration.test + /instant.test + /month.test + /year.test + ))))) -- cgit v1.2.3