From 706ce9e4916b65c4df5101bd3cc1b4da3b2057af Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Sat, 9 Jan 2021 12:58:50 -0400 Subject: Turned I64 and variant creation functions into constructors for JS. --- stdlib/source/test/aedifex/artifact.lux | 2 + stdlib/source/test/aedifex/artifact/value.lux | 38 +++++ stdlib/source/test/lux.lux | 117 +++++++------- stdlib/source/test/lux/host.js.lux | 24 +-- stdlib/source/test/lux/math/number/frac.lux | 3 +- stdlib/source/test/lux/meta.lux | 214 ++++++++++++++++++++++++-- stdlib/source/test/lux/time/day.lux | 35 +++-- stdlib/source/test/lux/time/duration.lux | 100 +++++++++--- stdlib/source/test/lux/time/instant.lux | 4 +- 9 files changed, 415 insertions(+), 122 deletions(-) create mode 100644 stdlib/source/test/aedifex/artifact/value.lux (limited to 'stdlib/source/test') diff --git a/stdlib/source/test/aedifex/artifact.lux b/stdlib/source/test/aedifex/artifact.lux index dc2de91f7..7409a65e2 100644 --- a/stdlib/source/test/aedifex/artifact.lux +++ b/stdlib/source/test/aedifex/artifact.lux @@ -21,6 +21,7 @@ ["." / #_ ["#." type] ["#." extension] + ["#." value] ["#." time_stamp ["#/." date] ["#/." time]]] @@ -45,6 +46,7 @@ /type.test /extension.test + /value.test /time_stamp.test /time_stamp/date.test /time_stamp/time.test diff --git a/stdlib/source/test/aedifex/artifact/value.lux b/stdlib/source/test/aedifex/artifact/value.lux new file mode 100644 index 000000000..10e9016b1 --- /dev/null +++ b/stdlib/source/test/aedifex/artifact/value.lux @@ -0,0 +1,38 @@ +(.module: + [lux #* + ["_" test (#+ Test)] + [abstract + [monad (#+ do)] + {[0 #spec] + [/ + ["$." equivalence]]}] + [control + ["." try ("#\." functor)] + [parser + ["<.>" text]]] + [math + ["." random (#+ Random)] + [number + ["n" nat] + ["i" int]]] + [time + ["." instant]]] + {#program + ["." /]}) + +(def: #export random + (Random /.Value) + ($_ random.and + (random.ascii/alpha 5) + random.instant + random.nat + )) + +(def: #export test + Test + (<| (_.covering /._) + (_.for [/.Build /.Value]) + ($_ _.and + (_.for [/.equivalence] + ($equivalence.spec /.equivalence ..random)) + ))) diff --git a/stdlib/source/test/lux.lux b/stdlib/source/test/lux.lux index 2fb01ad72..f1200381a 100644 --- a/stdlib/source/test/lux.lux +++ b/stdlib/source/test/lux.lux @@ -1,42 +1,46 @@ -(.module: - ["/" lux #* - [program (#+ program:)] - ["_" test (#+ Test)] - ["@" target] - [abstract - [monad (#+ do)] - [predicate (#+ Predicate)]] - [control - ["." io (#+ io)]] - [data - ["." name] - [text - ["%" format (#+ format)]]] - ["." math - ["." random (#+ Random) ("#\." functor)] - [number - ["n" nat] - ["i" int] - ["r" rev] - ["f" frac] - ["." i64]]]] - ## TODO: Must have 100% coverage on tests. - ["." / #_ - ["#." abstract] - ["#." control] - ["#." data] - ["#." locale] - ["#." macro] - ["#." math] - ["#." meta] - ["#." time] - ## ["#." tool] - ["#." type] - ["#." world] - ["#." host] - ["#." extension] - ["#." target #_ - ["#/." jvm]]]) +(.with_expansions [' (.for {"{old}" (.as_is ["#/." jvm]) + "JVM" (.as_is ["#/." jvm])} + (.as_is)) + '] + (.module: + ["/" lux #* + [program (#+ program:)] + ["_" test (#+ Test)] + ["@" target] + [abstract + [monad (#+ do)] + [predicate (#+ Predicate)]] + [control + ["." io (#+ io)]] + [data + ["." name] + [text + ["%" format (#+ format)]]] + ["." math + ["." random (#+ Random) ("#\." functor)] + [number + ["n" nat] + ["i" int] + ["r" rev] + ["f" frac] + ["." i64]]]] + ## TODO: Must have 100% coverage on tests. + ["." / #_ + ["#." abstract] + ["#." control] + ["#." data] + ["#." locale] + ["#." macro] + ["#." math] + ["#." meta] + ["#." time] + ## ["#." tool] + ["#." type] + ["#." world] + ["#." host] + ["#." extension] + ["#." target #_ + ]])) ## TODO: Get rid of this ASAP (template: (!bundle body) @@ -211,22 +215,25 @@ (def: sub_tests Test - (_.in_parallel (list& /abstract.test - /control.test - /data.test - /locale.test - /macro.test - /math.test - /meta.test - /time.test - ## /tool.test - /type.test - /world.test - /host.test - /target/jvm.test - (for {@.old (list)} - (list /extension.test)) - ))) + (let [tail (: (List Test) + (for {@.old (list)} + (list /extension.test)))] + (_.in_parallel (list& /abstract.test + /control.test + /data.test + /locale.test + /macro.test + /math.test + /meta.test + /time.test + ## /tool.test + /type.test + /world.test + /host.test + (for {@.jvm (#.Cons /target/jvm.test tail) + @.old (#.Cons /target/jvm.test tail)} + tail) + )))) (def: test (<| (_.context (name.module (name_of /._))) diff --git a/stdlib/source/test/lux/host.js.lux b/stdlib/source/test/lux/host.js.lux index 6147ef9b9..5ffe1fbeb 100644 --- a/stdlib/source/test/lux/host.js.lux +++ b/stdlib/source/test/lux/host.js.lux @@ -50,16 +50,16 @@ object random.nat] (<| (_.covering /._) ($_ _.and - (_.cover [/.on-browser? /.on-node-js? /.on-nashorn?] - (or /.on-nashorn? - /.on-node-js? - /.on-browser?)) - (_.cover [/.type-of] - (and (text\= "boolean" (/.type-of boolean)) - (text\= "number" (/.type-of number)) - (text\= "string" (/.type-of string)) - (text\= "function" (/.type-of function)) - (text\= "object" (/.type-of object)))) + (_.cover [/.on_browser? /.on_node_js? /.on_nashorn?] + (or /.on_nashorn? + /.on_node_js? + /.on_browser?)) + (_.cover [/.type_of] + (and (text\= "boolean" (/.type_of boolean)) + (text\= "number" (/.type_of number)) + (text\= "string" (/.type_of string)) + (text\= "function" (/.type_of function)) + (text\= "object" (/.type_of object)))) (_.cover [/.try] (case (/.try (error! string)) (#try.Success _) @@ -70,12 +70,12 @@ (_.cover [/.import:] (let [encoding "utf8"] (text\= string - (cond /.on-nashorn? + (cond /.on_nashorn? (let [binary (java/lang/String::getBytes [encoding] (:coerce java/lang/String string))] (|> (java/lang/String::new [binary encoding]) (:coerce Text))) - /.on-node-js? + /.on_node_js? (|> (Buffer::from [string encoding]) (Buffer::toString [encoding])) diff --git a/stdlib/source/test/lux/math/number/frac.lux b/stdlib/source/test/lux/math/number/frac.lux index 0bbe19697..5f37be2ef 100644 --- a/stdlib/source/test/lux/math/number/frac.lux +++ b/stdlib/source/test/lux/math/number/frac.lux @@ -123,7 +123,8 @@ (#static doubleToRawLongBits [double] long) (#static longBitsToDouble [long] double)]))] (for {@.old (as_is ) - @.jvm (as_is )})) + @.jvm (as_is )} + (as_is))) (def: #export test Test diff --git a/stdlib/source/test/lux/meta.lux b/stdlib/source/test/lux/meta.lux index c1972a991..e740c1237 100644 --- a/stdlib/source/test/lux/meta.lux +++ b/stdlib/source/test/lux/meta.lux @@ -1,6 +1,7 @@ (.module: [lux #* ["_" test (#+ Test)] + ["." type ("#\." equivalence)] [abstract [monad (#+ do)] {[0 #spec] @@ -9,13 +10,17 @@ ["$." apply] ["$." monad]]}] [control - ["." try]] + ["." try (#+ Try) ("#\." functor)]] [data + ["." product] + ["." maybe] ["." bit ("#\." equivalence)] + ["." name ("#\." equivalence)] ["." text ("#\." equivalence) ["%" format (#+ format)]] [collection - ["." list]]] + ["." list ("#\." functor monoid)] + ["." set]]] [meta ["." location]] [math @@ -161,14 +166,18 @@ version (random.ascii/upper_alpha 1) source_code (random.ascii/upper_alpha 1) expected_current_module (random.ascii/upper_alpha 1) + imported_module_name (random.filter (|>> (text\= expected_current_module) not) + (random.ascii/upper_alpha 1)) primitive_type (random.ascii/upper_alpha 1) expected_seed random.nat expected random.nat dummy (random.filter (|>> (n.= expected) not) random.nat) expected_short (random.ascii/upper_alpha 1) - dummy_module (random.filter (|>> (text\= expected_current_module) not) + dummy_module (random.filter (function (_ module) + (not (or (text\= expected_current_module module) + (text\= imported_module_name module)))) (random.ascii/upper_alpha 1)) - #let [expected_module {#.module_hash 0 + #let [imported_module {#.module_hash 0 #.module_aliases (list) #.definitions (list) #.imports (list) @@ -176,8 +185,18 @@ #.types (list) #.module_annotations #.None #.module_state #.Active} + expected_module {#.module_hash 0 + #.module_aliases (list) + #.definitions (list) + #.imports (list imported_module_name) + #.tags (list) + #.types (list) + #.module_annotations #.None + #.module_state #.Active} expected_modules (list [expected_current_module - expected_module]) + expected_module] + [imported_module_name + imported_module]) expected_lux {#.info {#.target target #.version version #.mode #.Build} @@ -222,6 +241,25 @@ (/.run expected_lux) (!expect (^multi (#try.Success actual_modules) (is? expected_modules actual_modules))))) + (_.cover [/.imported_modules] + (and (|> (/.imported_modules expected_current_module) + (/.run expected_lux) + (try\map (\ (list.equivalence text.equivalence) = + (list imported_module_name))) + (try.default false)) + (|> (/.imported_modules imported_module_name) + (/.run expected_lux) + (try\map (\ (list.equivalence text.equivalence) = + (list))) + (try.default false)))) + (_.cover [/.imported_by?] + (|> (/.imported_by? imported_module_name expected_current_module) + (/.run expected_lux) + (try.default false))) + (_.cover [/.imported?] + (|> (/.imported? imported_module_name) + (/.run expected_lux) + (try.default false))) (_.cover [/.normalize] (and (|> (/.normalize ["" expected_short]) (/.run expected_lux) @@ -256,7 +294,10 @@ 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 + #let [type_context {#.ex_counter 0 + #.var_counter 0 + #.var_bindings (list)} + expected_lux {#.info {#.target target #.version version #.mode #.Build} #.source [location.dummy 0 source_code] @@ -264,9 +305,7 @@ #.current_module (#.Some expected_current_module) #.modules (list) #.scopes (list) - #.type_context {#.ex_counter 0 - #.var_counter 0 - #.var_bindings (list)} + #.type_context type_context #.expected (#.Some expected_type) #.seed expected_seed #.scope_type_vars (list) @@ -299,6 +338,11 @@ (/.run expected_lux) (!expect (^multi (#try.Success actual_type) (is? expected_type actual_type))))) + (_.cover [/.type_context] + (|> /.type_context + (/.run expected_lux) + (try\map (is? type_context)) + (try.default false))) ))) (def: definition_related @@ -487,6 +531,17 @@ #.extensions [] #.host []}])))]] ($_ _.and + (_.cover [/.find_export] + (and (let [[current_globals macro_globals expected_lux] + (expected_lux true (#.Some expected_type))] + (|> (/.find_export [expected_macro_module expected_short]) + (/.run expected_lux) + (!expect (#try.Success _)))) + (let [[current_globals macro_globals expected_lux] + (expected_lux false (#.Some expected_type))] + (|> (/.find_export [expected_macro_module expected_short]) + (/.run expected_lux) + (!expect (#try.Failure _)))))) (_.cover [/.find_macro] (let [same_module! (let [[current_globals macro_globals expected_lux] @@ -521,6 +576,17 @@ not_macro! not_found! aliasing!))) + (_.cover [/.un_alias] + (let [[current_globals macro_globals expected_lux] + (expected_lux true (#.Some .Macro))] + (and (|> (/.un_alias [expected_macro_module expected_short]) + (/.run expected_lux) + (try\map (name\= [expected_macro_module expected_short])) + (try.default false)) + (|> (/.un_alias [expected_current_module expected_short]) + (/.run expected_lux) + (try\map (name\= [expected_macro_module expected_short])) + (try.default false))))) (_.cover [/.find_def] (let [[current_globals macro_globals expected_lux] (expected_lux expected_exported? (#.Some expected_type)) @@ -578,6 +644,113 @@ alias!))) ))) +(def: tags_related + Test + (do {! random.monad} + [current_module (random.ascii/upper_alpha 1) + tag_module (random.filter (|>> (text\= current_module) not) + (random.ascii/upper_alpha 1)) + + name_0 (random.ascii/upper_alpha 1) + name_1 (random.filter (|>> (text\= name_0) not) + (random.ascii/upper_alpha 1)) + + #let [random_tag (\ ! map (|>> [tag_module]) + (random.ascii/upper_alpha 1))] + all_tags (|> random_tag + (random.set name.hash 10) + (\ ! map set.to_list)) + #let [tags_0 (list.take 5 all_tags) + tags_1 (list.drop 5 all_tags) + + type_0 (#.Primitive name_0 (list)) + type_1 (#.Primitive name_1 (list)) + + entry_0 [name_0 [tags_0 false type_0]] + entry_1 [name_1 [tags_1 true type_1]] + + expected_lux + (: Lux + {#.info {#.target "" + #.version "" + #.mode #.Build} + #.source [location.dummy 0 ""] + #.location location.dummy + #.current_module (#.Some current_module) + #.modules (list [current_module + {#.module_hash 0 + #.module_aliases (list) + #.definitions (list) + #.imports (list tag_module) + #.tags (list) + #.types (list) + #.module_annotations #.None + #.module_state #.Active}] + [tag_module + {#.module_hash 0 + #.module_aliases (list) + #.definitions (list) + #.imports (list) + #.tags (list\compose (|> tags_0 + list.enumeration + (list\map (function (_ [index [_ short]]) + [short [index tags_0 false type_0]]))) + (|> tags_1 + list.enumeration + (list\map (function (_ [index [_ short]]) + [short [index tags_1 true type_1]])))) + #.types (list entry_0 entry_1) + #.module_annotations #.None + #.module_state #.Active}]) + #.scopes (list) + #.type_context {#.ex_counter 0 + #.var_counter 0 + #.var_bindings (list)} + #.expected #.None + #.seed 0 + #.scope_type_vars (list) + #.extensions [] + #.host []})]] + ($_ _.and + (_.cover [/.tag_lists] + (let [equivalence (list.equivalence + (product.equivalence + (list.equivalence name.equivalence) + type.equivalence))] + (|> (/.tag_lists tag_module) + (/.run expected_lux) + (try\map (\ equivalence = (list [tags_1 type_1]))) + (try.default false)))) + (_.cover [/.tags_of] + (|> (/.tags_of [tag_module name_1]) + (/.run expected_lux) + (try\map (\ (maybe.equivalence (list.equivalence name.equivalence)) = (#.Some tags_1))) + (try.default false))) + (_.cover [/.resolve_tag] + (|> tags_1 + list.enumeration + (list.every? (function (_ [expected_index tag]) + (|> tag + /.resolve_tag + (/.run expected_lux) + (!expect (^multi (^ (#try.Success [actual_index actual_tags actual_type])) + (let [correct_index! + (n.= expected_index + actual_index) + + correct_tags! + (\ (list.equivalence name.equivalence) = + tags_1 + actual_tags) + + correct_type! + (type\= type_1 + actual_type)] + (and correct_index! + correct_tags! + correct_type!))))))))) + ))) + (def: injection (Injection Meta) (\ /.monad wrap)) @@ -613,7 +786,7 @@ #let [expected_lux {#.info {#.target target #.version version #.mode #.Build} - #.source [location.dummy 0 source_code] + #.source [expected_location 0 source_code] #.location expected_location #.current_module (#.Some expected_current_module) #.modules (list) @@ -633,6 +806,26 @@ ($apply.spec ..injection (..comparison expected_lux) /.apply)) (_.for [/.monad] ($monad.spec ..injection (..comparison expected_lux) /.monad)) + + (do random.monad + [expected_value random.nat + expected_error (random.ascii/upper_alpha 1)] + (_.cover [/.lift] + (and (|> expected_error + #try.Failure + (: (Try Nat)) + /.lift + (/.run expected_lux) + (!expect (^multi (#try.Failure actual) + (text\= (location.with expected_location expected_error) + actual)))) + (|> expected_value + #try.Success + (: (Try Nat)) + /.lift + (/.run expected_lux) + (!expect (^multi (#try.Success actual) + (is? expected_value actual))))))) ..compiler_related ..error_handling @@ -640,6 +833,7 @@ ..context_related ..definition_related ..search_related + ..tags_related )) /annotation.test diff --git a/stdlib/source/test/lux/time/day.lux b/stdlib/source/test/lux/time/day.lux index a08b54659..89a1aa3d4 100644 --- a/stdlib/source/test/lux/time/day.lux +++ b/stdlib/source/test/lux/time/day.lux @@ -1,6 +1,5 @@ (.module: [lux #* - ["%" data/text/format (#+ format)] ["_" test (#+ Test)] [abstract {[0 #spec] @@ -9,25 +8,29 @@ ["$." order] ["$." enum]]}] [math - ["r" random (#+ Random) ("#\." monad)]]] + ["." random (#+ Random) ("#\." monad)]]] {1 - ["." / (#+ Day)]}) + ["." /]}) -(def: #export day - (Random Day) - (r.either (r.either (r.either (r\wrap #/.Sunday) - (r\wrap #/.Monday)) - (r.either (r\wrap #/.Tuesday) - (r\wrap #/.Wednesday))) - (r.either (r.either (r\wrap #/.Thursday) - (r\wrap #/.Friday)) - (r\wrap #/.Saturday)))) +(def: #export random + (Random /.Day) + (random.either (random.either (random.either (random\wrap #/.Sunday) + (random\wrap #/.Monday)) + (random.either (random\wrap #/.Tuesday) + (random\wrap #/.Wednesday))) + (random.either (random.either (random\wrap #/.Thursday) + (random\wrap #/.Friday)) + (random\wrap #/.Saturday)))) (def: #export test Test - (<| (_.context (%.name (name_of /._))) + (<| (_.covering /._) + (_.for [/.Day]) ($_ _.and - ($equivalence.spec /.equivalence ..day) - ($order.spec /.order ..day) - ($enum.spec /.enum ..day) + (_.for [/.equivalence] + ($equivalence.spec /.equivalence ..random)) + (_.for [/.order] + ($order.spec /.order ..random)) + (_.for [/.enum] + ($enum.spec /.enum ..random)) ))) diff --git a/stdlib/source/test/lux/time/duration.lux b/stdlib/source/test/lux/time/duration.lux index af9d46014..24d5449f3 100644 --- a/stdlib/source/test/lux/time/duration.lux +++ b/stdlib/source/test/lux/time/duration.lux @@ -1,6 +1,5 @@ (.module: [lux #* - ["%" data/text/format (#+ format)] ["_" test (#+ Test)] [abstract [monad (#+ do)] @@ -8,43 +7,94 @@ [/ ["$." equivalence] ["$." order] + ["$." enum] ["$." monoid] ["$." codec]]}] + [data + ["." bit ("#\." equivalence)]] [math ["." random (#+ Random)] [number ["n" nat] ["i" int]]]] {1 - ["." / (#+ Duration)]}) - -(def: #export duration - (Random Duration) - (\ random.monad map /.from_millis random.int)) + ["." /]}) (def: #export test Test - (<| (_.context (%.name (name_of /._))) + (<| (_.covering /._) + (_.for [/.Duration]) ($_ _.and - ($equivalence.spec /.equivalence ..duration) - ($order.spec /.order ..duration) - ($monoid.spec /.equivalence /.monoid ..duration) - ($codec.spec /.equivalence /.codec ..duration) + (_.for [/.equivalence] + ($equivalence.spec /.equivalence random.duration)) + (_.for [/.order] + ($order.spec /.order random.duration)) + (_.for [/.enum] + ($enum.spec /.enum random.duration)) + (_.for [/.monoid] + ($monoid.spec /.equivalence /.monoid random.duration)) + (_.for [/.codec] + ($codec.spec /.equivalence /.codec random.duration)) (do random.monad - [millis random.int] - (_.test "Can convert from/to milliseconds." - (|> millis /.from_millis /.to_millis (i.= millis)))) - (do {! random.monad} - [sample (|> duration (\ ! map (/.frame /.day))) - frame duration - factor (|> random.nat (\ ! map (|>> (n.% 10) (n.max 1)))) - #let [(^open "/\.") /.order]] + [duration random.duration] + (_.cover [/.from_millis /.to_millis] + (|> duration /.to_millis /.from_millis (\ /.equivalence = duration)))) + (do random.monad + [#let [(^open "\.") /.equivalence] + expected random.duration + parameter random.duration] ($_ _.and - (_.test "Can scale a duration." - (|> sample (/.up factor) (/.query sample) (i.= (.int factor)))) - (_.test "Scaling a duration by one does not change it." - (|> sample (/.up 1) (/\= sample))) - (_.test "Merging a duration with it's opposite yields an empty duration." - (|> sample (/.merge (/.inverse sample)) (/\= /.empty))))) + (_.cover [/.merge /.difference] + (|> expected (/.merge parameter) (/.difference parameter) (\= expected))) + (_.cover [/.empty] + (|> expected (/.merge /.empty) (\= expected))) + (_.cover [/.inverse] + (and (|> expected /.inverse /.inverse (\= expected)) + (|> expected (/.merge (/.inverse expected)) (\= /.empty)))) + (_.cover [/.positive? /.negative? /.neutral?] + (or (bit\= (/.positive? expected) + (/.negative? (/.inverse expected))) + (bit\= (/.neutral? expected) + (/.neutral? (/.inverse expected))))) + )) + (do random.monad + [#let [(^open "\.") /.equivalence] + factor random.nat] + (_.cover [/.up /.down] + (|> /.milli_second (/.up factor) (/.down factor) (\= /.milli_second)))) + (do {! random.monad} + [#let [(^open "\.") /.order + positive (|> random.duration + (random.filter (|>> (\= /.empty) not)) + (\ ! map (function (_ duration) + (if (/.positive? duration) + duration + (/.inverse duration)))))] + sample positive + frame positive] + (`` ($_ _.and + (_.cover [/.frame] + (let [sample' (/.frame frame sample)] + (and (\< frame sample') + (bit\= (\< frame sample) + (\= sample sample'))))) + (_.cover [/.query] + (i.= +1 (/.query sample sample))) + (_.cover [/.milli_second] + (\= /.empty (\ /.enum pred /.milli_second))) + (~~ (template [ ] + [(_.cover [] + (|> (/.query ) (i.= )))] + + [+1,000 /.second /.milli_second] + [+60 /.minute /.second] + [+60 /.hour /.minute] + [+24 /.day /.hour] + + [+7 /.week /.day] + [+365 /.normal_year /.day] + [+366 /.leap_year /.day] + )) + ))) ))) diff --git a/stdlib/source/test/lux/time/instant.lux b/stdlib/source/test/lux/time/instant.lux index 65fed1248..9ed1df446 100644 --- a/stdlib/source/test/lux/time/instant.lux +++ b/stdlib/source/test/lux/time/instant.lux @@ -21,8 +21,6 @@ [time ["@d" duration] ["@." date]]] - [// - ["_." duration]] {1 ["." / (#+ Instant)]}) @@ -45,7 +43,7 @@ (|> millis /.from_millis /.to_millis (i.= millis)))) (do random.monad [sample instant - span _duration.duration + span random.duration #let [(^open "@/.") /.equivalence (^open "@d/.") @d.equivalence]] ($_ _.and -- cgit v1.2.3