From ddcc768d9d2e798814989037a286df9951840bcd Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Wed, 12 Aug 2020 01:01:30 -0400 Subject: WIP: New build-tool named Aedifex (can read project descriptions). --- stdlib/source/test/lux/control/exception.lux | 163 ++++---- stdlib/source/test/lux/control/function.lux | 45 ++- stdlib/source/test/lux/control/io.lux | 37 +- stdlib/source/test/lux/control/parser.lux | 431 +++++++++++---------- stdlib/source/test/lux/control/pipe.lux | 177 +++++---- stdlib/source/test/lux/control/reader.lux | 55 +-- stdlib/source/test/lux/control/region.lux | 211 +++++----- stdlib/source/test/lux/control/security/policy.lux | 36 +- stdlib/source/test/lux/locale/language.lux | 266 +++++++++++++ stdlib/source/test/lux/target/jvm.lux | 22 +- 10 files changed, 862 insertions(+), 581 deletions(-) create mode 100644 stdlib/source/test/lux/locale/language.lux (limited to 'stdlib/source/test') 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 [ ] + [(def: + Bundle + (let [count (template.count ) + languages (: (List /.Language) + (`` (list (~~ (template.splice )))))] + {#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 + 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 [ ] + [(let [[count set] (..aggregate (get@ ) ..languages)] + (_.cover [] + (n.= count (set.size set))))] + + [/.name #names text.hash] + [/.code #codes text.hash] + [/.equivalence #languages /.hash] + )) + ))))) + +(template: (!aliases ) + (_.cover + (list.every? (:: /.equivalence = ) + (`` (list (~~ (template.splice ))))))) + +(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) -- cgit v1.2.3