diff options
Diffstat (limited to '')
| -rw-r--r-- | licentia/source/test/licentia.lux (renamed from stdlib/source/test/licentia.lux) | 163 | ||||
| -rw-r--r-- | stdlib/source/test/aedifex.lux | 83 | ||||
| -rw-r--r-- | stdlib/source/test/aedifex/command.lux | 32 | ||||
| -rw-r--r-- | stdlib/source/test/aedifex/command/install.lux | 20 | ||||
| -rw-r--r-- | stdlib/source/test/aedifex/command/pom.lux | 5 | ||||
| -rw-r--r-- | stdlib/source/test/aedifex/command/version.lux | 4 | ||||
| -rw-r--r-- | stdlib/source/test/lux/control/function.lux | 4 | ||||
| -rw-r--r-- | stdlib/source/test/lux/control/function/mutual.lux | 65 | ||||
| -rw-r--r-- | stdlib/source/test/lux/world.lux | 6 | ||||
| -rw-r--r-- | stdlib/source/test/lux/world/output/video/resolution.lux | 63 |
10 files changed, 297 insertions, 148 deletions
diff --git a/stdlib/source/test/licentia.lux b/licentia/source/test/licentia.lux index af03062cb..bf0f4929e 100644 --- a/stdlib/source/test/licentia.lux +++ b/licentia/source/test/licentia.lux @@ -1,22 +1,21 @@ (.module: [lux #* + [program (#+ program:)] ["_" test (#+ Test)] [abstract [monad (#+ do)]] [control - [io (#+ io)] - [parser - [cli (#+ program:)]]] + [io (#+ io)]] [data ["." bit ("#\." equivalence)] ["." maybe ("#\." functor)] ["." text] - [number - ["n" nat ("#\." interval)]] [collection ["." list ("#\." functor)]]] [math - ["." random (#+ Random)]]] + ["." random (#+ Random)] + [number + ["n" nat ("#\." interval)]]]] {#program [/ ["." license (#+ Identification @@ -25,7 +24,7 @@ Distribution Commercial Extension - Entity Black-List + Entity Black_List URL Attribution Addendum License) @@ -41,7 +40,7 @@ ["." commercial] ["." extension] ["." miscellaneous] - ["." black-list] + ["." black_list] ["." addendum]] ["." output]]}) @@ -50,14 +49,14 @@ (do {! random.monad} [start (random.filter (|>> (n.= n\top) not) random.nat) - #let [wiggle-room (n.- start n\top)] + #let [wiggle_room (n.- start n\top)] end (\ ! map - (|>> (n.% wiggle-room) (n.max 1)) + (|>> (n.% wiggle_room) (n.max 1)) random.nat)] (wrap {#time.start start #time.end end}))) -(def: copyright-holder +(def: copyright_holder (Random copyright.Holder) ($_ random.and (random.ascii 10) @@ -107,18 +106,18 @@ (Random Entity) (random.ascii 10)) -(def: (variable-list max-size gen-element) +(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)) + [amount (\ ! map (n.% (n.max 1 max_size)) random.nat)] - (random.list amount gen-element))) + (random.list amount gen_element))) -(def: black-list - (Random Black-List) +(def: black_list + (Random Black_List) ($_ random.and (random.maybe (random.ascii 10)) - (variable-list 10 ..entity))) + (variable_list 10 ..entity))) (def: url (Random URL) @@ -141,14 +140,14 @@ (def: license (Random License) ($_ random.and - (random.list 2 ..copyright-holder) + (random.list 2 ..copyright_holder) (random.maybe ..identification) ..termination ..liability ..distribution ..commercial ..extension - (variable-list 3 ..black-list) + (variable_list 3 ..black_list) (random.maybe attribution) ..addendum )) @@ -156,27 +155,27 @@ (type: (Concern a) (-> (-> Text Bit) a Test)) -(def: (about-grant present? termination) +(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)))) + (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)))) + (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)))) + (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)))) + (present? (grant.grace_period_clause (get@ #license.grace_period termination)))) (_.test "The grants are not retro-actively terminated." - (present? grant.no-retroactive-termination)) + (present? grant.no_retroactive_termination)) )) -(def: (about-liability present? liability) +(def: (about_liability present? liability) (Concern Liability) ($_ _.and (_.test "Warranty liability disclaimer is present." @@ -186,65 +185,65 @@ (_.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))) + (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))) + (bit\= (get@ #license.disclaim_high_risk? liability) + (present? liability.disclaim_high_risk))) )) -(def: (about-distribution present? distribution) +(def: (about_distribution present? distribution) (Concern Distribution) ($_ _.and (_.test "Conditions for source-code distribution are present." - (present? distribution.source-code-form)) + (present? distribution.source_code_form)) (_.test "Conditions for object-code distribution are present." - (present? distribution.object-form)) + (present? distribution.object_form)) (_.test "Conditions for extension distribution are present." (present? (distribution.extension distribution))) )) -(def: (about-commercial present? commercial) +(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))) + (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))) + (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))) + (bit\= (not (get@ #license.allow_contributor_endorsement? commercial)) + (present? commercial.disallow_contributor_endorsement))) )) -(def: (about-extension present? extension) +(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)))) + (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))) + (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) + (case (get@ #license.notification_period extension) (#.Some period) - (present? (extension.notification-requirement period)) + (present? (extension.notification_requirement period)) #.None true)) (_.test "Must describe modifications." - (bit\= (get@ #license.must-describe-modifications? extension) - (present? extension.description-requirement))) + (bit\= (get@ #license.must_describe_modifications? extension) + (present? extension.description_requirement))) )) -(def: (about-attribution present? attribution) +(def: (about_attribution present? attribution) (Concern Attribution) ($_ _.and (_.test "The attribution copyright notice is present." - (present? (get@ #license.copyright-notice attribution))) + (present? (get@ #license.copyright_notice attribution))) (_.test "The attribution phrase is present." (|> attribution (get@ #license.phrase) @@ -259,29 +258,29 @@ (maybe.default true))) )) -(def: (about-miscellaneous present?) +(def: (about_miscellaneous present?) (-> (-> Text Bit) Test) ($_ _.and (_.test "License constitutes the entire agreement." - (present? miscellaneous.entire-agreement)) + (present? miscellaneous.entire_agreement)) (_.test "Disclaims relationship of parties." - (present? miscellaneous.relationship-of-parties)) + (present? miscellaneous.relationship_of_parties)) (_.test "Explicitly allows independent development." - (present? miscellaneous.independent-development)) + (present? miscellaneous.independent_development)) (_.test "Clarifies consent to breach does not waiver." - (present? miscellaneous.not-waiver)) + (present? miscellaneous.not_waiver)) (_.test "Provides severability." (present? miscellaneous.severability)) (_.test "Covers export restrictions." - (present? miscellaneous.export-restrictions)) + (present? miscellaneous.export_restrictions)) )) -(def: (about-addendum present? value) +(def: (about_addendum present? value) (Concern Addendum) ($_ _.and (_.test "Commons clause" - (bit\= (get@ #license.commons-clause? value) - (present? addendum.commons-clause))) + (bit\= (get@ #license.commons_clause? value) + (present? addendum.commons_clause))) )) (def: test @@ -294,33 +293,33 @@ (text.contains? snippet writ)))]] ($_ _.and (_.test "Copyright notices are present." - (list.every? (|>> notice.copyright-holder present?) - (get@ #license.copyright-holders license))) + (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)) + (present? miscellaneous.new_versions)) #.None - (not (present? miscellaneous.new-versions)))) + (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) + (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 + every_entity_is_mentioned? (|> black_list (get@ #license.entities) - (list\map black-list.entity) + (list\map black_list.entity) (list.every? present?))] - (and black-list-is-justified? - every-entity-is-mentioned?))) - (get@ #license.black-lists license))) + (and black_list_is_justified? + every_entity_is_mentioned?))) + (get@ #license.black_lists license))) (_.test "All definitions are present." (list.every? (|>> output.definition present?) @@ -329,7 +328,7 @@ (_.test "Acceptance of the license is demanded." (present? limitation.acceptance)) - (..about-grant present? (get@ #license.termination license)) + (..about_grant present? (get@ #license.termination license)) (_.test "All limitations are present." (present? output.limitation)) @@ -340,28 +339,28 @@ (_.test "The terms of submission are present." (present? submission.contribution)) - (..about-liability present? (get@ #license.liability license)) + (..about_liability present? (get@ #license.liability license)) - (..about-distribution present? (get@ #license.distribution license)) + (..about_distribution present? (get@ #license.distribution license)) - (..about-commercial present? (get@ #license.commercial license)) + (..about_commercial present? (get@ #license.commercial license)) - (..about-extension present? (get@ #license.extension license)) + (..about_extension present? (get@ #license.extension license)) (case (get@ #license.attribution license) (#.Some attribution) - (..about-attribution present? attribution) + (..about_attribution present? attribution) #.None (_.test "Attribution is missing." yes)) - (..about-miscellaneous present?) + (..about_miscellaneous present?) - (..about-addendum present? (get@ #license.addendum license)) + (..about_addendum present? (get@ #license.addendum license)) (_.test "License ending footer is present." - (present? notice.end-of-license)) + (present? notice.end_of_license)) ))) (program: args 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/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 [<resolutions> (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 <resolutions>))) + + (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 [<resolutions>] + (let [listing (set.to_list catalogue)] + (n.= (list.size listing) + (set.size catalogue)))) + )))) |