aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/test
diff options
context:
space:
mode:
authorEduardo Julian2020-12-02 04:42:03 -0400
committerEduardo Julian2020-12-02 04:42:03 -0400
commit982a19e0c5d57b53f9726b780fec4c18f0787b4f (patch)
tree50bf995dd5f1361c4a6651e2865819693ea25ca5 /stdlib/source/test
parentcfa0a075b89a0df4618e7009f05c157393cbba72 (diff)
Test for Aedifex's "auto" command.
Diffstat (limited to '')
-rw-r--r--stdlib/source/test/aedifex.lux4
-rw-r--r--stdlib/source/test/aedifex/command/auto.lux147
-rw-r--r--stdlib/source/test/lux/data/collection/set.lux30
-rw-r--r--stdlib/source/test/lux/data/number.lux27
-rw-r--r--stdlib/source/test/lux/data/number/frac.lux196
-rw-r--r--stdlib/source/test/lux/type/check.lux49
-rw-r--r--stdlib/source/test/lux/world/file/watch.lux53
7 files changed, 397 insertions, 109 deletions
diff --git a/stdlib/source/test/aedifex.lux b/stdlib/source/test/aedifex.lux
index 71d9a29bb..02d2b8ed2 100644
--- a/stdlib/source/test/aedifex.lux
+++ b/stdlib/source/test/aedifex.lux
@@ -15,7 +15,8 @@
["#/." deploy]
["#/." deps]
["#/." build]
- ["#/." test]]
+ ["#/." test]
+ ["#/." auto]]
["#." local]
["#." cache]
["#." dependency
@@ -42,6 +43,7 @@
/command/deps.test
/command/build.test
/command/test.test
+ /command/auto.test
/local.test
/cache.test
/dependency.test
diff --git a/stdlib/source/test/aedifex/command/auto.lux b/stdlib/source/test/aedifex/command/auto.lux
new file mode 100644
index 000000000..13039d9d3
--- /dev/null
+++ b/stdlib/source/test/aedifex/command/auto.lux
@@ -0,0 +1,147 @@
+(.module:
+ [lux #*
+ ["_" test (#+ Test)]
+ [abstract
+ [monad (#+ do)]]
+ [control
+ ["." try]
+ [parser
+ ["." environment]]
+ [concurrency
+ ["." atom (#+ Atom)]
+ ["." promise (#+ Promise)]]
+ [security
+ ["!" capability]]]
+ [data
+ ["." text
+ ["%" format (#+ format)]]
+ [number
+ ["n" nat]]
+ [collection
+ ["." dictionary]
+ ["." set]
+ ["." list ("#\." functor)]]]
+ [math
+ ["." random]]
+ [world
+ [environment (#+ Environment)]
+ ["." shell (#+ Shell)]
+ ["." file (#+ Path)
+ ["." watch]]]]
+ ["$." /// #_
+ ["#." package]]
+ {#program
+ ["." /
+ ["/#" // #_
+ ["#." build]
+ ["/#" // #_
+ [command (#+ Command)]
+ ["#" profile (#+ Profile)]
+ ["#." action]
+ ["#." artifact
+ ["#/." type]]
+ ["#." dependency
+ ["#/." resolution (#+ Resolution)]]]]]})
+
+(def: (command end-signal dummy-files)
+ (-> Text (List Path)
+ [(Atom [Nat (List Path)])
+ (-> Environment (file.System Promise) (Shell Promise) Resolution (Command Any))])
+ (let [@runs (: (Atom [Nat (List Path)])
+ (atom.atom [0 dummy-files]))]
+ [@runs
+ (function (_ environment fs shell resolution profile)
+ (do {! promise.monad}
+ [[runs remaining-files] (promise.future
+ (atom.update (function (_ [runs remaining-files])
+ [(inc runs) remaining-files])
+ @runs))]
+ (case remaining-files
+ #.Nil
+ (wrap (#try.Failure end-signal))
+
+ (#.Cons head tail)
+ (do (try.with !)
+ [_ (!.use (:: fs create-file) [head])]
+ (do !
+ [_ (promise.future (atom.write [runs tail] @runs))]
+ (wrap (#try.Success [])))))))]))
+
+(def: #export test
+ Test
+ (<| (_.covering /._)
+ (do {! random.monad}
+ [#let [/ (:: file.default separator)
+ [fs watcher] (watch.mock /)
+ shell (shell.mock
+ (function (_ [actual-environment actual-working-directory actual-command actual-arguments])
+ (#try.Success
+ (: (shell.Simulation [])
+ (structure
+ (def: (on-read state)
+ (#try.Failure "on-read"))
+ (def: (on-error state)
+ (#try.Failure "on-error"))
+ (def: (on-write input state)
+ (#try.Failure "on-write"))
+ (def: (on-destroy state)
+ (#try.Failure "on-destroy"))
+ (def: (on-await state)
+ (#try.Success [state shell.normal]))))))
+ [])]
+ end-signal (random.ascii/alpha 5)
+ program (random.ascii/alpha 5)
+ target (random.ascii/alpha 5)
+ working-directory (random.ascii/alpha 5)
+ expected-runs (:: ! map (|>> (n.% 10) (n.max 2)) random.nat)
+ source (random.ascii/alpha 5)
+ dummy-files (|> (random.ascii/alpha 5)
+ (random.set text.hash (dec expected-runs))
+ (:: ! map (|>> set.to-list (list\map (|>> (format source /))))))
+ #let [empty-profile (: Profile
+ (:: ///.monoid identity))
+ with-target (: (-> Profile Profile)
+ (set@ #///.target (#.Some target)))
+ with-program (: (-> Profile Profile)
+ (set@ #///.program (#.Some program)))
+
+ 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)]]
+ ($_ _.and
+ (do !
+ [lux-version (random.ascii/alpha 5)
+ [_ compiler-package] $///package.random
+ #let [jvm-compiler {#///dependency.artifact {#///artifact.group //build.lux-group
+ #///artifact.name //build.jvm-compiler-name
+ #///artifact.version lux-version}
+ #///dependency.type ///artifact/type.lux-library}
+ js-compiler {#///dependency.artifact {#///artifact.group //build.lux-group
+ #///artifact.name //build.js-compiler-name
+ #///artifact.version lux-version}
+ #///dependency.type ///artifact/type.lux-library}]
+ compiler-dependency (random.either (wrap jvm-compiler)
+ (wrap js-compiler))
+ #let [[@runs command] (..command end-signal dummy-files)]]
+ (wrap (do promise.monad
+ [verdict (do ///action.monad
+ [_ (!.use (:: fs create-directory) [source])
+ _ (:: watcher poll [])
+ #let [resolution (|> ///dependency/resolution.empty
+ (dictionary.put compiler-dependency compiler-package))]]
+ (do promise.monad
+ [outcome ((/.do! watcher command) environment fs shell resolution profile)
+ [actual-runs _] (promise.future (atom.read @runs))]
+ (wrap (#try.Success (and (n.= expected-runs actual-runs)
+ (case outcome
+ (#try.Failure error)
+ (is? end-signal error)
+
+ (#try.Success _)
+ false))))))]
+ (_.cover' [/.do!]
+ (try.default false verdict)))))
+ ))))
diff --git a/stdlib/source/test/lux/data/collection/set.lux b/stdlib/source/test/lux/data/collection/set.lux
index 3525a5fc8..83cfe60fb 100644
--- a/stdlib/source/test/lux/data/collection/set.lux
+++ b/stdlib/source/test/lux/data/collection/set.lux
@@ -1,8 +1,8 @@
(.module:
[lux #*
- ["%" data/text/format (#+ format)]
["_" test (#+ Test)]
[abstract
+ [hash (#+ Hash)]
[monad (#+ do)]
{[0 #spec]
[/
@@ -17,7 +17,7 @@
[math
["." random (#+ Random)]]]
{1
- ["." /]})
+ ["." / ("\." equivalence)]})
(def: gen-nat
(Random Nat)
@@ -28,8 +28,7 @@
Test
(<| (_.covering /._)
(_.with-cover [/.Set])
- (let [(^open "/\.") /.equivalence])
- (do random.monad
+ (do {! random.monad}
[size ..gen-nat]
($_ _.and
(_.with-cover [/.equivalence]
@@ -37,7 +36,7 @@
(_.with-cover [/.monoid]
($monoid.spec /.equivalence (/.monoid n.hash) (random.set n.hash size random.nat)))
- (do random.monad
+ (do !
[sizeL ..gen-nat
sizeR ..gen-nat
setL (random.set n.hash sizeL random.nat)
@@ -45,13 +44,26 @@
non-memberL (random.filter (|>> (/.member? setL) not)
random.nat)]
($_ _.and
+ (_.cover [/.new]
+ (/.empty? (/.new n.hash)))
+ (do !
+ [hash (:: ! map (function (_ constant)
+ (: (Hash Nat)
+ (structure
+ (def: &equivalence n.equivalence)
+
+ (def: (hash _)
+ constant))))
+ random.nat)]
+ (_.cover [/.member-hash]
+ (is? hash (/.member-hash (/.new hash)))))
(_.cover [/.size]
(n.= sizeL (/.size setL)))
(_.cover [/.empty?]
(bit\= (/.empty? setL)
(n.= 0 (/.size setL))))
(_.cover [/.to-list /.from-list]
- (|> setL /.to-list (/.from-list n.hash) (/\= setL)))
+ (|> setL /.to-list (/.from-list n.hash) (\= setL)))
(_.cover [/.member?]
(and (list.every? (/.member? setL) (/.to-list setL))
(not (/.member? setL non-memberL))))
@@ -72,12 +84,12 @@
(|> setL
(/.add non-memberL)
(/.remove non-memberL)
- (/\= setL))
+ (\= setL))
idempotency!
(|> setL
(/.remove non-memberL)
- (/\= setL))]
+ (\= setL))]
(and symmetry!
idempotency!)))
(_.cover [/.union /.sub?]
@@ -90,7 +102,7 @@
union-with-empty-set!
(|> setL
(/.union (/.new n.hash))
- (/\= setL))]
+ (\= setL))]
(and sets-are-subs-of-their-unions!
union-with-empty-set!)))
(_.cover [/.intersection /.super?]
diff --git a/stdlib/source/test/lux/data/number.lux b/stdlib/source/test/lux/data/number.lux
index d8b0ad3bf..9458bb12c 100644
--- a/stdlib/source/test/lux/data/number.lux
+++ b/stdlib/source/test/lux/data/number.lux
@@ -29,21 +29,6 @@
(-> Text Text)
(text.replace-all "," ""))
-(def: sub
- Test
- ($_ _.and
- /i8.test
- /i16.test
- /i32.test
- /i64.test
- /nat.test
- /int.test
- /rev.test
- /frac.test
- /ratio.test
- /complex.test
- ))
-
(def: #export test
Test
(<| (_.covering /._)
@@ -111,5 +96,15 @@
[f.= f.hex "+dead.BEEF"]
[f.= f.hex "-dead,BE.EF"]
)))))
- ..sub
+
+ /i8.test
+ /i16.test
+ /i32.test
+ /i64.test
+ /nat.test
+ /int.test
+ /rev.test
+ /frac.test
+ /ratio.test
+ /complex.test
)))
diff --git a/stdlib/source/test/lux/data/number/frac.lux b/stdlib/source/test/lux/data/number/frac.lux
index 365bf9e7f..fcffb7c45 100644
--- a/stdlib/source/test/lux/data/number/frac.lux
+++ b/stdlib/source/test/lux/data/number/frac.lux
@@ -1,6 +1,5 @@
(.module:
[lux #*
- ["%" data/text/format (#+ format)]
["_" test (#+ Test)]
[abstract
[monad (#+ do)]
@@ -10,44 +9,171 @@
["$." order]
["$." monoid]
["$." codec]]}]
+ [data
+ ["." bit ("#\." equivalence)]]
[math
- ["." random]]]
+ ["." random (#+ Random)]]]
{1
["." /
[// #*
- ["i" int]]]})
+ ["n" nat]
+ ["i" int]
+ ["r" rev]
+ ["." i64]]]})
+
+(def: random
+ (Random Frac)
+ (:: random.monad map (|>> (i.% +1,000,000) i.frac) random.int))
+
+(def: signature
+ Test
+ (`` ($_ _.and
+ (_.with-cover [/.equivalence /.=]
+ ($equivalence.spec /.equivalence random.safe-frac))
+ (_.with-cover [/.order /.<]
+ ($order.spec /.order random.safe-frac))
+ (~~ (template [<monoid> <compose>]
+ [(_.with-cover [<monoid> <compose>]
+ ($monoid.spec /.equivalence <monoid> ..random))]
+
+ [/.addition /.+]
+ [/.multiplication /.*]
+ [/.minimum /.min]
+ [/.maximum /.max]
+ ))
+ (~~ (template [<codec>]
+ [(_.with-cover [<codec>]
+ ($codec.spec /.equivalence <codec> random.safe-frac))]
+
+ [/.binary] [/.octal] [/.decimal] [/.hex]
+ ))
+ )))
+
+(def: constant
+ Test
+ (do random.monad
+ [sample random.safe-frac]
+ ($_ _.and
+ (_.cover [/.biggest]
+ (/.<= /.biggest sample))
+ (_.cover [/.positive-infinity]
+ (/.< /.positive-infinity sample))
+ (_.cover [/.smallest]
+ (bit\= (/.positive? sample)
+ (/.>= /.smallest sample)))
+ (_.cover [/.negative-infinity]
+ (/.> /.negative-infinity sample))
+ (_.cover [/.not-a-number /.not-a-number?]
+ (and (/.not-a-number? /.not-a-number)
+ (not (or (/.= /.not-a-number sample)
+ (/.not-a-number? sample)))))
+ )))
+
+(def: predicate
+ Test
+ (do {! random.monad}
+ [sample ..random
+ shift (:: ! map /.abs ..random)]
+ ($_ _.and
+ (_.cover [/.negative?]
+ (bit\= (/.negative? sample)
+ (/.< +0.0 sample)))
+ (_.cover [/.positive?]
+ (bit\= (/.positive? sample)
+ (/.> +0.0 sample)))
+ (_.cover [/.zero?]
+ (bit\= (/.zero? sample)
+ (/.= +0.0 sample)))
+ (_.cover [/.within?]
+ (and (/.within? /.smallest sample sample)
+ (/.within? (/.+ +1.0 shift) sample (/.+ shift sample))))
+ (_.cover [/.number?]
+ (and (not (/.number? /.not-a-number))
+ (not (/.number? /.positive-infinity))
+ (not (/.number? /.negative-infinity))
+ (/.number? sample)))
+ )))
+
+(def: conversion
+ Test
+ ($_ _.and
+ (do {! random.monad}
+ [expected (:: ! map (n.% 1,000,000) random.nat)]
+ (_.cover [/.nat]
+ (|> expected n.frac /.nat (n.= expected))))
+ (do {! random.monad}
+ [expected (:: ! map (i.% +1,000,000) random.int)]
+ (_.cover [/.int]
+ (|> expected i.frac /.int (i.= expected))))
+ (do {! random.monad}
+ [expected (:: ! map (|>> (i64.left-shift 32) .rev)
+ random.nat)]
+ (_.cover [/.rev]
+ (|> expected r.frac /.rev (r.= expected))))
+ ))
(def: #export test
Test
- (let [gen-frac (:: random.monad map (|>> (i.% +100) i.frac) random.int)]
- (<| (_.context (%.name (name-of /._)))
- (`` ($_ _.and
- ($equivalence.spec /.equivalence gen-frac)
- ($order.spec /.order gen-frac)
- (~~ (template [<monoid>]
- [(<| (_.context (%.name (name-of <monoid>)))
- ($monoid.spec /.equivalence <monoid> gen-frac))]
-
- [/.addition] [/.multiplication] [/.minimum] [/.maximum]
- ))
- ## TODO: Uncomment ASAP
- ## (~~ (template [<codec>]
- ## [(<| (_.context (%.name (name-of /.binary)))
- ## ($codec.spec /.equivalence <codec> gen-frac))]
-
- ## [/.binary] [/.octal] [/.decimal] [/.hex]
- ## ))
-
- (_.test "Alternate notations."
- (and (/.= (bin "+1100.1001")
- (bin "+11,00.10,01"))
- (/.= (oct "-6152.43")
- (oct "-615,2.43"))
- (/.= (hex "+deadBE.EF")
- (hex "+dead,BE.EF"))))
- (do random.monad
- [sample gen-frac]
- (_.test (format (%.name (name-of /.to-bits))
- " & " (%.name (name-of /.from-bits)))
- (|> sample /.to-bits /.from-bits (/.= sample))))
- )))))
+ (<| (_.covering /._)
+ (_.with-cover [.Frac])
+ (`` ($_ _.and
+ (do random.monad
+ [left random.safe-frac
+ right random.safe-frac]
+ ($_ _.and
+ (_.cover [/.>]
+ (bit\= (/.> left right)
+ (/.< right left)))
+ (_.cover [/.<= /.>=]
+ (bit\= (/.<= left right)
+ (/.>= right left)))
+ ))
+ (do random.monad
+ [left ..random
+ right ..random]
+ ($_ _.and
+ (_.cover [/.%]
+ (let [rem (/.% left right)
+ div (|> right (/.- rem) (/./ left))]
+ (/.= right
+ (|> div (/.* left) (/.+ rem)))))
+ (_.cover [/./%]
+ (let [[div rem] (/./% left right)]
+ (and (/.= div (/./ left right))
+ (/.= rem (/.% left right)))))
+ ))
+ (do random.monad
+ [sample random.safe-frac]
+ ($_ _.and
+ (_.cover [/.-]
+ (and (/.= +0.0 (/.- sample sample))
+ (/.= sample (/.- +0.0 sample))
+ (/.= (/.negate sample)
+ (/.- sample +0.0))))
+ (_.cover [/./]
+ (and (/.= +1.0 (/./ sample sample))
+ (/.= sample (/./ +1.0 sample))))
+ (_.cover [/.abs]
+ (bit\= (/.> sample (/.abs sample))
+ (/.negative? sample)))
+ (_.cover [/.signum]
+ (/.= (/.abs sample)
+ (/.* (/.signum sample) sample)))))
+ (do random.monad
+ [expected random.frac]
+ ($_ _.and
+ (_.cover [/.to-bits /.from-bits]
+ (let [actual (|> expected /.to-bits /.from-bits)]
+ (or (/.= expected actual)
+ (and (/.not-a-number? expected)
+ (/.not-a-number? actual)))))
+ (_.cover [/.negate]
+ (and (/.= +0.0 (/.+ (/.negate expected) expected))
+ (|> expected /.negate /.negate (/.= expected))))
+ ))
+
+ ..signature
+ ..constant
+ ..predicate
+ ..conversion
+ ))))
diff --git a/stdlib/source/test/lux/type/check.lux b/stdlib/source/test/lux/type/check.lux
index bbaaa5712..46749652e 100644
--- a/stdlib/source/test/lux/type/check.lux
+++ b/stdlib/source/test/lux/type/check.lux
@@ -31,31 +31,30 @@
(def: (type' num-vars)
(-> Nat (r.Random Type))
- (do r.monad
- [_ (wrap [])]
- (let [(^open "R\.") r.monad
- pairG (r.and (type' num-vars)
- (type' num-vars))
- quantifiedG (r.and (R\wrap (list)) (type' (inc num-vars)))
- random-pair (r.either (r.either (R\map (|>> #.Sum) pairG)
- (R\map (|>> #.Product) pairG))
- (r.either (R\map (|>> #.Function) pairG)
- (R\map (|>> #.Apply) pairG)))
- random-id (let [random-id (r.either (R\map (|>> #.Var) r.nat)
- (R\map (|>> #.Ex) r.nat))]
- (case num-vars
- 0 random-id
- _ (r.either (R\map (|>> (n.% num-vars) (n.* 2) inc #.Parameter) r.nat)
- random-id)))
- random-quantified (r.either (R\map (|>> #.UnivQ) quantifiedG)
- (R\map (|>> #.ExQ) quantifiedG))]
- ($_ r.either
- (R\map (|>> #.Primitive) (r.and ..short (R\wrap (list))))
- random-pair
- random-id
- random-quantified
- (R\map (|>> #.Named) (r.and ..name (type' num-vars)))
- ))))
+ (r.rec
+ (function (_ recur)
+ (let [(^open "R\.") r.monad
+ pairG (r.and recur recur)
+ quantifiedG (r.and (R\wrap (list)) (type' (inc num-vars)))
+ random-pair (r.either (r.either (R\map (|>> #.Sum) pairG)
+ (R\map (|>> #.Product) pairG))
+ (r.either (R\map (|>> #.Function) pairG)
+ (R\map (|>> #.Apply) pairG)))
+ random-id (let [random-id (r.either (R\map (|>> #.Var) r.nat)
+ (R\map (|>> #.Ex) r.nat))]
+ (case num-vars
+ 0 random-id
+ _ (r.either (R\map (|>> (n.% num-vars) (n.* 2) inc #.Parameter) r.nat)
+ random-id)))
+ random-quantified (r.either (R\map (|>> #.UnivQ) quantifiedG)
+ (R\map (|>> #.ExQ) quantifiedG))]
+ ($_ r.either
+ (R\map (|>> #.Primitive) (r.and ..short (R\wrap (list))))
+ random-pair
+ random-id
+ random-quantified
+ (R\map (|>> #.Named) (r.and ..name (type' 0)))
+ )))))
(def: type
(r.Random Type)
diff --git a/stdlib/source/test/lux/world/file/watch.lux b/stdlib/source/test/lux/world/file/watch.lux
index 8d27ab307..5f55825e4 100644
--- a/stdlib/source/test/lux/world/file/watch.lux
+++ b/stdlib/source/test/lux/world/file/watch.lux
@@ -113,39 +113,46 @@
(list.empty? poll/0)]
file (!.use (:: fs create-file) [expected-path])
poll/1 (:: watcher poll [])
+ poll/1' (:: watcher poll [])
#let [after-creation!
- (case poll/1
- (^ (list [actual-path concern]))
- (and (text\= expected-path actual-path)
- (and (/.creation? concern)
- (not (/.modification? concern))
- (not (/.deletion? concern))))
+ (and (case poll/1
+ (^ (list [actual-path concern]))
+ (and (text\= expected-path actual-path)
+ (and (/.creation? concern)
+ (not (/.modification? concern))
+ (not (/.deletion? concern))))
- _
- false)]
+ _
+ false)
+ (list.empty? poll/1'))]
+ _ (promise.delay 1 (#try.Success "Delay to make sure the over-write time-stamp always changes."))
_ (!.use (:: file over-write) data)
poll/2 (:: watcher poll [])
+ poll/2' (:: watcher poll [])
#let [after-modification!
- (case poll/2
- (^ (list [actual-path concern]))
- (and (text\= expected-path actual-path)
- (and (not (/.creation? concern))
- (/.modification? concern)
- (not (/.deletion? concern))))
+ (and (case poll/2
+ (^ (list [actual-path concern]))
+ (and (text\= expected-path actual-path)
+ (and (not (/.creation? concern))
+ (/.modification? concern)
+ (not (/.deletion? concern))))
- _
- false)]
+ _
+ false)
+ (list.empty? poll/2'))]
_ (!.use (:: file delete) [])
poll/3 (:: watcher poll [])
+ poll/3' (:: watcher poll [])
#let [after-deletion!
- (case poll/3
- (^ (list [actual-path concern]))
- (and (not (/.creation? concern))
- (not (/.modification? concern))
- (/.deletion? concern))
+ (and (case poll/3
+ (^ (list [actual-path concern]))
+ (and (not (/.creation? concern))
+ (not (/.modification? concern))
+ (/.deletion? concern))
- _
- false)]]
+ _
+ false)
+ (list.empty? poll/3'))]]
(wrap (and no-events-prior-to-creation!
after-creation!
after-modification!