diff options
Diffstat (limited to '')
| -rw-r--r-- | stdlib/source/test/aedifex/command/auto.lux | 17 | ||||
| -rw-r--r-- | stdlib/source/test/aedifex/command/build.lux | 32 | ||||
| -rw-r--r-- | stdlib/source/test/aedifex/command/test.lux | 13 | ||||
| -rw-r--r-- | stdlib/source/test/lux/data/number/frac.lux | 2 | ||||
| -rw-r--r-- | stdlib/source/test/lux/data/number/i64.lux | 11 | ||||
| -rw-r--r-- | stdlib/source/test/lux/data/number/rev.lux | 157 |
6 files changed, 162 insertions, 70 deletions
diff --git a/stdlib/source/test/aedifex/command/auto.lux b/stdlib/source/test/aedifex/command/auto.lux index e8f6d17f1..48b2a7eb3 100644 --- a/stdlib/source/test/aedifex/command/auto.lux +++ b/stdlib/source/test/aedifex/command/auto.lux @@ -26,6 +26,7 @@ [world [console (#+ Console)] ["." shell (#+ Shell)] + ["." program (#+ Program)] ["." file (#+ Path) ["." watch]]]] ["." // #_ @@ -49,11 +50,11 @@ (def: (command end-signal dummy-files) (-> Text (List Path) [(Atom [Nat (List Path)]) - (-> (Console Promise) Environment (file.System Promise) (Shell Promise) Resolution (Command Any))]) + (-> (Console Promise) (Program Promise) (file.System Promise) (Shell Promise) Resolution (Command Any))]) (let [@runs (: (Atom [Nat (List Path)]) (atom.atom [0 dummy-files]))] [@runs - (function (_ console environment fs shell resolution profile) + (function (_ console program fs shell resolution profile) (do {! promise.monad} [[runs remaining-files] (promise.future (atom.update (function (_ [runs remaining-files]) @@ -95,9 +96,7 @@ profile (|> empty-profile with-program with-target - (set@ #///.sources (set.from-list text.hash (list source)))) - - environment (dictionary.put "user.dir" working-directory environment.empty)] + (set@ #///.sources (set.from-list text.hash (list source))))] resolution @build.resolution] ($_ _.and (wrap (do promise.monad @@ -106,7 +105,13 @@ _ (!.use (\ fs create-directory) [source]) _ (\ watcher poll [])] (do promise.monad - [outcome ((/.do! watcher command) (@version.echo "") environment fs (@build.good-shell []) resolution profile) + [outcome ((/.do! watcher command) + (@version.echo "") + (program.async (program.mock environment.empty working-directory)) + fs + (@build.good-shell []) + resolution + profile) [actual-runs _] (promise.future (atom.read @runs))] (wrap (#try.Success (and (n.= expected-runs actual-runs) (case outcome diff --git a/stdlib/source/test/aedifex/command/build.lux b/stdlib/source/test/aedifex/command/build.lux index 6a911e928..74508ef3d 100644 --- a/stdlib/source/test/aedifex/command/build.lux +++ b/stdlib/source/test/aedifex/command/build.lux @@ -20,7 +20,8 @@ ["." random]] [world ["." file] - ["." shell (#+ Shell)]]] + ["." shell (#+ Shell)] + ["." program]]] ["." // #_ ["@." version] ["$/#" // #_ @@ -110,27 +111,10 @@ profile (|> empty-profile with-program - with-target) - - no-working-directory environment.empty - - environment (dictionary.put "user.dir" working-directory environment.empty)]] + with-target)]] ($_ _.and - (_.cover [/.working-directory] - (and (case (/.working-directory no-working-directory) - (#try.Success _) - false - - (#try.Failure error) - true) - (case (/.working-directory environment) - (#try.Success _) - true - - (#try.Failure error) - false))) (wrap (do promise.monad - [outcome (/.do! (@version.echo "") environment fs shell ///dependency/resolution.empty + [outcome (/.do! (@version.echo "") (program.async (program.mock environment.empty working-directory)) fs shell ///dependency/resolution.empty (with-target empty-profile))] (_.cover' [/.no-specified-program] (case outcome @@ -140,7 +124,7 @@ (#try.Failure error) (exception.match? /.no-specified-program error))))) (wrap (do promise.monad - [outcome (/.do! (@version.echo "") environment fs shell ///dependency/resolution.empty + [outcome (/.do! (@version.echo "") (program.async (program.mock environment.empty working-directory)) fs shell ///dependency/resolution.empty (with-program empty-profile))] (_.cover' [/.no-specified-target] (case outcome @@ -150,7 +134,7 @@ (#try.Failure error) (exception.match? /.no-specified-target error))))) (wrap (do promise.monad - [outcome (/.do! (@version.echo "") environment fs shell ///dependency/resolution.empty profile)] + [outcome (/.do! (@version.echo "") (program.async (program.mock environment.empty working-directory)) fs shell ///dependency/resolution.empty profile)] (_.cover' [/.Compiler /.no-available-compiler] (case outcome (#try.Success _) @@ -163,7 +147,7 @@ resolution ..resolution] (wrap (do promise.monad [verdict (do ///action.monad - [_ (/.do! console environment fs shell resolution profile) + [_ (/.do! console (program.async (program.mock environment.empty working-directory)) fs shell resolution profile) start (!.use (\ console read-line) []) end (!.use (\ console read-line) [])] (wrap (and (text\= /.start start) @@ -177,7 +161,7 @@ resolution ..resolution] (wrap (do promise.monad [verdict (do ///action.monad - [_ (/.do! console environment fs (..bad-shell []) resolution profile) + [_ (/.do! console (program.async (program.mock environment.empty working-directory)) fs (..bad-shell []) resolution profile) start (!.use (\ console read-line) []) end (!.use (\ console read-line) [])] (wrap (and (text\= /.start start) diff --git a/stdlib/source/test/aedifex/command/test.lux b/stdlib/source/test/aedifex/command/test.lux index 43c70d8ba..f87e70e85 100644 --- a/stdlib/source/test/aedifex/command/test.lux +++ b/stdlib/source/test/aedifex/command/test.lux @@ -19,7 +19,8 @@ ["." random]] [world ["." file] - ["." shell]]] + ["." shell] + ["." program]]] ["." // #_ ["@." version] ["@." build] @@ -53,18 +54,14 @@ profile (|> empty-profile with-program - with-target) - - no-working-directory environment.empty - - environment (dictionary.put "user.dir" working-directory environment.empty)] + with-target)] resolution @build.resolution] ($_ _.and (let [fs (file.mock (\ file.default separator)) console (@version.echo "")] (wrap (do promise.monad [verdict (do ///action.monad - [_ (/.do! console environment fs (@build.good-shell []) resolution profile) + [_ (/.do! console (program.async (program.mock environment.empty working-directory)) fs (@build.good-shell []) resolution profile) build-start (!.use (\ console read-line) []) build-end (!.use (\ console read-line) []) test-start (!.use (\ console read-line) []) @@ -98,7 +95,7 @@ shell.normal shell.error)])))))) [])] - _ (/.do! console environment fs bad-shell resolution profile) + _ (/.do! console (program.async (program.mock environment.empty working-directory)) fs bad-shell resolution profile) build-start (!.use (\ console read-line) []) build-end (!.use (\ console read-line) []) test-start (!.use (\ console read-line) []) diff --git a/stdlib/source/test/lux/data/number/frac.lux b/stdlib/source/test/lux/data/number/frac.lux index aa472c572..f29cf93b1 100644 --- a/stdlib/source/test/lux/data/number/frac.lux +++ b/stdlib/source/test/lux/data/number/frac.lux @@ -84,7 +84,7 @@ (_.cover [/.int] (|> expected i.frac /.int (i.= expected)))) (do {! random.monad} - [expected (\ ! map (|>> (i64.left-shift 32) .rev) + [expected (\ ! map (|>> (i64.left-shift 52) .rev) random.nat)] (_.cover [/.rev] (|> expected r.frac /.rev (r.= expected)))) diff --git a/stdlib/source/test/lux/data/number/i64.lux b/stdlib/source/test/lux/data/number/i64.lux index 49f63d1a9..12b935bef 100644 --- a/stdlib/source/test/lux/data/number/i64.lux +++ b/stdlib/source/test/lux/data/number/i64.lux @@ -3,7 +3,7 @@ ["_" test (#+ Test)] [data ["." bit ("#\." equivalence)] - [number + [number (#+ hex) ["n" nat] ["i" int]]] [abstract @@ -261,6 +261,15 @@ inverse! nullity! futility!))) + (_.cover [/.reverse] + (and (|> pattern /.reverse /.reverse (\= pattern)) + (or (|> pattern /.reverse (\= pattern) not) + (let [high (/.and (hex "FFFFFFFF00000000") + pattern) + low (/.and (hex "00000000FFFFFFFF") + pattern)] + (\= (/.reverse high) + low))))) (_.cover [/.hash] (n.= pattern (\ /.hash hash pattern))) diff --git a/stdlib/source/test/lux/data/number/rev.lux b/stdlib/source/test/lux/data/number/rev.lux index 90a29c6d3..c28f89451 100644 --- a/stdlib/source/test/lux/data/number/rev.lux +++ b/stdlib/source/test/lux/data/number/rev.lux @@ -1,6 +1,5 @@ (.module: [lux #* - ["%" data/text/format (#+ format)] ["_" test (#+ Test)] [abstract [monad (#+ do)] @@ -13,41 +12,49 @@ ["$." monoid] ["$." codec]]}] [data - [number - ["." i64]]] + ["." bit ("#\." equivalence)] + [number (#+ hex) + ["n" nat] + ["f" frac] + ["." i64 ("#\." hash)]]] [math - ["r" random]]] + ["." random]]] {1 - ["." / - //]}) + ["." /]}) -(def: #export test +(def: signature Test - (<| (_.context (%.name (name-of /._))) - (`` ($_ _.and - ($equivalence.spec /.equivalence r.rev) - ($order.spec /.order r.rev) - ($enum.spec /.enum r.rev) - ($interval.spec /.interval r.rev) - (~~ (template [<monoid>] - [(<| (_.context (%.name (name-of <monoid>))) - ($monoid.spec /.equivalence <monoid> r.rev))] + (`` ($_ _.and + (_.for [/.equivalence /.=] + ($equivalence.spec /.equivalence random.rev)) + (_.for [/.order /.<] + ($order.spec /.order random.rev)) + (_.for [/.enum] + ($enum.spec /.enum random.rev)) + (_.for [/.interval] + ($interval.spec /.interval random.rev)) + (~~ (template [<compose> <monoid>] + [(_.for [<monoid> <compose>] + ($monoid.spec /.equivalence <monoid> random.rev))] - [/.addition] [/.minimum] [/.maximum] - )) - (~~ (template [<codec>] - [(<| (_.context (%.name (name-of /.binary))) - ($codec.spec /.equivalence <codec> r.rev))] + [/.+ /.addition] - [/.binary] [/.octal] [/.decimal] [/.hex] - )) - (_.test "Alternate notations." - (and (/.= (bin ".11001001") - (bin ".11,00,10,01")) - (/.= (oct ".615243") - (oct ".615,243")) - (/.= (hex ".deadBEEF") - (hex ".dead,BEEF")))) + [/.min /.minimum] + [/.max /.maximum] + )) + (~~ (template [<codec>] + [(_.for [<codec>] + ($codec.spec /.equivalence <codec> random.rev))] + + [/.binary] [/.octal] [/.decimal] [/.hex] + )) + ))) + +(def: #export test + Test + (<| (_.covering /._) + (_.for [.Rev]) + (`` ($_ _.and (~~ (template [<half> <whole>] [(_.cover [<half>] (/.= <whole> @@ -66,4 +73,94 @@ [/./2048 /./1024] [/./4096 /./2048] )) + (do random.monad + [sample random.rev] + (_.cover [/.-] + (and (/.= .0 (/.- sample sample)) + (/.= sample (/.- .0 sample))))) + (do {! random.monad} + [left random.rev + right random.rev] + (_.cover [/.*] + (and (/.< left (/.* left right)) + (/.< right (/.* left right))))) + (do {! random.monad} + [#let [dividend (\ ! map (i64.and (hex "FF")) + random.rev) + divisor (\ ! map (|>> (i64.and (hex "F")) + (i64.or (hex "1")) + (i64.rotate-right 8) + .rev) + random.nat)] + dividend dividend + divisor/0 divisor + divisor/1 (random.filter (|>> (/.= divisor/0) not) + divisor) + scale (\ ! map (|>> (n.% 10) inc) + random.nat)] + ($_ _.and + (_.cover [/./] + (bit\= (/.< divisor/0 divisor/1) + (/.> (/./ divisor/0 dividend) (/./ divisor/1 dividend)))) + (_.cover [/.%] + (\ i64.equivalence = + (.i64 (n.% (.nat divisor/0) (.nat dividend))) + (.i64 (/.% divisor/0 dividend)))) + (_.cover [/.up /.down] + (let [symmetry! + (|> dividend + (/.up scale) + (/.down scale) + (/.= dividend)) + + discrete-division! + (/.= (/.% (.rev scale) dividend) + (/.- (|> dividend + (/.down scale) + (/.up scale)) + dividend))] + (and symmetry! + discrete-division!))) + (_.cover [/.ratio] + (|> dividend + (/.up scale) + (/.ratio dividend) + (n.= scale))) + )) + (do {! random.monad} + [dividend random.rev + divisor (random.filter (|>> (/.= .0) not) + random.rev)] + (_.cover [/./%] + (let [[quotient remainder] (/./% divisor dividend)] + (and (/.= (/./ divisor dividend) quotient) + (/.= (/.% divisor dividend) remainder))))) + (do random.monad + [left random.rev + right random.rev] + ($_ _.and + (_.cover [/.>] + (bit\= (/.> left right) + (/.< right left))) + (_.cover [/.<= /.>=] + (bit\= (/.<= left right) + (/.>= right left))) + )) + (do random.monad + [sample random.nat] + (_.cover [/.reciprocal] + (/.= (/.reciprocal sample) + (|> sample /.reciprocal .nat /.reciprocal .nat /.reciprocal)))) + (do {! random.monad} + [expected (\ ! map (|>> f.abs (f.% +1.0)) + random.safe-frac)] + (_.cover [/.frac] + (|> expected f.rev /.frac (f.= expected)))) + (do random.monad + [sample random.rev] + (_.cover [/.hash] + (i64\= (i64\hash sample) + (\ /.hash hash sample)))) + + ..signature )))) |