aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/test
diff options
context:
space:
mode:
Diffstat (limited to 'stdlib/source/test')
-rw-r--r--stdlib/source/test/aedifex.lux4
-rw-r--r--stdlib/source/test/aedifex/command/deploy.lux10
-rw-r--r--stdlib/source/test/aedifex/dependency/status.lux34
-rw-r--r--stdlib/source/test/aedifex/hash.lux2
-rw-r--r--stdlib/source/test/aedifex/metadata.lux8
-rw-r--r--stdlib/source/test/aedifex/repository.lux30
-rw-r--r--stdlib/source/test/lux/control.lux16
-rw-r--r--stdlib/source/test/lux/control/function.lux10
-rw-r--r--stdlib/source/test/lux/control/function/memo.lux27
-rw-r--r--stdlib/source/test/lux/control/parser/text.lux60
-rw-r--r--stdlib/source/test/lux/data/format/tar.lux8
-rw-r--r--stdlib/source/test/lux/data/text/unicode/block.lux211
-rw-r--r--stdlib/source/test/lux/data/text/unicode/segment.lux211
-rw-r--r--stdlib/source/test/lux/data/text/unicode/set.lux42
-rw-r--r--stdlib/source/test/lux/macro/syntax/common.lux4
-rw-r--r--stdlib/source/test/lux/macro/syntax/common/check.lux41
-rw-r--r--stdlib/source/test/lux/macro/syntax/common/definition.lux103
-rw-r--r--stdlib/source/test/lux/math/infix.lux82
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!
+ ))))))