aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/test
diff options
context:
space:
mode:
Diffstat (limited to 'stdlib/source/test')
-rw-r--r--stdlib/source/test/aedifex.lux4
-rw-r--r--stdlib/source/test/aedifex/cli.lux4
-rw-r--r--stdlib/source/test/aedifex/parser.lux2
-rw-r--r--stdlib/source/test/aedifex/profile.lux5
-rw-r--r--stdlib/source/test/aedifex/repository.lux93
-rw-r--r--stdlib/source/test/lux/data/collection/set/ordered.lux232
-rw-r--r--stdlib/source/test/lux/meta/annotation.lux2
-rw-r--r--stdlib/source/test/lux/world/console.lux3
8 files changed, 253 insertions, 92 deletions
diff --git a/stdlib/source/test/aedifex.lux b/stdlib/source/test/aedifex.lux
index a4fd15bec..c9994aafa 100644
--- a/stdlib/source/test/aedifex.lux
+++ b/stdlib/source/test/aedifex.lux
@@ -21,7 +21,8 @@
["#." cli]
["#." hash]
["#." parser]
- ["#." pom]])
+ ["#." pom]
+ ["#." repository]])
(def: test
Test
@@ -41,6 +42,7 @@
/hash.test
/parser.test
/pom.test
+ /repository.test
))
(program: args
diff --git a/stdlib/source/test/aedifex/cli.lux b/stdlib/source/test/aedifex/cli.lux
index 0dde0402a..1edfb381f 100644
--- a/stdlib/source/test/aedifex/cli.lux
+++ b/stdlib/source/test/aedifex/cli.lux
@@ -18,8 +18,8 @@
{#program
["." /
["/#" // #_
- ["#" profile]
- [upload (#+ User Password)]]]})
+ [repository (#+ User Password)]
+ ["#" profile]]]})
(def: compilation
(Random /.Compilation)
diff --git a/stdlib/source/test/aedifex/parser.lux b/stdlib/source/test/aedifex/parser.lux
index e26240562..12fa349bb 100644
--- a/stdlib/source/test/aedifex/parser.lux
+++ b/stdlib/source/test/aedifex/parser.lux
@@ -29,7 +29,7 @@
["#" profile]
["#." project (#+ Project)]
["#." artifact (#+ Artifact)]
- ["#." dependency (#+ Repository Dependency)]
+ ["#." dependency (#+ Dependency)]
["#." format]]]})
(def: name
diff --git a/stdlib/source/test/aedifex/profile.lux b/stdlib/source/test/aedifex/profile.lux
index d0da1ff2a..10d921f94 100644
--- a/stdlib/source/test/aedifex/profile.lux
+++ b/stdlib/source/test/aedifex/profile.lux
@@ -28,7 +28,8 @@
{#program
["." /
["/#" // #_
- ["#." dependency (#+ Repository Dependency)]
+ [repository (#+ Address)]
+ ["#." dependency (#+ Dependency)]
["#." format]]]})
(def: distribution
@@ -103,7 +104,7 @@
(random.ascii/alpha 1))
(def: repository
- (Random Repository)
+ (Random Address)
(random.ascii/alpha 1))
(def: source
diff --git a/stdlib/source/test/aedifex/repository.lux b/stdlib/source/test/aedifex/repository.lux
new file mode 100644
index 000000000..4f96d9329
--- /dev/null
+++ b/stdlib/source/test/aedifex/repository.lux
@@ -0,0 +1,93 @@
+(.module:
+ [lux #*
+ ["_" test (#+ Test)]
+ [abstract
+ ["." hash (#+ Hash)]
+ ["." equivalence (#+ Equivalence)]
+ ["." monad (#+ do)]]
+ [control
+ ["." io]
+ ["." try]
+ ["." exception (#+ exception:)]]
+ [data
+ ["." binary (#+ Binary)]
+ ["." text
+ ["%" format (#+ format)]]
+ [collection
+ ["." dictionary (#+ Dictionary)]]]
+ [math
+ ["." random (#+ Random)]]]
+ [//
+ ["@." artifact]]
+ {#spec
+ ["$." /]}
+ {#program
+ ["." / (#+ Identity)
+ ["/#" // #_
+ ["#." artifact (#+ Version Artifact)
+ ["#/." extension (#+ Extension)]]]]})
+
+(def: identity
+ (Random Identity)
+ (random.and (random.ascii/alpha 10)
+ (random.ascii/alpha 10)))
+
+(def: identity-equivalence
+ (Equivalence Identity)
+ (equivalence.product text.equivalence
+ text.equivalence))
+
+(def: artifact
+ (-> Version Artifact)
+ (|>> ["com.github.luxlang" "test-artifact"]))
+
+(def: item-hash
+ (Hash [Artifact Extension])
+ (hash.product //artifact.hash
+ text.hash))
+
+(exception: (not-found {artifact Artifact}
+ {extension Extension})
+ (exception.report
+ ["Artifact" (//artifact.format artifact)]
+ ["Extension" (%.text extension)]))
+
+(exception: (invalid-identity {[user _] Identity})
+ (exception.report
+ ["User" (%.text user)]))
+
+(type: Store
+ (Dictionary [Artifact Extension] Binary))
+
+(def: empty
+ Store
+ (dictionary.new ..item-hash))
+
+(structure: (simulation identity)
+ (-> Identity (/.Simulation Store))
+
+ (def: (on-download artifact extension state)
+ (case (dictionary.get [artifact extension] state)
+ (#.Some content)
+ (exception.return [state content])
+
+ #.None
+ (exception.throw ..not-found [artifact extension])))
+ (def: (on-upload requester artifact extension content state)
+ (if (:: identity-equivalence = identity requester)
+ (exception.return (dictionary.put [artifact extension] content state))
+ (exception.throw ..invalid-identity [requester]))))
+
+(def: #export test
+ Test
+ (<| (_.covering /._)
+ (do {! random.monad}
+ [valid ..identity
+ invalid (random.filter (|>> (:: identity-equivalence = valid) not)
+ ..identity)]
+ ($_ _.and
+ (_.with-cover [/.mock /.Simulation]
+ ($/.spec valid (..artifact "1.2.3-YES")
+ invalid (..artifact "4.5.6-NO")
+ (/.mock (..simulation valid) ..empty)))
+ ))))
diff --git a/stdlib/source/test/lux/data/collection/set/ordered.lux b/stdlib/source/test/lux/data/collection/set/ordered.lux
index 335eb0226..7257a7f7b 100644
--- a/stdlib/source/test/lux/data/collection/set/ordered.lux
+++ b/stdlib/source/test/lux/data/collection/set/ordered.lux
@@ -1,6 +1,5 @@
(.module:
[lux #*
- ["%" data/text/format (#+ format)]
["_" test (#+ Test)]
[abstract
[monad (#+ do)]
@@ -9,105 +8,170 @@
[/
["$." equivalence]]}]
[data
+ ["." bit ("#@." equivalence)]
[number
["n" nat]]
[collection
["." list]]]
[math
- ["r" random (#+ Random) ("#@." monad)]]]
+ ["." random (#+ Random) ("#@." monad)]]]
{1
["." / (#+ Set)
["." //]]})
-(def: gen-nat
- (r.Random Nat)
- (|> r.nat
- (:: r.monad map (n.% 100))))
+(def: size
+ (random.Random Nat)
+ (:: random.monad map (n.% 100) random.nat))
-(def: #export (set &order gen-value size)
- (All [a] (-> (Order a) (Random a) Nat (Random (Set a))))
+(def: #export (random size &order gen-value)
+ (All [a] (-> Nat (Order a) (Random a) (Random (Set a))))
(case size
0
- (r@wrap (/.new &order))
+ (random@wrap (/.new &order))
_
- (do r.monad
- [partial (set &order gen-value (dec size))
- value (r.filter (|>> (/.member? partial) not)
- gen-value)]
+ (do random.monad
+ [partial (random (dec size) &order gen-value)
+ value (random.filter (|>> (/.member? partial) not)
+ gen-value)]
(wrap (/.add value partial)))))
(def: #export test
Test
- (<| (_.context (%.name (name-of /.Set)))
- ($_ _.and
- (do r.monad
- [size gen-nat]
- ($_ _.and
- ($equivalence.spec /.equivalence (..set n.order r.nat size))
- ))
- (do {! r.monad}
- [sizeL gen-nat
- sizeR gen-nat
- listL (|> (r.set n.hash sizeL gen-nat) (:: ! map //.to-list))
- listR (|> (r.set n.hash sizeR gen-nat) (:: ! map //.to-list))
- #let [(^open "/@.") /.equivalence
- setL (/.from-list n.order listL)
- setR (/.from-list n.order listR)
- sortedL (list.sort n.< listL)
- minL (list.head sortedL)
- maxL (list.last sortedL)]]
- ($_ _.and
- (_.test "I can query the size of a set."
- (n.= sizeL (/.size setL)))
- (_.test "Can query minimum value."
- (case [(/.min setL) minL]
- [#.None #.None]
- true
-
- [(#.Some reference) (#.Some sample)]
- (n.= reference sample)
-
- _
- false))
- (_.test "Can query maximum value."
- (case [(/.max setL) maxL]
- [#.None #.None]
- true
-
- [(#.Some reference) (#.Some sample)]
- (n.= reference sample)
-
- _
- false))
- (_.test "Converting sets to/from lists can't change their values."
- (|> setL
- /.to-list (/.from-list n.order)
- (/@= setL)))
- (_.test "Order is preserved."
- (let [listL (/.to-list setL)
- (^open "list@.") (list.equivalence n.equivalence)]
- (list@= listL
- (list.sort n.< listL))))
- (_.test "Every set is a sub-set of the union of itself with another."
- (let [setLR (/.union setL setR)]
- (and (/.sub? setLR setL)
- (/.sub? setLR setR))))
- (_.test "Every set is a super-set of the intersection of itself with another."
- (let [setLR (/.intersection setL setR)]
- (and (/.super? setLR setL)
- (/.super? setLR setR))))
- (_.test "Union with the empty set leaves a set unchanged."
- (/@= setL
- (/.union (/.new n.order)
- setL)))
- (_.test "Intersection with the empty set results in the empty set."
- (let [empty-set (/.new n.order)]
- (/@= empty-set
- (/.intersection empty-set setL))))
- (_.test "After substracting a set A from another B, no member of A can be a member of B."
- (let [sub (/.difference setR setL)]
- (not (list.any? (/.member? sub) (/.to-list setR)))))
- (_.test "Every member of a set must be identifiable."
- (list.every? (/.member? setL) (/.to-list setL)))
+ (<| (_.covering /._)
+ (_.with-cover [/.Set])
+ (do {! random.monad}
+ [sizeL ..size
+ sizeR ..size
+ usetL (random.set n.hash sizeL random.nat)
+ non-memberL (random.filter (|>> (//.member? usetL) not)
+ random.nat)
+ #let [listL (//.to-list usetL)]
+ listR (|> (random.set n.hash sizeR random.nat) (:: ! map //.to-list))
+ #let [(^open "/@.") /.equivalence
+ setL (/.from-list n.order listL)
+ setR (/.from-list n.order listR)
+ empty (/.new n.order)]]
+ (`` ($_ _.and
+ (_.with-cover [/.equivalence]
+ ($equivalence.spec /.equivalence (..random sizeL n.order random.nat)))
+
+ (_.cover [/.size]
+ (n.= sizeL (/.size setL)))
+ (_.cover [/.empty?]
+ (bit@= (n.= 0 (/.size setL))
+ (/.empty? setL)))
+ (_.cover [/.new]
+ (/.empty? (/.new n.order)))
+ (_.cover [/.to-list]
+ (:: (list.equivalence n.equivalence) =
+ (/.to-list (/.from-list n.order listL))
+ (list.sort (:: n.order <) listL)))
+ (_.cover [/.from-list]
+ (|> setL
+ /.to-list (/.from-list n.order)
+ (/@= setL)))
+ (~~ (template [<coverage> <comparison>]
+ [(_.cover [<coverage>]
+ (case (<coverage> setL)
+ (#.Some value)
+ (|> setL /.to-list (list.every? (<comparison> value)))
+
+ #.None
+ (/.empty? setL)))]
+
+ [/.min n.>=]
+ [/.max n.<=]
+ ))
+ (_.cover [/.member?]
+ (let [members-are-identified!
+ (list.every? (/.member? setL) (/.to-list setL))
+
+ non-members-are-not-identified!
+ (not (/.member? setL non-memberL))]
+ (and members-are-identified!
+ non-members-are-not-identified!)))
+ (_.cover [/.add]
+ (let [setL+ (/.add non-memberL setL)]
+ (and (not (/.member? setL non-memberL))
+ (/.member? setL+ non-memberL)
+ (n.= (inc (/.size setL))
+ (/.size setL+)))))
+ (_.cover [/.remove]
+ (|> setL
+ (/.add non-memberL)
+ (/.remove non-memberL)
+ (:: /.equivalence = setL)))
+ (_.cover [/.sub?]
+ (let [self!
+ (/.sub? setL setL)
+
+ empty!
+ (/.sub? setL empty)]
+ (and self!
+ empty!)))
+ (_.cover [/.super?]
+ (let [self!
+ (/.super? setL setL)
+
+ empty!
+ (/.super? empty setL)
+
+ symmetry!
+ (bit@= (/.super? setL setR)
+ (/.sub? setR setL))]
+ (and self!
+ empty!
+ symmetry!)))
+ (~~ (template [<coverage> <relation> <empty?>]
+ [(_.cover [<coverage>]
+ (let [self!
+ (:: /.equivalence =
+ setL
+ (<coverage> setL setL))
+
+ super!
+ (and (<relation> (<coverage> setL setR) setL)
+ (<relation> (<coverage> setL setR) setR))
+
+ empty!
+ (:: /.equivalence =
+ (if <empty?> empty setL)
+ (<coverage> setL empty))
+
+ idempotence!
+ (:: /.equivalence =
+ (<coverage> setL (<coverage> setL setR))
+ (<coverage> setR (<coverage> setL setR)))]
+ (and self!
+ super!
+ empty!
+ idempotence!)))]
+
+ [/.union /.sub? false]
+ [/.intersection /.super? true]
+ ))
+ (_.cover [/.difference]
+ (let [self!
+ (|> setL
+ (/.difference setL)
+ (:: /.equivalence = empty))
+
+ empty!
+ (|> setL
+ (/.difference empty)
+ (:: /.equivalence = setL))
+
+ difference!
+ (not (list.any? (/.member? (/.difference setL setR))
+ (/.to-list setL)))
+
+ idempotence!
+ (:: /.equivalence =
+ (/.difference setL setR)
+ (/.difference setL (/.difference setL setR)))]
+ (and self!
+ empty!
+ difference!
+ idempotence!)))
)))))
diff --git a/stdlib/source/test/lux/meta/annotation.lux b/stdlib/source/test/lux/meta/annotation.lux
index f0ff06160..a3c2dae7f 100644
--- a/stdlib/source/test/lux/meta/annotation.lux
+++ b/stdlib/source/test/lux/meta/annotation.lux
@@ -74,7 +74,7 @@
[/.nat random.nat code.nat nat.equivalence]
[/.int random.int code.int int.equivalence]
[/.rev random.rev code.rev rev.equivalence]
- [/.frac random.frac code.frac frac.equivalence]
+ [/.frac random.safe-frac code.frac frac.equivalence]
[/.text (random.ascii/alpha 1) code.text text.equivalence]
[/.identifier ..random-key code.identifier name.equivalence]
[/.tag ..random-key code.tag name.equivalence]
diff --git a/stdlib/source/test/lux/world/console.lux b/stdlib/source/test/lux/world/console.lux
index d17559cec..6e1ce67b3 100644
--- a/stdlib/source/test/lux/world/console.lux
+++ b/stdlib/source/test/lux/world/console.lux
@@ -4,6 +4,7 @@
[abstract
[monad (#+ do)]]
[control
+ ["." io]
["." try (#+ Try)]
["." exception (#+ exception:)]]]
{1
@@ -40,4 +41,4 @@
Test
(<| (_.covering /._)
(_.with-cover [/.mock /.Simulation]
- ($/.spec (/.mock ..simulation false)))))
+ ($/.spec (io.io (/.mock ..simulation false))))))
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-23 17:24:30 +0000