diff options
Diffstat (limited to '')
38 files changed, 4012 insertions, 4012 deletions
diff --git a/stdlib/source/test/lux/data.lux b/stdlib/source/test/lux/data.lux index 07ec343ce..dc85d5c14 100644 --- a/stdlib/source/test/lux/data.lux +++ b/stdlib/source/test/lux/data.lux @@ -31,40 +31,40 @@ (def: format Test - ($_ _.and - /format/binary.test - /format/json.test - /format/tar.test - /format/xml.test - )) + (all _.and + /format/binary.test + /format/json.test + /format/tar.test + /format/xml.test + )) (def: test/0 Test - ($_ _.and - /binary.test - /bit.test - /color.test - /color/named.test)) + (all _.and + /binary.test + /bit.test + /color.test + /color/named.test)) (def: test/1 Test - ($_ _.and - /identity.test)) + (all _.and + /identity.test)) (def: test/2 Test - ($_ _.and - /product.test - /sum.test - /text.test)) + (all _.and + /product.test + /sum.test + /text.test)) (def: .public test Test ... TODO: Inline ASAP - ($_ _.and - (!bundle test/0) - (!bundle test/1) - (!bundle test/2) - (!bundle ..format) - (!bundle /collection.test) - )) + (all _.and + (!bundle test/0) + (!bundle test/1) + (!bundle test/2) + (!bundle ..format) + (!bundle /collection.test) + )) diff --git a/stdlib/source/test/lux/data/binary.lux b/stdlib/source/test/lux/data/binary.lux index badf40980..d46560ddc 100644 --- a/stdlib/source/test/lux/data/binary.lux +++ b/stdlib/source/test/lux/data/binary.lux @@ -91,57 +91,57 @@ .let [gen_idx (|> random.nat (# ! each (n.% size)))] offset gen_idx length (# ! each (n.% (n.- offset size)) random.nat)] - (`` ($_ _.and - (_.for [!.=] - ($equivalence.spec (function (_ left right) - (!.= left right)) - (..random size))) - (_.cover [!.empty] - (!.= (!.empty size) (!.empty size))) - (_.cover [!.size] - (|> (!.empty size) !.size (n.= size))) - (~~ (template [<power> <bytes/?> <has/?>] - [(_.cover [<bytes/?> <has/?>] - (let [bytes (i64.left_shifted <power> 1) - binary (!.empty bytes) - cap (case bytes - 8 (-- 0) - _ (|> 1 (i64.left_shifted (n.* 8 bytes)) --)) - capped_value (i64.and cap value) - - pre (<bytes/?> 0 binary) - _ (<has/?> 0 value binary) - post (<bytes/?> 0 binary)] - (and (n.= 0 pre) - (n.= capped_value post))))] + (`` (all _.and + (_.for [!.=] + ($equivalence.spec (function (_ left right) + (!.= left right)) + (..random size))) + (_.cover [!.empty] + (!.= (!.empty size) (!.empty size))) + (_.cover [!.size] + (|> (!.empty size) !.size (n.= size))) + (~~ (template [<power> <bytes/?> <has/?>] + [(_.cover [<bytes/?> <has/?>] + (let [bytes (i64.left_shifted <power> 1) + binary (!.empty bytes) + cap (case bytes + 8 (-- 0) + _ (|> 1 (i64.left_shifted (n.* 8 bytes)) --)) + capped_value (i64.and cap value) + + pre (<bytes/?> 0 binary) + _ (<has/?> 0 value binary) + post (<bytes/?> 0 binary)] + (and (n.= 0 pre) + (n.= capped_value post))))] - [0 !.bits_8 !.has_8!] - [1 !.bits_16 !.has_16!] - [2 !.bits_32 !.has_32!] - [3 !.bits_64 !.has_64!])) - (_.cover [!.slice] - (let [random_slice (!.slice offset length sample) - idxs (is (List Nat) - (case length - 0 (list) - _ (enum.range n.enum 0 (-- length)))) - reader (function (_ binary idx) - (!.bits_8 idx binary))] - (and (n.= length (!.size random_slice)) - (# (list.equivalence n.equivalence) = - (list#each (|>> (n.+ offset) (reader sample)) idxs) - (list#each (reader random_slice) idxs))))) - (_.cover [!.copy!] - (and (let [it (!.copy! size 0 sample 0 (!.empty size))] - (and (not (same? sample it)) - (!.= sample it))) - (let [sample/0 (!.bits_8 0 sample) - copy (!.copy! 1 0 sample 0 (!.empty 2)) - copy/0 (!.bits_8 0 copy) - copy/1 (!.bits_8 1 copy)] - (and (n.= sample/0 copy/0) - (n.= 0 copy/1))))) - ))))) + [0 !.bits_8 !.has_8!] + [1 !.bits_16 !.has_16!] + [2 !.bits_32 !.has_32!] + [3 !.bits_64 !.has_64!])) + (_.cover [!.slice] + (let [random_slice (!.slice offset length sample) + idxs (is (List Nat) + (case length + 0 (list) + _ (enum.range n.enum 0 (-- length)))) + reader (function (_ binary idx) + (!.bits_8 idx binary))] + (and (n.= length (!.size random_slice)) + (# (list.equivalence n.equivalence) = + (list#each (|>> (n.+ offset) (reader sample)) idxs) + (list#each (reader random_slice) idxs))))) + (_.cover [!.copy!] + (and (let [it (!.copy! size 0 sample 0 (!.empty size))] + (and (not (same? sample it)) + (!.= sample it))) + (let [sample/0 (!.bits_8 0 sample) + copy (!.copy! 1 0 sample 0 (!.empty 2)) + copy/0 (!.bits_8 0 copy) + copy/1 (!.bits_8 1 copy)] + (and (n.= sample/0 copy/0) + (n.= 0 copy/1))))) + ))))) (def: .public test Test @@ -155,89 +155,89 @@ .let [gen_idx (|> random.nat (# ! each (n.% size)))] offset (# ! each (n.max 1) gen_idx) length (# ! each (n.% (n.- offset size)) random.nat)] - ($_ _.and - (_.for [/.equivalence] - ($equivalence.spec /.equivalence (..random size))) - (_.for [/.monoid] - ($monoid.spec /.equivalence /.monoid (..random size))) - (_.cover [/.mix] - (n.= (# list.mix mix n.+ 0 (..as_list sample)) - (/.mix n.+ 0 sample))) - - (_.cover [/.empty] - (# /.equivalence = - (/.empty size) - (/.empty size))) - (_.cover [/.size] - (|> (/.empty size) /.size (n.= size))) - (_.for [/.index_out_of_bounds] - ($_ _.and - (_.cover [/.bits_8 /.has_8!] - (..binary_io 0 /.bits_8 /.has_8! value)) - (_.cover [/.bits_16 /.has_16!] - (..binary_io 1 /.bits_16 /.has_16! value)) - (_.cover [/.bits_32 /.has_32!] - (..binary_io 2 /.bits_32 /.has_32! value)) - (_.cover [/.bits_64 /.has_64!] - (..binary_io 3 /.bits_64 /.has_64! value)))) - (_.cover [/.slice] - (let [random_slice (try.trusted (/.slice offset length sample)) - idxs (is (List Nat) - (case length - 0 (list) - _ (enum.range n.enum 0 (-- length)))) - reader (function (_ binary idx) - (/.bits_8 idx binary))] - (and (n.= length (/.size random_slice)) - (case [(monad.each try.monad (|>> (n.+ offset) (reader sample)) idxs) - (monad.each try.monad (reader random_slice) idxs)] - [{try.#Success binary_vals} {try.#Success slice_vals}] - (# (list.equivalence n.equivalence) = binary_vals slice_vals) + (all _.and + (_.for [/.equivalence] + ($equivalence.spec /.equivalence (..random size))) + (_.for [/.monoid] + ($monoid.spec /.equivalence /.monoid (..random size))) + (_.cover [/.mix] + (n.= (# list.mix mix n.+ 0 (..as_list sample)) + (/.mix n.+ 0 sample))) + + (_.cover [/.empty] + (# /.equivalence = + (/.empty size) + (/.empty size))) + (_.cover [/.size] + (|> (/.empty size) /.size (n.= size))) + (_.for [/.index_out_of_bounds] + (all _.and + (_.cover [/.bits_8 /.has_8!] + (..binary_io 0 /.bits_8 /.has_8! value)) + (_.cover [/.bits_16 /.has_16!] + (..binary_io 1 /.bits_16 /.has_16! value)) + (_.cover [/.bits_32 /.has_32!] + (..binary_io 2 /.bits_32 /.has_32! value)) + (_.cover [/.bits_64 /.has_64!] + (..binary_io 3 /.bits_64 /.has_64! value)))) + (_.cover [/.slice] + (let [random_slice (try.trusted (/.slice offset length sample)) + idxs (is (List Nat) + (case length + 0 (list) + _ (enum.range n.enum 0 (-- length)))) + reader (function (_ binary idx) + (/.bits_8 idx binary))] + (and (n.= length (/.size random_slice)) + (case [(monad.each try.monad (|>> (n.+ offset) (reader sample)) idxs) + (monad.each try.monad (reader random_slice) idxs)] + [{try.#Success binary_vals} {try.#Success slice_vals}] + (# (list.equivalence n.equivalence) = binary_vals slice_vals) - _ - #0)))) - (_.cover [/.slice_out_of_bounds] - (and (throws? /.slice_out_of_bounds (/.slice size size sample)) - (let [verdict (throws? /.slice_out_of_bounds (/.slice offset size sample))] - (case offset - 0 (not verdict) - _ verdict)))) - (_.cover [/.after] - (and (# /.equivalence = sample (/.after 0 sample)) - (# /.equivalence = (/.empty 0) (/.after size sample)) - (n.= (n.- offset size) (/.size (/.after offset sample))) - (case (list.reversed (..as_list sample)) - {.#End} - false + _ + #0)))) + (_.cover [/.slice_out_of_bounds] + (and (throws? /.slice_out_of_bounds (/.slice size size sample)) + (let [verdict (throws? /.slice_out_of_bounds (/.slice offset size sample))] + (case offset + 0 (not verdict) + _ verdict)))) + (_.cover [/.after] + (and (# /.equivalence = sample (/.after 0 sample)) + (# /.equivalence = (/.empty 0) (/.after size sample)) + (n.= (n.- offset size) (/.size (/.after offset sample))) + (case (list.reversed (..as_list sample)) + {.#End} + false - {.#Item head tail} - (n.= (list.mix n.+ 0 tail) - (/.mix n.+ 0 (/.after 1 sample)))))) - (_.cover [/.copy!] - (and (case (/.copy! size 0 sample 0 (/.empty size)) - {try.#Success output} - (and (not (same? sample output)) - (# /.equivalence = sample output)) + {.#Item head tail} + (n.= (list.mix n.+ 0 tail) + (/.mix n.+ 0 (/.after 1 sample)))))) + (_.cover [/.copy!] + (and (case (/.copy! size 0 sample 0 (/.empty size)) + {try.#Success output} + (and (not (same? sample output)) + (# /.equivalence = sample output)) - {try.#Failure _} - false) - (succeed - (do try.monad - [sample/0 (/.bits_8 0 sample) - copy (/.copy! 1 0 sample 0 (/.empty 2)) - copy/0 (/.bits_8 0 copy) - copy/1 (/.bits_8 1 copy)] - (in (and (n.= sample/0 copy/0) - (n.= 0 copy/1))))))) - (_.cover [/.cannot_copy] - (and (not (throws? /.cannot_copy - (/.copy! size 0 sample 0 (/.empty size)))) - (throws? /.cannot_copy - (/.copy! (n.+ offset size) 0 sample 0 (/.empty size))) - (throws? /.cannot_copy - (/.copy! size offset sample 0 (/.empty size))) - (throws? /.cannot_copy - (/.copy! size 0 sample offset (/.empty size))))) + {try.#Failure _} + false) + (succeed + (do try.monad + [sample/0 (/.bits_8 0 sample) + copy (/.copy! 1 0 sample 0 (/.empty 2)) + copy/0 (/.bits_8 0 copy) + copy/1 (/.bits_8 1 copy)] + (in (and (n.= sample/0 copy/0) + (n.= 0 copy/1))))))) + (_.cover [/.cannot_copy] + (and (not (throws? /.cannot_copy + (/.copy! size 0 sample 0 (/.empty size)))) + (throws? /.cannot_copy + (/.copy! (n.+ offset size) 0 sample 0 (/.empty size))) + (throws? /.cannot_copy + (/.copy! size offset sample 0 (/.empty size))) + (throws? /.cannot_copy + (/.copy! size 0 sample offset (/.empty size))))) - ..test|unsafe - )))) + ..test|unsafe + )))) diff --git a/stdlib/source/test/lux/data/bit.lux b/stdlib/source/test/lux/data/bit.lux index 695052aab..fed07f172 100644 --- a/stdlib/source/test/lux/data/bit.lux +++ b/stdlib/source/test/lux/data/bit.lux @@ -1,45 +1,45 @@ (.using - [library - [lux "*" - ["_" test {"+" Test}] - [abstract - [monad {"+" do}] - [\\specification - ["$[0]" equivalence] - ["$[0]" hash] - ["$[0]" monoid] - ["$[0]" codec]]] - [control - ["[0]" function]] - [math - ["[0]" random]]]] - [\\library - ["[0]" /]]) + [library + [lux "*" + ["_" test {"+" Test}] + [abstract + [monad {"+" do}] + [\\specification + ["$[0]" equivalence] + ["$[0]" hash] + ["$[0]" monoid] + ["$[0]" codec]]] + [control + ["[0]" function]] + [math + ["[0]" random]]]] + [\\library + ["[0]" /]]) (def: .public test Test (<| (_.covering /._) (do random.monad [value random.bit] - ($_ _.and - (_.for [/.equivalence] - ($equivalence.spec /.equivalence random.bit)) - (_.for [/.hash] - ($hash.spec /.hash random.bit)) - (_.for [/.disjunction] - ($monoid.spec /.equivalence /.disjunction random.bit)) - (_.for [/.conjunction] - ($monoid.spec /.equivalence /.conjunction random.bit)) - (_.for [/.codec] - ($codec.spec /.equivalence /.codec random.bit)) - - (_.cover [/.no /.yes] - (and (# /.equivalence = false /.no) - (# /.equivalence = true /.yes))) - (_.cover [/.off /.on] - (and (# /.equivalence = false /.off) - (# /.equivalence = true /.on))) - (_.cover [/.complement] - (and (not (# /.equivalence = value ((/.complement function.identity) value))) - (# /.equivalence = value ((/.complement not) value)))) - )))) + (all _.and + (_.for [/.equivalence] + ($equivalence.spec /.equivalence random.bit)) + (_.for [/.hash] + ($hash.spec /.hash random.bit)) + (_.for [/.disjunction] + ($monoid.spec /.equivalence /.disjunction random.bit)) + (_.for [/.conjunction] + ($monoid.spec /.equivalence /.conjunction random.bit)) + (_.for [/.codec] + ($codec.spec /.equivalence /.codec random.bit)) + + (_.cover [/.no /.yes] + (and (# /.equivalence = false /.no) + (# /.equivalence = true /.yes))) + (_.cover [/.off /.on] + (and (# /.equivalence = false /.off) + (# /.equivalence = true /.on))) + (_.cover [/.complement] + (and (not (# /.equivalence = value ((/.complement function.identity) value))) + (# /.equivalence = value ((/.complement not) value)))) + )))) diff --git a/stdlib/source/test/lux/data/collection.lux b/stdlib/source/test/lux/data/collection.lux index 686ccdacf..42c962e59 100644 --- a/stdlib/source/test/lux/data/collection.lux +++ b/stdlib/source/test/lux/data/collection.lux @@ -1,68 +1,68 @@ (.using - [library - [lux "*" - ["_" test {"+" Test}]]] - ["[0]" / "_" - ["[1][0]" array] - ["[1][0]" bits] - ["[1][0]" list] - ["[1][0]" sequence] - ["[1][0]" stream] - ["[1][0]" stack] - ["[1][0]" dictionary - ["[1]/[0]" ordered] - ["[1]/[0]" plist]] - ["[1][0]" queue - ["[1]/[0]" priority]] - ["[1][0]" set - ["[1]/[0]" multi] - ["[1]/[0]" ordered]] - ["[1][0]" tree - ["[1]/[0]" finger] - ["[1]/[0]" zipper]]]) + [library + [lux "*" + ["_" test {"+" Test}]]] + ["[0]" / "_" + ["[1][0]" array] + ["[1][0]" bits] + ["[1][0]" list] + ["[1][0]" sequence] + ["[1][0]" stream] + ["[1][0]" stack] + ["[1][0]" dictionary + ["[1]/[0]" ordered] + ["[1]/[0]" plist]] + ["[1][0]" queue + ["[1]/[0]" priority]] + ["[1][0]" set + ["[1]/[0]" multi] + ["[1]/[0]" ordered]] + ["[1][0]" tree + ["[1]/[0]" finger] + ["[1]/[0]" zipper]]]) (def: dictionary Test - ($_ _.and - /dictionary.test - /dictionary/ordered.test - /dictionary/plist.test - )) + (all _.and + /dictionary.test + /dictionary/ordered.test + /dictionary/plist.test + )) (def: queue Test - ($_ _.and - /queue.test - /queue/priority.test - )) + (all _.and + /queue.test + /queue/priority.test + )) (def: set Test - ($_ _.and - /set.test - /set/multi.test - /set/ordered.test - )) + (all _.and + /set.test + /set/multi.test + /set/ordered.test + )) (def: tree Test - ($_ _.and - /tree.test - /tree/finger.test - /tree/zipper.test - )) + (all _.and + /tree.test + /tree/finger.test + /tree/zipper.test + )) (def: .public test Test - ($_ _.and - /array.test - /bits.test - /list.test - /sequence.test - /stream.test - /stack.test - ..dictionary - ..queue - ..set - ..tree - )) + (all _.and + /array.test + /bits.test + /list.test + /sequence.test + /stream.test + /stack.test + ..dictionary + ..queue + ..set + ..tree + )) diff --git a/stdlib/source/test/lux/data/collection/array.lux b/stdlib/source/test/lux/data/collection/array.lux index 1008f2422..bbb829d98 100644 --- a/stdlib/source/test/lux/data/collection/array.lux +++ b/stdlib/source/test/lux/data/collection/array.lux @@ -41,16 +41,16 @@ Test (do [! random.monad] [size ..bounded_size] - ($_ _.and - (_.for [/.equivalence] - ($equivalence.spec (/.equivalence n.equivalence) (random.array size random.nat))) - (_.for [/.monoid] - ($monoid.spec (/.equivalence n.equivalence) /.monoid (random.array size random.nat))) - (_.for [/.functor] - ($functor.spec ..injection /.equivalence /.functor)) - (_.for [/.mix] - ($mix.spec ..injection /.equivalence /.mix)) - ))) + (all _.and + (_.for [/.equivalence] + ($equivalence.spec (/.equivalence n.equivalence) (random.array size random.nat))) + (_.for [/.monoid] + ($monoid.spec (/.equivalence n.equivalence) /.monoid (random.array size random.nat))) + (_.for [/.functor] + ($functor.spec ..injection /.equivalence /.functor)) + (_.for [/.mix] + ($mix.spec ..injection /.equivalence /.mix)) + ))) (def: search Test @@ -61,58 +61,58 @@ .let [expected (n.+ base shift)] the_array (random.array size random.nat) evens (random.array size (random.only n.even? random.nat))] - ($_ _.and - (let [(open "/#[0]") /.functor - choose (is (-> Nat (Maybe Text)) - (function (_ value) - (if (n.even? value) - {.#Some (# n.decimal encoded value)} - {.#None})))] - (_.cover [/.one] - (case [(|> evens - (/#each (# n.decimal encoded)) - (/.item 0)) - (/.one choose evens)] - [{.#Some expected} {.#Some actual}] - (text#= expected actual) + (all _.and + (let [(open "/#[0]") /.functor + choose (is (-> Nat (Maybe Text)) + (function (_ value) + (if (n.even? value) + {.#Some (# n.decimal encoded value)} + {.#None})))] + (_.cover [/.one] + (case [(|> evens + (/#each (# n.decimal encoded)) + (/.item 0)) + (/.one choose evens)] + [{.#Some expected} {.#Some actual}] + (text#= expected actual) - [{.#None} {.#None}] - true + [{.#None} {.#None}] + true - _ - false))) - (_.cover [/.example] - (# (maybe.equivalence n.equivalence) = - (/.example n.even? the_array) - (list.example n.even? (/.list {.#None} the_array)))) - (_.cover [/.example'] - (case [(/.example n.even? the_array) - (/.example' (function (_ idx member) - (n.even? member)) - the_array)] - [{.#Some expected} {.#Some [idx actual]}] - (case (/.item idx the_array) - {.#Some again} - (and (n.= expected actual) - (n.= actual again)) - - {.#None} - false) + _ + false))) + (_.cover [/.example] + (# (maybe.equivalence n.equivalence) = + (/.example n.even? the_array) + (list.example n.even? (/.list {.#None} the_array)))) + (_.cover [/.example'] + (case [(/.example n.even? the_array) + (/.example' (function (_ idx member) + (n.even? member)) + the_array)] + [{.#Some expected} {.#Some [idx actual]}] + (case (/.item idx the_array) + {.#Some again} + (and (n.= expected actual) + (n.= actual again)) + + {.#None} + false) - [{.#None} {.#None}] - true + [{.#None} {.#None}] + true - _ - false)) - (_.cover [/.every?] - (# bit.equivalence = - (list.every? n.even? (/.list {.#None} the_array)) - (/.every? n.even? the_array))) - (_.cover [/.any?] - (# bit.equivalence = - (list.any? n.even? (/.list {.#None} the_array)) - (/.any? n.even? the_array))) - ))) + _ + false)) + (_.cover [/.every?] + (# bit.equivalence = + (list.every? n.even? (/.list {.#None} the_array)) + (/.every? n.even? the_array))) + (_.cover [/.any?] + (# bit.equivalence = + (list.any? n.even? (/.list {.#None} the_array)) + (/.any? n.even? the_array))) + ))) (def: test|unsafe Test @@ -126,183 +126,183 @@ .let [expected (n.+ base shift)] the_array (random.array size random.nat) evens (random.array size (random.only n.even? random.nat))] - (`` ($_ _.and - (_.for [!.=] - ($equivalence.spec (function (_ left right) - (!.= n.equivalence left right)) - (random.array size random.nat))) - (_.for [!.composite] - ($monoid.spec (/.equivalence n.equivalence) - (implementation - (def: identity (!.empty 0)) - (def: (composite left right) - (!.composite left right))) - (random.array size random.nat))) - (_.for [!.each] - ($functor.spec ..injection /.equivalence - (function (_ $ it) - (!.each $ it)))) - (_.for [!.mix] - ($mix.spec ..injection /.equivalence - (is (Mix !.Array) - (function (_ $ init it) - (!.mix (function (_ index item output) - ($ item output)) - init - it))))) - - (_.cover [!.empty !.size] - (n.= size (!.size (is (Array Nat) - (!.empty size))))) - (_.cover [!.type] - (case !.Array - (pattern (<| {.#Named (symbol !.Array)} - {.#UnivQ (list)} - {.#Primitive nominal_type (list {.#Parameter 1})})) - (same? !.type nominal_type) + (`` (all _.and + (_.for [!.=] + ($equivalence.spec (function (_ left right) + (!.= n.equivalence left right)) + (random.array size random.nat))) + (_.for [!.composite] + ($monoid.spec (/.equivalence n.equivalence) + (implementation + (def: identity (!.empty 0)) + (def: (composite left right) + (!.composite left right))) + (random.array size random.nat))) + (_.for [!.each] + ($functor.spec ..injection /.equivalence + (function (_ $ it) + (!.each $ it)))) + (_.for [!.mix] + ($mix.spec ..injection /.equivalence + (is (Mix !.Array) + (function (_ $ init it) + (!.mix (function (_ index item output) + ($ item output)) + init + it))))) + + (_.cover [!.empty !.size] + (n.= size (!.size (is (Array Nat) + (!.empty size))))) + (_.cover [!.type] + (case !.Array + (pattern (<| {.#Named (symbol !.Array)} + {.#UnivQ (list)} + {.#Primitive nominal_type (list {.#Parameter 1})})) + (same? !.type nominal_type) - _ - false)) - (_.cover [!.lacks?] - (let [the_array (|> (!.empty 2) - (is (Array Nat)) - (!.has! 0 expected))] - (and (not (!.lacks? 0 the_array)) - (!.lacks? 1 the_array)))) - (_.cover [!.item !.has!] - (|> (!.empty 2) - (is (Array Nat)) - (!.has! 0 expected) - (!.item 0) - (n.= expected))) - (_.cover [!.lacks!] - (|> (!.empty 1) - (is (Array Nat)) - (!.has! 0 expected) - (!.lacks! 0) - (!.lacks? 0))) - (_.cover [!.lacks?] - (let [the_array (|> (!.empty 2) - (is (Array Nat)) - (!.has! 0 expected))] - (and (not (!.lacks? 0 the_array)) - (!.lacks? 1 the_array)))) - (_.cover [!.has?] - (let [the_array (|> (!.empty 2) - (is (Array Nat)) - (!.has! 0 expected))] - (and (!.has? 0 the_array) - (not (!.has? 1 the_array))))) - (_.cover [!.revised!] - (|> (!.empty 1) - (is (Array Nat)) - (!.has! 0 base) - (!.revised! 0 (n.+ shift)) - (!.item 0) - (n.= expected))) - (_.cover [!.upsert!] - (let [the_array (|> (!.empty 2) - (is (Array Nat)) - (!.has! 0 base) - (!.upsert! 0 dummy (n.+ shift)) - (!.upsert! 1 base (n.+ shift)))] - (and (n.= expected (!.item 0 the_array)) - (n.= expected (!.item 1 the_array))))) - (do ! - [occupancy (# ! each (n.% (++ size)) random.nat)] - (_.cover [!.occupancy !.vacancy] - (let [the_array (loop (again [output (is (Array Nat) - (!.empty size)) - idx 0]) - (if (n.< occupancy idx) - (again (!.has! idx expected output) - (++ idx)) - output))] - (and (n.= occupancy (!.occupancy the_array)) - (n.= size (n.+ (!.occupancy the_array) - (!.vacancy the_array))))))) - (do ! - [the_list (random.list size random.nat) - .let [the_array (!.clone the_array) - members (|> the_array (!.list {.#None}) (set.of_list n.hash))] - default (random.only (function (_ value) - (not (or (n.even? value) - (set.member? members value)))) - random.nat)] - (_.cover [!.of_list !.list] - (and (|> the_list !.of_list (!.list {.#None}) - (# (list.equivalence n.equivalence) = the_list)) - (|> the_array (!.list {.#None}) !.of_list - (!.= n.equivalence the_array)) - (exec - (!.only! n.even? the_array) - (list.every? (function (_ value) - (or (n.even? value) - (same? default value))) - (!.list {.#Some default} the_array)))))) - (do ! - [amount (# ! each (n.% (++ size)) random.nat)] - (_.cover [!.copy!] - (let [copy (is (Array Nat) - (!.empty size))] - (exec (!.copy! amount 0 the_array 0 copy) - (# (list.equivalence n.equivalence) = - (list.first amount (!.list {.#None} the_array)) - (!.list {.#None} copy)))))) - (_.cover [!.clone] - (let [clone (!.clone the_array)] - (and (not (same? the_array clone)) - (!.= n.equivalence the_array clone)))) - (let [the_array (!.clone the_array) - evens (|> the_array (!.list {.#None}) (list.only n.even?)) - odds (|> the_array (!.list {.#None}) (list.only n.odd?))] - (_.cover [!.only!] - (exec (!.only! n.even? the_array) - (and (n.= (list.size evens) (!.occupancy the_array)) - (n.= (list.size odds) (!.vacancy the_array)) - (|> the_array - (!.list {.#None}) - (# (list.equivalence n.equivalence) = evens)))))) - (let [choose (is (-> Nat (Maybe Text)) - (function (_ value) - (if (n.even? value) - {.#Some (# n.decimal encoded value)} - {.#None})))] - (_.cover [!.one] - (|> evens - (!.one choose) - (maybe#each (text#= (|> evens - (!.each (# n.decimal encoded)) - (!.item 0)))) - (maybe.else false)))) - (_.cover [!.example] - (# (maybe.equivalence n.equivalence) = - (!.example n.even? the_array) - (list.example n.even? (!.list {.#None} the_array)))) - (_.cover [!.example'] - (case [(!.example n.even? the_array) - (!.example' (function (_ idx member) - (n.even? member)) - the_array)] - [{.#Some expected} {.#Some [idx actual]}] - (and (not (!.lacks? idx the_array)) - (n.= expected actual) - (n.= actual (!.item idx the_array))) + _ + false)) + (_.cover [!.lacks?] + (let [the_array (|> (!.empty 2) + (is (Array Nat)) + (!.has! 0 expected))] + (and (not (!.lacks? 0 the_array)) + (!.lacks? 1 the_array)))) + (_.cover [!.item !.has!] + (|> (!.empty 2) + (is (Array Nat)) + (!.has! 0 expected) + (!.item 0) + (n.= expected))) + (_.cover [!.lacks!] + (|> (!.empty 1) + (is (Array Nat)) + (!.has! 0 expected) + (!.lacks! 0) + (!.lacks? 0))) + (_.cover [!.lacks?] + (let [the_array (|> (!.empty 2) + (is (Array Nat)) + (!.has! 0 expected))] + (and (not (!.lacks? 0 the_array)) + (!.lacks? 1 the_array)))) + (_.cover [!.has?] + (let [the_array (|> (!.empty 2) + (is (Array Nat)) + (!.has! 0 expected))] + (and (!.has? 0 the_array) + (not (!.has? 1 the_array))))) + (_.cover [!.revised!] + (|> (!.empty 1) + (is (Array Nat)) + (!.has! 0 base) + (!.revised! 0 (n.+ shift)) + (!.item 0) + (n.= expected))) + (_.cover [!.upsert!] + (let [the_array (|> (!.empty 2) + (is (Array Nat)) + (!.has! 0 base) + (!.upsert! 0 dummy (n.+ shift)) + (!.upsert! 1 base (n.+ shift)))] + (and (n.= expected (!.item 0 the_array)) + (n.= expected (!.item 1 the_array))))) + (do ! + [occupancy (# ! each (n.% (++ size)) random.nat)] + (_.cover [!.occupancy !.vacancy] + (let [the_array (loop (again [output (is (Array Nat) + (!.empty size)) + idx 0]) + (if (n.< occupancy idx) + (again (!.has! idx expected output) + (++ idx)) + output))] + (and (n.= occupancy (!.occupancy the_array)) + (n.= size (n.+ (!.occupancy the_array) + (!.vacancy the_array))))))) + (do ! + [the_list (random.list size random.nat) + .let [the_array (!.clone the_array) + members (|> the_array (!.list {.#None}) (set.of_list n.hash))] + default (random.only (function (_ value) + (not (or (n.even? value) + (set.member? members value)))) + random.nat)] + (_.cover [!.of_list !.list] + (and (|> the_list !.of_list (!.list {.#None}) + (# (list.equivalence n.equivalence) = the_list)) + (|> the_array (!.list {.#None}) !.of_list + (!.= n.equivalence the_array)) + (exec + (!.only! n.even? the_array) + (list.every? (function (_ value) + (or (n.even? value) + (same? default value))) + (!.list {.#Some default} the_array)))))) + (do ! + [amount (# ! each (n.% (++ size)) random.nat)] + (_.cover [!.copy!] + (let [copy (is (Array Nat) + (!.empty size))] + (exec (!.copy! amount 0 the_array 0 copy) + (# (list.equivalence n.equivalence) = + (list.first amount (!.list {.#None} the_array)) + (!.list {.#None} copy)))))) + (_.cover [!.clone] + (let [clone (!.clone the_array)] + (and (not (same? the_array clone)) + (!.= n.equivalence the_array clone)))) + (let [the_array (!.clone the_array) + evens (|> the_array (!.list {.#None}) (list.only n.even?)) + odds (|> the_array (!.list {.#None}) (list.only n.odd?))] + (_.cover [!.only!] + (exec (!.only! n.even? the_array) + (and (n.= (list.size evens) (!.occupancy the_array)) + (n.= (list.size odds) (!.vacancy the_array)) + (|> the_array + (!.list {.#None}) + (# (list.equivalence n.equivalence) = evens)))))) + (let [choose (is (-> Nat (Maybe Text)) + (function (_ value) + (if (n.even? value) + {.#Some (# n.decimal encoded value)} + {.#None})))] + (_.cover [!.one] + (|> evens + (!.one choose) + (maybe#each (text#= (|> evens + (!.each (# n.decimal encoded)) + (!.item 0)))) + (maybe.else false)))) + (_.cover [!.example] + (# (maybe.equivalence n.equivalence) = + (!.example n.even? the_array) + (list.example n.even? (!.list {.#None} the_array)))) + (_.cover [!.example'] + (case [(!.example n.even? the_array) + (!.example' (function (_ idx member) + (n.even? member)) + the_array)] + [{.#Some expected} {.#Some [idx actual]}] + (and (not (!.lacks? idx the_array)) + (n.= expected actual) + (n.= actual (!.item idx the_array))) - [{.#None} {.#None}] - true + [{.#None} {.#None}] + true - _ - false)) - (_.cover [!.every?] - (# bit.equivalence = - (list.every? n.even? (!.list {.#None} the_array)) - (!.every? n.even? the_array))) - (_.cover [!.any?] - (# bit.equivalence = - (list.any? n.even? (!.list {.#None} the_array)) - (!.any? n.even? the_array))) - ))))) + _ + false)) + (_.cover [!.every?] + (# bit.equivalence = + (list.every? n.even? (!.list {.#None} the_array)) + (!.every? n.even? the_array))) + (_.cover [!.any?] + (# bit.equivalence = + (list.any? n.even? (!.list {.#None} the_array)) + (!.any? n.even? the_array))) + ))))) (def: .public test Test @@ -315,135 +315,135 @@ dummy (random.only (|>> (n.= base) not) random.nat) .let [expected (n.+ base shift)] the_array (random.array size random.nat)] - ($_ _.and - ..structures - ..search + (all _.and + ..structures + ..search - (_.cover [/.empty /.size] - (n.= size (/.size (is (Array Nat) - (/.empty size))))) - (_.cover [/.type_name] - (case /.Array - (pattern (<| {.#Named (symbol /.Array)} - {.#Named (symbol !.Array)} - {.#UnivQ (list)} - {.#Primitive nominal_type (list {.#Parameter 1})})) - (same? /.type_name nominal_type) + (_.cover [/.empty /.size] + (n.= size (/.size (is (Array Nat) + (/.empty size))))) + (_.cover [/.type_name] + (case /.Array + (pattern (<| {.#Named (symbol /.Array)} + {.#Named (symbol !.Array)} + {.#UnivQ (list)} + {.#Primitive nominal_type (list {.#Parameter 1})})) + (same? /.type_name nominal_type) - _ - false)) - (_.cover [/.item /.has!] - (let [the_array (|> (/.empty 2) - (is (Array Nat)) - (/.has! 0 expected))] - (case [(/.item 0 the_array) - (/.item 1 the_array)] - [{.#Some actual} {.#None}] - (n.= expected actual) + _ + false)) + (_.cover [/.item /.has!] + (let [the_array (|> (/.empty 2) + (is (Array Nat)) + (/.has! 0 expected))] + (case [(/.item 0 the_array) + (/.item 1 the_array)] + [{.#Some actual} {.#None}] + (n.= expected actual) - _ - false))) - (_.cover [/.lacks!] - (let [the_array (|> (/.empty 1) - (is (Array Nat)) - (/.has! 0 expected))] - (case [(/.item 0 the_array) - (/.item 0 (/.lacks! 0 the_array))] - [{.#Some actual} {.#None}] - (n.= expected actual) + _ + false))) + (_.cover [/.lacks!] + (let [the_array (|> (/.empty 1) + (is (Array Nat)) + (/.has! 0 expected))] + (case [(/.item 0 the_array) + (/.item 0 (/.lacks! 0 the_array))] + [{.#Some actual} {.#None}] + (n.= expected actual) - _ - false))) - (_.cover [/.lacks?] - (let [the_array (|> (/.empty 2) - (is (Array Nat)) - (/.has! 0 expected))] - (and (not (/.lacks? 0 the_array)) - (/.lacks? 1 the_array)))) - (_.cover [/.has?] - (let [the_array (|> (/.empty 2) - (is (Array Nat)) - (/.has! 0 expected))] - (and (/.has? 0 the_array) - (not (/.has? 1 the_array))))) - (_.cover [/.revised!] - (let [the_array (|> (/.empty 1) - (is (Array Nat)) - (/.has! 0 base) - (/.revised! 0 (n.+ shift)))] - (case (/.item 0 the_array) - {.#Some actual} - (n.= expected actual) + _ + false))) + (_.cover [/.lacks?] + (let [the_array (|> (/.empty 2) + (is (Array Nat)) + (/.has! 0 expected))] + (and (not (/.lacks? 0 the_array)) + (/.lacks? 1 the_array)))) + (_.cover [/.has?] + (let [the_array (|> (/.empty 2) + (is (Array Nat)) + (/.has! 0 expected))] + (and (/.has? 0 the_array) + (not (/.has? 1 the_array))))) + (_.cover [/.revised!] + (let [the_array (|> (/.empty 1) + (is (Array Nat)) + (/.has! 0 base) + (/.revised! 0 (n.+ shift)))] + (case (/.item 0 the_array) + {.#Some actual} + (n.= expected actual) - _ - false))) - (_.cover [/.upsert!] - (let [the_array (|> (/.empty 2) - (is (Array Nat)) - (/.has! 0 base) - (/.upsert! 0 dummy (n.+ shift)) - (/.upsert! 1 base (n.+ shift)))] - (case [(/.item 0 the_array) - (/.item 1 the_array)] - [{.#Some actual/0} {.#Some actual/1}] - (and (n.= expected actual/0) - (n.= expected actual/1)) + _ + false))) + (_.cover [/.upsert!] + (let [the_array (|> (/.empty 2) + (is (Array Nat)) + (/.has! 0 base) + (/.upsert! 0 dummy (n.+ shift)) + (/.upsert! 1 base (n.+ shift)))] + (case [(/.item 0 the_array) + (/.item 1 the_array)] + [{.#Some actual/0} {.#Some actual/1}] + (and (n.= expected actual/0) + (n.= expected actual/1)) - _ - false))) - (do ! - [occupancy (# ! each (n.% (++ size)) random.nat)] - (_.cover [/.occupancy /.vacancy] - (let [the_array (loop (again [output (is (Array Nat) - (/.empty size)) - idx 0]) - (if (n.< occupancy idx) - (again (/.has! idx expected output) - (++ idx)) - output))] - (and (n.= occupancy (/.occupancy the_array)) - (n.= size (n.+ (/.occupancy the_array) - (/.vacancy the_array))))))) - (do ! - [the_list (random.list size random.nat) - .let [the_array (/.clone the_array) - members (|> the_array (/.list {.#None}) (set.of_list n.hash))] - default (random.only (function (_ value) - (not (or (n.even? value) - (set.member? members value)))) - random.nat)] - (_.cover [/.of_list /.list] - (and (|> the_list /.of_list (/.list {.#None}) - (# (list.equivalence n.equivalence) = the_list)) - (|> the_array (/.list {.#None}) /.of_list - (# (/.equivalence n.equivalence) = the_array)) - (exec - (/.only! n.even? the_array) - (list.every? (function (_ value) - (or (n.even? value) - (same? default value))) - (/.list {.#Some default} the_array)))))) - (do ! - [amount (# ! each (n.% (++ size)) random.nat)] - (_.cover [/.copy!] - (let [copy (is (Array Nat) - (/.empty size))] - (exec (/.copy! amount 0 the_array 0 copy) - (# (list.equivalence n.equivalence) = - (list.first amount (/.list {.#None} the_array)) - (/.list {.#None} copy)))))) - (_.cover [/.clone] - (let [clone (/.clone the_array)] - (and (not (same? the_array clone)) - (# (/.equivalence n.equivalence) = the_array clone)))) - (let [the_array (/.clone the_array) - evens (|> the_array (/.list {.#None}) (list.only n.even?)) - odds (|> the_array (/.list {.#None}) (list.only n.odd?))] - (_.cover [/.only!] - (exec (/.only! n.even? the_array) - (and (n.= (list.size evens) (/.occupancy the_array)) - (n.= (list.size odds) (/.vacancy the_array)) - (|> the_array (/.list {.#None}) (# (list.equivalence n.equivalence) = evens)))))) + _ + false))) + (do ! + [occupancy (# ! each (n.% (++ size)) random.nat)] + (_.cover [/.occupancy /.vacancy] + (let [the_array (loop (again [output (is (Array Nat) + (/.empty size)) + idx 0]) + (if (n.< occupancy idx) + (again (/.has! idx expected output) + (++ idx)) + output))] + (and (n.= occupancy (/.occupancy the_array)) + (n.= size (n.+ (/.occupancy the_array) + (/.vacancy the_array))))))) + (do ! + [the_list (random.list size random.nat) + .let [the_array (/.clone the_array) + members (|> the_array (/.list {.#None}) (set.of_list n.hash))] + default (random.only (function (_ value) + (not (or (n.even? value) + (set.member? members value)))) + random.nat)] + (_.cover [/.of_list /.list] + (and (|> the_list /.of_list (/.list {.#None}) + (# (list.equivalence n.equivalence) = the_list)) + (|> the_array (/.list {.#None}) /.of_list + (# (/.equivalence n.equivalence) = the_array)) + (exec + (/.only! n.even? the_array) + (list.every? (function (_ value) + (or (n.even? value) + (same? default value))) + (/.list {.#Some default} the_array)))))) + (do ! + [amount (# ! each (n.% (++ size)) random.nat)] + (_.cover [/.copy!] + (let [copy (is (Array Nat) + (/.empty size))] + (exec (/.copy! amount 0 the_array 0 copy) + (# (list.equivalence n.equivalence) = + (list.first amount (/.list {.#None} the_array)) + (/.list {.#None} copy)))))) + (_.cover [/.clone] + (let [clone (/.clone the_array)] + (and (not (same? the_array clone)) + (# (/.equivalence n.equivalence) = the_array clone)))) + (let [the_array (/.clone the_array) + evens (|> the_array (/.list {.#None}) (list.only n.even?)) + odds (|> the_array (/.list {.#None}) (list.only n.odd?))] + (_.cover [/.only!] + (exec (/.only! n.even? the_array) + (and (n.= (list.size evens) (/.occupancy the_array)) + (n.= (list.size odds) (/.vacancy the_array)) + (|> the_array (/.list {.#None}) (# (list.equivalence n.equivalence) = evens)))))) - ..test|unsafe - )))) + ..test|unsafe + )))) diff --git a/stdlib/source/test/lux/data/collection/bits.lux b/stdlib/source/test/lux/data/collection/bits.lux index 9cc283a9a..8547bcf42 100644 --- a/stdlib/source/test/lux/data/collection/bits.lux +++ b/stdlib/source/test/lux/data/collection/bits.lux @@ -1,18 +1,18 @@ (.using - [library - [lux "*" - ["_" test {"+" Test}] - [abstract - [monad {"+" do}] - ["[0]" predicate] - [\\specification - ["$[0]" equivalence]]] - [math - ["[0]" random {"+" Random}] - [number - ["n" nat]]]]] - [\\library - ["[0]" / {"+" Bits}]]) + [library + [lux "*" + ["_" test {"+" Test}] + [abstract + [monad {"+" do}] + ["[0]" predicate] + [\\specification + ["$[0]" equivalence]]] + [math + ["[0]" random {"+" Random}] + [number + ["n" nat]]]]] + [\\library + ["[0]" / {"+" Bits}]]) (def: (size min max) (-> Nat Nat (Random Nat)) @@ -33,63 +33,63 @@ Test (<| (_.covering /._) (_.for [/.Bits]) - ($_ _.and - (_.for [/.equivalence] - ($equivalence.spec /.equivalence ..random)) + (all _.and + (_.for [/.equivalence] + ($equivalence.spec /.equivalence ..random)) - (do random.monad - [sample ..random] - (_.cover [/.empty? /.size] - (if (/.empty? sample) - (n.= 0 (/.size sample)) - (n.> 0 (/.size sample))))) - (_.cover [/.empty] - (/.empty? /.empty)) - - (do [! random.monad] - [size (# ! each (|>> (n.% 1,000) ++) random.nat) - idx (# ! each (n.% size) random.nat) - sample ..random] - ($_ _.and - (_.cover [/.bit /.one] - (and (|> /.empty (/.bit idx) not) - (|> /.empty (/.one idx) (/.bit idx)))) - (_.cover [/.zero] - (|> /.empty (/.one idx) (/.zero idx) (/.bit idx) not)) - (_.cover [/.flipped] - (and (|> /.empty (/.flipped idx) (/.bit idx)) - (|> /.empty (/.flipped idx) (/.flipped idx) (/.bit idx) not))) - (_.cover [/.Chunk /.capacity /.chunk_size] - (and (n.= 0 (/.capacity /.empty)) - (|> /.empty (/.one idx) /.capacity - (n.- idx) - (predicate.or (n.>= 0) - (n.< /.chunk_size))) - (let [grown (/.flipped idx /.empty)] - (and (n.> 0 (/.capacity grown)) - (same? /.empty (/.flipped idx grown)))))) - (_.cover [/.intersects?] - (and (not (/.intersects? /.empty - /.empty)) - (/.intersects? (/.one idx /.empty) - (/.one idx /.empty)) - (not (/.intersects? (/.one (++ idx) /.empty) - (/.one idx /.empty))) - (not (/.intersects? sample (/.not sample))))) - (_.cover [/.not] - (and (same? /.empty (/.not /.empty)) - (or (same? /.empty sample) - (and (not (# /.equivalence = sample (/.not sample))) - (# /.equivalence = sample (/.not (/.not sample))))))) - (_.cover [/.xor] - (and (same? /.empty (/.xor sample sample)) - (n.= (/.size (/.xor sample (/.not sample))) - (/.capacity sample)))) - (_.cover [/.or] - (and (# /.equivalence = sample (/.or sample sample)) - (n.= (/.size (/.or sample (/.not sample))) - (/.capacity sample)))) - (_.cover [/.and] - (and (# /.equivalence = sample (/.and sample sample)) - (same? /.empty (/.and sample (/.not sample))))) - ))))) + (do random.monad + [sample ..random] + (_.cover [/.empty? /.size] + (if (/.empty? sample) + (n.= 0 (/.size sample)) + (n.> 0 (/.size sample))))) + (_.cover [/.empty] + (/.empty? /.empty)) + + (do [! random.monad] + [size (# ! each (|>> (n.% 1,000) ++) random.nat) + idx (# ! each (n.% size) random.nat) + sample ..random] + (all _.and + (_.cover [/.bit /.one] + (and (|> /.empty (/.bit idx) not) + (|> /.empty (/.one idx) (/.bit idx)))) + (_.cover [/.zero] + (|> /.empty (/.one idx) (/.zero idx) (/.bit idx) not)) + (_.cover [/.flipped] + (and (|> /.empty (/.flipped idx) (/.bit idx)) + (|> /.empty (/.flipped idx) (/.flipped idx) (/.bit idx) not))) + (_.cover [/.Chunk /.capacity /.chunk_size] + (and (n.= 0 (/.capacity /.empty)) + (|> /.empty (/.one idx) /.capacity + (n.- idx) + (predicate.or (n.>= 0) + (n.< /.chunk_size))) + (let [grown (/.flipped idx /.empty)] + (and (n.> 0 (/.capacity grown)) + (same? /.empty (/.flipped idx grown)))))) + (_.cover [/.intersects?] + (and (not (/.intersects? /.empty + /.empty)) + (/.intersects? (/.one idx /.empty) + (/.one idx /.empty)) + (not (/.intersects? (/.one (++ idx) /.empty) + (/.one idx /.empty))) + (not (/.intersects? sample (/.not sample))))) + (_.cover [/.not] + (and (same? /.empty (/.not /.empty)) + (or (same? /.empty sample) + (and (not (# /.equivalence = sample (/.not sample))) + (# /.equivalence = sample (/.not (/.not sample))))))) + (_.cover [/.xor] + (and (same? /.empty (/.xor sample sample)) + (n.= (/.size (/.xor sample (/.not sample))) + (/.capacity sample)))) + (_.cover [/.or] + (and (# /.equivalence = sample (/.or sample sample)) + (n.= (/.size (/.or sample (/.not sample))) + (/.capacity sample)))) + (_.cover [/.and] + (and (# /.equivalence = sample (/.and sample sample)) + (same? /.empty (/.and sample (/.not sample))))) + ))))) diff --git a/stdlib/source/test/lux/data/collection/dictionary.lux b/stdlib/source/test/lux/data/collection/dictionary.lux index 2f9465e94..9c1121143 100644 --- a/stdlib/source/test/lux/data/collection/dictionary.lux +++ b/stdlib/source/test/lux/data/collection/dictionary.lux @@ -38,97 +38,97 @@ random.nat) test_val (random.only (|>> (list.member? n.equivalence (/.values dict)) not) random.nat)] - ($_ _.and - (_.cover [/.size] - (n.= size (/.size dict))) - - (_.cover [/.empty?] - (case size - 0 (/.empty? dict) - _ (not (/.empty? dict)))) - - (_.cover [/.empty] - (let [sample (/.empty n.hash)] - (and (n.= 0 (/.size sample)) - (/.empty? sample)))) + (all _.and + (_.cover [/.size] + (n.= size (/.size dict))) + + (_.cover [/.empty?] + (case size + 0 (/.empty? dict) + _ (not (/.empty? dict)))) + + (_.cover [/.empty] + (let [sample (/.empty n.hash)] + (and (n.= 0 (/.size sample)) + (/.empty? sample)))) - (do ! - [constant random.nat - .let [hash (is (Hash Nat) - (implementation - (def: equivalence n.equivalence) - (def: (hash _) - constant)))]] - (_.cover [/.key_hash] - (same? hash (/.key_hash (/.empty hash))))) - - (_.cover [/.entries] - (let [entries (/.entries dict) + (do ! + [constant random.nat + .let [hash (is (Hash Nat) + (implementation + (def: equivalence n.equivalence) + (def: (hash _) + constant)))]] + (_.cover [/.key_hash] + (same? hash (/.key_hash (/.empty hash))))) + + (_.cover [/.entries] + (let [entries (/.entries dict) - correct_size! - (n.= (/.size dict) - (list.size entries)) + correct_size! + (n.= (/.size dict) + (list.size entries)) - unique_keys! - (|> entries - (list#each product.left) - (set.of_list n.hash) - set.size - (n.= (/.size dict))) - - correct_pairing! - (list.every? (function (_ [key value]) - (|> dict - (/.value key) - (maybe#each (n.= value)) - (maybe.else false))) - entries)] - (and correct_size! unique_keys! - correct_pairing!))) - (_.cover [/.keys] - (let [keys (/.keys dict) + (|> entries + (list#each product.left) + (set.of_list n.hash) + set.size + (n.= (/.size dict))) - correct_size! - (n.= (/.size dict) - (list.size keys)) + correct_pairing! + (list.every? (function (_ [key value]) + (|> dict + (/.value key) + (maybe#each (n.= value)) + (maybe.else false))) + entries)] + (and correct_size! + unique_keys! + correct_pairing!))) + (_.cover [/.keys] + (let [keys (/.keys dict) - unique_keys! - (|> keys - (set.of_list n.hash) - set.size - (n.= (/.size dict))) + correct_size! + (n.= (/.size dict) + (list.size keys)) - recognized! - (list.every? (/.key? dict) keys)] - (and correct_size! unique_keys! - recognized!))) - (_.cover [/.values] - (n.= (/.size dict) - (list.size (/.values dict)))) + (|> keys + (set.of_list n.hash) + set.size + (n.= (/.size dict))) + + recognized! + (list.every? (/.key? dict) keys)] + (and correct_size! + unique_keys! + recognized!))) + (_.cover [/.values] + (n.= (/.size dict) + (list.size (/.values dict)))) - (_.cover [/.composite] - (let [merging_with_oneself (let [(open "[0]") (/.equivalence n.equivalence)] - (= dict (/.composite dict dict))) - overwritting_keys (let [dict' (|> dict /.entries - (list#each (function (_ [k v]) [k (++ v)])) - (/.of_list n.hash)) - (open "[0]") (/.equivalence n.equivalence)] - (= dict' (/.composite dict' dict)))] - (and merging_with_oneself - overwritting_keys))) - - (_.cover [/.composite_with] - (list.every? (function (_ [x x*2]) (n.= (n.* 2 x) x*2)) - (list.zipped_2 (/.values dict) - (/.values (/.composite_with n.+ dict dict))))) + (_.cover [/.composite] + (let [merging_with_oneself (let [(open "[0]") (/.equivalence n.equivalence)] + (= dict (/.composite dict dict))) + overwritting_keys (let [dict' (|> dict /.entries + (list#each (function (_ [k v]) [k (++ v)])) + (/.of_list n.hash)) + (open "[0]") (/.equivalence n.equivalence)] + (= dict' (/.composite dict' dict)))] + (and merging_with_oneself + overwritting_keys))) + + (_.cover [/.composite_with] + (list.every? (function (_ [x x*2]) (n.= (n.* 2 x) x*2)) + (list.zipped_2 (/.values dict) + (/.values (/.composite_with n.+ dict dict))))) - (_.cover [/.of_list] - (let [(open "[0]") (/.equivalence n.equivalence)] - (and (= dict dict) - (|> dict /.entries (/.of_list n.hash) (= dict))))) - ))) + (_.cover [/.of_list] + (let [(open "[0]") (/.equivalence n.equivalence)] + (and (= dict dict) + (|> dict /.entries (/.of_list n.hash) (= dict))))) + ))) (def: for_entries Test @@ -140,113 +140,113 @@ random.nat) test_val (random.only (|>> (list.member? n.equivalence (/.values dict)) not) random.nat)] - ($_ _.and - (_.cover [/.key?] - (list.every? (/.key? dict) - (/.keys dict))) - - (_.cover [/.value] - (and (list.every? (function (_ key) (case (/.value key dict) - {.#Some _} true - _ false)) - (/.keys dict)) - (case (/.value non_key dict) - {.#Some _} false - _ true))) - - (_.cover [/.has] - (and (n.= (++ (/.size dict)) - (/.size (/.has non_key test_val dict))) - (case (/.value non_key (/.has non_key test_val dict)) - {.#Some v} (n.= test_val v) - _ true))) - - (_.cover [/.has' /.key_already_exists] - (let [can_put_new_keys! - (case (/.has' non_key test_val dict) - {try.#Success dict} - (case (/.value non_key dict) - {.#Some v} (n.= test_val v) - _ true) + (all _.and + (_.cover [/.key?] + (list.every? (/.key? dict) + (/.keys dict))) + + (_.cover [/.value] + (and (list.every? (function (_ key) (case (/.value key dict) + {.#Some _} true + _ false)) + (/.keys dict)) + (case (/.value non_key dict) + {.#Some _} false + _ true))) + + (_.cover [/.has] + (and (n.= (++ (/.size dict)) + (/.size (/.has non_key test_val dict))) + (case (/.value non_key (/.has non_key test_val dict)) + {.#Some v} (n.= test_val v) + _ true))) + + (_.cover [/.has' /.key_already_exists] + (let [can_put_new_keys! + (case (/.has' non_key test_val dict) + {try.#Success dict} + (case (/.value non_key dict) + {.#Some v} (n.= test_val v) + _ true) - {try.#Failure _} - false) - - cannot_put_old_keys! - (or (n.= 0 size) - (let [first_key (|> dict /.keys list.head maybe.trusted)] - (case (/.has' 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!))) - - (_.cover [/.lacks] - (and (let [base (/.has non_key test_val dict)] - (and (/.key? base non_key) - (not (/.key? (/.lacks non_key base) non_key)))) - (case (list.head (/.keys dict)) - {.#None} - true + {try.#Failure _} + false) - {.#Some known_key} - (n.= (-- (/.size dict)) - (/.size (/.lacks known_key dict)))))) - - (_.cover [/.revised] - (let [base (/.has non_key test_val dict) - updt (/.revised non_key ++ base)] - (case [(/.value non_key base) (/.value non_key updt)] - [{.#Some x} {.#Some y}] - (n.= (++ x) y) - - _ - false))) - - (_.cover [/.revised'] - (let [can_upsert_new_key! - (case (/.value non_key (/.revised' non_key test_val ++ dict)) - {.#Some inserted} - (n.= (++ test_val) inserted) - - {.#None} - false) - - can_upsert_old_key! - (case (list.head (/.entries dict)) + cannot_put_old_keys! + (or (n.= 0 size) + (let [first_key (|> dict /.keys list.head maybe.trusted)] + (case (/.has' 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!))) + + (_.cover [/.lacks] + (and (let [base (/.has non_key test_val dict)] + (and (/.key? base non_key) + (not (/.key? (/.lacks non_key base) non_key)))) + (case (list.head (/.keys dict)) {.#None} true - {.#Some [known_key known_value]} - (case (/.value known_key (/.revised' known_key test_val ++ dict)) - {.#Some updated} - (n.= (++ known_value) updated) + {.#Some known_key} + (n.= (-- (/.size dict)) + (/.size (/.lacks known_key dict)))))) + + (_.cover [/.revised] + (let [base (/.has non_key test_val dict) + updt (/.revised non_key ++ base)] + (case [(/.value non_key base) (/.value non_key updt)] + [{.#Some x} {.#Some y}] + (n.= (++ x) y) + + _ + false))) + + (_.cover [/.revised'] + (let [can_upsert_new_key! + (case (/.value non_key (/.revised' non_key test_val ++ dict)) + {.#Some inserted} + (n.= (++ test_val) inserted) + + {.#None} + false) + + can_upsert_old_key! + (case (list.head (/.entries dict)) + {.#None} + true + + {.#Some [known_key known_value]} + (case (/.value known_key (/.revised' known_key test_val ++ dict)) + {.#Some updated} + (n.= (++ known_value) updated) - {.#None} - false))] - (and can_upsert_new_key! - can_upsert_old_key!))) + {.#None} + false))] + (and can_upsert_new_key! + can_upsert_old_key!))) - (_.cover [/.sub] - (|> dict - (/.has non_key test_val) - (/.sub (list non_key)) - /.size - (n.= 1))) - - (_.cover [/.re_bound] - (or (n.= 0 size) - (let [first_key (|> dict /.keys list.head maybe.trusted) - rebound (/.re_bound first_key non_key dict)] - (and (n.= (/.size dict) (/.size rebound)) - (/.key? rebound non_key) - (not (/.key? rebound first_key)) - (n.= (maybe.trusted (/.value first_key dict)) - (maybe.trusted (/.value non_key rebound))))))) - ))) + (_.cover [/.sub] + (|> dict + (/.has non_key test_val) + (/.sub (list non_key)) + /.size + (n.= 1))) + + (_.cover [/.re_bound] + (or (n.= 0 size) + (let [first_key (|> dict /.keys list.head maybe.trusted) + rebound (/.re_bound first_key non_key dict)] + (and (n.= (/.size dict) (/.size rebound)) + (/.key? rebound non_key) + (not (/.key? rebound first_key)) + (n.= (maybe.trusted (/.value first_key dict)) + (maybe.trusted (/.value non_key rebound))))))) + ))) (def: .public test Test @@ -260,14 +260,14 @@ random.nat) test_val (random.only (|>> (list.member? n.equivalence (/.values dict)) not) random.nat)] - ($_ _.and - (_.for [/.equivalence] - ($equivalence.spec (/.equivalence n.equivalence) - (random.dictionary n.hash size random.nat random.nat))) - - (_.for [/.functor] - ($functor.spec ..injection /.equivalence /.functor)) + (all _.and + (_.for [/.equivalence] + ($equivalence.spec (/.equivalence n.equivalence) + (random.dictionary n.hash size random.nat random.nat))) + + (_.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 471565d52..6dd9ce772 100644 --- a/stdlib/source/test/lux/data/collection/dictionary/ordered.lux +++ b/stdlib/source/test/lux/data/collection/dictionary/ordered.lux @@ -62,76 +62,76 @@ (and (n.= kr ks) (n.= vr vs))))) (open "/#[0]") (/.equivalence n.equivalence)]] - ($_ _.and - (_.for [/.equivalence] - ($equivalence.spec (/.equivalence n.equivalence) (..dictionary n.order random.nat random.nat size))) - - (_.cover [/.size] - (n.= size (/.size sample))) - (_.cover [/.empty?] - (bit#= (n.= 0 (/.size sample)) - (/.empty? sample))) - (_.cover [/.empty] - (/.empty? (/.empty n.order))) - (_.cover [/.min] - (case [(/.min sample) (list.head sorted_values)] - [{.#None} {.#None}] - #1 + (all _.and + (_.for [/.equivalence] + ($equivalence.spec (/.equivalence n.equivalence) (..dictionary n.order random.nat random.nat size))) + + (_.cover [/.size] + (n.= size (/.size sample))) + (_.cover [/.empty?] + (bit#= (n.= 0 (/.size sample)) + (/.empty? sample))) + (_.cover [/.empty] + (/.empty? (/.empty n.order))) + (_.cover [/.min] + (case [(/.min sample) (list.head sorted_values)] + [{.#None} {.#None}] + #1 - [{.#Some reference} {.#Some sample}] - (n.= reference sample) + [{.#Some reference} {.#Some sample}] + (n.= reference sample) - _ - #0)) - (_.cover [/.max] - (case [(/.max sample) (list.last sorted_values)] - [{.#None} {.#None}] - #1 + _ + #0)) + (_.cover [/.max] + (case [(/.max sample) (list.last sorted_values)] + [{.#None} {.#None}] + #1 - [{.#Some reference} {.#Some sample}] - (n.= reference sample) + [{.#Some reference} {.#Some sample}] + (n.= reference sample) - _ - #0)) - (_.cover [/.entries] - (list#= (/.entries sample) - sorted_pairs)) - (_.cover [/.keys /.values] - (list#= (/.entries sample) - (list.zipped_2 (/.keys sample) (/.values sample)))) - (_.cover [/.of_list] - (|> sample - /.entries (/.of_list n.order) - (/#= sample))) - (_.cover [/.key?] - (and (list.every? (/.key? sample) - (/.keys sample)) - (not (/.key? sample extra_key)))) - (_.cover [/.has] - (and (not (/.key? sample extra_key)) - (let [sample+ (/.has extra_key extra_value sample)] - (and (/.key? sample+ extra_key) - (n.= (++ (/.size sample)) - (/.size sample+)))))) - (_.cover [/.value] - (let [sample+ (/.has extra_key extra_value sample)] - (case [(/.value extra_key sample) - (/.value extra_key sample+)] - [{.#None} {.#Some actual}] - (n.= extra_value actual) - - _ - false))) - (_.cover [/.lacks] - (|> sample - (/.has extra_key extra_value) - (/.lacks extra_key) - (/#= sample))) - (_.cover [/.revised] - (|> sample - (/.has extra_key extra_value) - (/.revised extra_key (n.+ shift)) - (/.value extra_key) - (maybe#each (n.= (n.+ shift extra_value))) - (maybe.else false))) - )))) + _ + #0)) + (_.cover [/.entries] + (list#= (/.entries sample) + sorted_pairs)) + (_.cover [/.keys /.values] + (list#= (/.entries sample) + (list.zipped_2 (/.keys sample) (/.values sample)))) + (_.cover [/.of_list] + (|> sample + /.entries (/.of_list n.order) + (/#= sample))) + (_.cover [/.key?] + (and (list.every? (/.key? sample) + (/.keys sample)) + (not (/.key? sample extra_key)))) + (_.cover [/.has] + (and (not (/.key? sample extra_key)) + (let [sample+ (/.has extra_key extra_value sample)] + (and (/.key? sample+ extra_key) + (n.= (++ (/.size sample)) + (/.size sample+)))))) + (_.cover [/.value] + (let [sample+ (/.has extra_key extra_value sample)] + (case [(/.value extra_key sample) + (/.value extra_key sample+)] + [{.#None} {.#Some actual}] + (n.= extra_value actual) + + _ + false))) + (_.cover [/.lacks] + (|> sample + (/.has extra_key extra_value) + (/.lacks extra_key) + (/#= sample))) + (_.cover [/.revised] + (|> sample + (/.has extra_key extra_value) + (/.revised extra_key (n.+ shift)) + (/.value extra_key) + (maybe#each (n.= (n.+ shift extra_value))) + (maybe.else false))) + )))) diff --git a/stdlib/source/test/lux/data/collection/dictionary/plist.lux b/stdlib/source/test/lux/data/collection/dictionary/plist.lux index fa4e221cd..2e5fb1810 100644 --- a/stdlib/source/test/lux/data/collection/dictionary/plist.lux +++ b/stdlib/source/test/lux/data/collection/dictionary/plist.lux @@ -44,54 +44,54 @@ gen_key) extra_value random.nat shift random.nat] - ($_ _.and - (_.for [/.equivalence] - ($equivalence.spec (/.equivalence n.equivalence) - (..random size gen_key random.nat))) - (_.for [/.monoid] - ($monoid.spec (/.equivalence n.equivalence) - /.monoid - (..random 10 (random.ascii/lower 1) random.nat))) - - (_.cover [/.size] - (n.= size (/.size sample))) - (_.cover [/.empty?] - (bit#= (n.= 0 (/.size sample)) - (/.empty? sample))) - (_.cover [/.empty] - (/.empty? /.empty)) - (_.cover [/.keys /.values] - (# (/.equivalence n.equivalence) = - sample - (list.zipped_2 (/.keys sample) - (/.values sample)))) - (_.cover [/.contains?] - (and (list.every? (function (_ key) - (/.contains? key sample)) - (/.keys sample)) - (not (/.contains? extra_key sample)))) - (_.cover [/.has] - (let [sample+ (/.has extra_key extra_value sample)] - (and (not (/.contains? extra_key sample)) - (/.contains? extra_key sample+) - (n.= (++ (/.size sample)) - (/.size sample+))))) - (_.cover [/.value] - (|> sample - (/.has extra_key extra_value) - (/.value extra_key) - (maybe#each (n.= extra_value)) - (maybe.else false))) - (_.cover [/.revised] - (|> sample - (/.has extra_key extra_value) - (/.revised extra_key (n.+ shift)) - (/.value extra_key) - (maybe#each (n.= (n.+ shift extra_value))) - (maybe.else false))) - (_.cover [/.lacks] - (|> sample - (/.has extra_key extra_value) - (/.lacks extra_key) - (# (/.equivalence n.equivalence) = sample))) - )))) + (all _.and + (_.for [/.equivalence] + ($equivalence.spec (/.equivalence n.equivalence) + (..random size gen_key random.nat))) + (_.for [/.monoid] + ($monoid.spec (/.equivalence n.equivalence) + /.monoid + (..random 10 (random.ascii/lower 1) random.nat))) + + (_.cover [/.size] + (n.= size (/.size sample))) + (_.cover [/.empty?] + (bit#= (n.= 0 (/.size sample)) + (/.empty? sample))) + (_.cover [/.empty] + (/.empty? /.empty)) + (_.cover [/.keys /.values] + (# (/.equivalence n.equivalence) = + sample + (list.zipped_2 (/.keys sample) + (/.values sample)))) + (_.cover [/.contains?] + (and (list.every? (function (_ key) + (/.contains? key sample)) + (/.keys sample)) + (not (/.contains? extra_key sample)))) + (_.cover [/.has] + (let [sample+ (/.has extra_key extra_value sample)] + (and (not (/.contains? extra_key sample)) + (/.contains? extra_key sample+) + (n.= (++ (/.size sample)) + (/.size sample+))))) + (_.cover [/.value] + (|> sample + (/.has extra_key extra_value) + (/.value extra_key) + (maybe#each (n.= extra_value)) + (maybe.else false))) + (_.cover [/.revised] + (|> sample + (/.has extra_key extra_value) + (/.revised extra_key (n.+ shift)) + (/.value extra_key) + (maybe#each (n.= (n.+ shift extra_value))) + (maybe.else false))) + (_.cover [/.lacks] + (|> sample + (/.has extra_key extra_value) + (/.lacks 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 5fe98b03c..379c31458 100644 --- a/stdlib/source/test/lux/data/collection/list.lux +++ b/stdlib/source/test/lux/data/collection/list.lux @@ -47,42 +47,42 @@ (def: signatures Test - ($_ _.and - (_.for [/.equivalence] - ($equivalence.spec (/.equivalence n.equivalence) ..random)) - (_.for [/.hash] - (|> random.nat - (# random.monad each (|>> list)) - ($hash.spec (/.hash n.hash)))) - (_.for [/.monoid] - ($monoid.spec (/.equivalence n.equivalence) /.monoid ..random)) - (_.for [/.mix] - ($mix.spec /#in /.equivalence /.mix)) - (_.for [/.functor] - ($functor.spec /#in /.equivalence /.functor)) - (_.for [/.apply] - ($apply.spec /#in /.equivalence /.apply)) - (_.for [/.monad] - ($monad.spec /#in /.equivalence /.monad)) + (all _.and + (_.for [/.equivalence] + ($equivalence.spec (/.equivalence n.equivalence) ..random)) + (_.for [/.hash] + (|> random.nat + (# random.monad each (|>> list)) + ($hash.spec (/.hash n.hash)))) + (_.for [/.monoid] + ($monoid.spec (/.equivalence n.equivalence) /.monoid ..random)) + (_.for [/.mix] + ($mix.spec /#in /.equivalence /.mix)) + (_.for [/.functor] + ($functor.spec /#in /.equivalence /.functor)) + (_.for [/.apply] + ($apply.spec /#in /.equivalence /.apply)) + (_.for [/.monad] + ($monad.spec /#in /.equivalence /.monad)) - (do [! random.monad] - [parameter random.nat - subject random.nat] - (let [lifted (/.lifted io.monad) - (open "io#[0]") io.monad - expected (n.+ parameter subject)] - (_.cover [/.with /.lifted] - (|> (io.run! (do (/.with io.monad) - [a (lifted (io#in parameter)) - b (in subject)] - (in (n.+ a b)))) - (pipe.case - (pattern (list actual)) - (n.= expected actual) - - _ - false))))) - )) + (do [! random.monad] + [parameter random.nat + subject random.nat] + (let [lifted (/.lifted io.monad) + (open "io#[0]") io.monad + expected (n.+ parameter subject)] + (_.cover [/.with /.lifted] + (|> (io.run! (do (/.with io.monad) + [a (lifted (io#in parameter)) + b (in subject)] + (in (n.+ a b)))) + (pipe.case + (pattern (list actual)) + (n.= expected actual) + + _ + false))))) + )) (def: whole Test @@ -90,43 +90,43 @@ [size ..bounded_size .let [(open "/#[0]") (/.equivalence n.equivalence)] sample (# ! each set.list (random.set n.hash size random.nat))] - ($_ _.and - (_.cover [/.size] - (n.= size (/.size sample))) - (_.cover [/.empty?] - (# bit.equivalence = - (/.empty? sample) - (n.= 0 (/.size sample)))) - (_.cover [/.repeated] - (n.= size (/.size (/.repeated size [])))) - (_.cover [/.reversed] - (or (n.< 2 (/.size sample)) - (let [not_same! - (not (/#= sample - (/.reversed sample))) + (all _.and + (_.cover [/.size] + (n.= size (/.size sample))) + (_.cover [/.empty?] + (# bit.equivalence = + (/.empty? sample) + (n.= 0 (/.size sample)))) + (_.cover [/.repeated] + (n.= size (/.size (/.repeated size [])))) + (_.cover [/.reversed] + (or (n.< 2 (/.size sample)) + (let [not_same! + (not (/#= sample + (/.reversed sample))) - self_symmetry! - (/#= sample - (/.reversed (/.reversed sample)))] - (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))) - (_.cover [/.sorted] - (let [<<< n.< - - size_preservation! - (n.= (/.size sample) - (/.size (/.sorted <<< sample))) - - symmetry! - (/#= (/.sorted <<< sample) - (/.reversed (/.sorted (function.flipped <<<) sample)))] - (and size_preservation! - symmetry!))) - ))) + self_symmetry! + (/#= sample + (/.reversed (/.reversed sample)))] + (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))) + (_.cover [/.sorted] + (let [<<< n.< + + size_preservation! + (n.= (/.size sample) + (/.size (/.sorted <<< sample))) + + symmetry! + (/#= (/.sorted <<< sample) + (/.reversed (/.sorted (function.flipped <<<) sample)))] + (and size_preservation! + symmetry!))) + ))) (def: indices Test @@ -135,58 +135,58 @@ (do [! random.monad] [sample ..random .let [size (/.size sample)]] - ($_ _.and - (_.cover [/.indices] - (let [indices (/.indices size) - - expected_amount! - (n.= size (/.size indices)) + (all _.and + (_.cover [/.indices] + (let [indices (/.indices size) - already_sorted! - (/#= indices - (/.sorted n.< indices)) + expected_amount! + (n.= size (/.size indices)) - expected_numbers! - (/.every? (n.= (-- size)) - (/.zipped_with_2 n.+ - indices - (/.sorted n.> indices)))] - (and expected_amount! already_sorted! - expected_numbers!))) - (_.cover [/.enumeration] - (let [enumeration (/.enumeration sample) + (/#= indices + (/.sorted n.< indices)) + + expected_numbers! + (/.every? (n.= (-- size)) + (/.zipped_with_2 n.+ + indices + (/.sorted n.> indices)))] + (and expected_amount! + already_sorted! + expected_numbers!))) + (_.cover [/.enumeration] + (let [enumeration (/.enumeration sample) - has_correct_indices! - (/#= (/.indices (/.size enumeration)) - (/#each product.left enumeration)) + has_correct_indices! + (/#= (/.indices (/.size enumeration)) + (/#each product.left enumeration)) - has_correct_values! - (/#= sample - (/#each product.right enumeration))] - (and has_correct_indices! - has_correct_values!))) - (_.cover [/.item] - (/.every? (function (_ [index expected]) - (case (/.item index sample) - {.#Some actual} - (n.= expected actual) - - {.#None} - false)) - (/.enumeration sample))) - (do ! - [index (case size - 0 random.nat - _ (# ! each (n.% size) random.nat)) - .let [changed? (/#= sample (/.revised index ++ sample)) - same? (/#= sample (/.revised size ++ sample))]] - (_.cover [/.revised] - (case size - 0 (and changed? - same?) - _ (not changed?)))) - )))) + has_correct_values! + (/#= sample + (/#each product.right enumeration))] + (and has_correct_indices! + has_correct_values!))) + (_.cover [/.item] + (/.every? (function (_ [index expected]) + (case (/.item index sample) + {.#Some actual} + (n.= expected actual) + + {.#None} + false)) + (/.enumeration sample))) + (do ! + [index (case size + 0 random.nat + _ (# ! each (n.% size) random.nat)) + .let [changed? (/#= sample (/.revised index ++ sample)) + same? (/#= sample (/.revised size ++ sample))]] + (_.cover [/.revised] + (case size + 0 (and changed? + same?) + _ (not changed?)))) + )))) (def: slice Test @@ -198,82 +198,82 @@ .let [size (/.size sample)] idx (# ! each (n.% size) random.nat) sub_size (# ! each (|>> (n.% size) ++) random.nat)] - ($_ _.and - (_.cover [/.only] - (let [positives (/.only n.even? sample) - negatives (/.only (bit.complement n.even?) sample)] - (and (/.every? n.even? positives) - (not (/.any? n.even? negatives)) + (all _.and + (_.cover [/.only] + (let [positives (/.only n.even? sample) + negatives (/.only (bit.complement n.even?) sample)] + (and (/.every? n.even? positives) + (not (/.any? n.even? negatives)) - (n.= (/.size sample) - (n.+ (/.size positives) - (/.size negatives)))))) - (_.cover [/.partition] - (let [[positives negatives] (/.partition n.even? sample)] - (and (/#= (/.only n.even? sample) - positives) - (/#= (/.only (bit.complement n.even?) sample) - negatives)))) - (_.cover [/.split_at] - (let [[left right] (/.split_at idx sample)] - (/#= sample - (/#composite left right)))) - (_.cover [/.split_when] - (let [[left right] (/.split_when n.even? sample)] - (/#= sample - (/#composite left right)))) - (_.cover [/.first /.after] - (/#= sample - (/#composite (/.first idx sample) - (/.after idx sample)))) - (_.cover [/.while /.until] - (/#= sample - (/#composite (/.while n.even? sample) - (/.until n.even? sample)))) - (_.cover [/.sub] - (let [subs (/.sub sub_size sample)] - (and (/.every? (|>> /.size (n.<= sub_size)) subs) - (/#= sample - (/.together subs))))) - )))) + (n.= (/.size sample) + (n.+ (/.size positives) + (/.size negatives)))))) + (_.cover [/.partition] + (let [[positives negatives] (/.partition n.even? sample)] + (and (/#= (/.only n.even? sample) + positives) + (/#= (/.only (bit.complement n.even?) sample) + negatives)))) + (_.cover [/.split_at] + (let [[left right] (/.split_at idx sample)] + (/#= sample + (/#composite left right)))) + (_.cover [/.split_when] + (let [[left right] (/.split_when n.even? sample)] + (/#= sample + (/#composite left right)))) + (_.cover [/.first /.after] + (/#= sample + (/#composite (/.first idx sample) + (/.after idx sample)))) + (_.cover [/.while /.until] + (/#= sample + (/#composite (/.while n.even? sample) + (/.until n.even? sample)))) + (_.cover [/.sub] + (let [subs (/.sub sub_size sample)] + (and (/.every? (|>> /.size (n.<= sub_size)) subs) + (/#= sample + (/.together subs))))) + )))) (def: member Test (let [(open "/#[0]") (/.equivalence n.equivalence)] (do [! random.monad] [sample ..random] - (`` ($_ _.and - (_.cover [/.member?] - (/.every? (/.member? n.equivalence sample) - sample)) - (~~ (template [<head> <tail> <pre>] - [($_ _.and - (_.cover [<head>] - (case [(<pre> sample) (<head> sample)] - [{.#Item expected _} {.#Some actual}] - (n.= expected actual) + (`` (all _.and + (_.cover [/.member?] + (/.every? (/.member? n.equivalence sample) + sample)) + (~~ (template [<head> <tail> <pre>] + [(all _.and + (_.cover [<head>] + (case [(<pre> sample) (<head> sample)] + [{.#Item expected _} {.#Some actual}] + (n.= expected actual) - [{.#End} {.#None}] - true + [{.#End} {.#None}] + true - _ - false)) - (_.cover [<tail>] - (case [(<pre> sample) (<tail> sample)] - [{.#Item _ expected} {.#Some actual}] - (/#= (<pre> expected) actual) + _ + false)) + (_.cover [<tail>] + (case [(<pre> sample) (<tail> sample)] + [{.#Item _ expected} {.#Some actual}] + (/#= (<pre> expected) actual) - [{.#End} {.#None}] - true + [{.#End} {.#None}] + true - _ - false)) - )] + _ + false)) + )] - [/.head /.tail |>] - [/.last /.inits /.reversed] - )) - ))))) + [/.head /.tail |>] + [/.last /.inits /.reversed] + )) + ))))) (def: grouping Test @@ -283,92 +283,92 @@ +/2 (is (-> Nat Nat Nat) (function (_ left right) - ($_ n.+ left right))) + (all n.+ left right))) +/3 (is (-> Nat Nat Nat Nat) (function (_ left mid right) - ($_ n.+ left mid right)))] + (all n.+ left mid right)))] (do [! random.monad] [sample/0 ..random sample/1 ..random sample/2 ..random] - ($_ _.and - (_.cover [/.pairs] - (let [even_sized? (|> sample/0 - /.size - (n.% 2) - (n.= 0))] - (case (/.pairs sample/0) - {.#Some pairs/0} - (and even_sized? - (n.= (n./ 2 (/.size sample/0)) - (/.size pairs/0))) + (all _.and + (_.cover [/.pairs] + (let [even_sized? (|> sample/0 + /.size + (n.% 2) + (n.= 0))] + (case (/.pairs sample/0) + {.#Some pairs/0} + (and even_sized? + (n.= (n./ 2 (/.size sample/0)) + (/.size pairs/0))) - {.#None} - (not even_sized?)))) - (_.cover [/.zipped_2] - (let [zipped (/.zipped_2 sample/0 sample/1) - zipped::size (/.size zipped) + {.#None} + (not even_sized?)))) + (_.cover [/.zipped_2] + (let [zipped (/.zipped_2 sample/0 sample/1) + zipped::size (/.size zipped) - size_of_smaller_list! - (n.= zipped::size - (n.min (/.size sample/0) (/.size sample/1))) + size_of_smaller_list! + (n.= zipped::size + (n.min (/.size sample/0) (/.size sample/1))) - can_extract_values! - (and (/#= (/.first zipped::size sample/0) - (/#each product.left zipped)) - (/#= (/.first zipped::size sample/1) - (/#each product.right zipped)))] - (and size_of_smaller_list! - can_extract_values!))) - (_.cover [/.zipped_3] - (let [zipped (/.zipped_3 sample/0 sample/1 sample/2) - zipped::size (/.size zipped) - - size_of_smaller_list! - (n.= zipped::size - ($_ n.min - (/.size sample/0) - (/.size sample/1) - (/.size sample/2))) + can_extract_values! + (and (/#= (/.first zipped::size sample/0) + (/#each product.left zipped)) + (/#= (/.first zipped::size sample/1) + (/#each product.right zipped)))] + (and size_of_smaller_list! + can_extract_values!))) + (_.cover [/.zipped_3] + (let [zipped (/.zipped_3 sample/0 sample/1 sample/2) + zipped::size (/.size zipped) + + size_of_smaller_list! + (n.= zipped::size + (all n.min + (/.size sample/0) + (/.size sample/1) + (/.size sample/2))) - can_extract_values! - (and (/#= (/.first zipped::size sample/0) - (/#each product.left zipped)) - (/#= (/.first zipped::size sample/1) - (/#each (|>> product.right product.left) zipped)) - (/#= (/.first zipped::size sample/2) - (/#each (|>> product.right product.right) zipped)))] - (and size_of_smaller_list! - can_extract_values!))) - (_.cover [/.zipped] - (and (# (/.equivalence (product.equivalence n.equivalence n.equivalence)) = - (/.zipped_2 sample/0 sample/1) - ((/.zipped 2) sample/0 sample/1)) - (# (/.equivalence ($_ product.equivalence n.equivalence n.equivalence n.equivalence)) = - (/.zipped_3 sample/0 sample/1 sample/2) - ((/.zipped 3) sample/0 sample/1 sample/2)))) + can_extract_values! + (and (/#= (/.first zipped::size sample/0) + (/#each product.left zipped)) + (/#= (/.first zipped::size sample/1) + (/#each (|>> product.right product.left) zipped)) + (/#= (/.first zipped::size sample/2) + (/#each (|>> product.right product.right) zipped)))] + (and size_of_smaller_list! + can_extract_values!))) + (_.cover [/.zipped] + (and (# (/.equivalence (product.equivalence n.equivalence n.equivalence)) = + (/.zipped_2 sample/0 sample/1) + ((/.zipped 2) sample/0 sample/1)) + (# (/.equivalence (all product.equivalence n.equivalence n.equivalence n.equivalence)) = + (/.zipped_3 sample/0 sample/1 sample/2) + ((/.zipped 3) sample/0 sample/1 sample/2)))) - (_.cover [/.zipped_with_2] - (/#= (/#each (function (_ [left right]) - (+/2 left right)) - (/.zipped_2 sample/0 sample/1)) - (/.zipped_with_2 +/2 sample/0 sample/1))) - (_.cover [/.zipped_with_3] - (/#= (/#each (function (_ [left mid right]) - (+/3 left mid right)) - (/.zipped_3 sample/0 sample/1 sample/2)) - (/.zipped_with_3 +/3 sample/0 sample/1 sample/2))) - (_.cover [/.zipped_with] - (and (/#= (/.zipped_with_2 +/2 sample/0 sample/1) - ((/.zipped_with 2) +/2 sample/0 sample/1)) - (/#= (/.zipped_with_3 +/3 sample/0 sample/1 sample/2) - ((/.zipped_with 3) +/3 sample/0 sample/1 sample/2)))) - (_.cover [/.together] - (and (/#= (/#composite sample/0 sample/1) - (/.together (list sample/0 sample/1))) - (/#= ($_ /#composite sample/0 sample/1 sample/2) - (/.together (list sample/0 sample/1 sample/2))))) - )))) + (_.cover [/.zipped_with_2] + (/#= (/#each (function (_ [left right]) + (+/2 left right)) + (/.zipped_2 sample/0 sample/1)) + (/.zipped_with_2 +/2 sample/0 sample/1))) + (_.cover [/.zipped_with_3] + (/#= (/#each (function (_ [left mid right]) + (+/3 left mid right)) + (/.zipped_3 sample/0 sample/1 sample/2)) + (/.zipped_with_3 +/3 sample/0 sample/1 sample/2))) + (_.cover [/.zipped_with] + (and (/#= (/.zipped_with_2 +/2 sample/0 sample/1) + ((/.zipped_with 2) +/2 sample/0 sample/1)) + (/#= (/.zipped_with_3 +/3 sample/0 sample/1 sample/2) + ((/.zipped_with 3) +/3 sample/0 sample/1 sample/2)))) + (_.cover [/.together] + (and (/#= (/#composite sample/0 sample/1) + (/.together (list sample/0 sample/1))) + (/#= (all /#composite sample/0 sample/1 sample/2) + (/.together (list sample/0 sample/1 sample/2))))) + )))) (def: search Test @@ -381,35 +381,35 @@ {.#None})))] (do [! random.monad] [sample ..random] - ($_ _.and - (_.cover [/.one] - (case [(|> sample - (/.only n.even?) - (/#each (# n.decimal encoded)) - /.head) - (/.one choice sample)] - [{.#Some expected} {.#Some actual}] - (text#= expected actual) + (all _.and + (_.cover [/.one] + (case [(|> sample + (/.only n.even?) + (/#each (# n.decimal encoded)) + /.head) + (/.one choice sample)] + [{.#Some expected} {.#Some actual}] + (text#= expected actual) - [{.#None} {.#None}] - true + [{.#None} {.#None}] + true - _ - false)) - (_.cover [/.all] - (# (/.equivalence text.equivalence) = - (|> sample - (/.only n.even?) - (/#each (# n.decimal encoded))) - (/.all choice sample))) - (_.cover [/.example] - (case (/.example n.even? sample) - {.#Some found} - (n.even? found) + _ + false)) + (_.cover [/.all] + (# (/.equivalence text.equivalence) = + (|> sample + (/.only n.even?) + (/#each (# n.decimal encoded))) + (/.all choice sample))) + (_.cover [/.example] + (case (/.example n.even? sample) + {.#Some found} + (n.even? found) - {.#None} - (not (/.any? n.even? sample)))) - )))) + {.#None} + (not (/.any? n.even? sample)))) + )))) (def: .public test Test @@ -420,42 +420,42 @@ (do [! random.monad] [sample ..random separator random.nat] - ($_ _.and - ..signatures - ..whole - ..indices - ..slice - ..member - ..grouping - ..search - - (_.cover [/.interposed] - (or (/.empty? sample) - (let [sample+ (/.interposed separator sample)] - (and (n.= (|> (/.size sample) (n.* 2) --) - (/.size sample+)) - (|> sample+ - /.pairs - (maybe.else (list)) - (/.every? (|>> product.right (n.= separator)))))))) - (_.cover [/.iterations] - (or (/.empty? sample) - (let [size (/.size sample)] - (/#= (/.indices size) - (/.iterations (function (_ index) - (if (n.< size index) - {.#Some (++ index)} - {.#None})) - 0))))) - (_.cover [/.mixes] - (/#= (/#each (function (_ index) - (# /.mix mix n.+ 0 (/.first index sample))) - (/.indices (++ (/.size sample)))) - (/.mixes n.+ 0 sample))) - (do random.monad - [expected random.nat - .let [(open "/#[0]") (/.equivalence n.equivalence)]] - (_.cover [/.when] - (and (/#= (list expected) (/.when true (list expected))) - (/#= (list) (/.when false (list expected)))))) - ))))) + (all _.and + ..signatures + ..whole + ..indices + ..slice + ..member + ..grouping + ..search + + (_.cover [/.interposed] + (or (/.empty? sample) + (let [sample+ (/.interposed separator sample)] + (and (n.= (|> (/.size sample) (n.* 2) --) + (/.size sample+)) + (|> sample+ + /.pairs + (maybe.else (list)) + (/.every? (|>> product.right (n.= separator)))))))) + (_.cover [/.iterations] + (or (/.empty? sample) + (let [size (/.size sample)] + (/#= (/.indices size) + (/.iterations (function (_ index) + (if (n.< size index) + {.#Some (++ index)} + {.#None})) + 0))))) + (_.cover [/.mixes] + (/#= (/#each (function (_ index) + (# /.mix mix n.+ 0 (/.first index sample))) + (/.indices (++ (/.size sample)))) + (/.mixes n.+ 0 sample))) + (do random.monad + [expected random.nat + .let [(open "/#[0]") (/.equivalence n.equivalence)]] + (_.cover [/.when] + (and (/#= (list expected) (/.when true (list expected))) + (/#= (list) (/.when false (list expected)))))) + ))))) diff --git a/stdlib/source/test/lux/data/collection/queue.lux b/stdlib/source/test/lux/data/collection/queue.lux index 96d793d61..aa6365a41 100644 --- a/stdlib/source/test/lux/data/collection/queue.lux +++ b/stdlib/source/test/lux/data/collection/queue.lux @@ -1,23 +1,23 @@ (.using - [library - [lux "*" - ["_" test {"+" Test}] - [abstract - [monad {"+" do}] - [\\specification - ["$[0]" equivalence] - ["$[0]" functor {"+" Injection}]]] - [data - ["[0]" bit ("[1]#[0]" equivalence)] - [collection - ["[0]" set] - ["[0]" list ("[1]#[0]" monoid)]]] - [math - ["[0]" random] - [number - ["n" nat]]]]] - [\\library - ["[0]" /]]) + [library + [lux "*" + ["_" test {"+" Test}] + [abstract + [monad {"+" do}] + [\\specification + ["$[0]" equivalence] + ["$[0]" functor {"+" Injection}]]] + [data + ["[0]" bit ("[1]#[0]" equivalence)] + [collection + ["[0]" set] + ["[0]" list ("[1]#[0]" monoid)]]] + [math + ["[0]" random] + [number + ["n" nat]]]]] + [\\library + ["[0]" /]]) (def: injection (Injection /.Queue) @@ -34,86 +34,86 @@ random.nat) .let [members (set.list members) sample (/.of_list members)]] - ($_ _.and - (_.for [/.equivalence] - ($equivalence.spec (/.equivalence n.equivalence) (random.queue size random.nat))) - (_.for [/.functor] - ($functor.spec ..injection /.equivalence /.functor)) + (all _.and + (_.for [/.equivalence] + ($equivalence.spec (/.equivalence n.equivalence) (random.queue size random.nat))) + (_.for [/.functor] + ($functor.spec ..injection /.equivalence /.functor)) - (_.cover [/.of_list /.list] - (|> members /.of_list /.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! - (/.empty? /.empty) + (_.cover [/.of_list /.list] + (|> members /.of_list /.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! + (/.empty? /.empty) - all_empty_queues_look_the_same! - (bit#= (/.empty? sample) - (# (/.equivalence n.equivalence) = - sample - /.empty))] - (and empty_is_empty! - all_empty_queues_look_the_same!))) - (_.cover [/.front] - (case [members (/.front sample)] - [{.#Item head tail} {.#Some first}] - (n.= head first) - - [{.#End} {.#None}] - true + all_empty_queues_look_the_same! + (bit#= (/.empty? sample) + (# (/.equivalence n.equivalence) = + sample + /.empty))] + (and empty_is_empty! + all_empty_queues_look_the_same!))) + (_.cover [/.front] + (case [members (/.front sample)] + [{.#Item head tail} {.#Some first}] + (n.= head first) + + [{.#End} {.#None}] + true - _ - false)) - (_.cover [/.member?] - (let [every_member_is_identified! - (list.every? (/.member? n.equivalence sample) - (/.list sample)) + _ + false)) + (_.cover [/.member?] + (let [every_member_is_identified! + (list.every? (/.member? n.equivalence sample) + (/.list sample)) - non_member_is_not_identified! - (not (/.member? n.equivalence sample non_member))] - (and every_member_is_identified! - non_member_is_not_identified!))) - (_.cover [/.end] - (let [pushed (/.end non_member sample) + non_member_is_not_identified! + (not (/.member? n.equivalence sample non_member))] + (and every_member_is_identified! + non_member_is_not_identified!))) + (_.cover [/.end] + (let [pushed (/.end non_member sample) - size_increases! - (n.= (++ (/.size sample)) (/.size pushed)) + size_increases! + (n.= (++ (/.size sample)) (/.size pushed)) - new_member_is_identified! - (/.member? n.equivalence pushed non_member) - - has_expected_order! - (# (list.equivalence n.equivalence) = - (list#composite (/.list sample) (list non_member)) - (/.list pushed))] - (and size_increases! new_member_is_identified! - has_expected_order!))) - (_.cover [/.next] - (case members - {.#Item target expected} - (let [popped (/.next sample) + (/.member? n.equivalence pushed non_member) - size_decreases! - (n.= (-- (/.size sample)) - (/.size popped)) + has_expected_order! + (# (list.equivalence n.equivalence) = + (list#composite (/.list sample) (list non_member)) + (/.list pushed))] + (and size_increases! + new_member_is_identified! + has_expected_order!))) + (_.cover [/.next] + (case members + {.#Item target expected} + (let [popped (/.next sample) - popped_member_is_not_identified! - (not (/.member? n.equivalence popped target)) + size_decreases! + (n.= (-- (/.size sample)) + (/.size popped)) - has_expected_order! - (# (list.equivalence n.equivalence) = - expected - (/.list popped))] - (and size_decreases! popped_member_is_not_identified! - has_expected_order!)) - - {.#End} - (and (/.empty? sample) - (/.empty? (/.next sample))))) - )))) + (not (/.member? n.equivalence popped target)) + + has_expected_order! + (# (list.equivalence n.equivalence) = + expected + (/.list popped))] + (and size_decreases! + popped_member_is_not_identified! + has_expected_order!)) + + {.#End} + (and (/.empty? sample) + (/.empty? (/.next sample))))) + )))) diff --git a/stdlib/source/test/lux/data/collection/queue/priority.lux b/stdlib/source/test/lux/data/collection/queue/priority.lux index 643c284fe..d0a8faf6c 100644 --- a/stdlib/source/test/lux/data/collection/queue/priority.lux +++ b/stdlib/source/test/lux/data/collection/queue/priority.lux @@ -1,19 +1,19 @@ (.using - [library - [lux "*" - ["_" test {"+" Test}] - [abstract - ["[0]" monad {"+" do}]] - [control - ["[0]" maybe ("[1]#[0]" functor)]] - [data - ["[0]" bit ("[1]#[0]" equivalence)]] - [math - ["[0]" random {"+" Random}] - [number - ["n" nat]]]]] - [\\library - ["[0]" / {"+" Queue}]]) + [library + [lux "*" + ["_" test {"+" Test}] + [abstract + ["[0]" monad {"+" do}]] + [control + ["[0]" maybe ("[1]#[0]" functor)]] + [data + ["[0]" bit ("[1]#[0]" equivalence)]] + [math + ["[0]" random {"+" Random}] + [number + ["n" nat]]]]] + [\\library + ["[0]" / {"+" Queue}]]) (def: .public (random size) (-> Nat (Random (Queue Nat))) @@ -39,56 +39,56 @@ max_member random.nat min_member random.nat] - ($_ _.and - (_.cover [/.size] - (n.= size (/.size sample))) - (_.cover [/.empty?] - (bit#= (n.= 0 (/.size sample)) - (/.empty? sample))) - (_.cover [/.empty] - (/.empty? /.empty)) - (_.cover [/.front] - (case (/.front sample) - {.#Some first} - (n.> 0 (/.size sample)) - - {.#None} - (/.empty? sample))) - (_.cover [/.member?] - (case (/.front sample) - {.#Some first} - (/.member? n.equivalence sample first) - - {.#None} - (/.empty? sample))) - (_.cover [/.end] - (let [sample+ (/.end non_member_priority non_member sample)] - (and (not (/.member? n.equivalence sample non_member)) - (n.= (++ (/.size sample)) - (/.size sample+)) - (/.member? n.equivalence sample+ non_member)))) - (_.cover [/.next] - (let [sample- (/.next sample)] - (or (and (/.empty? sample) - (/.empty? sample-)) - (n.= (-- (/.size sample)) - (/.size sample-))))) - (_.for [/.Priority] - ($_ _.and - (_.cover [/.max] - (|> /.empty - (/.end /.min min_member) - (/.end /.max max_member) - /.front - (maybe#each (n.= max_member)) - (maybe.else false))) - (_.cover [/.min] - (|> /.empty - (/.end /.max max_member) - (/.end /.min min_member) - /.next - /.front - (maybe#each (n.= min_member)) - (maybe.else false))) - )) - )))) + (all _.and + (_.cover [/.size] + (n.= size (/.size sample))) + (_.cover [/.empty?] + (bit#= (n.= 0 (/.size sample)) + (/.empty? sample))) + (_.cover [/.empty] + (/.empty? /.empty)) + (_.cover [/.front] + (case (/.front sample) + {.#Some first} + (n.> 0 (/.size sample)) + + {.#None} + (/.empty? sample))) + (_.cover [/.member?] + (case (/.front sample) + {.#Some first} + (/.member? n.equivalence sample first) + + {.#None} + (/.empty? sample))) + (_.cover [/.end] + (let [sample+ (/.end non_member_priority non_member sample)] + (and (not (/.member? n.equivalence sample non_member)) + (n.= (++ (/.size sample)) + (/.size sample+)) + (/.member? n.equivalence sample+ non_member)))) + (_.cover [/.next] + (let [sample- (/.next sample)] + (or (and (/.empty? sample) + (/.empty? sample-)) + (n.= (-- (/.size sample)) + (/.size sample-))))) + (_.for [/.Priority] + (all _.and + (_.cover [/.max] + (|> /.empty + (/.end /.min min_member) + (/.end /.max max_member) + /.front + (maybe#each (n.= max_member)) + (maybe.else false))) + (_.cover [/.min] + (|> /.empty + (/.end /.max max_member) + (/.end /.min min_member) + /.next + /.front + (maybe#each (n.= min_member)) + (maybe.else false))) + )) + )))) diff --git a/stdlib/source/test/lux/data/collection/sequence.lux b/stdlib/source/test/lux/data/collection/sequence.lux index 34e1b13c2..a88a1f8de 100644 --- a/stdlib/source/test/lux/data/collection/sequence.lux +++ b/stdlib/source/test/lux/data/collection/sequence.lux @@ -31,20 +31,20 @@ Test (do [! random.monad] [size (# ! each (n.% 100) random.nat)] - ($_ _.and - (_.for [/.equivalence] - ($equivalence.spec (/.equivalence n.equivalence) (random.sequence size random.nat))) - (_.for [/.monoid] - ($monoid.spec (/.equivalence n.equivalence) /.monoid (random.sequence size random.nat))) - (_.for [/.mix] - ($mix.spec /#in /.equivalence /.mix)) - (_.for [/.functor] - ($functor.spec /#in /.equivalence /.functor)) - (_.for [/.apply] - ($apply.spec /#in /.equivalence /.apply)) - (_.for [/.monad] - ($monad.spec /#in /.equivalence /.monad)) - ))) + (all _.and + (_.for [/.equivalence] + ($equivalence.spec (/.equivalence n.equivalence) (random.sequence size random.nat))) + (_.for [/.monoid] + ($monoid.spec (/.equivalence n.equivalence) /.monoid (random.sequence size random.nat))) + (_.for [/.mix] + ($mix.spec /#in /.equivalence /.mix)) + (_.for [/.functor] + ($functor.spec /#in /.equivalence /.functor)) + (_.for [/.apply] + ($apply.spec /#in /.equivalence /.apply)) + (_.for [/.monad] + ($monad.spec /#in /.equivalence /.monad)) + ))) (def: whole Test @@ -53,82 +53,82 @@ sample (random.set n.hash size random.nat) .let [sample (|> sample set.list /.of_list)] .let [(open "/#[0]") (/.equivalence n.equivalence)]] - ($_ _.and - (_.cover [/.size] - (n.= size (/.size sample))) - (_.cover [/.empty?] - (bit#= (/.empty? sample) (n.= 0 (/.size sample)))) - (_.cover [/.empty] - (/.empty? /.empty)) - (_.cover [/.list /.of_list] - (|> sample /.list /.of_list (/#= sample))) - (_.cover [/.reversed] - (or (n.< 2 (/.size sample)) - (let [not_same! - (not (/#= sample - (/.reversed sample))) + (all _.and + (_.cover [/.size] + (n.= size (/.size sample))) + (_.cover [/.empty?] + (bit#= (/.empty? sample) (n.= 0 (/.size sample)))) + (_.cover [/.empty] + (/.empty? /.empty)) + (_.cover [/.list /.of_list] + (|> sample /.list /.of_list (/#= sample))) + (_.cover [/.reversed] + (or (n.< 2 (/.size sample)) + (let [not_same! + (not (/#= sample + (/.reversed sample))) - self_symmetry! - (/#= sample - (/.reversed (/.reversed sample)))] - (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))) - ))) + self_symmetry! + (/#= sample + (/.reversed (/.reversed sample)))] + (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 Test (do [! random.monad] [size (# ! each (|>> (n.% 100) ++) random.nat)] - ($_ _.and - (do ! - [good_index (|> random.nat (# ! each (n.% size))) - .let [bad_index (n.+ size good_index)] - sample (random.set n.hash size random.nat) - non_member (random.only (|>> (set.member? sample) not) - random.nat) - .let [sample (|> sample set.list /.of_list)]] - ($_ _.and - (_.cover [/.item] - (case (/.item good_index sample) - {try.#Success member} - (/.member? n.equivalence sample member) - - {try.#Failure error} - false)) - (_.cover [/.has] - (<| (try.else false) - (do try.monad - [sample (/.has good_index non_member sample) - actual (/.item good_index sample)] - (in (same? non_member actual))))) - (_.cover [/.revised] - (<| (try.else false) - (do try.monad - [sample (/.has good_index non_member sample) - sample (/.revised good_index ++ sample) - actual (/.item good_index sample)] - (in (n.= (++ 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! (is (All (_ a) (-> (Try a) Bit)) - (function (_ situation) - (case situation - {try.#Success member} - false - - {try.#Failure error} - (exception.match? /.index_out_of_bounds error))))] - (and (fails! (/.item bad_index sample)) - (fails! (/.has bad_index non_member sample)) - (fails! (/.revised bad_index ++ sample))))) - )) - ))) + (all _.and + (do ! + [good_index (|> random.nat (# ! each (n.% size))) + .let [bad_index (n.+ size good_index)] + sample (random.set n.hash size random.nat) + non_member (random.only (|>> (set.member? sample) not) + random.nat) + .let [sample (|> sample set.list /.of_list)]] + (all _.and + (_.cover [/.item] + (case (/.item good_index sample) + {try.#Success member} + (/.member? n.equivalence sample member) + + {try.#Failure error} + false)) + (_.cover [/.has] + (<| (try.else false) + (do try.monad + [sample (/.has good_index non_member sample) + actual (/.item good_index sample)] + (in (same? non_member actual))))) + (_.cover [/.revised] + (<| (try.else false) + (do try.monad + [sample (/.has good_index non_member sample) + sample (/.revised good_index ++ sample) + actual (/.item good_index sample)] + (in (n.= (++ 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! (is (All (_ a) (-> (Try a) Bit)) + (function (_ situation) + (case situation + {try.#Success member} + false + + {try.#Failure error} + (exception.match? /.index_out_of_bounds error))))] + (and (fails! (/.item bad_index sample)) + (fails! (/.has bad_index non_member sample)) + (fails! (/.revised bad_index ++ sample))))) + )) + ))) (def: .public test Test @@ -136,82 +136,82 @@ (_.for [/.Sequence]) (do [! random.monad] [size (# ! each (|>> (n.% 100) ++) random.nat)] - ($_ _.and - ..signatures - ..whole - ..index_based + (all _.and + ..signatures + ..whole + ..index_based - (do ! - [sample (random.set n.hash size random.nat) - non_member (random.only (|>> (set.member? sample) not) - random.nat) - .let [sample (|> sample set.list /.of_list)] - .let [(open "/#[0]") (/.equivalence n.equivalence)]] - ($_ _.and - (do ! - [value/0 random.nat - value/1 random.nat - value/2 random.nat] - (_.cover [/.sequence] - (/#= (/.of_list (list value/0 value/1 value/2)) - (/.sequence value/0 value/1 value/2)))) - (_.cover [/.member?] - (and (list.every? (/.member? n.equivalence sample) - (/.list sample)) - (not (/.member? n.equivalence sample non_member)))) - (_.cover [/.suffix] - (let [added (/.suffix non_member sample) + (do ! + [sample (random.set n.hash size random.nat) + non_member (random.only (|>> (set.member? sample) not) + random.nat) + .let [sample (|> sample set.list /.of_list)] + .let [(open "/#[0]") (/.equivalence n.equivalence)]] + (all _.and + (do ! + [value/0 random.nat + value/1 random.nat + value/2 random.nat] + (_.cover [/.sequence] + (/#= (/.of_list (list value/0 value/1 value/2)) + (/.sequence value/0 value/1 value/2)))) + (_.cover [/.member?] + (and (list.every? (/.member? n.equivalence sample) + (/.list sample)) + (not (/.member? n.equivalence sample non_member)))) + (_.cover [/.suffix] + (let [added (/.suffix non_member sample) - size_increases! - (n.= (++ (/.size sample)) - (/.size added)) + size_increases! + (n.= (++ (/.size sample)) + (/.size added)) - is_a_member! - (/.member? n.equivalence added non_member)] - (and size_increases! - is_a_member!))) - (_.cover [/.prefix] - (if (/.empty? sample) - (/.empty? (/.prefix sample)) - (let [expected_size! - (n.= (-- (/.size sample)) - (/.size (/.prefix sample))) + is_a_member! + (/.member? n.equivalence added non_member)] + (and size_increases! + is_a_member!))) + (_.cover [/.prefix] + (if (/.empty? sample) + (/.empty? (/.prefix sample)) + (let [expected_size! + (n.= (-- (/.size sample)) + (/.size (/.prefix sample))) - symmetry! - (|> sample - (/.suffix non_member) - /.prefix - (/#= sample))] - (and expected_size! - symmetry!)))) - (_.cover [/.only] - (let [positives (/.only n.even? sample) - negatives (/.only (bit.complement n.even?) sample)] - (and (/.every? n.even? positives) - (not (/.any? n.even? negatives)) + symmetry! + (|> sample + (/.suffix non_member) + /.prefix + (/#= sample))] + (and expected_size! + symmetry!)))) + (_.cover [/.only] + (let [positives (/.only n.even? sample) + negatives (/.only (bit.complement n.even?) sample)] + (and (/.every? n.even? positives) + (not (/.any? n.even? negatives)) - (n.= (/.size sample) - (n.+ (/.size positives) - (/.size negatives)))))) - (_.cover [/.one] - (let [(open "/#[0]") /.functor - choice (is (-> Nat (Maybe Text)) - (function (_ value) - (if (n.even? value) - {.#Some (# n.decimal encoded value)} - {.#None})))] - (case [(|> sample - (/.only n.even?) - (/#each (# n.decimal encoded)) - (/.item 0)) - (/.one choice sample)] - [{try.#Success expected} {.#Some actual}] - (text#= expected actual) + (n.= (/.size sample) + (n.+ (/.size positives) + (/.size negatives)))))) + (_.cover [/.one] + (let [(open "/#[0]") /.functor + choice (is (-> Nat (Maybe Text)) + (function (_ value) + (if (n.even? value) + {.#Some (# n.decimal encoded value)} + {.#None})))] + (case [(|> sample + (/.only n.even?) + (/#each (# n.decimal encoded)) + (/.item 0)) + (/.one choice sample)] + [{try.#Success expected} {.#Some actual}] + (text#= expected actual) - [{try.#Failure _} {.#None}] - true + [{try.#Failure _} {.#None}] + true - _ - false))) - )) - )))) + _ + false))) + )) + )))) diff --git a/stdlib/source/test/lux/data/collection/set.lux b/stdlib/source/test/lux/data/collection/set.lux index a5336f6f7..c444f5419 100644 --- a/stdlib/source/test/lux/data/collection/set.lux +++ b/stdlib/source/test/lux/data/collection/set.lux @@ -31,103 +31,103 @@ (_.for [/.Set]) (do [! random.monad] [size ..gen_nat] - ($_ _.and - (_.for [/.equivalence] - ($equivalence.spec /.equivalence (random.set n.hash size random.nat))) - (_.for [/.hash] - (|> random.nat - (# random.monad each (|>> list (/.of_list n.hash))) - ($hash.spec /.hash))) - (_.for [/.monoid] - ($monoid.spec /.equivalence (/.monoid n.hash) (random.set n.hash size random.nat))) + (all _.and + (_.for [/.equivalence] + ($equivalence.spec /.equivalence (random.set n.hash size random.nat))) + (_.for [/.hash] + (|> random.nat + (# random.monad each (|>> list (/.of_list n.hash))) + ($hash.spec /.hash))) + (_.for [/.monoid] + ($monoid.spec /.equivalence (/.monoid n.hash) (random.set n.hash size random.nat))) - (do ! - [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.only (|>> (/.member? setL) not) - random.nat)] - ($_ _.and - (_.cover [/.empty] - (/.empty? (/.empty n.hash))) - (do ! - [hash (# ! each (function (_ constant) - (is (Hash Nat) - (implementation - (def: equivalence n.equivalence) - - (def: (hash _) - constant)))) - random.nat)] - (_.cover [/.member_hash] - (same? hash (/.member_hash (/.empty hash))))) - (_.cover [/.size] - (n.= sizeL (/.size setL))) - (_.cover [/.empty?] - (bit#= (/.empty? setL) - (n.= 0 (/.size setL)))) - (_.cover [/.list /.of_list] - (|> setL /.list (/.of_list n.hash) (#= setL))) - (_.cover [/.member?] - (and (list.every? (/.member? setL) (/.list setL)) - (not (/.member? setL non_memberL)))) - (_.cover [/.has] - (let [before_addition! - (not (/.member? setL non_memberL)) + (do ! + [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.only (|>> (/.member? setL) not) + random.nat)] + (all _.and + (_.cover [/.empty] + (/.empty? (/.empty n.hash))) + (do ! + [hash (# ! each (function (_ constant) + (is (Hash Nat) + (implementation + (def: equivalence n.equivalence) + + (def: (hash _) + constant)))) + random.nat)] + (_.cover [/.member_hash] + (same? hash (/.member_hash (/.empty hash))))) + (_.cover [/.size] + (n.= sizeL (/.size setL))) + (_.cover [/.empty?] + (bit#= (/.empty? setL) + (n.= 0 (/.size setL)))) + (_.cover [/.list /.of_list] + (|> setL /.list (/.of_list n.hash) (#= setL))) + (_.cover [/.member?] + (and (list.every? (/.member? setL) (/.list setL)) + (not (/.member? setL non_memberL)))) + (_.cover [/.has] + (let [before_addition! + (not (/.member? setL non_memberL)) - after_addition! - (/.member? (/.has non_memberL setL) non_memberL) + after_addition! + (/.member? (/.has non_memberL setL) non_memberL) - size_increase! - (n.= (++ (/.size setL)) - (/.size (/.has non_memberL setL)))] - (and before_addition! - after_addition!))) - (_.cover [/.lacks] - (let [symmetry! - (|> setL - (/.has non_memberL) - (/.lacks non_memberL) - (#= setL)) + size_increase! + (n.= (++ (/.size setL)) + (/.size (/.has non_memberL setL)))] + (and before_addition! + after_addition!))) + (_.cover [/.lacks] + (let [symmetry! + (|> setL + (/.has non_memberL) + (/.lacks non_memberL) + (#= setL)) - idempotency! - (|> setL - (/.lacks non_memberL) - (#= setL))] - (and symmetry! - idempotency!))) - (_.cover [/.union /.sub?] - (let [setLR (/.union setL setR) - - sets_are_subs_of_their_unions! - (and (/.sub? setLR setL) - (/.sub? setLR setR)) + idempotency! + (|> setL + (/.lacks non_memberL) + (#= setL))] + (and symmetry! + idempotency!))) + (_.cover [/.union /.sub?] + (let [setLR (/.union setL setR) + + sets_are_subs_of_their_unions! + (and (/.sub? setLR setL) + (/.sub? setLR setR)) - union_with_empty_set! - (|> setL - (/.union (/.empty n.hash)) - (#= setL))] - (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! - (and (/.super? setLR setL) - (/.super? setLR setR)) + union_with_empty_set! + (|> setL + (/.union (/.empty n.hash)) + (#= setL))] + (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! + (and (/.super? setLR setL) + (/.super? setLR setR)) - intersection_with_empty_set! - (|> setL - (/.intersection (/.empty n.hash)) - /.empty?)] - (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) (/.list setR)) - (not (list.any? (/.member? setL_R) (/.list setR)))))) - (_.cover [/.predicate] - (list.every? (/.predicate setL) (/.list setL))) - )))))) + intersection_with_empty_set! + (|> setL + (/.intersection (/.empty n.hash)) + /.empty?)] + (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) (/.list setR)) + (not (list.any? (/.member? setL_R) (/.list setR)))))) + (_.cover [/.predicate] + (list.every? (/.predicate setL) (/.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 755efb685..9ace968fb 100644 --- a/stdlib/source/test/lux/data/collection/set/multi.lux +++ b/stdlib/source/test/lux/data/collection/set/multi.lux @@ -40,15 +40,15 @@ Test (do [! random.monad] [diversity (# ! each (n.% 10) random.nat)] - ($_ _.and - (_.for [/.equivalence] - ($equivalence.spec /.equivalence (..random diversity n.hash ..count random.nat))) - (_.for [/.hash] - (|> random.nat - (# random.monad each (function (_ single) - (/.has 1 single (/.empty n.hash)))) - ($hash.spec /.hash))) - ))) + (all _.and + (_.for [/.equivalence] + ($equivalence.spec /.equivalence (..random diversity n.hash ..count random.nat))) + (_.for [/.hash] + (|> random.nat + (# random.monad each (function (_ single) + (/.has 1 single (/.empty n.hash)))) + ($hash.spec /.hash))) + ))) (def: composition Test @@ -56,57 +56,57 @@ [diversity (# ! each (n.% 10) random.nat) sample (..random diversity n.hash ..count random.nat) another (..random diversity n.hash ..count random.nat)] - (`` ($_ _.and - (~~ (template [<name> <composition>] - [(_.cover [<name>] - (let [|sample| (/.support sample) - |another| (/.support another) - sample_only (set.difference |another| |sample|) - another_only (set.difference |sample| |another|) - common (set.intersection |sample| |another|) - composed (<name> sample another) + (`` (all _.and + (~~ (template [<name> <composition>] + [(_.cover [<name>] + (let [|sample| (/.support sample) + |another| (/.support 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) - (n.= (/.multiplicity sample member) - (/.multiplicity composed member))) - (set.list sample_only)) - no_right_changes! (list.every? (function (_ member) - (n.= (/.multiplicity another member) + no_left_changes! (list.every? (function (_ member) + (n.= (/.multiplicity sample member) (/.multiplicity composed member))) - (set.list another_only)) - common_changes! (list.every? (function (_ member) - (n.= (<composition> (/.multiplicity sample member) - (/.multiplicity another member)) - (/.multiplicity composed member))) - (set.list common))] - (and no_left_changes! - no_right_changes! - common_changes!)))] + (set.list sample_only)) + no_right_changes! (list.every? (function (_ member) + (n.= (/.multiplicity another member) + (/.multiplicity composed member))) + (set.list another_only)) + common_changes! (list.every? (function (_ member) + (n.= (<composition> (/.multiplicity sample member) + (/.multiplicity another member)) + (/.multiplicity composed member))) + (set.list common))] + (and no_left_changes! + no_right_changes! + common_changes!)))] - [/.sum n.+] - [/.union n.max] - )) - (_.cover [/.intersection] - (let [|sample| (/.support sample) - |another| (/.support another) - sample_only (set.difference |another| |sample|) - another_only (set.difference |sample| |another|) - common (set.intersection |sample| |another|) - composed (/.intersection sample another) + [/.sum n.+] + [/.union n.max] + )) + (_.cover [/.intersection] + (let [|sample| (/.support sample) + |another| (/.support 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.list sample_only)) - right_removals! (list.every? (|>> (/.member? composed) not) - (set.list another_only)) - common_changes! (list.every? (function (_ member) - (n.= (n.min (/.multiplicity sample member) - (/.multiplicity another member)) - (/.multiplicity composed member))) - (set.list common))] - (and left_removals! - right_removals! - common_changes!))) - )))) + left_removals! (list.every? (|>> (/.member? composed) not) + (set.list sample_only)) + right_removals! (list.every? (|>> (/.member? composed) not) + (set.list another_only)) + common_changes! (list.every? (function (_ member) + (n.= (n.min (/.multiplicity sample member) + (/.multiplicity another member)) + (/.multiplicity composed member))) + (set.list common))] + (and left_removals! + right_removals! + common_changes!))) + )))) (def: .public test Test @@ -120,121 +120,121 @@ addition_count ..count partial_removal_count (# ! each (n.% addition_count) random.nat) another (..random diversity n.hash ..count random.nat)] - ($_ _.and - (_.cover [/.list /.of_list] - (|> sample - /.list - (/.of_list n.hash) - (# /.equivalence = sample))) - (_.cover [/.size] - (n.= (list.size (/.list sample)) - (/.size sample))) - (_.cover [/.empty?] - (bit#= (/.empty? sample) - (n.= 0 (/.size sample)))) - (_.cover [/.empty] - (/.empty? (/.empty n.hash))) - (_.cover [/.support] - (list.every? (set.member? (/.support sample)) - (/.list sample))) - (_.cover [/.member?] - (let [non_member_is_not_identified! - (not (/.member? sample non_member)) + (all _.and + (_.cover [/.list /.of_list] + (|> sample + /.list + (/.of_list n.hash) + (# /.equivalence = sample))) + (_.cover [/.size] + (n.= (list.size (/.list sample)) + (/.size sample))) + (_.cover [/.empty?] + (bit#= (/.empty? sample) + (n.= 0 (/.size sample)))) + (_.cover [/.empty] + (/.empty? (/.empty n.hash))) + (_.cover [/.support] + (list.every? (set.member? (/.support sample)) + (/.list sample))) + (_.cover [/.member?] + (let [non_member_is_not_identified! + (not (/.member? sample non_member)) - all_members_are_identified! - (list.every? (/.member? sample) - (/.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)) + all_members_are_identified! + (list.every? (/.member? sample) + (/.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)) - every_member_has_positive_multiplicity! - (list.every? (|>> (/.multiplicity sample) (n.> 0)) - (/.list sample))] - (and non_members_have_0_multiplicity! - every_member_has_positive_multiplicity!))) - (_.cover [/.has] - (let [null_scenario! - (|> sample - (/.has 0 non_member) - (# /.equivalence = sample)) + every_member_has_positive_multiplicity! + (list.every? (|>> (/.multiplicity sample) (n.> 0)) + (/.list sample))] + (and non_members_have_0_multiplicity! + every_member_has_positive_multiplicity!))) + (_.cover [/.has] + (let [null_scenario! + (|> sample + (/.has 0 non_member) + (# /.equivalence = sample)) - normal_scenario! - (let [sample+ (/.has 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 [/.lacks] - (let [null_scenario! - (# /.equivalence = - (|> sample - (/.has addition_count non_member)) - (|> sample - (/.has addition_count non_member) - (/.lacks 0 non_member))) + normal_scenario! + (let [sample+ (/.has 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 [/.lacks] + (let [null_scenario! + (# /.equivalence = + (|> sample + (/.has addition_count non_member)) + (|> sample + (/.has addition_count non_member) + (/.lacks 0 non_member))) - partial_scenario! - (let [sample* (|> sample - (/.has addition_count non_member) - (/.lacks partial_removal_count non_member))] - (and (/.member? sample* non_member) - (n.= (n.- partial_removal_count - addition_count) - (/.multiplicity sample* non_member)))) - - total_scenario! - (|> sample - (/.has addition_count non_member) - (/.lacks addition_count non_member) - (# /.equivalence = sample))] - (and null_scenario! partial_scenario! - total_scenario!))) - (_.cover [/.of_set] - (let [unary (|> sample /.support /.of_set)] - (list.every? (|>> (/.multiplicity unary) (n.= 1)) - (/.list unary)))) - (_.cover [/.sub?] - (let [unary (|> sample /.support /.of_set)] - (and (/.sub? sample unary) - (or (not (/.sub? unary sample)) - (# /.equivalence = sample unary))))) - (_.cover [/.super?] - (let [unary (|> sample /.support /.of_set)] - (and (/.super? unary sample) - (or (not (/.super? sample unary)) - (# /.equivalence = sample unary))))) - (_.cover [/.difference] - (let [|sample| (/.support sample) - |another| (/.support another) - sample_only (set.difference |another| |sample|) - another_only (set.difference |sample| |another|) - common (set.intersection |sample| |another|) - composed (/.difference sample another) + (let [sample* (|> sample + (/.has addition_count non_member) + (/.lacks partial_removal_count non_member))] + (and (/.member? sample* non_member) + (n.= (n.- partial_removal_count + addition_count) + (/.multiplicity sample* non_member)))) + + total_scenario! + (|> sample + (/.has addition_count non_member) + (/.lacks addition_count non_member) + (# /.equivalence = sample))] + (and null_scenario! + partial_scenario! + total_scenario!))) + (_.cover [/.of_set] + (let [unary (|> sample /.support /.of_set)] + (list.every? (|>> (/.multiplicity unary) (n.= 1)) + (/.list unary)))) + (_.cover [/.sub?] + (let [unary (|> sample /.support /.of_set)] + (and (/.sub? sample unary) + (or (not (/.sub? unary sample)) + (# /.equivalence = sample unary))))) + (_.cover [/.super?] + (let [unary (|> sample /.support /.of_set)] + (and (/.super? unary sample) + (or (not (/.super? sample unary)) + (# /.equivalence = sample unary))))) + (_.cover [/.difference] + (let [|sample| (/.support sample) + |another| (/.support 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.list sample_only)) - intact! (list.every? (function (_ member) - (n.= (/.multiplicity another member) - (/.multiplicity composed member))) - (set.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) - 0 - (n.- sample_multiplicity - another_multiplicity)) - (/.multiplicity composed member)))) - (set.list common))] - (and ommissions! - intact! - subtractions!))) + ommissions! (list.every? (|>> (/.member? composed) not) + (set.list sample_only)) + intact! (list.every? (function (_ member) + (n.= (/.multiplicity another member) + (/.multiplicity composed member))) + (set.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) + 0 + (n.- sample_multiplicity + another_multiplicity)) + (/.multiplicity composed member)))) + (set.list common))] + (and ommissions! + intact! + subtractions!))) - ..signature - ..composition - )))) + ..signature + ..composition + )))) diff --git a/stdlib/source/test/lux/data/collection/set/ordered.lux b/stdlib/source/test/lux/data/collection/set/ordered.lux index b4b97a984..67f7bb483 100644 --- a/stdlib/source/test/lux/data/collection/set/ordered.lux +++ b/stdlib/source/test/lux/data/collection/set/ordered.lux @@ -52,126 +52,126 @@ setL (/.of_list n.order listL) setR (/.of_list n.order listR) empty (/.empty n.order)]] - (`` ($_ _.and - (_.for [/.equivalence] - ($equivalence.spec /.equivalence (..random sizeL n.order random.nat))) - - (_.cover [/.size] - (n.= sizeL (/.size setL))) - (_.cover [/.empty?] - (bit#= (n.= 0 (/.size setL)) - (/.empty? setL))) - (_.cover [/.empty] - (/.empty? (/.empty n.order))) - (_.cover [/.list] - (# (list.equivalence n.equivalence) = - (/.list (/.of_list n.order listL)) - (list.sorted (# n.order <) listL))) - (_.cover [/.of_list] - (|> setL - /.list (/.of_list n.order) - (/#= setL))) - (~~ (template [<coverage> <comparison>] - [(_.cover [<coverage>] - (case (<coverage> setL) - {.#Some value} - (|> setL /.list (list.every? (<comparison> value))) - - {.#None} - (/.empty? setL)))] - - [/.min n.>=] - [/.max n.<=] - )) - (_.cover [/.member?] - (let [members_are_identified! - (list.every? (/.member? setL) (/.list setL)) - - non_members_are_not_identified! - (not (/.member? setL non_memberL))] - (and members_are_identified! - non_members_are_not_identified!))) - (_.cover [/.has] - (let [setL+ (/.has non_memberL setL)] - (and (not (/.member? setL non_memberL)) - (/.member? setL+ non_memberL) - (n.= (++ (/.size setL)) - (/.size setL+))))) - (_.cover [/.lacks] - (|> setL - (/.has non_memberL) - (/.lacks non_memberL) - (# /.equivalence = setL))) - (_.cover [/.sub?] - (let [self! - (/.sub? setL setL) - - empty! - (/.sub? setL empty)] - (and self! - empty!))) - (_.cover [/.super?] - (let [self! - (/.super? setL setL) - - empty! - (/.super? empty setL) - - symmetry! - (bit#= (/.super? setL setR) - (/.sub? setR setL))] - (and self! + (`` (all _.and + (_.for [/.equivalence] + ($equivalence.spec /.equivalence (..random sizeL n.order random.nat))) + + (_.cover [/.size] + (n.= sizeL (/.size setL))) + (_.cover [/.empty?] + (bit#= (n.= 0 (/.size setL)) + (/.empty? setL))) + (_.cover [/.empty] + (/.empty? (/.empty n.order))) + (_.cover [/.list] + (# (list.equivalence n.equivalence) = + (/.list (/.of_list n.order listL)) + (list.sorted (# n.order <) listL))) + (_.cover [/.of_list] + (|> setL + /.list (/.of_list n.order) + (/#= setL))) + (~~ (template [<coverage> <comparison>] + [(_.cover [<coverage>] + (case (<coverage> setL) + {.#Some value} + (|> setL /.list (list.every? (<comparison> value))) + + {.#None} + (/.empty? setL)))] + + [/.min n.>=] + [/.max n.<=] + )) + (_.cover [/.member?] + (let [members_are_identified! + (list.every? (/.member? setL) (/.list setL)) + + non_members_are_not_identified! + (not (/.member? setL non_memberL))] + (and members_are_identified! + non_members_are_not_identified!))) + (_.cover [/.has] + (let [setL+ (/.has non_memberL setL)] + (and (not (/.member? setL non_memberL)) + (/.member? setL+ non_memberL) + (n.= (++ (/.size setL)) + (/.size setL+))))) + (_.cover [/.lacks] + (|> setL + (/.has non_memberL) + (/.lacks non_memberL) + (# /.equivalence = setL))) + (_.cover [/.sub?] + (let [self! + (/.sub? setL setL) + + empty! + (/.sub? setL empty)] + (and self! + empty!))) + (_.cover [/.super?] + (let [self! + (/.super? setL setL) + empty! - symmetry!))) - (~~ (template [<coverage> <relation> <empty?>] - [(_.cover [<coverage>] - (let [self! - (# /.equivalence = - setL - (<coverage> setL setL)) - - super! - (and (<relation> (<coverage> setL setR) setL) - (<relation> (<coverage> setL setR) setR)) - - empty! - (# /.equivalence = - (if <empty?> empty setL) - (<coverage> setL empty)) - - idempotence! - (# /.equivalence = - (<coverage> setL (<coverage> setL setR)) - (<coverage> setR (<coverage> setL setR)))] - (and self! + (/.super? empty setL) + + symmetry! + (bit#= (/.super? setL setR) + (/.sub? setR setL))] + (and self! + empty! + symmetry!))) + (~~ (template [<coverage> <relation> <empty?>] + [(_.cover [<coverage>] + (let [self! + (# /.equivalence = + setL + (<coverage> setL setL)) + super! + (and (<relation> (<coverage> setL setR) setL) + (<relation> (<coverage> setL setR) setR)) + empty! - idempotence!)))] - - [/.union /.sub? false] - [/.intersection /.super? true] - )) - (_.cover [/.difference] - (let [self! - (|> setL - (/.difference setL) - (# /.equivalence = empty)) - - empty! - (|> setL - (/.difference empty) - (# /.equivalence = setL)) - - difference! - (not (list.any? (/.member? (/.difference setL setR)) - (/.list setL))) - - idempotence! - (# /.equivalence = - (/.difference setL setR) - (/.difference setL (/.difference setL setR)))] - (and self! + (# /.equivalence = + (if <empty?> empty setL) + (<coverage> setL empty)) + + idempotence! + (# /.equivalence = + (<coverage> setL (<coverage> setL setR)) + (<coverage> setR (<coverage> setL setR)))] + (and self! + super! + empty! + idempotence!)))] + + [/.union /.sub? false] + [/.intersection /.super? true] + )) + (_.cover [/.difference] + (let [self! + (|> setL + (/.difference setL) + (# /.equivalence = empty)) + empty! + (|> setL + (/.difference empty) + (# /.equivalence = setL)) + difference! - idempotence!))) - ))))) + (not (list.any? (/.member? (/.difference setL setR)) + (/.list setL))) + + idempotence! + (# /.equivalence = + (/.difference setL setR) + (/.difference setL (/.difference setL setR)))] + (and self! + empty! + difference! + idempotence!))) + ))))) diff --git a/stdlib/source/test/lux/data/collection/stack.lux b/stdlib/source/test/lux/data/collection/stack.lux index db77ca8b3..f23767283 100644 --- a/stdlib/source/test/lux/data/collection/stack.lux +++ b/stdlib/source/test/lux/data/collection/stack.lux @@ -1,22 +1,22 @@ (.using - [library - [lux "*" - ["_" test {"+" Test}] - [abstract - [monad {"+" do}] - [\\specification - ["$[0]" equivalence] - ["$[0]" functor {"+" Injection}]]] - [control - ["[0]" maybe]] - [data - ["[0]" bit ("[1]#[0]" equivalence)]] - [math - ["[0]" random] - [number - ["n" nat]]]]] - [\\library - ["[0]" /]]) + [library + [lux "*" + ["_" test {"+" Test}] + [abstract + [monad {"+" do}] + [\\specification + ["$[0]" equivalence] + ["$[0]" functor {"+" Injection}]]] + [control + ["[0]" maybe]] + [data + ["[0]" bit ("[1]#[0]" equivalence)]] + [math + ["[0]" random] + [number + ["n" nat]]]]] + [\\library + ["[0]" /]]) (def: (injection value) (Injection /.Stack) @@ -30,41 +30,41 @@ [size (# random.monad each (n.% 100) random.nat) sample (random.stack size random.nat) expected_top random.nat] - ($_ _.and - (_.for [/.equivalence] - ($equivalence.spec (/.equivalence n.equivalence) (random.stack size random.nat))) - (_.for [/.functor] - ($functor.spec ..injection /.equivalence /.functor)) - - (_.cover [/.size] - (n.= size (/.size sample))) - (_.cover [/.empty?] - (bit#= (n.= 0 (/.size sample)) - (/.empty? sample))) - (_.cover [/.empty] - (/.empty? /.empty)) - (_.cover [/.value] - (case (/.value sample) - {.#None} - (/.empty? sample) - - {.#Some _} - (not (/.empty? sample)))) - (_.cover [/.next] - (case (/.next sample) - {.#None} - (/.empty? sample) - - {.#Some [top remaining]} - (# (/.equivalence n.equivalence) = - sample - (/.top top remaining)))) - (_.cover [/.top] - (case (/.next (/.top expected_top sample)) - {.#Some [actual_top actual_sample]} - (and (same? expected_top actual_top) - (same? sample actual_sample)) - - {.#None} - false)) - )))) + (all _.and + (_.for [/.equivalence] + ($equivalence.spec (/.equivalence n.equivalence) (random.stack size random.nat))) + (_.for [/.functor] + ($functor.spec ..injection /.equivalence /.functor)) + + (_.cover [/.size] + (n.= size (/.size sample))) + (_.cover [/.empty?] + (bit#= (n.= 0 (/.size sample)) + (/.empty? sample))) + (_.cover [/.empty] + (/.empty? /.empty)) + (_.cover [/.value] + (case (/.value sample) + {.#None} + (/.empty? sample) + + {.#Some _} + (not (/.empty? sample)))) + (_.cover [/.next] + (case (/.next sample) + {.#None} + (/.empty? sample) + + {.#Some [top remaining]} + (# (/.equivalence n.equivalence) = + sample + (/.top top remaining)))) + (_.cover [/.top] + (case (/.next (/.top expected_top sample)) + {.#Some [actual_top actual_sample]} + (and (same? expected_top actual_top) + (same? sample actual_sample)) + + {.#None} + false)) + )))) diff --git a/stdlib/source/test/lux/data/collection/stream.lux b/stdlib/source/test/lux/data/collection/stream.lux index 64c5d6337..f6ddd13d3 100644 --- a/stdlib/source/test/lux/data/collection/stream.lux +++ b/stdlib/source/test/lux/data/collection/stream.lux @@ -50,74 +50,74 @@ offset (# ! each (n.% 100) random.nat) cycle_start random.nat cycle_next (random.list size random.nat)] - ($_ _.and - (_.for [/.functor] - ($functor.spec /.repeated ..equivalence /.functor)) - (_.for [/.comonad] - ($comonad.spec /.repeated ..equivalence /.comonad)) - - (_.cover [/.item] - (n.= (n.+ offset index) - (/.item index (..iterations ++ offset)))) - (_.cover [/.repeated] - (n.= repeated - (/.item index (/.repeated repeated)))) - (_.cover [/.first] - (list#= (enum.range n.enum offset (-- (n.+ size offset))) - (/.first size (..iterations ++ offset)))) - (_.cover [/.after] - (list#= (enum.range n.enum offset (-- (n.+ size offset))) - (/.first size (/.after offset (..iterations ++ 0))))) - (_.cover [/.split_at] - (let [[drops takes] (/.split_at size (..iterations ++ 0))] - (and (list#= (enum.range n.enum 0 (-- size)) - drops) - (list#= (enum.range n.enum size (-- (n.* 2 size))) - (/.first size takes))))) - (_.cover [/.while] - (list#= (enum.range n.enum 0 (-- size)) - (/.while (n.< size) (..iterations ++ 0)))) - (_.cover [/.until] - (list#= (enum.range n.enum offset (-- (n.+ size offset))) - (/.while (n.< (n.+ size offset)) - (/.until (n.< offset) (..iterations ++ 0))))) - (_.cover [/.split_when] - (let [[drops takes] (/.split_when (n.= size) (..iterations ++ 0))] - (and (list#= (enum.range n.enum 0 (-- size)) - drops) - (list#= (enum.range n.enum size (-- (n.* 2 size))) - (/.while (n.< (n.* 2 size)) takes))))) - (_.cover [/.head] - (n.= offset - (/.head (..iterations ++ offset)))) - (_.cover [/.tail] - (list#= (enum.range n.enum (++ offset) (n.+ size offset)) - (/.first size (/.tail (..iterations ++ offset))))) - (_.cover [/.only] - (list#= (list#each (n.* 2) (enum.range n.enum 0 (-- size))) - (/.first size (/.only n.even? (..iterations ++ 0))))) - (_.cover [/.partition] - (let [[evens odds] (/.partition n.even? (..iterations ++ 0))] - (and (n.= (n.* 2 offset) - (/.item offset evens)) - (n.= (++ (n.* 2 offset)) - (/.item offset odds))))) - (_.cover [/.iterations] - (let [(open "/#[0]") /.functor - (open "list#[0]") (list.equivalence text.equivalence)] - (list#= (/.first size - (/#each %.nat (..iterations ++ offset))) - (/.first size - (/.iterations (function (_ n) [(++ n) (%.nat n)]) - offset))))) - (_.cover [/.cycle] - (let [cycle (partial_list cycle_start cycle_next)] - (list#= (list.together (list.repeated size cycle)) - (/.first (n.* size (list.size cycle)) - (/.cycle [cycle_start cycle_next]))))) - (_.cover [/.pattern] - (let [(/.pattern first second third next) (..iterations ++ offset)] - (and (n.= offset first) - (n.= (n.+ 1 offset) second) - (n.= (n.+ 2 offset) third)))) - )))) + (all _.and + (_.for [/.functor] + ($functor.spec /.repeated ..equivalence /.functor)) + (_.for [/.comonad] + ($comonad.spec /.repeated ..equivalence /.comonad)) + + (_.cover [/.item] + (n.= (n.+ offset index) + (/.item index (..iterations ++ offset)))) + (_.cover [/.repeated] + (n.= repeated + (/.item index (/.repeated repeated)))) + (_.cover [/.first] + (list#= (enum.range n.enum offset (-- (n.+ size offset))) + (/.first size (..iterations ++ offset)))) + (_.cover [/.after] + (list#= (enum.range n.enum offset (-- (n.+ size offset))) + (/.first size (/.after offset (..iterations ++ 0))))) + (_.cover [/.split_at] + (let [[drops takes] (/.split_at size (..iterations ++ 0))] + (and (list#= (enum.range n.enum 0 (-- size)) + drops) + (list#= (enum.range n.enum size (-- (n.* 2 size))) + (/.first size takes))))) + (_.cover [/.while] + (list#= (enum.range n.enum 0 (-- size)) + (/.while (n.< size) (..iterations ++ 0)))) + (_.cover [/.until] + (list#= (enum.range n.enum offset (-- (n.+ size offset))) + (/.while (n.< (n.+ size offset)) + (/.until (n.< offset) (..iterations ++ 0))))) + (_.cover [/.split_when] + (let [[drops takes] (/.split_when (n.= size) (..iterations ++ 0))] + (and (list#= (enum.range n.enum 0 (-- size)) + drops) + (list#= (enum.range n.enum size (-- (n.* 2 size))) + (/.while (n.< (n.* 2 size)) takes))))) + (_.cover [/.head] + (n.= offset + (/.head (..iterations ++ offset)))) + (_.cover [/.tail] + (list#= (enum.range n.enum (++ offset) (n.+ size offset)) + (/.first size (/.tail (..iterations ++ offset))))) + (_.cover [/.only] + (list#= (list#each (n.* 2) (enum.range n.enum 0 (-- size))) + (/.first size (/.only n.even? (..iterations ++ 0))))) + (_.cover [/.partition] + (let [[evens odds] (/.partition n.even? (..iterations ++ 0))] + (and (n.= (n.* 2 offset) + (/.item offset evens)) + (n.= (++ (n.* 2 offset)) + (/.item offset odds))))) + (_.cover [/.iterations] + (let [(open "/#[0]") /.functor + (open "list#[0]") (list.equivalence text.equivalence)] + (list#= (/.first size + (/#each %.nat (..iterations ++ offset))) + (/.first size + (/.iterations (function (_ n) [(++ n) (%.nat n)]) + offset))))) + (_.cover [/.cycle] + (let [cycle (partial_list cycle_start cycle_next)] + (list#= (list.together (list.repeated size cycle)) + (/.first (n.* size (list.size cycle)) + (/.cycle [cycle_start cycle_next]))))) + (_.cover [/.pattern] + (let [(/.pattern first second third next) (..iterations ++ offset)] + (and (n.= offset first) + (n.= (n.+ 1 offset) second) + (n.= (n.+ 2 offset) third)))) + )))) diff --git a/stdlib/source/test/lux/data/collection/tree.lux b/stdlib/source/test/lux/data/collection/tree.lux index b8569005e..b5dbfa7c4 100644 --- a/stdlib/source/test/lux/data/collection/tree.lux +++ b/stdlib/source/test/lux/data/collection/tree.lux @@ -35,57 +35,57 @@ Test (<| (_.covering /._) (_.for [/.Tree]) - ($_ _.and - (_.for [/.equivalence] - (|> (..tree random.nat) - (# random.monad each product.right) - ($equivalence.spec (/.equivalence n.equivalence)))) - (_.for [/.mix] - ($mix.spec /.leaf /.equivalence /.mix)) - (_.for [/.functor] - ($functor.spec /.leaf /.equivalence /.functor)) - - (do random.monad - [[size sample] (..tree random.nat)] - (_.cover [/.flat] - (n.= size - (list.size (/.flat sample))))) - (do random.monad - [expected random.nat] - (_.cover [/.leaf] - (# (list.equivalence n.equivalence) = - (list expected) - (/.flat (/.leaf expected))))) - (do [! random.monad] - [value random.nat - num_children (# ! each (n.% 3) random.nat) - children (random.list num_children random.nat)] - (_.cover [/.branch] - (# (list.equivalence n.equivalence) = - (partial_list value children) - (/.flat (/.branch value (list#each /.leaf children)))))) - (do random.monad - [expected/0 random.nat - expected/1 random.nat - expected/2 random.nat - expected/3 random.nat - expected/4 random.nat - expected/5 random.nat] - (_.cover [/.tree] - (and (# (list.equivalence n.equivalence) = - (list expected/0) - (/.flat (/.tree expected/0))) - (# (list.equivalence n.equivalence) = - (list expected/0 expected/1 expected/2) - (/.flat (/.tree expected/0 - {expected/1 {} - expected/2 {}}))) - (# (list.equivalence n.equivalence) = - (list expected/0 expected/1 expected/2 - expected/3 expected/4 expected/5) - (/.flat (/.tree expected/0 - {expected/1 {} - expected/2 {expected/3 {} - expected/4 {expected/5 {}}}}))) - ))) - ))) + (all _.and + (_.for [/.equivalence] + (|> (..tree random.nat) + (# random.monad each product.right) + ($equivalence.spec (/.equivalence n.equivalence)))) + (_.for [/.mix] + ($mix.spec /.leaf /.equivalence /.mix)) + (_.for [/.functor] + ($functor.spec /.leaf /.equivalence /.functor)) + + (do random.monad + [[size sample] (..tree random.nat)] + (_.cover [/.flat] + (n.= size + (list.size (/.flat sample))))) + (do random.monad + [expected random.nat] + (_.cover [/.leaf] + (# (list.equivalence n.equivalence) = + (list expected) + (/.flat (/.leaf expected))))) + (do [! random.monad] + [value random.nat + num_children (# ! each (n.% 3) random.nat) + children (random.list num_children random.nat)] + (_.cover [/.branch] + (# (list.equivalence n.equivalence) = + (partial_list value children) + (/.flat (/.branch value (list#each /.leaf children)))))) + (do random.monad + [expected/0 random.nat + expected/1 random.nat + expected/2 random.nat + expected/3 random.nat + expected/4 random.nat + expected/5 random.nat] + (_.cover [/.tree] + (and (# (list.equivalence n.equivalence) = + (list expected/0) + (/.flat (/.tree expected/0))) + (# (list.equivalence n.equivalence) = + (list expected/0 expected/1 expected/2) + (/.flat (/.tree expected/0 + {expected/1 {} + expected/2 {}}))) + (# (list.equivalence n.equivalence) = + (list expected/0 expected/1 expected/2 + expected/3 expected/4 expected/5) + (/.flat (/.tree expected/0 + {expected/1 {} + expected/2 {expected/3 {} + expected/4 {expected/5 {}}}}))) + ))) + ))) diff --git a/stdlib/source/test/lux/data/collection/tree/finger.lux b/stdlib/source/test/lux/data/collection/tree/finger.lux index fb4ddc214..1a54f242e 100644 --- a/stdlib/source/test/lux/data/collection/tree/finger.lux +++ b/stdlib/source/test/lux/data/collection/tree/finger.lux @@ -38,115 +38,115 @@ (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#composite tag_left tag_right) - (/.tag (# ..builder branch + (all _.and + (_.cover [/.Builder /.builder] + (exec (/.builder text.monoid) + true)) + (_.cover [/.tag] + (and (text#= tag_left + (/.tag (# ..builder leaf tag_left expected_left))) + (text#= (text#composite tag_left tag_right) + (/.tag (# ..builder branch + (# ..builder leaf tag_left expected_left) + (# ..builder leaf tag_right expected_right)))))) + (_.cover [/.root] + (and (case (/.root (# ..builder leaf tag_left expected_left)) + {.#Left actual} + (n.= expected_left actual) + + {.#Right _} + false) + (case (/.root (# ..builder branch + (# ..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)) + + _ + false)))) + (_.cover [/.value] + (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)))))) - (_.cover [/.root] - (and (case (/.root (# ..builder leaf tag_left expected_left)) - {.#Left actual} - (n.= expected_left actual) - - {.#Right _} - false) - (case (/.root (# ..builder branch - (# ..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)) - - _ - false)))) - (_.cover [/.value] - (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)))))) - (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)) - values/H random.nat - values/T (random.list 5 random.nat)] - (_.cover [/.tags /.values] - (let [tree (list#mix (function (_ [tag value] tree) - (# builder branch tree (# builder leaf tag value))) - (# builder leaf tags/H values/H) - (list.zipped_2 tags/T values/T))] - (and (# tags_equivalence = (partial_list tags/H tags/T) (/.tags tree)) - (# values_equivalence = (partial_list values/H values/T) (/.values tree)))))) - (_.cover [/.one] - (let [can_find_correct_one! - (|> (# ..builder leaf tag_left expected_left) - (/.one (text.contains? tag_left)) - (maybe#each (n.= expected_left)) - (maybe.else false)) - - cannot_find_incorrect_one! - (|> (# ..builder leaf tag_right expected_right) - (/.one (text.contains? tag_left)) - (maybe#each (n.= expected_left)) - (maybe.else false) - not) + (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)) + values/H random.nat + values/T (random.list 5 random.nat)] + (_.cover [/.tags /.values] + (let [tree (list#mix (function (_ [tag value] tree) + (# builder branch tree (# builder leaf tag value))) + (# builder leaf tags/H values/H) + (list.zipped_2 tags/T values/T))] + (and (# tags_equivalence = (partial_list tags/H tags/T) (/.tags tree)) + (# values_equivalence = (partial_list values/H values/T) (/.values tree)))))) + (_.cover [/.one] + (let [can_find_correct_one! + (|> (# ..builder leaf tag_left expected_left) + (/.one (text.contains? tag_left)) + (maybe#each (n.= expected_left)) + (maybe.else false)) - can_find_left! - (|> (# ..builder branch - (# ..builder leaf tag_left expected_left) - (# ..builder leaf tag_right expected_right)) - (/.one (text.contains? tag_left)) - (maybe#each (n.= expected_left)) - (maybe.else false)) - - can_find_right! - (|> (# ..builder branch - (# ..builder leaf tag_left expected_left) - (# ..builder leaf tag_right expected_right)) - (/.one (text.contains? tag_right)) - (maybe#each (n.= expected_right)) - (maybe.else false))] - (and can_find_correct_one! cannot_find_incorrect_one! - can_find_left! - can_find_right!))) - (_.cover [/.exists?] - (let [can_find_correct_one! - (/.exists? (text.contains? tag_left) - (# ..builder leaf tag_left expected_left)) + (|> (# ..builder leaf tag_right expected_right) + (/.one (text.contains? tag_left)) + (maybe#each (n.= expected_left)) + (maybe.else false) + not) - cannot_find_incorrect_one! - (not (/.exists? (text.contains? tag_left) - (# ..builder leaf tag_right expected_right))) + can_find_left! + (|> (# ..builder branch + (# ..builder leaf tag_left expected_left) + (# ..builder leaf tag_right expected_right)) + (/.one (text.contains? tag_left)) + (maybe#each (n.= expected_left)) + (maybe.else false)) - can_find_left! - (/.exists? (text.contains? tag_left) - (# ..builder branch - (# ..builder leaf tag_left expected_left) - (# ..builder leaf tag_right expected_right))) + can_find_right! + (|> (# ..builder branch + (# ..builder leaf tag_left expected_left) + (# ..builder leaf tag_right expected_right)) + (/.one (text.contains? tag_right)) + (maybe#each (n.= expected_right)) + (maybe.else false))] + (and can_find_correct_one! + cannot_find_incorrect_one! + can_find_left! + can_find_right!))) + (_.cover [/.exists?] + (let [can_find_correct_one! + (/.exists? (text.contains? tag_left) + (# ..builder leaf tag_left expected_left)) - can_find_right! - (/.exists? (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! + (not (/.exists? (text.contains? tag_left) + (# ..builder leaf tag_right expected_right))) + can_find_left! - can_find_right!))) - )))) + (/.exists? (text.contains? tag_left) + (# ..builder branch + (# ..builder leaf tag_left expected_left) + (# ..builder leaf tag_right expected_right))) + + can_find_right! + (/.exists? (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!))) + )))) diff --git a/stdlib/source/test/lux/data/collection/tree/zipper.lux b/stdlib/source/test/lux/data/collection/tree/zipper.lux index b39f5ea63..3a74a5030 100644 --- a/stdlib/source/test/lux/data/collection/tree/zipper.lux +++ b/stdlib/source/test/lux/data/collection/tree/zipper.lux @@ -30,126 +30,126 @@ (do random.monad [expected random.nat dummy (random.only (|>> (n.= expected) not) random.nat)] - ($_ _.and - (_.cover [/.down] - (|> (tree.branch dummy (list (tree.leaf expected))) - /.zipper - (pipe.do maybe.monad - [/.down] - [/.value (n.= expected) in]) - (maybe.else false))) - (_.cover [/.up] - (|> (tree.branch expected (list (tree.leaf dummy))) - /.zipper - (pipe.do maybe.monad - [/.down] - [/.up] - [/.value (n.= expected) in]) - (maybe.else false))) - (_.cover [/.right] - (|> (tree.branch dummy (list (tree.leaf dummy) (tree.leaf expected))) - /.zipper - (pipe.do maybe.monad - [/.down] - [/.right] - [/.value (n.= expected) in]) - (maybe.else false))) - (_.cover [/.rightmost] - (|> (tree.branch dummy - (list (tree.leaf dummy) - (tree.leaf dummy) - (tree.leaf dummy) - (tree.leaf expected))) - /.zipper - (pipe.do maybe.monad - [/.down] - [/.rightmost] - [/.value (n.= expected) in]) - (maybe.else false))) - (_.cover [/.left] - (|> (tree.branch dummy (list (tree.leaf expected) (tree.leaf dummy))) - /.zipper - (pipe.do maybe.monad - [/.down] - [/.right] - [/.left] - [/.value (n.= expected) in]) - (maybe.else false))) - (_.cover [/.leftmost] - (|> (tree.branch dummy - (list (tree.leaf expected) - (tree.leaf dummy) - (tree.leaf dummy) - (tree.leaf dummy))) - /.zipper - (pipe.do maybe.monad - [/.down] - [/.rightmost] - [/.leftmost] - [/.value (n.= expected) in]) - (maybe.else false))) - (_.cover [/.next] - (and (|> (tree.branch dummy - (list (tree.leaf expected) - (tree.leaf dummy))) - /.zipper - (pipe.do maybe.monad - [/.next] - [/.value (n.= expected) in]) - (maybe.else false)) - (|> (tree.branch dummy - (list (tree.leaf dummy) - (tree.leaf expected))) - /.zipper - (pipe.do maybe.monad - [/.next] - [/.next] - [/.value (n.= expected) in]) - (maybe.else false)))) - (_.cover [/.end] - (|> (tree.branch dummy - (list (tree.leaf dummy) - (tree.leaf dummy) - (tree.leaf dummy) - (tree.leaf expected))) - /.zipper - (pipe.do maybe.monad - [/.end] - [/.value (n.= expected) in]) - (maybe.else false))) - (_.cover [/.start] - (|> (tree.branch expected - (list (tree.leaf dummy) - (tree.leaf dummy) - (tree.leaf dummy) - (tree.leaf dummy))) - /.zipper - (pipe.do maybe.monad - [/.end] - [/.start] - [/.value (n.= expected) in]) - (maybe.else false))) - (_.cover [/.previous] - (and (|> (tree.branch expected - (list (tree.leaf dummy) - (tree.leaf dummy))) - /.zipper - (pipe.do maybe.monad - [/.next] - [/.previous] - [/.value (n.= expected) in]) - (maybe.else false)) - (|> (tree.branch dummy - (list (tree.leaf expected) - (tree.leaf dummy))) - /.zipper - (pipe.do maybe.monad - [/.next] - [/.next] - [/.previous] - [/.value (n.= expected) in]) - (maybe.else false)))) - ))) + (all _.and + (_.cover [/.down] + (|> (tree.branch dummy (list (tree.leaf expected))) + /.zipper + (pipe.do maybe.monad + [/.down] + [/.value (n.= expected) in]) + (maybe.else false))) + (_.cover [/.up] + (|> (tree.branch expected (list (tree.leaf dummy))) + /.zipper + (pipe.do maybe.monad + [/.down] + [/.up] + [/.value (n.= expected) in]) + (maybe.else false))) + (_.cover [/.right] + (|> (tree.branch dummy (list (tree.leaf dummy) (tree.leaf expected))) + /.zipper + (pipe.do maybe.monad + [/.down] + [/.right] + [/.value (n.= expected) in]) + (maybe.else false))) + (_.cover [/.rightmost] + (|> (tree.branch dummy + (list (tree.leaf dummy) + (tree.leaf dummy) + (tree.leaf dummy) + (tree.leaf expected))) + /.zipper + (pipe.do maybe.monad + [/.down] + [/.rightmost] + [/.value (n.= expected) in]) + (maybe.else false))) + (_.cover [/.left] + (|> (tree.branch dummy (list (tree.leaf expected) (tree.leaf dummy))) + /.zipper + (pipe.do maybe.monad + [/.down] + [/.right] + [/.left] + [/.value (n.= expected) in]) + (maybe.else false))) + (_.cover [/.leftmost] + (|> (tree.branch dummy + (list (tree.leaf expected) + (tree.leaf dummy) + (tree.leaf dummy) + (tree.leaf dummy))) + /.zipper + (pipe.do maybe.monad + [/.down] + [/.rightmost] + [/.leftmost] + [/.value (n.= expected) in]) + (maybe.else false))) + (_.cover [/.next] + (and (|> (tree.branch dummy + (list (tree.leaf expected) + (tree.leaf dummy))) + /.zipper + (pipe.do maybe.monad + [/.next] + [/.value (n.= expected) in]) + (maybe.else false)) + (|> (tree.branch dummy + (list (tree.leaf dummy) + (tree.leaf expected))) + /.zipper + (pipe.do maybe.monad + [/.next] + [/.next] + [/.value (n.= expected) in]) + (maybe.else false)))) + (_.cover [/.end] + (|> (tree.branch dummy + (list (tree.leaf dummy) + (tree.leaf dummy) + (tree.leaf dummy) + (tree.leaf expected))) + /.zipper + (pipe.do maybe.monad + [/.end] + [/.value (n.= expected) in]) + (maybe.else false))) + (_.cover [/.start] + (|> (tree.branch expected + (list (tree.leaf dummy) + (tree.leaf dummy) + (tree.leaf dummy) + (tree.leaf dummy))) + /.zipper + (pipe.do maybe.monad + [/.end] + [/.start] + [/.value (n.= expected) in]) + (maybe.else false))) + (_.cover [/.previous] + (and (|> (tree.branch expected + (list (tree.leaf dummy) + (tree.leaf dummy))) + /.zipper + (pipe.do maybe.monad + [/.next] + [/.previous] + [/.value (n.= expected) in]) + (maybe.else false)) + (|> (tree.branch dummy + (list (tree.leaf expected) + (tree.leaf dummy))) + /.zipper + (pipe.do maybe.monad + [/.next] + [/.next] + [/.previous] + [/.value (n.= expected) in]) + (maybe.else false)))) + ))) (def: .public test Test @@ -161,101 +161,101 @@ dummy (random.only (|>> (n.= expected) not) random.nat) .let [(open "tree#[0]") (tree.equivalence n.equivalence) (open "list#[0]") (list.equivalence n.equivalence)]] - ($_ _.and - (_.for [/.equivalence] - ($equivalence.spec (/.equivalence n.equivalence) (# ! each (|>> product.right /.zipper) (//.tree random.nat)))) - (_.for [/.functor] - ($functor.spec (|>> tree.leaf /.zipper) /.equivalence /.functor)) - (_.for [/.comonad] - ($comonad.spec (|>> tree.leaf /.zipper) /.equivalence /.comonad)) - - (_.cover [/.zipper /.tree] - (|> sample /.zipper /.tree (tree#= sample))) - (_.cover [/.start?] - (|> sample /.zipper /.start?)) - (_.cover [/.leaf?] - (/.leaf? (/.zipper (tree.leaf expected)))) - (_.cover [/.branch?] - (and (/.branch? (/.zipper (tree.branch expected (list (tree.leaf expected))))) - (not (/.branch? (/.zipper (tree.branch expected (list))))))) - (_.cover [/.value] - (and (n.= expected (/.value (/.zipper (tree.leaf expected)))) - (n.= expected (/.value (/.zipper (tree.branch expected (list (tree.leaf expected)))))))) - (_.cover [/.set] - (|> (/.zipper (tree.leaf dummy)) - (/.set expected) - /.value - (n.= expected))) - (_.cover [/.update] - (|> (/.zipper (tree.leaf expected)) - (/.update ++) - /.value - (n.= (++ expected)))) - ..move - (_.cover [/.end?] - (or (/.end? (/.zipper sample)) - (|> sample - /.zipper - /.end - (maybe#each /.end?) - (maybe.else false)))) - (_.cover [/.interpose] - (let [cursor (|> (tree.branch dummy (list (tree.leaf dummy))) - /.zipper - (/.interpose expected))] - (and (n.= dummy (/.value cursor)) - (|> cursor - (pipe.do maybe.monad - [/.down] - [/.value (n.= expected) in]) - (maybe.else false)) - (|> cursor - (pipe.do maybe.monad - [/.down] - [/.down] - [/.value (n.= dummy) in]) - (maybe.else false))))) - (_.cover [/.adopt] - (let [cursor (|> (tree.branch dummy (list (tree.leaf dummy))) - /.zipper - (/.adopt expected))] - (and (n.= dummy (/.value cursor)) - (|> cursor - (pipe.do maybe.monad - [/.down] - [/.value (n.= expected) in]) - (maybe.else false)) - (|> cursor - (pipe.do maybe.monad - [/.down] - [/.right] - [/.value (n.= dummy) in]) - (maybe.else false))))) - (_.cover [/.insert_left] - (|> (tree.branch dummy (list (tree.leaf dummy))) - /.zipper - (pipe.do maybe.monad - [/.down] - [(/.insert_left expected)] - [/.left] - [/.value (n.= expected) in]) - (maybe.else false))) - (_.cover [/.insert_right] - (|> (tree.branch dummy (list (tree.leaf dummy))) - /.zipper - (pipe.do maybe.monad - [/.down] - [(/.insert_right expected)] - [/.right] - [/.value (n.= expected) in]) - (maybe.else false))) - (_.cover [/.remove] - (|> (tree.branch dummy (list (tree.leaf dummy))) - /.zipper - (pipe.do maybe.monad - [/.down] - [(/.insert_left expected)] - [/.remove] - [/.value (n.= expected) in]) - (maybe.else false))) - )))) + (all _.and + (_.for [/.equivalence] + ($equivalence.spec (/.equivalence n.equivalence) (# ! each (|>> product.right /.zipper) (//.tree random.nat)))) + (_.for [/.functor] + ($functor.spec (|>> tree.leaf /.zipper) /.equivalence /.functor)) + (_.for [/.comonad] + ($comonad.spec (|>> tree.leaf /.zipper) /.equivalence /.comonad)) + + (_.cover [/.zipper /.tree] + (|> sample /.zipper /.tree (tree#= sample))) + (_.cover [/.start?] + (|> sample /.zipper /.start?)) + (_.cover [/.leaf?] + (/.leaf? (/.zipper (tree.leaf expected)))) + (_.cover [/.branch?] + (and (/.branch? (/.zipper (tree.branch expected (list (tree.leaf expected))))) + (not (/.branch? (/.zipper (tree.branch expected (list))))))) + (_.cover [/.value] + (and (n.= expected (/.value (/.zipper (tree.leaf expected)))) + (n.= expected (/.value (/.zipper (tree.branch expected (list (tree.leaf expected)))))))) + (_.cover [/.set] + (|> (/.zipper (tree.leaf dummy)) + (/.set expected) + /.value + (n.= expected))) + (_.cover [/.update] + (|> (/.zipper (tree.leaf expected)) + (/.update ++) + /.value + (n.= (++ expected)))) + ..move + (_.cover [/.end?] + (or (/.end? (/.zipper sample)) + (|> sample + /.zipper + /.end + (maybe#each /.end?) + (maybe.else false)))) + (_.cover [/.interpose] + (let [cursor (|> (tree.branch dummy (list (tree.leaf dummy))) + /.zipper + (/.interpose expected))] + (and (n.= dummy (/.value cursor)) + (|> cursor + (pipe.do maybe.monad + [/.down] + [/.value (n.= expected) in]) + (maybe.else false)) + (|> cursor + (pipe.do maybe.monad + [/.down] + [/.down] + [/.value (n.= dummy) in]) + (maybe.else false))))) + (_.cover [/.adopt] + (let [cursor (|> (tree.branch dummy (list (tree.leaf dummy))) + /.zipper + (/.adopt expected))] + (and (n.= dummy (/.value cursor)) + (|> cursor + (pipe.do maybe.monad + [/.down] + [/.value (n.= expected) in]) + (maybe.else false)) + (|> cursor + (pipe.do maybe.monad + [/.down] + [/.right] + [/.value (n.= dummy) in]) + (maybe.else false))))) + (_.cover [/.insert_left] + (|> (tree.branch dummy (list (tree.leaf dummy))) + /.zipper + (pipe.do maybe.monad + [/.down] + [(/.insert_left expected)] + [/.left] + [/.value (n.= expected) in]) + (maybe.else false))) + (_.cover [/.insert_right] + (|> (tree.branch dummy (list (tree.leaf dummy))) + /.zipper + (pipe.do maybe.monad + [/.down] + [(/.insert_right expected)] + [/.right] + [/.value (n.= expected) in]) + (maybe.else false))) + (_.cover [/.remove] + (|> (tree.branch dummy (list (tree.leaf dummy))) + /.zipper + (pipe.do maybe.monad + [/.down] + [(/.insert_left expected)] + [/.remove] + [/.value (n.= expected) in]) + (maybe.else false))) + )))) diff --git a/stdlib/source/test/lux/data/color.lux b/stdlib/source/test/lux/data/color.lux index a8b175c3a..14c22b77c 100644 --- a/stdlib/source/test/lux/data/color.lux +++ b/stdlib/source/test/lux/data/color.lux @@ -23,7 +23,7 @@ (def: .public random (Random /.Color) - (|> ($_ random.and random.nat random.nat random.nat) + (|> (all random.and random.nat random.nat random.nat) (# random.monad each /.of_rgb))) (def: scale @@ -49,10 +49,10 @@ (let [[fr fg fb] (/.rgb from) [tr tg tb] (/.rgb to)] (square_root - ($_ f.+ - (|> (scale tr) (f.- (scale fr)) square) - (|> (scale tg) (f.- (scale fg)) square) - (|> (scale tb) (f.- (scale fb)) square))))) + (all 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) @@ -68,23 +68,23 @@ (def: (encoding expected) (-> /.Color Test) - ($_ _.and - (_.cover [/.RGB /.rgb /.of_rgb] - (|> expected /.rgb /.of_rgb - (# /.equivalence = expected))) - (_.cover [/.HSL /.hsl /.of_hsl] - (|> expected /.hsl /.of_hsl - (distance/3 expected) - (f.<= ..rgb_error_margin))) - (_.cover [/.HSB /.hsb /.of_hsb] - (|> expected /.hsb /.of_hsb - (distance/3 expected) - (f.<= ..rgb_error_margin))) - (_.cover [/.CMYK /.cmyk /.of_cmyk] - (|> expected /.cmyk /.of_cmyk - (distance/3 expected) - (f.<= ..rgb_error_margin))) - )) + (all _.and + (_.cover [/.RGB /.rgb /.of_rgb] + (|> expected /.rgb /.of_rgb + (# /.equivalence = expected))) + (_.cover [/.HSL /.hsl /.of_hsl] + (|> expected /.hsl /.of_hsl + (distance/3 expected) + (f.<= ..rgb_error_margin))) + (_.cover [/.HSB /.hsb /.of_hsb] + (|> expected /.hsb /.of_hsb + (distance/3 expected) + (f.<= ..rgb_error_margin))) + (_.cover [/.CMYK /.cmyk /.of_cmyk] + (|> expected /.cmyk /.of_cmyk + (distance/3 expected) + (f.<= ..rgb_error_margin))) + )) (def: transformation Test @@ -98,32 +98,32 @@ (and (f.>= +0.25 saturation) (f.<= +0.75 saturation))))))) ratio (|> random.safe_frac (random.only (f.>= +0.5)))] - ($_ _.and - (_.cover [/.darker /.brighter] - (and (f.<= (distance/3 colorful /.black) - (distance/3 (/.darker ratio colorful) /.black)) - (f.<= (distance/3 colorful /.white) - (distance/3 (/.brighter ratio colorful) /.white)))) - (_.cover [/.interpolated] - (and (f.<= (distance/3 colorful /.black) - (distance/3 (/.interpolated ratio /.black colorful) /.black)) - (f.<= (distance/3 colorful /.white) - (distance/3 (/.interpolated ratio /.white colorful) /.white)))) - (_.cover [/.saturated] - (f.> (saturation mediocre) - (saturation (/.saturated ratio mediocre)))) - (_.cover [/.un_saturated] - (f.< (saturation mediocre) - (saturation (/.un_saturated 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))))) - ))) + (all _.and + (_.cover [/.darker /.brighter] + (and (f.<= (distance/3 colorful /.black) + (distance/3 (/.darker ratio colorful) /.black)) + (f.<= (distance/3 colorful /.white) + (distance/3 (/.brighter ratio colorful) /.white)))) + (_.cover [/.interpolated] + (and (f.<= (distance/3 colorful /.black) + (distance/3 (/.interpolated ratio /.black colorful) /.black)) + (f.<= (distance/3 colorful /.white) + (distance/3 (/.interpolated ratio /.white colorful) /.white)))) + (_.cover [/.saturated] + (f.> (saturation mediocre) + (saturation (/.saturated ratio mediocre)))) + (_.cover [/.un_saturated] + (f.< (saturation mediocre) + (saturation (/.un_saturated 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))))) + ))) (def: palette Test @@ -139,40 +139,40 @@ spread_space (f.- min_spread max_spread)] spread (# ! each (|>> f.abs (f.% spread_space) (f.+ min_spread)) random.safe_frac)] - (`` ($_ _.and - (~~ (template [<brightness> <palette>] - [(_.cover [<palette>] - (let [eB <brightness> - expected (/.of_hsb [eH eS eB]) - palette (<palette> spread variations expected)] - (and (n.= variations (list.size palette)) - (not (list.any? (# /.equivalence = expected) palette)))))] - [+1.0 /.analogous] - [+0.5 /.monochromatic] - )) - (~~ (template [<palette>] - [(_.cover [<palette>] - (let [expected (/.of_hsb [eH eS +0.5]) - [c0 c1 c2] (<palette> expected)] - (and (# /.equivalence = expected c0) - (not (# /.equivalence = expected c1)) - (not (# /.equivalence = expected c2)))))] + (`` (all _.and + (~~ (template [<brightness> <palette>] + [(_.cover [<palette>] + (let [eB <brightness> + expected (/.of_hsb [eH eS eB]) + palette (<palette> spread variations expected)] + (and (n.= variations (list.size palette)) + (not (list.any? (# /.equivalence = expected) palette)))))] + [+1.0 /.analogous] + [+0.5 /.monochromatic] + )) + (~~ (template [<palette>] + [(_.cover [<palette>] + (let [expected (/.of_hsb [eH eS +0.5]) + [c0 c1 c2] (<palette> expected)] + (and (# /.equivalence = expected c0) + (not (# /.equivalence = expected c1)) + (not (# /.equivalence = expected c2)))))] - [/.triad] - [/.clash] - [/.split_complement])) - (~~ (template [<palette>] - [(_.cover [<palette>] - (let [expected (/.of_hsb [eH eS +0.5]) - [c0 c1 c2 c3] (<palette> expected)] - (and (# /.equivalence = expected c0) - (not (# /.equivalence = expected c1)) - (not (# /.equivalence = expected c2)) - (not (# /.equivalence = expected c3)))))] + [/.triad] + [/.clash] + [/.split_complement])) + (~~ (template [<palette>] + [(_.cover [<palette>] + (let [expected (/.of_hsb [eH eS +0.5]) + [c0 c1 c2 c3] (<palette> expected)] + (and (# /.equivalence = expected c0) + (not (# /.equivalence = expected c1)) + (not (# /.equivalence = expected c2)) + (not (# /.equivalence = expected c3)))))] - [/.square] - [/.tetradic])) - ))))) + [/.square] + [/.tetradic])) + ))))) (def: .public test Test @@ -180,33 +180,33 @@ (_.for [/.Color]) (do [! random.monad] [expected ..random] - ($_ _.and - (_.for [/.equivalence] - ($equivalence.spec /.equivalence ..random)) - (_.for [/.hash] - ($hash.spec /.hash ..random)) - (_.for [/.addition] - ($monoid.spec /.equivalence /.addition ..random)) - (_.for [/.subtraction] - ($monoid.spec /.equivalence /.addition ..random)) - - (..encoding expected) - (_.cover [/.complement] - (let [~expected (/.complement expected) - (open "/#[0]") /.equivalence] - (and (not (/#= expected ~expected)) - (/#= expected (/.complement ~expected))))) - (_.cover [/.black /.white] - (and (# /.equivalence = /.white (/.complement /.black)) - (# /.equivalence = /.black (/.complement /.white)))) - ..transformation - ..palette - (_.for [/.Alpha /.Pigment] - ($_ _.and - (_.cover [/.transparent /.opaque] - (and (r.= /.opaque (-- /.transparent)) - (r.= /.transparent (++ /.opaque)))) - (_.cover [/.translucent] - (r.= /.transparent (r.+ /.translucent /.translucent))) - )) - )))) + (all _.and + (_.for [/.equivalence] + ($equivalence.spec /.equivalence ..random)) + (_.for [/.hash] + ($hash.spec /.hash ..random)) + (_.for [/.addition] + ($monoid.spec /.equivalence /.addition ..random)) + (_.for [/.subtraction] + ($monoid.spec /.equivalence /.addition ..random)) + + (..encoding expected) + (_.cover [/.complement] + (let [~expected (/.complement expected) + (open "/#[0]") /.equivalence] + (and (not (/#= expected ~expected)) + (/#= expected (/.complement ~expected))))) + (_.cover [/.black /.white] + (and (# /.equivalence = /.white (/.complement /.black)) + (# /.equivalence = /.black (/.complement /.white)))) + ..transformation + ..palette + (_.for [/.Alpha /.Pigment] + (all _.and + (_.cover [/.transparent /.opaque] + (and (r.= /.opaque (-- /.transparent)) + (r.= /.transparent (++ /.opaque)))) + (_.cover [/.translucent] + (r.= /.transparent (r.+ /.translucent /.translucent))) + )) + )))) diff --git a/stdlib/source/test/lux/data/color/named.lux b/stdlib/source/test/lux/data/color/named.lux index 2c9d336a4..ce4f22fc3 100644 --- a/stdlib/source/test/lux/data/color/named.lux +++ b/stdlib/source/test/lux/data/color/named.lux @@ -227,14 +227,14 @@ (def: .public test Test (<| (_.covering /._) - (`` ($_ _.and - (~~ (template [<definition> <by_letter>] - [<definition>] - - <colors>)) - (_.cover [/.aqua] - (# //.equivalence = /.cyan /.aqua)) - (_.cover [/.fuchsia] - (# //.equivalence = /.magenta /.fuchsia)) - )))) + (`` (all _.and + (~~ (template [<definition> <by_letter>] + [<definition>] + + <colors>)) + (_.cover [/.aqua] + (# //.equivalence = /.cyan /.aqua)) + (_.cover [/.fuchsia] + (# //.equivalence = /.magenta /.fuchsia)) + )))) ) diff --git a/stdlib/source/test/lux/data/format/binary.lux b/stdlib/source/test/lux/data/format/binary.lux index 0a7227fd6..571a1ef5a 100644 --- a/stdlib/source/test/lux/data/format/binary.lux +++ b/stdlib/source/test/lux/data/format/binary.lux @@ -1,18 +1,18 @@ (.using - [library - [lux "*" - ["_" test {"+" Test}] - [abstract - [equivalence {"+" Equivalence}] - [monad {"+" do}] - [\\specification - ["$[0]" monoid]]] - [data - ["[0]" binary ("[1]#[0]" equivalence)]] - [math - ["[0]" random {"+" Random}]]]] - [\\library - ["[0]" /]]) + [library + [lux "*" + ["_" test {"+" Test}] + [abstract + [equivalence {"+" Equivalence}] + [monad {"+" do}] + [\\specification + ["$[0]" monoid]]] + [data + ["[0]" binary ("[1]#[0]" equivalence)]] + [math + ["[0]" random {"+" Random}]]]] + [\\library + ["[0]" /]]) (implementation: equivalence (Equivalence /.Specification) @@ -29,7 +29,7 @@ Test (<| (_.covering /._) (_.for [/.Mutation /.Specification /.Writer]) - ($_ _.and - (_.for [/.monoid] - ($monoid.spec ..equivalence /.monoid ..random)) - ))) + (all _.and + (_.for [/.monoid] + ($monoid.spec ..equivalence /.monoid ..random)) + ))) diff --git a/stdlib/source/test/lux/data/format/json.lux b/stdlib/source/test/lux/data/format/json.lux index 3d10458af..1c33df2b6 100644 --- a/stdlib/source/test/lux/data/format/json.lux +++ b/stdlib/source/test/lux/data/format/json.lux @@ -37,14 +37,14 @@ (function (_ again) (do [! random.monad] [size (# ! each (n.% 2) random.nat)] - ($_ random.or - (# ! in []) - random.bit - random.safe_frac - (random.unicode size) - (random.sequence size again) - (random.dictionary text.hash size (random.unicode size) again) - ))))) + (all random.or + (# ! in []) + random.bit + random.safe_frac + (random.unicode size) + (random.sequence size again) + (random.dictionary text.hash size (random.unicode size) again) + ))))) (syntax: (boolean []) (do meta.monad @@ -65,135 +65,135 @@ Test (<| (_.covering /._) (_.for [/.JSON]) - (`` ($_ _.and - (_.for [/.equivalence] - ($equivalence.spec /.equivalence ..random)) - (_.for [/.codec] - ($codec.spec /.equivalence /.codec ..random)) + (`` (all _.and + (_.for [/.equivalence] + ($equivalence.spec /.equivalence ..random)) + (_.for [/.codec] + ($codec.spec /.equivalence /.codec ..random)) - (do random.monad - [sample ..random] - (_.cover [/.Null /.null?] - (# bit.equivalence = - (/.null? sample) - (case sample - {/.#Null} true - _ false)))) - (do random.monad - [expected ..random] - (_.cover [/.format] - (|> expected - /.format - (# /.codec decoded) - (try#each (#= expected)) - (try.else 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.zipped_2 (set.list keys) - (list#each (|>> {/.#Number}) (set.list values))) - object (/.object expected)]] - ($_ _.and - (_.cover [/.object /.fields] - (case (/.fields object) - {try.#Success actual} - (# (list.equivalence text.equivalence) = - (list#each product.left expected) - actual) - - {try.#Failure error} - false)) - (_.cover [/.field] - (list.every? (function (_ [key expected]) - (|> (/.field key object) - (try#each (#= expected)) - (try.else false))) - expected)) - )) - (do random.monad - [key (random.ascii/alpha 1) - unknown (random.only (|>> (# text.equivalence = key) not) - (random.ascii/alpha 1)) - expected random.safe_frac] - (_.cover [/.has] - (<| (try.else false) - (do try.monad - [object (/.has key {/.#Number expected} (/.object (list))) - .let [can_find_known_key! - (|> object - (/.field key) - (try#each (#= {/.#Number expected})) - (try.else false)) + (do random.monad + [sample ..random] + (_.cover [/.Null /.null?] + (# bit.equivalence = + (/.null? sample) + (case sample + {/.#Null} true + _ false)))) + (do random.monad + [expected ..random] + (_.cover [/.format] + (|> expected + /.format + (# /.codec decoded) + (try#each (#= expected)) + (try.else 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.zipped_2 (set.list keys) + (list#each (|>> {/.#Number}) (set.list values))) + object (/.object expected)]] + (all _.and + (_.cover [/.object /.fields] + (case (/.fields object) + {try.#Success actual} + (# (list.equivalence text.equivalence) = + (list#each product.left expected) + actual) + + {try.#Failure error} + false)) + (_.cover [/.field] + (list.every? (function (_ [key expected]) + (|> (/.field key object) + (try#each (#= expected)) + (try.else false))) + expected)) + )) + (do random.monad + [key (random.ascii/alpha 1) + unknown (random.only (|>> (# text.equivalence = key) not) + (random.ascii/alpha 1)) + expected random.safe_frac] + (_.cover [/.has] + (<| (try.else false) + (do try.monad + [object (/.has key {/.#Number expected} (/.object (list))) + .let [can_find_known_key! + (|> object + (/.field key) + (try#each (#= {/.#Number expected})) + (try.else false)) - cannot_find_unknown_key! - (case (/.field unknown object) - {try.#Success _} - false + cannot_find_unknown_key! + (case (/.field unknown object) + {try.#Success _} + false - {try.#Failure error} - true)]] - (in (and can_find_known_key! - cannot_find_unknown_key!)))))) - (~~ (template [<type> <field> <tag> <random> <equivalence>] - [(do random.monad - [key (random.ascii/alpha 1) - value <random>] - (_.cover [<type> <field>] - (|> (/.object (list [key {<tag> value}])) - (<field> key) - (try#each (# <equivalence> = value)) - (try.else false))))] + {try.#Failure error} + true)]] + (in (and can_find_known_key! + cannot_find_unknown_key!)))))) + (~~ (template [<type> <field> <tag> <random> <equivalence>] + [(do random.monad + [key (random.ascii/alpha 1) + value <random>] + (_.cover [<type> <field>] + (|> (/.object (list [key {<tag> value}])) + (<field> key) + (try#each (# <equivalence> = value)) + (try.else false))))] - [/.Boolean /.boolean_field /.#Boolean random.bit bit.equivalence] - [/.Number /.number_field /.#Number random.safe_frac frac.equivalence] - [/.String /.string_field /.#String (random.ascii/alpha 1) text.equivalence] - [/.Array /.array_field /.#Array (random.sequence 3 ..random) (sequence.equivalence /.equivalence)] - [/.Object /.object_field /.#Object (random.dictionary text.hash 3 (random.ascii/alpha 1) ..random) (dictionary.equivalence /.equivalence)] - )) - (with_expansions [<boolean> (boolean) - <number> (number) - <string> (string) - <array_sequence> (sequence.sequence {/.#Null} - {/.#Boolean <boolean>} - {/.#Number <number>} - {/.#String <string>}) - <key0> (string) - <key1> (string) - <key2> (string) - <key3> (string) - <key4> (string) - <key5> (string) - <key6> (string)] - (_.cover [/.json] - (and (#= {/.#Null} (/.json ())) - (~~ (template [<tag> <value>] - [(#= {<tag> <value>} (/.json <value>))] - - [/.#Boolean <boolean>] - [/.#Number <number>] - [/.#String <string>] - )) - (#= {/.#Array <array_sequence>} (/.json [() <boolean> <number> <string>])) - (let [object (/.json {<key0> () - <key1> <boolean> - <key2> <number> - <key3> <string> - <key4> [() <boolean> <number> <string>] - <key5> {<key6> <number>}})] - (<| (try.else false) - (do try.monad - [value0 (/.field <key0> object) - value1 (/.field <key1> object) - value2 (/.field <key2> object) - value3 (/.field <key3> object) - value4 (/.field <key4> object) - value5 (/.field <key5> object) - value6 (/.field <key6> value5)] - (in (and (#= {/.#Null} value0) - (#= {/.#Boolean <boolean>} value1) - (#= {/.#Number <number>} value2) - (#= {/.#String <string>} value3) - (#= {/.#Array <array_sequence>} value4) - (#= {/.#Number <number>} value6)))))) - ))) - )))) + [/.Boolean /.boolean_field /.#Boolean random.bit bit.equivalence] + [/.Number /.number_field /.#Number random.safe_frac frac.equivalence] + [/.String /.string_field /.#String (random.ascii/alpha 1) text.equivalence] + [/.Array /.array_field /.#Array (random.sequence 3 ..random) (sequence.equivalence /.equivalence)] + [/.Object /.object_field /.#Object (random.dictionary text.hash 3 (random.ascii/alpha 1) ..random) (dictionary.equivalence /.equivalence)] + )) + (with_expansions [<boolean> (boolean) + <number> (number) + <string> (string) + <array_sequence> (sequence.sequence {/.#Null} + {/.#Boolean <boolean>} + {/.#Number <number>} + {/.#String <string>}) + <key0> (string) + <key1> (string) + <key2> (string) + <key3> (string) + <key4> (string) + <key5> (string) + <key6> (string)] + (_.cover [/.json] + (and (#= {/.#Null} (/.json ())) + (~~ (template [<tag> <value>] + [(#= {<tag> <value>} (/.json <value>))] + + [/.#Boolean <boolean>] + [/.#Number <number>] + [/.#String <string>] + )) + (#= {/.#Array <array_sequence>} (/.json [() <boolean> <number> <string>])) + (let [object (/.json {<key0> () + <key1> <boolean> + <key2> <number> + <key3> <string> + <key4> [() <boolean> <number> <string>] + <key5> {<key6> <number>}})] + (<| (try.else false) + (do try.monad + [value0 (/.field <key0> object) + value1 (/.field <key1> object) + value2 (/.field <key2> object) + value3 (/.field <key3> object) + value4 (/.field <key4> object) + value5 (/.field <key5> object) + value6 (/.field <key6> value5)] + (in (and (#= {/.#Null} value0) + (#= {/.#Boolean <boolean>} value1) + (#= {/.#Number <number>} value2) + (#= {/.#String <string>} value3) + (#= {/.#Array <array_sequence>} 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 d38efe7ec..1bffe48ec 100644 --- a/stdlib/source/test/lux/data/format/tar.lux +++ b/stdlib/source/test/lux/data/format/tar.lux @@ -44,32 +44,32 @@ invalid (random.ascii/lower (++ /.path_size)) not_ascii (random.text (random.char (unicode.set [unicode/block.katakana (list)])) /.path_size)] - (`` ($_ _.and - (_.cover [/.path /.from_path] - (case (/.path expected) - {try.#Success actual} - (text#= expected - (/.from_path actual)) - - {try.#Failure error} - false)) - (_.cover [/.no_path] - (text#= "" (/.from_path /.no_path))) - (_.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) - {try.#Success actual} - false - - {try.#Failure error} - (exception.match? /.not_ascii error))) - ))))) + (`` (all _.and + (_.cover [/.path /.from_path] + (case (/.path expected) + {try.#Success actual} + (text#= expected + (/.from_path actual)) + + {try.#Failure error} + false)) + (_.cover [/.no_path] + (text#= "" (/.from_path /.no_path))) + (_.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) + {try.#Success actual} + false + + {try.#Failure error} + (exception.match? /.not_ascii error))) + ))))) (def: name Test @@ -79,30 +79,30 @@ invalid (random.ascii/lower (++ /.name_size)) not_ascii (random.text (random.char (unicode.set [unicode/block.katakana (list)])) /.name_size)] - (`` ($_ _.and - (_.cover [/.name /.from_name] - (case (/.name expected) - {try.#Success actual} - (text#= expected - (/.from_name actual)) - - {try.#Failure error} - false)) - (_.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) - {try.#Success actual} - false - - {try.#Failure error} - (exception.match? /.not_ascii error))) - ))))) + (`` (all _.and + (_.cover [/.name /.from_name] + (case (/.name expected) + {try.#Success actual} + (text#= expected + (/.from_name actual)) + + {try.#Failure error} + false)) + (_.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) + {try.#Success actual} + false + + {try.#Failure error} + (exception.match? /.not_ascii error))) + ))))) (def: small Test @@ -110,23 +110,23 @@ (do [! random.monad] [expected (|> random.nat (# ! each (n.% /.small_limit))) invalid (|> random.nat (# ! each (n.max /.small_limit)))] - (`` ($_ _.and - (_.cover [/.small /.from_small] - (case (/.small expected) - {try.#Success actual} - (n.= expected - (/.from_small actual)) - - {try.#Failure error} - false)) - (_.cover [/.small_limit /.not_a_small_number] - (case (/.small invalid) - {try.#Success actual} - false - - {try.#Failure error} - (exception.match? /.not_a_small_number error))) - ))))) + (`` (all _.and + (_.cover [/.small /.from_small] + (case (/.small expected) + {try.#Success actual} + (n.= expected + (/.from_small actual)) + + {try.#Failure error} + false)) + (_.cover [/.small_limit /.not_a_small_number] + (case (/.small invalid) + {try.#Success actual} + false + + {try.#Failure error} + (exception.match? /.not_a_small_number error))) + ))))) (def: big Test @@ -134,23 +134,23 @@ (do [! random.monad] [expected (|> random.nat (# ! each (n.% /.big_limit))) invalid (|> random.nat (# ! each (n.max /.big_limit)))] - (`` ($_ _.and - (_.cover [/.big /.from_big] - (case (/.big expected) - {try.#Success actual} - (n.= expected - (/.from_big actual)) - - {try.#Failure error} - false)) - (_.cover [/.big_limit /.not_a_big_number] - (case (/.big invalid) - {try.#Success actual} - false - - {try.#Failure error} - (exception.match? /.not_a_big_number error))) - ))))) + (`` (all _.and + (_.cover [/.big /.from_big] + (case (/.big expected) + {try.#Success actual} + (n.= expected + (/.from_big actual)) + + {try.#Failure error} + false)) + (_.cover [/.big_limit /.not_a_big_number] + (case (/.big invalid) + {try.#Success actual} + false + + {try.#Failure error} + (exception.match? /.not_a_big_number error))) + ))))) (def: chunk_size 32) @@ -166,61 +166,61 @@ (list.repeated chunks) text.together (# utf8.codec encoded))]] - (`` ($_ _.and - (~~ (template [<type> <tag>] - [(_.cover [<type>] - (|> (do try.monad - [expected_path (/.path expected_path) - tar (|> (sequence.sequence {<tag> expected_path}) - (format.result /.writer) - (<b>.result /.parser))] - (in (case (sequence.list tar) - (pattern (list {<tag> actual_path})) - (text#= (/.from_path expected_path) - (/.from_path actual_path)) - - _ - false))) - (try.else false)))] - - [/.Symbolic_Link /.#Symbolic_Link] - [/.Directory /.#Directory] - )) - (_.for [/.File /.Content /.content /.data] - ($_ _.and - (~~ (template [<type> <tag>] - [(_.cover [<type>] - (|> (do try.monad - [expected_path (/.path expected_path) - expected_content (/.content content) - tar (|> (sequence.sequence {<tag> [expected_path - expected_moment - /.none - [/.#user [/.#name /.anonymous - /.#id /.no_id] - /.#group [/.#name /.anonymous - /.#id /.no_id]] - expected_content]}) - (format.result /.writer) - (<b>.result /.parser))] - (in (case (sequence.list tar) - (pattern (list {<tag> [actual_path actual_moment actual_mode actual_ownership actual_content]})) - (let [seconds (is (-> Instant Int) - (|>> instant.relative (duration.ticks 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)))) - - _ - false))) - (try.else false)))] - - [/.Normal /.#Normal] - [/.Contiguous /.#Contiguous] - )))))))) + (`` (all _.and + (~~ (template [<type> <tag>] + [(_.cover [<type>] + (|> (do try.monad + [expected_path (/.path expected_path) + tar (|> (sequence.sequence {<tag> expected_path}) + (format.result /.writer) + (<b>.result /.parser))] + (in (case (sequence.list tar) + (pattern (list {<tag> actual_path})) + (text#= (/.from_path expected_path) + (/.from_path actual_path)) + + _ + false))) + (try.else false)))] + + [/.Symbolic_Link /.#Symbolic_Link] + [/.Directory /.#Directory] + )) + (_.for [/.File /.Content /.content /.data] + (all _.and + (~~ (template [<type> <tag>] + [(_.cover [<type>] + (|> (do try.monad + [expected_path (/.path expected_path) + expected_content (/.content content) + tar (|> (sequence.sequence {<tag> [expected_path + expected_moment + /.none + [/.#user [/.#name /.anonymous + /.#id /.no_id] + /.#group [/.#name /.anonymous + /.#id /.no_id]] + expected_content]}) + (format.result /.writer) + (<b>.result /.parser))] + (in (case (sequence.list tar) + (pattern (list {<tag> [actual_path actual_moment actual_mode actual_ownership actual_content]})) + (let [seconds (is (-> Instant Int) + (|>> instant.relative (duration.ticks 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)))) + + _ + false))) + (try.else false)))] + + [/.Normal /.#Normal] + [/.Contiguous /.#Contiguous] + )))))))) (def: random_mode (Random /.Mode) @@ -246,71 +246,71 @@ [path (random.ascii/lower 10) modes (random.list 4 ..random_mode) .let [expected_mode (list#mix /.and /.none modes)]] - (`` ($_ _.and - (_.cover [/.and] - (|> (do try.monad - [path (/.path path) - content (/.content (binary.empty 0)) - tar (|> (sequence.sequence {/.#Normal [path - (instant.of_millis +0) - expected_mode - [/.#user [/.#name /.anonymous - /.#id /.no_id] - /.#group [/.#name /.anonymous - /.#id /.no_id]] - content]}) - (format.result /.writer) - (<b>.result /.parser))] - (in (case (sequence.list tar) - (pattern (list {/.#Normal [_ _ actual_mode _ _]})) - (n.= (/.mode expected_mode) - (/.mode actual_mode)) - - _ - false))) - (try.else false))) - (~~ (template [<expected_mode>] - [(_.cover [<expected_mode>] - (|> (do try.monad - [path (/.path path) - content (/.content (binary.empty 0)) - tar (|> (sequence.sequence {/.#Normal [path - (instant.of_millis +0) - <expected_mode> - [/.#user [/.#name /.anonymous - /.#id /.no_id] - /.#group [/.#name /.anonymous - /.#id /.no_id]] - content]}) - (format.result /.writer) - (<b>.result /.parser))] - (in (case (sequence.list tar) - (pattern (list {/.#Normal [_ _ actual_mode _ _]})) - (n.= (/.mode <expected_mode>) - (/.mode actual_mode)) - - _ - false))) - (try.else false)))] - - [/.none] - - [/.execute_by_other] - [/.write_by_other] - [/.read_by_other] - - [/.execute_by_group] - [/.write_by_group] - [/.read_by_group] - - [/.execute_by_owner] - [/.write_by_owner] - [/.read_by_owner] - - [/.save_text] - [/.set_group_id_on_execution] - [/.set_user_id_on_execution] - ))))))) + (`` (all _.and + (_.cover [/.and] + (|> (do try.monad + [path (/.path path) + content (/.content (binary.empty 0)) + tar (|> (sequence.sequence {/.#Normal [path + (instant.of_millis +0) + expected_mode + [/.#user [/.#name /.anonymous + /.#id /.no_id] + /.#group [/.#name /.anonymous + /.#id /.no_id]] + content]}) + (format.result /.writer) + (<b>.result /.parser))] + (in (case (sequence.list tar) + (pattern (list {/.#Normal [_ _ actual_mode _ _]})) + (n.= (/.mode expected_mode) + (/.mode actual_mode)) + + _ + false))) + (try.else false))) + (~~ (template [<expected_mode>] + [(_.cover [<expected_mode>] + (|> (do try.monad + [path (/.path path) + content (/.content (binary.empty 0)) + tar (|> (sequence.sequence {/.#Normal [path + (instant.of_millis +0) + <expected_mode> + [/.#user [/.#name /.anonymous + /.#id /.no_id] + /.#group [/.#name /.anonymous + /.#id /.no_id]] + content]}) + (format.result /.writer) + (<b>.result /.parser))] + (in (case (sequence.list tar) + (pattern (list {/.#Normal [_ _ actual_mode _ _]})) + (n.= (/.mode <expected_mode>) + (/.mode actual_mode)) + + _ + false))) + (try.else false)))] + + [/.none] + + [/.execute_by_other] + [/.write_by_other] + [/.read_by_other] + + [/.execute_by_group] + [/.write_by_group] + [/.read_by_group] + + [/.execute_by_owner] + [/.write_by_owner] + [/.read_by_owner] + + [/.save_text] + [/.set_group_id_on_execution] + [/.set_user_id_on_execution] + ))))))) (def: ownership Test @@ -321,75 +321,75 @@ 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] - (case (/.name invalid) - {try.#Success _} - false - - {try.#Failure error} - (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] - (|> (do try.monad - [path (/.path path) - content (/.content (binary.empty 0)) - expected (/.name expected) - tar (|> (sequence.sequence {/.#Normal [path - (instant.of_millis +0) - /.none - [/.#user [/.#name expected - /.#id /.no_id] - /.#group [/.#name /.anonymous - /.#id /.no_id]] - content]}) - (format.result /.writer) - (<b>.result /.parser))] - (in (case (sequence.list tar) - (pattern (list {/.#Normal [_ _ _ actual_ownership _]})) - (and (text#= (/.from_name expected) - (/.from_name (the [/.#user /.#name] actual_ownership))) - (text#= (/.from_name /.anonymous) - (/.from_name (the [/.#group /.#name] actual_ownership)))) - - _ - false))) - (try.else false))) - (_.cover [/.anonymous /.no_id] - (|> (do try.monad - [path (/.path path) - content (/.content (binary.empty 0)) - tar (|> (sequence.sequence {/.#Normal [path - (instant.of_millis +0) - /.none - [/.#user [/.#name /.anonymous - /.#id /.no_id] - /.#group [/.#name /.anonymous - /.#id /.no_id]] - content]}) - (format.result /.writer) - (<b>.result /.parser))] - (in (case (sequence.list tar) - (pattern (list {/.#Normal [_ _ _ actual_ownership _]})) - (and (text#= (/.from_name /.anonymous) - (/.from_name (the [/.#user /.#name] actual_ownership))) - (n.= (/.from_small /.no_id) - (/.from_small (the [/.#user /.#id] actual_ownership))) - (text#= (/.from_name /.anonymous) - (/.from_name (the [/.#group /.#name] actual_ownership))) - (n.= (/.from_small /.no_id) - (/.from_small (the [/.#group /.#id] actual_ownership)))) - - _ - false))) - (try.else false))) - )))) + (all _.and + (_.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) + {try.#Success actual} + false + + {try.#Failure error} + (exception.match? /.not_ascii error))) + (_.cover [/.Name /.name /.from_name] + (|> (do try.monad + [path (/.path path) + content (/.content (binary.empty 0)) + expected (/.name expected) + tar (|> (sequence.sequence {/.#Normal [path + (instant.of_millis +0) + /.none + [/.#user [/.#name expected + /.#id /.no_id] + /.#group [/.#name /.anonymous + /.#id /.no_id]] + content]}) + (format.result /.writer) + (<b>.result /.parser))] + (in (case (sequence.list tar) + (pattern (list {/.#Normal [_ _ _ actual_ownership _]})) + (and (text#= (/.from_name expected) + (/.from_name (the [/.#user /.#name] actual_ownership))) + (text#= (/.from_name /.anonymous) + (/.from_name (the [/.#group /.#name] actual_ownership)))) + + _ + false))) + (try.else false))) + (_.cover [/.anonymous /.no_id] + (|> (do try.monad + [path (/.path path) + content (/.content (binary.empty 0)) + tar (|> (sequence.sequence {/.#Normal [path + (instant.of_millis +0) + /.none + [/.#user [/.#name /.anonymous + /.#id /.no_id] + /.#group [/.#name /.anonymous + /.#id /.no_id]] + content]}) + (format.result /.writer) + (<b>.result /.parser))] + (in (case (sequence.list tar) + (pattern (list {/.#Normal [_ _ _ actual_ownership _]})) + (and (text#= (/.from_name /.anonymous) + (/.from_name (the [/.#user /.#name] actual_ownership))) + (n.= (/.from_small /.no_id) + (/.from_small (the [/.#user /.#id] actual_ownership))) + (text#= (/.from_name /.anonymous) + (/.from_name (the [/.#group /.#name] actual_ownership))) + (n.= (/.from_small /.no_id) + (/.from_small (the [/.#group /.#id] actual_ownership)))) + + _ + false))) + (try.else false))) + )))) (def: .public test Test @@ -397,30 +397,30 @@ (_.for [/.Tar]) (do random.monad [_ (in [])] - ($_ _.and - (_.cover [/.writer /.parser] - (|> sequence.empty - (format.result /.writer) - (<b>.result /.parser) - (# try.monad each sequence.empty?) - (try.else false))) - (_.cover [/.invalid_end_of_archive] - (let [dump (format.result /.writer sequence.empty)] - (case (<b>.result /.parser (binary#composite dump dump)) - {try.#Success _} - false - - {try.#Failure error} - (exception.match? /.invalid_end_of_archive error)))) - - ..path - ..name - ..small - ..big - (_.for [/.Entry] - ($_ _.and - ..entry - ..mode - ..ownership - )) - )))) + (all _.and + (_.cover [/.writer /.parser] + (|> sequence.empty + (format.result /.writer) + (<b>.result /.parser) + (# try.monad each sequence.empty?) + (try.else false))) + (_.cover [/.invalid_end_of_archive] + (let [dump (format.result /.writer sequence.empty)] + (case (<b>.result /.parser (binary#composite dump dump)) + {try.#Success _} + false + + {try.#Failure error} + (exception.match? /.invalid_end_of_archive error)))) + + ..path + ..name + ..small + ..big + (_.for [/.Entry] + (all _.and + ..entry + ..mode + ..ownership + )) + )))) diff --git a/stdlib/source/test/lux/data/format/xml.lux b/stdlib/source/test/lux/data/format/xml.lux index c547d400c..b4c0e7276 100644 --- a/stdlib/source/test/lux/data/format/xml.lux +++ b/stdlib/source/test/lux/data/format/xml.lux @@ -63,35 +63,35 @@ (random.or (..text 1 10) (do random.monad [size (..size 0 2)] - ($_ random.and - ..symbol - (random.dictionary symbol.hash size ..symbol (..text 0 10)) - (random.list size random))))))) + (all random.and + ..symbol + (random.dictionary symbol.hash size ..symbol (..text 0 10)) + (random.list size random))))))) (def: .public test Test (<| (_.covering /._) (_.for [/.XML]) - ($_ _.and - (_.for [/.equivalence] - ($equivalence.spec /.equivalence ..random)) - (_.for [/.codec] - ($codec.spec /.equivalence /.codec ..random)) + (all _.and + (_.for [/.equivalence] + ($equivalence.spec /.equivalence ..random)) + (_.for [/.codec] + ($codec.spec /.equivalence /.codec ..random)) - (do [! random.monad] - [(^.let symbol [namespace name]) ..symbol] - (`` ($_ _.and - (~~ (template [<type> <format>] - [(_.cover [<type> <format>] - (and (text#= name (<format> ["" name])) - (let [symbol (<format> symbol)] - (and (text.starts_with? namespace symbol) - (text.ends_with? name symbol)))))] + (do [! random.monad] + [(^.let symbol [namespace name]) ..symbol] + (`` (all _.and + (~~ (template [<type> <format>] + [(_.cover [<type> <format>] + (and (text#= name (<format> ["" name])) + (let [symbol (<format> symbol)] + (and (text.starts_with? namespace symbol) + (text.ends_with? name symbol)))))] - [/.Tag /.tag] - [/.Attribute /.attribute] - )) - (_.cover [/.Attrs /.attributes] - (dictionary.empty? /.attributes)) - ))) - ))) + [/.Tag /.tag] + [/.Attribute /.attribute] + )) + (_.cover [/.Attrs /.attributes] + (dictionary.empty? /.attributes)) + ))) + ))) diff --git a/stdlib/source/test/lux/data/identity.lux b/stdlib/source/test/lux/data/identity.lux index 7694292ba..2e8c63f0b 100644 --- a/stdlib/source/test/lux/data/identity.lux +++ b/stdlib/source/test/lux/data/identity.lux @@ -1,16 +1,16 @@ (.using - [library - [lux "*" - ["_" test {"+" Test}] - [abstract - [monad {"+" do}] - [\\specification - ["$[0]" functor {"+" Injection Comparison}] - ["$[0]" apply] - ["$[0]" monad] - ["$[0]" comonad]]]]] - [\\library - ["[0]" / {"+" Identity}]]) + [library + [lux "*" + ["_" test {"+" Test}] + [abstract + [monad {"+" do}] + [\\specification + ["$[0]" functor {"+" Injection Comparison}] + ["$[0]" apply] + ["$[0]" monad] + ["$[0]" comonad]]]]] + [\\library + ["[0]" / {"+" Identity}]]) (def: injection (Injection Identity) @@ -25,13 +25,13 @@ Test (<| (_.covering /._) (_.for [/.Identity]) - ($_ _.and - (_.for [/.functor] - ($functor.spec ..injection ..comparison /.functor)) - (_.for [/.apply] - ($apply.spec ..injection ..comparison /.apply)) - (_.for [/.monad] - ($monad.spec ..injection ..comparison /.monad)) - (_.for [/.comonad] - ($comonad.spec ..injection ..comparison /.comonad)) - ))) + (all _.and + (_.for [/.functor] + ($functor.spec ..injection ..comparison /.functor)) + (_.for [/.apply] + ($apply.spec ..injection ..comparison /.apply)) + (_.for [/.monad] + ($monad.spec ..injection ..comparison /.monad)) + (_.for [/.comonad] + ($comonad.spec ..injection ..comparison /.comonad)) + ))) diff --git a/stdlib/source/test/lux/data/product.lux b/stdlib/source/test/lux/data/product.lux index a16cead5e..a33f53a1d 100644 --- a/stdlib/source/test/lux/data/product.lux +++ b/stdlib/source/test/lux/data/product.lux @@ -1,18 +1,18 @@ (.using - [library - [lux "*" - ["_" test {"+" Test}] - [abstract - [monad {"+" do}] - [\\specification - ["$[0]" equivalence]]] - [math - ["[0]" random] - [number - ["n" nat] - ["i" int]]]]] - [\\library - ["[0]" /]]) + [library + [lux "*" + ["_" test {"+" Test}] + [abstract + [monad {"+" do}] + [\\specification + ["$[0]" equivalence]]] + [math + ["[0]" random] + [number + ["n" nat] + ["i" int]]]]] + [\\library + ["[0]" /]]) (def: .public test Test @@ -23,47 +23,47 @@ shift random.nat dummy (random.only (|>> (n.= expected) not) random.nat)] - ($_ _.and - (_.for [/.equivalence] - ($equivalence.spec (/.equivalence n.equivalence i.equivalence) - (random.and random.nat random.int))) - (do random.monad - [left random.int - right random.nat] - (_.cover [/.hash] - (let [hash (/.hash i.hash n.hash)] - (n.= (n.+ (# i.hash hash left) - (# n.hash hash right)) - (# hash hash [left right]))))) - - (<| (_.cover [/.left]) - (n.= expected (/.left [expected dummy]))) - (<| (_.cover [/.right]) - (n.= expected (/.right [dummy expected]))) - (<| (_.cover [/.forked]) - (let [[left right] ((/.forked (n.+ shift) (n.- shift)) expected)] - (and (n.= (n.+ shift expected) - left) - (n.= (n.- shift expected) - right)))) - (do random.monad - [left random.nat - right random.nat] - ($_ _.and - (<| (_.cover [/.swapped]) - (let [pair [left right]] - (and (n.= (/.left pair) - (/.right (/.swapped pair))) - (n.= (/.right pair) - (/.left (/.swapped pair)))))) - (<| (_.cover [/.uncurried]) - (n.= (n.+ left right) - ((/.uncurried n.+) [left right]))) - (<| (_.cover [/.curried]) - (n.= (n.+ left right) - ((/.curried (/.uncurried n.+)) left right))) - (<| (_.cover [/.then]) - (let [[left' right'] (/.then (n.+ shift) (n.- shift) [left right])] - (and (n.= (n.+ shift left) left') - (n.= (n.- shift right) right')))))) - )))) + (all _.and + (_.for [/.equivalence] + ($equivalence.spec (/.equivalence n.equivalence i.equivalence) + (random.and random.nat random.int))) + (do random.monad + [left random.int + right random.nat] + (_.cover [/.hash] + (let [hash (/.hash i.hash n.hash)] + (n.= (n.+ (# i.hash hash left) + (# n.hash hash right)) + (# hash hash [left right]))))) + + (<| (_.cover [/.left]) + (n.= expected (/.left [expected dummy]))) + (<| (_.cover [/.right]) + (n.= expected (/.right [dummy expected]))) + (<| (_.cover [/.forked]) + (let [[left right] ((/.forked (n.+ shift) (n.- shift)) expected)] + (and (n.= (n.+ shift expected) + left) + (n.= (n.- shift expected) + right)))) + (do random.monad + [left random.nat + right random.nat] + (all _.and + (<| (_.cover [/.swapped]) + (let [pair [left right]] + (and (n.= (/.left pair) + (/.right (/.swapped pair))) + (n.= (/.right pair) + (/.left (/.swapped pair)))))) + (<| (_.cover [/.uncurried]) + (n.= (n.+ left right) + ((/.uncurried n.+) [left right]))) + (<| (_.cover [/.curried]) + (n.= (n.+ left right) + ((/.curried (/.uncurried n.+)) left right))) + (<| (_.cover [/.then]) + (let [[left' right'] (/.then (n.+ shift) (n.- shift) [left right])] + (and (n.= (n.+ shift left) left') + (n.= (n.- shift right) right')))))) + )))) diff --git a/stdlib/source/test/lux/data/sum.lux b/stdlib/source/test/lux/data/sum.lux index 6d9e6cc5e..ec9e7d67d 100644 --- a/stdlib/source/test/lux/data/sum.lux +++ b/stdlib/source/test/lux/data/sum.lux @@ -28,79 +28,79 @@ (do [! random.monad] [expected random.nat shift random.nat] - ($_ _.and - (_.for [/.equivalence] - ($equivalence.spec (/.equivalence n.equivalence n.equivalence) - (random.or random.nat random.nat))) - (_.for [/.hash] - ($hash.spec (/.hash n.hash n.hash) - (random.or random.nat random.nat))) + (all _.and + (_.for [/.equivalence] + ($equivalence.spec (/.equivalence n.equivalence n.equivalence) + (random.or random.nat random.nat))) + (_.for [/.hash] + ($hash.spec (/.hash n.hash n.hash) + (random.or random.nat random.nat))) - (_.cover [/.left] - (|> (/.left expected) - (is (Or Nat Nat)) - (pipe.case - {0 #0 actual} (n.= expected actual) - _ false))) - (_.cover [/.right] - (|> (/.right expected) - (is (Or Nat Nat)) - (pipe.case - {0 #1 actual} (n.= expected actual) - _ false))) - (_.cover [/.either] - (and (|> (/.left expected) - (is (Or Nat Nat)) - (/.either (n.+ shift) (n.- shift)) - (n.= (n.+ shift expected))) - (|> (/.right expected) - (is (Or Nat Nat)) - (/.either (n.+ shift) (n.- shift)) - (n.= (n.- shift expected))))) - (_.cover [/.then] - (and (|> (/.left expected) - (is (Or Nat Nat)) - (/.then (n.+ shift) (n.- shift)) - (pipe.case {0 #0 actual} (n.= (n.+ shift expected) actual) _ false)) - (|> (/.right expected) - (is (Or Nat Nat)) - (/.then (n.+ shift) (n.- shift)) - (pipe.case {0 #1 actual} (n.= (n.- shift expected) actual) _ false)))) - (do ! - [size (# ! each (n.% 5) random.nat) - expected (random.list size random.nat)] - ($_ _.and - (_.cover [/.lefts] - (let [actual (is (List (Or Nat Nat)) - (list#each /.left expected))] - (and (# (list.equivalence n.equivalence) = - expected - (/.lefts actual)) - (# (list.equivalence n.equivalence) = - (list) - (/.rights actual))))) - (_.cover [/.rights] - (let [actual (is (List (Or Nat Nat)) - (list#each /.right expected))] - (and (# (list.equivalence n.equivalence) = - expected - (/.rights actual)) - (# (list.equivalence n.equivalence) = - (list) - (/.lefts actual))))) - (_.cover [/.partition] - (let [[lefts rights] (|> expected - (list#each (function (_ value) - (if (n.even? value) - (/.left value) - (/.right value)))) - (is (List (Or Nat Nat))) - /.partition)] - (and (# (list.equivalence n.equivalence) = - (list.only n.even? expected) - lefts) - (# (list.equivalence n.equivalence) = - (list.only (|>> n.even? not) expected) - rights)))) - )) - )))) + (_.cover [/.left] + (|> (/.left expected) + (is (Or Nat Nat)) + (pipe.case + {0 #0 actual} (n.= expected actual) + _ false))) + (_.cover [/.right] + (|> (/.right expected) + (is (Or Nat Nat)) + (pipe.case + {0 #1 actual} (n.= expected actual) + _ false))) + (_.cover [/.either] + (and (|> (/.left expected) + (is (Or Nat Nat)) + (/.either (n.+ shift) (n.- shift)) + (n.= (n.+ shift expected))) + (|> (/.right expected) + (is (Or Nat Nat)) + (/.either (n.+ shift) (n.- shift)) + (n.= (n.- shift expected))))) + (_.cover [/.then] + (and (|> (/.left expected) + (is (Or Nat Nat)) + (/.then (n.+ shift) (n.- shift)) + (pipe.case {0 #0 actual} (n.= (n.+ shift expected) actual) _ false)) + (|> (/.right expected) + (is (Or Nat Nat)) + (/.then (n.+ shift) (n.- shift)) + (pipe.case {0 #1 actual} (n.= (n.- shift expected) actual) _ false)))) + (do ! + [size (# ! each (n.% 5) random.nat) + expected (random.list size random.nat)] + (all _.and + (_.cover [/.lefts] + (let [actual (is (List (Or Nat Nat)) + (list#each /.left expected))] + (and (# (list.equivalence n.equivalence) = + expected + (/.lefts actual)) + (# (list.equivalence n.equivalence) = + (list) + (/.rights actual))))) + (_.cover [/.rights] + (let [actual (is (List (Or Nat Nat)) + (list#each /.right expected))] + (and (# (list.equivalence n.equivalence) = + expected + (/.rights actual)) + (# (list.equivalence n.equivalence) = + (list) + (/.lefts actual))))) + (_.cover [/.partition] + (let [[lefts rights] (|> expected + (list#each (function (_ value) + (if (n.even? value) + (/.left value) + (/.right value)))) + (is (List (Or Nat Nat))) + /.partition)] + (and (# (list.equivalence n.equivalence) = + (list.only n.even? expected) + lefts) + (# (list.equivalence n.equivalence) = + (list.only (|>> n.even? not) expected) + rights)))) + )) + )))) diff --git a/stdlib/source/test/lux/data/text.lux b/stdlib/source/test/lux/data/text.lux index 8825bc192..00bcfb12d 100644 --- a/stdlib/source/test/lux/data/text.lux +++ b/stdlib/source/test/lux/data/text.lux @@ -41,12 +41,12 @@ (do [! random.monad] [size (# ! each (n.% 10) random.nat) sample (random.unicode size)] - ($_ _.and - (_.cover [/.size] - (n.= size (/.size sample))) - (_.cover [/.empty?] - (or (/.empty? sample) - (not (n.= 0 size))))))) + (all _.and + (_.cover [/.size] + (n.= size (/.size sample))) + (_.cover [/.empty?] + (or (/.empty? sample) + (not (n.= 0 size))))))) (def: affix Test @@ -58,24 +58,24 @@ right (random.unicode 1) .let [full (# /.monoid composite inner outer) fake_index (-- 0)]] - (`` ($_ _.and - (~~ (template [<affix> <predicate>] - [(_.cover [<affix> <predicate>] - (<predicate> outer (<affix> outer inner)))] + (`` (all _.and + (~~ (template [<affix> <predicate>] + [(_.cover [<affix> <predicate>] + (<predicate> outer (<affix> outer inner)))] - [/.prefix /.starts_with?] - [/.suffix /.ends_with?] - [/.enclosed' /.enclosed_by?] - )) - (_.cover [/.enclosed] - (let [value (/.enclosed [left right] inner)] - (and (/.starts_with? left value) - (/.ends_with? right value)))) - (_.cover [/.format] - (let [sample (/.format inner)] - (and (/.enclosed_by? /.double_quote sample) - (/.contains? inner sample)))) - )))) + [/.prefix /.starts_with?] + [/.suffix /.ends_with?] + [/.enclosed' /.enclosed_by?] + )) + (_.cover [/.enclosed] + (let [value (/.enclosed [left right] inner)] + (and (/.starts_with? left value) + (/.ends_with? right value)))) + (_.cover [/.format] + (let [sample (/.format inner)] + (and (/.enclosed_by? /.double_quote sample) + (/.contains? inner sample)))) + )))) (def: index Test @@ -84,96 +84,96 @@ outer (random.only (|>> (# /.equivalence = inner) not) (random.unicode 1)) .let [fake_index (-- 0)]] - ($_ _.and - (_.cover [/.contains?] - (let [full (# /.monoid composite inner outer)] - (and (/.contains? inner full) - (/.contains? outer full)))) - (_.cover [/.index] - (and (|> (/.index inner (# /.monoid composite inner outer)) - (maybe.else fake_index) - (n.= 0)) - (|> (/.index outer (# /.monoid composite inner outer)) - (maybe.else fake_index) - (n.= 1)))) - (_.cover [/.index_since] - (let [full (# /.monoid composite inner outer)] - (and (|> (/.index_since 0 inner full) - (maybe.else fake_index) - (n.= 0)) - (|> (/.index_since 1 inner full) - (maybe.else fake_index) - (n.= fake_index)) - - (|> (/.index_since 0 outer full) - (maybe.else fake_index) - (n.= 1)) - (|> (/.index_since 1 outer full) - (maybe.else fake_index) - (n.= 1)) - (|> (/.index_since 2 outer full) - (maybe.else fake_index) - (n.= fake_index))))) - (_.cover [/.last_index] - (let [full ($_ (# /.monoid composite) outer inner outer)] - (and (|> (/.last_index inner full) - (maybe.else fake_index) - (n.= 1)) - (|> (/.last_index outer full) - (maybe.else fake_index) - (n.= 2))))) - ))) + (all _.and + (_.cover [/.contains?] + (let [full (# /.monoid composite inner outer)] + (and (/.contains? inner full) + (/.contains? outer full)))) + (_.cover [/.index] + (and (|> (/.index inner (# /.monoid composite inner outer)) + (maybe.else fake_index) + (n.= 0)) + (|> (/.index outer (# /.monoid composite inner outer)) + (maybe.else fake_index) + (n.= 1)))) + (_.cover [/.index_since] + (let [full (# /.monoid composite inner outer)] + (and (|> (/.index_since 0 inner full) + (maybe.else fake_index) + (n.= 0)) + (|> (/.index_since 1 inner full) + (maybe.else fake_index) + (n.= fake_index)) + + (|> (/.index_since 0 outer full) + (maybe.else fake_index) + (n.= 1)) + (|> (/.index_since 1 outer full) + (maybe.else fake_index) + (n.= 1)) + (|> (/.index_since 2 outer full) + (maybe.else fake_index) + (n.= fake_index))))) + (_.cover [/.last_index] + (let [full (all (# /.monoid composite) outer inner outer)] + (and (|> (/.last_index inner full) + (maybe.else fake_index) + (n.= 1)) + (|> (/.last_index outer full) + (maybe.else fake_index) + (n.= 2))))) + ))) (def: char Test - ($_ _.and - (_.for [/.Char /.of_char] - (`` ($_ _.and - (~~ (template [<short> <long>] - [(_.cover [<short> <long>] - (# /.equivalence = <short> <long>))] + (all _.and + (_.for [/.Char /.of_char] + (`` (all _.and + (~~ (template [<short> <long>] + [(_.cover [<short> <long>] + (# /.equivalence = <short> <long>))] - [/.\0 /.null] - [/.\a /.alarm] - [/.\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)) - ))) - (do [! random.monad] - [size (# ! each (|>> (n.% 10) ++) random.nat) - characters (random.set /.hash size (random.ascii/alpha 1)) - .let [sample (|> characters set.list /.together)] - expected (# ! each (n.% size) random.nat)] - (_.cover [/.char] - (case (/.char expected sample) - {.#Some char} - (case (/.index (/.of_char char) sample) - {.#Some actual} - (n.= expected actual) + [/.\0 /.null] + [/.\a /.alarm] + [/.\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)) + ))) + (do [! random.monad] + [size (# ! each (|>> (n.% 10) ++) random.nat) + characters (random.set /.hash size (random.ascii/alpha 1)) + .let [sample (|> characters set.list /.together)] + expected (# ! each (n.% size) random.nat)] + (_.cover [/.char] + (case (/.char expected sample) + {.#Some char} + (case (/.index (/.of_char char) sample) + {.#Some actual} + (n.= expected actual) - _ - false) - - {.#None} - false))) - (_.cover [/.space /.space?] - (`` (and (~~ (template [<char>] - [(/.space? (`` (.char (~~ (static <char>)))))] - - [/.tab] - [/.vertical_tab] - [/.space] - [/.new_line] - [/.carriage_return] - [/.form_feed] - ))))) - )) + _ + false) + + {.#None} + false))) + (_.cover [/.space /.space?] + (`` (and (~~ (template [<char>] + [(/.space? (`` (.char (~~ (static <char>)))))] + + [/.tab] + [/.vertical_tab] + [/.space] + [/.new_line] + [/.carriage_return] + [/.form_feed] + ))))) + )) (def: manipulation Test @@ -191,150 +191,150 @@ lower (random.ascii/lower 1) upper (random.ascii/upper 1)] - ($_ _.and - (_.cover [/.together] - (n.= (set.size characters) - (/.size (/.together (set.list characters))))) - (_.cover [/.interposed /.all_split_by] - (and (|> (set.list characters) - (/.interposed separator) - (/.all_split_by separator) - (set.of_list /.hash) - (# set.equivalence = characters)) - (# /.equivalence = - (/.together (set.list characters)) - (/.interposed "" (set.list characters))))) - (_.cover [/.replaced_once] - (# /.equivalence = - (# /.monoid composite post static) - (/.replaced_once pre post (# /.monoid composite pre static)))) - (_.cover [/.split_by] - (case (/.split_by static ($_ (# /.monoid composite) pre static post)) - {.#Some [left right]} - (and (# /.equivalence = pre left) - (# /.equivalence = post right)) - - {.#None} - false)) - (_.cover [/.lower_cased] - (let [effectiveness! - (|> upper - /.lower_cased - (# /.equivalence = upper) - not) + (all _.and + (_.cover [/.together] + (n.= (set.size characters) + (/.size (/.together (set.list characters))))) + (_.cover [/.interposed /.all_split_by] + (and (|> (set.list characters) + (/.interposed separator) + (/.all_split_by separator) + (set.of_list /.hash) + (# set.equivalence = characters)) + (# /.equivalence = + (/.together (set.list characters)) + (/.interposed "" (set.list characters))))) + (_.cover [/.replaced_once] + (# /.equivalence = + (# /.monoid composite post static) + (/.replaced_once pre post (# /.monoid composite pre static)))) + (_.cover [/.split_by] + (case (/.split_by static (all (# /.monoid composite) pre static post)) + {.#Some [left right]} + (and (# /.equivalence = pre left) + (# /.equivalence = post right)) + + {.#None} + false)) + (_.cover [/.lower_cased] + (let [effectiveness! + (|> upper + /.lower_cased + (# /.equivalence = upper) + not) - idempotence! - (|> lower - /.lower_cased - (# /.equivalence = lower)) - - inverse! - (|> lower - /.upper_cased - /.lower_cased - (# /.equivalence = lower))] - (and effectiveness! idempotence! - inverse!))) - (_.cover [/.upper_cased] - (let [effectiveness! - (|> lower - /.upper_cased - (# /.equivalence = lower) - not) + (|> lower + /.lower_cased + (# /.equivalence = lower)) + + inverse! + (|> lower + /.upper_cased + /.lower_cased + (# /.equivalence = lower))] + (and effectiveness! + idempotence! + inverse!))) + (_.cover [/.upper_cased] + (let [effectiveness! + (|> lower + /.upper_cased + (# /.equivalence = lower) + not) - idempotence! - (|> upper - /.upper_cased - (# /.equivalence = upper)) - - inverse! - (|> upper - /.lower_cased - /.upper_cased - (# /.equivalence = upper))] - (and effectiveness! idempotence! - inverse!))) - ))) + (|> upper + /.upper_cased + (# /.equivalence = upper)) + + inverse! + (|> upper + /.lower_cased + /.upper_cased + (# /.equivalence = upper))] + (and effectiveness! + idempotence! + inverse!))) + ))) (def: .public test Test (<| (_.covering /._) (_.for [.Text]) - ($_ _.and - (_.for [/.equivalence] - ($equivalence.spec /.equivalence (random.ascii 2))) - (_.for [/.hash] - ($hash.spec /.hash (random.ascii 1))) - (_.for [/.order] - ($order.spec /.order (random.ascii 2))) - (_.for [/.monoid] - ($monoid.spec /.equivalence /.monoid (random.ascii 2))) + (all _.and + (_.for [/.equivalence] + ($equivalence.spec /.equivalence (random.ascii 2))) + (_.for [/.hash] + ($hash.spec /.hash (random.ascii 1))) + (_.for [/.order] + ($order.spec /.order (random.ascii 2))) + (_.for [/.monoid] + ($monoid.spec /.equivalence /.monoid (random.ascii 2))) - ..size - ..affix - ..index - ..char - ..manipulation - - (do random.monad - [sizeL bounded_size - sizeR bounded_size - sampleL (random.unicode sizeL) - sampleR (random.unicode sizeR) - middle (random.unicode 1) - .let [sample (/.together (list sampleL sampleR)) - (open "/#[0]") /.equivalence]] - ($_ _.and - (_.cover [/.split_at] - (|> (/.split_at sizeL sample) - (pipe.case - {.#Right [_l _r]} - (and (/#= sampleL _l) - (/#= sampleR _r) - (/#= sample (/.together (list _l _r)))) + ..size + ..affix + ..index + ..char + ..manipulation + + (do random.monad + [sizeL bounded_size + sizeR bounded_size + sampleL (random.unicode sizeL) + sampleR (random.unicode sizeR) + middle (random.unicode 1) + .let [sample (/.together (list sampleL sampleR)) + (open "/#[0]") /.equivalence]] + (all _.and + (_.cover [/.split_at] + (|> (/.split_at sizeL sample) + (pipe.case + {.#Right [_l _r]} + (and (/#= sampleL _l) + (/#= sampleR _r) + (/#= sample (/.together (list _l _r)))) - _ - #0))) - (_.cover [/.clip /.clip_since] - (|> [(/.clip 0 sizeL sample) - (/.clip sizeL (n.- sizeL (/.size sample)) sample) - (/.clip_since sizeL sample) - (/.clip_since 0 sample)] - (pipe.case - [{.#Right _l} {.#Right _r} {.#Right _r'} {.#Right _f}] - (and (/#= sampleL _l) - (/#= sampleR _r) - (/#= _r _r') - (/#= sample _f)) + _ + #0))) + (_.cover [/.clip /.clip_since] + (|> [(/.clip 0 sizeL sample) + (/.clip sizeL (n.- sizeL (/.size sample)) sample) + (/.clip_since sizeL sample) + (/.clip_since 0 sample)] + (pipe.case + [{.#Right _l} {.#Right _r} {.#Right _r'} {.#Right _f}] + (and (/#= sampleL _l) + (/#= sampleR _r) + (/#= _r _r') + (/#= sample _f)) - _ - #0))) - )) - (do [! random.monad] - [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 (# ! each (|>> (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.only (|>> (/.contains? sep1) not)))] - parts (random.list sizeL part_gen) - .let [sample1 (/.together (list.interposed sep1 parts)) - sample2 (/.together (list.interposed sep2 parts)) - (open "/#[0]") /.equivalence]] - (_.cover [/.replaced] - (/#= sample2 - (/.replaced sep1 sep2 sample1)))) + _ + #0))) + )) + (do [! random.monad] + [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 (# ! each (|>> (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.only (|>> (/.contains? sep1) not)))] + parts (random.list sizeL part_gen) + .let [sample1 (/.together (list.interposed sep1 parts)) + sample2 (/.together (list.interposed sep2 parts)) + (open "/#[0]") /.equivalence]] + (_.cover [/.replaced] + (/#= sample2 + (/.replaced sep1 sep2 sample1)))) - /buffer.test - /encoding.test - /format.test - /regex.test - /escape.test - /unicode.test - ))) + /buffer.test + /encoding.test + /format.test + /regex.test + /escape.test + /unicode.test + ))) diff --git a/stdlib/source/test/lux/data/text/buffer.lux b/stdlib/source/test/lux/data/text/buffer.lux index 1e5946104..dbe4732df 100644 --- a/stdlib/source/test/lux/data/text/buffer.lux +++ b/stdlib/source/test/lux/data/text/buffer.lux @@ -1,18 +1,18 @@ (.using - [library - [lux "*" - ["_" test {"+" Test}] - [abstract - [monad {"+" do}]] - [data - ["[0]" text ("[1]#[0]" equivalence) - ["%" format {"+" format}]]] - [math - ["[0]" random {"+" Random}] - [number - ["n" nat]]]]] - [\\library - ["[0]" /]]) + [library + [lux "*" + ["_" test {"+" Test}] + [abstract + [monad {"+" do}]] + [data + ["[0]" text ("[1]#[0]" equivalence) + ["%" format {"+" format}]]] + [math + ["[0]" random {"+" Random}] + [number + ["n" nat]]]]] + [\\library + ["[0]" /]]) (def: part (Random Text) @@ -28,17 +28,17 @@ [left ..part mid ..part right ..part] - ($_ _.and - (_.cover [/.empty] - (n.= 0(/.size /.empty))) - (_.cover [/.size /.then] - (n.= (text.size left) - (/.size (/.then left /.empty)))) - (_.cover [/.text] - (text#= (format left mid right) - (|> /.empty - (/.then left) - (/.then mid) - (/.then right) - /.text))) - )))) + (all _.and + (_.cover [/.empty] + (n.= 0(/.size /.empty))) + (_.cover [/.size /.then] + (n.= (text.size left) + (/.size (/.then left /.empty)))) + (_.cover [/.text] + (text#= (format left mid right) + (|> /.empty + (/.then left) + (/.then mid) + (/.then right) + /.text))) + )))) diff --git a/stdlib/source/test/lux/data/text/encoding.lux b/stdlib/source/test/lux/data/text/encoding.lux index 6317fef10..eaa9b6aba 100644 --- a/stdlib/source/test/lux/data/text/encoding.lux +++ b/stdlib/source/test/lux/data/text/encoding.lux @@ -221,12 +221,12 @@ Test (<| (_.covering /._) (_.for [/.Encoding]) - (`` ($_ _.and - (~~ (template [<definition> <by_letter>] - [<definition>] - - <encodings>)) + (`` (all _.and + (~~ (template [<definition> <by_letter>] + [<definition>] + + <encodings>)) - /utf8.test - )))) + /utf8.test + )))) ) diff --git a/stdlib/source/test/lux/data/text/escape.lux b/stdlib/source/test/lux/data/text/escape.lux index 6abb32e94..c7fb6d2fc 100644 --- a/stdlib/source/test/lux/data/text/escape.lux +++ b/stdlib/source/test/lux/data/text/escape.lux @@ -82,76 +82,76 @@ (def: .public test Test (<| (_.covering /._) - ($_ _.and - (do random.monad - [ascii ..ascii_range] - (_.cover [/.escapable?] - (`` (if (or (~~ (template [<char>] - [(n.= (debug.private <char>) ascii)] - - [/.\0] [/.\a] [/.\b] [/.\t] - [/.\n] [/.\v] [/.\f] [/.\r] - [/.\''] [/.\\]))) - (/.escapable? ascii) - (bit#= (/.escapable? ascii) - (or (n.< (debug.private /.ascii_bottom) ascii) - (n.> (debug.private /.ascii_top) ascii))))))) - (do random.monad - [left (random.char unicode.character) - right (random.char unicode.character)] - (_.cover [/.escaped /.un_escaped] - (let [expected (format (text.of_char left) (text.of_char right))] - (if (or (/.escapable? left) - (/.escapable? right)) - (let [escaped (/.escaped expected)] - (case (/.un_escaped escaped) - {try.#Success un_escaped} - (and (not (text#= escaped expected)) - (text#= un_escaped expected)) - - {try.#Failure error} - false)) - (text#= expected (/.escaped expected)))))) - (do [! random.monad] - [dummy (|> (random.char unicode.character) - (# ! each text.of_char))] - (_.cover [/.dangling_escape] - (case (/.un_escaped (format (/.escaped dummy) "\")) - {try.#Success _} - false + (all _.and + (do random.monad + [ascii ..ascii_range] + (_.cover [/.escapable?] + (`` (if (or (~~ (template [<char>] + [(n.= (debug.private <char>) ascii)] + + [/.\0] [/.\a] [/.\b] [/.\t] + [/.\n] [/.\v] [/.\f] [/.\r] + [/.\''] [/.\\]))) + (/.escapable? ascii) + (bit#= (/.escapable? ascii) + (or (n.< (debug.private /.ascii_bottom) ascii) + (n.> (debug.private /.ascii_top) ascii))))))) + (do random.monad + [left (random.char unicode.character) + right (random.char unicode.character)] + (_.cover [/.escaped /.un_escaped] + (let [expected (format (text.of_char left) (text.of_char right))] + (if (or (/.escapable? left) + (/.escapable? right)) + (let [escaped (/.escaped expected)] + (case (/.un_escaped escaped) + {try.#Success un_escaped} + (and (not (text#= escaped expected)) + (text#= un_escaped expected)) + + {try.#Failure error} + false)) + (text#= expected (/.escaped expected)))))) + (do [! random.monad] + [dummy (|> (random.char unicode.character) + (# ! each text.of_char))] + (_.cover [/.dangling_escape] + (case (/.un_escaped (format (/.escaped dummy) "\")) + {try.#Success _} + false - {try.#Failure error} - (exception.match? /.dangling_escape error)))) - (do [! random.monad] - [dummy (|> (random.char unicode.character) - (random.only (|>> (set.member? ..valid_sigils) not)) - (# ! each text.of_char))] - (_.cover [/.invalid_escape] - (case (/.un_escaped (format "\" dummy)) - {try.#Success _} - false + {try.#Failure error} + (exception.match? /.dangling_escape error)))) + (do [! random.monad] + [dummy (|> (random.char unicode.character) + (random.only (|>> (set.member? ..valid_sigils) not)) + (# ! each text.of_char))] + (_.cover [/.invalid_escape] + (case (/.un_escaped (format "\" dummy)) + {try.#Success _} + false - {try.#Failure error} - (exception.match? /.invalid_escape error)))) - (do [! random.monad] - [too_short (|> (random.char unicode.character) - (# ! each (n.% (hex "1000")))) - code (|> (random.unicode 4) - (random.only (function (_ code) - (case (# n.hex decoded code) - {try.#Failure error} true - {try.#Success _} false))))] - (_.cover [/.invalid_unicode_escape] - (template.let [(!invalid <code>) - [(case (/.un_escaped (format "\u" <code>)) - {try.#Success _} - false + {try.#Failure error} + (exception.match? /.invalid_escape error)))) + (do [! random.monad] + [too_short (|> (random.char unicode.character) + (# ! each (n.% (hex "1000")))) + code (|> (random.unicode 4) + (random.only (function (_ code) + (case (# n.hex decoded code) + {try.#Failure error} true + {try.#Success _} false))))] + (_.cover [/.invalid_unicode_escape] + (template.let [(!invalid <code>) + [(case (/.un_escaped (format "\u" <code>)) + {try.#Success _} + false - {try.#Failure error} - (exception.match? /.invalid_unicode_escape error))]] - (and (!invalid (# n.hex encoded too_short)) - (!invalid code))))) - (_.cover [/.literal] - (with_expansions [<example> (..static_sample)] - (text#= <example> (`` (/.literal (~~ (..static_escaped <example>))))))) - ))) + {try.#Failure error} + (exception.match? /.invalid_unicode_escape error))]] + (and (!invalid (# n.hex encoded too_short)) + (!invalid code))))) + (_.cover [/.literal] + (with_expansions [<example> (..static_sample)] + (text#= <example> (`` (/.literal (~~ (..static_escaped <example>))))))) + ))) diff --git a/stdlib/source/test/lux/data/text/format.lux b/stdlib/source/test/lux/data/text/format.lux index 62dfcd17d..5ac493e4e 100644 --- a/stdlib/source/test/lux/data/text/format.lux +++ b/stdlib/source/test/lux/data/text/format.lux @@ -62,125 +62,125 @@ (def: random_contravariant (Random (Ex (_ a) [(/.Format a) (Random a)])) - ($_ random.either - (random#in [/.bit random.bit]) - (random#in [/.nat random.nat]) - (random#in [/.int random.int]) - (random#in [/.rev random.rev]) - (random#in [/.frac random.frac]) - )) + (all random.either + (random#in [/.bit random.bit]) + (random#in [/.nat random.nat]) + (random#in [/.int random.int]) + (random#in [/.rev random.rev]) + (random#in [/.frac random.frac]) + )) (def: codec Test - (`` ($_ _.and - (~~ (template [<format> <codec> <random>] - [(do random.monad - [sample <random>] - (_.cover [<format>] - (text#= (# <codec> encoded sample) - (<format> sample))))] + (`` (all _.and + (~~ (template [<format> <codec> <random>] + [(do random.monad + [sample <random>] + (_.cover [<format>] + (text#= (# <codec> encoded sample) + (<format> sample))))] - [/.bit bit.codec random.bit] - [/.nat nat.decimal random.nat] - [/.int int.decimal random.int] - [/.rev rev.decimal random.rev] - [/.frac frac.decimal random.frac] - [/.ratio ratio.codec random.ratio] - [/.symbol symbol.codec ($///symbol.random 5 5)] - [/.xml xml.codec $///xml.random] - [/.json json.codec $///json.random] - [/.day day.codec random.day] - [/.month month.codec random.month] - [/.instant instant.codec random.instant] - [/.duration duration.codec random.duration] - [/.date date.codec random.date] - [/.time time.codec random.time] - - [/.nat_2 nat.binary random.nat] - [/.nat_8 nat.octal random.nat] - [/.nat_10 nat.decimal random.nat] - [/.nat_16 nat.hex random.nat] - - [/.int_2 int.binary random.int] - [/.int_8 int.octal random.int] - [/.int_10 int.decimal random.int] - [/.int_16 int.hex random.int] - - [/.rev_2 rev.binary random.rev] - [/.rev_8 rev.octal random.rev] - [/.rev_10 rev.decimal random.rev] - [/.rev_16 rev.hex random.rev] - - [/.frac_2 frac.binary random.frac] - [/.frac_8 frac.octal random.frac] - [/.frac_10 frac.decimal random.frac] - [/.frac_16 frac.hex random.frac] - )) - ))) + [/.bit bit.codec random.bit] + [/.nat nat.decimal random.nat] + [/.int int.decimal random.int] + [/.rev rev.decimal random.rev] + [/.frac frac.decimal random.frac] + [/.ratio ratio.codec random.ratio] + [/.symbol symbol.codec ($///symbol.random 5 5)] + [/.xml xml.codec $///xml.random] + [/.json json.codec $///json.random] + [/.day day.codec random.day] + [/.month month.codec random.month] + [/.instant instant.codec random.instant] + [/.duration duration.codec random.duration] + [/.date date.codec random.date] + [/.time time.codec random.time] + + [/.nat_2 nat.binary random.nat] + [/.nat_8 nat.octal random.nat] + [/.nat_10 nat.decimal random.nat] + [/.nat_16 nat.hex random.nat] + + [/.int_2 int.binary random.int] + [/.int_8 int.octal random.int] + [/.int_10 int.decimal random.int] + [/.int_16 int.hex random.int] + + [/.rev_2 rev.binary random.rev] + [/.rev_8 rev.octal random.rev] + [/.rev_10 rev.decimal random.rev] + [/.rev_16 rev.hex random.rev] + + [/.frac_2 frac.binary random.frac] + [/.frac_8 frac.octal random.frac] + [/.frac_10 frac.decimal random.frac] + [/.frac_16 frac.hex random.frac] + )) + ))) (def: .public test Test (<| (_.covering /._) (_.for [/.Format]) - (`` ($_ _.and - (_.for [/.functor] - (do random.monad - [[format random] ..random_contravariant - example random] - ($contravariant.spec (..equivalence example) - format - /.functor))) - - (do random.monad - [left (random.unicode 5) - mid (random.unicode 5) - right (random.unicode 5)] - (_.cover [/.format] - (text#= (/.format left mid right) - ($_ "lux text concat" left mid right)))) - ..codec - (~~ (template [<format> <alias> <random>] - [(do random.monad - [sample <random>] - (_.cover [<format>] - (text#= (<alias> sample) - (<format> sample))))] + (`` (all _.and + (_.for [/.functor] + (do random.monad + [[format random] ..random_contravariant + example random] + ($contravariant.spec (..equivalence example) + format + /.functor))) + + (do random.monad + [left (random.unicode 5) + mid (random.unicode 5) + right (random.unicode 5)] + (_.cover [/.format] + (text#= (/.format left mid right) + (all "lux text concat" left mid right)))) + ..codec + (~~ (template [<format> <alias> <random>] + [(do random.monad + [sample <random>] + (_.cover [<format>] + (text#= (<alias> sample) + (<format> sample))))] - [/.text text.format (random.unicode 5)] - [/.code code.format $///code.random] - [/.type type.format ($///type.random 0)] - [/.location location.format - ($_ random.and - (random.unicode 5) - random.nat - random.nat)] - )) - (do random.monad - [members (random.list 5 random.nat)] - (_.cover [/.list] - (text#= (/.list /.nat members) - (|> members - (list#each /.nat) - (text.interposed " ") - list - (/.list (|>>)))))) - (do random.monad - [sample (random.maybe random.nat)] - (_.cover [/.maybe] - (case sample - {.#None} - true - - {.#Some value} - (text.contains? (/.nat value) - (/.maybe /.nat sample))))) - (do [! random.monad] - [modulus (random.one (|>> modulus.modulus - try.maybe) - random.int) - sample (# ! each (modular.modular modulus) - random.int)] - (_.cover [/.mod] - (text#= (# (modular.codec modulus) encoded sample) - (/.mod sample)))) - )))) + [/.text text.format (random.unicode 5)] + [/.code code.format $///code.random] + [/.type type.format ($///type.random 0)] + [/.location location.format + (all random.and + (random.unicode 5) + random.nat + random.nat)] + )) + (do random.monad + [members (random.list 5 random.nat)] + (_.cover [/.list] + (text#= (/.list /.nat members) + (|> members + (list#each /.nat) + (text.interposed " ") + list + (/.list (|>>)))))) + (do random.monad + [sample (random.maybe random.nat)] + (_.cover [/.maybe] + (case sample + {.#None} + true + + {.#Some value} + (text.contains? (/.nat value) + (/.maybe /.nat sample))))) + (do [! random.monad] + [modulus (random.one (|>> modulus.modulus + try.maybe) + random.int) + sample (# ! each (modular.modular modulus) + random.int)] + (_.cover [/.mod] + (text#= (# (modular.codec modulus) encoded sample) + (/.mod sample)))) + )))) diff --git a/stdlib/source/test/lux/data/text/regex.lux b/stdlib/source/test/lux/data/text/regex.lux index 58c26d067..a9f5d8cc4 100644 --- a/stdlib/source/test/lux/data/text/regex.lux +++ b/stdlib/source/test/lux/data/text/regex.lux @@ -78,120 +78,120 @@ (def: system_character_classes Test - ($_ _.and - (_.test "Can parse anything." - (should_pass (/.regex ".") "a")) + (all _.and + (_.test "Can parse anything." + (should_pass (/.regex ".") "a")) - (_.test "Can parse digits." - (and (should_pass (/.regex "\d") "0") - (should_fail (/.regex "\d") "m"))) + (_.test "Can parse digits." + (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"))) + (_.test "Can parse non digits." + (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"))) + (_.test "Can parse white-space." + (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") " "))) + (_.test "Can parse non white-space." + (and (should_pass (/.regex "\S") "m") + (should_fail (/.regex "\S") " "))) - (_.test "Can parse word characters." - (and (should_pass (/.regex "\w") "_") - (should_fail (/.regex "\w") "^"))) + (_.test "Can parse word characters." + (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"))) - )) + (_.test "Can parse non word characters." + (and (should_pass (/.regex "\W") ".") + (should_fail (/.regex "\W") "a"))) + )) (def: special_system_character_classes Test - ($_ _.and - (_.test "Lower-case." - (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"))) - (_.test "Alphabetic." - (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"))) - (_.test "Alphanumeric." - (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}") "."))) - (_.test "Hexadecimal." - (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}") "."))) - (_.test "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.of_char (hex "1234"))))) - (_.test "Control characters." - (and (should_pass (/.regex "\p{Contrl}") (text.of_char (hex "12"))) - (should_fail (/.regex "\p{Contrl}") "a"))) - (_.test "Punctuation." - (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}") " "))) - (_.test "Print." - (and (should_pass (/.regex "\p{Print}") (text.of_char (hex "20"))) - (should_fail (/.regex "\p{Print}") (text.of_char (hex "1234"))))) - )) + (all _.and + (_.test "Lower-case." + (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"))) + (_.test "Alphabetic." + (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"))) + (_.test "Alphanumeric." + (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}") "."))) + (_.test "Hexadecimal." + (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}") "."))) + (_.test "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.of_char (hex "1234"))))) + (_.test "Control characters." + (and (should_pass (/.regex "\p{Contrl}") (text.of_char (hex "12"))) + (should_fail (/.regex "\p{Contrl}") "a"))) + (_.test "Punctuation." + (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}") " "))) + (_.test "Print." + (and (should_pass (/.regex "\p{Print}") (text.of_char (hex "20"))) + (should_fail (/.regex "\p{Print}") (text.of_char (hex "1234"))))) + )) (def: custom_character_classes Test - ($_ _.and - (_.test "Can parse using custom character classes." - (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"))) - (_.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"))) - (_.test "Can negate custom character classes." - (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"))) - (_.test "Can parse negate combinations of character ranges." - (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"))) - (let [RE (/.regex "[a-z&&[^bc]]")] - (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"))))) - )) + (all _.and + (_.test "Can parse using custom character classes." + (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"))) + (_.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"))) + (_.test "Can negate custom character classes." + (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"))) + (_.test "Can parse negate combinations of character ranges." + (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"))) + (let [RE (/.regex "[a-z&&[^bc]]")] + (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"))))) + )) (def: references Test @@ -203,78 +203,78 @@ (def: fuzzy_quantifiers Test - ($_ _.and - (_.test "Can sequentially combine patterns." - (text_should_pass "aa" (/.regex "aa") "aa")) + (all _.and + (_.test "Can sequentially combine patterns." + (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?") ""))) + (_.test "Can match patterns optionally." + (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*") ""))) + (_.test "Can match a pattern 0 or more times." + (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+") ""))) - )) + (_.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+") ""))) + )) (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"))) - - (_.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"))) - - (_.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"))) - - (_.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"))) - )) + (all _.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"))) + + (_.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"))) + + (_.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"))) + + (_.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"))) + )) (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"))) - - (_.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")) - )) + (all _.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"))) + + (_.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")) + )) (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"))) - (_.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") - - (should_check ["123-456-7890" {0 #0 ["123" "456-7890" "456" "7890"]}] - (/.regex "(\d{3})-((\d{3})-(\d{4}))|b(.)d") - "123-456-7890"))) - )) + (all _.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"))) + (_.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") + + (should_check ["123-456-7890" {0 #0 ["123" "456-7890" "456" "7890"]}] + (/.regex "(\d{3})-((\d{3})-(\d{4}))|b(.)d") + "123-456-7890"))) + )) (syntax: (expands? [form <code>.any]) (function (_ lux) @@ -288,34 +288,34 @@ (def: .public test Test (<| (_.covering /._) - ($_ _.and - (_.for [/.regex] - ($_ _.and - ..basics - ..system_character_classes - ..special_system_character_classes - ..custom_character_classes - ..references - ..fuzzy_quantifiers - ..crisp_quantifiers - ..groups - ..alternation - )) - (do random.monad - [sample1 (random.unicode 3) - sample2 (random.unicode 3) - sample3 (random.unicode 4)] - (_.cover [/.pattern] - (case (format sample1 "-" sample2 "-" sample3) - (/.pattern "(.{3})-(.{3})-(.{4})" - [_ match1 match2 match3]) - (and (text#= sample1 match1) - (text#= sample2 match2) - (text#= sample3 match3)) - - _ - false))) - (_.cover [/.incorrect_quantification] - (and (expands? (/.regex "a{1,2}")) - (not (expands? (/.regex "a{2,1}"))))) - ))) + (all _.and + (_.for [/.regex] + (all _.and + ..basics + ..system_character_classes + ..special_system_character_classes + ..custom_character_classes + ..references + ..fuzzy_quantifiers + ..crisp_quantifiers + ..groups + ..alternation + )) + (do random.monad + [sample1 (random.unicode 3) + sample2 (random.unicode 3) + sample3 (random.unicode 4)] + (_.cover [/.pattern] + (case (format sample1 "-" sample2 "-" sample3) + (/.pattern "(.{3})-(.{3})-(.{4})" + [_ match1 match2 match3]) + (and (text#= sample1 match1) + (text#= sample2 match2) + (text#= sample3 match3)) + + _ + false))) + (_.cover [/.incorrect_quantification] + (and (expands? (/.regex "a{1,2}")) + (not (expands? (/.regex "a{2,1}"))))) + ))) diff --git a/stdlib/source/test/lux/data/text/unicode/block.lux b/stdlib/source/test/lux/data/text/unicode/block.lux index 4e3de67c4..767a8cf4c 100644 --- a/stdlib/source/test/lux/data/text/unicode/block.lux +++ b/stdlib/source/test/lux/data/text/unicode/block.lux @@ -182,32 +182,32 @@ (|>> (n.% size) (n.+ (/.start sample))) random.nat)] - (`` ($_ _.and - (_.for [/.equivalence] - ($equivalence.spec /.equivalence ..random)) - (_.for [/.hash] - ($hash.spec /.hash ..random)) - (_.for [/.monoid] - ($monoid.spec /.equivalence /.monoid ..random)) - - (_.for [/.block] - ($_ _.and - (_.cover [/.start] - (n.= start - (/.start sample))) - (_.cover [/.end] - (n.= end - (/.end sample))) - (_.cover [/.size] - (n.= (++ additional) - (/.size sample))) - (_.cover [/.within?] - (and (/.within? sample inside) - (not (/.within? sample (-- (/.start sample)))) - (not (/.within? sample (++ (/.end sample)))))) - (~~ (template [<definition> <part>] - [<definition>] - - <blocks>)))) - ))))) + (`` (all _.and + (_.for [/.equivalence] + ($equivalence.spec /.equivalence ..random)) + (_.for [/.hash] + ($hash.spec /.hash ..random)) + (_.for [/.monoid] + ($monoid.spec /.equivalence /.monoid ..random)) + + (_.for [/.block] + (all _.and + (_.cover [/.start] + (n.= start + (/.start sample))) + (_.cover [/.end] + (n.= end + (/.end sample))) + (_.cover [/.size] + (n.= (++ additional) + (/.size sample))) + (_.cover [/.within?] + (and (/.within? sample inside) + (not (/.within? sample (-- (/.start sample)))) + (not (/.within? sample (++ (/.end sample)))))) + (~~ (template [<definition> <part>] + [<definition>] + + <blocks>)))) + ))))) ) diff --git a/stdlib/source/test/lux/data/text/unicode/set.lux b/stdlib/source/test/lux/data/text/unicode/set.lux index c2f567fc2..20f6c2e42 100644 --- a/stdlib/source/test/lux/data/text/unicode/set.lux +++ b/stdlib/source/test/lux/data/text/unicode/set.lux @@ -1,27 +1,27 @@ (.using - [library - [lux "*" - ["_" test {"+" Test}] - [abstract - [monad {"+" do}] - [\\specification - ["$[0]" equivalence]]] - [data - ["[0]" product] - ["[0]" bit ("[1]#[0]" equivalence)] - [collection - ["[0]" set ("[1]#[0]" equivalence)]]] - [math - ["[0]" random {"+" Random}] - [number - ["n" nat]]]]] - ["[0]" / "_" - ["/[1]" // "_" - ["[1][0]" block]]] - [\\library - ["[0]" / - [// - ["[0]" block]]]]) + [library + [lux "*" + ["_" test {"+" Test}] + [abstract + [monad {"+" do}] + [\\specification + ["$[0]" equivalence]]] + [data + ["[0]" product] + ["[0]" bit ("[1]#[0]" equivalence)] + [collection + ["[0]" set ("[1]#[0]" equivalence)]]] + [math + ["[0]" random {"+" Random}] + [number + ["n" nat]]]]] + ["[0]" / "_" + ["/[1]" // "_" + ["[1][0]" block]]] + [\\library + ["[0]" / + [// + ["[0]" block]]]]) (def: .public random (Random /.Set) @@ -44,55 +44,55 @@ right //block.random .let [equivalence (product.equivalence n.equivalence n.equivalence)]] - (`` ($_ _.and - (_.for [/.equivalence] - ($equivalence.spec /.equivalence ..random)) - - (_.cover [/.set] - (and (n.= (block.start left) - (/.start (/.set [left (list)]))) - (n.= (block.end left) - (/.end (/.set [left (list)]))))) - (_.cover [/.start] - (n.= (n.min (block.start left) - (block.start right)) - (/.start (/.set [left (list right)])))) - (_.cover [/.end] - (n.= (n.max (block.end left) - (block.end right)) - (/.end (/.set [left (list right)])))) - (_.cover [/.member?] - (bit#= (block.within? block inside) - (/.member? (/.set [block (list)]) inside))) - (_.cover [/.composite] - (let [composed (/.composite (/.set [left (list)]) - (/.set [right (list)]))] - (and (n.= (n.min (block.start left) - (block.start right)) - (/.start composed)) - (n.= (n.max (block.end left) - (block.end right)) - (/.end composed))))) - (~~ (template [<set>] - [(do random.monad - [char (random.char <set>) - .let [start (/.start <set>) - end (/.end <set>)]] - (_.cover [<set>] - (and (/.member? <set> char) - (not (/.member? <set> (-- start))) - (not (/.member? <set> (++ end))))))] + (`` (all _.and + (_.for [/.equivalence] + ($equivalence.spec /.equivalence ..random)) + + (_.cover [/.set] + (and (n.= (block.start left) + (/.start (/.set [left (list)]))) + (n.= (block.end left) + (/.end (/.set [left (list)]))))) + (_.cover [/.start] + (n.= (n.min (block.start left) + (block.start right)) + (/.start (/.set [left (list right)])))) + (_.cover [/.end] + (n.= (n.max (block.end left) + (block.end right)) + (/.end (/.set [left (list right)])))) + (_.cover [/.member?] + (bit#= (block.within? block inside) + (/.member? (/.set [block (list)]) inside))) + (_.cover [/.composite] + (let [composed (/.composite (/.set [left (list)]) + (/.set [right (list)]))] + (and (n.= (n.min (block.start left) + (block.start right)) + (/.start composed)) + (n.= (n.max (block.end left) + (block.end right)) + (/.end composed))))) + (~~ (template [<set>] + [(do random.monad + [char (random.char <set>) + .let [start (/.start <set>) + end (/.end <set>)]] + (_.cover [<set>] + (and (/.member? <set> char) + (not (/.member? <set> (-- start))) + (not (/.member? <set> (++ end))))))] - [/.ascii] - [/.ascii/alpha] - [/.ascii/alpha_num] - [/.ascii/lower] - [/.ascii/upper] - [/.ascii/numeric] - [/.character] - [/.non_character] - [/.full] - )) + [/.ascii] + [/.ascii/alpha] + [/.ascii/alpha_num] + [/.ascii/lower] + [/.ascii/upper] + [/.ascii/numeric] + [/.character] + [/.non_character] + [/.full] + )) - //block.test - ))))) + //block.test + ))))) |