diff options
Diffstat (limited to 'stdlib/source/test')
18 files changed, 541 insertions, 362 deletions
diff --git a/stdlib/source/test/aedifex.lux b/stdlib/source/test/aedifex.lux index 2f46df228..eebccdf09 100644 --- a/stdlib/source/test/aedifex.lux +++ b/stdlib/source/test/aedifex.lux @@ -21,7 +21,8 @@ ["#." local] ["#." cache] ["#." dependency - ["#/." resolution]] + ["#/." resolution] + ["#/." status]] ["#." package] ["#." profile] ["#." project] @@ -51,6 +52,7 @@ /cache.test /dependency.test /dependency/resolution.test + /dependency/status.test /package.test /profile.test /project.test diff --git a/stdlib/source/test/aedifex/command/deploy.lux b/stdlib/source/test/aedifex/command/deploy.lux index ef08ba39e..18045a20b 100644 --- a/stdlib/source/test/aedifex/command/deploy.lux +++ b/stdlib/source/test/aedifex/command/deploy.lux @@ -110,11 +110,11 @@ set.to-list (export.library fs) (\ ! map (format.run tar.writer))) - - actual-pom (\ repository download artifact ///artifact/extension.pom) - actual-library (\ repository download artifact ///artifact/extension.lux-library) - actual-sha-1 (\ repository download artifact ///artifact/extension.sha-1) - actual-md5 (\ repository download artifact ///artifact/extension.md5) + + actual-pom (\ repository download (///repository.uri artifact ///artifact/extension.pom)) + actual-library (\ repository download (///repository.uri artifact ///artifact/extension.lux-library)) + actual-sha-1 (\ repository download (///repository.uri artifact (format ///artifact/extension.lux-library ///artifact/extension.sha-1))) + actual-md5 (\ repository download (///repository.uri artifact (format ///artifact/extension.lux-library ///artifact/extension.md5))) #let [deployed-library! (\ binary.equivalence = diff --git a/stdlib/source/test/aedifex/dependency/status.lux b/stdlib/source/test/aedifex/dependency/status.lux new file mode 100644 index 000000000..90cc547fa --- /dev/null +++ b/stdlib/source/test/aedifex/dependency/status.lux @@ -0,0 +1,34 @@ +(.module: + [lux #* + ["_" test (#+ Test)] + [abstract + {[0 #spec] + [/ + ["$." equivalence]]}] + [math + ["." random (#+ Random) ("#\." monad)]]] + ["$." /// #_ + ["#." hash]] + {#program + ["." / + ["//#" /// #_ + ["#." hash]]]}) + +(def: #export random + (Random /.Status) + ($_ random.or + (random\wrap []) + (random.or ($///hash.random ///hash.sha-1) + ($///hash.random ///hash.md5)) + (random.and ($///hash.random ///hash.sha-1) + ($///hash.random ///hash.md5)) + )) + +(def: #export test + Test + (<| (_.covering /._) + (_.for [/.Status] + ($_ _.and + (_.for [/.equivalence] + ($equivalence.spec /.equivalence ..random)) + )))) diff --git a/stdlib/source/test/aedifex/hash.lux b/stdlib/source/test/aedifex/hash.lux index 8bc830801..455835b84 100644 --- a/stdlib/source/test/aedifex/hash.lux +++ b/stdlib/source/test/aedifex/hash.lux @@ -25,7 +25,7 @@ [data ["_." binary]]]]) -(def: (random hash) +(def: #export (random hash) (All [h] (-> (-> Binary (/.Hash h)) (Random (/.Hash h)))) diff --git a/stdlib/source/test/aedifex/metadata.lux b/stdlib/source/test/aedifex/metadata.lux index 6a1ac503a..9dd3fac22 100644 --- a/stdlib/source/test/aedifex/metadata.lux +++ b/stdlib/source/test/aedifex/metadata.lux @@ -23,10 +23,10 @@ (do random.monad [sample @artifact.random] ($_ _.and - (_.cover [/.for-project] - (text.ends-with? /.file (/.for-project sample))) - (_.cover [/.for-version] - (text.ends-with? /.file (/.for-version sample))) + (_.cover [/.project] + (text.ends-with? /.file (/.project sample))) + (_.cover [/.version] + (text.ends-with? /.file (/.version sample))) ))) /artifact.test diff --git a/stdlib/source/test/aedifex/repository.lux b/stdlib/source/test/aedifex/repository.lux index ff669d687..5d2b62f57 100644 --- a/stdlib/source/test/aedifex/repository.lux +++ b/stdlib/source/test/aedifex/repository.lux @@ -17,7 +17,10 @@ [collection ["." dictionary (#+ Dictionary)]]] [math - ["." random (#+ Random)]]] + ["." random (#+ Random)]] + [world + [net + ["." uri (#+ URI)]]]] [// ["@." artifact]] {#spec @@ -42,41 +45,34 @@ (-> Version Artifact) (|>> ["com.github.luxlang" "test-artifact"])) -(def: item-hash - (Hash [Artifact Extension]) - (product.hash //artifact.hash - text.hash)) - -(exception: (not-found {artifact Artifact} - {extension Extension}) +(exception: (not-found {uri URI}) (exception.report - ["Artifact" (//artifact.format artifact)] - ["Extension" (%.text extension)])) + ["URI" (%.text uri)])) (exception: (invalid-identity {[user _] Identity}) (exception.report ["User" (%.text user)])) (type: Store - (Dictionary [Artifact Extension] Binary)) + (Dictionary URI Binary)) (def: #export empty Store - (dictionary.new ..item-hash)) + (dictionary.new text.hash)) (structure: #export (simulation identity) (-> Identity (/.Simulation Store)) - (def: (on-download artifact extension state) - (case (dictionary.get [artifact extension] state) + (def: (on-download uri state) + (case (dictionary.get uri state) (#.Some content) (exception.return [state content]) #.None - (exception.throw ..not-found [artifact extension]))) - (def: (on-upload requester artifact extension content state) + (exception.throw ..not-found [uri]))) + (def: (on-upload requester uri content state) (if (\ identity-equivalence = identity requester) - (exception.return (dictionary.put [artifact extension] content state)) + (exception.return (dictionary.put uri content state)) (exception.throw ..invalid-identity [requester])))) (def: #export test diff --git a/stdlib/source/test/lux/control.lux b/stdlib/source/test/lux/control.lux index 37ae36572..faf08f9b8 100644 --- a/stdlib/source/test/lux/control.lux +++ b/stdlib/source/test/lux/control.lux @@ -13,10 +13,7 @@ ["#/." stm]] ["#." continuation] ["#." exception] - ["#." function - ["#/." contract] - ["#/." memo] - ["#/." mixin]] + ["#." function] ["#." io] ["#." parser] ["#." pipe] @@ -43,15 +40,6 @@ /concurrency/stm.test )) -(def: function - Test - ($_ _.and - /function.test - /function/contract.test - /function/memo.test - /function/mixin.test - )) - (def: security Test ($_ _.and @@ -66,7 +54,7 @@ ..concurrency /continuation.test /exception.test - ..function + /function.test /io.test /parser.test /pipe.test diff --git a/stdlib/source/test/lux/control/function.lux b/stdlib/source/test/lux/control/function.lux index 3bd59dc41..c78d4f2e5 100644 --- a/stdlib/source/test/lux/control/function.lux +++ b/stdlib/source/test/lux/control/function.lux @@ -14,7 +14,11 @@ ["." random (#+ Random)]] ["_" test (#+ Test)]] {1 - ["." /]}) + ["." /]} + ["." / #_ + ["#." contract] + ["#." memo] + ["#." mixin]]) (def: #export test Test @@ -54,4 +58,8 @@ (_.cover [/.apply] (n.= (f0 extra) (/.apply extra f0))) + + /contract.test + /memo.test + /mixin.test )))) diff --git a/stdlib/source/test/lux/control/function/memo.lux b/stdlib/source/test/lux/control/function/memo.lux index 0180196b2..88be05a17 100644 --- a/stdlib/source/test/lux/control/function/memo.lux +++ b/stdlib/source/test/lux/control/function/memo.lux @@ -50,7 +50,7 @@ Test (<| (_.covering /._) (do {! random.monad} - [input (|> random.nat (\ ! map (|>> (n.% 5) (n.+ 23))))]) + [input (|> random.nat (\ ! map (|>> (n.% 5) (n.+ 20))))]) (_.for [/.Memo]) ($_ _.and (_.cover [/.closed /.none] @@ -72,13 +72,24 @@ open (/.open fibonacci)] [none-time none-output] (..time none input) [open-time [memory open-output]] (..time open [memory input]) - [open-time/+1 _] (..time open [memory (inc input)])] - (wrap (and (n.= none-output - open-output) - (n.< (milli-seconds none-time) - (milli-seconds open-time)) - (n.< (milli-seconds open-time) - (milli-seconds open-time/+1))))))) + [open-time/+1 _] (..time open [memory (inc input)]) + #let [same-output! + (n.= none-output + open-output) + + memo-is-faster! + (n.< (milli-seconds none-time) + (milli-seconds open-time)) + + incrementalism-is-faster! + ## the wiggle room is there to account for GC pauses + ## and other issues that might mess with duration + (let [wiggle-room 2] + (n.< (n.+ wiggle-room (milli-seconds open-time)) + (milli-seconds open-time/+1)))]] + (wrap (and same-output! + memo-is-faster! + incrementalism-is-faster!))))) (_.cover [/.memoization] (let [memo (<| //.mixin (//.inherit /.memoization) diff --git a/stdlib/source/test/lux/control/parser/text.lux b/stdlib/source/test/lux/control/parser/text.lux index dd5f4d6a8..486fc8798 100644 --- a/stdlib/source/test/lux/control/parser/text.lux +++ b/stdlib/source/test/lux/control/parser/text.lux @@ -13,7 +13,7 @@ ["%" format (#+ format)] ["." unicode #_ ["#" set] - ["#/." segment]]] + ["#/." block]]] [number ["n" nat]] [collection @@ -83,52 +83,52 @@ (..should-fail out-of-range (/.range offset limit))))) (do {! random.monad} [expected (random.char unicode.ascii/upper-alpha) - invalid (random.filter (|>> (unicode/segment.within? unicode/segment.basic-latin/upper-alpha) not) - (random.char unicode.full))] + invalid (random.filter (|>> (unicode/block.within? unicode/block.basic-latin/upper-alpha) not) + (random.char unicode.character))] (_.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/segment.within? unicode/segment.basic-latin/lower-alpha) not) - (random.char unicode.full))] + invalid (random.filter (|>> (unicode/block.within? unicode/block.basic-latin/lower-alpha) not) + (random.char unicode.character))] (_.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/segment.number-forms (list)]))] + invalid (random.char (unicode.set [unicode/block.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/segment.number-forms (list)]))] + invalid (random.char (unicode.set [unicode/block.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/segment.number-forms (list)]))] + invalid (random.char (unicode.set [unicode/block.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/segment.within? unicode/segment.basic-latin/upper-alpha char) - (unicode/segment.within? unicode/segment.basic-latin/lower-alpha char)))) - (random.char unicode.full))] + (not (or (unicode/block.within? unicode/block.basic-latin/upper-alpha char) + (unicode/block.within? unicode/block.basic-latin/lower-alpha char)))) + (random.char unicode.character))] (_.cover [/.alpha] (and (..should-pass (text.from-code expected) /.alpha) (..should-fail (text.from-code invalid) /.alpha)))) (do {! random.monad} [expected (random.char unicode.ascii/alpha-num) invalid (random.filter (function (_ 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))] + (not (or (unicode/block.within? unicode/block.basic-latin/upper-alpha char) + (unicode/block.within? unicode/block.basic-latin/lower-alpha char) + (unicode/block.within? unicode/block.basic-latin/decimal char)))) + (random.char unicode.character))] (_.cover [/.alpha-num] (and (..should-pass (text.from-code expected) /.alpha-num) (..should-fail (text.from-code invalid) /.alpha-num)))) @@ -152,11 +152,12 @@ (..should-fail invalid /.space)))) (do {! random.monad} [#let [num-options 3] - options (|> (random.char unicode.full) - (random.set n.hash num-options) - (\ ! map (|>> set.to-list - (list\map text.from-code) - (text.join-with "")))) + chars (random.set n.hash num-options + (random.char unicode.character)) + #let [options (|> chars + set.to-list + (list\map text.from-code) + (text.join-with ""))] expected (\ ! map (function (_ value) (|> options (text.nth (n.% num-options value)) @@ -165,7 +166,7 @@ invalid (random.filter (|>> text.from-code (text.contains? options) not) - (random.char unicode.full))] + (random.char unicode.character))] (_.cover [/.one-of /.one-of! /.character-should-be] (and (..should-pass (text.from-code expected) (/.one-of options)) (..should-fail (text.from-code invalid) (/.one-of options)) @@ -175,10 +176,11 @@ (..should-pass! (text.from-code expected) (/.one-of! options)) (..should-fail (text.from-code invalid) (/.one-of! options)) (..should-fail' (text.from-code invalid) (/.one-of! options) - /.character-should-be)))) + /.character-should-be) + ))) (do {! random.monad} [#let [num-options 3] - options (|> (random.char unicode.full) + options (|> (random.char unicode.character) (random.set n.hash num-options) (\ ! map (|>> set.to-list (list\map text.from-code) @@ -191,7 +193,7 @@ expected (random.filter (|>> text.from-code (text.contains? options) not) - (random.char unicode.full))] + (random.char unicode.character))] (_.cover [/.none-of /.none-of! /.character-should-not-be] (and (..should-pass (text.from-code expected) (/.none-of options)) (..should-fail (text.from-code invalid) (/.none-of options)) @@ -396,9 +398,9 @@ (text\= expected actual)))))) (do {! random.monad} [invalid (random.ascii/upper-alpha 1) - expected (random.filter (|>> (unicode/segment.within? unicode/segment.basic-latin/upper-alpha) + expected (random.filter (|>> (unicode/block.within? unicode/block.basic-latin/upper-alpha) not) - (random.char unicode.full)) + (random.char unicode.character)) #let [upper! (/.one-of! "ABCDEFGHIJKLMNOPQRSTUVWXYZ")]] (_.cover [/.not /.not! /.expected-to-fail] (and (..should-pass (text.from-code expected) (/.not /.upper)) @@ -416,9 +418,9 @@ [upper (random.ascii/upper-alpha 1) lower (random.ascii/lower-alpha 1) invalid (random.filter (function (_ 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)) + (not (or (unicode/block.within? unicode/block.basic-latin/upper-alpha char) + (unicode/block.within? unicode/block.basic-latin/lower-alpha char)))) + (random.char unicode.character)) #let [upper! (/.one-of! "ABCDEFGHIJKLMNOPQRSTUVWXYZ") lower! (/.one-of! "abcdefghijklmnopqrstuvwxyz")]] (_.cover [/.and /.and!] diff --git a/stdlib/source/test/lux/data/format/tar.lux b/stdlib/source/test/lux/data/format/tar.lux index 92f5915c7..7f271de05 100644 --- a/stdlib/source/test/lux/data/format/tar.lux +++ b/stdlib/source/test/lux/data/format/tar.lux @@ -17,7 +17,7 @@ ["." encoding] ["." unicode #_ ["#" set] - ["#/." segment]]] + ["#/." block]]] [number ["n" nat] ["i" int]] @@ -40,7 +40,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/segment.katakana (list)])) + not-ascii (random.text (random.char (unicode.set [unicode/block.katakana (list)])) /.path-size)] (`` ($_ _.and (_.cover [/.path /.from-path] @@ -73,7 +73,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/segment.katakana (list)])) + not-ascii (random.text (random.char (unicode.set [unicode/block.katakana (list)])) /.name-size)] (`` ($_ _.and (_.cover [/.name /.from-name] @@ -314,7 +314,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/segment.katakana (list)])) + not-ascii (random.text (random.char (unicode.set [unicode/block.katakana (list)])) /.name-size)] (_.for [/.Ownership /.Owner /.ID] ($_ _.and diff --git a/stdlib/source/test/lux/data/text/unicode/block.lux b/stdlib/source/test/lux/data/text/unicode/block.lux new file mode 100644 index 000000000..eb55617ca --- /dev/null +++ b/stdlib/source/test/lux/data/text/unicode/block.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 /.Block) + (do random.monad + [start random.nat + end random.nat] + (wrap (/.block start end)))) + +(with-expansions [<blocks> (as-is [blocks/0 + [/.basic-latin + /.latin-1-supplement + /.latin-extended-a + /.latin-extended-b + /.ipa-extensions + /.spacing-modifier-letters + /.combining-diacritical-marks + /.greek-and-coptic + /.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]] + [blocks/1 + [/.limbu + /.tai-le + /.khmer-symbols + /.phonetic-extensions + /.latin-extended-additional + /.greek-extended + /.general-punctuation + /.superscripts-and-subscripts + /.currency-symbols + /.combining-diacritical-marks-for-symbols + /.letterlike-symbols + /.number-forms + /.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]] + [blocks/2 + [/.arabic-presentation-forms-a + /.variation-selectors + /.combining-half-marks + /.cjk-compatibility-forms + /.small-form-variants + /.arabic-presentation-forms-b + /.halfwidth-and-fullwidth-forms + /.specials + + ## Specialized blocks + /.basic-latin/decimal + /.basic-latin/upper-alpha + /.basic-latin/lower-alpha]] + ) + <named> (template [<definition> <part>] + [((: (-> Any (List /.Block)) + (function (_ _) + (`` (list (~~ (template.splice <part>)))))) + [])] + + <blocks>)] + (template [<definition> <part>] + [(def: <definition> + Test + (`` (_.cover [(~~ (template.splice <part>))] + (let [all (list.concat (list <named>)) + unique (set.from-list /.hash all)] + (n.= (list.size all) + (set.size unique))))))] + + <blocks> + ) + + (def: #export test + Test + (<| (_.covering /._) + (_.for [/.Block]) + (do {! random.monad} + [#let [top-start (hex "AC00") + top-end (hex "D7AF")] + start (\ ! map (|>> (n.% top-start) inc) random.nat) + end (\ ! map (|>> (n.% top-end) inc) random.nat) + #let [sample (/.block 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 [/.block] + (\ /.equivalence = + (/.block start end) + (/.block end start))) + (_.cover [/.start] + (n.= (n.min start end) + (/.start (/.block start end)))) + (_.cover [/.end] + (n.= (n.max start end) + (/.end (/.block start end)))) + (_.cover [/.size] + (n.= (inc (n.- (n.min start end) + (n.max start end))) + (/.size (/.block start end)))) + (_.cover [/.within?] + (and (/.within? sample inside) + (not (/.within? sample (dec (/.start sample)))) + (not (/.within? sample (inc (/.end sample)))))) + (~~ (template [<definition> <part>] + [<definition>] + + <blocks>)) + ))))) + ) diff --git a/stdlib/source/test/lux/data/text/unicode/segment.lux b/stdlib/source/test/lux/data/text/unicode/segment.lux deleted file mode 100644 index 62a399cd1..000000000 --- a/stdlib/source/test/lux/data/text/unicode/segment.lux +++ /dev/null @@ -1,211 +0,0 @@ -(.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 [<segments> (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]] - ) - <named> (template [<definition> <part>] - [((: (-> Any (List /.Segment)) - (function (_ _) - (`` (list (~~ (template.splice <part>)))))) - [])] - - <segments>)] - (template [<definition> <part>] - [(def: <definition> - Test - (`` (_.cover [(~~ (template.splice <part>))] - (let [all (list.concat (list <named>)) - unique (set.from-list /.hash all)] - (n.= (list.size all) - (set.size unique))))))] - - <segments> - ) - - (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 [<definition> <part>] - [<definition>] - - <segments>)) - ))))) - ) diff --git a/stdlib/source/test/lux/data/text/unicode/set.lux b/stdlib/source/test/lux/data/text/unicode/set.lux index 21c5a90f1..16e29d368 100644 --- a/stdlib/source/test/lux/data/text/unicode/set.lux +++ b/stdlib/source/test/lux/data/text/unicode/set.lux @@ -17,17 +17,17 @@ ["." random (#+ Random)]]] ["." / #_ ["/#" // #_ - ["#." segment]]] + ["#." block]]] {1 ["." / [// - ["." segment]]]}) + ["." block]]]}) (def: #export random (Random /.Set) (do {! random.monad} - [left //segment.random - right //segment.random] + [left //block.random + right //block.random] (wrap (/.set [left (list right)])))) (def: #export test @@ -35,13 +35,13 @@ (<| (_.covering /._) (_.for [/.Set]) (do {! random.monad} - [segment //segment.random + [block //block.random inside (\ ! map - (|>> (n.% (segment.size segment)) - (n.+ (segment.start segment))) + (|>> (n.% (block.size block)) + (n.+ (block.start block))) random.nat) - left //segment.random - right //segment.random + left //block.random + right //block.random #let [equivalence (product.equivalence n.equivalence n.equivalence)]] (`` ($_ _.and @@ -50,21 +50,21 @@ (_.cover [/.range] (let [[start end] (/.range (/.set [left (list right)]))] - (and (n.= (n.min (segment.start left) - (segment.start right)) + (and (n.= (n.min (block.start left) + (block.start right)) start) - (n.= (n.max (segment.end left) - (segment.end right)) + (n.= (n.max (block.end left) + (block.end right)) end)))) (_.cover [/.member?] - (bit\= (segment.within? segment inside) - (/.member? (/.set [segment (list)]) inside))) + (bit\= (block.within? block inside) + (/.member? (/.set [block (list)]) inside))) (_.cover [/.compose] (\ equivalence = - [(n.min (segment.start left) - (segment.start right)) - (n.max (segment.end left) - (segment.end right))] + [(n.min (block.start left) + (block.start right)) + (n.max (block.end left) + (block.end right))] (/.range (/.compose (/.set [left (list)]) (/.set [right (list)]))))) (_.cover [/.set] @@ -86,8 +86,10 @@ [/.ascii/alpha-num] [/.ascii/lower-alpha] [/.ascii/upper-alpha] + [/.character] + [/.non-character] [/.full] )) - //segment.test + //block.test ))))) diff --git a/stdlib/source/test/lux/macro/syntax/common.lux b/stdlib/source/test/lux/macro/syntax/common.lux index 9fcb10006..98b3cdc0c 100644 --- a/stdlib/source/test/lux/macro/syntax/common.lux +++ b/stdlib/source/test/lux/macro/syntax/common.lux @@ -29,7 +29,8 @@ ["." /// #_ ["#." code]] ["." / #_ - ["#." check]]) + ["#." check] + ["#." definition]]) (def: annotations-equivalence (Equivalence /.Annotations) @@ -136,4 +137,5 @@ false)))) /check.test + /definition.test ))) diff --git a/stdlib/source/test/lux/macro/syntax/common/check.lux b/stdlib/source/test/lux/macro/syntax/common/check.lux index 63d042620..6b4a4ab3d 100644 --- a/stdlib/source/test/lux/macro/syntax/common/check.lux +++ b/stdlib/source/test/lux/macro/syntax/common/check.lux @@ -2,7 +2,10 @@ [lux #* ["_" test (#+ Test)] [abstract - [monad (#+ do)]] + [monad (#+ do)] + {[0 #spec] + [/ + ["$." equivalence]]}] [control ["." try] ["<>" parser @@ -16,20 +19,30 @@ ["$." //// #_ ["#." code]]) +(def: #export random + (Random /.Check) + ($_ random.and + $////code.random + $////code.random + )) + (def: #export test Test (<| (_.covering /._) (_.for [/.Check]) - (do random.monad - [type $////code.random - value $////code.random] - (_.cover [/.write /.parser] - (case (<code>.run /.parser - (list (/.write {#/.type type - #/.value value}))) - (#try.Failure _) - false - - (#try.Success check) - (and (code\= type (get@ #/.type check)) - (code\= value (get@ #/.value check)))))))) + ($_ _.and + (_.for [/.equivalence] + ($equivalence.spec /.equivalence ..random)) + + (do random.monad + [[type value] ..random] + (_.cover [/.write /.parser] + (case (<code>.run /.parser + (list (/.write {#/.type type + #/.value value}))) + (#try.Failure _) + false + + (#try.Success check) + (and (code\= type (get@ #/.type check)) + (code\= value (get@ #/.value check))))))))) diff --git a/stdlib/source/test/lux/macro/syntax/common/definition.lux b/stdlib/source/test/lux/macro/syntax/common/definition.lux new file mode 100644 index 000000000..4e3352e40 --- /dev/null +++ b/stdlib/source/test/lux/macro/syntax/common/definition.lux @@ -0,0 +1,103 @@ +(.module: + [lux #* + ["_" test (#+ Test)] + [abstract + [monad (#+ do)] + {[0 #spec] + [/ + ["$." equivalence]]}] + [control + ["." try] + ["." exception] + ["<>" parser + ["<.>" code]]] + [math + ["." random (#+ Random)]] + [macro + ["." code ("#\." equivalence)]] + [meta + ["." location]]] + {1 + ["." / + [// (#+ Annotations)]]} + ["$."// #_ + ["#." check] + ["#//" /// #_ + ["#." code]]]) + +(def: random-annotations + (Random Annotations) + (let [name (random.and (random.ascii/alpha 5) + (random.ascii/alpha 5))] + (random.list 5 (random.and name $////code.random)))) + +(def: #export random + (Random /.Definition) + ($_ random.and + (random.ascii/alpha 5) + (random.or $//check.random + $////code.random) + ..random-annotations + random.bit + )) + +(def: compiler + {#.info {#.target "FAKE" + #.version "0.0.0" + #.mode #.Build} + #.source [location.dummy 0 ""] + #.location location.dummy + #.current-module #.None + #.modules (list) + #.scopes (list) + #.type-context {#.ex-counter 0 + #.var-counter 0 + #.var-bindings (list)} + #.expected #.None + #.seed 0 + #.scope-type-vars (list) + #.extensions [] + #.host []}) + +(def: #export test + Test + (<| (_.covering /._) + (_.for [/.Definition]) + ($_ _.and + (_.for [/.equivalence] + ($equivalence.spec /.equivalence ..random)) + + (do random.monad + [expected ..random + + type $////code.random + untyped-value $////code.random] + ($_ _.and + (_.cover [/.write /.parser] + (case (<code>.run (/.parser compiler) + (list (/.write expected))) + (#try.Failure error) + false + + (#try.Success actual) + (\ /.equivalence = expected actual))) + (_.cover [/.typed] + (let [expected (set@ #/.value (#.Left [type untyped-value]) expected)] + (case (<code>.run (/.typed compiler) + (list (/.write expected))) + (#try.Failure error) + false + + (#try.Success actual) + (\ /.equivalence = expected actual)))) + (_.cover [/.lacks-type!] + (let [expected (set@ #/.value (#.Right untyped-value) expected)] + (case (<code>.run (/.typed compiler) + (list (/.write expected))) + (#try.Failure error) + (exception.match? /.lacks-type! error) + + (#try.Success actual) + false))) + ))) + )) diff --git a/stdlib/source/test/lux/math/infix.lux b/stdlib/source/test/lux/math/infix.lux index aeba020d5..d9c15a2e5 100644 --- a/stdlib/source/test/lux/math/infix.lux +++ b/stdlib/source/test/lux/math/infix.lux @@ -1,45 +1,63 @@ (.module: [lux #* - ["%" data/text/format (#+ format)] - [abstract/monad (#+ do)] - ["r" math/random] ["_" test (#+ Test)] + [abstract + [monad (#+ do)]] [data ["." bit ("#\." equivalence)] [number ["n" nat] - ["f" frac]]]] + ["f" frac]]] + [math + ["." random]]] {1 ["." / ["." //]]}) (def: #export test Test - (<| (_.context (%.name (name-of /._))) - (do r.monad - [subject r.nat - parameter r.nat - extra r.nat - angle r.safe-frac] - ($_ _.and - (_.test "Constant values don't change." - (n.= subject - (/.infix subject))) - (_.test "Can call binary functions." - (n.= (n.gcd parameter subject) - (/.infix [subject n.gcd parameter]))) - (_.test "Can call unary functions." - (f.= (//.sin angle) - (/.infix [//.sin angle]))) - (_.test "Can use regular syntax in the middle of infix code." - (n.= (n.gcd extra (n.* parameter subject)) - (/.infix [(n.* parameter subject) n.gcd extra]))) - (_.test "Can use non-numerical functions/macros as operators." - (bit\= (and (n.< parameter subject) (n.< extra parameter)) - (/.infix [[subject n.< parameter] and [parameter n.< extra]]))) - (_.test "Can combine bit operations in special ways via special keywords." - (and (bit\= (and (n.< parameter subject) (n.< extra parameter)) - (/.infix [#and subject n.< parameter n.< extra])) - (bit\= (and (n.< parameter subject) (n.> extra parameter)) - (/.infix [#and subject n.< parameter n.> extra])))) - )))) + (<| (_.covering /._) + (do random.monad + [subject random.nat + parameter random.nat + extra random.nat + angle random.safe-frac + factor random.nat] + (_.cover [/.infix] + (let [constant-values! + (n.= subject + (/.infix subject)) + + unary-functions! + (f.= (//.sin angle) + (/.infix [//.sin angle])) + + binary-functions! + (n.= (n.gcd parameter subject) + (/.infix [subject n.gcd parameter])) + + multiple-binary-functions! + (n.= (n.* factor (n.gcd parameter subject)) + (/.infix [subject n.gcd parameter n.* factor])) + + function-call! + (n.= (n.gcd extra (n.* parameter subject)) + (/.infix [(n.* parameter subject) n.gcd extra])) + + non-numeric! + (bit\= (and (n.< parameter subject) (n.< extra parameter)) + (/.infix [[subject n.< parameter] and [parameter n.< extra]])) + + and-composition! + (and (bit\= (and (n.< parameter subject) (n.< extra parameter)) + (/.infix [#and subject n.< parameter n.< extra])) + (bit\= (and (n.< parameter subject) (n.> extra parameter)) + (/.infix [#and subject n.< parameter n.> extra])))] + (and constant-values! + unary-functions! + binary-functions! + multiple-binary-functions! + function-call! + non-numeric! + and-composition! + )))))) |