From e153b011bb94ba95474505c307873616bb493b6d Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Sat, 24 Oct 2020 21:44:21 -0400 Subject: Changed type-parameters for Mixin types. --- stdlib/source/test/aedifex.lux | 3 + stdlib/source/test/aedifex/command/pom.lux | 67 ++++++++++ stdlib/source/test/aedifex/parser.lux | 12 +- stdlib/source/test/lux/control/function/memo.lux | 2 +- stdlib/source/test/lux/control/function/mixin.lux | 18 +-- stdlib/source/test/lux/control/parser/analysis.lux | 2 +- stdlib/source/test/lux/data/collection/list.lux | 61 +++++---- stdlib/source/test/lux/data/collection/queue.lux | 138 +++++++++++++++------ 8 files changed, 220 insertions(+), 83 deletions(-) create mode 100644 stdlib/source/test/aedifex/command/pom.lux (limited to 'stdlib/source/test') diff --git a/stdlib/source/test/aedifex.lux b/stdlib/source/test/aedifex.lux index f4abc3887..50d194e43 100644 --- a/stdlib/source/test/aedifex.lux +++ b/stdlib/source/test/aedifex.lux @@ -7,6 +7,8 @@ [cli (#+ program:)]]]] ["." / #_ ["#." artifact] + ["#." command #_ + ["#/." pom]] ["#." dependency] ["#." profile] ["#." project] @@ -19,6 +21,7 @@ Test ($_ _.and /artifact.test + /command/pom.test /dependency.test /profile.test /project.test diff --git a/stdlib/source/test/aedifex/command/pom.lux b/stdlib/source/test/aedifex/command/pom.lux new file mode 100644 index 000000000..1bb098de0 --- /dev/null +++ b/stdlib/source/test/aedifex/command/pom.lux @@ -0,0 +1,67 @@ +(.module: + [lux #* + ["_" test (#+ Test)] + [abstract + [monad (#+ do)]] + [control + ["." try (#+ Try) ("#@." functor)] + [concurrency + ["." promise (#+ Promise)]] + [security + ["!" capability]]] + [data + ["." binary] + ["." text ("#@." equivalence) + ["." encoding]] + [format + ["." xml]]] + [math + ["." random (#+ Random)]] + [world + ["." file (#+ File)]]] + [/// + ["@." profile]] + {#program + ["." / + ["//#" /// #_ + ["#" profile] + ["#." action] + ["#." pom]]]}) + +(def: #export test + Test + (<| (_.covering /._) + (do random.monad + [sample @profile.random + #let [fs (file.mock (:: file.system separator))]] + (wrap (do {@ promise.monad} + [outcome (/.do! fs sample)] + (case outcome + (#try.Success path) + (do @ + [verdict (do ///action.monad + [expected (|> (///pom.write sample) + (try@map (|>> (:: xml.codec encode) encoding.to-utf8)) + (:: @ wrap)) + file (: (Promise (Try (File Promise))) + (file.get-file promise.monad fs path)) + actual (!.use (:: file content) []) + + #let [expected-path! + (text@= ///pom.file path) + + expected-content! + (:: binary.equivalence = expected actual)]] + (wrap (and expected-path! + expected-content!)))] + (_.claim [/.do!] + (try.default false verdict))) + + (#try.Failure error) + (_.claim [/.do!] + (case (get@ #///.identity sample) + (#.Some _) + false + + #.None + true)))))))) diff --git a/stdlib/source/test/aedifex/parser.lux b/stdlib/source/test/aedifex/parser.lux index a171e694d..0c85156d2 100644 --- a/stdlib/source/test/aedifex/parser.lux +++ b/stdlib/source/test/aedifex/parser.lux @@ -22,7 +22,7 @@ [macro ["." code]]] [// - ["_." profile]] + ["@." profile]] {#program ["." / ["/#" // #_ @@ -48,9 +48,9 @@ (dictionary.from-list key-hash) (..list-of (random.and key-random value-random)))) -(def: project +(def: random (Random Project) - (..dictionary-of text.hash ..name _profile.random)) + (..dictionary-of text.hash ..name @profile.random)) (def: with-default-sources (-> //.Profile //.Profile) @@ -64,7 +64,7 @@ (def: single-profile Test (do random.monad - [expected _profile.random] + [expected @profile.random] (_.test "Single profile." (|> expected //format.profile @@ -88,7 +88,7 @@ (def: multiple-profiles Test (do random.monad - [expected ..project] + [expected ..random] (_.test "Multiple profiles." (|> expected //format.project @@ -100,7 +100,7 @@ dictionary.entries (list@map (function (_ [name profile]) [name (..with-default-sources profile)])) - (dictionary.from-list text.hash) + (dictionary.from-list text.hash) (:: //project.equivalence = actual)) (#try.Failure error) diff --git a/stdlib/source/test/lux/control/function/memo.lux b/stdlib/source/test/lux/control/function/memo.lux index a57adaa53..85fe41f8d 100644 --- a/stdlib/source/test/lux/control/function/memo.lux +++ b/stdlib/source/test/lux/control/function/memo.lux @@ -82,7 +82,7 @@ (_.cover [/.memoization] (let [memo (<| //.mixin (//.inherit /.memoization) - (: (//.Mixin (-> Nat (State (Dictionary Nat Nat) Nat))) + (: (//.Mixin Nat (State (Dictionary Nat Nat) Nat)) (function (factorial delegate recur input) (case input (^or 0 1) (:: state.monad wrap 1) diff --git a/stdlib/source/test/lux/control/function/mixin.lux b/stdlib/source/test/lux/control/function/mixin.lux index 23704362d..2d83f5515 100644 --- a/stdlib/source/test/lux/control/function/mixin.lux +++ b/stdlib/source/test/lux/control/function/mixin.lux @@ -28,12 +28,12 @@ [input (|> random.nat (:: @ map (|>> (n.% 6) (n.+ 20)))) dummy random.nat shift (|> random.nat (random.filter (|>> (n.= dummy) not))) - #let [equivalence (: (Equivalence (/.Mixin (-> Nat Nat))) + #let [equivalence (: (Equivalence (/.Mixin Nat Nat)) (structure (def: (= left right) (n.= ((/.mixin left) input) ((/.mixin right) input))))) - generator (: (Random (/.Mixin (-> Nat Nat))) + generator (: (Random (/.Mixin Nat Nat)) (do @ [output random.nat] (wrap (function (_ delegate recur input) @@ -56,19 +56,19 @@ (n.= expected (factorial input)))) (_.cover [/.inherit] - (let [bottom (: (/.Mixin (-> Nat Nat)) + (let [bottom (: (/.Mixin Nat Nat) (function (_ delegate recur input) (case input (^or 0 1) 1 _ (delegate input)))) - multiplication (: (/.Mixin (-> Nat Nat)) + multiplication (: (/.Mixin Nat Nat) (function (_ delegate recur input) (n.* input (recur (dec input))))) factorial (/.mixin (/.inherit bottom multiplication))] (n.= expected (factorial input)))) (_.cover [/.nothing] - (let [loop (: (/.Mixin (-> Nat Nat)) + (let [loop (: (/.Mixin Nat Nat) (function (_ delegate recur input) (case input (^or 0 1) 1 @@ -80,7 +80,7 @@ (n.= expected (right input))))) (_.cover [/.advice] - (let [bottom (: (/.Mixin (-> Nat Nat)) + (let [bottom (: (/.Mixin Nat Nat) (function (_ delegate recur input) 1)) bottom? (: (Predicate Nat) @@ -88,7 +88,7 @@ (case input (^or 0 1) true _ false))) - multiplication (: (/.Mixin (-> Nat Nat)) + multiplication (: (/.Mixin Nat Nat) (function (_ delegate recur input) (n.* input (recur (dec input))))) factorial (/.mixin (/.inherit (/.advice bottom? bottom) @@ -100,7 +100,7 @@ (function (_ input) (function (_ state) [shift []]))) - meld (: (/.Mixin (-> Nat (State Nat Nat))) + meld (: (/.Mixin Nat (State Nat Nat)) (function (_ delegate recur input) (function (_ state) [state (n.+ state input)]))) @@ -113,7 +113,7 @@ (function (_ input output) (function (_ state) [shift []]))) - meld (: (/.Mixin (-> Nat (State Nat Nat))) + meld (: (/.Mixin Nat (State Nat Nat)) (function (_ delegate recur input) (function (_ state) [state (n.+ state input)]))) diff --git a/stdlib/source/test/lux/control/parser/analysis.lux b/stdlib/source/test/lux/control/parser/analysis.lux index 1eb314b6e..47a987d03 100644 --- a/stdlib/source/test/lux/control/parser/analysis.lux +++ b/stdlib/source/test/lux/control/parser/analysis.lux @@ -82,7 +82,7 @@ [/.bit /.bit! random.bit analysis.bit bit@=] [/.nat /.nat! random.nat analysis.nat n.=] [/.int /.int! random.int analysis.int i.=] - [/.frac /.frac! random.frac analysis.frac f.=] + [/.frac /.frac! random.safe-frac analysis.frac f.=] [/.rev /.rev! random.rev analysis.rev r.=] [/.text /.text! (random.unicode 10) analysis.text text@=] [/.local /.local! random.nat analysis.variable/local n.=] diff --git a/stdlib/source/test/lux/data/collection/list.lux b/stdlib/source/test/lux/data/collection/list.lux index e6c971ae2..92cec10e8 100644 --- a/stdlib/source/test/lux/data/collection/list.lux +++ b/stdlib/source/test/lux/data/collection/list.lux @@ -95,10 +95,16 @@ (_.cover [/.repeat] (n.= size (/.size (/.repeat size [])))) (_.cover [/.reverse] - (and (not (/@= sample - (/.reverse sample))) - (/@= sample - (/.reverse (/.reverse sample))))) + (or (n.< 2 (/.size sample)) + (let [not-same! + (not (/@= sample + (/.reverse sample))) + + self-symmetry! + (/@= sample + (/.reverse (/.reverse sample)))] + (and not-same! + self-symmetry!)))) (_.cover [/.every? /.any?] (if (/.every? n.even? sample) (not (/.any? (bit.complement n.even?) sample)) @@ -144,11 +150,17 @@ already-sorted! expected-numbers!))) (_.cover [/.enumeration] - (let [enumeration (/.enumeration sample)] - (and (/@= (/.indices (/.size enumeration)) - (/@map product.left enumeration)) - (/@= sample - (/@map product.right enumeration))))) + (let [enumeration (/.enumeration sample) + + has-correct-indices! + (/@= (/.indices (/.size enumeration)) + (/@map product.left enumeration)) + + has-correct-values! + (/@= sample + (/@map product.right enumeration))] + (and has-correct-indices! + has-correct-values!))) (_.cover [/.nth] (/.every? (function (_ [index expected]) (case (/.nth index sample) @@ -366,13 +378,10 @@ (_.cover [/.find] (case (/.find n.even? sample) (#.Some found) - (and (n.even? found) - (/.any? n.even? sample) - (not (/.every? (bit.complement n.even?) sample))) + (n.even? found) #.None - (and (not (/.any? n.even? sample)) - (/.every? (bit.complement n.even?) sample)))) + (not (/.any? n.even? sample)))) )))) (def: #export test @@ -394,18 +403,20 @@ ..search (_.cover [/.interpose] - (let [sample+ (/.interpose separator sample)] - (and (n.= (|> (/.size sample) (n.* 2) dec) - (/.size sample+)) - (|> sample+ /.as-pairs (/.every? (|>> product.right (n.= separator))))))) + (or (/.empty? sample) + (let [sample+ (/.interpose separator sample)] + (and (n.= (|> (/.size sample) (n.* 2) dec) + (/.size sample+)) + (|> sample+ /.as-pairs (/.every? (|>> product.right (n.= separator)))))))) (_.cover [/.iterate] - (let [size (/.size sample)] - (/@= (/.indices size) - (/.iterate (function (_ index) - (if (n.< size index) - (#.Some (inc index)) - #.None)) - 0)))) + (or (/.empty? sample) + (let [size (/.size sample)] + (/@= (/.indices size) + (/.iterate (function (_ index) + (if (n.< size index) + (#.Some (inc index)) + #.None)) + 0))))) (_.cover [/.folds] (/@= (/@map (function (_ index) (:: /.fold fold n.+ 0 (/.take index sample))) diff --git a/stdlib/source/test/lux/data/collection/queue.lux b/stdlib/source/test/lux/data/collection/queue.lux index 9605a50b1..f646fd82a 100644 --- a/stdlib/source/test/lux/data/collection/queue.lux +++ b/stdlib/source/test/lux/data/collection/queue.lux @@ -1,6 +1,5 @@ (.module: [lux #* - ["%" data/text/format (#+ format)] ["_" test (#+ Test)] [abstract [monad (#+ do)] @@ -9,10 +8,15 @@ ["$." equivalence] ["$." functor (#+ Injection)]]}] [data + ["." bit ("#@." equivalence)] + ["%" text/format (#+ format)] [number - ["n" nat]]] + ["n" nat]] + [collection + ["." set] + ["." list ("#@." monoid)]]] [math - ["r" random]]] + ["." random]]] {1 ["." /]}) @@ -22,43 +26,95 @@ (def: #export test Test - (<| (_.context (%.name (name-of /.Queue))) - (do {@ r.monad} - [size (:: @ map (n.% 100) r.nat) - sample (r.queue size r.nat) - non-member (|> r.nat - (r.filter (|>> (/.member? n.equivalence sample) not)))] + (<| (_.covering /._) + (_.with-cover [/.Queue]) + (do {@ random.monad} + [size (:: @ map (n.% 100) random.nat) + members (random.set n.hash size random.nat) + non-member (random.filter (|>> (set.member? members) not) + random.nat) + #let [members (set.to-list members) + sample (/.from-list members)]] ($_ _.and - ($equivalence.spec (/.equivalence n.equivalence) (r.queue size r.nat)) - ($functor.spec ..injection /.equivalence /.functor) - - (_.test "I can query the size of a queue (and empty queues have size 0)." - (if (n.= 0 size) - (/.empty? sample) - (n.= size (/.size sample)))) - (_.test "Enqueueing and dequeing affects the size of queues." - (and (n.= (inc size) (/.size (/.push non-member sample))) - (or (/.empty? sample) - (n.= (dec size) (/.size (/.pop sample)))) - (n.= size (/.size (/.pop (/.push non-member sample)))))) - (_.test "Transforming to/from list can't change the queue." - (let [(^open "/;.") (/.equivalence n.equivalence)] - (|> sample - /.to-list /.from-list - (/;= sample)))) - (_.test "I can always peek at a non-empty queue." - (case (/.peek sample) - #.None (/.empty? sample) - (#.Some _) #1)) - (_.test "I can query whether an element belongs to a queue." - (and (not (/.member? n.equivalence sample non-member)) - (/.member? n.equivalence (/.push non-member sample) - non-member) - (case (/.peek sample) - #.None - (/.empty? sample) - - (#.Some first) - (and (/.member? n.equivalence sample first) - (not (/.member? n.equivalence (/.pop sample) first)))))) + (_.with-cover [/.equivalence] + ($equivalence.spec (/.equivalence n.equivalence) (random.queue size random.nat))) + (_.with-cover [/.functor] + ($functor.spec ..injection /.equivalence /.functor)) + + (_.cover [/.from-list /.to-list] + (|> members /.from-list /.to-list + (:: (list.equivalence n.equivalence) = members))) + (_.cover [/.size] + (n.= size (/.size sample))) + (_.cover [/.empty?] + (bit@= (n.= 0 size) (/.empty? sample))) + (_.cover [/.empty] + (let [empty-is-empty! + (/.empty? /.empty) + + all-empty-queues-look-the-same! + (bit@= (/.empty? sample) + (:: (/.equivalence n.equivalence) = + sample + /.empty))] + (and empty-is-empty! + all-empty-queues-look-the-same!))) + (_.cover [/.peek] + (case [members (/.peek sample)] + [(#.Cons head tail) (#.Some first)] + (n.= head first) + + [#.Nil #.None] + true + + _ + false)) + (_.cover [/.member?] + (let [every-member-is-identified! + (list.every? (/.member? n.equivalence sample) + (/.to-list sample)) + + non-member-is-not-identified! + (not (/.member? n.equivalence sample non-member))] + (and every-member-is-identified! + non-member-is-not-identified!))) + (_.cover [/.push] + (let [pushed (/.push non-member sample) + + size-increases! + (n.= (inc (/.size sample)) (/.size pushed)) + + new-member-is-identified! + (/.member? n.equivalence pushed non-member) + + has-expected-order! + (:: (list.equivalence n.equivalence) = + (list@compose (/.to-list sample) (list non-member)) + (/.to-list pushed))] + (and size-increases! + new-member-is-identified! + has-expected-order!))) + (_.cover [/.pop] + (case members + (#.Cons target expected) + (let [popped (/.pop sample) + + size-decreases! + (n.= (dec (/.size sample)) + (/.size popped)) + + popped-member-is-not-identified! + (not (/.member? n.equivalence popped target)) + + has-expected-order! + (:: (list.equivalence n.equivalence) = + expected + (/.to-list popped))] + (and size-decreases! + popped-member-is-not-identified! + has-expected-order!)) + + #.Nil + (and (/.empty? sample) + (/.empty? (/.pop sample))))) )))) -- cgit v1.2.3