From 8aac0c573c29d2829242d66539a9e027d03ff8ec Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Mon, 11 Jan 2021 02:05:30 -0400 Subject: Encapsulate JS definitions produced by the JS compiler in a local scope to avoid interacting with the global scope. --- stdlib/source/test/aedifex/artifact.lux | 2 + stdlib/source/test/aedifex/artifact/versioning.lux | 43 +++++ stdlib/source/test/lux/control/remember.lux | 12 +- stdlib/source/test/lux/data/format/json.lux | 4 +- stdlib/source/test/lux/data/text/regex.lux | 5 +- stdlib/source/test/lux/macro.lux | 182 ++++++++++++++++++++- stdlib/source/test/lux/meta.lux | 10 -- stdlib/source/test/lux/time/instant.lux | 114 +++++++++---- 8 files changed, 311 insertions(+), 61 deletions(-) create mode 100644 stdlib/source/test/aedifex/artifact/versioning.lux (limited to 'stdlib/source/test') diff --git a/stdlib/source/test/aedifex/artifact.lux b/stdlib/source/test/aedifex/artifact.lux index 7409a65e2..7d91ebed7 100644 --- a/stdlib/source/test/aedifex/artifact.lux +++ b/stdlib/source/test/aedifex/artifact.lux @@ -22,6 +22,7 @@ ["#." type] ["#." extension] ["#." value] + ["#." versioning] ["#." time_stamp ["#/." date] ["#/." time]]] @@ -47,6 +48,7 @@ /type.test /extension.test /value.test + /versioning.test /time_stamp.test /time_stamp/date.test /time_stamp/time.test diff --git a/stdlib/source/test/aedifex/artifact/versioning.lux b/stdlib/source/test/aedifex/artifact/versioning.lux new file mode 100644 index 000000000..c0704440e --- /dev/null +++ b/stdlib/source/test/aedifex/artifact/versioning.lux @@ -0,0 +1,43 @@ +(.module: + [lux #* + ["_" test (#+ Test)] + [abstract + [monad (#+ do)] + {[0 #spec] + [/ + ["$." equivalence]]}] + [control + ["." try ("#\." functor)] + [parser + ["<.>" xml]]] + [math + ["." random (#+ Random)]]] + {#program + ["." /]}) + +(def: #export random + (Random /.Versioning) + ($_ random.and + random.instant + random.nat + (random.list 5 (random.ascii/lower_alpha 3)) + )) + +(def: #export test + Test + (<| (_.covering /._) + (_.for [/.Versioning]) + ($_ _.and + (_.for [/.equivalence] + ($equivalence.spec /.equivalence ..random)) + + (do random.monad + [expected ..random + version (random.ascii/upper_alpha 3)] + (_.cover [/.format /.parser] + (|> expected + (/.format version) + (.run (/.parser version)) + (try\map (\ /.equivalence = expected)) + (try.default false)))) + ))) diff --git a/stdlib/source/test/lux/control/remember.lux b/stdlib/source/test/lux/control/remember.lux index fb7517237..753130ea2 100644 --- a/stdlib/source/test/lux/control/remember.lux +++ b/stdlib/source/test/lux/control/remember.lux @@ -1,6 +1,7 @@ (.module: [lux #* ["_" test (#+ Test)] + ["." meta] [abstract ["." monad (#+ do)]] [control @@ -20,8 +21,7 @@ ["." date (#+ Date)] ["." instant] ["." duration]] - ["." meta] - [macro + ["." macro ["." code] ["." syntax (#+ syntax:)]]] {1 @@ -71,10 +71,10 @@ message (product.right (random.run prng ..message)) expected (product.right (random.run prng ..focus))] (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))))] + [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) diff --git a/stdlib/source/test/lux/data/format/json.lux b/stdlib/source/test/lux/data/format/json.lux index 4f14375d9..091f64b67 100644 --- a/stdlib/source/test/lux/data/format/json.lux +++ b/stdlib/source/test/lux/data/format/json.lux @@ -25,7 +25,7 @@ [number ["n" nat] ["." frac]]] - [macro + ["." macro ["." syntax (#+ syntax:)] ["." code]]] {1 @@ -58,7 +58,7 @@ (syntax: (string) (do meta.monad - [value (meta.gensym "string")] + [value (macro.gensym "string")] (wrap (list (code.text (%.code value)))))) (def: #export test diff --git a/stdlib/source/test/lux/data/text/regex.lux b/stdlib/source/test/lux/data/text/regex.lux index 2cdead181..fd82fdee5 100644 --- a/stdlib/source/test/lux/data/text/regex.lux +++ b/stdlib/source/test/lux/data/text/regex.lux @@ -15,8 +15,7 @@ [math [number (#+ hex)] ["." random]] - ["." meta] - [macro + ["." macro [syntax (#+ syntax:)]]] {1 ["." /]}) @@ -52,7 +51,7 @@ false))) (syntax: (should_check pattern regex input) - (meta.with_gensyms [g!message g!_] + (macro.with_gensyms [g!message g!_] (wrap (list (` (|> (~ input) (.run (~ regex)) (case> (^ (#try.Success (~ pattern))) diff --git a/stdlib/source/test/lux/macro.lux b/stdlib/source/test/lux/macro.lux index 54370efb9..0b1077526 100644 --- a/stdlib/source/test/lux/macro.lux +++ b/stdlib/source/test/lux/macro.lux @@ -1,17 +1,185 @@ (.module: [lux #* - ["_" test (#+ Test)]] + ["_" test (#+ Test)] + [abstract + [monad (#+ do)]] + [control + ["." try ("#\." functor)] + [parser + ["<.>" code]]] + [data + ["." bit ("#\." equivalence)] + ["." name] + ["." text + ["%" format (#+ format)]] + [collection + ["." list]]] + [math + ["." random (#+ Random)] + [number + ["." nat]]] + ["." meta + ["." location]]] + {1 + ["." / + [syntax (#+ syntax:)] + ["." code ("#\." equivalence)] + ["." template]]} ["." / #_ ["#." code] ["#." template] ["#." poly] ["#." syntax]]) +(template: (!expect ) + (case + true + _ false)) + +(template: (!global ) + (: [Text .Global] + [(template.text []) (#.Definition [true .Macro (' []) ])])) + +(syntax: (pow/2 number) + (wrap (list (` (nat.* (~ number) (~ number)))))) + +(syntax: (pow/4 number) + (wrap (list (` (..pow/2 (..pow/2 (~ number))))))) + +(syntax: (repeat {times .nat} token) + (wrap (list.repeat times token))) + +(syntax: (fresh_identifier) + (do meta.monad + [g!fresh (/.gensym "fresh")] + (wrap (list g!fresh)))) + +(def: random_lux + (Random [Nat Text .Lux]) + (do {! random.monad} + [seed random.nat + gensym_prefix (random.ascii/upper_alpha 1) + #let [macro_module (name.module (name_of /._)) + current_module (name.module (name_of .._))]] + (wrap [seed + gensym_prefix + {#.info {#.target "" + #.version "" + #.mode #.Build} + #.source [location.dummy 0 ""] + #.location location.dummy + #.current_module (#.Some current_module) + #.modules (list [macro_module + {#.module_hash 0 + #.module_aliases (list) + #.definitions (: (List [Text .Global]) + (list (!global /.log_expand_once!) + (!global /.log_expand!) + (!global /.log_expand_all!))) + #.imports (list) + #.tags (list) + #.types (list) + #.module_annotations #.None + #.module_state #.Active}] + [current_module + {#.module_hash 0 + #.module_aliases (list) + #.definitions (: (List [Text .Global]) + (list (!global ..pow/2) + (!global ..pow/4) + (!global ..repeat))) + #.imports (list) + #.tags (list) + #.types (list) + #.module_annotations #.None + #.module_state #.Active}]) + #.scopes (list) + #.type_context {#.ex_counter 0 + #.var_counter 0 + #.var_bindings (list)} + #.expected #.None + #.seed seed + #.scope_type_vars (list) + #.extensions [] + #.host []}]))) + +(def: expander + Test + (do {! random.monad} + [[seed gensym_prefix lux] ..random_lux + + pow/1 (\ ! map code.nat random.nat) + + repetitions (\ ! map (nat.% 10) random.nat) + #let [expand_once (` (..pow/2 (..pow/2 (~ pow/1)))) + expand (` (nat.* (..pow/2 (~ pow/1)) + (..pow/2 (~ pow/1)))) + expand_all (` (nat.* (nat.* (~ pow/1) (~ pow/1)) + (nat.* (~ pow/1) (~ pow/1))))]] + (`` ($_ _.and + (~~ (template [ ] + [(_.cover [] + (|> ( (` (..pow/4 (~ pow/1)))) + (meta.run lux) + (try\map (\ (list.equivalence code.equivalence) = + (list ))) + (try.default false))) + + (_.cover [] + (and (|> (/.expand_once (` ( (~' #omit) (..pow/4 (~ pow/1))))) + (meta.run lux) + (try\map (\ (list.equivalence code.equivalence) = (list))) + (try.default false)) + (|> (/.expand_once (` ( (..pow/4 (~ pow/1))))) + (meta.run lux) + (try\map (\ (list.equivalence code.equivalence) = (list ))) + (try.default false))))] + + [/.expand_once /.log_expand_once! expand_once] + [/.expand /.log_expand! expand] + [/.expand_all /.log_expand_all! expand_all] + )) + (_.cover [/.expand_1] + (bit\= (not (nat.= 1 repetitions)) + (|> (/.expand_1 (` (..repeat (~ (code.nat repetitions)) (~ pow/1)))) + (meta.run lux) + (!expect (#try.Failure _))))) + )))) + (def: #export test Test - ($_ _.and - /code.test - /template.test - /syntax.test - /poly.test - )) + (<| (_.covering /._) + ($_ _.and + (do {! random.monad} + [[seed gensym_prefix lux] ..random_lux] + ($_ _.and + (_.cover [/.gensym] + (|> (/.gensym gensym_prefix) + (\ meta.monad map %.code) + (meta.run lux) + (!expect (^multi (#try.Success actual_gensym) + (and (text.contains? gensym_prefix actual_gensym) + (text.contains? (%.nat seed) actual_gensym)))))) + (_.cover [/.wrong_syntax_error] + (|> (/.expand_once (` (/.log_expand_once!))) + (meta.run lux) + (!expect (^multi (#try.Failure error) + (text.contains? (/.wrong_syntax_error (name_of /.log_expand_once!)) + error))))) + (_.cover [/.with_gensyms] + (with_expansions [ (fresh_identifier)] + (|> (/.with_gensyms [] + (\ meta.monad wrap )) + (meta.run lux) + (!expect (^multi (#try.Success [_ (#.Identifier ["" actual])]) + (text.contains? (template.text []) + actual)))))) + )) + + ..expander + + /code.test + /template.test + /syntax.test + /poly.test + ))) diff --git a/stdlib/source/test/lux/meta.lux b/stdlib/source/test/lux/meta.lux index e740c1237..c1e0e8e03 100644 --- a/stdlib/source/test/lux/meta.lux +++ b/stdlib/source/test/lux/meta.lux @@ -49,7 +49,6 @@ expected_seed random.nat expected random.nat dummy (random.filter (|>> (n.= expected) not) random.nat) - expected_gensym (random.ascii/upper_alpha 1) #let [expected_lux {#.info {#.target target #.version version #.mode #.Build} @@ -292,7 +291,6 @@ expected_seed random.nat expected random.nat dummy (random.filter (|>> (n.= expected) not) random.nat) - expected_gensym (random.ascii/upper_alpha 1) expected_location ..random_location #let [type_context {#.ex_counter 0 #.var_counter 0 @@ -321,13 +319,6 @@ (!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 [/.location] (|> /.location (/.run expected_lux) @@ -781,7 +772,6 @@ expected_seed random.nat expected random.nat dummy (random.filter (|>> (n.= expected) not) random.nat) - expected_gensym (random.ascii/upper_alpha 1) expected_location ..random_location #let [expected_lux {#.info {#.target target #.version version diff --git a/stdlib/source/test/lux/time/instant.lux b/stdlib/source/test/lux/time/instant.lux index 9ed1df446..4f6080b48 100644 --- a/stdlib/source/test/lux/time/instant.lux +++ b/stdlib/source/test/lux/time/instant.lux @@ -1,9 +1,9 @@ (.module: [lux #* - ["%" data/text/format (#+ format)] ["_" test (#+ Test)] + ["." host] [abstract - [monad (#+ do Monad)] + [monad (#+ do)] {[0 #spec] [/ ["$." equivalence] @@ -11,48 +11,96 @@ ["$." enum] ["$." codec]]}] [control + ["." function] ["." try]] [data - ["." text]] + [collection + ["." list ("#\." fold)]]] [math - ["." random (#+ Random)] - [number - ["i" int]]] + ["." random]] [time - ["@d" duration] - ["@." date]]] + ["." duration (#+ Duration)] + ["." day (#+ Day) ("#\." enum)]]] {1 - ["." / (#+ Instant)]}) - -(def: #export instant - (Random Instant) - (\ random.monad map /.from_millis random.int)) + ["." /]}) (def: #export test Test - (<| (_.context (%.name (name_of /._))) + (<| (_.covering /._) + (_.for [/.Instant]) ($_ _.and - ($equivalence.spec /.equivalence ..instant) - ($order.spec /.order ..instant) - ($enum.spec /.enum ..instant) - ($codec.spec /.equivalence /.codec ..instant) + (_.for [/.equivalence] + ($equivalence.spec /.equivalence random.instant)) + (_.for [/.order] + ($order.spec /.order random.instant)) + (_.for [/.enum] + ($enum.spec /.enum random.instant)) + (_.for [/.codec] + ($codec.spec /.equivalence /.codec random.instant)) (do random.monad - [millis random.int] - (_.test "Can convert from/to milliseconds." - (|> millis /.from_millis /.to_millis (i.= millis)))) + [#let [(^open "\.") /.equivalence] + expected random.instant] + ($_ _.and + (_.cover [/.to_millis /.from_millis] + (|> expected /.to_millis /.from_millis (\= expected))) + (_.cover [/.relative /.absolute] + (|> expected /.relative /.absolute (\= expected))) + (_.cover [/.date /.time /.from_date_time] + (\= expected + (/.from_date_time (/.date expected) + (/.time expected)))) + )) (do random.monad - [sample instant - span random.duration - #let [(^open "@/.") /.equivalence - (^open "@d/.") @d.equivalence]] + [#let [(^open "\.") /.equivalence + (^open "duration\.") duration.equivalence] + from random.instant + to random.instant] ($_ _.and - (_.test "The span of a instant and itself has an empty duration." - (|> sample (/.span sample) (@d/= @d.empty))) - (_.test "Can shift a instant by a duration." - (|> sample (/.shift span) (/.span sample) (@d/= span))) - (_.test "Can obtain the time-span between the epoch and an instant." - (|> sample /.relative /.absolute (@/= sample))) - (_.test "All instants are relative to the epoch." - (|> /.epoch (/.shift (/.relative sample)) (@/= sample))))) + (_.cover [/.span] + (|> from (/.span from) (duration\= duration.empty))) + (_.cover [/.shift] + (|> from (/.shift (/.span from to)) (\= to))) + (_.cover [/.epoch] + (duration\= (/.relative to) + (/.span /.epoch to))) + )) + (do random.monad + [instant random.instant + #let [d0 (/.day_of_week instant)]] + (_.cover [/.day_of_week] + (let [apply (: (-> (-> Duration Duration) (-> Day Day) Nat Bit) + (function (_ polarity move steps) + (let [day_shift (list\fold (function.constant move) + d0 + (list.repeat steps [])) + instant_shift (|> instant + (/.shift (polarity (duration.up steps duration.day))) + /.day_of_week)] + (day\= day_shift + instant_shift))))] + (and (apply function.identity day\succ 0) + (apply function.identity day\succ 1) + (apply function.identity day\succ 2) + (apply function.identity day\succ 3) + (apply function.identity day\succ 4) + (apply function.identity day\succ 5) + (apply function.identity day\succ 6) + (apply function.identity day\succ 7) + + (apply duration.inverse day\pred 0) + (apply duration.inverse day\pred 1) + (apply duration.inverse day\pred 2) + (apply duration.inverse day\pred 3) + (apply duration.inverse day\pred 4) + (apply duration.inverse day\pred 5) + (apply duration.inverse day\pred 6) + (apply duration.inverse day\pred 7))))) + (_.cover [/.now] + (case (host.try /.now) + (#try.Success _) + true + + (#try.Failure _) + false)) ))) -- cgit v1.2.3