From 982a19e0c5d57b53f9726b780fec4c18f0787b4f Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Wed, 2 Dec 2020 04:42:03 -0400 Subject: Test for Aedifex's "auto" command. --- stdlib/source/test/aedifex.lux | 4 +- stdlib/source/test/aedifex/command/auto.lux | 147 +++++++++++++++++++ stdlib/source/test/lux/data/collection/set.lux | 30 ++-- stdlib/source/test/lux/data/number.lux | 27 ++-- stdlib/source/test/lux/data/number/frac.lux | 196 ++++++++++++++++++++----- stdlib/source/test/lux/type/check.lux | 49 +++---- stdlib/source/test/lux/world/file/watch.lux | 53 ++++--- 7 files changed, 397 insertions(+), 109 deletions(-) create mode 100644 stdlib/source/test/aedifex/command/auto.lux (limited to 'stdlib/source/test') 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 [ ] + [(_.with-cover [ ] + ($monoid.spec /.equivalence ..random))] + + [/.addition /.+] + [/.multiplication /.*] + [/.minimum /.min] + [/.maximum /.max] + )) + (~~ (template [] + [(_.with-cover [] + ($codec.spec /.equivalence 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 [] - [(<| (_.context (%.name (name-of ))) - ($monoid.spec /.equivalence gen-frac))] - - [/.addition] [/.multiplication] [/.minimum] [/.maximum] - )) - ## TODO: Uncomment ASAP - ## (~~ (template [] - ## [(<| (_.context (%.name (name-of /.binary))) - ## ($codec.spec /.equivalence 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! -- cgit v1.2.3