diff options
Diffstat (limited to 'stdlib/source/test/lux/data')
30 files changed, 1450 insertions, 1450 deletions
diff --git a/stdlib/source/test/lux/data/binary.lux b/stdlib/source/test/lux/data/binary.lux index ce286a113..3d828dbb2 100644 --- a/stdlib/source/test/lux/data/binary.lux +++ b/stdlib/source/test/lux/data/binary.lux @@ -51,24 +51,24 @@ (#try.Success _) false)) -(def: (binary-io bytes read write value) +(def: (binary_io bytes read write value) (-> Nat (-> Nat Binary (Try Nat)) (-> Nat Nat Binary (Try Any)) Nat Bit) (let [binary (/.create bytes) cap (case bytes 8 (dec 0) - _ (|> 1 (i64.left-shift (n.* 8 bytes)) dec)) - capped-value (i64.and cap value)] + _ (|> 1 (i64.left_shift (n.* 8 bytes)) dec)) + capped_value (i64.and cap value)] (and (succeed (do try.monad [pre (read 0 binary) _ (write 0 value binary) post (read 0 binary)] (wrap (and (n.= 0 pre) - (n.= capped-value post))))) - (throws? /.index-out-of-bounds (read 1 binary)) - (throws? /.index-out-of-bounds (write 1 value binary))))) + (n.= capped_value post))))) + (throws? /.index_out_of_bounds (read 1 binary)) + (throws? /.index_out_of_bounds (write 1 value binary))))) -(def: as-list +(def: as_list (-> /.Binary (List Nat)) (/.fold (function (_ head tail) (#.Cons head tail)) @@ -78,12 +78,12 @@ Test (<| (_.covering /._) (do {! random.monad} - [#let [gen-size (|> random.nat (\ ! map (|>> (n.% 100) (n.max 8))))] - size gen-size + [#let [gen_size (|> random.nat (\ ! map (|>> (n.% 100) (n.max 8))))] + size gen_size sample (..random size) value random.nat - #let [gen-idx (|> random.nat (\ ! map (n.% size)))] - [from to] (random.and gen-idx gen-idx) + #let [gen_idx (|> random.nat (\ ! map (n.% size)))] + [from to] (random.and gen_idx gen_idx) #let [[from to] [(n.min from to) (n.max from to)]]] (_.for [/.Binary] ($_ _.and @@ -92,7 +92,7 @@ (_.for [/.monoid] ($monoid.spec /.equivalence /.monoid (..random size))) (_.cover [/.fold] - (n.= (\ list.fold fold n.+ 0 (..as-list sample)) + (n.= (\ list.fold fold n.+ 0 (..as_list sample)) (/.fold n.+ 0 sample))) (_.cover [/.create] @@ -101,39 +101,39 @@ (/.create size))) (_.cover [/.size] (|> (/.create size) /.size (n.= size))) - (_.for [/.index-out-of-bounds] + (_.for [/.index_out_of_bounds] ($_ _.and (_.cover [/.read/8 /.write/8] - (..binary-io 1 /.read/8 /.write/8 value)) + (..binary_io 1 /.read/8 /.write/8 value)) (_.cover [/.read/16 /.write/16] - (..binary-io 2 /.read/16 /.write/16 value)) + (..binary_io 2 /.read/16 /.write/16 value)) (_.cover [/.read/32 /.write/32] - (..binary-io 4 /.read/32 /.write/32 value)) + (..binary_io 4 /.read/32 /.write/32 value)) (_.cover [/.read/64 /.write/64] - (..binary-io 8 /.read/64 /.write/64 value)))) + (..binary_io 8 /.read/64 /.write/64 value)))) (_.cover [/.slice] - (let [slice-size (|> to (n.- from) inc) - random-slice (try.assume (/.slice from to sample)) - idxs (enum.range n.enum 0 (dec slice-size)) + (let [slice_size (|> to (n.- from) inc) + random_slice (try.assume (/.slice from to sample)) + idxs (enum.range n.enum 0 (dec slice_size)) reader (function (_ binary idx) (/.read/8 idx binary))] - (and (n.= slice-size (/.size random-slice)) - (case [(monad.map try.monad (reader random-slice) idxs) + (and (n.= slice_size (/.size random_slice)) + (case [(monad.map try.monad (reader random_slice) idxs) (monad.map try.monad (|>> (n.+ from) (reader sample)) idxs)] - [(#try.Success slice-vals) (#try.Success binary-vals)] - (\ (list.equivalence n.equivalence) = slice-vals binary-vals) + [(#try.Success slice_vals) (#try.Success binary_vals)] + (\ (list.equivalence n.equivalence) = slice_vals binary_vals) _ #0)))) - (_.cover [/.slice-out-of-bounds] - (and (throws? /.slice-out-of-bounds (/.slice size size sample)) - (throws? /.slice-out-of-bounds (/.slice from size sample)))) - (_.cover [/.inverted-slice] - (or (throws? /.inverted-slice (/.slice to from sample)) + (_.cover [/.slice_out_of_bounds] + (and (throws? /.slice_out_of_bounds (/.slice size size sample)) + (throws? /.slice_out_of_bounds (/.slice from size sample)))) + (_.cover [/.inverted_slice] + (or (throws? /.inverted_slice (/.slice to from sample)) (n.= to from))) (_.cover [/.drop] (and (\ /.equivalence = sample (/.drop 0 sample)) (\ /.equivalence = (/.create 0) (/.drop size sample)) - (case (list.reverse (..as-list sample)) + (case (list.reverse (..as_list sample)) #.Nil false diff --git a/stdlib/source/test/lux/data/collection/array.lux b/stdlib/source/test/lux/data/collection/array.lux index d47defeaf..ab1b1f04c 100644 --- a/stdlib/source/test/lux/data/collection/array.lux +++ b/stdlib/source/test/lux/data/collection/array.lux @@ -26,9 +26,9 @@ (def: injection (Injection Array) - (|>> list /.from-list)) + (|>> list /.from_list)) -(def: bounded-size +(def: bounded_size (Random Nat) (\ random.monad map (|>> (n.% 100) (n.+ 1)) random.nat)) @@ -36,7 +36,7 @@ (def: structures Test (do {! random.monad} - [size ..bounded-size] + [size ..bounded_size] ($_ _.and (_.for [/.equivalence] ($equivalence.spec (/.equivalence n.equivalence) (random.array size random.nat))) @@ -51,23 +51,23 @@ (def: search Test (do {! random.monad} - [size ..bounded-size + [size ..bounded_size base random.nat shift random.nat #let [expected (n.+ base shift)] - the-array (random.array size random.nat)] + the_array (random.array size random.nat)] ($_ _.and (_.cover [/.find] (\ (maybe.equivalence n.equivalence) = - (/.find n.even? the-array) - (list.find n.even? (/.to-list the-array)))) + (/.find n.even? the_array) + (list.find n.even? (/.to_list the_array)))) (_.cover [/.find+] - (case [(/.find n.even? the-array) + (case [(/.find n.even? the_array) (/.find+ (function (_ idx member) (n.even? member)) - the-array)] + the_array)] [(#.Some expected) (#.Some [idx actual])] - (case (/.read idx the-array) + (case (/.read idx the_array) (#.Some again) (and (n.= expected actual) (n.= actual again)) @@ -79,12 +79,12 @@ true)) (_.cover [/.every?] (\ bit.equivalence = - (list.every? n.even? (/.to-list the-array)) - (/.every? n.even? the-array))) + (list.every? n.even? (/.to_list the_array)) + (/.every? n.even? the_array))) (_.cover [/.any?] (\ bit.equivalence = - (list.any? n.even? (/.to-list the-array)) - (/.any? n.even? the-array))) + (list.any? n.even? (/.to_list the_array)) + (/.any? n.even? the_array))) ))) (def: #export test @@ -92,12 +92,12 @@ (<| (_.covering /._) (_.for [/.Array]) (do {! random.monad} - [size ..bounded-size + [size ..bounded_size base random.nat shift random.nat dummy (random.filter (|>> (n.= base) not) random.nat) #let [expected (n.+ base shift)] - the-array (random.array size random.nat)] + the_array (random.array size random.nat)] ($_ _.and ..structures ..search @@ -105,61 +105,61 @@ (_.cover [/.new /.size] (n.= size (/.size (: (Array Nat) (/.new size))))) - (_.cover [/.type-name] + (_.cover [/.type_name] (case (:of (/.new size)) - (^ (#.UnivQ _ (#.Apply _ (#.Named _ (#.UnivQ _ (#.Primitive nominal-type (list (#.Parameter 1)))))))) - (text\= /.type-name nominal-type) + (^ (#.UnivQ _ (#.Apply _ (#.Named _ (#.UnivQ _ (#.Primitive nominal_type (list (#.Parameter 1)))))))) + (text\= /.type_name nominal_type) _ false)) (_.cover [/.read /.write!] - (let [the-array (|> (/.new 2) + (let [the_array (|> (/.new 2) (: (Array Nat)) (/.write! 0 expected))] - (case [(/.read 0 the-array) - (/.read 1 the-array)] + (case [(/.read 0 the_array) + (/.read 1 the_array)] [(#.Some actual) #.None] (n.= expected actual) _ false))) (_.cover [/.delete!] - (let [the-array (|> (/.new 1) + (let [the_array (|> (/.new 1) (: (Array Nat)) (/.write! 0 expected))] - (case [(/.read 0 the-array) - (/.read 0 (/.delete! 0 the-array))] + (case [(/.read 0 the_array) + (/.read 0 (/.delete! 0 the_array))] [(#.Some actual) #.None] (n.= expected actual) _ false))) (_.cover [/.contains?] - (let [the-array (|> (/.new 2) + (let [the_array (|> (/.new 2) (: (Array Nat)) (/.write! 0 expected))] - (and (/.contains? 0 the-array) - (not (/.contains? 1 the-array))))) + (and (/.contains? 0 the_array) + (not (/.contains? 1 the_array))))) (_.cover [/.update!] - (let [the-array (|> (/.new 1) + (let [the_array (|> (/.new 1) (: (Array Nat)) (/.write! 0 base) (/.update! 0 (n.+ shift)))] - (case (/.read 0 the-array) + (case (/.read 0 the_array) (#.Some actual) (n.= expected actual) _ false))) (_.cover [/.upsert!] - (let [the-array (|> (/.new 2) + (let [the_array (|> (/.new 2) (: (Array Nat)) (/.write! 0 base) (/.upsert! 0 dummy (n.+ shift)) (/.upsert! 1 base (n.+ shift)))] - (case [(/.read 0 the-array) - (/.read 1 the-array)] + (case [(/.read 0 the_array) + (/.read 1 the_array)] [(#.Some actual/0) (#.Some actual/1)] (and (n.= expected actual/0) (n.= expected actual/1)) @@ -169,55 +169,55 @@ (do ! [occupancy (\ ! map (n.% (inc size)) random.nat)] (_.cover [/.occupancy /.vacancy] - (let [the-array (loop [output (: (Array Nat) + (let [the_array (loop [output (: (Array Nat) (/.new size)) idx 0] (if (n.< occupancy idx) (recur (/.write! idx expected output) (inc idx)) output))] - (and (n.= occupancy (/.occupancy the-array)) - (n.= size (n.+ (/.occupancy the-array) - (/.vacancy the-array))))))) + (and (n.= occupancy (/.occupancy the_array)) + (n.= size (n.+ (/.occupancy the_array) + (/.vacancy the_array))))))) (do ! - [the-list (random.list size random.nat)] - (_.cover [/.from-list /.to-list] - (and (|> the-list /.from-list /.to-list - (\ (list.equivalence n.equivalence) = the-list)) - (|> the-array /.to-list /.from-list - (\ (/.equivalence n.equivalence) = the-array))))) + [the_list (random.list size random.nat)] + (_.cover [/.from_list /.to_list] + (and (|> the_list /.from_list /.to_list + (\ (list.equivalence n.equivalence) = the_list)) + (|> the_array /.to_list /.from_list + (\ (/.equivalence n.equivalence) = the_array))))) (do ! [amount (\ ! map (n.% (inc size)) random.nat)] (_.cover [/.copy!] (let [copy (: (Array Nat) (/.new size))] - (exec (/.copy! amount 0 the-array 0 copy) + (exec (/.copy! amount 0 the_array 0 copy) (\ (list.equivalence n.equivalence) = - (list.take amount (/.to-list the-array)) - (/.to-list copy)))))) + (list.take amount (/.to_list the_array)) + (/.to_list copy)))))) (_.cover [/.clone] - (let [clone (/.clone the-array)] - (and (not (is? the-array clone)) - (\ (/.equivalence n.equivalence) = the-array clone)))) - (let [the-array (/.clone the-array) - evens (|> the-array /.to-list (list.filter n.even?)) - odds (|> the-array /.to-list (list.filter n.odd?))] + (let [clone (/.clone the_array)] + (and (not (is? the_array clone)) + (\ (/.equivalence n.equivalence) = the_array clone)))) + (let [the_array (/.clone the_array) + evens (|> the_array /.to_list (list.filter n.even?)) + odds (|> the_array /.to_list (list.filter n.odd?))] (_.cover [/.filter!] - (exec (/.filter! n.even? the-array) - (and (n.= (list.size evens) (/.occupancy the-array)) - (n.= (list.size odds) (/.vacancy the-array)) - (|> the-array /.to-list (\ (list.equivalence n.equivalence) = evens)))))) + (exec (/.filter! n.even? the_array) + (and (n.= (list.size evens) (/.occupancy the_array)) + (n.= (list.size odds) (/.vacancy the_array)) + (|> the_array /.to_list (\ (list.equivalence n.equivalence) = evens)))))) (do ! - [#let [the-array (/.clone the-array) - members (|> the-array /.to-list (set.from-list n.hash))] + [#let [the_array (/.clone the_array) + members (|> the_array /.to_list (set.from_list n.hash))] default (random.filter (function (_ value) (not (or (n.even? value) (set.member? members value)))) random.nat)] - (_.cover [/.to-list'] - (exec (/.filter! n.even? the-array) + (_.cover [/.to_list'] + (exec (/.filter! n.even? the_array) (list.every? (function (_ value) (or (n.even? value) (is? default value))) - (/.to-list' default the-array))))) + (/.to_list' default the_array))))) )))) diff --git a/stdlib/source/test/lux/data/collection/dictionary.lux b/stdlib/source/test/lux/data/collection/dictionary.lux index 2080e387a..0de661e64 100644 --- a/stdlib/source/test/lux/data/collection/dictionary.lux +++ b/stdlib/source/test/lux/data/collection/dictionary.lux @@ -25,17 +25,17 @@ (def: injection (Injection (/.Dictionary Nat)) - (|>> [0] list (/.from-list n.hash))) + (|>> [0] list (/.from_list n.hash))) -(def: for-dictionaries +(def: for_dictionaries Test (do {! random.monad} - [#let [capped-nat (\ random.monad map (n.% 100) random.nat)] - size capped-nat - dict (random.dictionary n.hash size random.nat capped-nat) - non-key (random.filter (|>> (/.key? dict) not) + [#let [capped_nat (\ random.monad map (n.% 100) random.nat)] + size capped_nat + dict (random.dictionary n.hash size random.nat capped_nat) + non_key (random.filter (|>> (/.key? dict) not) random.nat) - test-val (random.filter (|>> (list.member? n.equivalence (/.values dict)) not) + test_val (random.filter (|>> (list.member? n.equivalence (/.values dict)) not) random.nat)] ($_ _.and (_.cover [/.size] @@ -58,8 +58,8 @@ (def: &equivalence n.equivalence) (def: (hash _) constant)))]] - (_.cover [/.key-hash] - (is? hash (/.key-hash (/.new hash))))) + (_.cover [/.key_hash] + (is? hash (/.key_hash (/.new hash))))) (_.cover [/.entries /.keys /.values] (\ (list.equivalence (product.equivalence n.equivalence n.equivalence)) = @@ -68,36 +68,36 @@ (/.values dict)))) (_.cover [/.merge] - (let [merging-with-oneself (let [(^open ".") (/.equivalence n.equivalence)] + (let [merging_with_oneself (let [(^open ".") (/.equivalence n.equivalence)] (= dict (/.merge dict dict))) - overwritting-keys (let [dict' (|> dict /.entries + overwritting_keys (let [dict' (|> dict /.entries (list\map (function (_ [k v]) [k (inc v)])) - (/.from-list n.hash)) + (/.from_list n.hash)) (^open ".") (/.equivalence n.equivalence)] (= dict' (/.merge dict' dict)))] - (and merging-with-oneself - overwritting-keys))) + (and merging_with_oneself + overwritting_keys))) - (_.cover [/.merge-with] + (_.cover [/.merge_with] (list.every? (function (_ [x x*2]) (n.= (n.* 2 x) x*2)) (list.zip/2 (/.values dict) - (/.values (/.merge-with n.+ dict dict))))) + (/.values (/.merge_with n.+ dict dict))))) - (_.cover [/.from-list] + (_.cover [/.from_list] (let [(^open ".") (/.equivalence n.equivalence)] (and (= dict dict) - (|> dict /.entries (/.from-list n.hash) (= dict))))) + (|> dict /.entries (/.from_list n.hash) (= dict))))) ))) -(def: for-entries +(def: for_entries Test (do random.monad - [#let [capped-nat (\ random.monad map (n.% 100) random.nat)] - size capped-nat - dict (random.dictionary n.hash size random.nat capped-nat) - non-key (random.filter (|>> (/.key? dict) not) + [#let [capped_nat (\ random.monad map (n.% 100) random.nat)] + size capped_nat + dict (random.dictionary n.hash size random.nat capped_nat) + non_key (random.filter (|>> (/.key? dict) not) random.nat) - test-val (random.filter (|>> (list.member? n.equivalence (/.values dict)) not) + test_val (random.filter (|>> (list.member? n.equivalence (/.values dict)) not) random.nat)] ($_ _.and (_.cover [/.key?] @@ -109,56 +109,56 @@ (#.Some _) true _ false)) (/.keys dict)) - (case (/.get non-key dict) + (case (/.get non_key dict) (#.Some _) false _ true))) (_.cover [/.put] (and (n.= (inc (/.size dict)) - (/.size (/.put non-key test-val dict))) - (case (/.get non-key (/.put non-key test-val dict)) - (#.Some v) (n.= test-val v) + (/.size (/.put non_key test_val dict))) + (case (/.get non_key (/.put non_key test_val dict)) + (#.Some v) (n.= test_val v) _ true))) - (_.cover [/.try-put /.key-already-exists] - (let [can-put-new-keys! - (case (/.try-put non-key test-val dict) + (_.cover [/.try_put /.key_already_exists] + (let [can_put_new_keys! + (case (/.try_put non_key test_val dict) (#try.Success dict) - (case (/.get non-key dict) - (#.Some v) (n.= test-val v) + (case (/.get non_key dict) + (#.Some v) (n.= test_val v) _ true) (#try.Failure _) false) - cannot-put-old-keys! + cannot_put_old_keys! (or (n.= 0 size) - (let [first-key (|> dict /.keys list.head maybe.assume)] - (case (/.try-put first-key test-val dict) + (let [first_key (|> dict /.keys list.head maybe.assume)] + (case (/.try_put first_key test_val dict) (#try.Success _) false (#try.Failure error) - (exception.match? /.key-already-exists error))))] - (and can-put-new-keys! - cannot-put-old-keys!))) + (exception.match? /.key_already_exists error))))] + (and can_put_new_keys! + cannot_put_old_keys!))) (_.cover [/.remove] - (and (let [base (/.put non-key test-val dict)] - (and (/.key? base non-key) - (not (/.key? (/.remove non-key base) non-key)))) + (and (let [base (/.put non_key test_val dict)] + (and (/.key? base non_key) + (not (/.key? (/.remove non_key base) non_key)))) (case (list.head (/.keys dict)) #.None true - (#.Some known-key) + (#.Some known_key) (n.= (dec (/.size dict)) - (/.size (/.remove known-key dict)))))) + (/.size (/.remove known_key dict)))))) (_.cover [/.update] - (let [base (/.put non-key test-val dict) - updt (/.update non-key inc base)] - (case [(/.get non-key base) (/.get non-key updt)] + (let [base (/.put non_key test_val dict) + updt (/.update non_key inc base)] + (case [(/.get non_key base) (/.get non_key updt)] [(#.Some x) (#.Some y)] (n.= (inc x) y) @@ -166,45 +166,45 @@ false))) (_.cover [/.upsert] - (let [can-upsert-new-key! - (case (/.get non-key (/.upsert non-key test-val inc dict)) + (let [can_upsert_new_key! + (case (/.get non_key (/.upsert non_key test_val inc dict)) (#.Some inserted) - (n.= (inc test-val) inserted) + (n.= (inc test_val) inserted) #.None false) - can-upsert-old-key! + can_upsert_old_key! (case (list.head (/.entries dict)) #.None true - (#.Some [known-key known-value]) - (case (/.get known-key (/.upsert known-key test-val inc dict)) + (#.Some [known_key known_value]) + (case (/.get known_key (/.upsert known_key test_val inc dict)) (#.Some updated) - (n.= (inc known-value) updated) + (n.= (inc known_value) updated) #.None false))] - (and can-upsert-new-key! - can-upsert-old-key!))) + (and can_upsert_new_key! + can_upsert_old_key!))) (_.cover [/.select] (|> dict - (/.put non-key test-val) - (/.select (list non-key)) + (/.put non_key test_val) + (/.select (list non_key)) /.size (n.= 1))) - (_.cover [/.re-bind] + (_.cover [/.re_bind] (or (n.= 0 size) - (let [first-key (|> dict /.keys list.head maybe.assume) - rebound (/.re-bind first-key non-key dict)] + (let [first_key (|> dict /.keys list.head maybe.assume) + rebound (/.re_bind first_key non_key dict)] (and (n.= (/.size dict) (/.size rebound)) - (/.key? rebound non-key) - (not (/.key? rebound first-key)) - (n.= (maybe.assume (/.get first-key dict)) - (maybe.assume (/.get non-key rebound))))))) + (/.key? rebound non_key) + (not (/.key? rebound first_key)) + (n.= (maybe.assume (/.get first_key dict)) + (maybe.assume (/.get non_key rebound))))))) ))) (def: #export test @@ -212,12 +212,12 @@ (<| (_.covering /._) (_.for [/.Dictionary]) (do random.monad - [#let [capped-nat (\ random.monad map (n.% 100) random.nat)] - size capped-nat - dict (random.dictionary n.hash size random.nat capped-nat) - non-key (random.filter (|>> (/.key? dict) not) + [#let [capped_nat (\ random.monad map (n.% 100) random.nat)] + size capped_nat + dict (random.dictionary n.hash size random.nat capped_nat) + non_key (random.filter (|>> (/.key? dict) not) random.nat) - test-val (random.filter (|>> (list.member? n.equivalence (/.values dict)) not) + test_val (random.filter (|>> (list.member? n.equivalence (/.values dict)) not) random.nat)] ($_ _.and (_.for [/.equivalence] @@ -227,6 +227,6 @@ (_.for [/.functor] ($functor.spec ..injection /.equivalence /.functor)) - ..for-dictionaries - ..for-entries + ..for_dictionaries + ..for_entries )))) diff --git a/stdlib/source/test/lux/data/collection/dictionary/ordered.lux b/stdlib/source/test/lux/data/collection/dictionary/ordered.lux index 1553f2266..a44b5c295 100644 --- a/stdlib/source/test/lux/data/collection/dictionary/ordered.lux +++ b/stdlib/source/test/lux/data/collection/dictionary/ordered.lux @@ -22,7 +22,7 @@ {1 ["." /]}) -(def: #export (dictionary order gen-key gen-value size) +(def: #export (dictionary order gen_key gen_value size) (All [k v] (-> (Order k) (Random k) (Random v) Nat (Random (/.Dictionary k v)))) (case size @@ -31,10 +31,10 @@ _ (do random.monad - [partial (dictionary order gen-key gen-value (dec size)) + [partial (dictionary order gen_key gen_value (dec size)) key (random.filter (|>> (/.key? partial) not) - gen-key) - value gen-value] + gen_key) + value gen_value] (wrap (/.put key value partial))))) (def: #export test @@ -45,17 +45,17 @@ [size (\ ! map (n.% 100) random.nat) keys (random.set n.hash size random.nat) values (random.set n.hash size random.nat) - extra-key (random.filter (|>> (set.member? keys) not) + extra_key (random.filter (|>> (set.member? keys) not) random.nat) - extra-value random.nat + extra_value random.nat shift random.nat - #let [pairs (list.zip/2 (set.to-list keys) - (set.to-list values)) - sample (/.from-list n.order pairs) - sorted-pairs (list.sort (function (_ [left _] [right _]) + #let [pairs (list.zip/2 (set.to_list keys) + (set.to_list values)) + sample (/.from_list n.order pairs) + sorted_pairs (list.sort (function (_ [left _] [right _]) (n.< left right)) pairs) - sorted-values (list\map product.right sorted-pairs) + sorted_values (list\map product.right sorted_pairs) (^open "list\.") (list.equivalence (: (Equivalence [Nat Nat]) (function (_ [kr vr] [ks vs]) (and (n.= kr ks) @@ -73,7 +73,7 @@ (_.cover [/.new] (/.empty? (/.new n.order))) (_.cover [/.min] - (case [(/.min sample) (list.head sorted-values)] + (case [(/.min sample) (list.head sorted_values)] [#.None #.None] #1 @@ -83,7 +83,7 @@ _ #0)) (_.cover [/.max] - (case [(/.max sample) (list.last sorted-values)] + (case [(/.max sample) (list.last sorted_values)] [#.None #.None] #1 @@ -94,43 +94,43 @@ #0)) (_.cover [/.entries] (list\= (/.entries sample) - sorted-pairs)) + sorted_pairs)) (_.cover [/.keys /.values] (list\= (/.entries sample) (list.zip/2 (/.keys sample) (/.values sample)))) - (_.cover [/.from-list] + (_.cover [/.from_list] (|> sample - /.entries (/.from-list n.order) + /.entries (/.from_list n.order) (/\= sample))) (_.cover [/.key?] (and (list.every? (/.key? sample) (/.keys sample)) - (not (/.key? sample extra-key)))) + (not (/.key? sample extra_key)))) (_.cover [/.put] - (and (not (/.key? sample extra-key)) - (let [sample+ (/.put extra-key extra-value sample)] - (and (/.key? sample+ extra-key) + (and (not (/.key? sample extra_key)) + (let [sample+ (/.put extra_key extra_value sample)] + (and (/.key? sample+ extra_key) (n.= (inc (/.size sample)) (/.size sample+)))))) (_.cover [/.get] - (let [sample+ (/.put extra-key extra-value sample)] - (case [(/.get extra-key sample) - (/.get extra-key sample+)] + (let [sample+ (/.put extra_key extra_value sample)] + (case [(/.get extra_key sample) + (/.get extra_key sample+)] [#.None (#.Some actual)] - (n.= extra-value actual) + (n.= extra_value actual) _ false))) (_.cover [/.remove] (|> sample - (/.put extra-key extra-value) - (/.remove extra-key) + (/.put extra_key extra_value) + (/.remove extra_key) (/\= sample))) (_.cover [/.update] (|> sample - (/.put extra-key extra-value) - (/.update extra-key (n.+ shift)) - (/.get extra-key) - (maybe\map (n.= (n.+ shift extra-value))) + (/.put extra_key extra_value) + (/.update extra_key (n.+ shift)) + (/.get extra_key) + (maybe\map (n.= (n.+ shift extra_value))) (maybe.default false))) )))) diff --git a/stdlib/source/test/lux/data/collection/dictionary/plist.lux b/stdlib/source/test/lux/data/collection/dictionary/plist.lux index 2a92e28db..753b8db8a 100644 --- a/stdlib/source/test/lux/data/collection/dictionary/plist.lux +++ b/stdlib/source/test/lux/data/collection/dictionary/plist.lux @@ -20,32 +20,32 @@ {1 ["." /]}) -(def: #export (random size gen-key gen-value) +(def: #export (random size gen_key gen_value) (All [v] (-> Nat (Random Text) (Random v) (Random (/.PList v)))) (do random.monad - [keys (random.set text.hash size gen-key) - values (random.list size gen-value)] - (wrap (list.zip/2 (set.to-list keys) values)))) + [keys (random.set text.hash size gen_key) + values (random.list size gen_value)] + (wrap (list.zip/2 (set.to_list keys) values)))) (def: #export test Test (<| (_.covering /._) (_.for [/.PList]) (do {! random.monad} - [#let [gen-key (random.ascii/alpha 10)] + [#let [gen_key (random.ascii/alpha 10)] size (\ ! map (n.% 100) random.nat) - sample (..random size gen-key random.nat) + sample (..random size gen_key random.nat) - #let [keys (|> sample /.keys (set.from-list text.hash))] - extra-key (random.filter (|>> (set.member? keys) not) - gen-key) - extra-value random.nat + #let [keys (|> sample /.keys (set.from_list text.hash))] + extra_key (random.filter (|>> (set.member? keys) not) + gen_key) + extra_value random.nat shift random.nat] ($_ _.and (_.for [/.equivalence] ($equivalence.spec (/.equivalence n.equivalence) - (..random size gen-key random.nat))) + (..random size gen_key random.nat))) (_.cover [/.size] (n.= size (/.size sample))) @@ -63,29 +63,29 @@ (and (list.every? (function (_ key) (/.contains? key sample)) (/.keys sample)) - (not (/.contains? extra-key sample)))) + (not (/.contains? extra_key sample)))) (_.cover [/.put] - (let [sample+ (/.put extra-key extra-value sample)] - (and (not (/.contains? extra-key sample)) - (/.contains? extra-key sample+) + (let [sample+ (/.put extra_key extra_value sample)] + (and (not (/.contains? extra_key sample)) + (/.contains? extra_key sample+) (n.= (inc (/.size sample)) (/.size sample+))))) (_.cover [/.get] (|> sample - (/.put extra-key extra-value) - (/.get extra-key) - (maybe\map (n.= extra-value)) + (/.put extra_key extra_value) + (/.get extra_key) + (maybe\map (n.= extra_value)) (maybe.default false))) (_.cover [/.update] (|> sample - (/.put extra-key extra-value) - (/.update extra-key (n.+ shift)) - (/.get extra-key) - (maybe\map (n.= (n.+ shift extra-value))) + (/.put extra_key extra_value) + (/.update extra_key (n.+ shift)) + (/.get extra_key) + (maybe\map (n.= (n.+ shift extra_value))) (maybe.default false))) (_.cover [/.remove] (|> sample - (/.put extra-key extra-value) - (/.remove extra-key) + (/.put extra_key extra_value) + (/.remove extra_key) (\ (/.equivalence n.equivalence) = sample))) )))) diff --git a/stdlib/source/test/lux/data/collection/list.lux b/stdlib/source/test/lux/data/collection/list.lux index ffde9bcf4..b2d35b1f4 100644 --- a/stdlib/source/test/lux/data/collection/list.lux +++ b/stdlib/source/test/lux/data/collection/list.lux @@ -31,7 +31,7 @@ {1 ["." / ("#\." monad)]}) -(def: bounded-size +(def: bounded_size (Random Nat) (\ random.monad map (n.% 100) random.nat)) @@ -39,10 +39,10 @@ (def: random (Random (List Nat)) (do {! random.monad} - [size ..bounded-size] + [size ..bounded_size] (|> random.nat (random.set n.hash size) - (\ ! map set.to-list)))) + (\ ! map set.to_list)))) (def: signatures Test @@ -81,9 +81,9 @@ (def: whole Test (do {! random.monad} - [size ..bounded-size + [size ..bounded_size #let [(^open "/\.") (/.equivalence n.equivalence)] - sample (\ ! map set.to-list (random.set n.hash size random.nat))] + sample (\ ! map set.to_list (random.set n.hash size random.nat))] ($_ _.and (_.cover [/.size] (n.= size (/.size sample))) @@ -95,15 +95,15 @@ (n.= size (/.size (/.repeat size [])))) (_.cover [/.reverse] (or (n.< 2 (/.size sample)) - (let [not-same! + (let [not_same! (not (/\= sample (/.reverse sample))) - self-symmetry! + self_symmetry! (/\= sample (/.reverse (/.reverse sample)))] - (and not-same! - self-symmetry!)))) + (and not_same! + self_symmetry!)))) (_.cover [/.every? /.any?] (if (/.every? n.even? sample) (not (/.any? (bit.complement n.even?) sample)) @@ -111,14 +111,14 @@ (_.cover [/.sort] (let [<<< n.< - size-preservation! + size_preservation! (n.= (/.size sample) (/.size (/.sort <<< sample))) symmetry! (/\= (/.sort <<< sample) (/.reverse (/.sort (function.flip <<<) sample)))] - (and size-preservation! + (and size_preservation! symmetry!))) ))) @@ -133,33 +133,33 @@ (_.cover [/.indices] (let [indices (/.indices size) - expected-amount! + expected_amount! (n.= size (/.size indices)) - already-sorted! + already_sorted! (/\= indices (/.sort n.< indices)) - expected-numbers! + expected_numbers! (/.every? (n.= (dec size)) - (/.zip-with/2 n.+ + (/.zip_with/2 n.+ indices (/.sort n.> indices)))] - (and expected-amount! - already-sorted! - expected-numbers!))) + (and expected_amount! + already_sorted! + expected_numbers!))) (_.cover [/.enumeration] (let [enumeration (/.enumeration sample) - has-correct-indices! + has_correct_indices! (/\= (/.indices (/.size enumeration)) (/\map product.left enumeration)) - has-correct-values! + has_correct_values! (/\= sample (/\map product.right enumeration))] - (and has-correct-indices! - has-correct-values!))) + (and has_correct_indices! + has_correct_values!))) (_.cover [/.nth] (/.every? (function (_ [index expected]) (case (/.nth index sample) @@ -180,7 +180,7 @@ ..random) #let [size (/.size sample)] idx (\ ! map (n.% size) random.nat) - chunk-size (\ ! map (|>> (n.% size) inc) random.nat)] + chunk_size (\ ! map (|>> (n.% size) inc) random.nat)] ($_ _.and (_.cover [/.filter] (let [positives (/.filter n.even? sample) @@ -201,21 +201,21 @@ (let [[left right] (/.split idx sample)] (/\= sample (/\compose left right)))) - (_.cover [/.split-with] - (let [[left right] (/.split-with n.even? sample)] + (_.cover [/.split_with] + (let [[left right] (/.split_with n.even? sample)] (/\= sample (/\compose left right)))) (_.cover [/.take /.drop] (/\= sample (/\compose (/.take idx sample) (/.drop idx sample)))) - (_.cover [/.take-while /.drop-while] + (_.cover [/.take_while /.drop_while] (/\= sample - (/\compose (/.take-while n.even? sample) - (/.drop-while n.even? 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) + (let [chunks (/.chunk chunk_size sample)] + (and (/.every? (|>> /.size (n.<= chunk_size)) chunks) (/\= sample (/.concat chunks))))) )))) @@ -275,44 +275,44 @@ sample/1 ..random sample/2 ..random] ($_ _.and - (_.cover [/.as-pairs] + (_.cover [/.as_pairs] (n.= (n./ 2 (/.size sample/0)) - (/.size (/.as-pairs sample/0)))) + (/.size (/.as_pairs sample/0)))) (_.cover [/.zip/2] (let [zipped (/.zip/2 sample/0 sample/1) zipped::size (/.size zipped) - size-of-smaller-list! + size_of_smaller_list! (n.= zipped::size (n.min (/.size sample/0) (/.size sample/1))) - can-extract-values! + can_extract_values! (and (/\= (/.take zipped::size sample/0) (/\map product.left zipped)) (/\= (/.take zipped::size sample/1) (/\map product.right zipped)))] - (and size-of-smaller-list! - can-extract-values!))) + (and size_of_smaller_list! + can_extract_values!))) (_.cover [/.zip/3] (let [zipped (/.zip/3 sample/0 sample/1 sample/2) zipped::size (/.size zipped) - size-of-smaller-list! + size_of_smaller_list! (n.= zipped::size ($_ n.min (/.size sample/0) (/.size sample/1) (/.size sample/2))) - can-extract-values! + can_extract_values! (and (/\= (/.take zipped::size sample/0) (/\map product.left zipped)) (/\= (/.take zipped::size sample/1) (/\map (|>> product.right product.left) zipped)) (/\= (/.take zipped::size sample/2) (/\map (|>> product.right product.right) zipped)))] - (and size-of-smaller-list! - can-extract-values!))) + (and size_of_smaller_list! + can_extract_values!))) (_.cover [/.zip] (and (\ (/.equivalence (product.equivalence n.equivalence n.equivalence)) = (/.zip/2 sample/0 sample/1) @@ -321,21 +321,21 @@ (/.zip/3 sample/0 sample/1 sample/2) ((/.zip 3) sample/0 sample/1 sample/2)))) - (_.cover [/.zip-with/2] + (_.cover [/.zip_with/2] (/\= (/\map (function (_ [left right]) (+/2 left right)) (/.zip/2 sample/0 sample/1)) - (/.zip-with/2 +/2 sample/0 sample/1))) - (_.cover [/.zip-with/3] + (/.zip_with/2 +/2 sample/0 sample/1))) + (_.cover [/.zip_with/3] (/\= (/\map (function (_ [left mid right]) (+/3 left mid right)) (/.zip/3 sample/0 sample/1 sample/2)) - (/.zip-with/3 +/3 sample/0 sample/1 sample/2))) - (_.cover [/.zip-with] - (and (/\= (/.zip-with/2 +/2 sample/0 sample/1) - ((/.zip-with 2) +/2 sample/0 sample/1)) - (/\= (/.zip-with/3 +/3 sample/0 sample/1 sample/2) - ((/.zip-with 3) +/3 sample/0 sample/1 sample/2)))) + (/.zip_with/3 +/3 sample/0 sample/1 sample/2))) + (_.cover [/.zip_with] + (and (/\= (/.zip_with/2 +/2 sample/0 sample/1) + ((/.zip_with 2) +/2 sample/0 sample/1)) + (/\= (/.zip_with/3 +/3 sample/0 sample/1 sample/2) + ((/.zip_with 3) +/3 sample/0 sample/1 sample/2)))) (_.cover [/.concat] (and (/\= (/\compose sample/0 sample/1) (/.concat (list sample/0 sample/1))) @@ -407,7 +407,7 @@ (let [sample+ (/.interpose separator sample)] (and (n.= (|> (/.size sample) (n.* 2) dec) (/.size sample+)) - (|> sample+ /.as-pairs (/.every? (|>> product.right (n.= separator)))))))) + (|> sample+ /.as_pairs (/.every? (|>> product.right (n.= separator)))))))) (_.cover [/.iterate] (or (/.empty? sample) (let [size (/.size sample)] diff --git a/stdlib/source/test/lux/data/collection/queue.lux b/stdlib/source/test/lux/data/collection/queue.lux index aed90ebf9..3e532a66e 100644 --- a/stdlib/source/test/lux/data/collection/queue.lux +++ b/stdlib/source/test/lux/data/collection/queue.lux @@ -22,7 +22,7 @@ (def: injection (Injection /.Queue) - (|>> list /.from-list)) + (|>> list /.from_list)) (def: #export test Test @@ -31,34 +31,34 @@ (do {! random.monad} [size (\ ! map (n.% 100) random.nat) members (random.set n.hash size random.nat) - non-member (random.filter (|>> (set.member? members) not) + non_member (random.filter (|>> (set.member? members) not) random.nat) - #let [members (set.to-list members) - sample (/.from-list members)]] + #let [members (set.to_list members) + sample (/.from_list members)]] ($_ _.and (_.for [/.equivalence] ($equivalence.spec (/.equivalence n.equivalence) (random.queue size random.nat))) (_.for [/.functor] ($functor.spec ..injection /.equivalence /.functor)) - (_.cover [/.from-list /.to-list] - (|> members /.from-list /.to-list + (_.cover [/.from_list /.to_list] + (|> members /.from_list /.to_list (\ (list.equivalence n.equivalence) = members))) (_.cover [/.size] (n.= size (/.size sample))) (_.cover [/.empty?] (bit\= (n.= 0 size) (/.empty? sample))) (_.cover [/.empty] - (let [empty-is-empty! + (let [empty_is_empty! (/.empty? /.empty) - all-empty-queues-look-the-same! + all_empty_queues_look_the_same! (bit\= (/.empty? sample) (\ (/.equivalence n.equivalence) = sample /.empty))] - (and empty-is-empty! - all-empty-queues-look-the-same!))) + (and empty_is_empty! + all_empty_queues_look_the_same!))) (_.cover [/.peek] (case [members (/.peek sample)] [(#.Cons head tail) (#.Some first)] @@ -70,49 +70,49 @@ _ false)) (_.cover [/.member?] - (let [every-member-is-identified! + (let [every_member_is_identified! (list.every? (/.member? n.equivalence sample) - (/.to-list sample)) + (/.to_list sample)) - non-member-is-not-identified! - (not (/.member? n.equivalence sample non-member))] - (and every-member-is-identified! - non-member-is-not-identified!))) + non_member_is_not_identified! + (not (/.member? n.equivalence sample non_member))] + (and every_member_is_identified! + non_member_is_not_identified!))) (_.cover [/.push] - (let [pushed (/.push non-member sample) + (let [pushed (/.push non_member sample) - size-increases! + size_increases! (n.= (inc (/.size sample)) (/.size pushed)) - new-member-is-identified! - (/.member? n.equivalence pushed non-member) + new_member_is_identified! + (/.member? n.equivalence pushed non_member) - has-expected-order! + has_expected_order! (\ (list.equivalence n.equivalence) = - (list\compose (/.to-list sample) (list non-member)) - (/.to-list pushed))] - (and size-increases! - new-member-is-identified! - has-expected-order!))) + (list\compose (/.to_list sample) (list non_member)) + (/.to_list pushed))] + (and size_increases! + new_member_is_identified! + has_expected_order!))) (_.cover [/.pop] (case members (#.Cons target expected) (let [popped (/.pop sample) - size-decreases! + size_decreases! (n.= (dec (/.size sample)) (/.size popped)) - popped-member-is-not-identified! + popped_member_is_not_identified! (not (/.member? n.equivalence popped target)) - has-expected-order! + has_expected_order! (\ (list.equivalence n.equivalence) = expected - (/.to-list popped))] - (and size-decreases! - popped-member-is-not-identified! - has-expected-order!)) + (/.to_list popped))] + (and size_decreases! + popped_member_is_not_identified! + has_expected_order!)) #.Nil (and (/.empty? sample) diff --git a/stdlib/source/test/lux/data/collection/row.lux b/stdlib/source/test/lux/data/collection/row.lux index 46e305b8d..13ed9af28 100644 --- a/stdlib/source/test/lux/data/collection/row.lux +++ b/stdlib/source/test/lux/data/collection/row.lux @@ -50,7 +50,7 @@ (do {! random.monad} [size (\ ! map (n.% 100) random.nat) sample (random.set n.hash size random.nat) - #let [sample (|> sample set.to-list /.from-list)] + #let [sample (|> sample set.to_list /.from_list)] #let [(^open "/\.") (/.equivalence n.equivalence)]] ($_ _.and (_.cover [/.size] @@ -59,40 +59,40 @@ (bit\= (/.empty? sample) (n.= 0 (/.size sample)))) (_.cover [/.empty] (/.empty? /.empty)) - (_.cover [/.to-list /.from-list] - (|> sample /.to-list /.from-list (/\= sample))) + (_.cover [/.to_list /.from_list] + (|> sample /.to_list /.from_list (/\= sample))) (_.cover [/.reverse] (or (n.< 2 (/.size sample)) - (let [not-same! + (let [not_same! (not (/\= sample (/.reverse sample))) - self-symmetry! + self_symmetry! (/\= sample (/.reverse (/.reverse sample)))] - (and not-same! - self-symmetry!)))) + (and not_same! + self_symmetry!)))) (_.cover [/.every? /.any?] (if (/.every? n.even? sample) (not (/.any? (bit.complement n.even?) sample)) (/.any? (bit.complement n.even?) sample))) ))) -(def: index-based +(def: index_based Test (do {! random.monad} [size (\ ! map (|>> (n.% 100) inc) random.nat)] ($_ _.and (do ! - [good-index (|> random.nat (\ ! map (n.% size))) - #let [bad-index (n.+ size good-index)] + [good_index (|> random.nat (\ ! map (n.% size))) + #let [bad_index (n.+ size good_index)] sample (random.set n.hash size random.nat) - non-member (random.filter (|>> (set.member? sample) not) + non_member (random.filter (|>> (set.member? sample) not) random.nat) - #let [sample (|> sample set.to-list /.from-list)]] + #let [sample (|> sample set.to_list /.from_list)]] ($_ _.and (_.cover [/.nth] - (case (/.nth good-index sample) + (case (/.nth good_index sample) (#try.Success member) (/.member? n.equivalence sample member) @@ -101,20 +101,20 @@ (_.cover [/.put] (<| (try.default false) (do try.monad - [sample (/.put good-index non-member sample) - actual (/.nth good-index sample)] - (wrap (is? non-member actual))))) + [sample (/.put good_index non_member sample) + actual (/.nth good_index sample)] + (wrap (is? non_member actual))))) (_.cover [/.update] (<| (try.default false) (do try.monad - [sample (/.put good-index non-member sample) - sample (/.update good-index inc sample) - actual (/.nth good-index sample)] - (wrap (n.= (inc non-member) actual))))) - (_.cover [/.within-bounds?] - (and (/.within-bounds? sample good-index) - (not (/.within-bounds? sample bad-index)))) - (_.cover [/.index-out-of-bounds] + [sample (/.put good_index non_member sample) + sample (/.update good_index inc sample) + actual (/.nth good_index sample)] + (wrap (n.= (inc non_member) actual))))) + (_.cover [/.within_bounds?] + (and (/.within_bounds? sample good_index) + (not (/.within_bounds? sample bad_index)))) + (_.cover [/.index_out_of_bounds] (let [fails! (: (All [a] (-> (Try a) Bit)) (function (_ situation) (case situation @@ -122,10 +122,10 @@ false (#try.Failure error) - (exception.match? /.index-out-of-bounds error))))] - (and (fails! (/.nth bad-index sample)) - (fails! (/.put bad-index non-member sample)) - (fails! (/.update bad-index inc sample))))) + (exception.match? /.index_out_of_bounds error))))] + (and (fails! (/.nth bad_index sample)) + (fails! (/.put bad_index non_member sample)) + (fails! (/.update bad_index inc sample))))) )) ))) @@ -138,13 +138,13 @@ ($_ _.and ..signatures ..whole - ..index-based + ..index_based (do ! [sample (random.set n.hash size random.nat) - non-member (random.filter (|>> (set.member? sample) not) + non_member (random.filter (|>> (set.member? sample) not) random.nat) - #let [sample (|> sample set.to-list /.from-list)] + #let [sample (|> sample set.to_list /.from_list)] #let [(^open "/\.") (/.equivalence n.equivalence)]] ($_ _.and (do ! @@ -152,36 +152,36 @@ value/1 random.nat value/2 random.nat] (_.cover [/.row] - (/\= (/.from-list (list value/0 value/1 value/2)) + (/\= (/.from_list (list value/0 value/1 value/2)) (/.row value/0 value/1 value/2)))) (_.cover [/.member?] (and (list.every? (/.member? n.equivalence sample) - (/.to-list sample)) - (not (/.member? n.equivalence sample non-member)))) + (/.to_list sample)) + (not (/.member? n.equivalence sample non_member)))) (_.cover [/.add] - (let [added (/.add non-member sample) + (let [added (/.add non_member sample) - size-increases! + size_increases! (n.= (inc (/.size sample)) (/.size added)) - is-a-member! - (/.member? n.equivalence added non-member)] - (and size-increases! - is-a-member!))) + is_a_member! + (/.member? n.equivalence added non_member)] + (and size_increases! + is_a_member!))) (_.cover [/.pop] (if (/.empty? sample) (/.empty? (/.pop sample)) - (let [expected-size! + (let [expected_size! (n.= (dec (/.size sample)) (/.size (/.pop sample))) symmetry! (|> sample - (/.add non-member) + (/.add non_member) /.pop (/\= sample))] - (and expected-size! + (and expected_size! symmetry!)))) )) )))) diff --git a/stdlib/source/test/lux/data/collection/sequence.lux b/stdlib/source/test/lux/data/collection/sequence.lux index b21741752..b97e1f7d2 100644 --- a/stdlib/source/test/lux/data/collection/sequence.lux +++ b/stdlib/source/test/lux/data/collection/sequence.lux @@ -39,8 +39,8 @@ index (\ ! map (n.% 100) random.nat) size (\ ! map (|>> (n.% 10) inc) random.nat) offset (\ ! map (n.% 100) random.nat) - cycle-start random.nat - cycle-next (random.list size random.nat)] + cycle_start random.nat + cycle_next (random.list size random.nat)] ($_ _.and (_.for [/.functor] ($functor.spec /.repeat ..equivalence /.functor)) @@ -65,19 +65,19 @@ drops) (list\= (enum.range n.enum size (dec (n.* 2 size))) (/.take size takes))))) - (_.cover [/.take-while] + (_.cover [/.take_while] (list\= (enum.range n.enum 0 (dec size)) - (/.take-while (n.< size) (/.iterate inc 0)))) - (_.cover [/.drop-while] + (/.take_while (n.< size) (/.iterate inc 0)))) + (_.cover [/.drop_while] (list\= (enum.range n.enum offset (dec (n.+ size offset))) - (/.take-while (n.< (n.+ size offset)) - (/.drop-while (n.< offset) (/.iterate inc 0))))) - (_.cover [/.split-while] - (let [[drops takes] (/.split-while (n.< size) (/.iterate inc 0))] + (/.take_while (n.< (n.+ size offset)) + (/.drop_while (n.< offset) (/.iterate inc 0))))) + (_.cover [/.split_while] + (let [[drops takes] (/.split_while (n.< size) (/.iterate inc 0))] (and (list\= (enum.range n.enum 0 (dec size)) drops) (list\= (enum.range n.enum size (dec (n.* 2 size))) - (/.take-while (n.< (n.* 2 size)) takes))))) + (/.take_while (n.< (n.* 2 size)) takes))))) (_.cover [/.head] (n.= offset (/.head (/.iterate inc offset)))) @@ -102,10 +102,10 @@ (/.unfold (function (_ n) [(inc n) (%.nat n)]) offset))))) (_.cover [/.cycle] - (let [cycle (list& cycle-start cycle-next)] + (let [cycle (list& cycle_start cycle_next)] (list\= (list.concat (list.repeat size cycle)) (/.take (n.* size (list.size cycle)) - (/.cycle [cycle-start cycle-next]))))) + (/.cycle [cycle_start cycle_next]))))) (_.cover [/.^sequence&] (let [(/.^sequence& first second third next) (/.iterate inc offset)] (and (n.= offset first) diff --git a/stdlib/source/test/lux/data/collection/set.lux b/stdlib/source/test/lux/data/collection/set.lux index 024a41e39..a58627cde 100644 --- a/stdlib/source/test/lux/data/collection/set.lux +++ b/stdlib/source/test/lux/data/collection/set.lux @@ -19,7 +19,7 @@ {1 ["." / ("\." equivalence)]}) -(def: gen-nat +(def: gen_nat (Random Nat) (\ random.monad map (n.% 100) random.nat)) @@ -29,7 +29,7 @@ (<| (_.covering /._) (_.for [/.Set]) (do {! random.monad} - [size ..gen-nat] + [size ..gen_nat] ($_ _.and (_.for [/.equivalence] ($equivalence.spec /.equivalence (random.set n.hash size random.nat))) @@ -37,11 +37,11 @@ ($monoid.spec /.equivalence (/.monoid n.hash) (random.set n.hash size random.nat))) (do ! - [sizeL ..gen-nat - sizeR ..gen-nat + [sizeL ..gen_nat + sizeR ..gen_nat setL (random.set n.hash sizeL random.nat) setR (random.set n.hash sizeR random.nat) - non-memberL (random.filter (|>> (/.member? setL) not) + non_memberL (random.filter (|>> (/.member? setL) not) random.nat)] ($_ _.and (_.cover [/.new] @@ -55,74 +55,74 @@ (def: (hash _) constant)))) random.nat)] - (_.cover [/.member-hash] - (is? hash (/.member-hash (/.new hash))))) + (_.cover [/.member_hash] + (is? hash (/.member_hash (/.new hash))))) (_.cover [/.size] (n.= sizeL (/.size setL))) (_.cover [/.empty?] (bit\= (/.empty? setL) (n.= 0 (/.size setL)))) - (_.cover [/.to-list /.from-list] - (|> setL /.to-list (/.from-list n.hash) (\= setL))) + (_.cover [/.to_list /.from_list] + (|> setL /.to_list (/.from_list n.hash) (\= setL))) (_.cover [/.member?] - (and (list.every? (/.member? setL) (/.to-list setL)) - (not (/.member? setL non-memberL)))) + (and (list.every? (/.member? setL) (/.to_list setL)) + (not (/.member? setL non_memberL)))) (_.cover [/.add] - (let [before-addition! - (not (/.member? setL non-memberL)) + (let [before_addition! + (not (/.member? setL non_memberL)) - after-addition! - (/.member? (/.add non-memberL setL) non-memberL) + after_addition! + (/.member? (/.add non_memberL setL) non_memberL) - size-increase! + size_increase! (n.= (inc (/.size setL)) - (/.size (/.add non-memberL setL)))] - (and before-addition! - after-addition!))) + (/.size (/.add non_memberL setL)))] + (and before_addition! + after_addition!))) (_.cover [/.remove] (let [symmetry! (|> setL - (/.add non-memberL) - (/.remove non-memberL) + (/.add non_memberL) + (/.remove non_memberL) (\= setL)) idempotency! (|> setL - (/.remove non-memberL) + (/.remove non_memberL) (\= setL))] (and symmetry! idempotency!))) (_.cover [/.union /.sub?] (let [setLR (/.union setL setR) - sets-are-subs-of-their-unions! + sets_are_subs_of_their_unions! (and (/.sub? setLR setL) (/.sub? setLR setR)) - union-with-empty-set! + union_with_empty_set! (|> setL (/.union (/.new n.hash)) (\= setL))] - (and sets-are-subs-of-their-unions! - union-with-empty-set!))) + (and sets_are_subs_of_their_unions! + union_with_empty_set!))) (_.cover [/.intersection /.super?] (let [setLR (/.intersection setL setR) - sets-are-supers-of-their-intersections! + sets_are_supers_of_their_intersections! (and (/.super? setLR setL) (/.super? setLR setR)) - intersection-with-empty-set! + intersection_with_empty_set! (|> setL (/.intersection (/.new n.hash)) /.empty?)] - (and sets-are-supers-of-their-intersections! - intersection-with-empty-set!))) + (and sets_are_supers_of_their_intersections! + intersection_with_empty_set!))) (_.cover [/.difference] (let [setL+R (/.union setR setL) - setL-R (/.difference setR setL+R)] - (and (list.every? (/.member? setL+R) (/.to-list setR)) - (not (list.any? (/.member? setL-R) (/.to-list setR)))))) + setL_R (/.difference setR setL+R)] + (and (list.every? (/.member? setL+R) (/.to_list setR)) + (not (list.any? (/.member? setL_R) (/.to_list setR)))))) (_.cover [/.predicate] - (list.every? (/.predicate setL) (/.to-list setL))) + (list.every? (/.predicate setL) (/.to_list setL))) )))))) diff --git a/stdlib/source/test/lux/data/collection/set/multi.lux b/stdlib/source/test/lux/data/collection/set/multi.lux index 98877583f..8d6d5aa22 100644 --- a/stdlib/source/test/lux/data/collection/set/multi.lux +++ b/stdlib/source/test/lux/data/collection/set/multi.lux @@ -28,12 +28,12 @@ (All [a] (-> Nat (Hash a) (Random Nat) (Random a) (Random (/.Set a)))) (do {! random.monad} [elements (random.set hash size element) - element-counts (random.list size ..count)] + element_counts (random.list size ..count)] (wrap (list\fold (function (_ [count element] set) (/.add count element set)) (/.new hash) - (list.zip/2 element-counts - (set.to-list elements)))))) + (list.zip/2 element_counts + (set.to_list elements)))))) (def: #export test Test @@ -42,22 +42,22 @@ (do {! random.monad} [diversity (\ ! map (n.% 10) random.nat) sample (..random diversity n.hash ..count random.nat) - non-member (random.filter (predicate.complement (set.member? (/.support sample))) + non_member (random.filter (predicate.complement (set.member? (/.support sample))) random.nat) - addition-count ..count - partial-removal-count (\ ! map (n.% addition-count) random.nat) + addition_count ..count + partial_removal_count (\ ! map (n.% addition_count) random.nat) another (..random diversity n.hash ..count random.nat)] (`` ($_ _.and (_.for [/.equivalence] ($equivalence.spec /.equivalence (..random diversity n.hash ..count random.nat))) - (_.cover [/.to-list /.from-list] + (_.cover [/.to_list /.from_list] (|> sample - /.to-list - (/.from-list n.hash) + /.to_list + (/.from_list n.hash) (\ /.equivalence = sample))) (_.cover [/.size] - (n.= (list.size (/.to-list sample)) + (n.= (list.size (/.to_list sample)) (/.size sample))) (_.cover [/.empty?] (bit\= (/.empty? sample) @@ -66,75 +66,75 @@ (/.empty? (/.new n.hash))) (_.cover [/.support] (list.every? (set.member? (/.support sample)) - (/.to-list sample))) + (/.to_list sample))) (_.cover [/.member?] - (let [non-member-is-not-identified! - (not (/.member? sample non-member)) + (let [non_member_is_not_identified! + (not (/.member? sample non_member)) - all-members-are-identified! + all_members_are_identified! (list.every? (/.member? sample) - (/.to-list sample))] - (and non-member-is-not-identified! - all-members-are-identified!))) + (/.to_list sample))] + (and non_member_is_not_identified! + all_members_are_identified!))) (_.cover [/.multiplicity] - (let [non-members-have-0-multiplicity! - (n.= 0 (/.multiplicity sample non-member)) + (let [non_members_have_0_multiplicity! + (n.= 0 (/.multiplicity sample non_member)) - every-member-has-positive-multiplicity! + every_member_has_positive_multiplicity! (list.every? (|>> (/.multiplicity sample) (n.> 0)) - (/.to-list sample))] - (and non-members-have-0-multiplicity! - every-member-has-positive-multiplicity!))) + (/.to_list sample))] + (and non_members_have_0_multiplicity! + every_member_has_positive_multiplicity!))) (_.cover [/.add] - (let [null-scenario! + (let [null_scenario! (|> sample - (/.add 0 non-member) + (/.add 0 non_member) (\ /.equivalence = sample)) - normal-scenario! - (let [sample+ (/.add addition-count non-member sample)] - (and (not (/.member? sample non-member)) - (/.member? sample+ non-member) - (n.= addition-count (/.multiplicity sample+ non-member))))] - (and null-scenario! - normal-scenario!))) + normal_scenario! + (let [sample+ (/.add addition_count non_member sample)] + (and (not (/.member? sample non_member)) + (/.member? sample+ non_member) + (n.= addition_count (/.multiplicity sample+ non_member))))] + (and null_scenario! + normal_scenario!))) (_.cover [/.remove] - (let [null-scenario! + (let [null_scenario! (\ /.equivalence = (|> sample - (/.add addition-count non-member)) + (/.add addition_count non_member)) (|> sample - (/.add addition-count non-member) - (/.remove 0 non-member))) + (/.add addition_count non_member) + (/.remove 0 non_member))) - partial-scenario! + partial_scenario! (let [sample* (|> sample - (/.add addition-count non-member) - (/.remove partial-removal-count non-member))] - (and (/.member? sample* non-member) - (n.= (n.- partial-removal-count - addition-count) - (/.multiplicity sample* non-member)))) + (/.add addition_count non_member) + (/.remove partial_removal_count non_member))] + (and (/.member? sample* non_member) + (n.= (n.- partial_removal_count + addition_count) + (/.multiplicity sample* non_member)))) - total-scenario! + total_scenario! (|> sample - (/.add addition-count non-member) - (/.remove addition-count non-member) + (/.add addition_count non_member) + (/.remove addition_count non_member) (\ /.equivalence = sample))] - (and null-scenario! - partial-scenario! - total-scenario!))) - (_.cover [/.from-set] - (let [unary (|> sample /.support /.from-set)] + (and null_scenario! + partial_scenario! + total_scenario!))) + (_.cover [/.from_set] + (let [unary (|> sample /.support /.from_set)] (list.every? (|>> (/.multiplicity unary) (n.= 1)) - (/.to-list unary)))) + (/.to_list unary)))) (_.cover [/.sub?] - (let [unary (|> sample /.support /.from-set)] + (let [unary (|> sample /.support /.from_set)] (and (/.sub? sample unary) (or (not (/.sub? unary sample)) (\ /.equivalence = sample unary))))) (_.cover [/.super?] - (let [unary (|> sample /.support /.from-set)] + (let [unary (|> sample /.support /.from_set)] (and (/.super? unary sample) (or (not (/.super? sample unary)) (\ /.equivalence = sample unary))))) @@ -142,27 +142,27 @@ [(_.cover [<name>] (let [|sample| (/.support sample) |another| (/.support another) - sample-only (set.difference |another| |sample|) - another-only (set.difference |sample| |another|) + sample_only (set.difference |another| |sample|) + another_only (set.difference |sample| |another|) common (set.intersection |sample| |another|) composed (<name> sample another) - no-left-changes! (list.every? (function (_ member) + no_left_changes! (list.every? (function (_ member) (n.= (/.multiplicity sample member) (/.multiplicity composed member))) - (set.to-list sample-only)) - no-right-changes! (list.every? (function (_ member) + (set.to_list sample_only)) + no_right_changes! (list.every? (function (_ member) (n.= (/.multiplicity another member) (/.multiplicity composed member))) - (set.to-list another-only)) - common-changes! (list.every? (function (_ member) + (set.to_list another_only)) + common_changes! (list.every? (function (_ member) (n.= (<composition> (/.multiplicity sample member) (/.multiplicity another member)) (/.multiplicity composed member))) - (set.to-list common))] - (and no-left-changes! - no-right-changes! - common-changes!)))] + (set.to_list common))] + (and no_left_changes! + no_right_changes! + common_changes!)))] [/.sum n.+] [/.union n.max] @@ -170,46 +170,46 @@ (_.cover [/.intersection] (let [|sample| (/.support sample) |another| (/.support another) - sample-only (set.difference |another| |sample|) - another-only (set.difference |sample| |another|) + sample_only (set.difference |another| |sample|) + another_only (set.difference |sample| |another|) common (set.intersection |sample| |another|) composed (/.intersection sample another) - left-removals! (list.every? (|>> (/.member? composed) not) - (set.to-list sample-only)) - right-removals! (list.every? (|>> (/.member? composed) not) - (set.to-list another-only)) - common-changes! (list.every? (function (_ member) + left_removals! (list.every? (|>> (/.member? composed) not) + (set.to_list sample_only)) + right_removals! (list.every? (|>> (/.member? composed) not) + (set.to_list another_only)) + common_changes! (list.every? (function (_ member) (n.= (n.min (/.multiplicity sample member) (/.multiplicity another member)) (/.multiplicity composed member))) - (set.to-list common))] - (and left-removals! - right-removals! - common-changes!))) + (set.to_list common))] + (and left_removals! + right_removals! + common_changes!))) (_.cover [/.difference] (let [|sample| (/.support sample) |another| (/.support another) - sample-only (set.difference |another| |sample|) - another-only (set.difference |sample| |another|) + sample_only (set.difference |another| |sample|) + another_only (set.difference |sample| |another|) common (set.intersection |sample| |another|) composed (/.difference sample another) ommissions! (list.every? (|>> (/.member? composed) not) - (set.to-list sample-only)) + (set.to_list sample_only)) intact! (list.every? (function (_ member) (n.= (/.multiplicity another member) (/.multiplicity composed member))) - (set.to-list another-only)) + (set.to_list another_only)) subtractions! (list.every? (function (_ member) - (let [sample-multiplicity (/.multiplicity sample member) - another-multiplicity (/.multiplicity another member)] - (n.= (if (n.> another-multiplicity sample-multiplicity) + (let [sample_multiplicity (/.multiplicity sample member) + another_multiplicity (/.multiplicity another member)] + (n.= (if (n.> another_multiplicity sample_multiplicity) 0 - (n.- sample-multiplicity - another-multiplicity)) + (n.- sample_multiplicity + another_multiplicity)) (/.multiplicity composed member)))) - (set.to-list common))] + (set.to_list common))] (and ommissions! intact! subtractions!))) diff --git a/stdlib/source/test/lux/data/collection/set/ordered.lux b/stdlib/source/test/lux/data/collection/set/ordered.lux index 25c645651..6c0e75b3d 100644 --- a/stdlib/source/test/lux/data/collection/set/ordered.lux +++ b/stdlib/source/test/lux/data/collection/set/ordered.lux @@ -23,7 +23,7 @@ (random.Random Nat) (\ random.monad map (n.% 100) random.nat)) -(def: #export (random size &order gen-value) +(def: #export (random size &order gen_value) (All [a] (-> Nat (Order a) (Random a) (Random (Set a)))) (case size 0 @@ -31,9 +31,9 @@ _ (do random.monad - [partial (random (dec size) &order gen-value) + [partial (random (dec size) &order gen_value) value (random.filter (|>> (/.member? partial) not) - gen-value)] + gen_value)] (wrap (/.add value partial))))) (def: #export test @@ -44,13 +44,13 @@ [sizeL ..size sizeR ..size usetL (random.set n.hash sizeL random.nat) - non-memberL (random.filter (|>> (//.member? usetL) not) + non_memberL (random.filter (|>> (//.member? usetL) not) random.nat) - #let [listL (//.to-list usetL)] - listR (|> (random.set n.hash sizeR random.nat) (\ ! map //.to-list)) + #let [listL (//.to_list usetL)] + listR (|> (random.set n.hash sizeR random.nat) (\ ! map //.to_list)) #let [(^open "/\.") /.equivalence - setL (/.from-list n.order listL) - setR (/.from-list n.order listR) + setL (/.from_list n.order listL) + setR (/.from_list n.order listR) empty (/.new n.order)]] (`` ($_ _.and (_.for [/.equivalence] @@ -63,19 +63,19 @@ (/.empty? setL))) (_.cover [/.new] (/.empty? (/.new n.order))) - (_.cover [/.to-list] + (_.cover [/.to_list] (\ (list.equivalence n.equivalence) = - (/.to-list (/.from-list n.order listL)) + (/.to_list (/.from_list n.order listL)) (list.sort (\ n.order <) listL))) - (_.cover [/.from-list] + (_.cover [/.from_list] (|> setL - /.to-list (/.from-list n.order) + /.to_list (/.from_list n.order) (/\= setL))) (~~ (template [<coverage> <comparison>] [(_.cover [<coverage>] (case (<coverage> setL) (#.Some value) - (|> setL /.to-list (list.every? (<comparison> value))) + (|> setL /.to_list (list.every? (<comparison> value))) #.None (/.empty? setL)))] @@ -84,23 +84,23 @@ [/.max n.<=] )) (_.cover [/.member?] - (let [members-are-identified! - (list.every? (/.member? setL) (/.to-list setL)) + (let [members_are_identified! + (list.every? (/.member? setL) (/.to_list setL)) - non-members-are-not-identified! - (not (/.member? setL non-memberL))] - (and members-are-identified! - non-members-are-not-identified!))) + non_members_are_not_identified! + (not (/.member? setL non_memberL))] + (and members_are_identified! + non_members_are_not_identified!))) (_.cover [/.add] - (let [setL+ (/.add non-memberL setL)] - (and (not (/.member? setL non-memberL)) - (/.member? setL+ non-memberL) + (let [setL+ (/.add non_memberL setL)] + (and (not (/.member? setL non_memberL)) + (/.member? setL+ non_memberL) (n.= (inc (/.size setL)) (/.size setL+))))) (_.cover [/.remove] (|> setL - (/.add non-memberL) - (/.remove non-memberL) + (/.add non_memberL) + (/.remove non_memberL) (\ /.equivalence = setL))) (_.cover [/.sub?] (let [self! @@ -164,7 +164,7 @@ difference! (not (list.any? (/.member? (/.difference setL setR)) - (/.to-list setL))) + (/.to_list setL))) idempotence! (\ /.equivalence = diff --git a/stdlib/source/test/lux/data/collection/tree/finger.lux b/stdlib/source/test/lux/data/collection/tree/finger.lux index 3c1325d4e..f169d8a5d 100644 --- a/stdlib/source/test/lux/data/collection/tree/finger.lux +++ b/stdlib/source/test/lux/data/collection/tree/finger.lux @@ -12,7 +12,7 @@ ["." list ("#\." fold)]]] [math ["." random]] - [type (#+ :by-example)]] + [type (#+ :by_example)]] {1 ["." /]}) @@ -20,7 +20,7 @@ (/.builder text.monoid)) (def: :@: - (:by-example [@] + (:by_example [@] {(/.Builder @ Text) ..builder} @)) @@ -30,56 +30,56 @@ (<| (_.covering /._) (_.for [/.Tree]) (do {! random.monad} - [tag-left (random.ascii/alpha-num 1) - tag-right (random.filter (|>> (text\= tag-left) not) - (random.ascii/alpha-num 1)) - expected-left random.nat - expected-right random.nat] + [tag_left (random.ascii/alpha_num 1) + tag_right (random.filter (|>> (text\= tag_left) not) + (random.ascii/alpha_num 1)) + expected_left random.nat + expected_right random.nat] ($_ _.and (_.cover [/.Builder /.builder] (exec (/.builder text.monoid) true)) (_.cover [/.tag] - (and (text\= tag-left - (/.tag (\ ..builder leaf tag-left expected-left))) - (text\= (text\compose tag-left tag-right) + (and (text\= tag_left + (/.tag (\ ..builder leaf tag_left expected_left))) + (text\= (text\compose tag_left tag_right) (/.tag (\ ..builder branch - (\ ..builder leaf tag-left expected-left) - (\ ..builder leaf tag-right expected-right)))))) + (\ ..builder leaf tag_left expected_left) + (\ ..builder leaf tag_right expected_right)))))) (_.cover [/.root] - (and (case (/.root (\ ..builder leaf tag-left expected-left)) + (and (case (/.root (\ ..builder leaf tag_left expected_left)) (#.Left actual) - (n.= expected-left actual) + (n.= expected_left actual) (#.Right _) false) (case (/.root (\ ..builder branch - (\ ..builder leaf tag-left expected-left) - (\ ..builder leaf tag-right expected-right))) + (\ ..builder leaf tag_left expected_left) + (\ ..builder leaf tag_right expected_right))) (#.Left _) false (#.Right [left right]) (case [(/.root left) (/.root right)] - [(#.Left actual-left) (#.Left actual-right)] - (and (n.= expected-left actual-left) - (n.= expected-right actual-right)) + [(#.Left actual_left) (#.Left actual_right)] + (and (n.= expected_left actual_left) + (n.= expected_right actual_right)) _ false)))) (_.cover [/.value] - (and (n.= expected-left - (/.value (\ ..builder leaf tag-left expected-left))) - (n.= expected-left + (and (n.= expected_left + (/.value (\ ..builder leaf tag_left expected_left))) + (n.= expected_left (/.value (\ ..builder branch - (\ ..builder leaf tag-left expected-left) - (\ ..builder leaf tag-right expected-right)))))) + (\ ..builder leaf tag_left expected_left) + (\ ..builder leaf tag_right expected_right)))))) (do random.monad - [#let [tags-equivalence (list.equivalence text.equivalence) - values-equivalence (list.equivalence n.equivalence)] - tags/H (random.ascii/alpha-num 1) - tags/T (random.list 5 (random.ascii/alpha-num 1)) + [#let [tags_equivalence (list.equivalence text.equivalence) + values_equivalence (list.equivalence n.equivalence)] + tags/H (random.ascii/alpha_num 1) + tags/T (random.list 5 (random.ascii/alpha_num 1)) values/H random.nat values/T (random.list 5 random.nat)] (_.cover [/.tags /.values] @@ -87,63 +87,63 @@ (\ builder branch tree (\ builder leaf tag value))) (\ builder leaf tags/H values/H) (list.zip/2 tags/T values/T))] - (and (\ tags-equivalence = (list& tags/H tags/T) (/.tags tree)) - (\ values-equivalence = (list& values/H values/T) (/.values tree)))))) + (and (\ tags_equivalence = (list& tags/H tags/T) (/.tags tree)) + (\ values_equivalence = (list& values/H values/T) (/.values tree)))))) (_.cover [/.search] - (let [can-find-correct-one! - (|> (\ ..builder leaf tag-left expected-left) - (/.search (text.contains? tag-left)) - (maybe\map (n.= expected-left)) + (let [can_find_correct_one! + (|> (\ ..builder leaf tag_left expected_left) + (/.search (text.contains? tag_left)) + (maybe\map (n.= expected_left)) (maybe.default false)) - cannot-find-incorrect-one! - (|> (\ ..builder leaf tag-right expected-right) - (/.search (text.contains? tag-left)) - (maybe\map (n.= expected-left)) + cannot_find_incorrect_one! + (|> (\ ..builder leaf tag_right expected_right) + (/.search (text.contains? tag_left)) + (maybe\map (n.= expected_left)) (maybe.default false) not) - can-find-left! + can_find_left! (|> (\ ..builder branch - (\ ..builder leaf tag-left expected-left) - (\ ..builder leaf tag-right expected-right)) - (/.search (text.contains? tag-left)) - (maybe\map (n.= expected-left)) + (\ ..builder leaf tag_left expected_left) + (\ ..builder leaf tag_right expected_right)) + (/.search (text.contains? tag_left)) + (maybe\map (n.= expected_left)) (maybe.default false)) - can-find-right! + can_find_right! (|> (\ ..builder branch - (\ ..builder leaf tag-left expected-left) - (\ ..builder leaf tag-right expected-right)) - (/.search (text.contains? tag-right)) - (maybe\map (n.= expected-right)) + (\ ..builder leaf tag_left expected_left) + (\ ..builder leaf tag_right expected_right)) + (/.search (text.contains? tag_right)) + (maybe\map (n.= expected_right)) (maybe.default false))] - (and can-find-correct-one! - cannot-find-incorrect-one! - can-find-left! - can-find-right!))) + (and can_find_correct_one! + cannot_find_incorrect_one! + can_find_left! + can_find_right!))) (_.cover [/.found?] - (let [can-find-correct-one! - (/.found? (text.contains? tag-left) - (\ ..builder leaf tag-left expected-left)) + (let [can_find_correct_one! + (/.found? (text.contains? tag_left) + (\ ..builder leaf tag_left expected_left)) - cannot-find-incorrect-one! - (not (/.found? (text.contains? tag-left) - (\ ..builder leaf tag-right expected-right))) + cannot_find_incorrect_one! + (not (/.found? (text.contains? tag_left) + (\ ..builder leaf tag_right expected_right))) - can-find-left! - (/.found? (text.contains? tag-left) + can_find_left! + (/.found? (text.contains? tag_left) (\ ..builder branch - (\ ..builder leaf tag-left expected-left) - (\ ..builder leaf tag-right expected-right))) + (\ ..builder leaf tag_left expected_left) + (\ ..builder leaf tag_right expected_right))) - can-find-right! - (/.found? (text.contains? tag-right) + can_find_right! + (/.found? (text.contains? tag_right) (\ ..builder branch - (\ ..builder leaf tag-left expected-left) - (\ ..builder leaf tag-right expected-right)))] - (and can-find-correct-one! - cannot-find-incorrect-one! - can-find-left! - can-find-right!))) + (\ ..builder leaf tag_left expected_left) + (\ ..builder leaf tag_right expected_right)))] + (and can_find_correct_one! + cannot_find_incorrect_one! + can_find_left! + can_find_right!))) )))) diff --git a/stdlib/source/test/lux/data/color.lux b/stdlib/source/test/lux/data/color.lux index 76075ba0b..c0ea5e699 100644 --- a/stdlib/source/test/lux/data/color.lux +++ b/stdlib/source/test/lux/data/color.lux @@ -26,37 +26,37 @@ (def: #export random (Random Color) (|> ($_ random.and random.nat random.nat random.nat) - (\ random.monad map /.from-rgb))) + (\ random.monad map /.from_rgb))) (def: scale (-> Nat Frac) (|>> .int int.frac)) (def: square (-> Frac Frac) (math.pow +2.0)) -(def: square-root (-> Frac Frac) (math.pow +0.5)) +(def: square_root (-> Frac Frac) (math.pow +0.5)) (def: (distance/1 from to) (-> Frac Frac Frac) - (square-root + (square_root (square (f.- from to)))) (def: (distance/3 from to) (-> Color Color Frac) - (let [[fr fg fb] (/.to-rgb from) - [tr tg tb] (/.to-rgb to)] - (square-root + (let [[fr fg fb] (/.to_rgb from) + [tr tg tb] (/.to_rgb to)] + (square_root ($_ f.+ (|> (scale tr) (f.- (scale fr)) square) (|> (scale tg) (f.- (scale fg)) square) (|> (scale tb) (f.- (scale fb)) square))))) -(def: rgb-error-margin +1.8) +(def: rgb_error_margin +1.8) (template [<field>] [(def: (<field> color) (-> Color Frac) - (let [[hue saturation luminance] (/.to-hsl color)] + (let [[hue saturation luminance] (/.to_hsl color)] <field>))] [saturation] @@ -66,21 +66,21 @@ (def: (encoding expected) (-> /.Color Test) ($_ _.and - (_.cover [/.RGB /.to-rgb /.from-rgb] - (|> expected /.to-rgb /.from-rgb + (_.cover [/.RGB /.to_rgb /.from_rgb] + (|> expected /.to_rgb /.from_rgb (\ /.equivalence = expected))) - (_.cover [/.HSL /.to-hsl /.from-hsl] - (|> expected /.to-hsl /.from-hsl + (_.cover [/.HSL /.to_hsl /.from_hsl] + (|> expected /.to_hsl /.from_hsl (distance/3 expected) - (f.<= ..rgb-error-margin))) - (_.cover [/.HSB /.to-hsb /.from-hsb] - (|> expected /.to-hsb /.from-hsb + (f.<= ..rgb_error_margin))) + (_.cover [/.HSB /.to_hsb /.from_hsb] + (|> expected /.to_hsb /.from_hsb (distance/3 expected) - (f.<= ..rgb-error-margin))) - (_.cover [/.CMYK /.to-cmyk /.from-cmyk] - (|> expected /.to-cmyk /.from-cmyk + (f.<= ..rgb_error_margin))) + (_.cover [/.CMYK /.to_cmyk /.from_cmyk] + (|> expected /.to_cmyk /.from_cmyk (distance/3 expected) - (f.<= ..rgb-error-margin))) + (f.<= ..rgb_error_margin))) )) (def: transformation @@ -94,7 +94,7 @@ ((function (_ saturation) (and (f.>= +0.25 saturation) (f.<= +0.75 saturation))))))) - ratio (|> random.safe-frac (random.filter (f.>= +0.5)))] + ratio (|> random.safe_frac (random.filter (f.>= +0.5)))] ($_ _.and (_.cover [/.darker /.brighter] (and (f.<= (distance/3 colorful /.black) @@ -109,17 +109,17 @@ (_.cover [/.saturate] (f.> (saturation mediocre) (saturation (/.saturate ratio mediocre)))) - (_.cover [/.de-saturate] + (_.cover [/.de_saturate] (f.< (saturation mediocre) - (saturation (/.de-saturate ratio mediocre)))) - (_.cover [/.gray-scale] - (let [gray'ed (/.gray-scale mediocre)] + (saturation (/.de_saturate ratio mediocre)))) + (_.cover [/.gray_scale] + (let [gray'ed (/.gray_scale mediocre)] (and (f.= +0.0 (saturation gray'ed)) (|> (luminance gray'ed) (f.- (luminance mediocre)) f.abs - (f.<= ..rgb-error-margin))))) + (f.<= ..rgb_error_margin))))) ))) (def: palette @@ -127,20 +127,20 @@ (_.for [/.Spread /.Palette] (do {! random.monad} [eH (\ ! map (|>> f.abs (f.% +0.9) (f.+ +0.05)) - random.safe-frac) + random.safe_frac) #let [eS +0.5] variations (\ ! map (|>> (n.% 3) (n.+ 2)) random.nat) - #let [max-spread (f./ (|> variations inc .int int.frac) + #let [max_spread (f./ (|> variations inc .int int.frac) +1.0) - min-spread (f./ +2.0 max-spread) - spread-space (f.- min-spread max-spread)] - spread (\ ! map (|>> f.abs (f.% spread-space) (f.+ min-spread)) - random.safe-frac)] + min_spread (f./ +2.0 max_spread) + spread_space (f.- min_spread max_spread)] + spread (\ ! map (|>> f.abs (f.% spread_space) (f.+ min_spread)) + random.safe_frac)] (`` ($_ _.and (~~ (template [<brightness> <palette>] [(_.cover [<palette>] (let [eB <brightness> - expected (/.from-hsb [eH eS eB]) + expected (/.from_hsb [eH eS eB]) palette (<palette> spread variations expected)] (and (n.= variations (list.size palette)) (not (list.any? (\ /.equivalence = expected) palette)))))] @@ -149,7 +149,7 @@ )) (~~ (template [<palette>] [(_.cover [<palette>] - (let [expected (/.from-hsb [eH eS +0.5]) + (let [expected (/.from_hsb [eH eS +0.5]) [c0 c1 c2] (<palette> expected)] (and (\ /.equivalence = expected c0) (not (\ /.equivalence = expected c1)) @@ -157,10 +157,10 @@ [/.triad] [/.clash] - [/.split-complement])) + [/.split_complement])) (~~ (template [<palette>] [(_.cover [<palette>] - (let [expected (/.from-hsb [eH eS +0.5]) + (let [expected (/.from_hsb [eH eS +0.5]) [c0 c1 c2 c3] (<palette> expected)] (and (\ /.equivalence = expected c0) (not (\ /.equivalence = expected c1)) diff --git a/stdlib/source/test/lux/data/color/named.lux b/stdlib/source/test/lux/data/color/named.lux index 0420eed19..062ba560b 100644 --- a/stdlib/source/test/lux/data/color/named.lux +++ b/stdlib/source/test/lux/data/color/named.lux @@ -17,9 +17,9 @@ ["." / ["/#" //]]}) -(with-expansions [<colors> (as-is [letter/a - [/.alice-blue - /.antique-white +(with_expansions [<colors> (as_is [letter/a + [/.alice_blue + /.antique_white ## /.aqua /.aquamarine /.azure]] @@ -28,67 +28,67 @@ [/.beige /.bisque /.black - /.blanched-almond + /.blanched_almond /.blue - /.blue-violet + /.blue_violet /.brown - /.burly-wood]] + /.burly_wood]] [letter/c - [/.cadet-blue + [/.cadet_blue /.chartreuse /.chocolate /.coral - /.cornflower-blue + /.cornflower_blue /.cornsilk /.crimson /.cyan]] [letter/d - [/.dark-blue - /.dark-cyan - /.dark-goldenrod - /.dark-gray - /.dark-green - /.dark-khaki - /.dark-magenta - /.dark-olive-green - /.dark-orange - /.dark-orchid - /.dark-red - /.dark-salmon - /.dark-sea-green - /.dark-slate-blue - /.dark-slate-gray - /.dark-turquoise - /.dark-violet - /.deep-pink - /.deep-sky-blue - /.dim-gray - /.dodger-blue]] + [/.dark_blue + /.dark_cyan + /.dark_goldenrod + /.dark_gray + /.dark_green + /.dark_khaki + /.dark_magenta + /.dark_olive_green + /.dark_orange + /.dark_orchid + /.dark_red + /.dark_salmon + /.dark_sea_green + /.dark_slate_blue + /.dark_slate_gray + /.dark_turquoise + /.dark_violet + /.deep_pink + /.deep_sky_blue + /.dim_gray + /.dodger_blue]] [letter/f - [/.fire-brick - /.floral-white - /.forest-green + [/.fire_brick + /.floral_white + /.forest_green ## /.fuchsia ]] [letter/g [/.gainsboro - /.ghost-white + /.ghost_white /.gold /.goldenrod /.gray /.green - /.green-yellow]] + /.green_yellow]] [letter/h - [/.honey-dew - /.hot-pink]] + [/.honey_dew + /.hot_pink]] [letter/i - [/.indian-red + [/.indian_red /.indigo /.ivory]] @@ -97,88 +97,88 @@ [letter/l [/.lavender - /.lavender-blush - /.lawn-green - /.lemon-chiffon - /.light-blue - /.light-coral - /.light-cyan - /.light-goldenrod-yellow - /.light-gray - /.light-green - /.light-pink - /.light-salmon - /.light-sea-green - /.light-sky-blue - /.light-slate-gray - /.light-steel-blue - /.light-yellow + /.lavender_blush + /.lawn_green + /.lemon_chiffon + /.light_blue + /.light_coral + /.light_cyan + /.light_goldenrod_yellow + /.light_gray + /.light_green + /.light_pink + /.light_salmon + /.light_sea_green + /.light_sky_blue + /.light_slate_gray + /.light_steel_blue + /.light_yellow /.lime - /.lime-green + /.lime_green /.linen]] [letter/m [/.magenta /.maroon - /.medium-aquamarine - /.medium-blue - /.medium-orchid - /.medium-purple - /.medium-sea-green - /.medium-slate-blue - /.medium-spring-green - /.medium-turquoise - /.medium-violet-red - /.midnight-blue - /.mint-cream - /.misty-rose + /.medium_aquamarine + /.medium_blue + /.medium_orchid + /.medium_purple + /.medium_sea_green + /.medium_slate_blue + /.medium_spring_green + /.medium_turquoise + /.medium_violet_red + /.midnight_blue + /.mint_cream + /.misty_rose /.moccasin]] [letter/n - [/.navajo-white + [/.navajo_white /.navy]] [letter/o - [/.old-lace + [/.old_lace /.olive - /.olive-drab + /.olive_drab /.orange - /.orange-red + /.orange_red /.orchid]] [letter/p - [/.pale-goldenrod - /.pale-green - /.pale-turquoise - /.pale-violet-red - /.papaya-whip - /.peach-puff + [/.pale_goldenrod + /.pale_green + /.pale_turquoise + /.pale_violet_red + /.papaya_whip + /.peach_puff /.peru /.pink /.plum - /.powder-blue + /.powder_blue /.purple]] [letter/r - [/.rebecca-purple + [/.rebecca_purple /.red - /.rosy-brown - /.royal-blue]] + /.rosy_brown + /.royal_blue]] [letter/s - [/.saddle-brown + [/.saddle_brown /.salmon - /.sandy-brown - /.sea-green - /.sea-shell + /.sandy_brown + /.sea_green + /.sea_shell /.sienna /.silver - /.sky-blue - /.slate-blue - /.slate-gray + /.sky_blue + /.slate_blue + /.slate_gray /.snow - /.spring-green - /.steel-blue]] + /.spring_green + /.steel_blue]] [letter/t [/.tan @@ -193,33 +193,33 @@ [letter/w [/.wheat /.white - /.white-smoke]] + /.white_smoke]] [letter/y [/.yellow - /.yellow-green]] + /.yellow_green]] ) - <named> (template [<definition> <by-letter>] + <named> (template [<definition> <by_letter>] [((: (-> Any (List //.Color)) (function (_ _) - (`` (list (~~ (template.splice <by-letter>)))))) + (`` (list (~~ (template.splice <by_letter>)))))) 123)] <colors>)] - (def: all-colors + (def: all_colors (list.concat (list <named>))) - (def: unique-colors - (set.from-list //.hash ..all-colors)) + (def: unique_colors + (set.from_list //.hash ..all_colors)) (def: verdict - (n.= (list.size ..all-colors) - (set.size ..unique-colors))) + (n.= (list.size ..all_colors) + (set.size ..unique_colors))) - (template [<definition> <by-letter>] + (template [<definition> <by_letter>] [(def: <definition> Test - (_.cover <by-letter> + (_.cover <by_letter> ..verdict))] <colors>) @@ -228,7 +228,7 @@ Test (<| (_.covering /._) (`` ($_ _.and - (~~ (template [<definition> <by-letter>] + (~~ (template [<definition> <by_letter>] [<definition>] <colors>)) diff --git a/stdlib/source/test/lux/data/format/json.lux b/stdlib/source/test/lux/data/format/json.lux index 09f608543..2d38b8988 100644 --- a/stdlib/source/test/lux/data/format/json.lux +++ b/stdlib/source/test/lux/data/format/json.lux @@ -40,7 +40,7 @@ ($_ random.or (\ ! wrap []) random.bit - random.safe-frac + random.safe_frac (random.unicode size) (random.row size recur) (random.dictionary text.hash size (random.unicode size) recur) @@ -89,9 +89,9 @@ (try.default false)))) (do random.monad [keys (random.set text.hash 3 (random.ascii/alpha 1)) - values (random.set frac.hash 3 random.safe-frac) - #let [expected (list.zip/2 (set.to-list keys) - (list\map (|>> #/.Number) (set.to-list values))) + values (random.set frac.hash 3 random.safe_frac) + #let [expected (list.zip/2 (set.to_list keys) + (list\map (|>> #/.Number) (set.to_list values))) object (/.object expected)]] ($_ _.and (_.cover [/.object /.fields] @@ -114,26 +114,26 @@ [key (random.ascii/alpha 1) unknown (random.filter (|>> (\ text.equivalence = key) not) (random.ascii/alpha 1)) - expected random.safe-frac] + expected random.safe_frac] (_.cover [/.set] (<| (try.default false) (do try.monad [object (/.set key (#/.Number expected) (/.object (list))) - #let [can-find-known-key! + #let [can_find_known_key! (|> object (/.get key) (try\map (\= (#/.Number expected))) (try.default false)) - cannot-find-unknown-key! + cannot_find_unknown_key! (case (/.get unknown object) (#try.Success _) false (#try.Failure error) true)]] - (wrap (and can-find-known-key! - cannot-find-unknown-key!)))))) + (wrap (and can_find_known_key! + cannot_find_unknown_key!)))))) (~~ (template [<type> <get> <tag> <random> <equivalence>] [(do random.monad [key (random.ascii/alpha 1) @@ -144,16 +144,16 @@ (try\map (\ <equivalence> = value)) (try.default false))))] - [/.Boolean /.get-boolean #/.Boolean random.bit bit.equivalence] - [/.Number /.get-number #/.Number random.safe-frac frac.equivalence] - [/.String /.get-string #/.String (random.ascii/alpha 1) text.equivalence] - [/.Array /.get-array #/.Array (random.row 3 ..random) (row.equivalence /.equivalence)] - [/.Object /.get-object #/.Object (random.dictionary text.hash 3 (random.ascii/alpha 1) ..random) (dictionary.equivalence /.equivalence)] + [/.Boolean /.get_boolean #/.Boolean random.bit bit.equivalence] + [/.Number /.get_number #/.Number random.safe_frac frac.equivalence] + [/.String /.get_string #/.String (random.ascii/alpha 1) text.equivalence] + [/.Array /.get_array #/.Array (random.row 3 ..random) (row.equivalence /.equivalence)] + [/.Object /.get_object #/.Object (random.dictionary text.hash 3 (random.ascii/alpha 1) ..random) (dictionary.equivalence /.equivalence)] )) - (with-expansions [<boolean> (boolean) + (with_expansions [<boolean> (boolean) <number> (number) <string> (string) - <array-row> (row.row #/.Null + <array_row> (row.row #/.Null (#/.Boolean <boolean>) (#/.Number <number>) (#/.String <string>)) @@ -173,7 +173,7 @@ [#/.Number <number>] [#/.String <string>] )) - (\= (#/.Array <array-row>) (/.json [#null <boolean> <number> <string>])) + (\= (#/.Array <array_row>) (/.json [#null <boolean> <number> <string>])) (let [object (/.json {<key0> #null <key1> <boolean> <key2> <number> @@ -193,7 +193,7 @@ (\= (#/.Boolean <boolean>) value1) (\= (#/.Number <number>) value2) (\= (#/.String <string>) value3) - (\= (#/.Array <array-row>) value4) + (\= (#/.Array <array_row>) value4) (\= (#/.Number <number>) value6)))))) ))) )))) diff --git a/stdlib/source/test/lux/data/format/tar.lux b/stdlib/source/test/lux/data/format/tar.lux index 7f271de05..72024ba29 100644 --- a/stdlib/source/test/lux/data/format/tar.lux +++ b/stdlib/source/test/lux/data/format/tar.lux @@ -38,148 +38,148 @@ Test (_.for [/.Path] (do {! random.monad} - [expected (random.ascii/lower-alpha /.path-size) - invalid (random.ascii/lower-alpha (inc /.path-size)) - not-ascii (random.text (random.char (unicode.set [unicode/block.katakana (list)])) - /.path-size)] + [expected (random.ascii/lower_alpha /.path_size) + invalid (random.ascii/lower_alpha (inc /.path_size)) + not_ascii (random.text (random.char (unicode.set [unicode/block.katakana (list)])) + /.path_size)] (`` ($_ _.and - (_.cover [/.path /.from-path] + (_.cover [/.path /.from_path] (case (/.path expected) (#try.Success actual) (text\= expected - (/.from-path actual)) + (/.from_path actual)) (#try.Failure error) false)) - (_.cover [/.path-size /.path-is-too-long] + (_.cover [/.path_size /.path_is_too_long] (case (/.path invalid) (#try.Success _) false (#try.Failure error) - (exception.match? /.path-is-too-long error))) - (_.cover [/.not-ascii] - (case (/.path not-ascii) + (exception.match? /.path_is_too_long error))) + (_.cover [/.not_ascii] + (case (/.path not_ascii) (#try.Success actual) false (#try.Failure error) - (exception.match? /.not-ascii error))) + (exception.match? /.not_ascii error))) ))))) (def: name Test (_.for [/.Name] (do {! random.monad} - [expected (random.ascii/lower-alpha /.name-size) - invalid (random.ascii/lower-alpha (inc /.name-size)) - not-ascii (random.text (random.char (unicode.set [unicode/block.katakana (list)])) - /.name-size)] + [expected (random.ascii/lower_alpha /.name_size) + invalid (random.ascii/lower_alpha (inc /.name_size)) + not_ascii (random.text (random.char (unicode.set [unicode/block.katakana (list)])) + /.name_size)] (`` ($_ _.and - (_.cover [/.name /.from-name] + (_.cover [/.name /.from_name] (case (/.name expected) (#try.Success actual) (text\= expected - (/.from-name actual)) + (/.from_name actual)) (#try.Failure error) false)) - (_.cover [/.name-size /.name-is-too-long] + (_.cover [/.name_size /.name_is_too_long] (case (/.name invalid) (#try.Success _) false (#try.Failure error) - (exception.match? /.name-is-too-long error))) - (_.cover [/.not-ascii] - (case (/.name not-ascii) + (exception.match? /.name_is_too_long error))) + (_.cover [/.not_ascii] + (case (/.name not_ascii) (#try.Success actual) false (#try.Failure error) - (exception.match? /.not-ascii error))) + (exception.match? /.not_ascii error))) ))))) (def: small Test (_.for [/.Small] (do {! random.monad} - [expected (|> random.nat (\ ! map (n.% /.small-limit))) - invalid (|> random.nat (\ ! map (n.max /.small-limit)))] + [expected (|> random.nat (\ ! map (n.% /.small_limit))) + invalid (|> random.nat (\ ! map (n.max /.small_limit)))] (`` ($_ _.and - (_.cover [/.small /.from-small] + (_.cover [/.small /.from_small] (case (/.small expected) (#try.Success actual) (n.= expected - (/.from-small actual)) + (/.from_small actual)) (#try.Failure error) false)) - (_.cover [/.small-limit /.not-a-small-number] + (_.cover [/.small_limit /.not_a_small_number] (case (/.small invalid) (#try.Success actual) false (#try.Failure error) - (exception.match? /.not-a-small-number error))) + (exception.match? /.not_a_small_number error))) ))))) (def: big Test (_.for [/.Big] (do {! random.monad} - [expected (|> random.nat (\ ! map (n.% /.big-limit))) - invalid (|> random.nat (\ ! map (n.max /.big-limit)))] + [expected (|> random.nat (\ ! map (n.% /.big_limit))) + invalid (|> random.nat (\ ! map (n.max /.big_limit)))] (`` ($_ _.and - (_.cover [/.big /.from-big] + (_.cover [/.big /.from_big] (case (/.big expected) (#try.Success actual) (n.= expected - (/.from-big actual)) + (/.from_big actual)) (#try.Failure error) false)) - (_.cover [/.big-limit /.not-a-big-number] + (_.cover [/.big_limit /.not_a_big_number] (case (/.big invalid) (#try.Success actual) false (#try.Failure error) - (exception.match? /.not-a-big-number error))) + (exception.match? /.not_a_big_number error))) ))))) -(def: chunk-size 32) +(def: chunk_size 32) (def: entry Test (do {! random.monad} - [expected-path (random.ascii/lower-alpha (dec /.path-size)) - expected-moment (\ ! map (|>> (n.% 1,0,00,00,00,00,000) .int instant.from-millis) + [expected_path (random.ascii/lower_alpha (dec /.path_size)) + expected_moment (\ ! map (|>> (n.% 1,0,00,00,00,00,000) .int instant.from_millis) random.nat) - chunk (random.ascii/lower-alpha chunk-size) + chunk (random.ascii/lower_alpha chunk_size) chunks (\ ! map (n.% 100) random.nat) #let [content (|> chunk (list.repeat chunks) - (text.join-with "") + (text.join_with "") (\ encoding.utf8 encode))]] (`` ($_ _.and (~~ (template [<type> <tag>] [(_.cover [<type>] (|> (do try.monad - [expected-path (/.path expected-path) - tar (|> (row.row (<tag> expected-path)) + [expected_path (/.path expected_path) + tar (|> (row.row (<tag> expected_path)) (format.run /.writer) (<b>.run /.parser))] - (wrap (case (row.to-list tar) - (^ (list (<tag> actual-path))) - (text\= (/.from-path expected-path) - (/.from-path actual-path)) + (wrap (case (row.to_list tar) + (^ (list (<tag> actual_path))) + (text\= (/.from_path expected_path) + (/.from_path actual_path)) _ false))) (try.default false)))] - [/.Symbolic-Link #/.Symbolic-Link] + [/.Symbolic_Link #/.Symbolic_Link] [/.Directory #/.Directory] )) (_.for [/.File /.Content /.content /.data] @@ -187,28 +187,28 @@ (~~ (template [<type> <tag>] [(_.cover [<type>] (|> (do try.monad - [expected-path (/.path expected-path) - expected-content (/.content content) - tar (|> (row.row (<tag> [expected-path - expected-moment + [expected_path (/.path expected_path) + expected_content (/.content content) + tar (|> (row.row (<tag> [expected_path + expected_moment /.none {#/.user {#/.name /.anonymous - #/.id /.no-id} + #/.id /.no_id} #/.group {#/.name /.anonymous - #/.id /.no-id}} - expected-content])) + #/.id /.no_id}} + expected_content])) (format.run /.writer) (<b>.run /.parser))] - (wrap (case (row.to-list tar) - (^ (list (<tag> [actual-path actual-moment actual-mode actual-ownership actual-content]))) + (wrap (case (row.to_list tar) + (^ (list (<tag> [actual_path actual_moment actual_mode actual_ownership actual_content]))) (let [seconds (: (-> Instant Int) (|>> instant.relative (duration.query duration.second)))] - (and (text\= (/.from-path expected-path) - (/.from-path actual-path)) - (i.= (seconds expected-moment) - (seconds actual-moment)) - (binary\= (/.data expected-content) - (/.data actual-content)))) + (and (text\= (/.from_path expected_path) + (/.from_path actual_path)) + (i.= (seconds expected_moment) + (seconds actual_moment)) + (binary\= (/.data expected_content) + (/.data actual_content)))) _ false))) @@ -218,72 +218,72 @@ [/.Contiguous #/.Contiguous] )))))))) -(def: random-mode +(def: random_mode (Random /.Mode) (do {! random.monad} [] - (random.either (random.either (random.either (wrap /.execute-by-other) - (wrap /.write-by-other)) - (random.either (wrap /.read-by-other) - (wrap /.execute-by-group))) - (random.either (random.either (random.either (wrap /.write-by-group) - (wrap /.read-by-group)) - (random.either (wrap /.execute-by-owner) - (wrap /.write-by-owner))) - (random.either (random.either (wrap /.read-by-owner) - (wrap /.save-text)) - (random.either (wrap /.set-group-id-on-execution) - (wrap /.set-user-id-on-execution))))))) + (random.either (random.either (random.either (wrap /.execute_by_other) + (wrap /.write_by_other)) + (random.either (wrap /.read_by_other) + (wrap /.execute_by_group))) + (random.either (random.either (random.either (wrap /.write_by_group) + (wrap /.read_by_group)) + (random.either (wrap /.execute_by_owner) + (wrap /.write_by_owner))) + (random.either (random.either (wrap /.read_by_owner) + (wrap /.save_text)) + (random.either (wrap /.set_group_id_on_execution) + (wrap /.set_user_id_on_execution))))))) (def: mode Test (_.for [/.Mode /.mode] (do {! random.monad} - [path (random.ascii/lower-alpha 10) - modes (random.list 4 ..random-mode) - #let [expected-mode (list\fold /.and /.none modes)]] + [path (random.ascii/lower_alpha 10) + modes (random.list 4 ..random_mode) + #let [expected_mode (list\fold /.and /.none modes)]] (`` ($_ _.and (_.cover [/.and] (|> (do try.monad [path (/.path path) content (/.content (binary.create 0)) tar (|> (row.row (#/.Normal [path - (instant.from-millis +0) - expected-mode + (instant.from_millis +0) + expected_mode {#/.user {#/.name /.anonymous - #/.id /.no-id} + #/.id /.no_id} #/.group {#/.name /.anonymous - #/.id /.no-id}} + #/.id /.no_id}} content])) (format.run /.writer) (<b>.run /.parser))] - (wrap (case (row.to-list tar) - (^ (list (#/.Normal [_ _ actual-mode _ _]))) - (n.= (/.mode expected-mode) - (/.mode actual-mode)) + (wrap (case (row.to_list tar) + (^ (list (#/.Normal [_ _ actual_mode _ _]))) + (n.= (/.mode expected_mode) + (/.mode actual_mode)) _ false))) (try.default false))) - (~~ (template [<expected-mode>] - [(_.cover [<expected-mode>] + (~~ (template [<expected_mode>] + [(_.cover [<expected_mode>] (|> (do try.monad [path (/.path path) content (/.content (binary.create 0)) tar (|> (row.row (#/.Normal [path - (instant.from-millis +0) - <expected-mode> + (instant.from_millis +0) + <expected_mode> {#/.user {#/.name /.anonymous - #/.id /.no-id} + #/.id /.no_id} #/.group {#/.name /.anonymous - #/.id /.no-id}} + #/.id /.no_id}} content])) (format.run /.writer) (<b>.run /.parser))] - (wrap (case (row.to-list tar) - (^ (list (#/.Normal [_ _ actual-mode _ _]))) - (n.= (/.mode <expected-mode>) - (/.mode actual-mode)) + (wrap (case (row.to_list tar) + (^ (list (#/.Normal [_ _ actual_mode _ _]))) + (n.= (/.mode <expected_mode>) + (/.mode actual_mode)) _ false))) @@ -291,96 +291,96 @@ [/.none] - [/.execute-by-other] - [/.write-by-other] - [/.read-by-other] + [/.execute_by_other] + [/.write_by_other] + [/.read_by_other] - [/.execute-by-group] - [/.write-by-group] - [/.read-by-group] + [/.execute_by_group] + [/.write_by_group] + [/.read_by_group] - [/.execute-by-owner] - [/.write-by-owner] - [/.read-by-owner] + [/.execute_by_owner] + [/.write_by_owner] + [/.read_by_owner] - [/.save-text] - [/.set-group-id-on-execution] - [/.set-user-id-on-execution] + [/.save_text] + [/.set_group_id_on_execution] + [/.set_user_id_on_execution] ))))))) (def: ownership Test (do {! random.monad} - [path (random.ascii/lower-alpha /.path-size) - expected (random.ascii/lower-alpha /.name-size) - invalid (random.ascii/lower-alpha (inc /.name-size)) - not-ascii (random.text (random.char (unicode.set [unicode/block.katakana (list)])) - /.name-size)] + [path (random.ascii/lower_alpha /.path_size) + expected (random.ascii/lower_alpha /.name_size) + invalid (random.ascii/lower_alpha (inc /.name_size)) + not_ascii (random.text (random.char (unicode.set [unicode/block.katakana (list)])) + /.name_size)] (_.for [/.Ownership /.Owner /.ID] ($_ _.and - (_.cover [/.name-size /.name-is-too-long] + (_.cover [/.name_size /.name_is_too_long] (case (/.name invalid) (#try.Success _) false (#try.Failure error) - (exception.match? /.name-is-too-long error))) - (_.cover [/.not-ascii] - (case (/.name not-ascii) + (exception.match? /.name_is_too_long error))) + (_.cover [/.not_ascii] + (case (/.name not_ascii) (#try.Success actual) false (#try.Failure error) - (exception.match? /.not-ascii error))) - (_.cover [/.Name /.name /.from-name] + (exception.match? /.not_ascii error))) + (_.cover [/.Name /.name /.from_name] (|> (do try.monad [path (/.path path) content (/.content (binary.create 0)) expected (/.name expected) tar (|> (row.row (#/.Normal [path - (instant.from-millis +0) + (instant.from_millis +0) /.none {#/.user {#/.name expected - #/.id /.no-id} + #/.id /.no_id} #/.group {#/.name /.anonymous - #/.id /.no-id}} + #/.id /.no_id}} content])) (format.run /.writer) (<b>.run /.parser))] - (wrap (case (row.to-list tar) - (^ (list (#/.Normal [_ _ _ actual-ownership _]))) - (and (text\= (/.from-name expected) - (/.from-name (get@ [#/.user #/.name] actual-ownership))) - (text\= (/.from-name /.anonymous) - (/.from-name (get@ [#/.group #/.name] actual-ownership)))) + (wrap (case (row.to_list tar) + (^ (list (#/.Normal [_ _ _ actual_ownership _]))) + (and (text\= (/.from_name expected) + (/.from_name (get@ [#/.user #/.name] actual_ownership))) + (text\= (/.from_name /.anonymous) + (/.from_name (get@ [#/.group #/.name] actual_ownership)))) _ false))) (try.default false))) - (_.cover [/.anonymous /.no-id] + (_.cover [/.anonymous /.no_id] (|> (do try.monad [path (/.path path) content (/.content (binary.create 0)) tar (|> (row.row (#/.Normal [path - (instant.from-millis +0) + (instant.from_millis +0) /.none {#/.user {#/.name /.anonymous - #/.id /.no-id} + #/.id /.no_id} #/.group {#/.name /.anonymous - #/.id /.no-id}} + #/.id /.no_id}} content])) (format.run /.writer) (<b>.run /.parser))] - (wrap (case (row.to-list tar) - (^ (list (#/.Normal [_ _ _ actual-ownership _]))) - (and (text\= (/.from-name /.anonymous) - (/.from-name (get@ [#/.user #/.name] actual-ownership))) - (n.= (/.from-small /.no-id) - (/.from-small (get@ [#/.user #/.id] actual-ownership))) - (text\= (/.from-name /.anonymous) - (/.from-name (get@ [#/.group #/.name] actual-ownership))) - (n.= (/.from-small /.no-id) - (/.from-small (get@ [#/.group #/.id] actual-ownership)))) + (wrap (case (row.to_list tar) + (^ (list (#/.Normal [_ _ _ actual_ownership _]))) + (and (text\= (/.from_name /.anonymous) + (/.from_name (get@ [#/.user #/.name] actual_ownership))) + (n.= (/.from_small /.no_id) + (/.from_small (get@ [#/.user #/.id] actual_ownership))) + (text\= (/.from_name /.anonymous) + (/.from_name (get@ [#/.group #/.name] actual_ownership))) + (n.= (/.from_small /.no_id) + (/.from_small (get@ [#/.group #/.id] actual_ownership)))) _ false))) diff --git a/stdlib/source/test/lux/data/format/xml.lux b/stdlib/source/test/lux/data/format/xml.lux index e95b843d2..57958281c 100644 --- a/stdlib/source/test/lux/data/format/xml.lux +++ b/stdlib/source/test/lux/data/format/xml.lux @@ -27,7 +27,7 @@ {1 ["." / (#+ XML)]}) -(def: char-range +(def: char_range Text (format "_" "abcdefghijklmnopqrstuvwxyz" @@ -36,8 +36,8 @@ (def: char (Random Nat) (do {! random.monad} - [idx (|> random.nat (\ ! map (n.% (text.size char-range))))] - (wrap (maybe.assume (text.nth idx char-range))))) + [idx (|> random.nat (\ ! map (n.% (text.size char_range))))] + (wrap (maybe.assume (text.nth idx char_range))))) (def: (size bottom top) (-> Nat Nat (Random Nat)) @@ -83,8 +83,8 @@ [(_.cover [<type> <format>] (and (text\= name (<format> ["" name])) (let [identifier (<format> identifier)] - (and (text.starts-with? namespace identifier) - (text.ends-with? name identifier)))))] + (and (text.starts_with? namespace identifier) + (text.ends_with? name identifier)))))] [/.Tag /.tag] [/.Attribute /.attribute] diff --git a/stdlib/source/test/lux/data/name.lux b/stdlib/source/test/lux/data/name.lux index dd5238aa4..08fd3065e 100644 --- a/stdlib/source/test/lux/data/name.lux +++ b/stdlib/source/test/lux/data/name.lux @@ -24,10 +24,10 @@ (random.filter (|>> (text.contains? ".") not) (random.unicode size))) -(def: #export (random module-size short-size) +(def: #export (random module_size short_size) (-> Nat Nat (Random Name)) - (random.and (..part module-size) - (..part short-size))) + (random.and (..part module_size) + (..part short_size))) (def: #export test Test @@ -59,17 +59,17 @@ (and (is? module1 (/.module name1)) (is? short1 (/.short name1)))) - (_.for [.name-of] + (_.for [.name_of] (let [(^open "/\.") /.equivalence] ($_ _.and (_.test "Can obtain Name from identifier." - (and (/\= ["lux" "yolo"] (.name-of .yolo)) - (/\= ["test/lux/data/name" "yolo"] (.name-of ..yolo)) - (/\= ["" "yolo"] (.name-of yolo)) - (/\= ["lux/test" "yolo"] (.name-of lux/test.yolo)))) + (and (/\= ["lux" "yolo"] (.name_of .yolo)) + (/\= ["test/lux/data/name" "yolo"] (.name_of ..yolo)) + (/\= ["" "yolo"] (.name_of yolo)) + (/\= ["lux/test" "yolo"] (.name_of lux/test.yolo)))) (_.test "Can obtain Name from tag." - (and (/\= ["lux" "yolo"] (.name-of #.yolo)) - (/\= ["test/lux/data/name" "yolo"] (.name-of #..yolo)) - (/\= ["" "yolo"] (.name-of #yolo)) - (/\= ["lux/test" "yolo"] (.name-of #lux/test.yolo))))))) + (and (/\= ["lux" "yolo"] (.name_of #.yolo)) + (/\= ["test/lux/data/name" "yolo"] (.name_of #..yolo)) + (/\= ["" "yolo"] (.name_of #yolo)) + (/\= ["lux/test" "yolo"] (.name_of #lux/test.yolo))))))) ))))) diff --git a/stdlib/source/test/lux/data/number.lux b/stdlib/source/test/lux/data/number.lux index d1d812aa9..d8e769369 100644 --- a/stdlib/source/test/lux/data/number.lux +++ b/stdlib/source/test/lux/data/number.lux @@ -25,9 +25,9 @@ ["#." ratio] ["#." complex]]) -(def: clean-commas +(def: clean_commas (-> Text Text) - (text.replace-all "," "")) + (text.replace_all "," "")) (def: #export test Test @@ -35,7 +35,7 @@ ($_ _.and (_.cover [/.bin] (`` (and (~~ (template [<=> <codec> <number>] - [(case (\ <codec> decode (..clean-commas <number>)) + [(case (\ <codec> decode (..clean_commas <number>)) (#try.Success actual) (<=> (/.bin <number>) actual) @@ -56,7 +56,7 @@ ))))) (_.cover [/.oct] (`` (and (~~ (template [<=> <codec> <number>] - [(case (\ <codec> decode (..clean-commas <number>)) + [(case (\ <codec> decode (..clean_commas <number>)) (#try.Success actual) (<=> (/.oct <number>) actual) @@ -77,7 +77,7 @@ ))))) (_.cover [/.hex] (`` (and (~~ (template [<=> <codec> <number>] - [(case (\ <codec> decode (..clean-commas <number>)) + [(case (\ <codec> decode (..clean_commas <number>)) (#try.Success actual) (<=> (/.hex <number>) actual) diff --git a/stdlib/source/test/lux/data/number/complex.lux b/stdlib/source/test/lux/data/number/complex.lux index 2d5865e3d..fc83ddb51 100644 --- a/stdlib/source/test/lux/data/number/complex.lux +++ b/stdlib/source/test/lux/data/number/complex.lux @@ -21,14 +21,14 @@ {1 ["." /]}) -(def: margin-of-error +(def: margin_of_error +0.000000001) (def: dimension (Random Frac) (do {! random.monad} [factor (|> random.nat (\ ! map (|>> (n.% 1000) (n.max 1)))) - measure (|> random.safe-frac (random.filter (f.> +0.0)))] + measure (|> random.safe_frac (random.filter (f.> +0.0)))] (wrap (f.* (|> factor .int int.frac) measure)))) @@ -60,12 +60,12 @@ (and (f.= real (get@ #/.real r+i)) (f.= +0.0 (get@ #/.imaginary r+i)))))) (_.cover [/.within?] - (/.within? ..margin-of-error + (/.within? ..margin_of_error (/.complex real imaginary) (/.complex real imaginary))) - (_.cover [/.not-a-number?] - (and (/.not-a-number? (/.complex f.not-a-number imaginary)) - (/.not-a-number? (/.complex real f.not-a-number)))) + (_.cover [/.not_a_number?] + (and (/.not_a_number? (/.complex f.not_a_number imaginary)) + (/.not_a_number? (/.complex real f.not_a_number)))) ))) (def: constant @@ -90,7 +90,7 @@ (/.* /.i (/.* /.i sample))))) ))) -(def: absolute-value&argument +(def: absolute_value&argument Test (do random.monad [real ..dimension @@ -102,23 +102,23 @@ (and (f.>= (f.abs real) (/.abs r+i)) (f.>= (f.abs imaginary) (/.abs r+i)))) - not-a-number! - (and (f.not-a-number? (/.abs (/.complex f.not-a-number imaginary))) - (f.not-a-number? (/.abs (/.complex real f.not-a-number)))) + not_a_number! + (and (f.not_a_number? (/.abs (/.complex f.not_a_number imaginary))) + (f.not_a_number? (/.abs (/.complex real f.not_a_number)))) infinity! - (and (f.= f.positive-infinity (/.abs (/.complex f.positive-infinity imaginary))) - (f.= f.positive-infinity (/.abs (/.complex real f.positive-infinity))) - (f.= f.positive-infinity (/.abs (/.complex f.negative-infinity imaginary))) - (f.= f.positive-infinity (/.abs (/.complex real f.negative-infinity))))] + (and (f.= f.positive_infinity (/.abs (/.complex f.positive_infinity imaginary))) + (f.= f.positive_infinity (/.abs (/.complex real f.positive_infinity))) + (f.= f.positive_infinity (/.abs (/.complex f.negative_infinity imaginary))) + (f.= f.positive_infinity (/.abs (/.complex real f.negative_infinity))))] (and normal! - not-a-number! + not_a_number! infinity!))) ## https://en.wikipedia.org/wiki/Argument_(complex_analysis)#Identities (_.cover [/.argument] (let [sample (/.complex real imaginary)] (or (/.= /.zero sample) - (/.within? ..margin-of-error + (/.within? ..margin_of_error sample (/.*' (/.abs sample) (/.exp (/.* /.i (/.complex (/.argument sample))))))))) @@ -148,14 +148,14 @@ (get@ #/.imaginary x)))))) inverse! - (and (|> x (/.+ y) (/.- y) (/.within? ..margin-of-error x)) - (|> x (/.- y) (/.+ y) (/.within? ..margin-of-error x)))] + (and (|> x (/.+ y) (/.- y) (/.within? ..margin_of_error x)) + (|> x (/.- y) (/.+ y) (/.within? ..margin_of_error x)))] (and normal! inverse!))) (_.cover [/.* /./] - (|> x (/.* y) (/./ y) (/.within? ..margin-of-error x))) + (|> x (/.* y) (/./ y) (/.within? ..margin_of_error x))) (_.cover [/.*' /./'] - (|> x (/.*' factor) (/./' factor) (/.within? ..margin-of-error x))) + (|> x (/.*' factor) (/./' factor) (/.within? ..margin_of_error x))) (_.cover [/.%] (let [rem (/.% y x) quotient (|> x (/.- rem) (/./ y)) @@ -180,36 +180,36 @@ (get@ #/.imaginary cx))))) (_.cover [/.reciprocal] (let [reciprocal! - (|> x (/.* (/.reciprocal x)) (/.within? ..margin-of-error /.+one)) + (|> x (/.* (/.reciprocal x)) (/.within? ..margin_of_error /.+one)) - own-inverse! - (|> x /.reciprocal /.reciprocal (/.within? ..margin-of-error x))] + own_inverse! + (|> x /.reciprocal /.reciprocal (/.within? ..margin_of_error x))] (and reciprocal! - own-inverse!))) + own_inverse!))) (_.cover [/.signum] ## Absolute value of signum is always root/2(2), 1 or 0. - (let [signum-abs (|> x /.signum /.abs)] - (or (f.= +0.0 signum-abs) - (f.= +1.0 signum-abs) - (f.= (math.pow +0.5 +2.0) signum-abs)))) + (let [signum_abs (|> x /.signum /.abs)] + (or (f.= +0.0 signum_abs) + (f.= +1.0 signum_abs) + (f.= (math.pow +0.5 +2.0) signum_abs)))) (_.cover [/.negate] - (let [own-inverse! + (let [own_inverse! (let [there (/.negate x) - back-again (/.negate there)] + back_again (/.negate there)] (and (not (/.= there x)) - (/.= back-again x))) + (/.= back_again x))) absolute! (f.= (/.abs x) (/.abs (/.negate x)))] - (and own-inverse! + (and own_inverse! absolute!))) ))) -(def: (trigonometric-symmetry forward backward angle) +(def: (trigonometric_symmetry forward backward angle) (-> (-> /.Complex /.Complex) (-> /.Complex /.Complex) /.Complex Bit) (let [normal (|> angle forward backward)] - (|> normal forward backward (/.within? ..margin-of-error normal)))) + (|> normal forward backward (/.within? ..margin_of_error normal)))) (def: trigonometry Test @@ -217,11 +217,11 @@ [angle ..angle] ($_ _.and (_.cover [/.sin /.asin] - (trigonometric-symmetry /.sin /.asin angle)) + (trigonometric_symmetry /.sin /.asin angle)) (_.cover [/.cos /.acos] - (trigonometric-symmetry /.cos /.acos angle)) + (trigonometric_symmetry /.cos /.acos angle)) (_.cover [/.tan /.atan] - (trigonometric-symmetry /.tan /.atan angle))))) + (trigonometric_symmetry /.tan /.atan angle))))) (def: hyperbolic Test @@ -229,15 +229,15 @@ [angle ..angle] ($_ _.and (_.cover [/.sinh] - (/.within? ..margin-of-error + (/.within? ..margin_of_error (|> angle (/.* /.i) /.sin (/.* /.i) (/.* /.-one)) (/.sinh angle))) (_.cover [/.cosh] - (/.within? ..margin-of-error + (/.within? ..margin_of_error (|> angle (/.* /.i) /.cos) (/.cosh angle))) (_.cover [/.tanh] - (/.within? ..margin-of-error + (/.within? ..margin_of_error (|> angle (/.* /.i) /.tan (/.* /.i) (/.* /.-one)) (/.tanh angle))) ))) @@ -248,11 +248,11 @@ [x ..random] ($_ _.and (_.cover [/.pow /.root/2] - (|> x (/.pow (/.complex +2.0)) /.root/2 (/.within? ..margin-of-error x))) + (|> x (/.pow (/.complex +2.0)) /.root/2 (/.within? ..margin_of_error x))) (_.cover [/.pow'] - (|> x (/.pow' +2.0) (/.pow' +0.5) (/.within? ..margin-of-error x))) + (|> x (/.pow' +2.0) (/.pow' +0.5) (/.within? ..margin_of_error x))) (_.cover [/.log /.exp] - (|> x /.log /.exp (/.within? ..margin-of-error x))) + (|> x /.log /.exp (/.within? ..margin_of_error x))) ))) (def: root @@ -264,7 +264,7 @@ (|> sample (/.roots degree) (list\map (/.pow' (|> degree .int int.frac))) - (list.every? (/.within? ..margin-of-error sample)))))) + (list.every? (/.within? ..margin_of_error sample)))))) (def: #export test Test @@ -276,7 +276,7 @@ ..construction ..constant - ..absolute-value&argument + ..absolute_value&argument ..number ..conjugate&reciprocal&signum&negation ..trigonometry diff --git a/stdlib/source/test/lux/data/number/frac.lux b/stdlib/source/test/lux/data/number/frac.lux index d982b6492..dcaa417ed 100644 --- a/stdlib/source/test/lux/data/number/frac.lux +++ b/stdlib/source/test/lux/data/number/frac.lux @@ -31,21 +31,21 @@ (def: constant Test (do random.monad - [sample random.safe-frac] + [sample random.safe_frac] ($_ _.and (_.cover [/.biggest] (/.<= /.biggest sample)) - (_.cover [/.positive-infinity] - (/.< /.positive-infinity sample)) + (_.cover [/.positive_infinity] + (/.< /.positive_infinity sample)) (_.cover [/.smallest] (bit\= (/.positive? sample) (/.>= /.smallest sample))) - (_.cover [/.negative-infinity] - (/.> /.negative-infinity sample)) - (_.cover [/.not-a-number /.not-a-number?] - (and (/.not-a-number? /.not-a-number) - (not (or (/.= /.not-a-number sample) - (/.not-a-number? sample))))) + (_.cover [/.negative_infinity] + (/.> /.negative_infinity sample)) + (_.cover [/.not_a_number /.not_a_number?] + (and (/.not_a_number? /.not_a_number) + (not (or (/.= /.not_a_number sample) + (/.not_a_number? sample))))) ))) (def: predicate @@ -67,9 +67,9 @@ (and (/.within? /.smallest sample sample) (/.within? (/.+ +1.0 shift) sample (/.+ shift sample)))) (_.cover [/.number?] - (and (not (/.number? /.not-a-number)) - (not (/.number? /.positive-infinity)) - (not (/.number? /.negative-infinity)) + (and (not (/.number? /.not_a_number)) + (not (/.number? /.positive_infinity)) + (not (/.number? /.negative_infinity)) (/.number? sample))) ))) @@ -85,7 +85,7 @@ (_.cover [/.int] (|> expected i.frac /.int (i.= expected)))) (do {! random.monad} - [expected (\ ! map (|>> (i64.left-shift 52) .rev) + [expected (\ ! map (|>> (i64.left_shift 52) .rev) random.nat)] (_.cover [/.rev] (|> expected r.frac /.rev (r.= expected)))) @@ -95,11 +95,11 @@ Test (`` ($_ _.and (_.for [/.equivalence /.=] - ($equivalence.spec /.equivalence random.safe-frac)) + ($equivalence.spec /.equivalence random.safe_frac)) (_.for [/.hash] ($hash.spec /.hash random.frac)) (_.for [/.order /.<] - ($order.spec /.order random.safe-frac)) + ($order.spec /.order random.safe_frac)) (~~ (template [<compose> <monoid>] [(_.for [<monoid> <compose>] ($monoid.spec /.equivalence <monoid> ..random))] @@ -112,18 +112,18 @@ )) (~~ (template [<codec>] [(_.for [<codec>] - ($codec.spec /.equivalence <codec> random.safe-frac))] + ($codec.spec /.equivalence <codec> random.safe_frac))] [/.binary] [/.octal] [/.decimal] [/.hex] )) ))) -(with-expansions [<jvm> (as-is (host.import: java/lang/Double +(with_expansions [<jvm> (as_is (host.import: java/lang/Double ["#::." (#static doubleToRawLongBits #manual [double] long) (#static longBitsToDouble #manual [long] double)]))] - (for {@.old (as-is <jvm>) - @.jvm (as-is <jvm>)})) + (for {@.old (as_is <jvm>) + @.jvm (as_is <jvm>)})) (def: #export test Test @@ -131,8 +131,8 @@ (_.for [.Frac]) ($_ _.and (do random.monad - [left random.safe-frac - right random.safe-frac] + [left random.safe_frac + right random.safe_frac] ($_ _.and (_.cover [/.>] (bit\= (/.> left right) @@ -142,7 +142,7 @@ (/.>= right left))) )) (do random.monad - [sample random.safe-frac] + [sample random.safe_frac] ($_ _.and (_.cover [/.-] (and (/.= +0.0 (/.- sample sample)) @@ -186,48 +186,48 @@ (/.= (/.+ left (/.% left right)) (/.mod left right)))))) )) - (with-expansions [<jvm> ($_ _.and + (with_expansions [<jvm> ($_ _.and (let [test (: (-> Frac Bit) (function (_ value) (n.= (.nat (java/lang/Double::doubleToRawLongBits value)) - (/.to-bits value))))] + (/.to_bits value))))] (do random.monad [sample random.frac] - (_.cover [/.to-bits] + (_.cover [/.to_bits] (and (test sample) (test /.biggest) (test /.smallest) - (test /.not-a-number) - (test /.positive-infinity) - (test /.negative-infinity))))) + (test /.not_a_number) + (test /.positive_infinity) + (test /.negative_infinity))))) (do random.monad [sample random.i64] - (_.cover [/.from-bits] + (_.cover [/.from_bits] (let [expected (java/lang/Double::longBitsToDouble sample) - actual (/.from-bits sample)] + actual (/.from_bits sample)] (or (/.= expected actual) - (and (/.not-a-number? expected) - (/.not-a-number? actual)))))) + (and (/.not_a_number? expected) + (/.not_a_number? actual)))))) )] (for {@.old <jvm> @.jvm <jvm>} (let [test (: (-> Frac Bit) (function (_ expected) - (let [actual (|> expected /.to-bits /.from-bits)] + (let [actual (|> expected /.to_bits /.from_bits)] (or (/.= expected actual) - (and (/.not-a-number? expected) - (/.not-a-number? actual))))))] + (and (/.not_a_number? expected) + (/.not_a_number? actual))))))] (do random.monad [sample random.frac] - (_.cover [/.to-bits /.from-bits] + (_.cover [/.to_bits /.from_bits] (and (test sample) (test /.biggest) (test /.smallest) - (test /.not-a-number) - (test /.positive-infinity) - (test /.negative-infinity))))))) + (test /.not_a_number) + (test /.positive_infinity) + (test /.negative_infinity))))))) (do random.monad - [expected random.safe-frac] + [expected random.safe_frac] (_.cover [/.negate] (let [subtraction! (/.= +0.0 (/.+ (/.negate expected) expected)) diff --git a/stdlib/source/test/lux/data/number/i64.lux b/stdlib/source/test/lux/data/number/i64.lux index 78b293fd5..45e644ab2 100644 --- a/stdlib/source/test/lux/data/number/i64.lux +++ b/stdlib/source/test/lux/data/number/i64.lux @@ -49,38 +49,38 @@ ($_ _.and (do ! [idx (\ ! map (n.% /.width) random.nat)] - (_.cover [/.arithmetic-right-shift] + (_.cover [/.arithmetic_right_shift] (let [value (.int pattern) nullity! - (\= pattern (/.arithmetic-right-shift 0 pattern)) + (\= pattern (/.arithmetic_right_shift 0 pattern)) idempotency! - (\= value (/.arithmetic-right-shift /.width value)) + (\= value (/.arithmetic_right_shift /.width value)) - sign-preservation! + sign_preservation! (bit\= (i.negative? value) - (i.negative? (/.arithmetic-right-shift idx value)))] + (i.negative? (/.arithmetic_right_shift idx value)))] (and nullity! idempotency! - sign-preservation!)))) + sign_preservation!)))) (do ! [idx (\ ! map (|>> (n.% (dec /.width)) inc) random.nat)] - (_.cover [/.left-shift /.logic-right-shift] + (_.cover [/.left_shift /.logic_right_shift] (let [nullity! - (and (\= pattern (/.left-shift 0 pattern)) - (\= pattern (/.logic-right-shift 0 pattern))) + (and (\= pattern (/.left_shift 0 pattern)) + (\= pattern (/.logic_right_shift 0 pattern))) idempotency! - (and (\= pattern (/.left-shift /.width pattern)) - (\= pattern (/.logic-right-shift /.width pattern))) + (and (\= pattern (/.left_shift /.width pattern)) + (\= pattern (/.logic_right_shift /.width pattern))) movement! (let [shift (n.- idx /.width)] (\= (/.and (/.mask idx) pattern) (|> pattern - (/.left-shift shift) - (/.logic-right-shift shift))))] + (/.left_shift shift) + (/.logic_right_shift shift))))] (and nullity! idempotency! movement!)))) @@ -123,13 +123,13 @@ 0 (\= /.false (/.region size offset)) _ (\= (|> pattern ## NNNNYYYYNNNN - (/.logic-right-shift offset) + (/.logic_right_shift offset) ## ____NNNNYYYY - (/.left-shift spare) + (/.left_shift spare) ## YYYY________ - (/.logic-right-shift spare) + (/.logic_right_shift spare) ## ________YYYY - (/.left-shift offset) + (/.left_shift offset) ## ____YYYY____ ) (/.and (/.region size offset) pattern))))) @@ -184,11 +184,11 @@ [pattern random.nat idx (\ ! map (n.% /.width) random.nat)] ($_ _.and - (_.cover [/.width /.bits-per-byte /.bytes-per-i64] - (and (n.= /.bytes-per-i64 - (n./ /.bits-per-byte /.width)) - (n.= /.bits-per-byte - (n./ /.bytes-per-i64 /.width)))) + (_.cover [/.width /.bits_per_byte /.bytes_per_i64] + (and (n.= /.bytes_per_i64 + (n./ /.bits_per_byte /.width)) + (n.= /.bits_per_byte + (n./ /.bytes_per_i64 /.width)))) (_.cover [/.false] (n.= 0 (/.count /.false))) (_.cover [/.or] @@ -225,39 +225,39 @@ (/.count (/.not pattern))))] (and clear&set! complementarity!))) - (_.cover [/.rotate-left /.rotate-right] + (_.cover [/.rotate_left /.rotate_right] (let [false! - (and (\= /.false (/.rotate-left idx /.false)) - (\= /.false (/.rotate-right idx /.false))) + (and (\= /.false (/.rotate_left idx /.false)) + (\= /.false (/.rotate_right idx /.false))) true! - (and (\= /.true (/.rotate-left idx /.true)) - (\= /.true (/.rotate-right idx /.true))) + (and (\= /.true (/.rotate_left idx /.true)) + (\= /.true (/.rotate_right idx /.true))) inverse! (and (|> pattern - (/.rotate-left idx) - (/.rotate-right idx) + (/.rotate_left idx) + (/.rotate_right idx) (\= pattern)) (|> pattern - (/.rotate-right idx) - (/.rotate-left idx) + (/.rotate_right idx) + (/.rotate_left idx) (\= pattern))) nullity! (and (|> pattern - (/.rotate-left 0) + (/.rotate_left 0) (\= pattern)) (|> pattern - (/.rotate-right 0) + (/.rotate_right 0) (\= pattern))) futility! (and (|> pattern - (/.rotate-left /.width) + (/.rotate_left /.width) (\= pattern)) (|> pattern - (/.rotate-right /.width) + (/.rotate_right /.width) (\= pattern)))] (and false! true! diff --git a/stdlib/source/test/lux/data/number/rev.lux b/stdlib/source/test/lux/data/number/rev.lux index 294d8b97a..2e75eb874 100644 --- a/stdlib/source/test/lux/data/number/rev.lux +++ b/stdlib/source/test/lux/data/number/rev.lux @@ -92,7 +92,7 @@ random.rev) divisor (\ ! map (|>> (i64.and (hex "F")) (i64.or (hex "1")) - (i64.rotate-right 8) + (i64.rotate_right 8) .rev) random.nat)] dividend (random.filter (/.> .0) dividend) @@ -116,14 +116,14 @@ (/.down scale) (/.= dividend)) - discrete-division! + discrete_division! (/.= (/.% (.rev scale) dividend) (/.- (|> dividend (/.down scale) (/.up scale)) dividend))] (and symmetry! - discrete-division!))) + discrete_division!))) (_.cover [/.ratio] (|> dividend (/.up scale) @@ -156,7 +156,7 @@ (|> sample /.reciprocal .nat /.reciprocal .nat /.reciprocal)))) (do {! random.monad} [expected (\ ! map (|>> f.abs (f.% +1.0)) - random.safe-frac)] + random.safe_frac)] (_.cover [/.frac] (|> expected f.rev /.frac (f.= expected)))) diff --git a/stdlib/source/test/lux/data/text.lux b/stdlib/source/test/lux/data/text.lux index c751e6a78..4100d5f0d 100644 --- a/stdlib/source/test/lux/data/text.lux +++ b/stdlib/source/test/lux/data/text.lux @@ -29,7 +29,7 @@ {1 ["." /]}) -(def: bounded-size +(def: bounded_size (random.Random Nat) (|> random.nat (\ random.monad map (|>> (n.% 20) (n.+ 1))))) @@ -55,23 +55,23 @@ left (random.unicode 1) right (random.unicode 1) #let [full (\ /.monoid compose inner outer) - fake-index (.nat -1)]] + fake_index (.nat -1)]] (`` ($_ _.and (~~ (template [<affix> <predicate>] [(_.cover [<affix> <predicate>] (<predicate> outer (<affix> outer inner)))] - [/.prefix /.starts-with?] - [/.suffix /.ends-with?] + [/.prefix /.starts_with?] + [/.suffix /.ends_with?] [/.enclose' /.encloses?] )) (_.cover [/.enclose] (let [value (/.enclose [left right] inner)] - (and (/.starts-with? left value) - (/.ends-with? right value)))) + (and (/.starts_with? left value) + (/.ends_with? right value)))) (_.cover [/.encode] (let [sample (/.encode inner)] - (and (/.encloses? /.double-quote sample) + (and (/.encloses? /.double_quote sample) (/.contains? inner sample)))) )))) @@ -81,69 +81,69 @@ [inner (random.unicode 1) outer (random.filter (|>> (\ /.equivalence = inner) not) (random.unicode 1)) - #let [fake-index (.nat -1)]] + #let [fake_index (.nat -1)]] ($_ _.and (_.cover [/.contains?] (let [full (\ /.monoid compose inner outer)] (and (/.contains? inner full) (/.contains? outer full)))) - (_.cover [/.index-of] - (and (|> (/.index-of inner (\ /.monoid compose inner outer)) - (maybe.default fake-index) + (_.cover [/.index_of] + (and (|> (/.index_of inner (\ /.monoid compose inner outer)) + (maybe.default fake_index) (n.= 0)) - (|> (/.index-of outer (\ /.monoid compose inner outer)) - (maybe.default fake-index) + (|> (/.index_of outer (\ /.monoid compose inner outer)) + (maybe.default fake_index) (n.= 1)))) - (_.cover [/.index-of'] + (_.cover [/.index_of'] (let [full (\ /.monoid compose inner outer)] - (and (|> (/.index-of' inner 0 full) - (maybe.default fake-index) + (and (|> (/.index_of' inner 0 full) + (maybe.default fake_index) (n.= 0)) - (|> (/.index-of' inner 1 full) - (maybe.default fake-index) - (n.= fake-index)) + (|> (/.index_of' inner 1 full) + (maybe.default fake_index) + (n.= fake_index)) - (|> (/.index-of' outer 0 full) - (maybe.default fake-index) + (|> (/.index_of' outer 0 full) + (maybe.default fake_index) (n.= 1)) - (|> (/.index-of' outer 1 full) - (maybe.default fake-index) + (|> (/.index_of' outer 1 full) + (maybe.default fake_index) (n.= 1)) - (|> (/.index-of' outer 2 full) - (maybe.default fake-index) - (n.= fake-index))))) - (_.cover [/.last-index-of] + (|> (/.index_of' outer 2 full) + (maybe.default fake_index) + (n.= fake_index))))) + (_.cover [/.last_index_of] (let [full ($_ (\ /.monoid compose) outer inner outer)] - (and (|> (/.last-index-of inner full) - (maybe.default fake-index) + (and (|> (/.last_index_of inner full) + (maybe.default fake_index) (n.= 1)) - (|> (/.last-index-of outer full) - (maybe.default fake-index) + (|> (/.last_index_of outer full) + (maybe.default fake_index) (n.= 2))))) - (_.cover [/.last-index-of'] + (_.cover [/.last_index_of'] (let [full ($_ (\ /.monoid compose) outer inner outer)] - (and (|> (/.last-index-of' inner 0 full) - (maybe.default fake-index) + (and (|> (/.last_index_of' inner 0 full) + (maybe.default fake_index) (n.= 1)) - (|> (/.last-index-of' inner 2 full) - (maybe.default fake-index) - (n.= fake-index)) + (|> (/.last_index_of' inner 2 full) + (maybe.default fake_index) + (n.= fake_index)) - (|> (/.last-index-of' outer 0 full) - (maybe.default fake-index) + (|> (/.last_index_of' outer 0 full) + (maybe.default fake_index) (n.= 2)) - (|> (/.last-index-of' outer 2 full) - (maybe.default fake-index) + (|> (/.last_index_of' outer 2 full) + (maybe.default fake_index) (n.= 2)) - (|> (/.last-index-of' outer 3 full) - (maybe.default fake-index) - (n.= fake-index))))) + (|> (/.last_index_of' outer 3 full) + (maybe.default fake_index) + (n.= fake_index))))) ))) (def: char Test ($_ _.and - (_.for [/.Char /.from-code] + (_.for [/.Char /.from_code] (`` ($_ _.and (~~ (template [<short> <long>] [(_.cover [<short> <long>] @@ -151,25 +151,25 @@ [/.\0 /.null] [/.\a /.alarm] - [/.\b /.back-space] + [/.\b /.back_space] [/.\t /.tab] - [/.\n /.new-line] - [/.\v /.vertical-tab] - [/.\f /.form-feed] - [/.\r /.carriage-return] - [/.\'' /.double-quote])) - (_.cover [/.line-feed] - (\ /.equivalence = /.new-line /.line-feed)) + [/.\n /.new_line] + [/.\v /.vertical_tab] + [/.\f /.form_feed] + [/.\r /.carriage_return] + [/.\'' /.double_quote])) + (_.cover [/.line_feed] + (\ /.equivalence = /.new_line /.line_feed)) ))) (do {! random.monad} [size (\ ! map (|>> (n.% 10) inc) random.nat) characters (random.set /.hash size (random.ascii/alpha 1)) - #let [sample (|> characters set.to-list /.concat)] + #let [sample (|> characters set.to_list /.concat)] expected (\ ! map (n.% size) random.nat)] (_.cover [/.nth] (case (/.nth expected sample) (#.Some char) - (case (/.index-of (/.from-code char) sample) + (case (/.index_of (/.from_code char) sample) (#.Some actual) (n.= expected actual) @@ -183,11 +183,11 @@ [(/.space? (`` (.char (~~ (static <char>)))))] [/.tab] - [/.vertical-tab] + [/.vertical_tab] [/.space] - [/.new-line] - [/.carriage-return] - [/.form-feed] + [/.new_line] + [/.carriage_return] + [/.form_feed] ))))) )) @@ -198,7 +198,7 @@ characters (random.set /.hash size (random.ascii/alpha 1)) separator (random.filter (|>> (set.member? characters) not) (random.ascii/alpha 1)) - #let [with-no-separator (|> characters set.to-list /.concat)] + #let [with_no_separator (|> characters set.to_list /.concat)] static (random.ascii/alpha 1) #let [dynamic (random.filter (|>> (\ /.equivalence = static) not) (random.ascii/alpha 1))] @@ -207,22 +207,22 @@ ($_ _.and (_.cover [/.concat] (n.= (set.size characters) - (/.size (/.concat (set.to-list characters))))) - (_.cover [/.join-with /.split-all-with] - (and (|> (set.to-list characters) - (/.join-with separator) - (/.split-all-with separator) - (set.from-list /.hash) + (/.size (/.concat (set.to_list characters))))) + (_.cover [/.join_with /.split_all_with] + (and (|> (set.to_list characters) + (/.join_with separator) + (/.split_all_with separator) + (set.from_list /.hash) (\ set.equivalence = characters)) (\ /.equivalence = - (/.concat (set.to-list characters)) - (/.join-with "" (set.to-list characters))))) - (_.cover [/.replace-once] + (/.concat (set.to_list characters)) + (/.join_with "" (set.to_list characters))))) + (_.cover [/.replace_once] (\ /.equivalence = (\ /.monoid compose post static) - (/.replace-once pre post (\ /.monoid compose pre static)))) - (_.cover [/.split-with] - (case (/.split-with static ($_ (\ /.monoid compose) pre static post)) + (/.replace_once pre post (\ /.monoid compose pre static)))) + (_.cover [/.split_with] + (case (/.split_with static ($_ (\ /.monoid compose) pre static post)) (#.Some [left right]) (and (\ /.equivalence = pre left) (\ /.equivalence = post right)) @@ -250,8 +250,8 @@ ..manipulation (do random.monad - [sizeL bounded-size - sizeR bounded-size + [sizeL bounded_size + sizeR bounded_size sampleL (random.unicode sizeL) sampleR (random.unicode sizeR) middle (random.unicode 1) @@ -282,23 +282,23 @@ #0))) )) (do {! random.monad} - [sizeP bounded-size - sizeL bounded-size + [sizeP bounded_size + sizeL bounded_size #let [## The wider unicode charset includes control characters that ## can make text replacement work improperly. ## Because of that, I restrict the charset. - normal-char-gen (|> random.nat (\ ! map (|>> (n.% 128) (n.max 1))))] - sep1 (random.text normal-char-gen 1) - sep2 (random.text normal-char-gen 1) - #let [part-gen (|> (random.text normal-char-gen sizeP) + normal_char_gen (|> random.nat (\ ! map (|>> (n.% 128) (n.max 1))))] + sep1 (random.text normal_char_gen 1) + sep2 (random.text normal_char_gen 1) + #let [part_gen (|> (random.text normal_char_gen sizeP) (random.filter (|>> (/.contains? sep1) not)))] - parts (random.list sizeL part-gen) + parts (random.list sizeL part_gen) #let [sample1 (/.concat (list.interpose sep1 parts)) sample2 (/.concat (list.interpose sep2 parts)) (^open "/\.") /.equivalence]] - (_.cover [/.replace-all] + (_.cover [/.replace_all] (/\= sample2 - (/.replace-all sep1 sep2 sample1)))) + (/.replace_all sep1 sep2 sample1)))) /buffer.test /encoding.test diff --git a/stdlib/source/test/lux/data/text/encoding.lux b/stdlib/source/test/lux/data/text/encoding.lux index fcf01e93d..2e61159dc 100644 --- a/stdlib/source/test/lux/data/text/encoding.lux +++ b/stdlib/source/test/lux/data/text/encoding.lux @@ -23,190 +23,190 @@ {1 ["." /]}) -(with-expansions [<encodings> (as-is [all/a +(with_expansions [<encodings> (as_is [all/a [/.ascii]] [all/ibm<1000 - [/.ibm-37 - /.ibm-273 - /.ibm-277 - /.ibm-278 - /.ibm-280 - /.ibm-284 - /.ibm-285 - /.ibm-290 - /.ibm-297 - /.ibm-300 - /.ibm-420 - /.ibm-424 - /.ibm-437 - /.ibm-500 - /.ibm-737 - /.ibm-775 - /.ibm-833 - /.ibm-834 - /.ibm-838 - /.ibm-850 - /.ibm-852 - /.ibm-855 - /.ibm-856 - /.ibm-857 - /.ibm-858 - /.ibm-860 - /.ibm-861 - /.ibm-862 - /.ibm-863 - /.ibm-864 - /.ibm-865 - /.ibm-866 - /.ibm-868 - /.ibm-869 - /.ibm-870 - /.ibm-871 - /.ibm-874 - /.ibm-875 - /.ibm-918 - /.ibm-921 - /.ibm-922 - /.ibm-930 - /.ibm-933 - /.ibm-935 - /.ibm-937 - /.ibm-939 - /.ibm-942 - /.ibm-942c - /.ibm-943 - /.ibm-943c - /.ibm-948 - /.ibm-949 - /.ibm-949c - /.ibm-950 - /.ibm-964 - /.ibm-970]] + [/.ibm_37 + /.ibm_273 + /.ibm_277 + /.ibm_278 + /.ibm_280 + /.ibm_284 + /.ibm_285 + /.ibm_290 + /.ibm_297 + /.ibm_300 + /.ibm_420 + /.ibm_424 + /.ibm_437 + /.ibm_500 + /.ibm_737 + /.ibm_775 + /.ibm_833 + /.ibm_834 + /.ibm_838 + /.ibm_850 + /.ibm_852 + /.ibm_855 + /.ibm_856 + /.ibm_857 + /.ibm_858 + /.ibm_860 + /.ibm_861 + /.ibm_862 + /.ibm_863 + /.ibm_864 + /.ibm_865 + /.ibm_866 + /.ibm_868 + /.ibm_869 + /.ibm_870 + /.ibm_871 + /.ibm_874 + /.ibm_875 + /.ibm_918 + /.ibm_921 + /.ibm_922 + /.ibm_930 + /.ibm_933 + /.ibm_935 + /.ibm_937 + /.ibm_939 + /.ibm_942 + /.ibm_942c + /.ibm_943 + /.ibm_943c + /.ibm_948 + /.ibm_949 + /.ibm_949c + /.ibm_950 + /.ibm_964 + /.ibm_970]] [all/ibm>1000 - [/.ibm-1006 - /.ibm-1025 - /.ibm-1026 - /.ibm-1046 - /.ibm-1047 - /.ibm-1097 - /.ibm-1098 - /.ibm-1112 - /.ibm-1122 - /.ibm-1123 - /.ibm-1124 - /.ibm-1140 - /.ibm-1141 - /.ibm-1142 - /.ibm-1143 - /.ibm-1144 - /.ibm-1145 - /.ibm-1146 - /.ibm-1147 - /.ibm-1148 - /.ibm-1149 - /.ibm-1166 - /.ibm-1364 - /.ibm-1381 - /.ibm-1383 - /.ibm-33722]] + [/.ibm_1006 + /.ibm_1025 + /.ibm_1026 + /.ibm_1046 + /.ibm_1047 + /.ibm_1097 + /.ibm_1098 + /.ibm_1112 + /.ibm_1122 + /.ibm_1123 + /.ibm_1124 + /.ibm_1140 + /.ibm_1141 + /.ibm_1142 + /.ibm_1143 + /.ibm_1144 + /.ibm_1145 + /.ibm_1146 + /.ibm_1147 + /.ibm_1148 + /.ibm_1149 + /.ibm_1166 + /.ibm_1364 + /.ibm_1381 + /.ibm_1383 + /.ibm_33722]] [all/iso - [/.iso-2022-cn - /.iso2022-cn-cns - /.iso2022-cn-gb - /.iso-2022-jp - /.iso-2022-jp-2 - /.iso-2022-kr - /.iso-8859-1 - /.iso-8859-2 - /.iso-8859-3 - /.iso-8859-4 - /.iso-8859-5 - /.iso-8859-6 - /.iso-8859-7 - /.iso-8859-8 - /.iso-8859-9 - /.iso-8859-11 - /.iso-8859-13 - /.iso-8859-15]] + [/.iso_2022_cn + /.iso2022_cn_cns + /.iso2022_cn_gb + /.iso_2022_jp + /.iso_2022_jp_2 + /.iso_2022_kr + /.iso_8859_1 + /.iso_8859_2 + /.iso_8859_3 + /.iso_8859_4 + /.iso_8859_5 + /.iso_8859_6 + /.iso_8859_7 + /.iso_8859_8 + /.iso_8859_9 + /.iso_8859_11 + /.iso_8859_13 + /.iso_8859_15]] [all/mac - [/.mac-arabic - /.mac-central-europe - /.mac-croatian - /.mac-cyrillic - /.mac-dingbat - /.mac-greek - /.mac-hebrew - /.mac-iceland - /.mac-roman - /.mac-romania - /.mac-symbol - /.mac-thai - /.mac-turkish - /.mac-ukraine]] + [/.mac_arabic + /.mac_central_europe + /.mac_croatian + /.mac_cyrillic + /.mac_dingbat + /.mac_greek + /.mac_hebrew + /.mac_iceland + /.mac_roman + /.mac_romania + /.mac_symbol + /.mac_thai + /.mac_turkish + /.mac_ukraine]] [all/utf - [/.utf-8 - /.utf-16 - /.utf-32]] + [/.utf_8 + /.utf_16 + /.utf_32]] [all/windows - [/.windows-31j - /.windows-874 - /.windows-949 - /.windows-950 - /.windows-1250 - /.windows-1252 - /.windows-1251 - /.windows-1253 - /.windows-1254 - /.windows-1255 - /.windows-1256 - /.windows-1257 - /.windows-1258 - /.windows-iso2022jp - /.windows-50220 - /.windows-50221]] + [/.windows_31j + /.windows_874 + /.windows_949 + /.windows_950 + /.windows_1250 + /.windows_1252 + /.windows_1251 + /.windows_1253 + /.windows_1254 + /.windows_1255 + /.windows_1256 + /.windows_1257 + /.windows_1258 + /.windows_iso2022jp + /.windows_50220 + /.windows_50221]] [all/others - [/.cesu-8 - /.koi8-r - /.koi8-u]] + [/.cesu_8 + /.koi8_r + /.koi8_u]] ) - <named> (template [<definition> <by-letter>] + <named> (template [<definition> <by_letter>] [((: (-> Any (List /.Encoding)) (function (_ _) - (`` (list (~~ (template.splice <by-letter>)))))) + (`` (list (~~ (template.splice <by_letter>)))))) 123)] <encodings>)] - (def: all-encodings + (def: all_encodings (list.concat (list <named>))) - (def: unique-encodings - (set.from-list text.hash (list\map /.name ..all-encodings))) + (def: unique_encodings + (set.from_list text.hash (list\map /.name ..all_encodings))) (def: verdict - (n.= (list.size ..all-encodings) - (set.size ..unique-encodings))) + (n.= (list.size ..all_encodings) + (set.size ..unique_encodings))) - (template [<definition> <by-letter>] + (template [<definition> <by_letter>] [(def: <definition> Test - (`` (_.cover [/.name (~~ (template.splice <by-letter>))] + (`` (_.cover [/.name (~~ (template.splice <by_letter>))] ..verdict)))] <encodings>) (def: #export random (Random /.Encoding) - (let [options (list.size ..all-encodings)] + (let [options (list.size ..all_encodings)] (do {! random.monad} [choice (\ ! map (n.% options) random.nat)] - (wrap (maybe.assume (list.nth choice ..all-encodings)))))) + (wrap (maybe.assume (list.nth choice ..all_encodings)))))) (def: #export test Test @@ -216,7 +216,7 @@ (_.for [/.utf8] ($codec.spec text.equivalence /.utf8 (random.unicode 5))) - (~~ (template [<definition> <by-letter>] + (~~ (template [<definition> <by_letter>] [<definition>] <encodings>)) diff --git a/stdlib/source/test/lux/data/text/format.lux b/stdlib/source/test/lux/data/text/format.lux index cfad7f524..00df7058a 100644 --- a/stdlib/source/test/lux/data/text/format.lux +++ b/stdlib/source/test/lux/data/text/format.lux @@ -56,7 +56,7 @@ (def: (= reference subject) (text\= (reference example) (subject example)))) -(def: random-contravariant +(def: random_contravariant (Random (Ex [a] [(/.Format a) (Random a)])) ($_ random.either @@ -74,7 +74,7 @@ (`` ($_ _.and (_.for [/.functor] (do random.monad - [[format random] ..random-contravariant + [[format random] ..random_contravariant example random] ($contravariant.spec (..equivalence example) format @@ -149,12 +149,12 @@ (text\= (/.list /.nat members) (|> members (list\map /.nat) - (text.join-with " ") + (text.join_with " ") list (/.list (|>>)))))) (do {! random.monad} [modulus (random.one (|>> modulus.modulus - try.to-maybe) + try.to_maybe) random.int) sample (\ ! map (modular.modular modulus) random.int)] diff --git a/stdlib/source/test/lux/data/text/regex.lux b/stdlib/source/test/lux/data/text/regex.lux index f72c19030..3998f78f7 100644 --- a/stdlib/source/test/lux/data/text/regex.lux +++ b/stdlib/source/test/lux/data/text/regex.lux @@ -21,7 +21,7 @@ {1 ["." /]}) -(def: (should-pass regex input) +(def: (should_pass regex input) (-> (Parser Text) Text Bit) (|> input (<text>.run regex) @@ -31,7 +31,7 @@ _ #0))) -(def: (text-should-pass test regex input) +(def: (text_should_pass test regex input) (-> Text (Parser Text) Text Bit) (|> input (<text>.run regex) @@ -41,7 +41,7 @@ _ false))) -(def: (should-fail regex input) +(def: (should_fail regex input) (All [a] (-> (Parser a) Text Bit)) (|> input (<text>.run regex) @@ -51,220 +51,220 @@ _ false))) -(syntax: (should-check pattern regex input) - (meta.with-gensyms [g!message g!_] - (wrap (list (` (|> (~ input) - (<text>.run (~ regex)) - (case> (^ (#try.Success (~ pattern))) - true +(syntax: (should_check pattern regex input) + (meta.with_gensyms [g!message g!_] + (wrap (list (` (|> (~ input) + (<text>.run (~ regex)) + (case> (^ (#try.Success (~ pattern))) + true - (~ g!_) - false))))))) + (~ g!_) + false))))))) (def: basics Test (_.test "Can parse character literals." - (and (should-pass (/.regex "a") "a") - (should-fail (/.regex "a") ".") - (should-pass (/.regex "\.") ".") - (should-fail (/.regex "\.") "a")))) + (and (should_pass (/.regex "a") "a") + (should_fail (/.regex "a") ".") + (should_pass (/.regex "\.") ".") + (should_fail (/.regex "\.") "a")))) -(def: system-character-classes +(def: system_character_classes Test ($_ _.and (_.test "Can parse anything." - (should-pass (/.regex ".") "a")) + (should_pass (/.regex ".") "a")) (_.test "Can parse digits." - (and (should-pass (/.regex "\d") "0") - (should-fail (/.regex "\d") "m"))) + (and (should_pass (/.regex "\d") "0") + (should_fail (/.regex "\d") "m"))) (_.test "Can parse non digits." - (and (should-pass (/.regex "\D") "m") - (should-fail (/.regex "\D") "0"))) + (and (should_pass (/.regex "\D") "m") + (should_fail (/.regex "\D") "0"))) (_.test "Can parse white-space." - (and (should-pass (/.regex "\s") " ") - (should-fail (/.regex "\s") "m"))) + (and (should_pass (/.regex "\s") " ") + (should_fail (/.regex "\s") "m"))) (_.test "Can parse non white-space." - (and (should-pass (/.regex "\S") "m") - (should-fail (/.regex "\S") " "))) + (and (should_pass (/.regex "\S") "m") + (should_fail (/.regex "\S") " "))) (_.test "Can parse word characters." - (and (should-pass (/.regex "\w") "_") - (should-fail (/.regex "\w") "^"))) + (and (should_pass (/.regex "\w") "_") + (should_fail (/.regex "\w") "^"))) (_.test "Can parse non word characters." - (and (should-pass (/.regex "\W") ".") - (should-fail (/.regex "\W") "a"))) + (and (should_pass (/.regex "\W") ".") + (should_fail (/.regex "\W") "a"))) )) -(def: special-system-character-classes +(def: special_system_character_classes Test ($_ _.and (_.test "Lower-case." - (and (should-pass (/.regex "\p{Lower}") "m") - (should-fail (/.regex "\p{Lower}") "M"))) + (and (should_pass (/.regex "\p{Lower}") "m") + (should_fail (/.regex "\p{Lower}") "M"))) (_.test "Upper-case." - (and (should-pass (/.regex "\p{Upper}") "M") - (should-fail (/.regex "\p{Upper}") "m"))) + (and (should_pass (/.regex "\p{Upper}") "M") + (should_fail (/.regex "\p{Upper}") "m"))) (_.test "Alphabetic." - (and (should-pass (/.regex "\p{Alpha}") "M") - (should-fail (/.regex "\p{Alpha}") "0"))) + (and (should_pass (/.regex "\p{Alpha}") "M") + (should_fail (/.regex "\p{Alpha}") "0"))) (_.test "Numeric digits." - (and (should-pass (/.regex "\p{Digit}") "1") - (should-fail (/.regex "\p{Digit}") "n"))) + (and (should_pass (/.regex "\p{Digit}") "1") + (should_fail (/.regex "\p{Digit}") "n"))) (_.test "Alphanumeric." - (and (should-pass (/.regex "\p{Alnum}") "1") - (should-fail (/.regex "\p{Alnum}") "."))) + (and (should_pass (/.regex "\p{Alnum}") "1") + (should_fail (/.regex "\p{Alnum}") "."))) (_.test "Whitespace." - (and (should-pass (/.regex "\p{Space}") " ") - (should-fail (/.regex "\p{Space}") "."))) + (and (should_pass (/.regex "\p{Space}") " ") + (should_fail (/.regex "\p{Space}") "."))) (_.test "Hexadecimal." - (and (should-pass (/.regex "\p{HexDigit}") "a") - (should-fail (/.regex "\p{HexDigit}") "."))) + (and (should_pass (/.regex "\p{HexDigit}") "a") + (should_fail (/.regex "\p{HexDigit}") "."))) (_.test "Octal." - (and (should-pass (/.regex "\p{OctDigit}") "6") - (should-fail (/.regex "\p{OctDigit}") "."))) + (and (should_pass (/.regex "\p{OctDigit}") "6") + (should_fail (/.regex "\p{OctDigit}") "."))) (_.test "Blank." - (and (should-pass (/.regex "\p{Blank}") text.tab) - (should-fail (/.regex "\p{Blank}") "."))) + (and (should_pass (/.regex "\p{Blank}") text.tab) + (should_fail (/.regex "\p{Blank}") "."))) (_.test "ASCII." - (and (should-pass (/.regex "\p{ASCII}") text.tab) - (should-fail (/.regex "\p{ASCII}") (text.from-code (hex "1234"))))) + (and (should_pass (/.regex "\p{ASCII}") text.tab) + (should_fail (/.regex "\p{ASCII}") (text.from_code (hex "1234"))))) (_.test "Control characters." - (and (should-pass (/.regex "\p{Contrl}") (text.from-code (hex "12"))) - (should-fail (/.regex "\p{Contrl}") "a"))) + (and (should_pass (/.regex "\p{Contrl}") (text.from_code (hex "12"))) + (should_fail (/.regex "\p{Contrl}") "a"))) (_.test "Punctuation." - (and (should-pass (/.regex "\p{Punct}") "@") - (should-fail (/.regex "\p{Punct}") "a"))) + (and (should_pass (/.regex "\p{Punct}") "@") + (should_fail (/.regex "\p{Punct}") "a"))) (_.test "Graph." - (and (should-pass (/.regex "\p{Graph}") "@") - (should-fail (/.regex "\p{Graph}") " "))) + (and (should_pass (/.regex "\p{Graph}") "@") + (should_fail (/.regex "\p{Graph}") " "))) (_.test "Print." - (and (should-pass (/.regex "\p{Print}") (text.from-code (hex "20"))) - (should-fail (/.regex "\p{Print}") (text.from-code (hex "1234"))))) + (and (should_pass (/.regex "\p{Print}") (text.from_code (hex "20"))) + (should_fail (/.regex "\p{Print}") (text.from_code (hex "1234"))))) )) -(def: custom-character-classes +(def: custom_character_classes Test ($_ _.and (_.test "Can parse using custom character classes." - (and (should-pass (/.regex "[abc]") "a") - (should-fail (/.regex "[abc]") "m"))) + (and (should_pass (/.regex "[abc]") "a") + (should_fail (/.regex "[abc]") "m"))) (_.test "Can parse using character ranges." - (and (should-pass (/.regex "[a-z]") "a") - (should-pass (/.regex "[a-z]") "m") - (should-pass (/.regex "[a-z]") "z"))) + (and (should_pass (/.regex "[a-z]") "a") + (should_pass (/.regex "[a-z]") "m") + (should_pass (/.regex "[a-z]") "z"))) (_.test "Can combine character ranges." - (and (should-pass (/.regex "[a-zA-Z]") "a") - (should-pass (/.regex "[a-zA-Z]") "m") - (should-pass (/.regex "[a-zA-Z]") "z") - (should-pass (/.regex "[a-zA-Z]") "A") - (should-pass (/.regex "[a-zA-Z]") "M") - (should-pass (/.regex "[a-zA-Z]") "Z"))) + (and (should_pass (/.regex "[a-zA-Z]") "a") + (should_pass (/.regex "[a-zA-Z]") "m") + (should_pass (/.regex "[a-zA-Z]") "z") + (should_pass (/.regex "[a-zA-Z]") "A") + (should_pass (/.regex "[a-zA-Z]") "M") + (should_pass (/.regex "[a-zA-Z]") "Z"))) (_.test "Can negate custom character classes." - (and (should-fail (/.regex "[^abc]") "a") - (should-pass (/.regex "[^abc]") "m"))) + (and (should_fail (/.regex "[^abc]") "a") + (should_pass (/.regex "[^abc]") "m"))) (_.test "Can negate character ranges.." - (and (should-fail (/.regex "[^a-z]") "a") - (should-pass (/.regex "[^a-z]") "0"))) + (and (should_fail (/.regex "[^a-z]") "a") + (should_pass (/.regex "[^a-z]") "0"))) (_.test "Can parse negate combinations of character ranges." - (and (should-fail (/.regex "[^a-zA-Z]") "a") - (should-pass (/.regex "[^a-zA-Z]") "0"))) + (and (should_fail (/.regex "[^a-zA-Z]") "a") + (should_pass (/.regex "[^a-zA-Z]") "0"))) (_.test "Can make custom character classes more specific." (and (let [RE (/.regex "[a-z&&[def]]")] - (and (should-fail RE "a") - (should-pass RE "d"))) + (and (should_fail RE "a") + (should_pass RE "d"))) (let [RE (/.regex "[a-z&&[^bc]]")] - (and (should-pass RE "a") - (should-fail RE "b"))) + (and (should_pass RE "a") + (should_fail RE "b"))) (let [RE (/.regex "[a-z&&[^m-p]]")] - (and (should-pass RE "a") - (should-fail RE "m") - (should-fail RE "p"))))) + (and (should_pass RE "a") + (should_fail RE "m") + (should_fail RE "p"))))) )) (def: references Test (let [number (/.regex "\d+")] (_.test "Can build complex regexs by combining simpler ones." - (should-check ["809-345-6789" "809" "345" "6789"] + (should_check ["809-345-6789" "809" "345" "6789"] (/.regex "(\@<number>)-(\@<number>)-(\@<number>)") "809-345-6789")))) -(def: fuzzy-quantifiers +(def: fuzzy_quantifiers Test ($_ _.and (_.test "Can sequentially combine patterns." - (text-should-pass "aa" (/.regex "aa") "aa")) + (text_should_pass "aa" (/.regex "aa") "aa")) (_.test "Can match patterns optionally." - (and (text-should-pass "a" (/.regex "a?") "a") - (text-should-pass "" (/.regex "a?") ""))) + (and (text_should_pass "a" (/.regex "a?") "a") + (text_should_pass "" (/.regex "a?") ""))) (_.test "Can match a pattern 0 or more times." - (and (text-should-pass "aaa" (/.regex "a*") "aaa") - (text-should-pass "" (/.regex "a*") ""))) + (and (text_should_pass "aaa" (/.regex "a*") "aaa") + (text_should_pass "" (/.regex "a*") ""))) (_.test "Can match a pattern 1 or more times." - (and (text-should-pass "aaa" (/.regex "a+") "aaa") - (text-should-pass "a" (/.regex "a+") "a") - (should-fail (/.regex "a+") ""))) + (and (text_should_pass "aaa" (/.regex "a+") "aaa") + (text_should_pass "a" (/.regex "a+") "a") + (should_fail (/.regex "a+") ""))) )) -(def: crisp-quantifiers +(def: crisp_quantifiers Test ($_ _.and (_.test "Can match a pattern N times." - (and (text-should-pass "aa" (/.regex "a{2}") "aa") - (text-should-pass "a" (/.regex "a{1}") "a") - (should-fail (/.regex "a{3}") "aa"))) + (and (text_should_pass "aa" (/.regex "a{2}") "aa") + (text_should_pass "a" (/.regex "a{1}") "a") + (should_fail (/.regex "a{3}") "aa"))) (_.test "Can match a pattern at-least N times." - (and (text-should-pass "aa" (/.regex "a{1,}") "aa") - (text-should-pass "aa" (/.regex "a{2,}") "aa") - (should-fail (/.regex "a{3,}") "aa"))) + (and (text_should_pass "aa" (/.regex "a{1,}") "aa") + (text_should_pass "aa" (/.regex "a{2,}") "aa") + (should_fail (/.regex "a{3,}") "aa"))) (_.test "Can match a pattern at-most N times." - (and (text-should-pass "aa" (/.regex "a{,2}") "aa") - (text-should-pass "aa" (/.regex "a{,3}") "aa"))) + (and (text_should_pass "aa" (/.regex "a{,2}") "aa") + (text_should_pass "aa" (/.regex "a{,3}") "aa"))) (_.test "Can match a pattern between N and M times." - (and (text-should-pass "a" (/.regex "a{1,2}") "a") - (text-should-pass "aa" (/.regex "a{1,2}") "aa"))) + (and (text_should_pass "a" (/.regex "a{1,2}") "a") + (text_should_pass "aa" (/.regex "a{1,2}") "aa"))) )) (def: groups Test ($_ _.and (_.test "Can extract groups of sub-matches specified in a pattern." - (and (should-check ["abc" "b"] (/.regex "a(.)c") "abc") - (should-check ["abbbbbc" "bbbbb"] (/.regex "a(b+)c") "abbbbbc") - (should-check ["809-345-6789" "809" "345" "6789"] (/.regex "(\d{3})-(\d{3})-(\d{4})") "809-345-6789") - (should-check ["809-345-6789" "809" "6789"] (/.regex "(\d{3})-(?:\d{3})-(\d{4})") "809-345-6789") - (should-check ["809-809-6789" "809" "6789"] (/.regex "(\d{3})-\0-(\d{4})") "809-809-6789") - (should-check ["809-809-6789" "809" "6789"] (/.regex "(?<code>\d{3})-\k<code>-(\d{4})") "809-809-6789") - (should-check ["809-809-6789-6789" "809" "6789"] (/.regex "(?<code>\d{3})-\k<code>-(\d{4})-\0") "809-809-6789-6789"))) + (and (should_check ["abc" "b"] (/.regex "a(.)c") "abc") + (should_check ["abbbbbc" "bbbbb"] (/.regex "a(b+)c") "abbbbbc") + (should_check ["809-345-6789" "809" "345" "6789"] (/.regex "(\d{3})-(\d{3})-(\d{4})") "809-345-6789") + (should_check ["809-345-6789" "809" "6789"] (/.regex "(\d{3})-(?:\d{3})-(\d{4})") "809-345-6789") + (should_check ["809-809-6789" "809" "6789"] (/.regex "(\d{3})-\0-(\d{4})") "809-809-6789") + (should_check ["809-809-6789" "809" "6789"] (/.regex "(?<code>\d{3})-\k<code>-(\d{4})") "809-809-6789") + (should_check ["809-809-6789-6789" "809" "6789"] (/.regex "(?<code>\d{3})-\k<code>-(\d{4})-\0") "809-809-6789-6789"))) (_.test "Can specify groups within groups." - (should-check ["809-345-6789" "809" ["345-6789" "345" "6789"]] (/.regex "(\d{3})-((\d{3})-(\d{4}))") "809-345-6789")) + (should_check ["809-345-6789" "809" ["345-6789" "345" "6789"]] (/.regex "(\d{3})-((\d{3})-(\d{4}))") "809-345-6789")) )) (def: alternation Test ($_ _.and (_.test "Can specify alternative patterns." - (and (should-check ["a" (0 #0 [])] (/.regex "a|b") "a") - (should-check ["b" (0 #1 [])] (/.regex "a|b") "b") - (should-fail (/.regex "a|b") "c"))) + (and (should_check ["a" (0 #0 [])] (/.regex "a|b") "a") + (should_check ["b" (0 #1 [])] (/.regex "a|b") "b") + (should_fail (/.regex "a|b") "c"))) (_.test "Can have groups within alternations." - (and (should-check ["abc" (0 #0 ["b" "c"])] (/.regex "a(.)(.)|b(.)(.)") "abc") - (should-check ["bcd" (0 #1 ["c" "d"])] (/.regex "a(.)(.)|b(.)(.)") "bcd") - (should-fail (/.regex "a(.)(.)|b(.)(.)") "cde") + (and (should_check ["abc" (0 #0 ["b" "c"])] (/.regex "a(.)(.)|b(.)(.)") "abc") + (should_check ["bcd" (0 #1 ["c" "d"])] (/.regex "a(.)(.)|b(.)(.)") "bcd") + (should_fail (/.regex "a(.)(.)|b(.)(.)") "cde") - (should-check ["123-456-7890" (0 #0 ["123" "456-7890" "456" "7890"])] + (should_check ["123-456-7890" (0 #0 ["123" "456-7890" "456" "7890"])] (/.regex "(\d{3})-((\d{3})-(\d{4}))|b(.)d") "123-456-7890"))) )) @@ -276,12 +276,12 @@ (_.for [/.regex] ($_ _.and ..basics - ..system-character-classes - ..special-system-character-classes - ..custom-character-classes + ..system_character_classes + ..special_system_character_classes + ..custom_character_classes ..references - ..fuzzy-quantifiers - ..crisp-quantifiers + ..fuzzy_quantifiers + ..crisp_quantifiers ..groups ..alternation )) diff --git a/stdlib/source/test/lux/data/text/unicode/block.lux b/stdlib/source/test/lux/data/text/unicode/block.lux index eb55617ca..a575b4fc6 100644 --- a/stdlib/source/test/lux/data/text/unicode/block.lux +++ b/stdlib/source/test/lux/data/text/unicode/block.lux @@ -29,17 +29,17 @@ end random.nat] (wrap (/.block start end)))) -(with-expansions [<blocks> (as-is [blocks/0 - [/.basic-latin - /.latin-1-supplement - /.latin-extended-a - /.latin-extended-b - /.ipa-extensions - /.spacing-modifier-letters - /.combining-diacritical-marks - /.greek-and-coptic +(with_expansions [<blocks> (as_is [blocks/0 + [/.basic_latin + /.latin_1_supplement + /.latin_extended_a + /.latin_extended_b + /.ipa_extensions + /.spacing_modifier_letters + /.combining_diacritical_marks + /.greek_and_coptic /.cyrillic - /.cyrillic-supplementary + /.cyrillic_supplementary /.armenian /.hebrew /.arabic @@ -60,10 +60,10 @@ /.tibetan /.myanmar /.georgian - /.hangul-jamo + /.hangul_jamo /.ethiopic /.cherokee - /.unified-canadian-aboriginal-syllabics + /.unified_canadian_aboriginal_syllabics /.ogham /.runic /.tagalog @@ -74,74 +74,74 @@ /.mongolian]] [blocks/1 [/.limbu - /.tai-le - /.khmer-symbols - /.phonetic-extensions - /.latin-extended-additional - /.greek-extended - /.general-punctuation - /.superscripts-and-subscripts - /.currency-symbols - /.combining-diacritical-marks-for-symbols - /.letterlike-symbols - /.number-forms + /.tai_le + /.khmer_symbols + /.phonetic_extensions + /.latin_extended_additional + /.greek_extended + /.general_punctuation + /.superscripts_and_subscripts + /.currency_symbols + /.combining_diacritical_marks_for_symbols + /.letterlike_symbols + /.number_forms /.arrows - /.mathematical-operators - /.miscellaneous-technical - /.control-pictures - /.optical-character-recognition - /.enclosed-alphanumerics - /.box-drawing - /.block-elements - /.geometric-shapes - /.miscellaneous-symbols + /.mathematical_operators + /.miscellaneous_technical + /.control_pictures + /.optical_character_recognition + /.enclosed_alphanumerics + /.box_drawing + /.block_elements + /.geometric_shapes + /.miscellaneous_symbols /.dingbats - /.miscellaneous-mathematical-symbols-a - /.supplemental-arrows-a - /.braille-patterns - /.supplemental-arrows-b - /.miscellaneous-mathematical-symbols-b - /.supplemental-mathematical-operators - /.miscellaneous-symbols-and-arrows - /.cjk-radicals-supplement - /.kangxi-radicals - /.ideographic-description-characters - /.cjk-symbols-and-punctuation + /.miscellaneous_mathematical_symbols_a + /.supplemental_arrows_a + /.braille_patterns + /.supplemental_arrows_b + /.miscellaneous_mathematical_symbols_b + /.supplemental_mathematical_operators + /.miscellaneous_symbols_and_arrows + /.cjk_radicals_supplement + /.kangxi_radicals + /.ideographic_description_characters + /.cjk_symbols_and_punctuation /.hiragana /.katakana /.bopomofo - /.hangul-compatibility-jamo + /.hangul_compatibility_jamo /.kanbun - /.bopomofo-extended - /.katakana-phonetic-extensions - /.enclosed-cjk-letters-and-months - /.cjk-compatibility - /.cjk-unified-ideographs-extension-a - /.yijing-hexagram-symbols - /.cjk-unified-ideographs - /.yi-syllables - /.yi-radicals - /.hangul-syllables - /.high-surrogates - /.high-private-use-surrogates - /.low-surrogates - /.private-use-area - /.cjk-compatibility-ideographs - /.alphabetic-presentation-forms]] + /.bopomofo_extended + /.katakana_phonetic_extensions + /.enclosed_cjk_letters_and_months + /.cjk_compatibility + /.cjk_unified_ideographs_extension_a + /.yijing_hexagram_symbols + /.cjk_unified_ideographs + /.yi_syllables + /.yi_radicals + /.hangul_syllables + /.high_surrogates + /.high_private_use_surrogates + /.low_surrogates + /.private_use_area + /.cjk_compatibility_ideographs + /.alphabetic_presentation_forms]] [blocks/2 - [/.arabic-presentation-forms-a - /.variation-selectors - /.combining-half-marks - /.cjk-compatibility-forms - /.small-form-variants - /.arabic-presentation-forms-b - /.halfwidth-and-fullwidth-forms + [/.arabic_presentation_forms_a + /.variation_selectors + /.combining_half_marks + /.cjk_compatibility_forms + /.small_form_variants + /.arabic_presentation_forms_b + /.halfwidth_and_fullwidth_forms /.specials ## Specialized blocks - /.basic-latin/decimal - /.basic-latin/upper-alpha - /.basic-latin/lower-alpha]] + /.basic_latin/decimal + /.basic_latin/upper_alpha + /.basic_latin/lower_alpha]] ) <named> (template [<definition> <part>] [((: (-> Any (List /.Block)) @@ -155,7 +155,7 @@ Test (`` (_.cover [(~~ (template.splice <part>))] (let [all (list.concat (list <named>)) - unique (set.from-list /.hash all)] + unique (set.from_list /.hash all)] (n.= (list.size all) (set.size unique))))))] @@ -167,10 +167,10 @@ (<| (_.covering /._) (_.for [/.Block]) (do {! random.monad} - [#let [top-start (hex "AC00") - top-end (hex "D7AF")] - start (\ ! map (|>> (n.% top-start) inc) random.nat) - end (\ ! map (|>> (n.% top-end) inc) random.nat) + [#let [top_start (hex "AC00") + top_end (hex "D7AF")] + start (\ ! map (|>> (n.% top_start) inc) random.nat) + end (\ ! map (|>> (n.% top_end) inc) random.nat) #let [sample (/.block start end) size (/.size sample)] inside (\ ! map diff --git a/stdlib/source/test/lux/data/text/unicode/set.lux b/stdlib/source/test/lux/data/text/unicode/set.lux index 16e29d368..e32c08bfd 100644 --- a/stdlib/source/test/lux/data/text/unicode/set.lux +++ b/stdlib/source/test/lux/data/text/unicode/set.lux @@ -83,11 +83,11 @@ [/.ascii] [/.ascii/alpha] - [/.ascii/alpha-num] - [/.ascii/lower-alpha] - [/.ascii/upper-alpha] + [/.ascii/alpha_num] + [/.ascii/lower_alpha] + [/.ascii/upper_alpha] [/.character] - [/.non-character] + [/.non_character] [/.full] )) |