From abc5c5293603229b447b8b5dfa7f3275571ad982 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Tue, 15 Dec 2020 22:05:05 -0400 Subject: Compiling "lux syntax char case!" with TABLESWITCH instead of LOOKUPSWITCH. --- stdlib/source/test/aedifex/artifact/type.lux | 14 +- stdlib/source/test/aedifex/metadata.lux | 2 + stdlib/source/test/aedifex/metadata/snapshot.lux | 84 ++++++++ stdlib/source/test/lux/control/concurrency/frp.lux | 24 +-- stdlib/source/test/lux/control/parser/text.lux | 31 +-- .../test/lux/data/collection/tree/finger.lux | 18 +- stdlib/source/test/lux/data/format/tar.lux | 11 +- stdlib/source/test/lux/data/text.lux | 4 +- stdlib/source/test/lux/data/text/regex.lux | 72 ++++--- stdlib/source/test/lux/data/text/unicode.lux | 91 +++++++++ .../source/test/lux/data/text/unicode/segment.lux | 211 +++++++++++++++++++++ 11 files changed, 486 insertions(+), 76 deletions(-) create mode 100644 stdlib/source/test/aedifex/metadata/snapshot.lux create mode 100644 stdlib/source/test/lux/data/text/unicode.lux create mode 100644 stdlib/source/test/lux/data/text/unicode/segment.lux (limited to 'stdlib/source/test') diff --git a/stdlib/source/test/aedifex/artifact/type.lux b/stdlib/source/test/aedifex/artifact/type.lux index 84807a8c6..5dc1b9caa 100644 --- a/stdlib/source/test/aedifex/artifact/type.lux +++ b/stdlib/source/test/aedifex/artifact/type.lux @@ -11,10 +11,22 @@ ["." set] ["." list]]] [math - ["." random (#+ Random)]]] + ["." random (#+ Random) ("#\." monad)]]] {#program ["." /]}) +(def: #export random + (Random /.Type) + ($_ random.either + ($_ random.either + (random\wrap /.lux-library) + (random\wrap /.jvm-library)) + ($_ random.either + (random\wrap /.pom) + (random\wrap /.md5) + (random\wrap /.sha-1)) + )) + (def: #export test Test (<| (_.covering /._) diff --git a/stdlib/source/test/aedifex/metadata.lux b/stdlib/source/test/aedifex/metadata.lux index 5b8b47b00..6a1ac503a 100644 --- a/stdlib/source/test/aedifex/metadata.lux +++ b/stdlib/source/test/aedifex/metadata.lux @@ -9,6 +9,7 @@ ["." random]]] ["." / #_ ["#." artifact] + ["#." snapshot] [// ["@." artifact]]] {#program @@ -29,4 +30,5 @@ ))) /artifact.test + /snapshot.test ))) diff --git a/stdlib/source/test/aedifex/metadata/snapshot.lux b/stdlib/source/test/aedifex/metadata/snapshot.lux new file mode 100644 index 000000000..e17765038 --- /dev/null +++ b/stdlib/source/test/aedifex/metadata/snapshot.lux @@ -0,0 +1,84 @@ +(.module: + [lux #* + ["_" test (#+ Test)] + [abstract + [monad (#+ do)] + {[0 #spec] + [/ + ["$." equivalence]]}] + [control + ["." try ("#\." functor)] + [parser + ["<.>" xml]]] + [data + [number + ["n" nat]]] + ["." time + ["." date] + ["." year] + ["." month] + ["." instant (#+ Instant)] + ["." duration]] + [math + ["." random (#+ Random)]] + [macro + ["." code]]] + ["$." /// #_ + [artifact + ["#." type]]] + {#program + ["." /]}) + +(def: random-instant + (Random Instant) + (do {! random.monad} + [year (\ ! map (|>> (n.% 10,000) .int) random.nat) + month (\ ! map (n.% 13) random.nat) + day-of-month (\ ! map (n.% 29) random.nat) + hour (\ ! map (n.% 24) random.nat) + minute (\ ! map (n.% 60) random.nat) + second (\ ! map (n.% 60) random.nat)] + (wrap (try.assume + (do try.monad + [year (year.year year) + month (month.by-number month) + date (date.date year month day-of-month) + time (time.time + {#time.hour hour + #time.minute minute + #time.second second + #time.milli-second 0})] + (wrap (instant.from-date-time date time))))))) + +(def: random-versioning + (Random /.Versioning) + ($_ random.and + ..random-instant + random.nat + (random.list 5 $///type.random) + )) + +(def: #export random + (Random /.Metadata) + ($_ random.and + (random.ascii/alpha 5) + (random.ascii/alpha 5) + (random.ascii/alpha 5) + ..random-versioning)) + +(def: #export test + Test + (<| (_.covering /._) + (_.for [/.Metadata]) + ($_ _.and + (_.for [/.equivalence] + ($equivalence.spec /.equivalence ..random)) + (do random.monad + [expected ..random] + (_.cover [/.write /.parser] + (|> expected + /.write + (.run /.parser) + (try\map (\ /.equivalence = expected)) + (try.default false)))) + ))) diff --git a/stdlib/source/test/lux/control/concurrency/frp.lux b/stdlib/source/test/lux/control/concurrency/frp.lux index 709c756a2..3e0aee4f0 100644 --- a/stdlib/source/test/lux/control/concurrency/frp.lux +++ b/stdlib/source/test/lux/control/concurrency/frp.lux @@ -127,24 +127,20 @@ channel (/.sequential 0 (list\compose inputs inputs))] _ (promise.future (/.subscribe (function (_ value) (do {! io.monad} - [current (atom.read sink)] - (if (n.< (list.size inputs) - (row.size current)) - (do ! - [_ (atom.update (row.add value) sink)] - (wrap (#.Some []))) - (wrap (#.Some []))))) + [current (atom.read sink) + _ (atom.update (row.add value) sink)] + (wrap (if (n.< (list.size inputs) + (inc (row.size current))) + (#.Some []) + #.None)))) channel)) - output (/.consume channel) + _ (/.consume channel) listened (|> sink atom.read promise.future (\ ! map row.to-list))] (_.cover' [/.Subscriber /.subscribe] - (and (list\= inputs - output) - (list\= output - listened))))) + (list\= inputs listened)))) (wrap (do promise.monad [actual (/.fold (function (_ input total) (promise.resolved (n.+ input total))) @@ -173,9 +169,9 @@ (_.cover' [/.distinct] (list\= (list distint/0 distint/1 distint/2) actual)))) - (let [polling-delay 10 - wiggle-room (n.* 5 polling-delay) + (let [polling-delay 1 amount-of-polls 5 + wiggle-room ($_ n.* amount-of-polls 2 polling-delay) total-delay (|> polling-delay (n.* amount-of-polls) (n.+ wiggle-room))] diff --git a/stdlib/source/test/lux/control/parser/text.lux b/stdlib/source/test/lux/control/parser/text.lux index 5a2245401..7c1f5d932 100644 --- a/stdlib/source/test/lux/control/parser/text.lux +++ b/stdlib/source/test/lux/control/parser/text.lux @@ -10,8 +10,9 @@ [data ["." maybe] ["." text ("#\." equivalence) - ["." unicode] - ["%" format (#+ format)]] + ["%" format (#+ format)] + ["." unicode + ["#/." segment]]] [number ["n" nat]] [collection @@ -81,41 +82,41 @@ (..should-fail out-of-range (/.range offset limit))))) (do {! random.monad} [expected (random.char unicode.ascii/upper-alpha) - invalid (random.filter (|>> (unicode.within? unicode.basic-latin/upper-alpha) not) + invalid (random.filter (|>> (unicode/segment.within? unicode/segment.basic-latin/upper-alpha) not) (random.char unicode.full))] (_.cover [/.upper] (and (..should-pass (text.from-code expected) /.upper) (..should-fail (text.from-code invalid) /.upper)))) (do {! random.monad} [expected (random.char unicode.ascii/lower-alpha) - invalid (random.filter (|>> (unicode.within? unicode.basic-latin/lower-alpha) not) + invalid (random.filter (|>> (unicode/segment.within? unicode/segment.basic-latin/lower-alpha) not) (random.char unicode.full))] (_.cover [/.lower] (and (..should-pass (text.from-code expected) /.lower) (..should-fail (text.from-code invalid) /.lower)))) (do {! random.monad} [expected (\ ! map (n.% 10) random.nat) - invalid (random.char (unicode.set [unicode.number-forms (list)]))] + invalid (random.char (unicode.set [unicode/segment.number-forms (list)]))] (_.cover [/.decimal] (and (..should-pass (\ n.decimal encode expected) /.decimal) (..should-fail (text.from-code invalid) /.decimal)))) (do {! random.monad} [expected (\ ! map (n.% 8) random.nat) - invalid (random.char (unicode.set [unicode.number-forms (list)]))] + invalid (random.char (unicode.set [unicode/segment.number-forms (list)]))] (_.cover [/.octal] (and (..should-pass (\ n.octal encode expected) /.octal) (..should-fail (text.from-code invalid) /.octal)))) (do {! random.monad} [expected (\ ! map (n.% 16) random.nat) - invalid (random.char (unicode.set [unicode.number-forms (list)]))] + invalid (random.char (unicode.set [unicode/segment.number-forms (list)]))] (_.cover [/.hexadecimal] (and (..should-pass (\ n.hex encode expected) /.hexadecimal) (..should-fail (text.from-code invalid) /.hexadecimal)))) (do {! random.monad} [expected (random.char unicode.ascii/alpha) invalid (random.filter (function (_ char) - (not (or (unicode.within? unicode.basic-latin/upper-alpha char) - (unicode.within? unicode.basic-latin/lower-alpha char)))) + (not (or (unicode/segment.within? unicode/segment.basic-latin/upper-alpha char) + (unicode/segment.within? unicode/segment.basic-latin/lower-alpha char)))) (random.char unicode.full))] (_.cover [/.alpha] (and (..should-pass (text.from-code expected) /.alpha) @@ -123,9 +124,9 @@ (do {! random.monad} [expected (random.char unicode.ascii/alpha-num) invalid (random.filter (function (_ char) - (not (or (unicode.within? unicode.basic-latin/upper-alpha char) - (unicode.within? unicode.basic-latin/lower-alpha char) - (unicode.within? unicode.basic-latin/decimal char)))) + (not (or (unicode/segment.within? unicode/segment.basic-latin/upper-alpha char) + (unicode/segment.within? unicode/segment.basic-latin/lower-alpha char) + (unicode/segment.within? unicode/segment.basic-latin/decimal char)))) (random.char unicode.full))] (_.cover [/.alpha-num] (and (..should-pass (text.from-code expected) /.alpha-num) @@ -394,7 +395,7 @@ (text\= expected actual)))))) (do {! random.monad} [invalid (random.ascii/upper-alpha 1) - expected (random.filter (|>> (unicode.within? unicode.basic-latin/upper-alpha) + expected (random.filter (|>> (unicode/segment.within? unicode/segment.basic-latin/upper-alpha) not) (random.char unicode.full)) #let [upper! (/.one-of! "ABCDEFGHIJKLMNOPQRSTUVWXYZ")]] @@ -414,8 +415,8 @@ [upper (random.ascii/upper-alpha 1) lower (random.ascii/lower-alpha 1) invalid (random.filter (function (_ char) - (not (or (unicode.within? unicode.basic-latin/upper-alpha char) - (unicode.within? unicode.basic-latin/lower-alpha char)))) + (not (or (unicode/segment.within? unicode/segment.basic-latin/upper-alpha char) + (unicode/segment.within? unicode/segment.basic-latin/lower-alpha char)))) (random.char unicode.full)) #let [upper! (/.one-of! "ABCDEFGHIJKLMNOPQRSTUVWXYZ") lower! (/.one-of! "abcdefghijklmnopqrstuvwxyz")]] diff --git a/stdlib/source/test/lux/data/collection/tree/finger.lux b/stdlib/source/test/lux/data/collection/tree/finger.lux index 3760298f9..3c1325d4e 100644 --- a/stdlib/source/test/lux/data/collection/tree/finger.lux +++ b/stdlib/source/test/lux/data/collection/tree/finger.lux @@ -7,7 +7,9 @@ ["." maybe ("#\." functor)] ["." text ("#\." equivalence monoid)] [number - ["n" nat]]] + ["n" nat]] + [collection + ["." list ("#\." fold)]]] [math ["." random]] [type (#+ :by-example)]] @@ -73,6 +75,20 @@ (/.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\fold (function (_ [tag value] tree) + (\ builder branch tree (\ builder leaf tag value))) + (\ builder leaf tags/H values/H) + (list.zip/2 tags/T values/T))] + (and (\ tags-equivalence = (list& tags/H tags/T) (/.tags tree)) + (\ values-equivalence = (list& values/H values/T) (/.values tree)))))) (_.cover [/.search] (let [can-find-correct-one! (|> (\ ..builder leaf tag-left expected-left) diff --git a/stdlib/source/test/lux/data/format/tar.lux b/stdlib/source/test/lux/data/format/tar.lux index f837c0d18..73ccec27f 100644 --- a/stdlib/source/test/lux/data/format/tar.lux +++ b/stdlib/source/test/lux/data/format/tar.lux @@ -13,9 +13,10 @@ ["." maybe] ["." binary ("#\." equivalence)] ["." text ("#\." equivalence) + ["%" format (#+ format)] ["." encoding] - ["." unicode] - ["%" format (#+ format)]] + ["." unicode + ["#/." segment]]] [number ["n" nat] ["i" int]] @@ -38,7 +39,7 @@ (do {! random.monad} [expected (random.ascii/lower-alpha /.path-size) invalid (random.ascii/lower-alpha (inc /.path-size)) - not-ascii (random.text (random.char (unicode.set [unicode.katakana (list)])) + not-ascii (random.text (random.char (unicode.set [unicode/segment.katakana (list)])) /.path-size)] (`` ($_ _.and (_.cover [/.path /.from-path] @@ -71,7 +72,7 @@ (do {! random.monad} [expected (random.ascii/lower-alpha /.name-size) invalid (random.ascii/lower-alpha (inc /.name-size)) - not-ascii (random.text (random.char (unicode.set [unicode.katakana (list)])) + not-ascii (random.text (random.char (unicode.set [unicode/segment.katakana (list)])) /.name-size)] (`` ($_ _.and (_.cover [/.name /.from-name] @@ -312,7 +313,7 @@ [path (random.ascii/lower-alpha /.path-size) expected (random.ascii/lower-alpha /.name-size) invalid (random.ascii/lower-alpha (inc /.name-size)) - not-ascii (random.text (random.char (unicode.set [unicode.katakana (list)])) + not-ascii (random.text (random.char (unicode.set [unicode/segment.katakana (list)])) /.name-size)] (_.for [/.Ownership /.Owner /.ID] ($_ _.and diff --git a/stdlib/source/test/lux/data/text.lux b/stdlib/source/test/lux/data/text.lux index 2cf0e2cfd..b9dfdb1a9 100644 --- a/stdlib/source/test/lux/data/text.lux +++ b/stdlib/source/test/lux/data/text.lux @@ -23,7 +23,8 @@ ["#." buffer] ["#." encoding] ["#." format] - ["#." regex]] + ["#." regex] + ["#." unicode]] {1 ["." /]}) @@ -302,4 +303,5 @@ /encoding.test /format.test /regex.test + /unicode.test ))) diff --git a/stdlib/source/test/lux/data/text/regex.lux b/stdlib/source/test/lux/data/text/regex.lux index 83d2cfcc4..f72c19030 100644 --- a/stdlib/source/test/lux/data/text/regex.lux +++ b/stdlib/source/test/lux/data/text/regex.lux @@ -1,8 +1,8 @@ (.module: [lux #* - ["%" data/text/format (#+ format)] ["_" test (#+ Test)] - [abstract/monad (#+ do)] + [abstract + [monad (#+ do)]] [control pipe ["." try] @@ -11,9 +11,10 @@ ["s" code]]] [data [number (#+ hex)] - ["." text ("#\." equivalence)]] + ["." text ("#\." equivalence) + ["%" format (#+ format)]]] [math - ["r" random]] + ["." random]] ["." meta] [macro [syntax (#+ syntax:)]]] @@ -57,13 +58,8 @@ (case> (^ (#try.Success (~ pattern))) true - (#try.Failure (~ g!message)) - (exec (log! (format "{{{Failure}}} " (~ g!message))) - false) - (~ g!_) - (exec (log! (format "{{{Success}}} " "OH NO")) - false)))))))) + false))))))) (def: basics Test @@ -273,36 +269,34 @@ "123-456-7890"))) )) -(def: pattern-matching - Test - (do r.monad - [sample1 (r.unicode 3) - sample2 (r.unicode 3) - sample3 (r.unicode 4)] - (case (format sample1 "-" sample2 "-" sample3) - (/.^regex "(.{3})-(.{3})-(.{4})" - [_ match1 match2 match3]) - (_.test "Can pattern-match using regular-expressions." - (and (text\= sample1 match1) - (text\= sample2 match2) - (text\= sample3 match3))) - - _ - (_.test "Cannot pattern-match using regular-expressions." - #0)))) - (def: #export test Test - (<| (_.context (%.name (name-of /.regex))) + (<| (_.covering /._) ($_ _.and - ..basics - ..system-character-classes - ..special-system-character-classes - ..custom-character-classes - ..references - ..fuzzy-quantifiers - ..crisp-quantifiers - ..groups - ..alternation - ..pattern-matching + (_.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 [/.^regex] + (case (format sample1 "-" sample2 "-" sample3) + (/.^regex "(.{3})-(.{3})-(.{4})" + [_ match1 match2 match3]) + (and (text\= sample1 match1) + (text\= sample2 match2) + (text\= sample3 match3)) + + _ + false))) ))) diff --git a/stdlib/source/test/lux/data/text/unicode.lux b/stdlib/source/test/lux/data/text/unicode.lux new file mode 100644 index 000000000..1b47c8cdb --- /dev/null +++ b/stdlib/source/test/lux/data/text/unicode.lux @@ -0,0 +1,91 @@ +(.module: + [lux #* + ["_" test (#+ Test)] + [abstract + [monad (#+ do)] + {[0 #spec] + [/ + ["$." equivalence]]}] + [data + ["." product] + ["." bit ("#\." equivalence)] + [number + ["n" nat]] + [collection + ["." set ("#\." equivalence)]]] + [math + ["." random (#+ Random)]]] + ["." / #_ + ["#." segment]] + {1 + ["." / + ["." segment]]}) + +(def: #export random + (Random /.Set) + (do {! random.monad} + [left /segment.random + right /segment.random] + (wrap (/.set [left (list right)])))) + +(def: #export test + Test + (<| (_.covering /._) + (_.for [/.Set]) + (do {! random.monad} + [segment /segment.random + inside (\ ! map + (|>> (n.% (segment.size segment)) + (n.+ (segment.start segment))) + random.nat) + left /segment.random + right /segment.random + #let [equivalence (product.equivalence n.equivalence + n.equivalence)]] + (`` ($_ _.and + (_.for [/.equivalence] + ($equivalence.spec /.equivalence ..random)) + + (_.cover [/.range] + (let [[start end] (/.range (/.set [left (list right)]))] + (and (n.= (n.min (segment.start left) + (segment.start right)) + start) + (n.= (n.max (segment.end left) + (segment.end right)) + end)))) + (_.cover [/.member?] + (bit\= (segment.within? segment inside) + (/.member? (/.set [segment (list)]) inside))) + (_.cover [/.compose] + (\ equivalence = + [(n.min (segment.start left) + (segment.start right)) + (n.max (segment.end left) + (segment.end right))] + (/.range (/.compose (/.set [left (list)]) + (/.set [right (list)]))))) + (_.cover [/.set] + (\ equivalence = + (/.range (/.compose (/.set [left (list)]) + (/.set [right (list)]))) + (/.range (/.set [left (list right)])))) + (~~ (template [] + [(do random.monad + [char (random.char ) + #let [[start end] (/.range )]] + (_.cover [] + (and (/.member? char) + (not (/.member? (dec start))) + (not (/.member? (inc end))))))] + + [/.ascii] + [/.ascii/alpha] + [/.ascii/alpha-num] + [/.ascii/lower-alpha] + [/.ascii/upper-alpha] + [/.full] + )) + + /segment.test + ))))) diff --git a/stdlib/source/test/lux/data/text/unicode/segment.lux b/stdlib/source/test/lux/data/text/unicode/segment.lux new file mode 100644 index 000000000..62a399cd1 --- /dev/null +++ b/stdlib/source/test/lux/data/text/unicode/segment.lux @@ -0,0 +1,211 @@ +(.module: + [lux #* + ["_" test (#+ Test)] + [abstract + [monad (#+ do)] + {[0 #spec] + [/ + ["$." equivalence] + ["$." hash] + ["$." monoid]]}] + [data + ["." text] + [number (#+ hex) + ["n" nat]] + [collection + ["." set] + ["." list]]] + [macro + ["." template]] + [math + ["." random (#+ Random)]]] + {1 + ["." /]}) + +(def: #export random + (Random /.Segment) + (do random.monad + [start random.nat + end random.nat] + (wrap (/.segment start end)))) + +(with-expansions [ (as-is [segments/0 + [/.basic-latin + /.latin-1-supplement + /.latin-extended-a + /.latin-extended-b + /.ipa-extensions + /.spacing-modifier-letters + /.combining-diacritical-marks + /.greek-and-coptic + /.cyrillic + /.cyrillic-supplementary + /.armenian + /.hebrew + /.arabic + /.syriac + /.thaana + /.devanagari + /.bengali + /.gurmukhi + /.gujarati + /.oriya + /.tamil + /.telugu + /.kannada + /.malayalam + /.sinhala + /.thai + /.lao + /.tibetan + /.myanmar + /.georgian + /.hangul-jamo + /.ethiopic + /.cherokee + /.unified-canadian-aboriginal-syllabics + /.ogham + /.runic + /.tagalog + /.hanunoo + /.buhid + /.tagbanwa + /.khmer + /.mongolian]] + [segments/1 + [/.limbu + /.tai-le + /.khmer-symbols + /.phonetic-extensions + /.latin-extended-additional + /.greek-extended + /.general-punctuation + /.superscripts-and-subscripts + /.currency-symbols + /.combining-diacritical-marks-for-symbols + /.letterlike-symbols + /.number-forms + /.arrows + /.mathematical-operators + /.miscellaneous-technical + /.control-pictures + /.optical-character-recognition + /.enclosed-alphanumerics + /.box-drawing + /.block-elements + /.geometric-shapes + /.miscellaneous-symbols + /.dingbats + /.miscellaneous-mathematical-symbols-a + /.supplemental-arrows-a + /.braille-patterns + /.supplemental-arrows-b + /.miscellaneous-mathematical-symbols-b + /.supplemental-mathematical-operators + /.miscellaneous-symbols-and-arrows + /.cjk-radicals-supplement + /.kangxi-radicals + /.ideographic-description-characters + /.cjk-symbols-and-punctuation + /.hiragana + /.katakana + /.bopomofo + /.hangul-compatibility-jamo + /.kanbun + /.bopomofo-extended + /.katakana-phonetic-extensions + /.enclosed-cjk-letters-and-months + /.cjk-compatibility + /.cjk-unified-ideographs-extension-a + /.yijing-hexagram-symbols + /.cjk-unified-ideographs + /.yi-syllables + /.yi-radicals + /.hangul-syllables + /.high-surrogates + /.high-private-use-surrogates + /.low-surrogates + /.private-use-area + /.cjk-compatibility-ideographs + /.alphabetic-presentation-forms]] + [segments/2 + [/.arabic-presentation-forms-a + /.variation-selectors + /.combining-half-marks + /.cjk-compatibility-forms + /.small-form-variants + /.arabic-presentation-forms-b + /.halfwidth-and-fullwidth-forms + /.specials + + ## Specialized segments + /.basic-latin/decimal + /.basic-latin/upper-alpha + /.basic-latin/lower-alpha]] + ) + (template [ ] + [((: (-> Any (List /.Segment)) + (function (_ _) + (`` (list (~~ (template.splice )))))) + [])] + + )] + (template [ ] + [(def: + Test + (`` (_.cover [(~~ (template.splice ))] + (let [all (list.concat (list )) + unique (set.from-list /.hash all)] + (n.= (list.size all) + (set.size unique))))))] + + + ) + + (def: #export test + Test + (<| (_.covering /._) + (_.for [/.Segment]) + (do {! random.monad} + [#let [top-start (hex "AC00") + top-end (hex "D7AF")] + start (\ ! map (|>> (n.% top-start) inc) random.nat) + end (\ ! map (|>> (n.% top-end) inc) random.nat) + #let [sample (/.segment start end) + size (/.size sample)] + inside (\ ! map + (|>> (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)) + + (_.cover [/.segment] + (\ /.equivalence = + (/.segment start end) + (/.segment end start))) + (_.cover [/.start] + (n.= (n.min start end) + (/.start (/.segment start end)))) + (_.cover [/.end] + (n.= (n.max start end) + (/.end (/.segment start end)))) + (_.cover [/.size] + (n.= (inc (n.- (n.min start end) + (n.max start end))) + (/.size (/.segment start end)))) + (_.cover [/.within?] + (and (/.within? sample inside) + (not (/.within? sample (dec (/.start sample)))) + (not (/.within? sample (inc (/.end sample)))))) + (~~ (template [ ] + [] + + )) + ))))) + ) -- cgit v1.2.3