From 0205e5146b50ab066d152fccda0fc8cef4eef852 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Thu, 3 Dec 2020 02:09:57 -0400 Subject: Detect duplicate files coming from dependencies. --- stdlib/source/test/aedifex/command/auto.lux | 80 +++++---------- stdlib/source/test/aedifex/command/build.lux | 133 +++++++++++++++++-------- stdlib/source/test/aedifex/command/clean.lux | 65 +++++++----- stdlib/source/test/aedifex/command/deploy.lux | 43 ++++---- stdlib/source/test/aedifex/command/deps.lux | 53 ++++++---- stdlib/source/test/aedifex/command/install.lux | 104 ++++++++++--------- stdlib/source/test/aedifex/command/pom.lux | 26 +++-- stdlib/source/test/aedifex/command/test.lux | 98 ++++++++++-------- stdlib/source/test/aedifex/command/version.lux | 61 +++++++++++- 9 files changed, 403 insertions(+), 260 deletions(-) (limited to 'stdlib/source/test/aedifex/command') diff --git a/stdlib/source/test/aedifex/command/auto.lux b/stdlib/source/test/aedifex/command/auto.lux index 5fad232b1..aa1b8ebe8 100644 --- a/stdlib/source/test/aedifex/command/auto.lux +++ b/stdlib/source/test/aedifex/command/auto.lux @@ -25,11 +25,15 @@ ["." random]] [world [environment (#+ Environment)] + [console (#+ Console)] ["." shell (#+ Shell)] ["." file (#+ Path) ["." watch]]]] - ["$." /// #_ - ["#." package]] + ["." // #_ + ["@." version] + ["@." build] + ["$/#" // #_ + ["#." package]]] {#program ["." / ["/#" // #_ @@ -46,11 +50,11 @@ (def: (command end-signal dummy-files) (-> Text (List Path) [(Atom [Nat (List Path)]) - (-> Environment (file.System Promise) (Shell Promise) Resolution (Command Any))]) + (-> (Console Promise) 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) + (function (_ console environment fs shell resolution profile) (do {! promise.monad} [[runs remaining-files] (promise.future (atom.update (function (_ [runs remaining-files]) @@ -72,23 +76,7 @@ (<| (_.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])))))) - [])] + [fs watcher] (watch.mock /)] end-signal (random.ascii/alpha 5) program (random.ascii/alpha 5) target (random.ascii/alpha 5) @@ -110,38 +98,24 @@ with-target (set@ #///.sources (set.from-list text.hash (list source)))) - environment (dictionary.put "user.dir" working-directory environment.empty)]] + environment (dictionary.put "user.dir" working-directory environment.empty)] + resolution @build.resolution] ($_ _.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) + (wrap (do promise.monad + [verdict (do ///action.monad + [#let [[@runs command] (..command end-signal dummy-files)] + _ (!.use (\ fs create-directory) [source]) + _ (\ watcher poll [])] + (do promise.monad + [outcome ((/.do! watcher command) (@version.echo "") environment fs (@build.good-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))))) + (#try.Success _) + false))))))] + (_.cover' [/.do!] + (try.default false verdict)))) )))) diff --git a/stdlib/source/test/aedifex/command/build.lux b/stdlib/source/test/aedifex/command/build.lux index 3b1802440..6a911e928 100644 --- a/stdlib/source/test/aedifex/command/build.lux +++ b/stdlib/source/test/aedifex/command/build.lux @@ -7,19 +7,24 @@ ["." try] ["." exception] [concurrency - ["." promise]] + ["." promise (#+ Promise)]] [parser - ["." environment]]] + ["." environment]] + [security + ["!" capability]]] [data + ["." text ("#\." equivalence)] [collection ["." dictionary]]] [math ["." random]] [world ["." file] - ["." shell]]] - ["$." /// #_ - ["#." package]] + ["." shell (#+ Shell)]]] + ["." // #_ + ["@." version] + ["$/#" // #_ + ["#." package]]] {#program ["." / ["//#" /// #_ @@ -30,27 +35,69 @@ ["#." dependency ["#/." resolution]]]]}) +(def: #export good-shell + (-> Any (Shell Promise)) + (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])))))))) + +(def: #export bad-shell + (-> Any (Shell Promise)) + (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.error])))))))) + +(def: compiler + (do random.monad + [lux-version (random.ascii/alpha 5) + #let [jvm-compiler {#///dependency.artifact {#///artifact.group /.lux-group + #///artifact.name /.jvm-compiler-name + #///artifact.version lux-version} + #///dependency.type ///artifact/type.lux-library} + js-compiler {#///dependency.artifact {#///artifact.group /.lux-group + #///artifact.name /.js-compiler-name + #///artifact.version lux-version} + #///dependency.type ///artifact/type.lux-library}]] + (random.either (wrap jvm-compiler) + (wrap js-compiler)))) + +(def: #export resolution + (do random.monad + [dependency ..compiler + [_ package] $///package.random] + (wrap (|> ///dependency/resolution.empty + (dictionary.put dependency package))))) + (def: #export test Test (<| (_.covering /._) (do {! random.monad} [#let [fs (file.mock (\ file.default separator)) - 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])))))) - [])] + shell (..good-shell [])] program (random.ascii/alpha 5) target (random.ascii/alpha 5) working-directory (random.ascii/alpha 5) @@ -83,7 +130,7 @@ (#try.Failure error) false))) (wrap (do promise.monad - [outcome (/.do! environment fs shell ///dependency/resolution.empty + [outcome (/.do! (@version.echo "") environment fs shell ///dependency/resolution.empty (with-target empty-profile))] (_.cover' [/.no-specified-program] (case outcome @@ -93,7 +140,7 @@ (#try.Failure error) (exception.match? /.no-specified-program error))))) (wrap (do promise.monad - [outcome (/.do! environment fs shell ///dependency/resolution.empty + [outcome (/.do! (@version.echo "") environment fs shell ///dependency/resolution.empty (with-program empty-profile))] (_.cover' [/.no-specified-target] (case outcome @@ -103,7 +150,7 @@ (#try.Failure error) (exception.match? /.no-specified-target error))))) (wrap (do promise.monad - [outcome (/.do! environment fs shell ///dependency/resolution.empty profile)] + [outcome (/.do! (@version.echo "") environment fs shell ///dependency/resolution.empty profile)] (_.cover' [/.Compiler /.no-available-compiler] (case outcome (#try.Success _) @@ -112,25 +159,29 @@ (#try.Failure error) (exception.match? /.no-available-compiler error))))) (do ! - [lux-version (random.ascii/alpha 5) - [_ compiler-package] $///package.random - #let [jvm-compiler {#///dependency.artifact {#///artifact.group /.lux-group - #///artifact.name /.jvm-compiler-name - #///artifact.version lux-version} - #///dependency.type ///artifact/type.lux-library} - js-compiler {#///dependency.artifact {#///artifact.group /.lux-group - #///artifact.name /.js-compiler-name - #///artifact.version lux-version} - #///dependency.type ///artifact/type.lux-library}] - compiler-dependency (random.either (wrap jvm-compiler) - (wrap js-compiler))] + [#let [console (@version.echo "")] + resolution ..resolution] (wrap (do promise.monad [verdict (do ///action.monad - [#let [resolution (|> ///dependency/resolution.empty - (dictionary.put compiler-dependency compiler-package))] - _ (/.do! environment fs shell resolution profile)] - (wrap true))] + [_ (/.do! console environment fs shell resolution profile) + start (!.use (\ console read-line) []) + end (!.use (\ console read-line) [])] + (wrap (and (text\= /.start start) + (text\= /.success end))))] (_.cover' [/.do! - /.lux-group /.jvm-compiler-name /.js-compiler-name] + /.lux-group /.jvm-compiler-name /.js-compiler-name + /.start /.success] + (try.default false verdict))))) + (do ! + [#let [console (@version.echo "")] + resolution ..resolution] + (wrap (do promise.monad + [verdict (do ///action.monad + [_ (/.do! console environment fs (..bad-shell []) resolution profile) + start (!.use (\ console read-line) []) + end (!.use (\ console read-line) [])] + (wrap (and (text\= /.start start) + (text\= /.failure end))))] + (_.cover' [/.failure] (try.default false verdict))))) )))) diff --git a/stdlib/source/test/aedifex/command/clean.lux b/stdlib/source/test/aedifex/command/clean.lux index 11570d034..739bd1a34 100644 --- a/stdlib/source/test/aedifex/command/clean.lux +++ b/stdlib/source/test/aedifex/command/clean.lux @@ -12,7 +12,7 @@ [data [binary (#+ Binary)] ["." product] - ["." text + ["." text ("#\." equivalence) ["%" format (#+ format)]] [number ["n" nat]] @@ -23,12 +23,14 @@ ["." random (#+ Random)]] [world ["." file (#+ Path File)]]] - [/// - ["@." profile] + [// + ["@." version] [// - [lux - [data - ["_." binary]]]]] + ["@." profile] + [// + [lux + [data + ["_." binary]]]]]] {#program ["." / ["//#" /// #_ @@ -97,22 +99,35 @@ sub-files (..files (format sub-path /)) dummy @profile.random] - (wrap (do promise.monad - [verdict (do {! (try.with promise.monad)} - [_ (..create-directory! fs target-path direct-files) - _ (..create-directory! fs sub-path sub-files) - context-exists!/pre (..directory-exists? fs context) - target-exists!/pre (..assets-exist? fs target-path direct-files) - sub-exists!/pre (..assets-exist? fs sub-path sub-files) - _ (/.do! fs (set@ #///.target (#.Some target-path) dummy)) - context-exists!/post (..directory-exists? fs context) - target-exists!/post (..assets-exist? fs target-path direct-files) - sub-exists!/post (..assets-exist? fs sub-path sub-files)] - (wrap (and (and context-exists!/pre - context-exists!/post) - (and target-exists!/pre - (not target-exists!/post)) - (and sub-exists!/pre - (not sub-exists!/post)))))] - (_.cover' [/.do!] - (try.default false verdict))))))) + ($_ _.and + (wrap (do promise.monad + [#let [console (@version.echo "")] + verdict (do {! (try.with promise.monad)} + [_ (/.do! console fs (set@ #///.target #.None dummy))] + (\ ! map (text\= /.failure) + (!.use (\ console read-line) [])))] + (_.cover' [/.failure] + (try.default false verdict)))) + (wrap (do promise.monad + [#let [console (@version.echo "")] + verdict (do {! (try.with promise.monad)} + [_ (..create-directory! fs target-path direct-files) + _ (..create-directory! fs sub-path sub-files) + context-exists!/pre (..directory-exists? fs context) + target-exists!/pre (..assets-exist? fs target-path direct-files) + sub-exists!/pre (..assets-exist? fs sub-path sub-files) + _ (/.do! console fs (set@ #///.target (#.Some target-path) dummy)) + context-exists!/post (..directory-exists? fs context) + target-exists!/post (..assets-exist? fs target-path direct-files) + sub-exists!/post (..assets-exist? fs sub-path sub-files) + logging (!.use (\ console read-line) [])] + (wrap (and (and context-exists!/pre + context-exists!/post) + (and target-exists!/pre + (not target-exists!/post)) + (and sub-exists!/pre + (not sub-exists!/post)) + (text\= /.success logging))))] + (_.cover' [/.do! /.success] + (try.default false verdict)))) + )))) diff --git a/stdlib/source/test/aedifex/command/deploy.lux b/stdlib/source/test/aedifex/command/deploy.lux index 5e4f6615b..773069322 100644 --- a/stdlib/source/test/aedifex/command/deploy.lux +++ b/stdlib/source/test/aedifex/command/deploy.lux @@ -30,20 +30,24 @@ [program [compositor ["." export]]] - [/// - ["@." profile] - ["@." repository]] + [// + ["@." version] + [// + ["@." profile] + ["@." repository]]] {#program ["." / - ["//#" /// #_ - ["#" profile] - ["#." action] - ["#." pom] - ["#." local] - ["#." hash] - ["#." repository (#+ Identity Repository)] - ["#." artifact (#+ Artifact) - ["#/." extension]]]]}) + ["/#" // #_ + ["#." clean] + ["/#" // #_ + ["#" profile] + ["#." action] + ["#." pom] + ["#." local] + ["#." hash] + ["#." repository (#+ Identity Repository)] + ["#." artifact (#+ Artifact) + ["#/." extension]]]]]}) (def: (make-sources! fs sources) (-> (file.System Promise) (Set Path) (Promise (Try Any))) @@ -65,12 +69,14 @@ (def: (execute! repository fs identity artifact profile) (-> (Repository Promise) (file.System Promise) Identity Artifact ///.Profile - (Promise (Try Any))) + (Promise (Try Text))) (do ///action.monad - [_ (..make-sources! fs (get@ #///.sources profile)) + [#let [console (@version.echo "")] + _ (..make-sources! fs (get@ #///.sources profile)) _ (: (Promise (Try Path)) - (file.make-directories promise.monad fs (///local.repository fs)))] - (/.do! repository fs identity artifact profile))) + (file.make-directories promise.monad fs (///local.repository fs))) + _ (/.do! console repository fs identity artifact profile)] + (!.use (\ console read-line) []))) (def: #export test Test @@ -90,7 +96,7 @@ fs (file.mock (\ file.default separator))]] (wrap (do {! promise.monad} [verdict (do {! ///action.monad} - [_ (..execute! repository fs identity artifact profile) + [logging (..execute! repository fs identity artifact profile) expected-library (|> profile (get@ #///.sources) set.to-list @@ -121,7 +127,8 @@ (\ binary.equivalence = (///hash.data (///hash.md5 expected-library)) actual-md5)]] - (wrap (and deployed-library! + (wrap (and (text\= //clean.success logging) + deployed-library! deployed-pom! deployed-sha-1! deployed-md5!)))] diff --git a/stdlib/source/test/aedifex/command/deps.lux b/stdlib/source/test/aedifex/command/deps.lux index 2f221a7ce..5b9dd87da 100644 --- a/stdlib/source/test/aedifex/command/deps.lux +++ b/stdlib/source/test/aedifex/command/deps.lux @@ -7,9 +7,11 @@ [control ["." try] [concurrency - ["." promise]]] + ["." promise]] + [security + ["!" capability]]] [data - [text + ["." text ("#\." equivalence) ["%" format (#+ format)]] [collection ["." dictionary] @@ -18,24 +20,28 @@ ["." random (#+ Random)]] [world ["." file]]] - ["$." /// #_ - ["#." package] - ["#." artifact] - ["#." dependency #_ - ["#/." resolution]]] + ["." // #_ + ["@." version] + ["$/#" // #_ + ["#." package] + ["#." artifact] + ["#." dependency #_ + ["#/." resolution]]]] {#program ["." / - ["//#" /// #_ - ["#" profile] - ["#." action] - ["#." pom] - ["#." package] - ["#." cache] - ["#." repository] - ["#." artifact - ["#/." type]] - ["#." dependency - ["#/." resolution]]]]}) + ["/#" // #_ + ["#." clean] + ["/#" // #_ + ["#" profile] + ["#." action] + ["#." pom] + ["#." package] + ["#." cache] + ["#." repository] + ["#." artifact + ["#/." type]] + ["#." dependency + ["#/." resolution]]]]]}) (def: #export test Test @@ -74,13 +80,18 @@ fs (file.mock (\ file.default separator))]] (wrap (do promise.monad [verdict (do ///action.monad - [pre (|> ///dependency/resolution.empty + [#let [console (@version.echo "")] + pre (|> ///dependency/resolution.empty (dictionary.put dependee dependee-package) (///cache.write-all fs)) post (|> (\ ///.monoid identity) (set@ #///.dependencies (set.from-list ///dependency.hash (list dependee depender))) - (/.do! fs (list (///repository.mock ($///dependency/resolution.single depender-artifact depender-package) []))))] - (wrap (and (and (set.member? pre dependee-artifact) + (/.do! console fs (list (///repository.mock ($///dependency/resolution.single depender-artifact depender-package) [])))) + logging! (\ ///action.monad map + (text\= //clean.success) + (!.use (\ console read-line) []))] + (wrap (and logging! + (and (set.member? pre dependee-artifact) (not (set.member? pre depender-artifact))) (and (dictionary.key? post dependee) (dictionary.key? post depender)))))] diff --git a/stdlib/source/test/aedifex/command/install.lux b/stdlib/source/test/aedifex/command/install.lux index e858d46d2..2dbddeaa3 100644 --- a/stdlib/source/test/aedifex/command/install.lux +++ b/stdlib/source/test/aedifex/command/install.lux @@ -4,7 +4,7 @@ [abstract ["." monad (#+ do)]] [control - ["." try (#+ Try)] + ["." try (#+ Try) ("#\." functor)] ["." exception] [concurrency ["." promise (#+ Promise)]] @@ -13,7 +13,7 @@ [data ["." maybe] ["." binary] - ["." text + ["." text ("#\." equivalence) ["%" format (#+ format)] ["." encoding]] [format @@ -24,17 +24,22 @@ ["." random (#+ Random)]] [world ["." file (#+ Path File)]]] - [/// - ["@." profile]] + [// + ["@." version] + [// + ["@." profile] + ["@." artifact]]] {#program ["." / - ["//#" /// #_ - ["#" profile] - ["#." action] - ["#." pom] - ["#." local] - ["#." artifact - ["#/." extension]]]]}) + ["/#" // #_ + ["#." clean] + ["/#" // #_ + ["#" profile] + ["#." action] + ["#." pom] + ["#." local] + ["#." artifact + ["#/." extension]]]]]}) (def: (make-sources! fs sources) (-> (file.System Promise) (Set Path) (Promise (Try Any))) @@ -54,48 +59,49 @@ (recur tail))))) (def: (execute! fs sample) - (-> (file.System Promise) ///.Profile (Promise (Try Any))) + (-> (file.System Promise) ///.Profile (Promise (Try Text))) (do ///action.monad - [_ (..make-sources! fs (get@ #///.sources sample)) + [#let [console (@version.echo "")] + _ (..make-sources! fs (get@ #///.sources sample)) _ (: (Promise (Try Path)) - (file.make-directories promise.monad fs (///local.repository fs)))] - (/.do! fs sample))) + (file.make-directories promise.monad fs (///local.repository fs))) + _ (/.do! console fs sample)] + (!.use (\ console read-line) []))) (def: #export test Test (<| (_.covering /._) - (do random.monad - [sample @profile.random - #let [fs (file.mock (\ file.default separator))]] - (wrap (case (get@ #///.identity sample) - (#.Some identity) - (do {! promise.monad} - [verdict (do ///action.monad - [_ (..execute! fs sample) - #let [artifact-path (format (///local.path fs identity) - (\ fs separator) - (///artifact.identity identity)) - library-path (format artifact-path ///artifact/extension.lux-library) - pom-path (format artifact-path ///artifact/extension.pom)] + (do {! random.monad} + [identity @artifact.random + sample (\ ! map (set@ #///.identity (#.Some identity)) + @profile.random)] + ($_ _.and + (wrap (do {! promise.monad} + [#let [fs (file.mock (\ file.default separator))] + verdict (do ///action.monad + [logging (..execute! fs sample) + #let [artifact-path (format (///local.path fs identity) + (\ fs separator) + (///artifact.identity identity)) + library-path (format artifact-path ///artifact/extension.lux-library) + pom-path (format artifact-path ///artifact/extension.pom)] - library-exists! (\ promise.monad map - exception.return - (file.file-exists? promise.monad fs library-path)) - pom-exists! (\ promise.monad map - exception.return - (file.file-exists? promise.monad fs pom-path))] - (wrap (and library-exists! - pom-exists!)))] - (_.cover' [/.do!] - (try.default false verdict))) - - #.None - (do {! promise.monad} - [outcome (..execute! fs sample)] - (_.cover' [/.do!] - (case outcome - (#try.Success _) - false - - (#try.Failure error) - true)))))))) + library-exists! (\ promise.monad map + exception.return + (file.file-exists? promise.monad fs library-path)) + pom-exists! (\ promise.monad map + exception.return + (file.file-exists? promise.monad fs pom-path))] + (wrap (and (text\= //clean.success logging) + library-exists! + pom-exists!)))] + (_.cover' [/.do!] + (try.default false verdict)))) + (wrap (do {! promise.monad} + [#let [fs (file.mock (\ file.default separator))] + logging (..execute! fs (set@ #///.identity #.None sample))] + (_.cover' [/.failure] + (|> logging + (try\map (text\= /.failure)) + (try.default false))))) + )))) diff --git a/stdlib/source/test/aedifex/command/pom.lux b/stdlib/source/test/aedifex/command/pom.lux index 408debea6..d63641e04 100644 --- a/stdlib/source/test/aedifex/command/pom.lux +++ b/stdlib/source/test/aedifex/command/pom.lux @@ -19,14 +19,18 @@ ["." random (#+ Random)]] [world ["." file (#+ File)]]] - [/// - ["@." profile]] + [// + ["@." version] + [// + ["@." profile]]] {#program ["." / - ["//#" /// #_ - ["#" profile] - ["#." action] - ["#." pom]]]}) + ["/#" // #_ + ["#." clean] + ["/#" // #_ + ["#" profile] + ["#." action] + ["#." pom]]]]}) (def: #export test Test @@ -35,7 +39,8 @@ [sample @profile.random #let [fs (file.mock (\ file.default separator))]] (wrap (do {! promise.monad} - [outcome (/.do! fs sample)] + [#let [console (@version.echo "")] + outcome (/.do! console fs sample)] (case outcome (#try.Success path) (do ! @@ -47,12 +52,17 @@ (file.get-file promise.monad fs path)) actual (!.use (\ file content) []) + logging! (\ ///action.monad map + (text\= //clean.success) + (!.use (\ console read-line) [])) + #let [expected-path! (text\= ///pom.file path) expected-content! (\ binary.equivalence = expected actual)]] - (wrap (and expected-path! + (wrap (and logging! + expected-path! expected-content!)))] (_.cover' [/.do!] (try.default false verdict))) diff --git a/stdlib/source/test/aedifex/command/test.lux b/stdlib/source/test/aedifex/command/test.lux index 3a4bf9d79..43c70d8ba 100644 --- a/stdlib/source/test/aedifex/command/test.lux +++ b/stdlib/source/test/aedifex/command/test.lux @@ -8,8 +8,11 @@ [concurrency ["." promise]] [parser - ["." environment]]] + ["." environment]] + [security + ["!" capability]]] [data + ["." text ("#\." equivalence)] [collection ["." dictionary]]] [math @@ -17,8 +20,11 @@ [world ["." file] ["." shell]]] - ["$." /// #_ - ["#." package]] + ["." // #_ + ["@." version] + ["@." build] + ["$/#" // #_ + ["#." package]]] {#program ["." / ["/#" // #_ @@ -35,24 +41,7 @@ Test (<| (_.covering /._) (do {! random.monad} - [#let [fs (file.mock (\ file.default separator)) - 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])))))) - [])] - program (random.ascii/alpha 5) + [program (random.ascii/alpha 5) target (random.ascii/alpha 5) working-directory (random.ascii/alpha 5) #let [empty-profile (: Profile @@ -68,27 +57,56 @@ no-working-directory environment.empty - environment (dictionary.put "user.dir" working-directory environment.empty)]] + environment (dictionary.put "user.dir" working-directory environment.empty)] + resolution @build.resolution] ($_ _.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 [fs (file.mock (\ file.default separator)) + console (@version.echo "")] (wrap (do promise.monad [verdict (do ///action.monad - [#let [resolution (|> ///dependency/resolution.empty - (dictionary.put compiler-dependency compiler-package))] - _ (/.do! environment fs shell resolution profile)] - (wrap true))] - (_.cover' [/.do!] + [_ (/.do! console environment fs (@build.good-shell []) resolution profile) + build-start (!.use (\ console read-line) []) + build-end (!.use (\ console read-line) []) + test-start (!.use (\ console read-line) []) + test-end (!.use (\ console read-line) [])] + (wrap (and (and (text\= //build.start build-start) + (text\= //build.success build-end)) + (and (text\= /.start test-start) + (text\= /.success test-end)))))] + (_.cover' [/.do! + /.start /.success] + (try.default false verdict))))) + (let [fs (file.mock (\ file.default separator)) + console (@version.echo "")] + (wrap (do promise.monad + [verdict (do ///action.monad + [#let [bad-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 (if (text.ends-with? " build" actual-command) + shell.normal + shell.error)])))))) + [])] + _ (/.do! console environment fs bad-shell resolution profile) + build-start (!.use (\ console read-line) []) + build-end (!.use (\ console read-line) []) + test-start (!.use (\ console read-line) []) + test-end (!.use (\ console read-line) [])] + (wrap (and (and (text\= //build.start build-start) + (text\= //build.success build-end)) + (and (text\= /.start test-start) + (text\= /.failure test-end)))))] + (_.cover' [/.failure] (try.default false verdict))))) )))) diff --git a/stdlib/source/test/aedifex/command/version.lux b/stdlib/source/test/aedifex/command/version.lux index f6196556d..5e60f6b9b 100644 --- a/stdlib/source/test/aedifex/command/version.lux +++ b/stdlib/source/test/aedifex/command/version.lux @@ -5,23 +5,74 @@ [monad (#+ do)]] [control ["." try] + ["." exception (#+ exception:)] [concurrency - ["." promise]]] + ["." promise (#+ Promise)]] + [security + ["!" capability]]] + [data + ["." maybe] + ["." text ("#\." equivalence) + ["%" format (#+ format)]]] [math - ["." random]]] + ["." random]] + [tool + [compiler + ["." version] + ["." language #_ + ["#/." lux #_ + ["#" version]]]]] + [world + ["." console (#+ Console Simulation)]]] [/// ["@." profile]] {#program ["." /]}) +(exception: #export console-is-closed!) + +(structure: simulation + (Simulation [Bit Text]) + + (def: (on-read [open? state]) + (if open? + (try.from-maybe + (do maybe.monad + [head (text.nth 0 state) + [_ tail] (text.split 1 state)] + (wrap [[open? tail] head]))) + (exception.throw ..console-is-closed! []))) + (def: (on-read-line [open? state]) + (if open? + (try.from-maybe + (do maybe.monad + [[output state] (text.split-with text.new-line state)] + (wrap [[open? state] output]))) + (exception.throw ..console-is-closed! []))) + (def: (on-write input [open? state]) + (if open? + (#try.Success [open? (format state input)]) + (exception.throw ..console-is-closed! []))) + (def: (on-close [open? buffer]) + (if open? + (#try.Success [false buffer]) + (exception.throw ..console-is-closed! [])))) + +(def: #export echo + (-> Text (Console Promise)) + (|>> [true] (console.mock ..simulation))) + (def: #export test Test (<| (_.covering /._) (do random.monad [profile @profile.random] (wrap (do promise.monad - [verdict (do (try.with promise.monad) - [_ (/.do! profile)] - (wrap true))] + [#let [console (..echo "")] + verdict (do (try.with promise.monad) + [_ (/.do! console profile) + logging (!.use (\ console read-line) [])] + (wrap (text\= (version.format language/lux.version) + logging)))] (_.cover' [/.do!] (try.default false verdict))))))) -- cgit v1.2.3