From 2139e72d8e7c58cb355799d4a8412a0c38fb481c Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Thu, 28 May 2020 02:18:02 -0400 Subject: Can now parse TAR files. --- stdlib/source/test/lux/abstract.lux | 13 +- stdlib/source/test/lux/abstract/equivalence.lux | 20 +- .../test/lux/abstract/functor/contravariant.lux | 10 + stdlib/source/test/lux/abstract/order.lux | 23 +- stdlib/source/test/lux/data.lux | 2 + stdlib/source/test/lux/data/format/tar.lux | 409 +++++++++++++++++++++ 6 files changed, 470 insertions(+), 7 deletions(-) create mode 100644 stdlib/source/test/lux/abstract/functor/contravariant.lux create mode 100644 stdlib/source/test/lux/data/format/tar.lux (limited to 'stdlib/source/test') 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 + ["" 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 [ ] + [(_.cover [] + (|> (do try.monad + [expected-path (/.path expected-path) + tar (|> (row.row ( expected-path)) + (format.run /.writer) + (.run /.parser))] + (wrap (case (row.to-list tar) + (^ (list ( 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 [ ] + [(_.cover [] + (|> (do try.monad + [expected-path (/.path expected-path) + expected-content (/.content content) + tar (|> (row.row ( [expected-path + expected-moment + /.none + {#/.user {#/.name /.anonymous + #/.id /.no-id} + #/.group {#/.name /.anonymous + #/.id /.no-id}} + expected-content])) + (format.run /.writer) + (.run /.parser))] + (wrap (case (row.to-list tar) + (^ (list ( [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) + (.run /.parser))] + (wrap (case (row.to-list tar) + (^ (list (#/.Normal [_ _ actual-mode _ _]))) + (n.= (/.mode expected-mode) + (/.mode actual-mode)) + + _ + false))) + (try.default false))) + (~~ (template [] + [(_.cover [] + (|> (do try.monad + [path (/.path path) + content (/.content (binary.create 0)) + tar (|> (row.row (#/.Normal [path + (instant.from-millis +0) + + {#/.user {#/.name /.anonymous + #/.id /.no-id} + #/.group {#/.name /.anonymous + #/.id /.no-id}} + content])) + (format.run /.writer) + (.run /.parser))] + (wrap (case (row.to-list tar) + (^ (list (#/.Normal [_ _ actual-mode _ _]))) + (n.= (/.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) + (.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) + (.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) + (.run /.parser) + (:: try.monad map row.empty?) + (try.default false))) + ..path + ..name + ..small + ..big + (_.with-cover [/.Entry] + ($_ _.and + ..entry + ..mode + ..ownership + )) + )))) -- cgit v1.2.3