aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/test/lux/data
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--stdlib/source/test/lux/data/collection/tree/finger.lux18
-rw-r--r--stdlib/source/test/lux/data/format/tar.lux11
-rw-r--r--stdlib/source/test/lux/data/text.lux4
-rw-r--r--stdlib/source/test/lux/data/text/regex.lux72
-rw-r--r--stdlib/source/test/lux/data/text/unicode.lux91
-rw-r--r--stdlib/source/test/lux/data/text/unicode/segment.lux211
6 files changed, 361 insertions, 46 deletions
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 [<set>]
+ [(do random.monad
+ [char (random.char <set>)
+ #let [[start end] (/.range <set>)]]
+ (_.cover [<set>]
+ (and (/.member? <set> char)
+ (not (/.member? <set> (dec start)))
+ (not (/.member? <set> (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 [<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>))
+ )))))
+ )
generated by cgit v1.2.3 (git 2.25.1) at 2025-01-11 09:58:07 +0000