diff options
Diffstat (limited to 'stdlib/source/test/lux/data')
21 files changed, 89 insertions, 238 deletions
diff --git a/stdlib/source/test/lux/data/binary.lux b/stdlib/source/test/lux/data/binary.lux index b7ae6bba4..3270e17a7 100644 --- a/stdlib/source/test/lux/data/binary.lux +++ b/stdlib/source/test/lux/data/binary.lux @@ -33,7 +33,7 @@ (def: .public (random size) (-> Nat (Random Binary)) - (let [output (/.create size)] + (let [output (/.empty size)] (loop [idx 0] (if (n.< size idx) (do random.monad @@ -54,7 +54,7 @@ (def: (binary_io power read write value) (-> Nat (-> Nat Binary (Try Nat)) (-> Nat Nat Binary (Try Any)) Nat Bit) (let [bytes (i64.left_shifted power 1) - binary (/.create bytes) + binary (/.empty bytes) cap (case bytes 8 (dec 0) _ (|> 1 (i64.left_shifted (n.* 8 bytes)) dec)) @@ -96,12 +96,12 @@ (n.= (\ list.fold fold n.+ 0 (..as_list sample)) (/.fold n.+ 0 sample))) - (_.cover [/.create] + (_.cover [/.empty] (\ /.equivalence = - (/.create size) - (/.create size))) + (/.empty size) + (/.empty size))) (_.cover [/.size] - (|> (/.create size) /.size (n.= size))) + (|> (/.empty size) /.size (n.= size))) (_.for [/.index_out_of_bounds] ($_ _.and (_.cover [/.read/8! /.write/8!] @@ -136,7 +136,7 @@ _ verdict)))) (_.cover [/.drop] (and (\ /.equivalence = sample (/.drop 0 sample)) - (\ /.equivalence = (/.create 0) (/.drop size sample)) + (\ /.equivalence = (/.empty 0) (/.drop size sample)) (case (list.reversed (..as_list sample)) #.End false @@ -145,7 +145,7 @@ (n.= (list.fold n.+ 0 tail) (/.fold n.+ 0 (/.drop 1 sample)))))) (_.cover [/.copy] - (and (case (/.copy size 0 sample 0 (/.create size)) + (and (case (/.copy size 0 sample 0 (/.empty size)) (#try.Success output) (and (not (is? sample output)) (\ /.equivalence = sample output)) @@ -155,7 +155,7 @@ (succeed (do try.monad [sample/0 (/.read/8! 0 sample) - copy (/.copy 1 0 sample 0 (/.create 2)) + copy (/.copy 1 0 sample 0 (/.empty 2)) copy/0 (/.read/8! 0 copy) copy/1 (/.read/8! 1 copy)] (in (and (n.= sample/0 copy/0) diff --git a/stdlib/source/test/lux/data/collection/array.lux b/stdlib/source/test/lux/data/collection/array.lux index 9925fccec..64e0f4268 100644 --- a/stdlib/source/test/lux/data/collection/array.lux +++ b/stdlib/source/test/lux/data/collection/array.lux @@ -9,9 +9,10 @@ ["$." monoid] ["$." fold] ["$." functor (#+ Injection)]]] + [control + ["." maybe]] [data ["." bit] - ["." maybe] [collection ["." list] ["." set]]] diff --git a/stdlib/source/test/lux/data/collection/dictionary.lux b/stdlib/source/test/lux/data/collection/dictionary.lux index aafa848b4..ad8a63d28 100644 --- a/stdlib/source/test/lux/data/collection/dictionary.lux +++ b/stdlib/source/test/lux/data/collection/dictionary.lux @@ -9,11 +9,11 @@ ["$." equivalence] ["$." functor (#+ Injection)]]] [control + ["." maybe ("#\." functor)] ["." try] ["." exception]] [data ["." product] - ["." maybe ("#\." functor)] [collection ["." list ("#\." functor)] ["." set]]] diff --git a/stdlib/source/test/lux/data/collection/dictionary/ordered.lux b/stdlib/source/test/lux/data/collection/dictionary/ordered.lux index 13971ad88..adce56dc3 100644 --- a/stdlib/source/test/lux/data/collection/dictionary/ordered.lux +++ b/stdlib/source/test/lux/data/collection/dictionary/ordered.lux @@ -8,10 +8,11 @@ [order (#+ Order)] [\\specification ["$." equivalence]]] + [control + ["." maybe ("#\." monad)]] [data ["." product] ["." bit ("#\." equivalence)] - ["." maybe ("#\." monad)] [collection ["." set] ["." list ("#\." functor)]]] @@ -52,9 +53,9 @@ .let [pairs (list.zipped/2 (set.list keys) (set.list values)) sample (/.of_list n.order pairs) - sorted_pairs (list.sort (function (_ [left _] [right _]) - (n.< left right)) - pairs) + sorted_pairs (list.sorted (function (_ [left _] [right _]) + (n.< left right)) + pairs) sorted_values (list\map product.right sorted_pairs) (^open "list\.") (list.equivalence (: (Equivalence [Nat Nat]) (function (_ [kr vr] [ks vs]) diff --git a/stdlib/source/test/lux/data/collection/dictionary/plist.lux b/stdlib/source/test/lux/data/collection/dictionary/plist.lux index fdbcccc06..ad74dc0a0 100644 --- a/stdlib/source/test/lux/data/collection/dictionary/plist.lux +++ b/stdlib/source/test/lux/data/collection/dictionary/plist.lux @@ -6,9 +6,10 @@ [monad (#+ do)] [\\specification ["$." equivalence]]] + [control + ["." maybe ("#\." monad)]] [data ["." bit ("#\." equivalence)] - ["." maybe ("#\." monad)] ["." text] [collection ["." set] diff --git a/stdlib/source/test/lux/data/collection/list.lux b/stdlib/source/test/lux/data/collection/list.lux index abf61aef3..426b556b8 100644 --- a/stdlib/source/test/lux/data/collection/list.lux +++ b/stdlib/source/test/lux/data/collection/list.lux @@ -16,11 +16,11 @@ [control pipe ["." io] + ["." maybe] ["." function]] [data ["." bit] ["." product] - ["." maybe] ["." text ("#\." equivalence)] [collection ["." set]]] @@ -72,10 +72,10 @@ (^open "io\.") io.monad expected (n.+ parameter subject)] (_.cover [/.with /.lift] - (|> (io.run (do (/.with io.monad) - [a (lift (io\in parameter)) - b (in subject)] - (in (n.+ a b)))) + (|> (io.run! (do (/.with io.monad) + [a (lift (io\in parameter)) + b (in subject)] + (in (n.+ a b)))) (case> (^ (list actual)) (n.= expected actual) @@ -113,16 +113,16 @@ (if (/.every? n.even? sample) (not (/.any? (bit.complement n.even?) sample)) (/.any? (bit.complement n.even?) sample))) - (_.cover [/.sort] + (_.cover [/.sorted] (let [<<< n.< size_preservation! (n.= (/.size sample) - (/.size (/.sort <<< sample))) + (/.size (/.sorted <<< sample))) symmetry! - (/\= (/.sort <<< sample) - (/.reversed (/.sort (function.flip <<<) sample)))] + (/\= (/.sorted <<< sample) + (/.reversed (/.sorted (function.flip <<<) sample)))] (and size_preservation! symmetry!))) ))) @@ -143,13 +143,13 @@ already_sorted! (/\= indices - (/.sort n.< indices)) + (/.sorted n.< indices)) expected_numbers! (/.every? (n.= (dec size)) (/.zipped_with/2 n.+ indices - (/.sort n.> indices)))] + (/.sorted n.> indices)))] (and expected_amount! already_sorted! expected_numbers!))) @@ -185,7 +185,7 @@ ..random) .let [size (/.size sample)] idx (\ ! map (n.% size) random.nat) - chunk_size (\ ! map (|>> (n.% size) inc) random.nat)] + sub_size (\ ! map (|>> (n.% size) inc) random.nat)] ($_ _.and (_.cover [/.only] (let [positives (/.only n.even? sample) @@ -218,11 +218,11 @@ (/\= sample (/\compose (/.take_while n.even? sample) (/.drop_while n.even? sample)))) - (_.cover [/.chunk] - (let [chunks (/.chunk chunk_size sample)] - (and (/.every? (|>> /.size (n.<= chunk_size)) chunks) + (_.cover [/.sub] + (let [subs (/.sub sub_size sample)] + (and (/.every? (|>> /.size (n.<= sub_size)) subs) (/\= sample - (/.concat chunks))))) + (/.concat subs))))) )))) (def: member @@ -407,9 +407,9 @@ ..grouping ..search - (_.cover [/.interpose] + (_.cover [/.interposed] (or (/.empty? sample) - (let [sample+ (/.interpose separator sample)] + (let [sample+ (/.interposed separator sample)] (and (n.= (|> (/.size sample) (n.* 2) dec) (/.size sample+)) (|> sample+ /.pairs (/.every? (|>> product.right (n.= separator)))))))) diff --git a/stdlib/source/test/lux/data/collection/queue/priority.lux b/stdlib/source/test/lux/data/collection/queue/priority.lux index 42ec9677e..20579c5b6 100644 --- a/stdlib/source/test/lux/data/collection/queue/priority.lux +++ b/stdlib/source/test/lux/data/collection/queue/priority.lux @@ -4,8 +4,9 @@ ["_" test (#+ Test)] [abstract ["." monad (#+ do)]] + [control + ["." maybe ("#\." functor)]] [data - ["." maybe ("#\." functor)] ["." bit ("#\." equivalence)]] [math ["." random (#+ Random)] diff --git a/stdlib/source/test/lux/data/collection/set/ordered.lux b/stdlib/source/test/lux/data/collection/set/ordered.lux index 260d6ee39..d5ff02472 100644 --- a/stdlib/source/test/lux/data/collection/set/ordered.lux +++ b/stdlib/source/test/lux/data/collection/set/ordered.lux @@ -66,7 +66,7 @@ (_.cover [/.list] (\ (list.equivalence n.equivalence) = (/.list (/.of_list n.order listL)) - (list.sort (\ n.order <) listL))) + (list.sorted (\ n.order <) listL))) (_.cover [/.of_list] (|> setL /.list (/.of_list n.order) diff --git a/stdlib/source/test/lux/data/collection/stack.lux b/stdlib/source/test/lux/data/collection/stack.lux index 082609904..1cb75755f 100644 --- a/stdlib/source/test/lux/data/collection/stack.lux +++ b/stdlib/source/test/lux/data/collection/stack.lux @@ -7,8 +7,9 @@ [\\specification ["$." equivalence] ["$." functor (#+ Injection)]]] + [control + ["." maybe]] [data - ["." maybe] ["." bit ("#\." equivalence)]] [math ["." random] diff --git a/stdlib/source/test/lux/data/collection/tree/finger.lux b/stdlib/source/test/lux/data/collection/tree/finger.lux index 79140887d..370a39a53 100644 --- a/stdlib/source/test/lux/data/collection/tree/finger.lux +++ b/stdlib/source/test/lux/data/collection/tree/finger.lux @@ -4,8 +4,9 @@ ["_" test (#+ Test)] [abstract [monad (#+ do)]] + [control + ["." maybe ("#\." functor)]] [data - ["." maybe ("#\." functor)] ["." text ("#\." equivalence monoid)] [collection ["." list ("#\." fold)]]] diff --git a/stdlib/source/test/lux/data/collection/tree/zipper.lux b/stdlib/source/test/lux/data/collection/tree/zipper.lux index 60c18d514..a4e73fb03 100644 --- a/stdlib/source/test/lux/data/collection/tree/zipper.lux +++ b/stdlib/source/test/lux/data/collection/tree/zipper.lux @@ -9,10 +9,10 @@ ["$." functor] ["$." comonad]]] [control - pipe] + pipe + ["." maybe ("#\." functor)]] [data ["." product] - ["." maybe ("#\." functor)] ["." text] [collection ["." list]]] diff --git a/stdlib/source/test/lux/data/format/json.lux b/stdlib/source/test/lux/data/format/json.lux index 6ff253a73..0444588e1 100644 --- a/stdlib/source/test/lux/data/format/json.lux +++ b/stdlib/source/test/lux/data/format/json.lux @@ -58,7 +58,7 @@ (syntax: (string) (do meta.monad - [value (macro.gensym "string")] + [value (macro.identifier "string")] (in (list (code.text (%.code value)))))) (def: .public test diff --git a/stdlib/source/test/lux/data/format/tar.lux b/stdlib/source/test/lux/data/format/tar.lux index c951382ba..0c43ada46 100644 --- a/stdlib/source/test/lux/data/format/tar.lux +++ b/stdlib/source/test/lux/data/format/tar.lux @@ -5,13 +5,13 @@ [abstract [monad (#+ do)]] [control + ["." maybe] ["." try] ["." exception] ["<>" parser ["<b>" binary]]] [data ["." product] - ["." maybe] ["." binary ("#\." equivalence monoid)] ["." text ("#\." equivalence) ["%" format (#+ format)] @@ -172,8 +172,8 @@ (|> (do try.monad [expected_path (/.path expected_path) tar (|> (row.row (<tag> expected_path)) - (format.run /.writer) - (<b>.run /.parser))] + (format.result /.writer) + (<b>.result /.parser))] (in (case (row.list tar) (^ (list (<tag> actual_path))) (text\= (/.from_path expected_path) @@ -201,8 +201,8 @@ #/.group {#/.name /.anonymous #/.id /.no_id}} expected_content])) - (format.run /.writer) - (<b>.run /.parser))] + (format.result /.writer) + (<b>.result /.parser))] (in (case (row.list tar) (^ (list (<tag> [actual_path actual_moment actual_mode actual_ownership actual_content]))) (let [seconds (: (-> Instant Int) @@ -250,7 +250,7 @@ (_.cover [/.and] (|> (do try.monad [path (/.path path) - content (/.content (binary.create 0)) + content (/.content (binary.empty 0)) tar (|> (row.row (#/.Normal [path (instant.of_millis +0) expected_mode @@ -259,8 +259,8 @@ #/.group {#/.name /.anonymous #/.id /.no_id}} content])) - (format.run /.writer) - (<b>.run /.parser))] + (format.result /.writer) + (<b>.result /.parser))] (in (case (row.list tar) (^ (list (#/.Normal [_ _ actual_mode _ _]))) (n.= (/.mode expected_mode) @@ -273,7 +273,7 @@ [(_.cover [<expected_mode>] (|> (do try.monad [path (/.path path) - content (/.content (binary.create 0)) + content (/.content (binary.empty 0)) tar (|> (row.row (#/.Normal [path (instant.of_millis +0) <expected_mode> @@ -282,8 +282,8 @@ #/.group {#/.name /.anonymous #/.id /.no_id}} content])) - (format.run /.writer) - (<b>.run /.parser))] + (format.result /.writer) + (<b>.result /.parser))] (in (case (row.list tar) (^ (list (#/.Normal [_ _ actual_mode _ _]))) (n.= (/.mode <expected_mode>) @@ -339,7 +339,7 @@ (_.cover [/.Name /.name /.from_name] (|> (do try.monad [path (/.path path) - content (/.content (binary.create 0)) + content (/.content (binary.empty 0)) expected (/.name expected) tar (|> (row.row (#/.Normal [path (instant.of_millis +0) @@ -349,8 +349,8 @@ #/.group {#/.name /.anonymous #/.id /.no_id}} content])) - (format.run /.writer) - (<b>.run /.parser))] + (format.result /.writer) + (<b>.result /.parser))] (in (case (row.list tar) (^ (list (#/.Normal [_ _ _ actual_ownership _]))) (and (text\= (/.from_name expected) @@ -364,7 +364,7 @@ (_.cover [/.anonymous /.no_id] (|> (do try.monad [path (/.path path) - content (/.content (binary.create 0)) + content (/.content (binary.empty 0)) tar (|> (row.row (#/.Normal [path (instant.of_millis +0) /.none @@ -373,8 +373,8 @@ #/.group {#/.name /.anonymous #/.id /.no_id}} content])) - (format.run /.writer) - (<b>.run /.parser))] + (format.result /.writer) + (<b>.result /.parser))] (in (case (row.list tar) (^ (list (#/.Normal [_ _ _ actual_ownership _]))) (and (text\= (/.from_name /.anonymous) @@ -400,13 +400,13 @@ ($_ _.and (_.cover [/.writer /.parser] (|> row.empty - (format.run /.writer) - (<b>.run /.parser) + (format.result /.writer) + (<b>.result /.parser) (\ try.monad map row.empty?) (try.else false))) (_.cover [/.invalid_end_of_archive] - (let [dump (format.run /.writer row.empty)] - (case (<b>.run /.parser (binary\compose dump dump)) + (let [dump (format.result /.writer row.empty)] + (case (<b>.result /.parser (binary\compose dump dump)) (#try.Success _) false diff --git a/stdlib/source/test/lux/data/format/xml.lux b/stdlib/source/test/lux/data/format/xml.lux index 3ec5618a3..4fef01a10 100644 --- a/stdlib/source/test/lux/data/format/xml.lux +++ b/stdlib/source/test/lux/data/format/xml.lux @@ -9,12 +9,12 @@ ["$." codec]]] [control pipe + ["." maybe] ["." try] ["p" parser ["</>" xml]]] [data ["." name] - ["." maybe] ["." text ("#\." equivalence) ["%" format (#+ format)]] [collection diff --git a/stdlib/source/test/lux/data/lazy.lux b/stdlib/source/test/lux/data/lazy.lux deleted file mode 100644 index c9de9cb25..000000000 --- a/stdlib/source/test/lux/data/lazy.lux +++ /dev/null @@ -1,67 +0,0 @@ -(.module: - [library - [lux #* - ["_" test (#+ Test)] - [abstract - [monad (#+ do)] - [\\specification - ["$." functor (#+ Injection Comparison)] - ["$." apply] - ["$." monad] - ["$." equivalence]]] - [data - ["." product]] - [math - ["." random (#+ Random)] - [number - ["n" nat]]]]] - [\\library - ["." / (#+ Lazy)]]) - -(def: injection - (Injection Lazy) - (|>> /.lazy)) - -(def: comparison - (Comparison Lazy) - (function (_ ==) - (\ (/.equivalence ==) =))) - -(def: .public lazy - (All [a] (-> (Random a) (Random (Lazy a)))) - (\ random.functor map (|>> /.lazy))) - -(def: .public test - Test - (with_expansions [<eager> (: [Nat Nat] - [(n.+ left right) - (n.* left right)])] - (<| (_.covering /._) - (do random.monad - [left random.nat - right random.nat - .let [expected <eager>]] - (_.for [/.Lazy] - ($_ _.and - (_.for [/.equivalence] - ($equivalence.spec (/.equivalence n.equivalence) (..lazy random.nat))) - (_.for [/.functor] - ($functor.spec ..injection ..comparison /.functor)) - (_.for [/.apply] - ($apply.spec ..injection ..comparison /.apply)) - (_.for [/.monad] - ($monad.spec ..injection ..comparison /.monad)) - - (_.cover [/.lazy] - (let [lazy (/.lazy <eager>) - (^open "\=") (product.equivalence n.equivalence n.equivalence)] - (\= expected - (/.value lazy)))) - - (_.cover [/.value] - (let [lazy (/.lazy <eager>)] - (and (not (is? expected - (/.value lazy))) - (is? (/.value lazy) - (/.value lazy))))) - )))))) diff --git a/stdlib/source/test/lux/data/maybe.lux b/stdlib/source/test/lux/data/maybe.lux deleted file mode 100644 index dd32c20db..000000000 --- a/stdlib/source/test/lux/data/maybe.lux +++ /dev/null @@ -1,88 +0,0 @@ -(.module: - [library - [lux #* - ["_" test (#+ Test)] - [abstract - [monad (#+ do)] - [\\specification - ["$." equivalence] - ["$." hash] - ["$." monoid] - ["$." functor] - ["$." apply] - ["$." monad]]] - [control - ["." io ("#\." monad)] - pipe] - [data - ["." text] - [collection - ["." list]]] - [math - ["." random (#+ Random)] - [number - ["n" nat]]]]] - [\\library - ["." / ("#\." monoid monad)]]) - -(def: .public test - Test - (<| (_.covering /._) - (_.for [.Maybe]) - ($_ _.and - (_.for [/.equivalence] - ($equivalence.spec (/.equivalence n.equivalence) (random.maybe random.nat))) - (_.for [/.hash] - (|> random.nat - (\ random.monad map (|>> #.Some)) - ($hash.spec (/.hash n.hash)))) - (_.for [/.monoid] - ($monoid.spec (/.equivalence n.equivalence) /.monoid (random.maybe random.nat))) - (_.for [/.functor] - ($functor.spec /\in /.equivalence /.functor)) - (_.for [/.apply] - ($apply.spec /\in /.equivalence /.apply)) - (_.for [/.monad] - ($monad.spec /\in /.equivalence /.monad)) - - (do random.monad - [left random.nat - right random.nat - .let [expected (n.+ left right)]] - (let [lift (/.lift io.monad)] - (_.cover [/.with /.lift] - (|> (io.run (do (/.with io.monad) - [a (lift (io\in left)) - b (in right)] - (in (n.+ a b)))) - (case> (#.Some actual) - (n.= expected actual) - - _ - false))))) - (do random.monad - [default random.nat - value random.nat] - (_.cover [/.else] - (and (is? default (/.else default - #.None)) - - (is? value (/.else default - (#.Some value)))))) - (do random.monad - [value random.nat] - (_.cover [/.assume] - (is? value (/.assume (#.Some value))))) - (do random.monad - [value random.nat] - (_.cover [/.list] - (\ (list.equivalence n.equivalence) = - (list value) - (/.list (#.Some value))))) - (do random.monad - [expected random.nat - .let [(^open "/\.") (/.equivalence n.equivalence)]] - (_.cover [/.when] - (and (/\= (#.Some expected) (/.when true (#.Some expected))) - (/\= #.None (/.when false (#.Some expected)))))) - ))) diff --git a/stdlib/source/test/lux/data/product.lux b/stdlib/source/test/lux/data/product.lux index 3b846940f..9d9b9e248 100644 --- a/stdlib/source/test/lux/data/product.lux +++ b/stdlib/source/test/lux/data/product.lux @@ -50,18 +50,18 @@ [left random.nat right random.nat] ($_ _.and - (<| (_.cover [/.swap]) + (<| (_.cover [/.swapped]) (let [pair [left right]] (and (n.= (/.left pair) - (/.right (/.swap pair))) + (/.right (/.swapped pair))) (n.= (/.right pair) - (/.left (/.swap pair)))))) - (<| (_.cover [/.uncurry]) + (/.left (/.swapped pair)))))) + (<| (_.cover [/.uncurried]) (n.= (n.+ left right) - ((/.uncurry n.+) [left right]))) - (<| (_.cover [/.curry]) + ((/.uncurried n.+) [left right]))) + (<| (_.cover [/.curried]) (n.= (n.+ left right) - ((/.curry (/.uncurry n.+)) left right))) + ((/.curried (/.uncurried n.+)) left right))) (<| (_.cover [/.apply]) (let [[left' right'] (/.apply (n.+ shift) (n.- shift) [left right])] (and (n.= (n.+ shift left) left') diff --git a/stdlib/source/test/lux/data/text.lux b/stdlib/source/test/lux/data/text.lux index 4ff904116..3c70075d1 100644 --- a/stdlib/source/test/lux/data/text.lux +++ b/stdlib/source/test/lux/data/text.lux @@ -10,9 +10,9 @@ ["$." order] ["$." monoid]]] [control - pipe] + pipe + ["." maybe]] [data - ["." maybe] [collection ["." list] ["." set]]] @@ -323,8 +323,8 @@ .let [part_gen (|> (random.text normal_char_gen sizeP) (random.only (|>> (/.contains? sep1) not)))] parts (random.list sizeL part_gen) - .let [sample1 (/.concat (list.interpose sep1 parts)) - sample2 (/.concat (list.interpose sep2 parts)) + .let [sample1 (/.concat (list.interposed sep1 parts)) + sample2 (/.concat (list.interposed sep2 parts)) (^open "/\.") /.equivalence]] (_.cover [/.replaced] (/\= sample2 diff --git a/stdlib/source/test/lux/data/text/encoding.lux b/stdlib/source/test/lux/data/text/encoding.lux index 662643d3c..126cb6556 100644 --- a/stdlib/source/test/lux/data/text/encoding.lux +++ b/stdlib/source/test/lux/data/text/encoding.lux @@ -7,9 +7,9 @@ [\\specification ["$." codec]]] [control + ["." maybe] ["." try]] [data - ["." maybe] ["." text ("#\." equivalence)] [collection ["." list ("#\." fold)] @@ -29,7 +29,7 @@ [/.ascii]] [all/ibm<700 - [/.ibm_37 + [/.ibm_037 /.ibm_273 /.ibm_277 /.ibm_278 diff --git a/stdlib/source/test/lux/data/text/escape.lux b/stdlib/source/test/lux/data/text/escape.lux index 35dfaf1cf..8e8c4b1df 100644 --- a/stdlib/source/test/lux/data/text/escape.lux +++ b/stdlib/source/test/lux/data/text/escape.lux @@ -72,8 +72,8 @@ (syntax: (static_sample) (do meta.monad [seed meta.seed - .let [[_ expected] (random.run (random.pcg_32 [seed seed]) - (random.ascii 10))]] + .let [[_ expected] (random.result (random.pcg_32 [seed seed]) + (random.ascii 10))]] (in (list (code.text expected))))) (syntax: (static_escaped {un_escaped <code>.text}) diff --git a/stdlib/source/test/lux/data/text/regex.lux b/stdlib/source/test/lux/data/text/regex.lux index 263c6cb50..c0b1f9183 100644 --- a/stdlib/source/test/lux/data/text/regex.lux +++ b/stdlib/source/test/lux/data/text/regex.lux @@ -24,7 +24,7 @@ (def: (should_pass regex input) (-> (Parser Text) Text Bit) (|> input - (<text>.run regex) + (<text>.result regex) (case> (#try.Success parsed) (text\= parsed input) @@ -34,7 +34,7 @@ (def: (text_should_pass test regex input) (-> Text (Parser Text) Text Bit) (|> input - (<text>.run regex) + (<text>.result regex) (case> (#try.Success parsed) (text\= test parsed) @@ -44,7 +44,7 @@ (def: (should_fail regex input) (All [a] (-> (Parser a) Text Bit)) (|> input - (<text>.run regex) + (<text>.result regex) (case> (#try.Failure _) true @@ -52,9 +52,9 @@ false))) (syntax: (should_check pattern regex input) - (macro.with_gensyms [g!message g!_] + (macro.with_identifiers [g!message g!_] (in (list (` (|> (~ input) - (<text>.run (~ regex)) + (<text>.result (~ regex)) (case> (^ (#try.Success (~ pattern))) true |