aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/test
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--stdlib/source/test/lux/control/exception.lux163
-rw-r--r--stdlib/source/test/lux/control/function.lux45
-rw-r--r--stdlib/source/test/lux/control/io.lux37
-rw-r--r--stdlib/source/test/lux/control/parser.lux431
-rw-r--r--stdlib/source/test/lux/control/pipe.lux177
-rw-r--r--stdlib/source/test/lux/control/reader.lux55
-rw-r--r--stdlib/source/test/lux/control/region.lux211
-rw-r--r--stdlib/source/test/lux/control/security/policy.lux36
-rw-r--r--stdlib/source/test/lux/locale/language.lux266
-rw-r--r--stdlib/source/test/lux/target/jvm.lux22
10 files changed, 862 insertions, 581 deletions
diff --git a/stdlib/source/test/lux/control/exception.lux b/stdlib/source/test/lux/control/exception.lux
index 8d54fa893..599eb5863 100644
--- a/stdlib/source/test/lux/control/exception.lux
+++ b/stdlib/source/test/lux/control/exception.lux
@@ -1,8 +1,8 @@
(.module:
[lux #*
- [abstract/monad (#+ do)]
+ [abstract
+ [monad (#+ do)]]
[data
- ["." name]
[number
["n" nat]]
["." text ("#@." equivalence)
@@ -33,84 +33,85 @@
value0 report-element
field1 report-element
value1 report-element]
- (<| (_.context (name.module (name-of /._)))
+ (<| (_.covering /._)
+ (_.with-cover [/.Exception])
($_ _.and
- (_.test (%.name (name-of /.return))
- (case (/.return expected)
- (#try.Success actual) (n.= expected actual)
- (#try.Failure _) false))
- (_.test (%.name (name-of /.throw))
- (case (/.throw ..an-exception [])
- (#try.Success _) false
- (#try.Failure _) true))
- (_.test (%.name (name-of /.construct))
- (case (/.throw ..an-exception [])
- (#try.Success _)
- false
-
- (#try.Failure message)
- (text@= message (/.construct ..an-exception []))))
- (_.test (%.name (name-of /.match?))
- (/.match? ..an-exception
- (/.construct ..an-exception [])))
- (_.test (%.name (name-of /.assert))
- (case (/.assert ..an-exception [] assertion-succeeded?)
- (#try.Success _)
- assertion-succeeded?
-
- (#try.Failure message)
- (and (not assertion-succeeded?)
- (text@= message (/.construct ..an-exception [])))))
- (_.test (%.name (name-of /.catch))
- (and (n.= expected
- (|> (/.throw ..an-exception [])
- (/.catch ..an-exception (function (_ ex) expected))
- (/.otherwise (function (_ ex) wrong))))
- (n.= expected
- (|> (/.throw ..another-exception [])
- (/.catch ..an-exception (function (_ ex) wrong))
- (/.catch ..another-exception (function (_ ex) expected))
- (/.otherwise (function (_ ex) wrong))))))
- (_.test (%.name (name-of /.otherwise))
- (n.= expected
- (|> (/.throw ..another-exception [])
- (/.catch ..an-exception (function (_ ex) wrong))
- (/.otherwise (function (_ ex) expected)))))
- (_.test (%.name (name-of /.report))
- (let [report (/.report [field0 value0]
- [field1 value1])]
- (and (text.contains? field0 report)
- (text.contains? value0 report)
- (text.contains? field1 report)
- (text.contains? value1 report))))
- (_.test (%.name (name-of /.enumerate))
- (let [enumeration (/.enumerate %.text (list field0 value0 field1 value1))]
- (and (text.contains? field0 enumeration)
- (text.contains? value0 enumeration)
- (text.contains? field1 enumeration)
- (text.contains? value1 enumeration))))
- (_.test (%.name (name-of /.with))
- (and (case (/.with ..an-exception [] (#try.Success expected))
- (#try.Success actual) (n.= expected actual)
- (#try.Failure _) false)
- (case (/.with ..an-exception [] (#try.Failure ""))
- (#try.Success _) false
- (#try.Failure message) (text@= message (/.construct ..an-exception [])))
- (case (/.with ..an-exception []
- (: (Try Nat)
- (/.throw ..another-exception [])))
- (#try.Success _)
- false
-
- (#try.Failure message)
- (and (text.contains? (/.construct ..an-exception []) message)
- (text.contains? (/.construct ..another-exception []) message)))))
- (_.test (%.name (name-of /.exception:))
- (case (/.throw ..custom-exception [expected])
- (#try.Success _)
- false
-
- (#try.Failure message)
- (and (text.contains? ..label message)
- (text.contains? (%.nat expected) message))))
+ (_.cover [/.return]
+ (case (/.return expected)
+ (#try.Success actual) (n.= expected actual)
+ (#try.Failure _) false))
+ (_.cover [/.throw]
+ (case (/.throw ..an-exception [])
+ (#try.Success _) false
+ (#try.Failure _) true))
+ (_.cover [/.construct]
+ (case (/.throw ..an-exception [])
+ (#try.Success _)
+ false
+
+ (#try.Failure message)
+ (text@= message (/.construct ..an-exception []))))
+ (_.cover [/.match?]
+ (/.match? ..an-exception
+ (/.construct ..an-exception [])))
+ (_.cover [/.assert]
+ (case (/.assert ..an-exception [] assertion-succeeded?)
+ (#try.Success _)
+ assertion-succeeded?
+
+ (#try.Failure message)
+ (and (not assertion-succeeded?)
+ (text@= message (/.construct ..an-exception [])))))
+ (_.cover [/.catch]
+ (and (n.= expected
+ (|> (/.throw ..an-exception [])
+ (/.catch ..an-exception (function (_ ex) expected))
+ (/.otherwise (function (_ ex) wrong))))
+ (n.= expected
+ (|> (/.throw ..another-exception [])
+ (/.catch ..an-exception (function (_ ex) wrong))
+ (/.catch ..another-exception (function (_ ex) expected))
+ (/.otherwise (function (_ ex) wrong))))))
+ (_.cover [/.otherwise]
+ (n.= expected
+ (|> (/.throw ..another-exception [])
+ (/.catch ..an-exception (function (_ ex) wrong))
+ (/.otherwise (function (_ ex) expected)))))
+ (_.cover [/.report]
+ (let [report (/.report [field0 value0]
+ [field1 value1])]
+ (and (text.contains? field0 report)
+ (text.contains? value0 report)
+ (text.contains? field1 report)
+ (text.contains? value1 report))))
+ (_.cover [/.enumerate]
+ (let [enumeration (/.enumerate %.text (list field0 value0 field1 value1))]
+ (and (text.contains? field0 enumeration)
+ (text.contains? value0 enumeration)
+ (text.contains? field1 enumeration)
+ (text.contains? value1 enumeration))))
+ (_.cover [/.with]
+ (and (case (/.with ..an-exception [] (#try.Success expected))
+ (#try.Success actual) (n.= expected actual)
+ (#try.Failure _) false)
+ (case (/.with ..an-exception [] (#try.Failure ""))
+ (#try.Success _) false
+ (#try.Failure message) (text@= message (/.construct ..an-exception [])))
+ (case (/.with ..an-exception []
+ (: (Try Nat)
+ (/.throw ..another-exception [])))
+ (#try.Success _)
+ false
+
+ (#try.Failure message)
+ (and (text.contains? (/.construct ..an-exception []) message)
+ (text.contains? (/.construct ..another-exception []) message)))))
+ (_.cover [/.exception:]
+ (case (/.throw ..custom-exception [expected])
+ (#try.Success _)
+ false
+
+ (#try.Failure message)
+ (and (text.contains? ..label message)
+ (text.contains? (%.nat expected) message))))
))))
diff --git a/stdlib/source/test/lux/control/function.lux b/stdlib/source/test/lux/control/function.lux
index 145e466c0..f795d27c0 100644
--- a/stdlib/source/test/lux/control/function.lux
+++ b/stdlib/source/test/lux/control/function.lux
@@ -7,11 +7,9 @@
[/
["$." monoid]]}]
[data
- ["." name]
[number
["n" nat]]
- ["." text ("#@." equivalence)
- ["%" format (#+ format)]]]
+ ["." text ("#@." equivalence)]]
[math
["." random (#+ Random)]]
["_" test (#+ Test)]]
@@ -26,7 +24,7 @@
f1 (:: @ map n.* random.nat)
dummy random.nat
extra (|> random.nat (random.filter (|>> (n.= expected) not)))]
- (<| (_.context (name.module (name-of /._)))
+ (<| (_.covering /._)
($_ _.and
(let [equivalence (: (Equivalence (-> Nat Nat))
(structure
@@ -35,24 +33,25 @@
(right extra)))))
generator (: (Random (-> Nat Nat))
(:: @ map n.- random.nat))]
- ($monoid.spec equivalence /.monoid generator))
+ (_.with-cover [/.monoid]
+ ($monoid.spec equivalence /.monoid generator)))
- (_.test (%.name (name-of /.identity))
- (n.= expected
- (/.identity expected)))
- (_.test (%.name (name-of /.compose))
- (n.= (f0 (f1 expected))
- ((/.compose f0 f1) expected)))
- (_.test (%.name (name-of /.constant))
- (n.= expected
- ((/.constant expected) dummy)))
- (_.test (%.name (name-of /.flip))
- (let [outcome ((/.flip n.-) expected extra)]
- (and (n.= (n.- extra expected)
- outcome)
- (not (n.= (n.- expected extra)
- outcome)))))
- (_.test (%.name (name-of /.apply))
- (n.= (f0 extra)
- (/.apply extra f0)))
+ (_.cover [/.identity]
+ (n.= expected
+ (/.identity expected)))
+ (_.cover [/.compose]
+ (n.= (f0 (f1 expected))
+ ((/.compose f0 f1) expected)))
+ (_.cover [/.constant]
+ (n.= expected
+ ((/.constant expected) dummy)))
+ (_.cover [/.flip]
+ (let [outcome ((/.flip n.-) expected extra)]
+ (and (n.= (n.- extra expected)
+ outcome)
+ (not (n.= (n.- expected extra)
+ outcome)))))
+ (_.cover [/.apply]
+ (n.= (f0 extra)
+ (/.apply extra f0)))
))))
diff --git a/stdlib/source/test/lux/control/io.lux b/stdlib/source/test/lux/control/io.lux
index 32bf5f4fc..4855e8c3f 100644
--- a/stdlib/source/test/lux/control/io.lux
+++ b/stdlib/source/test/lux/control/io.lux
@@ -1,8 +1,8 @@
(.module:
[lux #*
- ["%" data/text/format (#+ format)]
["_" test (#+ Test)]
- ["r" math/random]
+ [math
+ ["." random]]
[abstract
[monad (#+ do)]
{[0 #spec]
@@ -11,7 +11,6 @@
["$." apply]
["$." monad]]}]
[data
- ["." name]
[number
["n" nat]]]]
{1
@@ -30,18 +29,24 @@
(def: #export test
Test
- (<| (_.context (name.module (name-of /._)))
- (do r.monad
- [sample r.nat
- exit-code r.int]
+ (<| (_.covering /._)
+ (_.with-cover [/.IO])
+ (do random.monad
+ [sample random.nat
+ exit-code random.int]
($_ _.and
- ($functor.spec ..injection ..comparison /.functor)
- ($apply.spec ..injection ..comparison /.apply)
- ($monad.spec ..injection ..comparison /.monad)
+ (_.with-cover [/.functor]
+ ($functor.spec ..injection ..comparison /.functor))
+ (_.with-cover [/.apply]
+ ($apply.spec ..injection ..comparison /.apply))
+ (_.with-cover [/.monad]
+ ($monad.spec ..injection ..comparison /.monad))
- (_.test (%.name (name-of /.run))
- (n.= sample
- (/.run (/.io sample))))
- (_.test (%.name (name-of /.exit))
- (exec (/.exit exit-code)
- true))))))
+ (_.cover [/.run /.io]
+ (n.= sample
+ (/.run (/.io sample))))
+ (_.cover [/.exit]
+ ## The /.exit is not actually executed because it would immediately
+ ## terminate the program/tests.
+ (exec (/.exit exit-code)
+ true))))))
diff --git a/stdlib/source/test/lux/control/parser.lux b/stdlib/source/test/lux/control/parser.lux
index 701d49741..092152160 100644
--- a/stdlib/source/test/lux/control/parser.lux
+++ b/stdlib/source/test/lux/control/parser.lux
@@ -14,7 +14,6 @@
[parser
["s" code]]]
[data
- ["." name]
[number
["n" nat]]
["." text ("#@." equivalence)
@@ -83,85 +82,85 @@
odd0 (random.filter n.odd? random.nat)
not0 random.bit]
($_ _.and
- (_.test (%.name (name-of /.maybe))
- (and (|> (list (code.nat expected0))
- (/.run (/.maybe s.nat))
- (match (#.Some actual)
- (n.= expected0 actual)))
- (|> (list (code.int (.int expected0)))
- (/.run (/.maybe s.nat))
- (match #.None
- #1))))
- (_.test (%.name (name-of /.some))
- (and (|> (list@map code.nat expected+)
- (/.run (/.some s.nat))
- (match actual
- (:: (list.equivalence n.equivalence) = expected+ actual)))
- (|> (list@map (|>> .int code.int) expected+)
- (/.run (/.some s.nat))
- (match #.Nil
- #1))))
- (_.test (%.name (name-of /.many))
- (and (|> (list@map code.nat expected+)
- (/.run (/.many s.nat))
- (match actual
- (:: (list.equivalence n.equivalence) = expected+ actual)))
- (|> (list (code.nat expected0))
- (/.run (/.many s.nat))
- (match (list actual)
- (n.= expected0 actual)))
- (|> (list@map (|>> .int code.int) expected+)
- (/.run (/.many s.nat))
- fails?)))
- (_.test (%.name (name-of /.filter))
- (and (|> (list (code.nat even0))
- (/.run (/.filter n.even? s.nat))
- (match actual (n.= even0 actual)))
- (|> (list (code.nat odd0))
- (/.run (/.filter n.even? s.nat))
- fails?)))
- (_.test (%.name (name-of /.and))
- (let [even (/.filter n.even? s.nat)
- odd (/.filter n.odd? s.nat)]
- (and (|> (list (code.nat even0) (code.nat odd0))
- (/.run (/.and even odd))
- (match [left right]
- (and (n.= even0 left)
- (n.= odd0 right))))
- (|> (list (code.nat odd0) (code.nat even0))
- (/.run (/.and even odd))
- fails?))))
- (_.test (%.name (name-of /.or))
- (let [even (/.filter n.even? s.nat)
- odd (/.filter n.odd? s.nat)]
- (and (|> (list (code.nat even0))
- (/.run (/.or even odd))
- (match (#.Left actual) (n.= even0 actual)))
- (|> (list (code.nat odd0))
- (/.run (/.or even odd))
- (match (#.Right actual) (n.= odd0 actual)))
- (|> (list (code.bit not0))
- (/.run (/.or even odd))
- fails?))))
- (_.test (%.name (name-of /.either))
- (let [even (/.filter n.even? s.nat)
- odd (/.filter n.odd? s.nat)]
- (and (|> (list (code.nat even0))
- (/.run (/.either even odd))
- (match actual (n.= even0 actual)))
- (|> (list (code.nat odd0))
- (/.run (/.either even odd))
- (match actual (n.= odd0 actual)))
- (|> (list (code.bit not0))
- (/.run (/.either even odd))
- fails?))))
- (_.test (%.name (name-of /.not))
- (and (|> (list (code.nat expected0))
- (/.run (/.not s.nat))
- fails?)
- (|> (list (code.bit not0))
- (/.run (/.not s.nat))
- (match [] #1))))
+ (_.cover [/.maybe]
+ (and (|> (list (code.nat expected0))
+ (/.run (/.maybe s.nat))
+ (match (#.Some actual)
+ (n.= expected0 actual)))
+ (|> (list (code.int (.int expected0)))
+ (/.run (/.maybe s.nat))
+ (match #.None
+ #1))))
+ (_.cover [/.some]
+ (and (|> (list@map code.nat expected+)
+ (/.run (/.some s.nat))
+ (match actual
+ (:: (list.equivalence n.equivalence) = expected+ actual)))
+ (|> (list@map (|>> .int code.int) expected+)
+ (/.run (/.some s.nat))
+ (match #.Nil
+ #1))))
+ (_.cover [/.many]
+ (and (|> (list@map code.nat expected+)
+ (/.run (/.many s.nat))
+ (match actual
+ (:: (list.equivalence n.equivalence) = expected+ actual)))
+ (|> (list (code.nat expected0))
+ (/.run (/.many s.nat))
+ (match (list actual)
+ (n.= expected0 actual)))
+ (|> (list@map (|>> .int code.int) expected+)
+ (/.run (/.many s.nat))
+ fails?)))
+ (_.cover [/.filter]
+ (and (|> (list (code.nat even0))
+ (/.run (/.filter n.even? s.nat))
+ (match actual (n.= even0 actual)))
+ (|> (list (code.nat odd0))
+ (/.run (/.filter n.even? s.nat))
+ fails?)))
+ (_.cover [/.and]
+ (let [even (/.filter n.even? s.nat)
+ odd (/.filter n.odd? s.nat)]
+ (and (|> (list (code.nat even0) (code.nat odd0))
+ (/.run (/.and even odd))
+ (match [left right]
+ (and (n.= even0 left)
+ (n.= odd0 right))))
+ (|> (list (code.nat odd0) (code.nat even0))
+ (/.run (/.and even odd))
+ fails?))))
+ (_.cover [/.or]
+ (let [even (/.filter n.even? s.nat)
+ odd (/.filter n.odd? s.nat)]
+ (and (|> (list (code.nat even0))
+ (/.run (/.or even odd))
+ (match (#.Left actual) (n.= even0 actual)))
+ (|> (list (code.nat odd0))
+ (/.run (/.or even odd))
+ (match (#.Right actual) (n.= odd0 actual)))
+ (|> (list (code.bit not0))
+ (/.run (/.or even odd))
+ fails?))))
+ (_.cover [/.either]
+ (let [even (/.filter n.even? s.nat)
+ odd (/.filter n.odd? s.nat)]
+ (and (|> (list (code.nat even0))
+ (/.run (/.either even odd))
+ (match actual (n.= even0 actual)))
+ (|> (list (code.nat odd0))
+ (/.run (/.either even odd))
+ (match actual (n.= odd0 actual)))
+ (|> (list (code.bit not0))
+ (/.run (/.either even odd))
+ fails?))))
+ (_.cover [/.not]
+ (and (|> (list (code.nat expected0))
+ (/.run (/.not s.nat))
+ fails?)
+ (|> (list (code.bit not0))
+ (/.run (/.not s.nat))
+ (match [] #1))))
)))
(def: combinators-1
@@ -174,74 +173,74 @@
expected+ (random.list variadic random.nat)
separator (random.ascii 1)]
($_ _.and
- (_.test (%.name (name-of /.exactly))
- (and (|> (list@map code.nat expected+)
- (/.run (/.exactly times s.nat))
- (match actual
- (:: (list.equivalence n.equivalence) =
- (list.take times expected+)
- actual)))
- (|> (list@map code.nat expected+)
- (/.run (/.exactly (inc variadic) s.nat))
- fails?)))
- (_.test (%.name (name-of /.at-least))
- (and (|> (list@map code.nat expected+)
- (/.run (/.at-least times s.nat))
- (match actual
- (:: (list.equivalence n.equivalence) =
- expected+
- actual)))
- (|> (list@map code.nat expected+)
- (/.run (/.at-least (inc variadic) s.nat))
- fails?)))
- (_.test (%.name (name-of /.at-most))
- (and (|> (list@map code.nat expected+)
- (/.run (/.at-most times s.nat))
- (match actual
- (:: (list.equivalence n.equivalence) =
- (list.take times expected+)
- actual)))
- (|> (list@map code.nat expected+)
- (/.run (/.at-most (inc variadic) s.nat))
- (match actual
- (:: (list.equivalence n.equivalence) =
- expected+
- actual)))))
- (_.test (%.name (name-of /.between))
- (and (|> (list@map code.nat expected+)
- (/.run (/.between times variadic s.nat))
- (match actual
- (:: (list.equivalence n.equivalence) =
- expected+
- actual)))
- (|> (list@map code.nat (list.take times expected+))
- (/.run (/.between times variadic s.nat))
- (match actual
- (:: (list.equivalence n.equivalence) =
- (list.take times expected+)
- actual)))))
- (_.test (%.name (name-of /.sep-by))
- (|> (list.interpose (code.text separator) (list@map code.nat expected+))
- (/.run (/.sep-by (s.this! (code.text separator)) s.nat))
- (match actual
- (:: (list.equivalence n.equivalence) =
- expected+
- actual))))
- (_.test (%.name (name-of /.remaining))
- (|> (list@map code.nat expected+)
- (/.run /.remaining)
- (match actual
- (:: (list.equivalence code.equivalence) =
- (list@map code.nat expected+)
- actual))))
- (_.test (%.name (name-of /.default))
- (and (|> (/.run (/.default wrong (:: /.monad wrap expected)) (list))
- (match actual (n.= expected actual)))
- (|> (/.run (/.default expected (: (Parser (List Code) Nat)
- (/.fail "yolo")))
- (list))
- (match actual (n.= expected actual)))
- ))
+ (_.cover [/.exactly]
+ (and (|> (list@map code.nat expected+)
+ (/.run (/.exactly times s.nat))
+ (match actual
+ (:: (list.equivalence n.equivalence) =
+ (list.take times expected+)
+ actual)))
+ (|> (list@map code.nat expected+)
+ (/.run (/.exactly (inc variadic) s.nat))
+ fails?)))
+ (_.cover [/.at-least]
+ (and (|> (list@map code.nat expected+)
+ (/.run (/.at-least times s.nat))
+ (match actual
+ (:: (list.equivalence n.equivalence) =
+ expected+
+ actual)))
+ (|> (list@map code.nat expected+)
+ (/.run (/.at-least (inc variadic) s.nat))
+ fails?)))
+ (_.cover [/.at-most]
+ (and (|> (list@map code.nat expected+)
+ (/.run (/.at-most times s.nat))
+ (match actual
+ (:: (list.equivalence n.equivalence) =
+ (list.take times expected+)
+ actual)))
+ (|> (list@map code.nat expected+)
+ (/.run (/.at-most (inc variadic) s.nat))
+ (match actual
+ (:: (list.equivalence n.equivalence) =
+ expected+
+ actual)))))
+ (_.cover [/.between]
+ (and (|> (list@map code.nat expected+)
+ (/.run (/.between times variadic s.nat))
+ (match actual
+ (:: (list.equivalence n.equivalence) =
+ expected+
+ actual)))
+ (|> (list@map code.nat (list.take times expected+))
+ (/.run (/.between times variadic s.nat))
+ (match actual
+ (:: (list.equivalence n.equivalence) =
+ (list.take times expected+)
+ actual)))))
+ (_.cover [/.sep-by]
+ (|> (list.interpose (code.text separator) (list@map code.nat expected+))
+ (/.run (/.sep-by (s.this! (code.text separator)) s.nat))
+ (match actual
+ (:: (list.equivalence n.equivalence) =
+ expected+
+ actual))))
+ (_.cover [/.remaining]
+ (|> (list@map code.nat expected+)
+ (/.run /.remaining)
+ (match actual
+ (:: (list.equivalence code.equivalence) =
+ (list@map code.nat expected+)
+ actual))))
+ (_.cover [/.default]
+ (and (|> (/.run (/.default wrong (:: /.monad wrap expected)) (list))
+ (match actual (n.= expected actual)))
+ (|> (/.run (/.default expected (: (Parser (List Code) Nat)
+ (/.fail "yolo")))
+ (list))
+ (match actual (n.= expected actual)))
+ ))
)))
(def: combinators-2
@@ -253,47 +252,47 @@
#let [even^ (/.filter n.even? s.nat)
odd^ (/.filter n.odd? s.nat)]]
($_ _.and
- (_.test (%.name (name-of /.rec))
- (let [parser (/.rec (function (_ self)
- (/.either s.nat
- (s.tuple self))))
- level-0 (code.nat expected)
- level-up (: (-> Code Code)
- (|>> list code.tuple))]
- (and (|> (list level-0)
- (/.run parser)
- (match actual (n.= expected actual)))
- (|> (list (level-up level-0))
- (/.run parser)
- (match actual (n.= expected actual)))
- (|> (list (level-up (level-up level-0)))
- (/.run parser)
- (match actual (n.= expected actual))))))
- (_.test (%.name (name-of /.after))
- (and (|> (/.run (/.after even^ s.nat)
- (list (code.nat even) (code.nat expected)))
- (match actual (n.= expected actual)))
- (|> (/.run (/.after even^ s.nat)
- (list (code.nat odd) (code.nat expected)))
- fails?)))
- (_.test (%.name (name-of /.before))
- (and (|> (/.run (/.before even^ s.nat)
- (list (code.nat expected) (code.nat even)))
- (match actual (n.= expected actual)))
- (|> (/.run (/.before even^ s.nat)
- (list (code.nat expected) (code.nat odd)))
- fails?)))
- (_.test (%.name (name-of /.parses?))
- (and (|> (/.run (/.parses? even^)
- (list (code.nat even)))
- (match verdict verdict))
- (|> (/.run (/.parses? even^)
- (list (code.nat odd)))
- (match verdict (not verdict)))))
- (_.test (%.name (name-of /.codec))
- (|> (/.run (/.codec n.decimal s.text)
- (list (code.text (%.nat expected))))
- (match actual (n.= expected actual))))
+ (_.cover [/.rec]
+ (let [parser (/.rec (function (_ self)
+ (/.either s.nat
+ (s.tuple self))))
+ level-0 (code.nat expected)
+ level-up (: (-> Code Code)
+ (|>> list code.tuple))]
+ (and (|> (list level-0)
+ (/.run parser)
+ (match actual (n.= expected actual)))
+ (|> (list (level-up level-0))
+ (/.run parser)
+ (match actual (n.= expected actual)))
+ (|> (list (level-up (level-up level-0)))
+ (/.run parser)
+ (match actual (n.= expected actual))))))
+ (_.cover [/.after]
+ (and (|> (/.run (/.after even^ s.nat)
+ (list (code.nat even) (code.nat expected)))
+ (match actual (n.= expected actual)))
+ (|> (/.run (/.after even^ s.nat)
+ (list (code.nat odd) (code.nat expected)))
+ fails?)))
+ (_.cover [/.before]
+ (and (|> (/.run (/.before even^ s.nat)
+ (list (code.nat expected) (code.nat even)))
+ (match actual (n.= expected actual)))
+ (|> (/.run (/.before even^ s.nat)
+ (list (code.nat expected) (code.nat odd)))
+ fails?)))
+ (_.cover [/.parses?]
+ (and (|> (/.run (/.parses? even^)
+ (list (code.nat even)))
+ (match verdict verdict))
+ (|> (/.run (/.parses? even^)
+ (list (code.nat odd)))
+ (match verdict (not verdict)))))
+ (_.cover [/.codec]
+ (|> (/.run (/.codec n.decimal s.text)
+ (list (code.text (%.nat expected))))
+ (match actual (n.= expected actual))))
)))
(def: injection
@@ -316,33 +315,37 @@
[expected random.nat
failure (random.ascii 1)
assertion (random.ascii 1)]
- (<| (_.context (name.module (name-of /._)))
+ (<| (_.covering /._)
+ (_.with-cover [/.Parser])
($_ _.and
- ($functor.spec ..injection ..comparison /.functor)
- ($apply.spec ..injection ..comparison /.apply)
- ($monad.spec ..injection ..comparison /.monad)
+ (_.with-cover [/.functor]
+ ($functor.spec ..injection ..comparison /.functor))
+ (_.with-cover [/.apply]
+ ($apply.spec ..injection ..comparison /.apply))
+ (_.with-cover [/.monad]
+ ($monad.spec ..injection ..comparison /.monad))
- (_.test (%.name (name-of /.run))
- (|> (/.run (:: /.monad wrap expected) (list))
- (match actual (n.= expected actual))))
- (_.test (%.name (name-of /.fail))
- (|> (list)
- (/.run (/.fail failure))
- (should-fail failure)))
- (_.test (%.name (name-of /.lift))
- (and (|> (list)
- (/.run (/.lift (#try.Success expected)))
- (match actual (n.= expected actual)))
- (|> (list)
- (/.run (/.lift (#try.Failure failure)))
- (should-fail failure))))
- (_.test (%.name (name-of /.assert))
- (and (|> (list (code.bit #1) (code.int +123))
- (/.run (/.assert assertion #1))
- (match [] true))
- (|> (list (code.bit #1) (code.int +123))
- (/.run (/.assert assertion #0))
- fails?)))
+ (_.cover [/.run]
+ (|> (/.run (:: /.monad wrap expected) (list))
+ (match actual (n.= expected actual))))
+ (_.cover [/.fail]
+ (|> (list)
+ (/.run (/.fail failure))
+ (should-fail failure)))
+ (_.cover [/.lift]
+ (and (|> (list)
+ (/.run (/.lift (#try.Success expected)))
+ (match actual (n.= expected actual)))
+ (|> (list)
+ (/.run (/.lift (#try.Failure failure)))
+ (should-fail failure))))
+ (_.cover [/.assert]
+ (and (|> (list (code.bit #1) (code.int +123))
+ (/.run (/.assert assertion #1))
+ (match [] true))
+ (|> (list (code.bit #1) (code.int +123))
+ (/.run (/.assert assertion #0))
+ fails?)))
..combinators-0
..combinators-1
..combinators-2
diff --git a/stdlib/source/test/lux/control/pipe.lux b/stdlib/source/test/lux/control/pipe.lux
index 7bf7e5e0f..1efc39cbc 100644
--- a/stdlib/source/test/lux/control/pipe.lux
+++ b/stdlib/source/test/lux/control/pipe.lux
@@ -5,106 +5,105 @@
[monad (#+ do)]]
[data
["." identity]
- ["." name]
[number
["n" nat]]
["." text ("#@." equivalence)
["%" format (#+ format)]]]
[math
- ["r" random]]]
+ ["." random]]]
{1
["." /]})
(def: #export test
Test
- (<| (_.context (name.module (name-of /._)))
- (do {@ r.monad}
- [sample r.nat]
+ (<| (_.covering /._)
+ (do {@ random.monad}
+ [sample random.nat]
($_ _.and
(do @
- [another r.nat]
- (_.test (%.name (name-of /.new>))
- (n.= (inc another)
- (|> sample
- (n.* 3)
- (n.+ 4)
- (/.new> another [inc])))))
- (_.test (%.name (name-of /.let>))
- (n.= (n.+ sample sample)
- (|> sample
- (/.let> x [(n.+ x x)]))))
- (_.test (%.name (name-of /.cond>))
- (text@= (cond (n.= 0 sample) "zero"
- (n.even? sample) "even"
- "odd")
+ [another random.nat]
+ (_.cover [/.new>]
+ (n.= (inc another)
(|> sample
- (/.cond> [(n.= 0)] [(/.new> "zero" [])]
- [n.even?] [(/.new> "even" [])]
- [(/.new> "odd" [])]))))
- (_.test (%.name (name-of /.if>))
- (text@= (if (n.even? sample)
- "even"
- "odd")
- (|> sample
- (/.if> [n.even?]
- [(/.new> "even" [])]
- [(/.new> "odd" [])]))))
- (_.test (%.name (name-of /.when>))
- (n.= (if (n.even? sample)
- (n.* 2 sample)
- sample)
- (|> sample
- (/.when> [n.even?]
- [(n.* 2)]))))
- (_.test (%.name (name-of /.loop>))
- (n.= (n.* 10 sample)
- (|> sample
- (/.loop> [(n.= (n.* 10 sample)) not]
- [(n.+ sample)]))))
- (_.test (%.name (name-of /.do>))
- (n.= (inc (n.+ 4 (n.* 3 sample)))
- (|> sample
- (/.do> identity.monad
- [(n.* 3)]
- [(n.+ 4)]
- [inc]))))
- (_.test (%.name (name-of /.exec>))
- (n.= (n.* 10 sample)
- (|> sample
- (/.exec> [%.nat (format "sample = ") log!])
- (n.* 10))))
- (_.test (%.name (name-of /.tuple>))
- (let [[left middle right] (|> sample
- (/.tuple> [inc]
- [dec]
- [%.nat]))]
- (and (n.= (inc sample) left)
- (n.= (dec sample) middle)
- (text@= (%.nat sample) right))))
- (_.test (%.name (name-of /.case>))
- (text@= (case (n.% 10 sample)
- 0 "zero"
- 1 "one"
- 2 "two"
- 3 "three"
- 4 "four"
- 5 "five"
- 6 "six"
- 7 "seven"
- 8 "eight"
- 9 "nine"
- _ "???")
- (|> sample
- (n.% 10)
- (/.case> 0 "zero"
- 1 "one"
- 2 "two"
- 3 "three"
- 4 "four"
- 5 "five"
- 6 "six"
- 7 "seven"
- 8 "eight"
- 9 "nine"
- _ "???"))))
+ (n.* 3)
+ (n.+ 4)
+ (/.new> another [inc])))))
+ (_.cover [/.let>]
+ (n.= (n.+ sample sample)
+ (|> sample
+ (/.let> x [(n.+ x x)]))))
+ (_.cover [/.cond>]
+ (text@= (cond (n.= 0 sample) "zero"
+ (n.even? sample) "even"
+ "odd")
+ (|> sample
+ (/.cond> [(n.= 0)] [(/.new> "zero" [])]
+ [n.even?] [(/.new> "even" [])]
+ [(/.new> "odd" [])]))))
+ (_.cover [/.if>]
+ (text@= (if (n.even? sample)
+ "even"
+ "odd")
+ (|> sample
+ (/.if> [n.even?]
+ [(/.new> "even" [])]
+ [(/.new> "odd" [])]))))
+ (_.cover [/.when>]
+ (n.= (if (n.even? sample)
+ (n.* 2 sample)
+ sample)
+ (|> sample
+ (/.when> [n.even?]
+ [(n.* 2)]))))
+ (_.cover [/.loop>]
+ (n.= (n.* 10 sample)
+ (|> sample
+ (/.loop> [(n.= (n.* 10 sample)) not]
+ [(n.+ sample)]))))
+ (_.cover [/.do>]
+ (n.= (inc (n.+ 4 (n.* 3 sample)))
+ (|> sample
+ (/.do> identity.monad
+ [(n.* 3)]
+ [(n.+ 4)]
+ [inc]))))
+ (_.cover [/.exec>]
+ (n.= (n.* 10 sample)
+ (|> sample
+ (/.exec> [%.nat (format "sample = ") log!])
+ (n.* 10))))
+ (_.cover [/.tuple>]
+ (let [[left middle right] (|> sample
+ (/.tuple> [inc]
+ [dec]
+ [%.nat]))]
+ (and (n.= (inc sample) left)
+ (n.= (dec sample) middle)
+ (text@= (%.nat sample) right))))
+ (_.cover [/.case>]
+ (text@= (case (n.% 10 sample)
+ 0 "zero"
+ 1 "one"
+ 2 "two"
+ 3 "three"
+ 4 "four"
+ 5 "five"
+ 6 "six"
+ 7 "seven"
+ 8 "eight"
+ 9 "nine"
+ _ "???")
+ (|> sample
+ (n.% 10)
+ (/.case> 0 "zero"
+ 1 "one"
+ 2 "two"
+ 3 "three"
+ 4 "four"
+ 5 "five"
+ 6 "six"
+ 7 "seven"
+ 8 "eight"
+ 9 "nine"
+ _ "???"))))
))))
diff --git a/stdlib/source/test/lux/control/reader.lux b/stdlib/source/test/lux/control/reader.lux
index 29a21d045..7b6a8a8c3 100644
--- a/stdlib/source/test/lux/control/reader.lux
+++ b/stdlib/source/test/lux/control/reader.lux
@@ -9,13 +9,10 @@
["$." apply]
["$." monad]]}]
[data
- ["." name]
[number
- ["n" nat]]
- [text
- ["%" format (#+ format)]]]
+ ["n" nat]]]
[math
- ["r" random]]]
+ ["." random]]]
{1
["." / (#+ Reader)
[//
@@ -33,28 +30,32 @@
(def: #export test
Test
- (<| (_.context (name.module (name-of /._)))
- (do r.monad
- [sample r.nat
- factor r.nat]
+ (<| (_.covering /._)
+ (_.with-cover [/.Reader])
+ (do random.monad
+ [sample random.nat
+ factor random.nat]
($_ _.and
- ($functor.spec ..injection ..comparison /.functor)
- ($apply.spec ..injection ..comparison /.apply)
- ($monad.spec ..injection ..comparison /.monad)
+ (_.with-cover [/.functor]
+ ($functor.spec ..injection ..comparison /.functor))
+ (_.with-cover [/.apply]
+ ($apply.spec ..injection ..comparison /.apply))
+ (_.with-cover [/.monad]
+ ($monad.spec ..injection ..comparison /.monad))
- (_.test (%.name (name-of /.ask))
- (n.= sample
- (/.run sample /.ask)))
- (_.test (%.name (name-of /.local))
- (n.= (n.* factor sample)
- (/.run sample (/.local (n.* factor) /.ask))))
+ (_.cover [/.run /.ask]
+ (n.= sample
+ (/.run sample /.ask)))
+ (_.cover [/.local]
+ (n.= (n.* factor sample)
+ (/.run sample (/.local (n.* factor) /.ask))))
(let [(^open "io@.") io.monad]
- (_.test (%.name (name-of /.with))
- (|> (: (/.Reader Any (IO Nat))
- (do (/.with io.monad)
- [a (/.lift (io@wrap sample))
- b (wrap factor)]
- (wrap (n.* b a))))
- (/.run [])
- io.run
- (n.= (n.* factor sample)))))))))
+ (_.cover [/.with /.lift]
+ (|> (: (/.Reader Any (IO Nat))
+ (do (/.with io.monad)
+ [a (/.lift (io@wrap sample))
+ b (wrap factor)]
+ (wrap (n.* b a))))
+ (/.run [])
+ io.run
+ (n.= (n.* factor sample)))))))))
diff --git a/stdlib/source/test/lux/control/region.lux b/stdlib/source/test/lux/control/region.lux
index 550b3b872..763a4be0c 100644
--- a/stdlib/source/test/lux/control/region.lux
+++ b/stdlib/source/test/lux/control/region.lux
@@ -15,15 +15,12 @@
[control
["." try (#+ Try)]]
[data
- ["." name]
[number
["n" nat]]
- [text
- ["%" format (#+ format)]]
[collection
["." list]]]
[math
- ["r" random]]
+ ["." random]]
[type (#+ :share)]]
{1
["." / (#+ Region)
@@ -75,107 +72,111 @@
(def: #export test
Test
- (<| (_.context (name.module (name-of /._)))
- (do {@ r.monad}
- [expected-clean-ups (|> r.nat (:: @ map (|>> (n.% 100) (n.max 1))))]
+ (<| (_.covering /._)
+ (_.with-cover [/.Region])
+ (do {@ random.monad}
+ [expected-clean-ups (|> random.nat (:: @ map (|>> (n.% 100) (n.max 1))))]
($_ _.and
- ($functor.spec ..injection ..comparison (: (All [! r]
- (Functor (Region r (thread.Thread !))))
- (/.functor thread.functor)))
- ($apply.spec ..injection ..comparison (: (All [! r]
- (Apply (Region r (thread.Thread !))))
- (/.apply thread.monad)))
- ($monad.spec ..injection ..comparison (: (All [! r]
- (Monad (Region r (thread.Thread !))))
- (/.monad thread.monad)))
+ (_.with-cover [/.functor]
+ ($functor.spec ..injection ..comparison (: (All [! r]
+ (Functor (Region r (thread.Thread !))))
+ (/.functor thread.functor))))
+ (_.with-cover [/.apply]
+ ($apply.spec ..injection ..comparison (: (All [! r]
+ (Apply (Region r (thread.Thread !))))
+ (/.apply thread.monad))))
+ (_.with-cover [/.monad]
+ ($monad.spec ..injection ..comparison (: (All [! r]
+ (Monad (Region r (thread.Thread !))))
+ (/.monad thread.monad))))
- (_.test (%.name (name-of /.run))
- (thread.run
- (do {@ thread.monad}
- [clean-up-counter (thread.box 0)
- #let [//@ @
- count-clean-up (function (_ value)
- (do @
- [_ (thread.update inc clean-up-counter)]
- (wrap (#try.Success []))))]
- outcome (/.run @
- (do {@ (/.monad @)}
- [_ (monad.map @ (/.acquire //@ count-clean-up)
- (enum.range n.enum 1 expected-clean-ups))]
- (wrap [])))
- actual-clean-ups (thread.read clean-up-counter)]
- (wrap (and (success? outcome)
- (n.= expected-clean-ups
- actual-clean-ups))))))
- (_.test (%.name (name-of /.fail))
- (thread.run
- (do {@ thread.monad}
- [clean-up-counter (thread.box 0)
- #let [//@ @
- count-clean-up (function (_ value)
- (do @
- [_ (thread.update inc clean-up-counter)]
- (wrap (#try.Success []))))]
- outcome (/.run @
- (do {@ (/.monad @)}
- [_ (monad.map @ (/.acquire //@ count-clean-up)
- (enum.range n.enum 1 expected-clean-ups))
- _ (/.fail //@ (exception.construct ..oops []))]
- (wrap [])))
- actual-clean-ups (thread.read clean-up-counter)]
- (wrap (and (failure? outcome)
- (n.= expected-clean-ups
- actual-clean-ups))))))
- (_.test (%.name (name-of /.throw))
- (thread.run
- (do {@ thread.monad}
- [clean-up-counter (thread.box 0)
- #let [//@ @
- count-clean-up (function (_ value)
- (do @
- [_ (thread.update inc clean-up-counter)]
- (wrap (#try.Success []))))]
- outcome (/.run @
- (do {@ (/.monad @)}
- [_ (monad.map @ (/.acquire //@ count-clean-up)
- (enum.range n.enum 1 expected-clean-ups))
- _ (/.throw //@ ..oops [])]
- (wrap [])))
- actual-clean-ups (thread.read clean-up-counter)]
- (wrap (and (failure? outcome)
- (n.= expected-clean-ups
- actual-clean-ups))))))
- (_.test (%.name (name-of /.acquire))
- (thread.run
- (do {@ thread.monad}
- [clean-up-counter (thread.box 0)
- #let [//@ @
- count-clean-up (function (_ value)
- (do @
- [_ (thread.update inc clean-up-counter)]
- (wrap (: (Try Any)
- (exception.throw ..oops [])))))]
- outcome (/.run @
- (do {@ (/.monad @)}
- [_ (monad.map @ (/.acquire //@ count-clean-up)
- (enum.range n.enum 1 expected-clean-ups))]
- (wrap [])))
- actual-clean-ups (thread.read clean-up-counter)]
- (wrap (and (or (n.= 0 expected-clean-ups)
- (failure? outcome))
- (n.= expected-clean-ups
- actual-clean-ups))))))
- (_.test (%.name (name-of /.lift))
- (thread.run
- (do {@ thread.monad}
- [clean-up-counter (thread.box 0)
- #let [//@ @]
- outcome (/.run @
- (do (/.monad @)
- [_ (/.lift //@ (thread.write expected-clean-ups clean-up-counter))]
- (wrap [])))
- actual-clean-ups (thread.read clean-up-counter)]
- (wrap (and (success? outcome)
- (n.= expected-clean-ups
- actual-clean-ups))))))
+ (_.cover [/.run]
+ (thread.run
+ (do {@ thread.monad}
+ [clean-up-counter (thread.box 0)
+ #let [//@ @
+ count-clean-up (function (_ value)
+ (do @
+ [_ (thread.update inc clean-up-counter)]
+ (wrap (#try.Success []))))]
+ outcome (/.run @
+ (do {@ (/.monad @)}
+ [_ (monad.map @ (/.acquire //@ count-clean-up)
+ (enum.range n.enum 1 expected-clean-ups))]
+ (wrap [])))
+ actual-clean-ups (thread.read clean-up-counter)]
+ (wrap (and (success? outcome)
+ (n.= expected-clean-ups
+ actual-clean-ups))))))
+ (_.cover [/.fail]
+ (thread.run
+ (do {@ thread.monad}
+ [clean-up-counter (thread.box 0)
+ #let [//@ @
+ count-clean-up (function (_ value)
+ (do @
+ [_ (thread.update inc clean-up-counter)]
+ (wrap (#try.Success []))))]
+ outcome (/.run @
+ (do {@ (/.monad @)}
+ [_ (monad.map @ (/.acquire //@ count-clean-up)
+ (enum.range n.enum 1 expected-clean-ups))
+ _ (/.fail //@ (exception.construct ..oops []))]
+ (wrap [])))
+ actual-clean-ups (thread.read clean-up-counter)]
+ (wrap (and (failure? outcome)
+ (n.= expected-clean-ups
+ actual-clean-ups))))))
+ (_.cover [/.throw]
+ (thread.run
+ (do {@ thread.monad}
+ [clean-up-counter (thread.box 0)
+ #let [//@ @
+ count-clean-up (function (_ value)
+ (do @
+ [_ (thread.update inc clean-up-counter)]
+ (wrap (#try.Success []))))]
+ outcome (/.run @
+ (do {@ (/.monad @)}
+ [_ (monad.map @ (/.acquire //@ count-clean-up)
+ (enum.range n.enum 1 expected-clean-ups))
+ _ (/.throw //@ ..oops [])]
+ (wrap [])))
+ actual-clean-ups (thread.read clean-up-counter)]
+ (wrap (and (failure? outcome)
+ (n.= expected-clean-ups
+ actual-clean-ups))))))
+ (_.cover [/.acquire]
+ (thread.run
+ (do {@ thread.monad}
+ [clean-up-counter (thread.box 0)
+ #let [//@ @
+ count-clean-up (function (_ value)
+ (do @
+ [_ (thread.update inc clean-up-counter)]
+ (wrap (: (Try Any)
+ (exception.throw ..oops [])))))]
+ outcome (/.run @
+ (do {@ (/.monad @)}
+ [_ (monad.map @ (/.acquire //@ count-clean-up)
+ (enum.range n.enum 1 expected-clean-ups))]
+ (wrap [])))
+ actual-clean-ups (thread.read clean-up-counter)]
+ (wrap (and (or (n.= 0 expected-clean-ups)
+ (failure? outcome))
+ (n.= expected-clean-ups
+ actual-clean-ups))))))
+ (_.cover [/.lift]
+ (thread.run
+ (do {@ thread.monad}
+ [clean-up-counter (thread.box 0)
+ #let [//@ @]
+ outcome (/.run @
+ (do (/.monad @)
+ [_ (/.lift //@ (thread.write expected-clean-ups clean-up-counter))]
+ (wrap [])))
+ actual-clean-ups (thread.read clean-up-counter)]
+ (wrap (and (success? outcome)
+ (n.= expected-clean-ups
+ actual-clean-ups))))))
))))
diff --git a/stdlib/source/test/lux/control/security/policy.lux b/stdlib/source/test/lux/control/security/policy.lux
index d193cc159..4a4f8409a 100644
--- a/stdlib/source/test/lux/control/security/policy.lux
+++ b/stdlib/source/test/lux/control/security/policy.lux
@@ -14,12 +14,11 @@
[security
["!" capability]]]
[data
- ["." name]
["." text ("#@." equivalence)]
[number
["n" nat]]]
[math
- ["r" random]]]
+ ["." random]]]
{1
["." / (#+ Context Privacy Can-Conceal Can-Reveal Privilege Private with-policy)]})
@@ -71,22 +70,31 @@
(def: #export test
Test
- (<| (_.context (name.module (name-of /._)))
- (do r.monad
+ (<| (_.covering /._)
+ (_.with-cover [/.Policy
+ /.Can-Upgrade /.Can-Downgrade
+ /.can-upgrade /.can-downgrade])
+ (do random.monad
[#let [policy-0 (policy [])]
- raw-password (r.ascii 10)
+ raw-password (random.ascii 10)
#let [password (:: policy-0 password raw-password)]]
($_ _.and
- ($functor.spec (..injection (:: policy-0 can-upgrade)) (..comparison (:: policy-0 can-downgrade)) /.functor)
- ($apply.spec (..injection (:: policy-0 can-upgrade)) (..comparison (:: policy-0 can-downgrade)) /.apply)
- ($monad.spec (..injection (:: policy-0 can-upgrade)) (..comparison (:: policy-0 can-downgrade)) /.monad)
+ (_.with-cover [/.Privacy /.Private
+ /.Can-Conceal /.Can-Reveal]
+ ($_ _.and
+ (_.with-cover [/.functor]
+ ($functor.spec (..injection (:: policy-0 can-upgrade)) (..comparison (:: policy-0 can-downgrade)) /.functor))
+ (_.with-cover [/.apply]
+ ($apply.spec (..injection (:: policy-0 can-upgrade)) (..comparison (:: policy-0 can-downgrade)) /.apply))
+ (_.with-cover [/.monad]
+ ($monad.spec (..injection (:: policy-0 can-upgrade)) (..comparison (:: policy-0 can-downgrade)) /.monad))))
- (_.test "Can work with private values under the same label."
- (and (:: policy-0 = password password)
- (n.= (:: text.hash hash raw-password)
- (:: policy-0 hash password))))
+ (_.cover [/.Privilege /.Context /.with-policy]
+ (and (:: policy-0 = password password)
+ (n.= (:: text.hash hash raw-password)
+ (:: policy-0 hash password))))
(let [policy-1 (policy [])
delegate (/.delegation (:: policy-0 can-downgrade) (:: policy-1 can-upgrade))]
- (_.test "Can use delegation to share private values between policies."
- (:: policy-1 = (delegate password) (delegate password))))
+ (_.cover [/.Delegation /.delegation]
+ (:: policy-1 = (delegate password) (delegate password))))
))))
diff --git a/stdlib/source/test/lux/locale/language.lux b/stdlib/source/test/lux/locale/language.lux
new file mode 100644
index 000000000..1bb81e06a
--- /dev/null
+++ b/stdlib/source/test/lux/locale/language.lux
@@ -0,0 +1,266 @@
+(.module:
+ [lux #*
+ ["_" test (#+ Test)]
+ [abstract
+ [monad (#+ do)]
+ [hash (#+ Hash)]]
+ [data
+ ["." text]
+ [number
+ ["n" nat]]
+ [collection
+ ["." set (#+ Set)]
+ ["." list ("#@." functor fold)]]]
+ [macro
+ ["." template]]
+ [math
+ ["." random]]]
+ {1
+ ["." /]})
+
+(type: Bundle
+ {#count Nat
+ #names (Set Text)
+ #codes (Set Text)
+ #languages (Set /.Language)
+ #test Test})
+
+(template [<bundle> <languages>]
+ [(def: <bundle>
+ Bundle
+ (let [count (template.count <languages>)
+ languages (: (List /.Language)
+ (`` (list (~~ (template.splice <languages>)))))]
+ {#count count
+ #names (|> languages (list@map /.name) (set.from-list text.hash))
+ #codes (|> languages (list@map /.code) (set.from-list text.hash))
+ #languages (|> languages (set.from-list /.hash))
+ #test (_.cover <languages>
+ true)}))]
+
+ [languages/a [/.afar /.abkhazian /.achinese /.acoli /.adangme
+ /.adyghe /.afro-asiatic /.afrihili /.afrikaans /.ainu
+ /.akan /.akkadian /.aleut /.algonquian /.southern-altai
+ /.amharic /.old-english /.angika /.apache /.arabic
+ /.official-aramaic /.aragonese /.mapudungun /.arapaho /.artificial
+ /.arawak /.assamese /.asturian /.athapascan /.australian
+ /.avaric /.avestan /.awadhi /.aymara /.azerbaijani]]
+ [languages/b [/.banda /.bamileke /.bashkir /.baluchi /.bambara
+ /.balinese /.basa /.baltic /.beja /.belarusian
+ /.bemba /.bengali /.berber /.bhojpuri /.bihari
+ /.bikol /.bini /.bislama /.siksika /.bantu
+ /.tibetan /.bosnian /.braj /.breton /.batak
+ /.buriat /.buginese /.bulgarian /.blin]]
+ [languages/c [/.caddo /.central-american-indian /.galibi-carib /.catalan /.caucasian
+ /.cebuano /.celtic /.czech /.chamorro /.chibcha
+ /.chechen /.chagatai /.chuukese /.mari /.chinook
+ /.choctaw /.chipewyan /.cherokee /.church-slavic /.chuvash
+ /.cheyenne /.chamic /.montenegrin /.coptic /.cornish
+ /.corsican /.creoles-and-pidgins/english /.creoles-and-pidgins/french /.creoles-and-pidgins/portuguese /.cree
+ /.crimean /.creoles-and-pidgins /.kashubian /.cushitic /.welsh]]
+ [languages/d [/.dakota /.danish /.dargwa /.land-dayak /.delaware
+ /.slavey /.dogrib /.dinka /.dhivehi /.dogri
+ /.dravidian /.lower-sorbian /.duala /.middle-dutch /.dyula
+ /.dzongkha]]
+ [languages/e [/.efik /.egyptian /.ekajuk /.greek /.elamite
+ /.english /.middle-english /.esperanto /.estonian /.basque
+ /.ewe /.ewondo]]
+ [languages/f [/.fang /.faroese /.persian /.fanti /.fijian
+ /.filipino /.finnish /.finno-ugrian /.fon /.french
+ /.middle-french /.old-french /.northern-frisian /.eastern-frisian /.western-frisian
+ /.fulah /.friulian]]
+ [languages/g [/.ga /.gayo /.gbaya /.germanic /.german
+ /.geez /.gilbertese /.gaelic /.irish /.galician
+ /.manx /.middle-high-german /.old-high-german /.gondi /.gorontalo
+ /.gothic /.grebo /.ancient-greek /.guarani /.swiss-german
+ /.gujarati /.gwich'in]]
+ [languages/h [/.haida /.haitian /.hausa /.hawaiian /.hebrew
+ /.herero /.hiligaynon /.himachali /.hindi /.hittite
+ /.hmong /.hiri-motu /.croatian /.upper-sorbian /.hungarian
+ /.hupa /.armenian]]
+ [languages/i [/.iban /.igbo /.ido /.sichuan-yi /.ijo
+ /.inuktitut /.interlingue /.iloko /.interlingua /.indic
+ /.indonesian /.indo-european /.ingush /.inupiaq /.iranian
+ /.iroquoian /.icelandic /.italian]]
+ [languages/j [/.javanese /.lojban /.japanese /.judeo-persian /.judeo-arabic]]
+ [languages/k [/.kara-kalpak /.kabyle /.kachin /.kalaallisut /.kamba
+ /.kannada /.karen /.kashmiri /.georgian /.kanuri
+ /.kawi /.kazakh /.kabardian /.khasi /.khoisan
+ /.central-khmer /.khotanese /.gikuyu /.kinyarwanda /.kyrgyz
+ /.kimbundu /.konkani /.komi /.kongo /.korean
+ /.kosraean /.kpelle /.karachay-balkar /.karelian /.kru
+ /.kurukh /.kwanyama /.kumyk /.kurdish /.kutenai]]
+ [languages/l [/.ladino /.lahnda /.lamba /.lao /.latin
+ /.latvian /.lezghian /.limburgan /.lingala /.lithuanian
+ /.mongo /.lozi /.luxembourgish /.luba-lulua /.luba-katanga
+ /.ganda /.luiseno /.lunda /.luo /.lushai]]
+ [languages/m [/.madurese /.magahi /.marshallese /.maithili /.makasar
+ /.malayalam /.mandingo /.austronesian /.marathi /.masai
+ /.moksha /.mandar /.mende /.middle-irish /.mi'kmaq
+ /.minangkabau /.macedonian /.mon-khmer /.malagasy /.maltese
+ /.manchu /.manipuri /.manobo /.mohawk /.mongolian
+ /.mossi /.maori /.malay /.munda /.creek
+ /.mirandese /.marwari /.burmese /.mayan /.erzya]]
+ [languages/n [/.nahuatl /.north-american-indian /.neapolitan /.nauru /.navajo
+ /.south-ndebele /.north-ndebele /.ndonga /.low-german /.nepali
+ /.newari /.nias /.niger-kordofanian /.niuean /.dutch
+ /.nynorsk /.bokmal /.nogai /.old-norse /.norwegian
+ /.n'ko /.northern-sotho /.nubian /.old-newari /.nyanja
+ /.nyamwezi /.nyankole /.nyoro /.nzima]]
+ [languages/o [/.occitan /.ojibwa /.oriya /.oromo /.osage
+ /.ossetic /.ottoman-turkish /.otomian]]
+ [languages/p [/.papuan /.pangasinan /.pahlavi /.pampanga /.punjabi
+ /.papiamento /.palauan /.old-persian /.philippine /.phoenician
+ /.pali /.polish /.pohnpeian /.portuguese /.prakrit
+ /.old-provencal /.pashto]]
+ [languages/q [/.quechua]]
+ [languages/r [/.rajasthani /.rapanui /.rarotongan /.romance /.romansh
+ /.romany /.romanian /.rundi /.aromanian /.russian]]
+ [languages/s [/.sandawe /.sango /.yakut /.south-american-indian /.salishan
+ /.samaritan-aramaic /.sanskrit /.sasak /.santali /.sicilian
+ /.scots /.selkup /.semitic /.old-irish /.sign
+ /.shan /.sidamo /.sinhalese /.siouan /.sino-tibetan
+ /.slavic /.slovak /.slovenian /.southern-sami /.northern-sami
+ /.sami /.lule /.inari /.samoan /.skolt-sami
+ /.shona /.sindhi /.soninke /.sogdian /.somali
+ /.songhai /.southern-sotho /.spanish /.albanian /.sardinian
+ /.sranan-tongo /.serbian /.serer /.nilo-saharan /.swati
+ /.sukuma /.sundanese /.susu /.sumerian /.swahili
+ /.swedish /.classical-syriac /.syriac]]
+ [languages/t [/.tahitian /.tai /.tamil /.tatar /.telugu
+ /.timne /.tereno /.tetum /.tajik /.tagalog
+ /.thai /.tigre /.tigrinya /.tiv /.tokelau
+ /.klingon /.tlingit /.tamashek /.tonga /.tongan
+ /.tok-pisin /.tsimshian /.tswana /.tsonga /.turkmen
+ /.tumbuka /.tupi /.turkish /.altaic /.tuvalu
+ /.twi /.tuvinian]]
+ [languages/u [/.udmurt /.ugaritic /.uyghur /.ukrainian /.umbundu
+ /.urdu /.uzbek]]
+ [languages/v [/.vai /.venda /.vietnamese /.volapük /.votic]]
+ [languages/w [/.wakashan /.walamo /.waray /.washo /.sorbian
+ /.walloon /.wolof]]
+ [languages/x [/.kalmyk /.xhosa]]
+ [languages/y [/.yao /.yapese /.yiddish /.yoruba /.yupik]]
+ [languages/z [/.zapotec /.blissymbols /.zenaga /.standard-moroccan-tamazight /.zhuang
+ /.chinese /.zande /.zulu /.zuni /.zaza]]
+ [languages/etc [/.uncoded /.multiple /.undetermined /.not-applicable]]
+ )
+
+(def: languages
+ (List Bundle)
+ (list ..languages/a
+ ..languages/b
+ ..languages/c
+ ..languages/d
+ ..languages/e
+ ..languages/f
+ ..languages/g
+ ..languages/h
+ ..languages/i
+ ..languages/j
+ ..languages/k
+ ..languages/l
+ ..languages/m
+ ..languages/n
+ ..languages/o
+ ..languages/p
+ ..languages/q
+ ..languages/r
+ ..languages/s
+ ..languages/t
+ ..languages/u
+ ..languages/v
+ ..languages/w
+ ..languages/x
+ ..languages/y
+ ..languages/z
+ ..languages/etc))
+
+(def: (aggregate lens hash territories)
+ (All [a] (-> (-> Bundle (Set a))
+ (Hash a)
+ (List Bundle)
+ [Nat (Set a)]))
+ (list@fold (function (_ bundle [count set])
+ [(n.+ count (get@ #count bundle))
+ (set.union set (lens bundle))])
+ [0 (set.new hash)]
+ territories))
+
+(def: languages-test
+ Test
+ (|> ..languages
+ list.reverse
+ (list@map (get@ #test))
+ (list@fold _.and
+ (`` ($_ _.and
+ (~~ (template [<lens> <tag> <hash>]
+ [(let [[count set] (..aggregate (get@ <tag>) <hash> ..languages)]
+ (_.cover [<lens>]
+ (n.= count (set.size set))))]
+
+ [/.name #names text.hash]
+ [/.code #codes text.hash]
+ [/.equivalence #languages /.hash]
+ ))
+ )))))
+
+(template: (!aliases <reference> <aliases>)
+ (_.cover <aliases>
+ (list.every? (:: /.equivalence = <reference>)
+ (`` (list (~~ (template.splice <aliases>)))))))
+
+(def: aliases-test
+ Test
+ ($_ _.and
+ ## A
+ (!aliases /.official-aramaic [/.imperial-aramaic])
+ (!aliases /.asturian [/.bable /.leonese /.asturleonese])
+ ## B
+ (!aliases /.bini [/.edo])
+ (!aliases /.blin [/.bilin])
+ ## C
+ (!aliases /.catalan [/.valencian])
+ (!aliases /.church-slavic [/.old-slavonic /.church-slavonic /.old-bulgarian /.old-church-slavonic])
+ ## D
+ (!aliases /.dhivehi [/.maldivian])
+ ## G
+ (!aliases /.swiss-german [/.alemannic /.alsatian])
+ ## I
+ (!aliases /.sichuan-yi [/.nuosu])
+ ## K
+ (!aliases /.kachin [/.jingpho])
+ (!aliases /.kalaallisut [/.greenlandic])
+ (!aliases /.khotanese [/.sakan])
+ ## M
+ (!aliases /.mi'kmaq [/.micmac])
+ ## N
+ (!aliases /.newari [/.nepal-bhasa])
+ (!aliases /.dutch [/.flemish])
+ (!aliases /.northern-sotho [/.pedi /.sepedi])
+ (!aliases /.old-newari [/.classical-newari /.classical-nepal-bhasa])
+ (!aliases /.nyanja [/.chichewa /.chewa])
+ ## O
+ (!aliases /.occitan [/.provencal])
+ ## P
+ (!aliases /.pampanga [/.kapampangan])
+ ## R
+ (!aliases /.rarotongan [/.cook-islands-maori])
+ (!aliases /.romanian [/.moldavian /.moldovan])
+ (!aliases /.aromanian [/.arumanian /.macedo-romanian])
+ ## S
+ (!aliases /.spanish [/.castilian])
+ ## X
+ (!aliases /.kalmyk [/.oirat])
+ ## Z
+ (!aliases /.zaza [/.dimili /.dimli /.kirdki /.kirmanjki /.zazaki])
+ ))
+
+(def: #export test
+ Test
+ (<| (_.covering /._)
+ (_.with-cover [/.Language])
+ ($_ _.and
+ ..languages-test
+ ..aliases-test
+ )))
diff --git a/stdlib/source/test/lux/target/jvm.lux b/stdlib/source/test/lux/target/jvm.lux
index 18366de69..437621fb4 100644
--- a/stdlib/source/test/lux/target/jvm.lux
+++ b/stdlib/source/test/lux/target/jvm.lux
@@ -693,19 +693,17 @@
_ instruction
_ /.i2l]
..$Long::wrap)))))
+ ## https://docs.oracle.com/javase/specs/jvms/se7/html/jvms-6.html#jvms-6.5.dcmp_op
+ comparison-standard (: (-> java/lang/Double java/lang/Double Bit)
+ (function (_ reference subject)
+ (for {@.old
+ ("jvm dgt" subject reference)
+
+ @.jvm
+ ("jvm double <" ("jvm object cast" subject) ("jvm object cast" reference))})))
comparison ($_ _.and
- (_.lift "DCMPL" (comparison /.dcmpl (function (_ reference subject)
- (for {@.old
- ("jvm dlt" subject reference)
-
- @.jvm
- ("jvm double <" ("jvm object cast" reference) ("jvm object cast" subject))}))))
- (_.lift "DCMPG" (comparison /.dcmpg (function (_ reference subject)
- (for {@.old
- ("jvm dgt" subject reference)
-
- @.jvm
- ("jvm double <" ("jvm object cast" subject) ("jvm object cast" reference))})))))]
+ (_.lift "DCMPL" (comparison /.dcmpl comparison-standard))
+ (_.lift "DCMPG" (comparison /.dcmpg comparison-standard)))]
($_ _.and
(<| (_.context "literal")
literal)
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-26 20:39:35 +0000