aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/test
diff options
context:
space:
mode:
authorEduardo Julian2021-07-08 23:59:00 -0400
committerEduardo Julian2021-07-08 23:59:00 -0400
commitf3e869d0246e956399ec31a074c6c6299ff73602 (patch)
treeba67c7713bbe4ec48232f58a4b324bd364111f95 /stdlib/source/test
parent2b909032e7a0bd10cd7db52067d2fb701bfa95e5 (diff)
Made sure the "phase" parameter of extensions is always usable (even across language boundaries)
Diffstat (limited to '')
-rw-r--r--stdlib/source/test/lux/extension.lux151
-rw-r--r--stdlib/source/test/lux/time.lux154
2 files changed, 230 insertions, 75 deletions
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
- ["<c>" code]
- ["<a>" analysis]
- ["<s>" 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 <c>.any)})
- (do phase.monad
- [_ (type.infer .Text)]
- (wrap (#analysis.Extension self (list)))))
+ (as_is
+ ## Analysis
+ (analysis: (..my_analysis self phase archive {pass_through <code>.any})
+ (phase archive pass_through))
- (synthesis: (..my_generation self phase archive {parameters (<>.some <a>.any)})
- (do phase.monad
- []
- (wrap (#synthesis.Extension self (list)))))
- ))
+ ## Synthesis
+ (analysis: (..my_synthesis self phase archive {parameters (<>.some <code>.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 <s>.any)})
- (do phase.monad
- []
- (wrap (for {@.jvm
- (row.row (#jvm.Constant (#jvm.LDC (#jvm.String self))))
+ (synthesis: (..my_synthesis self phase archive {pass_through <analysis>.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 <code>.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 <c>.any)})
- (do phase.monad
- [_ (type.infer .Text)]
- (wrap (#analysis.Primitive (#analysis.Text self)))))
+ (synthesis: (..my_generation self phase archive {parameters (<>.some <analysis>.any)})
+ (let [! phase.monad]
+ (|> parameters
+ (monad.map ! (phase archive))
+ (\ ! map (|>> (#synthesis.Extension self))))))
+
+ (generation: (..my_generation self phase archive {pass_through <synthesis>.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 <c>.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 <a>.any)})
- (do phase.monad
- []
- (wrap (synthesis.text self))))
-
- ## Directive
- (directive: (..my_directive self phase archive {parameters (<>.some <c>.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 <code>.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 [<macro> <extension>]
- [(_.cover [<macro>]
- (for {@.old
- false}
- (text\= (`` ((~~ (static <extension>))))
- <extension>)))]
+ (do random.monad
+ [expected random.nat]
+ (`` ($_ _.and
+ (~~ (template [<macro> <extension>]
+ [(_.cover [<macro>]
+ (for {@.old
+ false}
+ (n.= expected
+ (`` ((~~ (static <extension>)) 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 [<cap> <exception> <prefix> <suffix> <valid> <invalid>]
+ [(_.cover [<cap> <exception>]
+ (let [valid!
+ (|> <valid>
+ %.nat
+ (text.prefix <prefix>)
+ (text.suffix <suffix>)
+ (\ /.codec decode)
+ (case> (#try.Success _) true
+ (#try.Failure error) false))
+
+ invalid!
+ (|> <invalid>
+ %.nat
+ (text.prefix <prefix>)
+ (text.suffix <suffix>)
+ (\ /.codec decode)
+ (case> (#try.Success _)
+ false
+
+ (#try.Failure error)
+ (exception.match? <exception> 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)
+ (<text>.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
+ )))))