aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/test
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--stdlib/source/test/aedifex/artifact.lux4
-rw-r--r--stdlib/source/test/aedifex/artifact/extension.lux40
-rw-r--r--stdlib/source/test/lux/data/collection/array.lux244
-rw-r--r--stdlib/source/test/lux/macro/code.lux8
-rw-r--r--stdlib/source/test/lux/meta.lux16
-rw-r--r--stdlib/source/test/lux/target/jvm.lux22
-rw-r--r--stdlib/source/test/lux/tool/compiler/language/lux/syntax.lux10
7 files changed, 233 insertions, 111 deletions
diff --git a/stdlib/source/test/aedifex/artifact.lux b/stdlib/source/test/aedifex/artifact.lux
index 72715fdef..376f26717 100644
--- a/stdlib/source/test/aedifex/artifact.lux
+++ b/stdlib/source/test/aedifex/artifact.lux
@@ -10,7 +10,8 @@
[math
["." random (#+ Random)]]]
["." / #_
- ["#." type]]
+ ["#." type]
+ ["#." extension]]
{#program
["." /]})
@@ -31,4 +32,5 @@
($equivalence.spec /.equivalence ..random))
/type.test
+ /extension.test
))))
diff --git a/stdlib/source/test/aedifex/artifact/extension.lux b/stdlib/source/test/aedifex/artifact/extension.lux
new file mode 100644
index 000000000..e65dd567a
--- /dev/null
+++ b/stdlib/source/test/aedifex/artifact/extension.lux
@@ -0,0 +1,40 @@
+(.module:
+ [lux #*
+ ["_" test (#+ Test)]
+ [abstract
+ [monad (#+ do)]]
+ [data
+ ["." text ("#@." equivalence)]
+ [number
+ ["n" nat]]
+ [collection
+ ["." set]
+ ["." list]]]
+ [math
+ ["." random (#+ Random)]]]
+ {#program
+ ["." /
+ ["/#" // #_
+ ["#" type]]]})
+
+(def: #export test
+ Test
+ (<| (_.covering /._)
+ (_.with-cover [/.Extension]
+ ($_ _.and
+ (_.cover [/.lux-library /.jvm-library /.pom
+ /.sha1 /.md5]
+ (let [options (list /.lux-library /.jvm-library /.pom /.sha1 /.md5)
+ uniques (set.from-list text.hash options)]
+ (n.= (list.size options)
+ (set.size uniques))))
+ (_.cover [/.extension]
+ (`` (and (~~ (template [<type> <extension>]
+ [(text@= <extension>
+ (/.extension <type>))]
+
+ [//.lux-library /.lux-library]
+ [//.jvm-library /.jvm-library]
+ [//.pom /.pom]
+ )))))
+ ))))
diff --git a/stdlib/source/test/lux/data/collection/array.lux b/stdlib/source/test/lux/data/collection/array.lux
index 63366a81d..4cd81db10 100644
--- a/stdlib/source/test/lux/data/collection/array.lux
+++ b/stdlib/source/test/lux/data/collection/array.lux
@@ -1,25 +1,24 @@
(.module:
[lux #*
- ["%" data/text/format (#+ format)]
["_" test (#+ Test)]
[abstract
- [monad (#+ do Monad)]
+ [monad (#+ do)]
{[0 #spec]
[/
["$." equivalence]
["$." monoid]
["$." fold]
["$." functor (#+ Injection)]]}]
- [control
- pipe]
[data
+ ["." bit]
["." maybe]
[number
["n" nat]]
[collection
- ["." list]]]
+ ["." list]
+ ["." set]]]
[math
- ["r" random (#+ Random)]]]
+ ["." random (#+ Random)]]]
{1
["." / (#+ Array)]})
@@ -29,90 +28,167 @@
(def: bounded-size
(Random Nat)
- (|> r.nat
- (:: r.monad map (|>> (n.% 100) (n.+ 1)))))
+ (:: random.monad map (|>> (n.% 100) (n.+ 1))
+ random.nat))
(def: #export test
Test
- (<| (_.context (%.name (name-of /.Array)))
- (do {@ r.monad}
- [size bounded-size]
+ (<| (_.covering /._)
+ (_.with-cover [/.Array])
+ (do {@ random.monad}
+ [size ..bounded-size
+ base random.nat
+ shift random.nat
+ dummy (random.filter (|>> (n.= base) not) random.nat)
+ #let [expected (n.+ base shift)]
+ the-array (random.array size random.nat)]
($_ _.and
- ($equivalence.spec (/.equivalence n.equivalence) (r.array size r.nat))
- ($monoid.spec (/.equivalence n.equivalence) /.monoid (r.array size r.nat))
- ($functor.spec ..injection /.equivalence /.functor)
- ($fold.spec ..injection /.equivalence /.fold)
+ (_.with-cover [/.equivalence]
+ ($equivalence.spec (/.equivalence n.equivalence) (random.array size random.nat)))
+ (_.with-cover [/.monoid]
+ ($monoid.spec (/.equivalence n.equivalence) /.monoid (random.array size random.nat)))
+ (_.with-cover [/.functor]
+ ($functor.spec ..injection /.equivalence /.functor))
+ (_.with-cover [/.fold]
+ ($fold.spec ..injection /.equivalence /.fold))
+ (_.cover [/.new /.size]
+ (n.= size (/.size (: (Array Nat)
+ (/.new size)))))
+ (_.cover [/.read /.write!]
+ (let [the-array (|> (/.new 2)
+ (: (Array Nat))
+ (/.write! 0 expected))]
+ (case [(/.read 0 the-array)
+ (/.read 1 the-array)]
+ [(#.Some actual) #.None]
+ (n.= expected actual)
+
+ _
+ false)))
+ (_.cover [/.delete!]
+ (let [the-array (|> (/.new 1)
+ (: (Array Nat))
+ (/.write! 0 expected))]
+ (case [(/.read 0 the-array)
+ (/.read 0 (/.delete! 0 the-array))]
+ [(#.Some actual) #.None]
+ (n.= expected actual)
+
+ _
+ false)))
+ (_.cover [/.contains?]
+ (let [the-array (|> (/.new 2)
+ (: (Array Nat))
+ (/.write! 0 expected))]
+ (and (/.contains? 0 the-array)
+ (not (/.contains? 1 the-array)))))
+
+ (_.cover [/.update!]
+ (let [the-array (|> (/.new 1)
+ (: (Array Nat))
+ (/.write! 0 base)
+ (/.update! 0 (n.+ shift)))]
+ (case (/.read 0 the-array)
+ (#.Some actual)
+ (n.= expected actual)
+
+ _
+ false)))
+ (_.cover [/.upsert!]
+ (let [the-array (|> (/.new 2)
+ (: (Array Nat))
+ (/.write! 0 base)
+ (/.upsert! 0 dummy (n.+ shift))
+ (/.upsert! 1 base (n.+ shift)))]
+ (case [(/.read 0 the-array)
+ (/.read 1 the-array)]
+ [(#.Some actual/0) (#.Some actual/1)]
+ (and (n.= expected actual/0)
+ (n.= expected actual/1))
+
+ _
+ false)))
+ (do @
+ [occupancy (:: @ map (n.% (inc size)) random.nat)]
+ (_.cover [/.occupancy /.vacancy]
+ (let [the-array (loop [output (: (Array Nat)
+ (/.new size))
+ idx 0]
+ (if (n.< occupancy idx)
+ (recur (/.write! idx expected output)
+ (inc idx))
+ output))]
+ (and (n.= occupancy (/.occupancy the-array))
+ (n.= size (n.+ (/.occupancy the-array)
+ (/.vacancy the-array)))))))
(do @
- [size bounded-size
- original (r.array size r.nat)]
- ($_ _.and
- (_.test "Size function must correctly return size of array."
- (n.= size (/.size original)))
- (_.test "Cloning an array should yield and identical array, but not the same one."
- (let [clone (/.clone original)]
- (and (:: (/.equivalence n.equivalence) = original clone)
- (not (is? original clone)))))
- (_.test "Full-range manual copies should give the same result as cloning."
- (let [copy (: (Array Nat)
- (/.new size))]
- (exec (/.copy size 0 original 0 copy)
- (and (:: (/.equivalence n.equivalence) = original copy)
- (not (is? original copy))))))
- (_.test "Array folding should go over all values."
- (let [manual-copy (: (Array Nat)
- (/.new size))]
- (exec (:: /.fold fold
- (function (_ x idx)
- (exec (/.write idx x manual-copy)
- (inc idx)))
- 0
- original)
- (:: (/.equivalence n.equivalence) = original manual-copy))))
- (_.test "Transformations between (full) arrays and lists shouldn't cause lose or change any values."
- (|> original
- /.to-list /.from-list
- (:: (/.equivalence n.equivalence) = original)))
- ))
+ [the-list (random.list size random.nat)]
+ (_.cover [/.from-list /.to-list]
+ (and (|> the-list /.from-list /.to-list
+ (:: (list.equivalence n.equivalence) = the-list))
+ (|> the-array /.to-list /.from-list
+ (:: (/.equivalence n.equivalence) = the-array)))))
(do @
- [size bounded-size
- idx (:: @ map (n.% size) r.nat)
- array (|> (r.array size r.nat)
- (r.filter (|>> /.to-list (list.any? n.odd?))))
- #let [value (maybe.assume (/.read idx array))]]
- ($_ _.and
- (_.test "Shouldn't be able to find a value in an unoccupied cell."
- (case (/.read idx (/.delete idx array))
- (#.Some _) false
- #.None true))
- (_.test "You should be able to access values put into the array."
- (case (/.read idx (/.write idx value array))
- (#.Some value') (n.= value' value)
- #.None false))
- (_.test "All cells should be occupied on a full array."
- (and (n.= size (/.occupied array))
- (n.= 0 (/.vacant array))))
- (_.test "Filtering mutates the array to remove invalid values."
- (exec (/.filter! n.even? array)
- (and (n.< size (/.occupied array))
- (n.> 0 (/.vacant array))
- (n.= size (n.+ (/.occupied array)
- (/.vacant array))))))
- ))
+ [amount (:: @ map (n.% (inc size)) random.nat)]
+ (_.cover [/.copy!]
+ (let [copy (: (Array Nat)
+ (/.new size))]
+ (exec (/.copy! amount 0 the-array 0 copy)
+ (:: (list.equivalence n.equivalence) =
+ (list.take amount (/.to-list the-array))
+ (/.to-list copy))))))
+ (_.cover [/.clone]
+ (let [clone (/.clone the-array)]
+ (and (not (is? the-array clone))
+ (:: (/.equivalence n.equivalence) = the-array clone))))
+ (let [the-array (/.clone the-array)
+ evens (|> the-array /.to-list (list.filter n.even?))
+ odds (|> the-array /.to-list (list.filter n.odd?))]
+ (_.cover [/.filter!]
+ (exec (/.filter! n.even? the-array)
+ (and (n.= (list.size evens) (/.occupancy the-array))
+ (n.= (list.size odds) (/.vacancy the-array))
+ (|> the-array /.to-list (:: (list.equivalence n.equivalence) = evens))))))
(do @
- [size bounded-size
- array (|> (r.array size r.nat)
- (r.filter (|>> /.to-list (list.any? n.even?))))]
- ($_ _.and
- (_.test "Can find values inside arrays."
- (|> (/.find n.even? array)
- (case> (#.Some _) true
- #.None false)))
- (_.test "Can find values inside arrays (with access to indices)."
- (|> (/.find+ (function (_ idx n)
- (and (n.even? n)
- (n.< size idx)))
- array)
- (case> (#.Some _) true
- #.None false)))))
+ [#let [the-array (/.clone the-array)
+ members (|> the-array /.to-list (set.from-list n.hash))]
+ default (random.filter (function (_ value)
+ (not (or (n.even? value)
+ (set.member? members value))))
+ random.nat)]
+ (_.cover [/.to-list']
+ (exec (/.filter! n.even? the-array)
+ (list.every? (function (_ value)
+ (or (n.even? value)
+ (is? default value)))
+ (/.to-list' default the-array)))))
+ (_.cover [/.find]
+ (:: (maybe.equivalence n.equivalence) =
+ (/.find n.even? the-array)
+ (list.find n.even? (/.to-list the-array))))
+ (_.cover [/.find+]
+ (case [(/.find n.even? the-array)
+ (/.find+ (function (_ idx member)
+ (n.even? member))
+ the-array)]
+ [(#.Some expected) (#.Some [idx actual])]
+ (case (/.read idx the-array)
+ (#.Some again)
+ (and (n.= expected actual)
+ (n.= actual again))
+
+ #.None
+ false)
+
+ [#.None #.None]
+ true))
+ (_.cover [/.every?]
+ (:: bit.equivalence =
+ (list.every? n.even? (/.to-list the-array))
+ (/.every? n.even? the-array)))
+ (_.cover [/.any?]
+ (:: bit.equivalence =
+ (list.any? n.even? (/.to-list the-array))
+ (/.any? n.even? the-array)))
))))
diff --git a/stdlib/source/test/lux/macro/code.lux b/stdlib/source/test/lux/macro/code.lux
index eec419644..717d4be94 100644
--- a/stdlib/source/test/lux/macro/code.lux
+++ b/stdlib/source/test/lux/macro/code.lux
@@ -17,6 +17,8 @@
["n" nat]]
[collection
["." list ("#@." functor)]]]
+ [meta
+ ["." location]]
[tool
[compiler
[language
@@ -69,7 +71,7 @@
syntax.no-aliases
(text.size source-code))
start (: Source
- [.dummy-location 0 source-code])]
+ [location.dummy 0 source-code])]
(case (parse start)
(#.Left [end error])
(#try.Failure error)
@@ -132,7 +134,7 @@
(#try.Failure error)
false)
(:: /.equivalence =
- [.dummy-location (<tag> expected)]
+ [location.dummy (<tag> expected)]
(<coverage> expected)))))]
[/.bit random.bit #.Bit]
@@ -159,7 +161,7 @@
(#try.Failure error)
false)
(:: /.equivalence =
- [.dummy-location (<tag> ["" expected])]
+ [location.dummy (<tag> ["" expected])]
(<coverage> expected)))
))]
diff --git a/stdlib/source/test/lux/meta.lux b/stdlib/source/test/lux/meta.lux
index 1f5e2c5fa..18bc370c2 100644
--- a/stdlib/source/test/lux/meta.lux
+++ b/stdlib/source/test/lux/meta.lux
@@ -15,6 +15,8 @@
["%" format (#+ format)]]
[number
["n" nat]]]
+ [meta
+ ["." location]]
[math
["." random (#+ Random)]]]
{1
@@ -46,8 +48,8 @@
#let [expected-lux {#.info {#.target target
#.version version
#.mode #.Build}
- #.source [.dummy-location 0 source-code]
- #.location .dummy-location
+ #.source [location.dummy 0 source-code]
+ #.location location.dummy
#.current-module (#.Some expected-current-module)
#.modules (list)
#.scopes (list)
@@ -93,8 +95,8 @@
#let [expected-lux {#.info {#.target target
#.version version
#.mode #.Build}
- #.source [.dummy-location 0 source-code]
- #.location .dummy-location
+ #.source [location.dummy 0 source-code]
+ #.location location.dummy
#.current-module (#.Some expected-current-module)
#.modules (list)
#.scopes (list)
@@ -167,8 +169,8 @@
#let [expected-lux {#.info {#.target target
#.version version
#.mode #.Build}
- #.source [.dummy-location 0 source-code]
- #.location .dummy-location
+ #.source [location.dummy 0 source-code]
+ #.location location.dummy
#.current-module (#.Some expected-current-module)
#.modules (list)
#.scopes (list)
@@ -245,7 +247,7 @@
#let [expected-lux {#.info {#.target target
#.version version
#.mode #.Build}
- #.source [.dummy-location 0 source-code]
+ #.source [location.dummy 0 source-code]
#.location expected-location
#.current-module (#.Some expected-current-module)
#.modules (list)
diff --git a/stdlib/source/test/lux/target/jvm.lux b/stdlib/source/test/lux/target/jvm.lux
index e1c4dbfe3..7df1cdd07 100644
--- a/stdlib/source/test/lux/target/jvm.lux
+++ b/stdlib/source/test/lux/target/jvm.lux
@@ -229,38 +229,36 @@
(|>> (:coerce java/lang/Double) host.double-to-float)
random.frac))
(def: $Float::literal /.float)
+(def: valid-float
+ (Random java/lang/Float)
+ (random.filter (|>> host.float-to-double (:coerce Frac) f.not-a-number? not)
+ ..$Float::random))
(def: $Float::primitive
(Primitive java/lang/Float)
{#unboxed /type.float
#boxed ..$Float
#wrap ..$Float::wrap
- #random ..$Float::random
+ #random ..valid-float
#literal ..$Float::literal})
-(def: valid-float
- (Random java/lang/Float)
- (random.filter (|>> host.float-to-double (:coerce Frac) f.not-a-number? not)
- ..$Float::random))
-
(def: $Double (/type.class "java.lang.Double" (list)))
(def: $Double::wrap (/.invokestatic ..$Double "valueOf" (/type.method [(list /type.double) ..$Double (list)])))
(def: $Double::random (:coerce (Random java/lang/Double) random.frac))
(def: $Double::literal
(-> java/lang/Double (Bytecode Any))
(|>> (:coerce Frac) /.double))
+(def: valid-double
+ (Random java/lang/Double)
+ (random.filter (|>> (:coerce Frac) f.not-a-number? not)
+ ..$Double::random))
(def: $Double::primitive
(Primitive java/lang/Double)
{#unboxed /type.double
#boxed ..$Double
#wrap ..$Double::wrap
- #random ..$Double::random
+ #random ..valid-double
#literal ..$Double::literal})
-(def: valid-double
- (Random java/lang/Double)
- (random.filter (|>> (:coerce Frac) f.not-a-number? not)
- ..$Double::random))
-
(def: $Character
(/type.class "java.lang.Character" (list)))
(def: $Character::wrap
diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/syntax.lux b/stdlib/source/test/lux/tool/compiler/language/lux/syntax.lux
index c6ac62bc5..819f6ccf1 100644
--- a/stdlib/source/test/lux/tool/compiler/language/lux/syntax.lux
+++ b/stdlib/source/test/lux/tool/compiler/language/lux/syntax.lux
@@ -18,7 +18,9 @@
["." list]
["." dictionary (#+ Dictionary)]]]
[macro
- ["." code]]]
+ ["." code]]
+ [meta
+ ["." location]]]
{1
["." /]})
@@ -77,7 +79,7 @@
(_.test "Can parse Lux code."
(case (let [source-code (%.code sample)]
(/.parse "" (dictionary.new text.hash) (text.size source-code)
- [.dummy-location 0 source-code]))
+ [location.dummy 0 source-code]))
(#.Left error)
false
@@ -89,7 +91,7 @@
(let [source-code (format (%.code sample) " " (%.code other))
source-code//size (text.size source-code)]
(case (/.parse "" (dictionary.new text.hash) source-code//size
- [.dummy-location 0 source-code])
+ [location.dummy 0 source-code])
(#.Left error)
false
@@ -127,7 +129,7 @@
(case (let [source-code (format comment (%.code sample))
source-code//size (text.size source-code)]
(/.parse "" (dictionary.new text.hash) source-code//size
- [.dummy-location 0 source-code]))
+ [location.dummy 0 source-code]))
(#.Left error)
false
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-29 18:59:33 +0000