From 1797521191746640e761cc1b4973d46b8c403dee Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Thu, 28 Jan 2021 20:14:11 -0400 Subject: Implemented arithmetic right-shift in terms of logic right-shift. --- stdlib/source/test/aedifex/artifact/snapshot.lux | 4 +- .../test/aedifex/artifact/snapshot/version.lux | 46 +++ stdlib/source/test/aedifex/artifact/time.lux | 10 +- .../source/test/lux/data/collection/set/multi.lux | 348 +++++++++++---------- stdlib/source/test/lux/data/format/tar.lux | 13 +- stdlib/source/test/lux/data/name.lux | 9 +- stdlib/source/test/lux/math/number/i64.lux | 29 +- stdlib/source/test/lux/math/number/int.lux | 28 +- stdlib/source/test/lux/type/dynamic.lux | 4 +- stdlib/source/test/lux/type/implicit.lux | 52 ++- 10 files changed, 323 insertions(+), 220 deletions(-) create mode 100644 stdlib/source/test/aedifex/artifact/snapshot/version.lux (limited to 'stdlib/source/test') diff --git a/stdlib/source/test/aedifex/artifact/snapshot.lux b/stdlib/source/test/aedifex/artifact/snapshot.lux index 1bdb9ca2d..371fde55e 100644 --- a/stdlib/source/test/aedifex/artifact/snapshot.lux +++ b/stdlib/source/test/aedifex/artifact/snapshot.lux @@ -15,7 +15,8 @@ ["$." / #_ ["#." build] ["#." time] - ["#." stamp]] + ["#." stamp] + ["#." version]] {#program ["." /]}) @@ -45,4 +46,5 @@ $/build.test $/time.test $/stamp.test + $/version.test )))) diff --git a/stdlib/source/test/aedifex/artifact/snapshot/version.lux b/stdlib/source/test/aedifex/artifact/snapshot/version.lux new file mode 100644 index 000000000..e08691c3c --- /dev/null +++ b/stdlib/source/test/aedifex/artifact/snapshot/version.lux @@ -0,0 +1,46 @@ +(.module: + [lux #* + ["_" test (#+ Test)] + [abstract + [monad (#+ do)] + {[0 #spec] + [/ + ["$." equivalence]]}] + [control + ["." try ("#\." functor)] + [parser + ["<.>" xml]]] + [math + ["." random (#+ Random)]]] + {#program + ["." /]} + ["$." /// #_ + ["#." type] + ["#." time]]) + +(def: #export random + (Random /.Version) + ($_ random.and + $///type.random + (random.ascii/alpha 1) + $///time.random + )) + +(def: #export test + Test + (<| (_.covering /._) + (_.for [/.Version]) + ($_ _.and + (_.for [/.equivalence] + ($equivalence.spec /.equivalence ..random)) + + (do random.monad + [expected ..random] + (_.cover [/.format /.parser] + (|> expected + /.format + list + (.run /.parser) + (try\map (\ /.equivalence = expected)) + (try.default false)))) + ))) diff --git a/stdlib/source/test/aedifex/artifact/time.lux b/stdlib/source/test/aedifex/artifact/time.lux index 880bc1f83..4bf63018c 100644 --- a/stdlib/source/test/aedifex/artifact/time.lux +++ b/stdlib/source/test/aedifex/artifact/time.lux @@ -11,7 +11,7 @@ [parser ["<.>" text]]] [math - ["." random]] + ["." random (#+ Random)]] [time ["." instant]]] {#program @@ -20,16 +20,20 @@ ["#." date] ["#." time]]) +(def: #export random + (Random /.Time) + random.instant) + (def: #export test Test (<| (_.covering /._) (_.for [/.Time]) ($_ _.and (_.for [/.equivalence] - ($equivalence.spec /.equivalence random.instant)) + ($equivalence.spec /.equivalence ..random)) (do random.monad - [expected random.instant] + [expected ..random] (_.cover [/.format /.parser] (|> expected /.format diff --git a/stdlib/source/test/lux/data/collection/set/multi.lux b/stdlib/source/test/lux/data/collection/set/multi.lux index 718c971c3..feea35e2f 100644 --- a/stdlib/source/test/lux/data/collection/set/multi.lux +++ b/stdlib/source/test/lux/data/collection/set/multi.lux @@ -36,6 +36,78 @@ (list.zip/2 element_counts (set.to_list elements)))))) +(def: signature + Test + (do {! random.monad} + [diversity (\ ! map (n.% 10) random.nat)] + ($_ _.and + (_.for [/.equivalence] + ($equivalence.spec /.equivalence (..random diversity n.hash ..count random.nat))) + (_.for [/.hash] + (|> random.nat + (\ random.monad map (function (_ single) + (/.add 1 single (/.new n.hash)))) + ($hash.spec /.hash))) + ))) + +(def: composition + Test + (do {! random.monad} + [diversity (\ ! map (n.% 10) random.nat) + sample (..random diversity n.hash ..count random.nat) + another (..random diversity n.hash ..count random.nat)] + (`` ($_ _.and + (~~ (template [ ] + [(_.cover [] + (let [|sample| (/.support sample) + |another| (/.support another) + sample_only (set.difference |another| |sample|) + another_only (set.difference |sample| |another|) + common (set.intersection |sample| |another|) + composed ( sample another) + + no_left_changes! (list.every? (function (_ member) + (n.= (/.multiplicity sample member) + (/.multiplicity composed member))) + (set.to_list sample_only)) + no_right_changes! (list.every? (function (_ member) + (n.= (/.multiplicity another member) + (/.multiplicity composed member))) + (set.to_list another_only)) + common_changes! (list.every? (function (_ member) + (n.= ( (/.multiplicity sample member) + (/.multiplicity another member)) + (/.multiplicity composed member))) + (set.to_list common))] + (and no_left_changes! + no_right_changes! + common_changes!)))] + + [/.sum n.+] + [/.union n.max] + )) + (_.cover [/.intersection] + (let [|sample| (/.support sample) + |another| (/.support another) + sample_only (set.difference |another| |sample|) + another_only (set.difference |sample| |another|) + common (set.intersection |sample| |another|) + composed (/.intersection sample another) + + left_removals! (list.every? (|>> (/.member? composed) not) + (set.to_list sample_only)) + right_removals! (list.every? (|>> (/.member? composed) not) + (set.to_list another_only)) + common_changes! (list.every? (function (_ member) + (n.= (n.min (/.multiplicity sample member) + (/.multiplicity another member)) + (/.multiplicity composed member))) + (set.to_list common))] + (and left_removals! + right_removals! + common_changes!))) + )))) + (def: #export test Test (<| (_.covering /._) @@ -48,175 +120,121 @@ addition_count ..count partial_removal_count (\ ! map (n.% addition_count) random.nat) another (..random diversity n.hash ..count random.nat)] - (`` ($_ _.and - (_.for [/.equivalence] - ($equivalence.spec /.equivalence (..random diversity n.hash ..count random.nat))) - (_.for [/.hash] - (|> random.nat - (\ random.monad map (function (_ single) - (/.add 1 single (/.new n.hash)))) - ($hash.spec /.hash))) - - (_.cover [/.to_list /.from_list] - (|> sample - /.to_list - (/.from_list n.hash) - (\ /.equivalence = sample))) - (_.cover [/.size] - (n.= (list.size (/.to_list sample)) - (/.size sample))) - (_.cover [/.empty?] - (bit\= (/.empty? sample) - (n.= 0 (/.size sample)))) - (_.cover [/.new] - (/.empty? (/.new n.hash))) - (_.cover [/.support] - (list.every? (set.member? (/.support sample)) - (/.to_list sample))) - (_.cover [/.member?] - (let [non_member_is_not_identified! - (not (/.member? sample non_member)) - - all_members_are_identified! - (list.every? (/.member? sample) - (/.to_list sample))] - (and non_member_is_not_identified! - all_members_are_identified!))) - (_.cover [/.multiplicity] - (let [non_members_have_0_multiplicity! - (n.= 0 (/.multiplicity sample non_member)) - - every_member_has_positive_multiplicity! - (list.every? (|>> (/.multiplicity sample) (n.> 0)) - (/.to_list sample))] - (and non_members_have_0_multiplicity! - every_member_has_positive_multiplicity!))) - (_.cover [/.add] - (let [null_scenario! - (|> sample - (/.add 0 non_member) - (\ /.equivalence = sample)) + ($_ _.and + (_.cover [/.to_list /.from_list] + (|> sample + /.to_list + (/.from_list n.hash) + (\ /.equivalence = sample))) + (_.cover [/.size] + (n.= (list.size (/.to_list sample)) + (/.size sample))) + (_.cover [/.empty?] + (bit\= (/.empty? sample) + (n.= 0 (/.size sample)))) + (_.cover [/.new] + (/.empty? (/.new n.hash))) + (_.cover [/.support] + (list.every? (set.member? (/.support sample)) + (/.to_list sample))) + (_.cover [/.member?] + (let [non_member_is_not_identified! + (not (/.member? sample non_member)) - normal_scenario! - (let [sample+ (/.add addition_count non_member sample)] - (and (not (/.member? sample non_member)) - (/.member? sample+ non_member) - (n.= addition_count (/.multiplicity sample+ non_member))))] - (and null_scenario! - normal_scenario!))) - (_.cover [/.remove] - (let [null_scenario! - (\ /.equivalence = - (|> sample - (/.add addition_count non_member)) - (|> sample - (/.add addition_count non_member) - (/.remove 0 non_member))) + all_members_are_identified! + (list.every? (/.member? sample) + (/.to_list sample))] + (and non_member_is_not_identified! + all_members_are_identified!))) + (_.cover [/.multiplicity] + (let [non_members_have_0_multiplicity! + (n.= 0 (/.multiplicity sample non_member)) - partial_scenario! - (let [sample* (|> sample - (/.add addition_count non_member) - (/.remove partial_removal_count non_member))] - (and (/.member? sample* non_member) - (n.= (n.- partial_removal_count - addition_count) - (/.multiplicity sample* non_member)))) + every_member_has_positive_multiplicity! + (list.every? (|>> (/.multiplicity sample) (n.> 0)) + (/.to_list sample))] + (and non_members_have_0_multiplicity! + every_member_has_positive_multiplicity!))) + (_.cover [/.add] + (let [null_scenario! + (|> sample + (/.add 0 non_member) + (\ /.equivalence = sample)) - total_scenario! - (|> sample - (/.add addition_count non_member) - (/.remove addition_count non_member) - (\ /.equivalence = sample))] - (and null_scenario! - partial_scenario! - total_scenario!))) - (_.cover [/.from_set] - (let [unary (|> sample /.support /.from_set)] - (list.every? (|>> (/.multiplicity unary) (n.= 1)) - (/.to_list unary)))) - (_.cover [/.sub?] - (let [unary (|> sample /.support /.from_set)] - (and (/.sub? sample unary) - (or (not (/.sub? unary sample)) - (\ /.equivalence = sample unary))))) - (_.cover [/.super?] - (let [unary (|> sample /.support /.from_set)] - (and (/.super? unary sample) - (or (not (/.super? sample unary)) - (\ /.equivalence = sample unary))))) - (~~ (template [ ] - [(_.cover [] - (let [|sample| (/.support sample) - |another| (/.support another) - sample_only (set.difference |another| |sample|) - another_only (set.difference |sample| |another|) - common (set.intersection |sample| |another|) - composed ( sample another) + normal_scenario! + (let [sample+ (/.add addition_count non_member sample)] + (and (not (/.member? sample non_member)) + (/.member? sample+ non_member) + (n.= addition_count (/.multiplicity sample+ non_member))))] + (and null_scenario! + normal_scenario!))) + (_.cover [/.remove] + (let [null_scenario! + (\ /.equivalence = + (|> sample + (/.add addition_count non_member)) + (|> sample + (/.add addition_count non_member) + (/.remove 0 non_member))) - no_left_changes! (list.every? (function (_ member) - (n.= (/.multiplicity sample member) - (/.multiplicity composed member))) - (set.to_list sample_only)) - no_right_changes! (list.every? (function (_ member) - (n.= (/.multiplicity another member) - (/.multiplicity composed member))) - (set.to_list another_only)) - common_changes! (list.every? (function (_ member) - (n.= ( (/.multiplicity sample member) - (/.multiplicity another member)) - (/.multiplicity composed member))) - (set.to_list common))] - (and no_left_changes! - no_right_changes! - common_changes!)))] + partial_scenario! + (let [sample* (|> sample + (/.add addition_count non_member) + (/.remove partial_removal_count non_member))] + (and (/.member? sample* non_member) + (n.= (n.- partial_removal_count + addition_count) + (/.multiplicity sample* non_member)))) - [/.sum n.+] - [/.union n.max] - )) - (_.cover [/.intersection] - (let [|sample| (/.support sample) - |another| (/.support another) - sample_only (set.difference |another| |sample|) - another_only (set.difference |sample| |another|) - common (set.intersection |sample| |another|) - composed (/.intersection sample another) + total_scenario! + (|> sample + (/.add addition_count non_member) + (/.remove addition_count non_member) + (\ /.equivalence = sample))] + (and null_scenario! + partial_scenario! + total_scenario!))) + (_.cover [/.from_set] + (let [unary (|> sample /.support /.from_set)] + (list.every? (|>> (/.multiplicity unary) (n.= 1)) + (/.to_list unary)))) + (_.cover [/.sub?] + (let [unary (|> sample /.support /.from_set)] + (and (/.sub? sample unary) + (or (not (/.sub? unary sample)) + (\ /.equivalence = sample unary))))) + (_.cover [/.super?] + (let [unary (|> sample /.support /.from_set)] + (and (/.super? unary sample) + (or (not (/.super? sample unary)) + (\ /.equivalence = sample unary))))) + (_.cover [/.difference] + (let [|sample| (/.support sample) + |another| (/.support another) + sample_only (set.difference |another| |sample|) + another_only (set.difference |sample| |another|) + common (set.intersection |sample| |another|) + composed (/.difference sample another) - left_removals! (list.every? (|>> (/.member? composed) not) - (set.to_list sample_only)) - right_removals! (list.every? (|>> (/.member? composed) not) - (set.to_list another_only)) - common_changes! (list.every? (function (_ member) - (n.= (n.min (/.multiplicity sample member) - (/.multiplicity another member)) - (/.multiplicity composed member))) - (set.to_list common))] - (and left_removals! - right_removals! - common_changes!))) - (_.cover [/.difference] - (let [|sample| (/.support sample) - |another| (/.support another) - sample_only (set.difference |another| |sample|) - another_only (set.difference |sample| |another|) - common (set.intersection |sample| |another|) - composed (/.difference sample another) + ommissions! (list.every? (|>> (/.member? composed) not) + (set.to_list sample_only)) + intact! (list.every? (function (_ member) + (n.= (/.multiplicity another member) + (/.multiplicity composed member))) + (set.to_list another_only)) + subtractions! (list.every? (function (_ member) + (let [sample_multiplicity (/.multiplicity sample member) + another_multiplicity (/.multiplicity another member)] + (n.= (if (n.> another_multiplicity sample_multiplicity) + 0 + (n.- sample_multiplicity + another_multiplicity)) + (/.multiplicity composed member)))) + (set.to_list common))] + (and ommissions! + intact! + subtractions!))) - ommissions! (list.every? (|>> (/.member? composed) not) - (set.to_list sample_only)) - intact! (list.every? (function (_ member) - (n.= (/.multiplicity another member) - (/.multiplicity composed member))) - (set.to_list another_only)) - subtractions! (list.every? (function (_ member) - (let [sample_multiplicity (/.multiplicity sample member) - another_multiplicity (/.multiplicity another member)] - (n.= (if (n.> another_multiplicity sample_multiplicity) - 0 - (n.- sample_multiplicity - another_multiplicity)) - (/.multiplicity composed member)))) - (set.to_list common))] - (and ommissions! - intact! - subtractions!))) - ))))) + ..signature + ..composition + )))) diff --git a/stdlib/source/test/lux/data/format/tar.lux b/stdlib/source/test/lux/data/format/tar.lux index 1300012dd..10000ff52 100644 --- a/stdlib/source/test/lux/data/format/tar.lux +++ b/stdlib/source/test/lux/data/format/tar.lux @@ -11,7 +11,7 @@ [data ["." product] ["." maybe] - ["." binary ("#\." equivalence)] + ["." binary ("#\." equivalence monoid)] ["." text ("#\." equivalence) ["%" format (#+ format)] ["." encoding] @@ -51,6 +51,8 @@ (#try.Failure error) false)) + (_.cover [/.no_path] + (text\= "" (/.from_path /.no_path))) (_.cover [/.path_size /.path_is_too_long] (case (/.path invalid) (#try.Success _) @@ -398,6 +400,15 @@ (.run /.parser) (\ try.monad map row.empty?) (try.default false))) + (_.cover [/.invalid_end_of_archive] + (let [dump (format.run /.writer row.empty)] + (case (.run /.parser (binary\compose dump dump)) + (#try.Success _) + false + + (#try.Failure error) + (exception.match? /.invalid_end_of_archive error)))) + ..path ..name ..small diff --git a/stdlib/source/test/lux/data/name.lux b/stdlib/source/test/lux/data/name.lux index f68a58d9a..62c576d27 100644 --- a/stdlib/source/test/lux/data/name.lux +++ b/stdlib/source/test/lux/data/name.lux @@ -20,15 +20,10 @@ {1 ["." /]}) -(def: (part size) - (-> Nat (Random Text)) - (random.filter (|>> (text.contains? ".") not) - (random.unicode size))) - (def: #export (random module_size short_size) (-> Nat Nat (Random Name)) - (random.and (..part module_size) - (..part short_size))) + (random.and (random.ascii/alpha module_size) + (random.ascii/alpha short_size))) (def: #export test Test diff --git a/stdlib/source/test/lux/math/number/i64.lux b/stdlib/source/test/lux/math/number/i64.lux index 43e240675..9384e08c4 100644 --- a/stdlib/source/test/lux/math/number/i64.lux +++ b/stdlib/source/test/lux/math/number/i64.lux @@ -47,40 +47,23 @@ (do {! random.monad} [pattern random.nat] ($_ _.and - (do ! - [idx (\ ! map (n.% /.width) random.nat)] - (_.cover [/.arithmetic_right_shift] - (let [value (.int pattern) - - nullity! - (\= pattern (/.arithmetic_right_shift 0 pattern)) - - idempotency! - (\= value (/.arithmetic_right_shift /.width value)) - - sign_preservation! - (bit\= (i.negative? value) - (i.negative? (/.arithmetic_right_shift idx value)))] - (and nullity! - idempotency! - sign_preservation!)))) (do ! [idx (\ ! map (|>> (n.% (dec /.width)) inc) random.nat)] - (_.cover [/.left_shift /.logic_right_shift] + (_.cover [/.left_shift /.right_shift] (let [nullity! (and (\= pattern (/.left_shift 0 pattern)) - (\= pattern (/.logic_right_shift 0 pattern))) + (\= pattern (/.right_shift 0 pattern))) idempotency! (and (\= pattern (/.left_shift /.width pattern)) - (\= pattern (/.logic_right_shift /.width pattern))) + (\= pattern (/.right_shift /.width pattern))) movement! (let [shift (n.- idx /.width)] (\= (/.and (/.mask idx) pattern) (|> pattern (/.left_shift shift) - (/.logic_right_shift shift))))] + (/.right_shift shift))))] (and nullity! idempotency! movement!)))) @@ -123,11 +106,11 @@ 0 (\= /.false (/.region size offset)) _ (\= (|> pattern ## NNNNYYYYNNNN - (/.logic_right_shift offset) + (/.right_shift offset) ## ____NNNNYYYY (/.left_shift spare) ## YYYY________ - (/.logic_right_shift spare) + (/.right_shift spare) ## ________YYYY (/.left_shift offset) ## ____YYYY____ diff --git a/stdlib/source/test/lux/math/number/int.lux b/stdlib/source/test/lux/math/number/int.lux index 3d9931ad1..c75ffb6bd 100644 --- a/stdlib/source/test/lux/math/number/int.lux +++ b/stdlib/source/test/lux/math/number/int.lux @@ -19,7 +19,9 @@ {1 ["." / [// - ["f" frac]]]}) + ["n" nat] + ["f" frac] + ["." i64]]]}) (def: signature Test @@ -178,6 +180,30 @@ [expected (\ ! map (/.% +1,000,000) random.int)] (_.cover [/.frac] (|> expected /.frac f.int (/.= expected)))) + (do {! random.monad} + [pattern random.int + idx (\ ! map (n.% i64.width) random.nat)] + (_.cover [/.right_shift] + (let [nullity! + (/.= pattern (/.right_shift 0 pattern)) + + idempotency! + (/.= pattern (/.right_shift i64.width pattern)) + + sign_mask (i64.left_shift (dec i64.width) 1) + mantissa_mask (i64.not sign_mask) + + sign_preservation! + (/.= (i64.and sign_mask pattern) + (i64.and sign_mask (/.right_shift idx pattern))) + + mantissa_parity! + (/.= (i64.and mantissa_mask (i64.right_shift idx pattern)) + (i64.and mantissa_mask (/.right_shift idx pattern)))] + (and nullity! + idempotency! + sign_preservation! + mantissa_parity!)))) ..predicate ..signature diff --git a/stdlib/source/test/lux/type/dynamic.lux b/stdlib/source/test/lux/type/dynamic.lux index 533b7fad0..e95f68146 100644 --- a/stdlib/source/test/lux/type/dynamic.lux +++ b/stdlib/source/test/lux/type/dynamic.lux @@ -37,8 +37,8 @@ (#try.Failure error) (exception.match? /.wrong_type error))) - (_.cover [/.print] - (case (/.print (/.:dynamic expected)) + (_.cover [/.format] + (case (/.format (/.:dynamic expected)) (#try.Success actual) (text\= (%.nat expected) actual) diff --git a/stdlib/source/test/lux/type/implicit.lux b/stdlib/source/test/lux/type/implicit.lux index 4978a9b3a..9ef12d3a0 100644 --- a/stdlib/source/test/lux/type/implicit.lux +++ b/stdlib/source/test/lux/type/implicit.lux @@ -1,10 +1,10 @@ (.module: [lux #* - ["%" data/text/format] ["_" test (#+ Test)] [abstract [equivalence (#+)] [functor (#+)] + [monoid (#+)] [monad (#+ do)] ["." enum]] [data @@ -18,28 +18,46 @@ {1 ["." /]}) +(/.implicit: [n.multiplication]) + (def: #export test Test - (<| (_.context (%.name (name_of /._))) + (<| (_.covering /._) (do {! random.monad} [#let [digit (\ ! map (n.% 10) random.nat)] left digit right digit #let [start (n.min left right) - end (n.max left right)]] + end (n.max left right)] + + left random.nat + right random.nat] ($_ _.and - (_.test "Can automatically select first-order structures." - (let [(^open "list\.") (list.equivalence n.equivalence)] - (and (bit\= (\ n.equivalence = left right) - (/.\\ = left right)) - (list\= (\ list.functor map inc (enum.range n.enum start end)) - (/.\\ map inc (enum.range n.enum start end)))))) - (_.test "Can automatically select second-order structures." - (/.\\ = - (enum.range n.enum start end) - (enum.range n.enum start end))) - (_.test "Can automatically select third-order structures." - (let [lln (/.\\ map (enum.range n.enum start) - (enum.range n.enum start end))] - (/.\\ = lln lln))) + (_.cover [/.\\] + (let [first_order! + (let [(^open "list\.") (list.equivalence n.equivalence)] + (and (bit\= (\ n.equivalence = left right) + (/.\\ = left right)) + (list\= (\ list.functor map inc (enum.range n.enum start end)) + (/.\\ map inc (enum.range n.enum start end))))) + + second_order! + (/.\\ = + (enum.range n.enum start end) + (enum.range n.enum start end)) + + third_order! + (let [lln (/.\\ map (enum.range n.enum start) + (enum.range n.enum start end))] + (/.\\ = lln lln))] + (and first_order! + second_order! + third_order!))) + (_.cover [/.with] + (/.with [n.addition] + (n.= (\ n.addition compose left right) + (/.\\ compose left right)))) + (_.cover [/.implicit:] + (n.= (\ n.multiplication compose left right) + (/.\\ compose left right))) )))) -- cgit v1.2.3