aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/test
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--stdlib/source/test/lux/abstract.lux13
-rw-r--r--stdlib/source/test/lux/abstract/equivalence.lux20
-rw-r--r--stdlib/source/test/lux/abstract/functor/contravariant.lux10
-rw-r--r--stdlib/source/test/lux/abstract/order.lux23
-rw-r--r--stdlib/source/test/lux/data.lux2
-rw-r--r--stdlib/source/test/lux/data/format/tar.lux409
6 files changed, 470 insertions, 7 deletions
diff --git a/stdlib/source/test/lux/abstract.lux b/stdlib/source/test/lux/abstract.lux
index ef7cb0774..aa93df86f 100644
--- a/stdlib/source/test/lux/abstract.lux
+++ b/stdlib/source/test/lux/abstract.lux
@@ -14,7 +14,16 @@
["#." monad]
["#." monoid]
["#." order]
- ["#." predicate]])
+ ["#." predicate]
+ [functor
+ ["#." contravariant]]])
+
+(def: functor
+ Test
+ ($_ _.and
+ /functor.test
+ /contravariant.test
+ ))
(def: #export test
Test
@@ -25,7 +34,7 @@
/enum.test
/equivalence.test
/fold.test
- /functor.test
+ ..functor
/hash.test
/interval.test
/monad.test
diff --git a/stdlib/source/test/lux/abstract/equivalence.lux b/stdlib/source/test/lux/abstract/equivalence.lux
index 7cc5c95f9..d79803e31 100644
--- a/stdlib/source/test/lux/abstract/equivalence.lux
+++ b/stdlib/source/test/lux/abstract/equivalence.lux
@@ -1,7 +1,12 @@
(.module:
[lux #*
["_" test (#+ Test)]
- [abstract/monad (#+ do)]
+ [abstract
+ [monad (#+ do)]
+ {[0 #spec]
+ [/
+ [functor
+ ["." contravariant]]]}]
[data
["." bit ("#@." equivalence)]
[number
@@ -20,9 +25,20 @@
leftI random.int
rightI random.int
sample random.nat
- different (|> random.nat (random.filter (|>> (n.= sample) not)))]
+ different (|> random.nat (random.filter (|>> (n.= sample) not)))
+ #let [equivalence (: (Equivalence (Equivalence Nat))
+ (structure
+ (def: (= left right)
+ (and (bit@= (:: left = leftN leftN)
+ (:: right = leftN leftN))
+ (bit@= (:: left = rightN rightN)
+ (:: right = rightN rightN))
+ (bit@= (:: left = leftN rightN)
+ (:: right = leftN rightN))))))]]
(<| (_.covering /._)
($_ _.and
+ (_.with-cover [/.functor]
+ (contravariant.spec equivalence n.equivalence /.functor))
(_.cover [/.sum]
(let [equivalence (/.sum n.equivalence i.equivalence)]
(and (bit@= (:: n.equivalence = leftN leftN)
diff --git a/stdlib/source/test/lux/abstract/functor/contravariant.lux b/stdlib/source/test/lux/abstract/functor/contravariant.lux
new file mode 100644
index 000000000..93d1f18ad
--- /dev/null
+++ b/stdlib/source/test/lux/abstract/functor/contravariant.lux
@@ -0,0 +1,10 @@
+(.module:
+ [lux #*
+ ["_" test (#+ Test)]]
+ {1
+ ["." /]})
+
+(def: #export test
+ Test
+ (<| (_.covering /._)
+ (_.in-parallel (list))))
diff --git a/stdlib/source/test/lux/abstract/order.lux b/stdlib/source/test/lux/abstract/order.lux
index 7157a6c01..dff849034 100644
--- a/stdlib/source/test/lux/abstract/order.lux
+++ b/stdlib/source/test/lux/abstract/order.lux
@@ -2,7 +2,11 @@
[lux #*
["_" test (#+ Test)]
[abstract
- [monad (#+ do)]]
+ [monad (#+ do)]
+ {[0 #spec]
+ [/
+ [functor
+ ["." contravariant]]]}]
[data
["." bit ("#@." equivalence)]
[number
@@ -10,15 +14,28 @@
[math
["." random (#+ Random)]]]
{1
- ["." / (#+ Order)]})
+ ["." / (#+ Order)
+ [//
+ [equivalence (#+ Equivalence)]]]})
(def: #export test
Test
(<| (_.covering /._)
(do random.monad
[left random.nat
- right (|> random.nat (random.filter (|>> (n.= left) not)))])
+ right (|> random.nat (random.filter (|>> (n.= left) not)))
+ #let [equivalence (: (Equivalence (Order Nat))
+ (structure
+ (def: (= leftO rightO)
+ (and (bit@= (:: leftO < left left)
+ (:: rightO < left left))
+ (bit@= (:: leftO < right right)
+ (:: rightO < right right))
+ (bit@= (:: leftO < left right)
+ (:: rightO < left right))))))]])
($_ _.and
+ (_.with-cover [/.functor]
+ (contravariant.spec equivalence n.order /.functor))
(_.cover [/.Choice /.min /.max]
(n.< (/.max n.order left right)
(/.min n.order left right)))
diff --git a/stdlib/source/test/lux/data.lux b/stdlib/source/test/lux/data.lux
index fa544ccd5..47a79b530 100644
--- a/stdlib/source/test/lux/data.lux
+++ b/stdlib/source/test/lux/data.lux
@@ -30,6 +30,7 @@
["#/." regex]]
[format
["#." json]
+ ["#." tar]
["#." xml]]
["#." collection]])
@@ -71,6 +72,7 @@
(def: format
($_ _.and
/json.test
+ /tar.test
/xml.test
))
diff --git a/stdlib/source/test/lux/data/format/tar.lux b/stdlib/source/test/lux/data/format/tar.lux
new file mode 100644
index 000000000..b8ba1af51
--- /dev/null
+++ b/stdlib/source/test/lux/data/format/tar.lux
@@ -0,0 +1,409 @@
+(.module:
+ [lux #*
+ ["_" test (#+ Test)]
+ [abstract
+ [monad (#+ do)]]
+ [control
+ ["." try]
+ ["." exception]
+ ["<>" parser
+ ["<b>" binary]]]
+ [data
+ ["." product]
+ ["." maybe]
+ ["." binary ("#@." equivalence)]
+ ["." text ("#@." equivalence)
+ ["." encoding]
+ ["." unicode]
+ ["%" format (#+ format)]]
+ [number
+ ["n" nat]
+ ["i" int]]
+ [collection
+ ["." row]
+ ["." list ("#@." fold)]]
+ ["." format #_
+ ["#" binary]]]
+ [time
+ ["." instant (#+ Instant)]
+ ["." duration]]
+ [math
+ ["." random (#+ Random)]]]
+ {1
+ ["." /]})
+
+(def: path
+ Test
+ (_.with-cover [/.Path]
+ (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 (list unicode.katakana)))
+ /.path-size)]
+ (`` ($_ _.and
+ (_.cover [/.path /.from-path]
+ (case (/.path expected)
+ (#try.Success actual)
+ (text@= expected
+ (/.from-path actual))
+
+ (#try.Failure error)
+ false))
+ (_.cover [/.path-size /.path-is-too-long]
+ (case (/.path invalid)
+ (#try.Success _)
+ false
+
+ (#try.Failure error)
+ (exception.match? /.path-is-too-long error)))
+ (_.cover [/.not-ascii]
+ (case (/.path not-ascii)
+ (#try.Success actual)
+ false
+
+ (#try.Failure error)
+ (exception.match? /.not-ascii error)))
+ )))))
+
+(def: name
+ Test
+ (_.with-cover [/.Name]
+ (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 (list unicode.katakana)))
+ /.name-size)]
+ (`` ($_ _.and
+ (_.cover [/.name /.from-name]
+ (case (/.name expected)
+ (#try.Success actual)
+ (text@= expected
+ (/.from-name actual))
+
+ (#try.Failure error)
+ false))
+ (_.cover [/.name-size /.name-is-too-long]
+ (case (/.name invalid)
+ (#try.Success _)
+ false
+
+ (#try.Failure error)
+ (exception.match? /.name-is-too-long error)))
+ (_.cover [/.not-ascii]
+ (case (/.name not-ascii)
+ (#try.Success actual)
+ false
+
+ (#try.Failure error)
+ (exception.match? /.not-ascii error)))
+ )))))
+
+(def: small
+ Test
+ (_.with-cover [/.Small]
+ (do {@ random.monad}
+ [expected (|> random.nat (:: @ map (n.% /.small-limit)))
+ invalid (|> random.nat (:: @ map (n.max /.small-limit)))]
+ (`` ($_ _.and
+ (_.cover [/.small /.from-small]
+ (case (/.small expected)
+ (#try.Success actual)
+ (n.= expected
+ (/.from-small actual))
+
+ (#try.Failure error)
+ false))
+ (_.cover [/.small-limit /.not-a-small-number]
+ (case (/.small invalid)
+ (#try.Success actual)
+ false
+
+ (#try.Failure error)
+ (exception.match? /.not-a-small-number error)))
+ )))))
+
+(def: big
+ Test
+ (_.with-cover [/.Big]
+ (do {@ random.monad}
+ [expected (|> random.nat (:: @ map (n.% /.big-limit)))
+ invalid (|> random.nat (:: @ map (n.max /.big-limit)))]
+ (`` ($_ _.and
+ (_.cover [/.big /.from-big]
+ (case (/.big expected)
+ (#try.Success actual)
+ (n.= expected
+ (/.from-big actual))
+
+ (#try.Failure error)
+ false))
+ (_.cover [/.big-limit /.not-a-big-number]
+ (case (/.big invalid)
+ (#try.Success actual)
+ false
+
+ (#try.Failure error)
+ (exception.match? /.not-a-big-number error)))
+ )))))
+
+(def: chunk-size 32)
+
+(def: entry
+ Test
+ (do {@ random.monad}
+ [expected-path (random.ascii/lower-alpha (dec /.path-size))
+ expected-moment (:: @ map (|>> (n.% 1,00,00,00,00,00,000) .int instant.from-millis)
+ random.nat)
+ chunk (random.ascii/lower-alpha chunk-size)
+ chunks (:: @ map (n.% 100) random.nat)
+ #let [content (|> chunk
+ (list.repeat chunks)
+ (text.join-with "")
+ encoding.to-utf8)]]
+ (`` ($_ _.and
+ (~~ (template [<type> <tag>]
+ [(_.cover [<type>]
+ (|> (do try.monad
+ [expected-path (/.path expected-path)
+ tar (|> (row.row (<tag> expected-path))
+ (format.run /.writer)
+ (<b>.run /.parser))]
+ (wrap (case (row.to-list tar)
+ (^ (list (<tag> actual-path)))
+ (text@= (/.from-path expected-path)
+ (/.from-path actual-path))
+
+ _
+ false)))
+ (try.default false)))]
+
+ [/.Symbolic-Link #/.Symbolic-Link]
+ [/.Directory #/.Directory]
+ ))
+ (_.with-cover [/.File /.Content /.content /.data]
+ ($_ _.and
+ (~~ (template [<type> <tag>]
+ [(_.cover [<type>]
+ (|> (do try.monad
+ [expected-path (/.path expected-path)
+ expected-content (/.content content)
+ tar (|> (row.row (<tag> [expected-path
+ expected-moment
+ /.none
+ {#/.user {#/.name /.anonymous
+ #/.id /.no-id}
+ #/.group {#/.name /.anonymous
+ #/.id /.no-id}}
+ expected-content]))
+ (format.run /.writer)
+ (<b>.run /.parser))]
+ (wrap (case (row.to-list tar)
+ (^ (list (<tag> [actual-path actual-moment actual-mode actual-ownership actual-content])))
+ (let [seconds (: (-> Instant Int)
+ (|>> instant.relative (duration.query duration.second)))]
+ (and (text@= (/.from-path expected-path)
+ (/.from-path actual-path))
+ (i.= (seconds expected-moment)
+ (seconds actual-moment))
+ (binary@= (/.data expected-content)
+ (/.data actual-content))))
+
+ _
+ false)))
+ (try.default false)))]
+
+ [/.Normal #/.Normal]
+ [/.Contiguous #/.Contiguous]
+ ))))))))
+
+(def: random-mode
+ (Random /.Mode)
+ (do {@ random.monad}
+ []
+ (random.either (random.either (random.either (wrap /.execute-by-other)
+ (wrap /.write-by-other))
+ (random.either (wrap /.read-by-other)
+ (wrap /.execute-by-group)))
+ (random.either (random.either (random.either (wrap /.write-by-group)
+ (wrap /.read-by-group))
+ (random.either (wrap /.execute-by-owner)
+ (wrap /.write-by-owner)))
+ (random.either (random.either (wrap /.read-by-owner)
+ (wrap /.save-text))
+ (random.either (wrap /.set-group-id-on-execution)
+ (wrap /.set-user-id-on-execution)))))))
+
+(def: mode
+ Test
+ (_.with-cover [/.Mode /.mode]
+ (do {@ random.monad}
+ [path (random.ascii/lower-alpha 10)
+ modes (random.list 4 ..random-mode)
+ #let [expected-mode (list@fold /.and /.none modes)]]
+ (`` ($_ _.and
+ (_.cover [/.and]
+ (|> (do try.monad
+ [path (/.path path)
+ content (/.content (binary.create 0))
+ tar (|> (row.row (#/.Normal [path
+ (instant.from-millis +0)
+ expected-mode
+ {#/.user {#/.name /.anonymous
+ #/.id /.no-id}
+ #/.group {#/.name /.anonymous
+ #/.id /.no-id}}
+ content]))
+ (format.run /.writer)
+ (<b>.run /.parser))]
+ (wrap (case (row.to-list tar)
+ (^ (list (#/.Normal [_ _ actual-mode _ _])))
+ (n.= (/.mode expected-mode)
+ (/.mode actual-mode))
+
+ _
+ false)))
+ (try.default false)))
+ (~~ (template [<expected-mode>]
+ [(_.cover [<expected-mode>]
+ (|> (do try.monad
+ [path (/.path path)
+ content (/.content (binary.create 0))
+ tar (|> (row.row (#/.Normal [path
+ (instant.from-millis +0)
+ <expected-mode>
+ {#/.user {#/.name /.anonymous
+ #/.id /.no-id}
+ #/.group {#/.name /.anonymous
+ #/.id /.no-id}}
+ content]))
+ (format.run /.writer)
+ (<b>.run /.parser))]
+ (wrap (case (row.to-list tar)
+ (^ (list (#/.Normal [_ _ actual-mode _ _])))
+ (n.= (/.mode <expected-mode>)
+ (/.mode actual-mode))
+
+ _
+ false)))
+ (try.default false)))]
+
+ [/.none]
+
+ [/.execute-by-other]
+ [/.write-by-other]
+ [/.read-by-other]
+
+ [/.execute-by-group]
+ [/.write-by-group]
+ [/.read-by-group]
+
+ [/.execute-by-owner]
+ [/.write-by-owner]
+ [/.read-by-owner]
+
+ [/.save-text]
+ [/.set-group-id-on-execution]
+ [/.set-user-id-on-execution]
+ )))))))
+
+(def: ownership
+ Test
+ (do {@ random.monad}
+ [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 (list unicode.katakana)))
+ /.name-size)]
+ (_.with-cover [/.Ownership /.Owner /.ID]
+ ($_ _.and
+ (_.cover [/.name-size /.name-is-too-long]
+ (case (/.name invalid)
+ (#try.Success _)
+ false
+
+ (#try.Failure error)
+ (exception.match? /.name-is-too-long error)))
+ (_.cover [/.not-ascii]
+ (case (/.name not-ascii)
+ (#try.Success actual)
+ false
+
+ (#try.Failure error)
+ (exception.match? /.not-ascii error)))
+ (_.cover [/.Name /.name /.from-name]
+ (|> (do try.monad
+ [path (/.path path)
+ content (/.content (binary.create 0))
+ expected (/.name expected)
+ tar (|> (row.row (#/.Normal [path
+ (instant.from-millis +0)
+ /.none
+ {#/.user {#/.name expected
+ #/.id /.no-id}
+ #/.group {#/.name /.anonymous
+ #/.id /.no-id}}
+ content]))
+ (format.run /.writer)
+ (<b>.run /.parser))]
+ (wrap (case (row.to-list tar)
+ (^ (list (#/.Normal [_ _ _ actual-ownership _])))
+ (and (text@= (/.from-name expected)
+ (/.from-name (get@ [#/.user #/.name] actual-ownership)))
+ (text@= (/.from-name /.anonymous)
+ (/.from-name (get@ [#/.group #/.name] actual-ownership))))
+
+ _
+ false)))
+ (try.default false)))
+ (_.cover [/.anonymous /.no-id]
+ (|> (do try.monad
+ [path (/.path path)
+ content (/.content (binary.create 0))
+ tar (|> (row.row (#/.Normal [path
+ (instant.from-millis +0)
+ /.none
+ {#/.user {#/.name /.anonymous
+ #/.id /.no-id}
+ #/.group {#/.name /.anonymous
+ #/.id /.no-id}}
+ content]))
+ (format.run /.writer)
+ (<b>.run /.parser))]
+ (wrap (case (row.to-list tar)
+ (^ (list (#/.Normal [_ _ _ actual-ownership _])))
+ (and (text@= (/.from-name /.anonymous)
+ (/.from-name (get@ [#/.user #/.name] actual-ownership)))
+ (n.= (/.from-small /.no-id)
+ (/.from-small (get@ [#/.user #/.id] actual-ownership)))
+ (text@= (/.from-name /.anonymous)
+ (/.from-name (get@ [#/.group #/.name] actual-ownership)))
+ (n.= (/.from-small /.no-id)
+ (/.from-small (get@ [#/.group #/.id] actual-ownership))))
+
+ _
+ false)))
+ (try.default false)))
+ ))))
+
+(def: #export test
+ Test
+ (<| (_.covering /._)
+ (_.with-cover [/.Tar]
+ ($_ _.and
+ (_.cover [/.writer /.parser]
+ (|> row.empty
+ (format.run /.writer)
+ (<b>.run /.parser)
+ (:: try.monad map row.empty?)
+ (try.default false)))
+ ..path
+ ..name
+ ..small
+ ..big
+ (_.with-cover [/.Entry]
+ ($_ _.and
+ ..entry
+ ..mode
+ ..ownership
+ ))
+ ))))
generated by cgit v1.2.3 (git 2.25.1) at 2024-08-22 19:00:22 +0000