From bcd68d4691e7b2f6d56e0ab92b591c14d7a26a48 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Sat, 24 Oct 2020 05:05:26 -0400 Subject: Re-named "search" to "one" and "search-all" to "all". --- stdlib/source/test/aedifex.lux | 2 + stdlib/source/test/aedifex/artifact/type.lux | 6 +- stdlib/source/test/aedifex/dependency.lux | 29 +++ stdlib/source/test/aedifex/profile.lux | 11 +- stdlib/source/test/lux/control/parser/xml.lux | 8 +- .../source/test/lux/data/collection/dictionary.lux | 289 +++++++++++++-------- stdlib/source/test/lux/data/format/xml.lux | 6 +- stdlib/source/test/lux/macro/poly/json.lux | 26 +- stdlib/source/test/lux/world/file.lux | 4 +- 9 files changed, 245 insertions(+), 136 deletions(-) create mode 100644 stdlib/source/test/aedifex/dependency.lux (limited to 'stdlib/source/test') diff --git a/stdlib/source/test/aedifex.lux b/stdlib/source/test/aedifex.lux index c496eb88b..b5aa7e34e 100644 --- a/stdlib/source/test/aedifex.lux +++ b/stdlib/source/test/aedifex.lux @@ -7,6 +7,7 @@ [cli (#+ program:)]]]] ["." / #_ ["#." artifact] + ["#." dependency] ["#." profile] ["#." project] ["#." cli] @@ -17,6 +18,7 @@ Test ($_ _.and /artifact.test + /dependency.test /profile.test /project.test /cli.test diff --git a/stdlib/source/test/aedifex/artifact/type.lux b/stdlib/source/test/aedifex/artifact/type.lux index fd815f19e..cbc6f681b 100644 --- a/stdlib/source/test/aedifex/artifact/type.lux +++ b/stdlib/source/test/aedifex/artifact/type.lux @@ -20,8 +20,10 @@ (<| (_.covering /._) (_.with-cover [/.Type] ($_ _.and - (_.cover [/.lux-library /.jvm-library /.pom] - (let [options (list /.lux-library /.jvm-library /.pom) + (_.cover [/.lux-library /.jvm-library + /.pom /.md5 /.sha1] + (let [options (list /.lux-library /.jvm-library + /.pom /.md5 /.sha1) uniques (set.from-list text.hash options)] (n.= (list.size options) (set.size uniques)))) diff --git a/stdlib/source/test/aedifex/dependency.lux b/stdlib/source/test/aedifex/dependency.lux new file mode 100644 index 000000000..e7388189c --- /dev/null +++ b/stdlib/source/test/aedifex/dependency.lux @@ -0,0 +1,29 @@ +(.module: + [lux #* + ["_" test (#+ Test)] + [abstract + [monad (#+ do)] + {[0 #spec] + [/ + ["$." equivalence]]}] + [math + ["." random (#+ Random)]]] + [// + ["@." artifact]] + {#program + ["." /]}) + +(def: #export random + (Random /.Dependency) + ($_ random.and + @artifact.random + (random.ascii/alpha 1))) + +(def: #export test + Test + (<| (_.covering /._) + (_.with-cover [/.Dependency] + ($_ _.and + (_.with-cover [/.equivalence] + ($equivalence.spec /.equivalence ..random)) + )))) diff --git a/stdlib/source/test/aedifex/profile.lux b/stdlib/source/test/aedifex/profile.lux index 94f695a9b..398a85f5b 100644 --- a/stdlib/source/test/aedifex/profile.lux +++ b/stdlib/source/test/aedifex/profile.lux @@ -23,7 +23,8 @@ [math ["." random (#+ Random) ("#@." monad)]]] [// - ["@." artifact]] + ["@." artifact] + ["@." dependency]] {#program ["." / ["/#" // #_ @@ -105,12 +106,6 @@ (Random Repository) (random.ascii/alpha 1)) -(def: dependency - (Random Dependency) - ($_ random.and - @artifact.random - (random.ascii/alpha 1))) - (def: source (Random /.Source) (random.ascii/alpha 1)) @@ -126,7 +121,7 @@ (random.maybe @artifact.random) (random.maybe ..info) (..set-of text.hash ..repository) - (..set-of //dependency.hash ..dependency) + (..set-of //dependency.hash @dependency.random) (..set-of text.hash ..source) (random.maybe ..target) (random.maybe (random.ascii/alpha 1)) diff --git a/stdlib/source/test/lux/control/parser/xml.lux b/stdlib/source/test/lux/control/parser/xml.lux index 15e0e993b..b46994c97 100644 --- a/stdlib/source/test/lux/control/parser/xml.lux +++ b/stdlib/source/test/lux/control/parser/xml.lux @@ -86,10 +86,10 @@ [expected-tag ..random-tag expected-attribute ..random-attribute expected-value (random.ascii/alpha 1)] - (_.cover [/.attr] + (_.cover [/.attribute] (|> (/.run (do //.monad [_ (/.node expected-tag) - _ (/.attr expected-attribute)] + _ (/.attribute expected-attribute)] /.ignore) (#xml.Node expected-tag (|> (dictionary.new name.hash) @@ -98,7 +98,7 @@ (!expect (#try.Success []))))) (!failure /.unknown-attribute [[(do //.monad - [_ (/.attr ["" expected])] + [_ (/.attribute ["" expected])] /.ignore) (#xml.Node [expected expected] (|> (dictionary.new name.hash) @@ -158,7 +158,7 @@ /.ignore) (#xml.Text expected)] [(do //.monad - [_ (/.attr [expected expected])] + [_ (/.attribute [expected expected])] /.ignore) (#xml.Text expected)] [(do {@ //.monad} diff --git a/stdlib/source/test/lux/data/collection/dictionary.lux b/stdlib/source/test/lux/data/collection/dictionary.lux index fca670802..b2956fa85 100644 --- a/stdlib/source/test/lux/data/collection/dictionary.lux +++ b/stdlib/source/test/lux/data/collection/dictionary.lux @@ -1,16 +1,16 @@ (.module: [lux #* - ["%" data/text/format (#+ format)] ["_" test (#+ Test)] [abstract [monad (#+ do)] - ["eq" equivalence] + ["." equivalence] {[0 #spec] [/ ["$." equivalence] ["$." functor (#+ Injection)]]}] [control - ["." try]] + ["." try] + ["." exception]] [data ["." maybe] [number @@ -18,7 +18,7 @@ [collection ["." list ("#@." functor)]]] [math - ["r" random]]] + ["." random]]] {1 ["." /]}) @@ -26,111 +26,190 @@ (Injection (/.Dictionary Nat)) (|>> [0] list (/.from-list n.hash))) -(def: #export test +(def: for-dictionaries Test - (<| (_.context (%.name (name-of /.Dictionary))) - (do r.monad - [#let [capped-nat (:: r.monad map (n.% 100) r.nat)] - size capped-nat - dict (r.dictionary n.hash size r.nat capped-nat) - non-key (|> r.nat (r.filter (function (_ key) (not (/.contains? key dict))))) - test-val (|> r.nat (r.filter (function (_ val) (not (list.member? n.equivalence (/.values dict) val)))))] - ($_ _.and - ($equivalence.spec (/.equivalence n.equivalence) - (r.dictionary n.hash size r.nat r.nat)) - ($functor.spec ..injection /.equivalence /.functor) - - (_.test "Size function should correctly represent Dictionary size." - (n.= size (/.size dict))) - (_.test "Dictionaries of size 0 should be considered empty." - (if (n.= 0 size) - (/.empty? dict) - (not (/.empty? dict)))) - (_.test "The functions 'entries', 'keys' and 'values' should be synchronized." - (:: (list.equivalence (eq.product n.equivalence n.equivalence)) = - (/.entries dict) - (list.zip2 (/.keys dict) - (/.values dict)))) - (_.test "Dictionary should be able to recognize it's own keys." - (list.every? (function (_ key) (/.contains? key dict)) - (/.keys dict))) - (_.test "Should be able to get every key." - (list.every? (function (_ key) (case (/.get key dict) - (#.Some _) #1 - _ #0)) - (/.keys dict))) - (_.test "Shouldn't be able to access non-existant keys." - (case (/.get non-key dict) - (#.Some _) #0 - _ #1)) - (_.test "Should be able to put and then get a value." - (case (/.get non-key (/.put non-key test-val dict)) - (#.Some v) (n.= test-val v) - _ #1)) + (do random.monad + [#let [capped-nat (:: random.monad map (n.% 100) random.nat)] + size capped-nat + dict (random.dictionary n.hash size random.nat capped-nat) + non-key (|> random.nat (random.filter (function (_ key) (not (/.contains? key dict))))) + test-val (|> random.nat (random.filter (function (_ val) (not (list.member? n.equivalence (/.values dict) val)))))] + ($_ _.and + (_.cover [/.size] + (n.= size (/.size dict))) + + (_.cover [/.empty?] + (case size + 0 (/.empty? dict) + _ (not (/.empty? dict)))) + + (_.cover [/.new] + (let [sample (/.new n.hash)] + (and (n.= 0 (/.size sample)) + (/.empty? sample)))) + + (_.cover [/.entries /.keys /.values] + (:: (list.equivalence (equivalence.product n.equivalence n.equivalence)) = + (/.entries dict) + (list.zip2 (/.keys dict) + (/.values dict)))) + + (_.cover [/.merge] + (let [merging-with-oneself (let [(^open ".") (/.equivalence n.equivalence)] + (= dict (/.merge dict dict))) + overwritting-keys (let [dict' (|> dict /.entries + (list@map (function (_ [k v]) [k (inc v)])) + (/.from-list n.hash)) + (^open ".") (/.equivalence n.equivalence)] + (= dict' (/.merge dict' dict)))] + (and merging-with-oneself + overwritting-keys))) + + (_.cover [/.merge-with] + (list.every? (function (_ [x x*2]) (n.= (n.* 2 x) x*2)) + (list.zip2 (/.values dict) + (/.values (/.merge-with n.+ dict dict))))) - (_.test "Should be able to try-put and then get a value." - (case (/.try-put non-key test-val dict) - (#try.Success dict) + (_.cover [/.from-list] + (let [(^open ".") (/.equivalence n.equivalence)] + (and (= dict dict) + (|> dict /.entries (/.from-list n.hash) (= dict))))) + ))) + +(def: for-entries + Test + (do random.monad + [#let [capped-nat (:: random.monad map (n.% 100) random.nat)] + size capped-nat + dict (random.dictionary n.hash size random.nat capped-nat) + non-key (|> random.nat (random.filter (function (_ key) (not (/.contains? key dict))))) + test-val (|> random.nat (random.filter (function (_ val) (not (list.member? n.equivalence (/.values dict) val)))))] + ($_ _.and + (_.cover [/.contains?] + (list.every? (function (_ key) (/.contains? key dict)) + (/.keys dict))) + + (_.cover [/.get] + (and (list.every? (function (_ key) (case (/.get key dict) + (#.Some _) true + _ false)) + (/.keys dict)) (case (/.get non-key dict) + (#.Some _) false + _ true))) + + (_.cover [/.put] + (and (n.= (inc (/.size dict)) + (/.size (/.put non-key test-val dict))) + (case (/.get non-key (/.put non-key test-val dict)) (#.Some v) (n.= test-val v) - _ true) + _ true))) + + (_.cover [/.try-put /.key-already-exists] + (let [can-put-new-keys! + (case (/.try-put non-key test-val dict) + (#try.Success dict) + (case (/.get non-key dict) + (#.Some v) (n.= test-val v) + _ true) + + (#try.Failure _) + false) + + cannot-put-old-keys! + (or (n.= 0 size) + (let [first-key (|> dict /.keys list.head maybe.assume)] + (case (/.try-put first-key test-val dict) + (#try.Success _) + false + + (#try.Failure error) + (exception.match? /.key-already-exists error))))] + (and can-put-new-keys! + cannot-put-old-keys!))) + + (_.cover [/.remove] + (and (let [base (/.put non-key test-val dict)] + (and (/.contains? non-key base) + (not (/.contains? non-key (/.remove non-key base))))) + (case (list.head (/.keys dict)) + #.None + true + + (#.Some known-key) + (n.= (dec (/.size dict)) + (/.size (/.remove known-key dict)))))) + + (_.cover [/.update] + (let [base (/.put non-key test-val dict) + updt (/.update non-key inc base)] + (case [(/.get non-key base) (/.get non-key updt)] + [(#.Some x) (#.Some y)] + (n.= (inc x) y) + + _ + false))) + + (_.cover [/.upsert] + (let [can-upsert-new-key! + (case (/.get non-key (/.upsert non-key test-val inc dict)) + (#.Some inserted) + (n.= (inc test-val) inserted) - (#try.Failure _) - false)) - (_.test "Shouldn't be able to try-put an existing key." - (or (n.= 0 size) - (let [first-key (|> dict /.keys list.head maybe.assume)] - (case (/.try-put first-key test-val dict) - (#try.Success _) false - (#try.Failure _) true)))) - (_.test "Removing a key should make it's value inaccessible." - (let [base (/.put non-key test-val dict)] - (and (/.contains? non-key base) - (not (/.contains? non-key (/.remove non-key base)))))) - (_.test "Should be possible to update values via their keys." - (let [base (/.put non-key test-val dict) - updt (/.update non-key inc base)] - (case [(/.get non-key base) (/.get non-key updt)] - [(#.Some x) (#.Some y)] - (n.= (inc x) y) + #.None + false) + + can-upsert-old-key! + (case (list.head (/.entries dict)) + #.None + true + + (#.Some [known-key known-value]) + (case (/.get known-key (/.upsert known-key test-val inc dict)) + (#.Some updated) + (n.= (inc known-value) updated) + + #.None + false))] + (and can-upsert-new-key! + can-upsert-old-key!))) + + (_.cover [/.select] + (|> dict + (/.put non-key test-val) + (/.select (list non-key)) + /.size + (n.= 1))) + + (_.cover [/.re-bind] + (or (n.= 0 size) + (let [first-key (|> dict /.keys list.head maybe.assume) + rebound (/.re-bind first-key non-key dict)] + (and (n.= (/.size dict) (/.size rebound)) + (/.contains? non-key rebound) + (not (/.contains? first-key rebound)) + (n.= (maybe.assume (/.get first-key dict)) + (maybe.assume (/.get non-key rebound))))))) + ))) + +(def: #export test + Test + (<| (_.covering /._) + (_.with-cover [/.Dictionary]) + (do random.monad + [#let [capped-nat (:: random.monad map (n.% 100) random.nat)] + size capped-nat + dict (random.dictionary n.hash size random.nat capped-nat) + non-key (|> random.nat (random.filter (function (_ key) (not (/.contains? key dict))))) + test-val (|> random.nat (random.filter (function (_ val) (not (list.member? n.equivalence (/.values dict) val)))))] + ($_ _.and + (_.with-cover [/.equivalence] + ($equivalence.spec (/.equivalence n.equivalence) + (random.dictionary n.hash size random.nat random.nat))) + + (_.with-cover [/.functor] + ($functor.spec ..injection /.equivalence /.functor)) - _ - #0))) - (_.test "Additions and removals to a Dictionary should affect its size." - (let [plus (/.put non-key test-val dict) - base (/.remove non-key plus)] - (and (n.= (inc (/.size dict)) (/.size plus)) - (n.= (dec (/.size plus)) (/.size base))))) - (_.test "A Dictionary should equal itself & going to<->from lists shouldn't change that." - (let [(^open ".") (/.equivalence n.equivalence)] - (and (= dict dict) - (|> dict /.entries (/.from-list n.hash) (= dict))))) - (_.test "Merging a Dictionary to itself changes nothing." - (let [(^open ".") (/.equivalence n.equivalence)] - (= dict (/.merge dict dict)))) - (_.test "If you merge, and the second dict has overlapping keys, it should overwrite yours." - (let [dict' (|> dict /.entries - (list@map (function (_ [k v]) [k (inc v)])) - (/.from-list n.hash)) - (^open ".") (/.equivalence n.equivalence)] - (= dict' (/.merge dict' dict)))) - (_.test "Can merge values in such a way that they become combined." - (list.every? (function (_ [x x*2]) (n.= (n.* 2 x) x*2)) - (list.zip2 (/.values dict) - (/.values (/.merge-with n.+ dict dict))))) - (_.test "Should be able to select subset of keys from dict." - (|> dict - (/.put non-key test-val) - (/.select (list non-key)) - /.size - (n.= 1))) - (_.test "Should be able to re-bind existing values to different keys." - (or (n.= 0 size) - (let [first-key (|> dict /.keys list.head maybe.assume) - rebound (/.re-bind first-key non-key dict)] - (and (n.= (/.size dict) (/.size rebound)) - (/.contains? non-key rebound) - (not (/.contains? first-key rebound)) - (n.= (maybe.assume (/.get first-key dict)) - (maybe.assume (/.get non-key rebound))))))) + ..for-dictionaries + ..for-entries )))) diff --git a/stdlib/source/test/lux/data/format/xml.lux b/stdlib/source/test/lux/data/format/xml.lux index 4c86781c0..6cf842827 100644 --- a/stdlib/source/test/lux/data/format/xml.lux +++ b/stdlib/source/test/lux/data/format/xml.lux @@ -78,10 +78,10 @@ num-children (|> r.nat (:: @ map (n.% 5))) children (r.list num-children (..text 1 10)) tag xml-identifier^ - attr xml-identifier^ + attribute xml-identifier^ value (..text 1 10) #let [node (#/.Node tag - (dictionary.put attr value /.attrs) + (dictionary.put attribute value /.attrs) (list@map (|>> #/.Text) children))]] ($_ _.and (_.test "Can parse text." @@ -94,7 +94,7 @@ (E.default #0 (do E.monad [output (.run (p.before .ignore - (.attr attr)) + (.attribute attribute)) node)] (wrap (text@= value output))))) (_.test "Can parse nodes." diff --git a/stdlib/source/test/lux/macro/poly/json.lux b/stdlib/source/test/lux/macro/poly/json.lux index 144994f50..8be02dc27 100644 --- a/stdlib/source/test/lux/macro/poly/json.lux +++ b/stdlib/source/test/lux/macro/poly/json.lux @@ -79,10 +79,9 @@ (Random Recursive) (random.rec (function (_ gen-recursive) - (random.or random.frac - (random.and random.frac gen-recursive))))) - -(derived: recursive-equivalence (poly/equivalence.equivalence Recursive)) + (random.or random.safe-frac + (random.and random.safe-frac + gen-recursive))))) (def: qty (All [unit] (Random (unit.Qty unit))) @@ -94,13 +93,13 @@ [size (:: @ map (n.% 2) random.nat)] ($_ random.and random.bit - random.frac + random.safe-frac (random.unicode size) - (random.maybe random.frac) - (random.list size random.frac) - (random.dictionary text.hash size (random.unicode size) random.frac) - ($_ random.or random.bit (random.unicode size) random.frac) - ($_ random.and random.bit (random.unicode size) random.frac) + (random.maybe random.safe-frac) + (random.list size random.safe-frac) + (random.dictionary text.hash size (random.unicode size) random.safe-frac) + ($_ random.or random.bit (random.unicode size) random.safe-frac) + ($_ random.and random.bit (random.unicode size) random.safe-frac) ..gen-recursive ## _instant.instant ## _duration.duration @@ -108,8 +107,11 @@ ..qty ))) -(derived: equivalence (poly/equivalence.equivalence Record)) -(derived: codec (/.codec Record)) +(derived: equivalence + (poly/equivalence.equivalence Record)) + +(derived: codec + (/.codec Record)) (def: #export test Test diff --git a/stdlib/source/test/lux/world/file.lux b/stdlib/source/test/lux/world/file.lux index 0fd4d76f3..9dc1fb2e2 100644 --- a/stdlib/source/test/lux/world/file.lux +++ b/stdlib/source/test/lux/world/file.lux @@ -70,8 +70,8 @@ (<| (_.context (%.name (name-of /._))) (do {@ r.monad} [file-size (|> r.nat (:: @ map (|>> (n.% 100) (n.max 10)))) - dataL (_binary.binary file-size) - dataR (_binary.binary file-size) + dataL (_binary.random file-size) + dataR (_binary.random file-size) new-modified (|> r.int (:: @ map (|>> i.abs (i.% +10,000,000,000,000) truncate-millis -- cgit v1.2.3