aboutsummaryrefslogtreecommitdiff
path: root/licentia/source/test
diff options
context:
space:
mode:
authorEduardo Julian2021-06-14 18:33:54 -0400
committerEduardo Julian2021-06-14 18:33:54 -0400
commit519c0c0c71cdf7ce3dfc64b9781ab826760b3d94 (patch)
tree75fa0672afceff129e5e75afb7a5fed197ce1773 /licentia/source/test
parentaf3e6e2cb011dc2ad9204440990731a2f272716d (diff)
Extracted Licentia out of the standard library.
Diffstat (limited to 'licentia/source/test')
-rw-r--r--licentia/source/test/licentia.lux368
1 files changed, 368 insertions, 0 deletions
diff --git a/licentia/source/test/licentia.lux b/licentia/source/test/licentia.lux
new file mode 100644
index 000000000..bf0f4929e
--- /dev/null
+++ b/licentia/source/test/licentia.lux
@@ -0,0 +1,368 @@
+(.module:
+ [lux #*
+ [program (#+ program:)]
+ ["_" test (#+ Test)]
+ [abstract
+ [monad (#+ do)]]
+ [control
+ [io (#+ io)]]
+ [data
+ ["." bit ("#\." equivalence)]
+ ["." maybe ("#\." functor)]
+ ["." text]
+ [collection
+ ["." list ("#\." functor)]]]
+ [math
+ ["." random (#+ Random)]
+ [number
+ ["n" nat ("#\." interval)]]]]
+ {#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))))