From 519c0c0c71cdf7ce3dfc64b9781ab826760b3d94 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Mon, 14 Jun 2021 18:33:54 -0400 Subject: Extracted Licentia out of the standard library. --- stdlib/source/test/aedifex.lux | 83 ++--- stdlib/source/test/aedifex/command.lux | 32 ++ stdlib/source/test/aedifex/command/install.lux | 20 +- stdlib/source/test/aedifex/command/pom.lux | 5 +- stdlib/source/test/aedifex/command/version.lux | 4 +- stdlib/source/test/licentia.lux | 369 --------------------- stdlib/source/test/lux/control/function.lux | 4 +- stdlib/source/test/lux/control/function/mutual.lux | 65 ++++ stdlib/source/test/lux/world.lux | 6 +- .../test/lux/world/output/video/resolution.lux | 63 ++++ 10 files changed, 216 insertions(+), 435 deletions(-) create mode 100644 stdlib/source/test/aedifex/command.lux delete mode 100644 stdlib/source/test/licentia.lux create mode 100644 stdlib/source/test/lux/control/function/mutual.lux create mode 100644 stdlib/source/test/lux/world/output/video/resolution.lux (limited to 'stdlib/source/test') diff --git a/stdlib/source/test/aedifex.lux b/stdlib/source/test/aedifex.lux index 3833c0828..ae9bde67c 100644 --- a/stdlib/source/test/aedifex.lux +++ b/stdlib/source/test/aedifex.lux @@ -1,66 +1,49 @@ (.module: [lux #* + [program (#+ program:)] ["_" test (#+ Test)] [control - [io (#+ io)] - [parser - [cli (#+ program:)]]]] + [io (#+ io)]]] ["." / #_ ["#." artifact] - ["#." input] - ["#." command #_ - ["#/." version] - ["#/." clean] - ["#/." pom] - ["#/." install] - ["#/." deploy] - ["#/." deps] - ["#/." build] - ["#/." test] - ["#/." auto]] - ["#." local] - ["#." dependency - ["#/." resolution] - ["#/." status]] - ["#." package] - ["#." profile] - ["#." project] ["#." cli] - ["#." hash] - ["#." parser] - ["#." pom] - ["#." repository] - ["#." runtime] - ["#." metadata]]) + ["#." command] + ## ["#." input] + ## ["#." local] + ## ["#." dependency + ## ## ["#/." resolution] + ## ["#/." status]] + ## ["#." package] + ## ["#." profile] + ## ["#." project] + ## ["#." hash] + ## ["#." parser] + ## ["#." pom] + ## ["#." repository] + ## ["#." runtime] + ## ["#." metadata] + ]) (def: test Test ($_ _.and /artifact.test - /input.test - /command/version.test - /command/clean.test - /command/pom.test - /command/install.test - /command/deploy.test - /command/deps.test - /command/build.test - /command/test.test - /command/auto.test - /local.test - /dependency.test - /dependency/resolution.test - /dependency/status.test - /package.test - /profile.test - /project.test /cli.test - /hash.test - /parser.test - /pom.test - /repository.test - /runtime.test - /metadata.test + /command.test + ## /input.test + ## /local.test + ## /dependency.test + ## ## /dependency/resolution.test + ## /dependency/status.test + ## /package.test + ## /profile.test + ## /project.test + ## /hash.test + ## /parser.test + ## /pom.test + ## /repository.test + ## /runtime.test + ## /metadata.test )) (program: args diff --git a/stdlib/source/test/aedifex/command.lux b/stdlib/source/test/aedifex/command.lux new file mode 100644 index 000000000..0ef18f044 --- /dev/null +++ b/stdlib/source/test/aedifex/command.lux @@ -0,0 +1,32 @@ +(.module: + [lux #* + ["_" test (#+ Test)]] + ["." / #_ + ["#." clean] + ["#." install] + ["#." pom] + ["#." version]] + {#program + ["." / + ## ["#." deploy] + ## ["#." deps] + ## ["#." build] + ## ["#." test] + ## ["#." auto] + ]}) + +(def: #export test + Test + (<| (_.covering /._) + (_.for [/.Command]) + ($_ _.and + /clean.test + /install.test + /pom.test + /version.test + ## /deploy.test + ## /deps.test + ## /build.test + ## /test.test + ## /auto.test + ))) diff --git a/stdlib/source/test/aedifex/command/install.lux b/stdlib/source/test/aedifex/command/install.lux index ce3f21de8..33ee7192d 100644 --- a/stdlib/source/test/aedifex/command/install.lux +++ b/stdlib/source/test/aedifex/command/install.lux @@ -16,8 +16,7 @@ ["." maybe] ["." binary] ["." text ("#\." equivalence) - ["%" format (#+ format)] - ["." encoding]] + ["%" format (#+ format)]] [format ["." xml]] [collection @@ -67,13 +66,11 @@ (def: (execute! program fs sample) (-> (Program Promise) (file.System Promise) ///.Profile (Promise (Try Text))) - (do promise.monad - [home (\ program home [])] - (do ///action.monad - [#let [console (@version.echo "")] - _ (..make_sources! fs (get@ #///.sources sample)) - _ (/.do! console fs (///repository/local.repository program fs) sample)] - (!.use (\ console read_line) [])))) + (do ///action.monad + [#let [console (@version.echo "")] + _ (..make_sources! fs (get@ #///.sources sample)) + _ (/.do! console fs (///repository/local.repository program fs) sample)] + (!.use (\ console read_line) []))) (def: #export test Test @@ -91,17 +88,18 @@ verdict (do ///action.monad [logging (..execute! program fs sample) #let [/ uri.separator - artifact_path (format (///local.uri identity) / (///artifact.identity identity)) + artifact_path (///local.uri (get@ #///artifact.version identity) identity) library_path (format artifact_path ///artifact/extension.lux_library) pom_path (format artifact_path ///artifact/extension.pom)] + #let [succeeded! (text\= //clean.success logging)] 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) + (wrap (and succeeded! library_exists! pom_exists!)))] (_.cover' [/.do!] diff --git a/stdlib/source/test/aedifex/command/pom.lux b/stdlib/source/test/aedifex/command/pom.lux index 33c102926..c368d5f84 100644 --- a/stdlib/source/test/aedifex/command/pom.lux +++ b/stdlib/source/test/aedifex/command/pom.lux @@ -12,7 +12,8 @@ [data ["." binary] ["." text ("#\." equivalence) - ["." encoding]] + [encoding + ["." utf8]]] [format ["." xml]]] [math @@ -46,7 +47,7 @@ (do ! [verdict (do ///action.monad [expected (|> (///pom.write sample) - (try\map (|>> (\ xml.codec encode) (\ encoding.utf8 encode))) + (try\map (|>> (\ xml.codec encode) (\ utf8.codec encode))) (\ ! wrap)) file (: (Promise (Try (File Promise))) (file.get_file promise.monad fs path)) diff --git a/stdlib/source/test/aedifex/command/version.lux b/stdlib/source/test/aedifex/command/version.lux index ee26b3b5d..c7a9aa4ef 100644 --- a/stdlib/source/test/aedifex/command/version.lux +++ b/stdlib/source/test/aedifex/command/version.lux @@ -60,7 +60,9 @@ (def: #export echo (-> Text (Console Promise)) - (|>> [true] (console.mock ..simulation))) + (|>> [true] + (console.mock ..simulation) + console.async)) (def: #export test Test diff --git a/stdlib/source/test/licentia.lux b/stdlib/source/test/licentia.lux deleted file mode 100644 index af03062cb..000000000 --- a/stdlib/source/test/licentia.lux +++ /dev/null @@ -1,369 +0,0 @@ -(.module: - [lux #* - ["_" test (#+ Test)] - [abstract - [monad (#+ do)]] - [control - [io (#+ io)] - [parser - [cli (#+ program:)]]] - [data - ["." bit ("#\." equivalence)] - ["." maybe ("#\." functor)] - ["." text] - [number - ["n" nat ("#\." interval)]] - [collection - ["." list ("#\." functor)]]] - [math - ["." random (#+ Random)]]] - {#program - [/ - ["." license (#+ Identification - Termination - Liability - Distribution - Commercial - Extension - Entity Black-List - URL Attribution - Addendum - License) - ["." time (#+ Period)] - ["." copyright] - ["." notice] - ["." definition] - ["." grant] - ["." limitation] - ["." submission] - ["." liability] - ["." distribution] - ["." commercial] - ["." extension] - ["." miscellaneous] - ["." black-list] - ["." addendum]] - ["." output]]}) - -(def: period - (Random (Period Nat)) - (do {! random.monad} - [start (random.filter (|>> (n.= n\top) not) - random.nat) - #let [wiggle-room (n.- start n\top)] - end (\ ! map - (|>> (n.% wiggle-room) (n.max 1)) - random.nat)] - (wrap {#time.start start - #time.end end}))) - -(def: copyright-holder - (Random copyright.Holder) - ($_ random.and - (random.ascii 10) - ..period)) - -(def: identification - (Random Identification) - ($_ random.and - (random.ascii 10) - (random.ascii 10))) - -(def: termination - (Random Termination) - ($_ random.and - random.bit - random.nat - random.nat)) - -(def: liability - (Random Liability) - ($_ random.and - random.bit - random.bit)) - -(def: distribution - (Random Distribution) - ($_ random.and - random.bit - random.bit)) - -(def: commercial - (Random Commercial) - ($_ random.and - random.bit - random.bit - random.bit)) - -(def: extension - (Random Extension) - ($_ random.and - random.bit - random.bit - (random.maybe ..period) - random.bit)) - -(def: entity - (Random Entity) - (random.ascii 10)) - -(def: (variable-list max-size gen-element) - (All [a] (-> Nat (Random a) (Random (List a)))) - (do {! random.monad} - [amount (\ ! map (n.% (n.max 1 max-size)) - random.nat)] - (random.list amount gen-element))) - -(def: black-list - (Random Black-List) - ($_ random.and - (random.maybe (random.ascii 10)) - (variable-list 10 ..entity))) - -(def: url - (Random URL) - (random.ascii 10)) - -(def: attribution - (Random Attribution) - ($_ random.and - (random.ascii 10) - (random.maybe (random.ascii 10)) - ..url - (random.maybe ..url))) - -(def: addendum - (Random Addendum) - ($_ random.and - random.bit - )) - -(def: license - (Random License) - ($_ random.and - (random.list 2 ..copyright-holder) - (random.maybe ..identification) - ..termination - ..liability - ..distribution - ..commercial - ..extension - (variable-list 3 ..black-list) - (random.maybe attribution) - ..addendum - )) - -(type: (Concern a) - (-> (-> Text Bit) a Test)) - -(def: (about-grant present? termination) - (Concern Termination) - ($_ _.and - (_.test "Copyright grant is present." - (present? grant.copyright)) - (_.test "Patent grant is present." - (present? (grant.patent (get@ #license.patent-retaliation? termination)))) - (_.test "Effective date for the grants is present." - (present? grant.date)) - (_.test "Patent grant is present." - (present? (grant.termination (get@ #license.termination-period termination) - (get@ #license.grace-period termination)))) - (_.test "The termination period is accurately conveyed." - (present? (grant.grant-restoration-clause (get@ #license.termination-period termination)))) - (_.test "The grace period is accurately conveyed." - (present? (grant.grace-period-clause (get@ #license.grace-period termination)))) - (_.test "The grants are not retro-actively terminated." - (present? grant.no-retroactive-termination)) - )) - -(def: (about-liability present? liability) - (Concern Liability) - ($_ _.and - (_.test "Warranty liability disclaimer is present." - (present? liability.warranty)) - (_.test "Limitation of liability is present." - (present? liability.limitation)) - (_.test "Litigation conditions are present." - (present? liability.litigation)) - (_.test "Liability acceptance conditions may be present." - (bit\= (get@ #license.can-accept? liability) - (present? liability.can-accept))) - (_.test "Liability acceptance conditions may be present." - (bit\= (get@ #license.disclaim-high-risk? liability) - (present? liability.disclaim-high-risk))) - )) - -(def: (about-distribution present? distribution) - (Concern Distribution) - ($_ _.and - (_.test "Conditions for source-code distribution are present." - (present? distribution.source-code-form)) - (_.test "Conditions for object-code distribution are present." - (present? distribution.object-form)) - (_.test "Conditions for extension distribution are present." - (present? (distribution.extension distribution))) - )) - -(def: (about-commercial present? commercial) - (Concern Commercial) - ($_ _.and - (_.test "Non-commercial clause is present." - (bit\= (not (get@ #license.can-sell? commercial)) - (present? commercial.cannot-sell))) - (_.test "Contributor credit condition is present." - (bit\= (get@ #license.require-contributor-credit? commercial) - (present? commercial.require-contributor-attribution))) - (_.test "Anti-endorsement condition is present." - (bit\= (not (get@ #license.allow-contributor-endorsement? commercial)) - (present? commercial.disallow-contributor-endorsement))) - )) - -(def: (about-extension present? extension) - (Concern Extension) - ($_ _.and - (_.test "The license is viral." - (bit\= (get@ #license.same-license? extension) - (and (list.every? present? extension.sharing-requirement) - (list.every? present? extension.license-conflict-resolution)))) - (_.test "Extensions must be distinguishable from the original work." - (bit\= (get@ #license.must-be-distinguishable? extension) - (present? extension.distinctness-requirement))) - (_.test "The community must be notified of new extensions." - (case (get@ #license.notification-period extension) - (#.Some period) - (present? (extension.notification-requirement period)) - - #.None - true)) - (_.test "Must describe modifications." - (bit\= (get@ #license.must-describe-modifications? extension) - (present? extension.description-requirement))) - )) - -(def: (about-attribution present? attribution) - (Concern Attribution) - ($_ _.and - (_.test "The attribution copyright notice is present." - (present? (get@ #license.copyright-notice attribution))) - (_.test "The attribution phrase is present." - (|> attribution - (get@ #license.phrase) - (maybe\map present?) - (maybe.default true))) - (_.test "The attribution URL is present." - (present? (get@ #license.url attribution))) - (_.test "The attribution image is present." - (|> attribution - (get@ #license.image) - (maybe\map present?) - (maybe.default true))) - )) - -(def: (about-miscellaneous present?) - (-> (-> Text Bit) Test) - ($_ _.and - (_.test "License constitutes the entire agreement." - (present? miscellaneous.entire-agreement)) - (_.test "Disclaims relationship of parties." - (present? miscellaneous.relationship-of-parties)) - (_.test "Explicitly allows independent development." - (present? miscellaneous.independent-development)) - (_.test "Clarifies consent to breach does not waiver." - (present? miscellaneous.not-waiver)) - (_.test "Provides severability." - (present? miscellaneous.severability)) - (_.test "Covers export restrictions." - (present? miscellaneous.export-restrictions)) - )) - -(def: (about-addendum present? value) - (Concern Addendum) - ($_ _.and - (_.test "Commons clause" - (bit\= (get@ #license.commons-clause? value) - (present? addendum.commons-clause))) - )) - -(def: test - Test - (do random.monad - [license ..license - #let [writ (output.license license) - present? (: (-> Text Bit) - (function (_ snippet) - (text.contains? snippet writ)))]] - ($_ _.and - (_.test "Copyright notices are present." - (list.every? (|>> notice.copyright-holder present?) - (get@ #license.copyright-holders license))) - - (_.test "Identification is present (if the license is identified)." - (case (get@ #license.identification license) - (#.Some identification) - (and (present? (output.identification identification)) - (present? miscellaneous.new-versions)) - - #.None - (not (present? miscellaneous.new-versions)))) - - (_.test "Black-lists (if wanted by licensor) are explicitly enumerated and justified." - (list.every? (function (_ black-list) - (let [black-list-is-justified? (case (get@ #license.justification black-list) - (#.Some justification) - (present? justification) - - #.None - yes) - every-entity-is-mentioned? (|> black-list - (get@ #license.entities) - (list\map black-list.entity) - (list.every? present?))] - (and black-list-is-justified? - every-entity-is-mentioned?))) - (get@ #license.black-lists license))) - - (_.test "All definitions are present." - (list.every? (|>> output.definition present?) - definition.all)) - - (_.test "Acceptance of the license is demanded." - (present? limitation.acceptance)) - - (..about-grant present? (get@ #license.termination license)) - - (_.test "All limitations are present." - (present? output.limitation)) - - (_.test "All assurances are present." - (present? output.assurance)) - - (_.test "The terms of submission are present." - (present? submission.contribution)) - - (..about-liability present? (get@ #license.liability license)) - - (..about-distribution present? (get@ #license.distribution license)) - - (..about-commercial present? (get@ #license.commercial license)) - - (..about-extension present? (get@ #license.extension license)) - - (case (get@ #license.attribution license) - (#.Some attribution) - (..about-attribution present? attribution) - - #.None - (_.test "Attribution is missing." - yes)) - - (..about-miscellaneous present?) - - (..about-addendum present? (get@ #license.addendum license)) - - (_.test "License ending footer is present." - (present? notice.end-of-license)) - ))) - -(program: args - (io (_.run! (<| (_.times 100) - ..test)))) diff --git a/stdlib/source/test/lux/control/function.lux b/stdlib/source/test/lux/control/function.lux index f816075f5..354433cc8 100644 --- a/stdlib/source/test/lux/control/function.lux +++ b/stdlib/source/test/lux/control/function.lux @@ -18,7 +18,8 @@ ["." / #_ ["#." contract] ["#." memo] - ["#." mixin]]) + ["#." mixin] + ["#." mutual]]) (def: #export test Test @@ -62,4 +63,5 @@ /contract.test /memo.test /mixin.test + /mutual.test )))) diff --git a/stdlib/source/test/lux/control/function/mutual.lux b/stdlib/source/test/lux/control/function/mutual.lux new file mode 100644 index 000000000..e645e282b --- /dev/null +++ b/stdlib/source/test/lux/control/function/mutual.lux @@ -0,0 +1,65 @@ +(.module: + [lux #* + ["_" test (#+ Test)] + [abstract + [monad (#+ do)]] + [data + ["." bit ("#\." equivalence)] + [text + ["%" format (#+ format)]]] + [math + ["." random (#+ Random)] + [number + ["n" nat]]]] + {1 + ["." /]}) + +(def: test_let + Test + (do {! random.monad} + [sample (\ ! map (n.% 10) random.nat) + #let [expected (n.even? sample)]] + (<| (_.cover [/.let]) + (/.let [(even? number) + (-> Nat Bit) + (case number + 0 true + _ (odd? (dec number))) + + (odd? number) + (-> Nat Bit) + (case number + 0 false + _ (even? (dec number)))] + (and (bit\= expected (even? sample)) + (bit\= (not expected) (odd? sample))))))) + +(/.def: + [(even? number) + (-> Nat Bit) + (case number + 0 true + _ (odd? (dec number)))] + + [(odd? number) + (-> Nat Bit) + (case number + 0 false + _ (even? (dec number)))]) + +(def: test_def + Test + (do {! random.monad} + [sample (\ ! map (n.% 10) random.nat) + #let [expected (n.even? sample)]] + (<| (_.cover [/.def:]) + (and (bit\= expected (..even? sample)) + (bit\= (not expected) (..odd? sample)))))) + +(def: #export test + Test + (<| (_.covering /._) + ($_ _.and + ..test_let + ..test_def + ))) diff --git a/stdlib/source/test/lux/world.lux b/stdlib/source/test/lux/world.lux index 0405ef7ee..8b560ca40 100644 --- a/stdlib/source/test/lux/world.lux +++ b/stdlib/source/test/lux/world.lux @@ -5,7 +5,10 @@ ["#." file] ["#." shell] ["#." console] - ["#." program]]) + ["#." program] + ["#." output #_ + ["#/." video #_ + ["#/." resolution]]]]) (def: #export test Test @@ -14,4 +17,5 @@ /shell.test /console.test /program.test + /output/video/resolution.test )) diff --git a/stdlib/source/test/lux/world/output/video/resolution.lux b/stdlib/source/test/lux/world/output/video/resolution.lux new file mode 100644 index 000000000..f5dcf5380 --- /dev/null +++ b/stdlib/source/test/lux/world/output/video/resolution.lux @@ -0,0 +1,63 @@ +(.module: + [lux #* + ["_" test (#+ Test)] + [abstract + [monad (#+ do)] + {[0 #spec] + [/ + ["$." equivalence] + ["$." hash]]}] + [data + ["." maybe] + [collection + ["." list] + ["." set (#+ Set)]]] + [math + ["." random (#+ Random)] + [number + ["n" nat]]]] + {1 + ["." /]}) + +(with_expansions [ (as_is /.svga + /.wsvga + /.xga + /.xga+ + /.wxga/16:9 + /.wxga/5:3 + /.wxga/16:10 + /.sxga + /.wxga+ + /.hd+ + /.wsxga+ + /.fhd + /.wuxga + /.wqhd + /.uhd-4k)] + (def: catalogue + (Set /.Resolution) + (set.from_list /.hash (list ))) + + (def: #export random + (Random /.Resolution) + (let [listing (set.to_list catalogue) + count (list.size listing)] + (do {! random.monad} + [choice (\ ! map (n.% count) random.nat)] + (wrap (maybe.assume (list.nth choice listing)))))) + + (def: #export test + Test + (<| (_.covering /._) + (_.for [/.Resolution]) + ($_ _.and + (_.for [/.equivalence] + ($equivalence.spec /.equivalence ..random)) + (_.for [/.hash] + ($hash.spec /.hash ..random)) + + (_.cover [] + (let [listing (set.to_list catalogue)] + (n.= (list.size listing) + (set.size catalogue)))) + )))) -- cgit v1.2.3