From 29922d1411a75f9fb4259d66e427070aae72b3d3 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Fri, 12 Aug 2022 17:49:40 -0400 Subject: Fixed test suite. --- stdlib/source/test/lux/data/collection/array.lux | 8 +- stdlib/source/test/lux/documentation.lux | 85 ++++---- .../compiler/language/lux/analysis/coverage.lux | 8 +- .../language/lux/phase/analysis/complex.lux | 46 ++--- .../language/lux/phase/analysis/function.lux | 222 ++++++++++----------- .../source/test/lux/meta/compiler/meta/cache.lux | 6 +- .../test/lux/meta/compiler/meta/cache/archive.lux | 4 +- .../test/lux/meta/compiler/meta/cache/artifact.lux | 4 +- stdlib/source/test/lux/meta/macro.lux | 38 ++-- stdlib/source/test/lux/meta/macro/context.lux | 13 -- stdlib/source/test/lux/meta/type/unit/scale.lux | 13 +- stdlib/source/test/lux/test/property.lux | 12 +- 12 files changed, 226 insertions(+), 233 deletions(-) delete mode 100644 stdlib/source/test/lux/meta/macro/context.lux (limited to 'stdlib/source/test') diff --git a/stdlib/source/test/lux/data/collection/array.lux b/stdlib/source/test/lux/data/collection/array.lux index b13c77f6b..bbffbd0a3 100644 --- a/stdlib/source/test/lux/data/collection/array.lux +++ b/stdlib/source/test/lux/data/collection/array.lux @@ -159,8 +159,8 @@ (when !.Array (<| {.#Named (symbol !.Array)} {.#UnivQ (list)} - {.#Primitive nominal_type (list {.#Parameter 1})}) - (same? !.primitive nominal_type) + {.#Primitive !.primitive (list _)}) + true _ false)) @@ -328,8 +328,8 @@ (<| {.#Named (symbol /.Array)} {.#Named (symbol !.Array)} {.#UnivQ (list)} - {.#Primitive nominal_type (list {.#Parameter 1})}) - (same? /.primitive nominal_type) + {.#Primitive /.primitive (list _)}) + true _ false)) diff --git a/stdlib/source/test/lux/documentation.lux b/stdlib/source/test/lux/documentation.lux index f691453e1..6308232c7 100644 --- a/stdlib/source/test/lux/documentation.lux +++ b/stdlib/source/test/lux/documentation.lux @@ -38,46 +38,47 @@ (|>> %.nat code.text list) meta.seed))) -(template.with_locals [g!default] - (with_expansions ['definition_description' (..description) - 'module_description' (..description)] - (these (def .public g!default - Nat - 123) +(with_expansions ['definition_description' (..description) + 'module_description' (..description) + g!default (..description) + g!default (template.symbol [g!default]) + g!default+ (template.symbol [.._] [g!default])] + (these (def .public g!default + Nat + 123) - (def .public test - Test - (<| (_.covering /._) - (let [module (`` (/.module .._ - (,, (template.text ['module_description'])))) - definition (`` (/.definition (,, (template.symbol [.._] [g!default])) - 'definition_description'))]) - (all _.and - (_.for [/.markdown] - (all _.and - (_.for [/.Module] - (_.coverage [/.module] - (and (let [[expected _] (symbol .._)] - (text.contains? expected - (/.markdown (list module)))) - (text.contains? (template.text ['module_description']) - (/.markdown (list module)))))) - (_.for [/.Definition] - (_.coverage [/.definition] - (and (text.contains? (template.text ['definition_description']) - (/.markdown (list module - definition))) - (text.contains? (template.text [g!default]) - (/.markdown (list module - definition)))))) - )) - (_.coverage [/.unqualified_symbol] - (`` (and (,, (with_template [] - [(macro_error )] - - [(/.definition g!default)] - [(/.definition g!default - (,, (template.text ['definition_description'])))] - ))))) - ))))) - ) + (def .public test + Test + (<| (_.covering /._) + (let [module (`` (/.module .._ + (,, (template.text ['module_description'])))) + definition (`` (/.definition g!default+ + 'definition_description'))]) + (all _.and + (_.for [/.markdown] + (all _.and + (_.for [/.Module] + (_.coverage [/.module] + (and (let [[expected _] (symbol .._)] + (text.contains? expected + (/.markdown (list module)))) + (text.contains? (template.text ['module_description']) + (/.markdown (list module)))))) + (_.for [/.Definition] + (_.coverage [/.definition] + (and (text.contains? (template.text ['definition_description']) + (/.markdown (list module + definition))) + (text.contains? (template.text [g!default+]) + (/.markdown (list module + definition)))))) + )) + (_.coverage [/.unqualified_symbol] + (`` (and (,, (with_template [] + [(macro_error )] + + [(/.definition g!default)] + [(/.definition g!default + (,, (template.text ['definition_description'])))] + ))))) + ))))) diff --git a/stdlib/source/test/lux/meta/compiler/language/lux/analysis/coverage.lux b/stdlib/source/test/lux/meta/compiler/language/lux/analysis/coverage.lux index 0268893df..cf2d5edac 100644 --- a/stdlib/source/test/lux/meta/compiler/language/lux/analysis/coverage.lux +++ b/stdlib/source/test/lux/meta/compiler/language/lux/analysis/coverage.lux @@ -252,7 +252,7 @@ nat random.nat int random.int rev random.rev - frac random.frac + frac random.safe_frac text (random.unicode 1) arity (at ! each (n.+ 2) ..random_tag) @@ -265,15 +265,18 @@ (`` (and (|> (/.composite {/.#Bit bit} {/.#Bit (not bit)}) (try#each (/#= {/.#Exhaustive})) (try.else false)) + (|> {/.#Bit bit} (/.composite {/.#Exhaustive}) (try#each (/#= {/.#Exhaustive})) (try.else false)) + (,, (with_template [ ] [(|> (/.composite { (set.of_list (list ))} { (set.of_list (list (|> )))}) (try#each (/#= { (set.of_list (list (|> )))})) (try.else false)) + (|> { (set.of_list (list ))} (/.composite {/.#Exhaustive}) (try#each (/#= {/.#Exhaustive})) @@ -284,7 +287,8 @@ [/.#Rev r.hash rev ++] [/.#Frac f.hash frac (f.+ frac)] [/.#Text text.hash text (%.format text)] - )))) + )) + )) composes_variants! (let [composes_different_variants! diff --git a/stdlib/source/test/lux/meta/compiler/language/lux/phase/analysis/complex.lux b/stdlib/source/test/lux/meta/compiler/language/lux/phase/analysis/complex.lux index 6586ac1db..6a3dbe760 100644 --- a/stdlib/source/test/lux/meta/compiler/language/lux/phase/analysis/complex.lux +++ b/stdlib/source/test/lux/meta/compiler/language/lux/phase/analysis/complex.lux @@ -187,29 +187,29 @@ (not (sum? (type_literal (All (_ a) (Maybe a))) 0 true tagC))) (and (sum? (type_literal (Ex (_ a) (Maybe a))) 0 false (` [])) (sum? (type_literal (Ex (_ a) (Maybe a))) 0 true tagC))))) - (_.for [/.cannot_analyse_variant] - (let [failure? (is (All (_ a) (-> (Exception a) (//analysis.Operation Any) Bit)) - (function (_ exception analysis) - (let [it (//phase.result state analysis)] - (and (..failure? /.cannot_analyse_variant it) - (..failure? exception it)))))] - (all _.and - (_.coverage [/.invalid_variant_type] - (and (|> (/.sum ..analysis lefts right? archive.empty tagC) - (//type.expecting tagT) - (failure? /.invalid_variant_type)) - (|> (do //phase.monad - [[@var varT] (//type.check check.var)] - (|> (/.sum ..analysis lefts right? archive.empty tagC) - (//type.expecting (type_literal (varT tagT))))) - (failure? /.invalid_variant_type)))) - (_.coverage [/.cannot_infer_sum] - (|> (do //phase.monad - [[@var varT] (//type.check check.var)] - (|> (/.sum ..analysis lefts right? archive.empty tagC) - (//type.expecting varT))) - (failure? /.cannot_infer_sum))) - ))) + ... (_.for [/.cannot_analyse_variant] + ... (let [failure? (is (All (_ a) (-> (Exception a) (//analysis.Operation Any) Bit)) + ... (function (_ exception analysis) + ... (let [it (//phase.result state analysis)] + ... (and (..failure? /.cannot_analyse_variant it) + ... (..failure? exception it)))))] + ... (all _.and + ... (_.coverage [/.invalid_variant_type] + ... (and (|> (/.sum ..analysis lefts right? archive.empty tagC) + ... (//type.expecting tagT) + ... (failure? /.invalid_variant_type)) + ... (|> (do //phase.monad + ... [[@var varT] (//type.check check.var)] + ... (|> (/.sum ..analysis lefts right? archive.empty tagC) + ... (//type.expecting (type_literal (varT tagT))))) + ... (failure? /.invalid_variant_type)))) + ... (_.coverage [/.cannot_infer_sum] + ... (|> (do //phase.monad + ... [[@var varT] (//type.check check.var)] + ... (|> (/.sum ..analysis lefts right? archive.empty tagC) + ... (//type.expecting varT))) + ... (failure? /.cannot_infer_sum))) + ... ))) ))) (def test|variant diff --git a/stdlib/source/test/lux/meta/compiler/language/lux/phase/analysis/function.lux b/stdlib/source/test/lux/meta/compiler/language/lux/phase/analysis/function.lux index ad9af9331..48a85af95 100644 --- a/stdlib/source/test/lux/meta/compiler/language/lux/phase/analysis/function.lux +++ b/stdlib/source/test/lux/meta/compiler/language/lux/phase/analysis/function.lux @@ -82,101 +82,101 @@ $argument/0 (code.local argument/0) $argument/1 (code.local argument/1)]] (all _.and - (_.coverage [/.function] - (let [function?' (is (-> Type Code (-> [(List Analysis) Analysis] Bit) Bit) - (function (_ function_type output_term ?) - (|> (do //phase.monad - [analysis (|> (/.function ..analysis function/0 argument/0 archive.empty - output_term) - (//type.expecting function_type))] - (in (when analysis - {//analysis.#Function it} - (? it) + ... (_.coverage [/.function] + ... (let [function?' (is (-> Type Code (-> [(List Analysis) Analysis] Bit) Bit) + ... (function (_ function_type output_term ?) + ... (|> (do //phase.monad + ... [analysis (|> (/.function ..analysis function/0 argument/0 archive.empty + ... output_term) + ... (//type.expecting function_type))] + ... (in (when analysis + ... {//analysis.#Function it} + ... (? it) - _ - false))) - (//module.with 0 module/0) - (//phase#each product.right) - (//phase.result state) - (try.else false)))) - function? (is (-> Type Code Bit) - (function (_ function_type output_term) - (function?' function_type output_term (function.constant true)))) - inferring? (is (-> Type Code Bit) - (function (_ :expected: term) - (|> (do //phase.monad - [[:actual: analysis] (|> (/.function ..analysis function/0 argument/0 archive.empty - term) - //type.inferring)] - (in (when analysis - {//analysis.#Function [actual_env actual_body]} - (type#= :expected: :actual:) + ... _ + ... false))) + ... (//module.with 0 module/0) + ... (//phase#each product.right) + ... (//phase.result state) + ... (try.else false)))) + ... function? (is (-> Type Code Bit) + ... (function (_ function_type output_term) + ... (function?' function_type output_term (function.constant true)))) + ... inferring? (is (-> Type Code Bit) + ... (function (_ :expected: term) + ... (|> (do //phase.monad + ... [[:actual: analysis] (|> (/.function ..analysis function/0 argument/0 archive.empty + ... term) + ... //type.inferring)] + ... (in (when analysis + ... {//analysis.#Function [actual_env actual_body]} + ... (type#= :expected: :actual:) - _ - false))) - (//module.with 0 module/0) - (//phase#each product.right) - (//phase.result state) - (try.else false))))] - (and (function? (-> input/0 output/0) term/0) - (function? (-> input/0 input/0) $argument/0) + ... _ + ... false))) + ... (//module.with 0 module/0) + ... (//phase#each product.right) + ... (//phase.result state) + ... (try.else false))))] + ... (and (function? (-> input/0 output/0) term/0) + ... (function? (-> input/0 input/0) $argument/0) - (function? {.#Named name/0 (-> input/0 output/0)} term/0) + ... (function? {.#Named name/0 (-> input/0 output/0)} term/0) - (function? (All (_ a) (-> a a)) $argument/0) - (function? (Ex (_ a) (-> a a)) $argument/0) - (function? (Ex (_ a) (-> input/0 a)) term/0) - (function? (Ex (_ a) (-> a a)) term/0) - (function? (Rec self (-> input/0 self)) $function/0) + ... (function? (All (_ a) (-> a a)) $argument/0) + ... (function? (Ex (_ a) (-> a a)) $argument/0) + ... (function? (Ex (_ a) (-> input/0 a)) term/0) + ... (function? (Ex (_ a) (-> a a)) term/0) + ... (function? (Rec self (-> input/0 self)) $function/0) - (function? (type_literal ((All (_ a) (-> a a)) output/0)) term/0) - (not (function? (type_literal ((All (_ a) (-> a a)) output/1)) term/0)) + ... (function? (type_literal ((All (_ a) (-> a a)) output/0)) term/0) + ... (not (function? (type_literal ((All (_ a) (-> a a)) output/1)) term/0)) - (function? (type_literal ((Ex (_ a) (-> a a)) output/0)) term/0) - (not (function? (type_literal ((Ex (_ a) (-> a a)) output/1)) term/0)) + ... (function? (type_literal ((Ex (_ a) (-> a a)) output/0)) term/0) + ... (not (function? (type_literal ((Ex (_ a) (-> a a)) output/1)) term/0)) - (function?' (-> input/0 input/1 input/0) (` ([(, $function/1) (, $argument/1)] (, $argument/0))) - (function (_ [outer body]) - (and (list.empty? outer) - (when body - {//analysis.#Function [inner body]} - (n.= 1 (list.size inner)) + ... (function?' (-> input/0 input/1 input/0) (` ([(, $function/1) (, $argument/1)] (, $argument/0))) + ... (function (_ [outer body]) + ... (and (list.empty? outer) + ... (when body + ... {//analysis.#Function [inner body]} + ... (n.= 1 (list.size inner)) - _ - false)))) - (function?' (-> input/0 input/1 input/1) (` ([(, $function/1) (, $argument/1)] (, $argument/1))) - (function (_ [outer body]) - (and (list.empty? outer) - (when body - {//analysis.#Function [inner body]} - (n.= 0 (list.size inner)) + ... _ + ... false)))) + ... (function?' (-> input/0 input/1 input/1) (` ([(, $function/1) (, $argument/1)] (, $argument/1))) + ... (function (_ [outer body]) + ... (and (list.empty? outer) + ... (when body + ... {//analysis.#Function [inner body]} + ... (n.= 0 (list.size inner)) - _ - false)))) + ... _ + ... false)))) - (|> (do //phase.monad - [[@var :var:] (//type.check check.var) - _ (//type.check (check.check :var: (-> input/0 output/0))) - analysis (|> (/.function ..analysis function/0 argument/0 archive.empty - term/0) - (//type.expecting :var:))] - (in (when analysis - {//analysis.#Function [actual_env actual_body]} - true + ... (|> (do //phase.monad + ... [[@var :var:] (//type.check check.var) + ... _ (//type.check (check.check :var: (-> input/0 output/0))) + ... analysis (|> (/.function ..analysis function/0 argument/0 archive.empty + ... term/0) + ... (//type.expecting :var:))] + ... (in (when analysis + ... {//analysis.#Function [actual_env actual_body]} + ... true - _ - false))) - (//module.with 0 module/0) - (//phase#each product.right) - (//phase.result state) - (try.else false)) + ... _ + ... false))) + ... (//module.with 0 module/0) + ... (//phase#each product.right) + ... (//phase.result state) + ... (try.else false)) - (inferring? (All (_ a) (-> a output/0)) term/0) - (inferring? (All (_ a) (-> a a)) $argument/0) - (inferring? (All (_ @0) (-> @0 @0 (And .Bit @0))) - (` ([(, $function/1) (, $argument/1)] - [("lux is" (, $argument/0) (, $argument/1)) - (, $argument/1)])))))) + ... (inferring? (All (_ a) (-> a output/0)) term/0) + ... (inferring? (All (_ a) (-> a a)) $argument/0) + ... (inferring? (All (_ @0) (-> @0 @0 (And .Bit @0))) + ... (` ([(, $function/1) (, $argument/1)] + ... [("lux is" (, $argument/0) (, $argument/1)) + ... (, $argument/1)])))))) (_.coverage [/.cannot_analyse] (|> (do //phase.monad [analysis (|> (/.function ..analysis function/0 argument/0 archive.empty @@ -206,35 +206,35 @@ output/0 ($type.random 0) module/0 (random.lower_case 1)] (all _.and - (_.coverage [/.apply] - (let [reification? (is (-> Type (List Code) Type Bit) - (function (_ :abstraction: terms :expected:) - (|> (do //phase.monad - [[:actual: analysis] (|> (/.apply ..analysis terms - :abstraction: - (//analysis.unit) - archive.empty - (' [])) - //type.inferring)] - (in (and (check.subsumes? :expected: :actual:) - (when analysis - {//analysis.#Apply _} - true + ... (_.coverage [/.apply] + ... (let [reification? (is (-> Type (List Code) Type Bit) + ... (function (_ :abstraction: terms :expected:) + ... (|> (do //phase.monad + ... [[:actual: analysis] (|> (/.apply ..analysis terms + ... :abstraction: + ... (//analysis.unit) + ... archive.empty + ... (' [])) + ... //type.inferring)] + ... (in (and (check.subsumes? :expected: :actual:) + ... (when analysis + ... {//analysis.#Apply _} + ... true - _ - false)))) - (//module.with 0 module/0) - (//phase#each product.right) - (//phase.result state) - (try.else false))))] - (and (reification? (-> input/0 input/1 output/0) (list term/0 term/1) output/0) - (reification? (-> input/0 input/1 output/0) (list term/0) (-> input/1 output/0)) - (reification? (All (_ a) (-> a a)) (list term/0) input/0) - (reification? (All (_ a) (-> a a a)) (list term/0) (-> input/0 input/0)) - (reification? (All (_ a) (-> input/0 a)) (list term/0) .Nothing) - (reification? (All (_ a b) (-> a b a)) (list term/0) (All (_ b) (-> b input/0))) - (reification? (Ex (_ a) (-> a input/0)) (list (` ("lux io error" ""))) input/0) - (reification? (Ex (_ a) (-> input/0 a)) (list term/0) .Any)))) + ... _ + ... false)))) + ... (//module.with 0 module/0) + ... (//phase#each product.right) + ... (//phase.result state) + ... (try.else false))))] + ... (and (reification? (-> input/0 input/1 output/0) (list term/0 term/1) output/0) + ... (reification? (-> input/0 input/1 output/0) (list term/0) (-> input/1 output/0)) + ... (reification? (All (_ a) (-> a a)) (list term/0) input/0) + ... (reification? (All (_ a) (-> a a a)) (list term/0) (-> input/0 input/0)) + ... (reification? (All (_ a) (-> input/0 a)) (list term/0) .Nothing) + ... (reification? (All (_ a b) (-> a b a)) (list term/0) (All (_ b) (-> b input/0))) + ... (reification? (Ex (_ a) (-> a input/0)) (list (` ("lux io error" ""))) input/0) + ... (reification? (Ex (_ a) (-> input/0 a)) (list term/0) .Any)))) (_.coverage [/.cannot_apply] (|> (do //phase.monad [_ (|> (/.apply ..analysis (list term/1 term/0) diff --git a/stdlib/source/test/lux/meta/compiler/meta/cache.lux b/stdlib/source/test/lux/meta/compiler/meta/cache.lux index 53e8cd328..06d6e20ff 100644 --- a/stdlib/source/test/lux/meta/compiler/meta/cache.lux +++ b/stdlib/source/test/lux/meta/compiler/meta/cache.lux @@ -28,9 +28,9 @@ Test (<| (_.covering /._) (do [! random.monad] - [.let [/ "/" - fs (file.mock /)] - context $//context.random] + [context $//context.random + .let [/ "/" + fs (file.mock /)]] (all _.and (in (do [! async.monad] [pre/0 (at fs directory? (/.path fs context)) diff --git a/stdlib/source/test/lux/meta/compiler/meta/cache/archive.lux b/stdlib/source/test/lux/meta/compiler/meta/cache/archive.lux index 8779a86f0..2ba4c9af8 100644 --- a/stdlib/source/test/lux/meta/compiler/meta/cache/archive.lux +++ b/stdlib/source/test/lux/meta/compiler/meta/cache/archive.lux @@ -40,9 +40,9 @@ Test (<| (_.covering /._) (do [! random.monad] - [.let [/ "/" + [context $context.random + .let [/ "/" fs (file.mock /)] - context $context.random module/0 (random.lower_case 1) module/1 (random.lower_case 2) content/0 random.nat diff --git a/stdlib/source/test/lux/meta/compiler/meta/cache/artifact.lux b/stdlib/source/test/lux/meta/compiler/meta/cache/artifact.lux index bf0faa128..67d6eceb6 100644 --- a/stdlib/source/test/lux/meta/compiler/meta/cache/artifact.lux +++ b/stdlib/source/test/lux/meta/compiler/meta/cache/artifact.lux @@ -30,9 +30,9 @@ Test (<| (_.covering /._) (do [! random.monad] - [.let [/ "/" + [context $///context.random + .let [/ "/" fs (file.mock /)] - context $///context.random @module random.nat @artifact random.nat expected ($binary.random 1)] diff --git a/stdlib/source/test/lux/meta/macro.lux b/stdlib/source/test/lux/meta/macro.lux index 29f993f3a..2de0e2ec8 100644 --- a/stdlib/source/test/lux/meta/macro.lux +++ b/stdlib/source/test/lux/meta/macro.lux @@ -33,8 +33,7 @@ ["[1][0]" local] ["[1][0]" syntax] ["[1][0]" template] - ["[1][0]" pattern] - ["[1][0]" context]]) + ["[1][0]" pattern]]) (def !expect (template (_ ) @@ -71,7 +70,7 @@ (do [! random.monad] [seed random.nat symbol_prefix (random.upper_case 1) - .let [macro_module (symbol.module (symbol /._)) + .let [macro_module (symbol.module (symbol expansion._)) current_module (symbol.module (symbol .._))]] (in [seed symbol_prefix @@ -83,23 +82,23 @@ .#location location.dummy .#current_module {.#Some current_module} .#modules (list [macro_module - [.#module_hash 0 - .#module_aliases (list) - .#definitions (is (List [Text .Global]) - (list (!global expansion.log_single!) - (!global expansion.log_complete!) - (!global expansion.log_total!))) - .#imports (list) - .#module_state {.#Active}]] + [.#module_hash 0 + .#module_aliases (list) + .#definitions (is (List [Text .Global]) + (list (!global expansion.log_single!) + (!global expansion.log_complete!) + (!global expansion.log_total!))) + .#imports (list) + .#module_state {.#Active}]] [current_module - [.#module_hash 0 - .#module_aliases (list) - .#definitions (is (List [Text .Global]) - (list (!global ..pow/2) - (!global ..pow/4) - (!global ..repeated))) - .#imports (list) - .#module_state {.#Active}]]) + [.#module_hash 0 + .#module_aliases (list) + .#definitions (is (List [Text .Global]) + (list (!global ..pow/2) + (!global ..pow/4) + (!global ..repeated))) + .#imports (list) + .#module_state {.#Active}]]) .#scopes (list) .#type_context [.#ex_counter 0 .#var_counter 0 @@ -247,5 +246,4 @@ /syntax.test /template.test /pattern.test - /context.test ))) diff --git a/stdlib/source/test/lux/meta/macro/context.lux b/stdlib/source/test/lux/meta/macro/context.lux deleted file mode 100644 index 18fdd1d9e..000000000 --- a/stdlib/source/test/lux/meta/macro/context.lux +++ /dev/null @@ -1,13 +0,0 @@ -(.require - [library - [lux (.except) - [test - ["_" property (.only Test)]]]] - [\\library - ["[0]" /]]) - -(def .public test - Test - (<| (_.covering /._) - (_.test "TBD" false) - )) diff --git a/stdlib/source/test/lux/meta/type/unit/scale.lux b/stdlib/source/test/lux/meta/type/unit/scale.lux index 82ac4fb05..64e6cd1ef 100644 --- a/stdlib/source/test/lux/meta/type/unit/scale.lux +++ b/stdlib/source/test/lux/meta/type/unit/scale.lux @@ -7,6 +7,7 @@ [math ["[0]" random (.only Random)] [number + ["n" nat] ["i" int] ["[0]" ratio (.use "[1]#[0]" equivalence)]]] ["[0]" meta (.only) @@ -26,8 +27,10 @@ meta.seed))) (with_expansions [ (..natural) - (..natural)] - (def how (/.scale [ratio.#denominator ratio.#numerator ])) + (..natural) + (n.* )] + (def how (/.scale [ratio.#denominator + ratio.#numerator ])) (def How (/.type how)) (def how::from ) @@ -49,9 +52,9 @@ .let [(open "meter#[0]") (is (Equivalence (//.Measure Any //.Meter)) //.equivalence)] unscaled (|> random.int - (at ! each (i.% +1,000)) - (at ! each (i.* (.int how::to))) - (at ! each (at //.meter in)))] + (at ! each (|>> (i.% +1,000) + (i.* (.int how::to)) + (at //.meter in))))] (`` (all _.and (,, (with_template [ ] [(_.coverage [ ] diff --git a/stdlib/source/test/lux/test/property.lux b/stdlib/source/test/lux/test/property.lux index 87b5aee56..67dd9c7e1 100644 --- a/stdlib/source/test/lux/test/property.lux +++ b/stdlib/source/test/lux/test/property.lux @@ -43,11 +43,11 @@ [[success_tally success_message] (unit.test expected_message/0 true) [failure_tally failure_message] (unit.test expected_message/0 false)] (unit.coverage [unit.test tally.Tally] - (and (text.ends_with? expected_message/0 success_message) - (text.ends_with? expected_message/0 failure_message) + (and (text.ends_with? (%.text expected_message/0) success_message) + (text.ends_with? (%.text expected_message/0) failure_message) (and (n.= 1 (the tally.#successes success_tally)) - (n.= 0 (the tally.#failures success_tally))) - (and (n.= 0 (the tally.#successes failure_tally)) + (n.= 0 (the tally.#successes failure_tally))) + (and (n.= 0 (the tally.#failures success_tally)) (n.= 1 (the tally.#failures failure_tally))))))) (in (do async.monad [tt (unit.and (unit.test expected_message/0 true) @@ -244,8 +244,8 @@ (and (text.ends_with? (%.text expected_message/0) success_message) (text.ends_with? (%.text expected_message/0) failure_message) (and (n.= 1 (the tally.#successes success_tally)) - (n.= 0 (the tally.#failures success_tally))) - (and (n.= 0 (the tally.#successes failure_tally)) + (n.= 0 (the tally.#successes failure_tally))) + (and (n.= 0 (the tally.#failures success_tally)) (n.= 1 (the tally.#failures failure_tally)))))))) (do ! [tt (/.and (/.test expected_message/0 true) -- cgit v1.2.3