aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/test/lux/data/format/tar.lux
diff options
context:
space:
mode:
Diffstat (limited to 'stdlib/source/test/lux/data/format/tar.lux')
-rw-r--r--stdlib/source/test/lux/data/format/tar.lux592
1 files changed, 296 insertions, 296 deletions
diff --git a/stdlib/source/test/lux/data/format/tar.lux b/stdlib/source/test/lux/data/format/tar.lux
index 374c068a8..fc92947ff 100644
--- a/stdlib/source/test/lux/data/format/tar.lux
+++ b/stdlib/source/test/lux/data/format/tar.lux
@@ -34,117 +34,117 @@
(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 [unicode.katakana (list)]))
- /.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)))
- )))))
+ (_.for [/.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 [unicode.katakana (list)]))
+ /.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 [unicode.katakana (list)]))
- /.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)))
- )))))
+ (_.for [/.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 [unicode.katakana (list)]))
+ /.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)))
- )))))
+ (_.for [/.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)))
- )))))
+ (_.for [/.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)
@@ -180,41 +180,41 @@
[/.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]
- ))))))))
+ (_.for [/.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)
@@ -235,76 +235,76 @@
(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]
- )))))))
+ (_.for [/.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
@@ -314,96 +314,96 @@
invalid (random.ascii/lower-alpha (inc /.name-size))
not-ascii (random.text (random.char (unicode.set [unicode.katakana (list)]))
/.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)))
- ))))
+ (_.for [/.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
- ))
- ))))
+ (_.for [/.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
+ (_.for [/.Entry]
+ ($_ _.and
+ ..entry
+ ..mode
+ ..ownership
+ ))
+ ))))
generated by cgit v1.2.3 (git 2.25.1) at 2024-10-04 04:16:57 +0000