diff options
Diffstat (limited to 'stdlib/source/test')
-rw-r--r-- | stdlib/source/test/lux/abstract/fold.lux | 37 | ||||
-rw-r--r-- | stdlib/source/test/lux/abstract/interval.lux | 179 |
2 files changed, 122 insertions, 94 deletions
diff --git a/stdlib/source/test/lux/abstract/fold.lux b/stdlib/source/test/lux/abstract/fold.lux index 334d43e50..e954a0a38 100644 --- a/stdlib/source/test/lux/abstract/fold.lux +++ b/stdlib/source/test/lux/abstract/fold.lux @@ -1,12 +1,17 @@ (.module: [lux #* ["_" test (#+ Test)] - ["%" data/text/format (#+ format)] - ["r" math/random] - [abstract/monad (#+ do)] + [abstract + [monad (#+ do)]] [data [number - ["n" nat]]]] + ["n" nat]] + [text + ["%" format (#+ format)]] + [collection + ["." list]]] + [math + ["." random]]] [// [functor (#+ Injection Comparison)]] {1 @@ -14,10 +19,20 @@ (def: #export (spec injection comparison (^open "/@.")) (All [f] (-> (Injection f) (Comparison f) (Fold f) Test)) - (_.context (%.name (name-of /.Fold)) - (do r.monad - [subject r.nat - parameter r.nat] - (_.test "Can fold." - (n.= (/@fold n.+ parameter (injection subject)) - (n.+ parameter subject)))))) + (do random.monad + [subject random.nat + parameter random.nat] + (_.cover [/.Fold] + (n.= (/@fold n.+ parameter (injection subject)) + (n.+ parameter subject))))) + +(def: #export test + Test + (do random.monad + [samples (random.list 10 random.nat)] + (<| (_.covering /._) + ($_ _.and + (_.cover [/.with-monoid] + (n.= (:: list.fold fold (:: n.addition compose) (:: n.addition identity) samples) + (/.with-monoid n.addition list.fold samples))) + )))) diff --git a/stdlib/source/test/lux/abstract/interval.lux b/stdlib/source/test/lux/abstract/interval.lux index 1a15336f5..c6f2cd36f 100644 --- a/stdlib/source/test/lux/abstract/interval.lux +++ b/stdlib/source/test/lux/abstract/interval.lux @@ -12,23 +12,21 @@ [data [number ["n" nat]] - [text - ["%" format (#+ format)]] [collection ["." set] ["." list]]] [math - ["r" random (#+ Random)]]] + ["." random (#+ Random)]]] {1 ["." / (#+ Interval) ("#@." equivalence)]}) (template [<name> <cmp>] [(def: #export <name> (Random (Interval Nat)) - (do r.monad - [bottom r.nat - top (r.filter (|>> (n.= bottom) not) - r.nat)] + (do random.monad + [bottom random.nat + top (random.filter (|>> (n.= bottom) not) + random.nat)] (if (<cmp> top bottom) (wrap (/.between n.enum bottom top)) (wrap (/.between n.enum top bottom)))))] @@ -39,54 +37,54 @@ (def: #export singleton (Random (Interval Nat)) - (do r.monad - [point r.nat] + (do random.monad + [point random.nat] (wrap (/.singleton n.enum point)))) (def: #export interval (Random (Interval Nat)) - ($_ r.either + ($_ random.either ..inner ..outer ..singleton)) (def: types Test - (do r.monad + (do random.monad [inner ..inner outer ..outer singleton ..singleton] ($_ _.and - (_.test (%.name (name-of /.inner?)) - (/.inner? inner)) - (_.test (%.name (name-of /.outer?)) - (/.outer? outer)) - (_.test (%.name (name-of /.singleton?)) - (/.singleton? singleton)) + (_.cover [/.inner?] + (/.inner? inner)) + (_.cover [/.outer?] + (/.outer? outer)) + (_.cover [/.singleton /.singleton?] + (/.singleton? singleton)) ))) (def: boundaries Test - (do r.monad - [bottom r.nat - top r.nat + (do random.monad + [bottom random.nat + top random.nat #let [interval (/.between n.enum bottom top)]] ($_ _.and - (_.test (%.name (name-of /.within?)) - (and (/.within? interval bottom) - (/.within? interval top))) - (_.test (%.name (name-of /.starts-with?)) - (/.starts-with? bottom interval)) - (_.test (%.name (name-of /.ends-with?)) - (/.ends-with? top interval)) - (_.test (%.name (name-of /.borders?)) - (and (/.borders? interval bottom) - (/.borders? interval top))) + (_.cover [/.between /.within?] + (and (/.within? interval bottom) + (/.within? interval top))) + (_.cover [/.starts-with?] + (/.starts-with? bottom interval)) + (_.cover [/.ends-with?] + (/.ends-with? top interval)) + (_.cover [/.borders?] + (and (/.borders? interval bottom) + (/.borders? interval top))) ))) (def: union Test - (do r.monad + (do random.monad [some-interval ..interval left-inner ..inner right-inner ..inner @@ -107,7 +105,7 @@ (def: intersection Test - (do r.monad + (do random.monad [some-interval ..interval left-inner ..inner right-inner ..inner @@ -128,7 +126,7 @@ (def: complement Test - (do r.monad + (do random.monad [some-interval ..interval] ($_ _.and (_.test "The complement of a complement is the same as the original." @@ -139,8 +137,8 @@ (def: location Test - (do r.monad - [[l m r] (|> (r.set n.hash 3 r.nat) + (do random.monad + [[l m r] (|> (random.set n.hash 3 random.nat) (:: @ map (|>> set.to-list (list.sort n.<) (case> (^ (list b t1 t2)) @@ -151,18 +149,18 @@ #let [left (/.singleton n.enum l) right (/.singleton n.enum r)]] ($_ _.and - (_.test (format (%.name (name-of /.precedes?)) " &&& " (%.name (name-of /.succeeds?))) - (and (/.precedes? right left) - (/.succeeds? left right))) - (_.test (format (%.name (name-of /.before?)) " &&& " (%.name (name-of /.after?))) - (and (/.before? m left) - (/.after? m right))) + (_.cover [/.precedes? /.succeeds?] + (and (/.precedes? right left) + (/.succeeds? left right))) + (_.cover [/.before? /.after?] + (and (/.before? m left) + (/.after? m right))) ))) (def: touch Test - (do r.monad - [[b t1 t2] (|> (r.set n.hash 3 r.nat) + (do random.monad + [[b t1 t2] (|> (random.set n.hash 3 random.nat) (:: @ map (|>> set.to-list (list.sort n.<) (case> (^ (list b t1 t2)) @@ -173,23 +171,23 @@ #let [int-left (/.between n.enum t1 t2) int-right (/.between n.enum b t1)]] ($_ _.and - (_.test (%.name (name-of /.meets?)) - (/.meets? int-left int-right)) - (_.test (%.name (name-of /.touches?)) - (/.touches? int-left int-right)) - (_.test (%.name (name-of /.starts?)) - (/.starts? (/.between n.enum b t2) - (/.between n.enum b t1))) - (_.test (%.name (name-of /.finishes?)) - (/.finishes? (/.between n.enum b t2) - (/.between n.enum t1 t2))) + (_.cover [/.meets?] + (/.meets? int-left int-right)) + (_.cover [/.touches?] + (/.touches? int-left int-right)) + (_.cover [/.starts?] + (/.starts? (/.between n.enum b t2) + (/.between n.enum b t1))) + (_.cover [/.finishes?] + (/.finishes? (/.between n.enum b t2) + (/.between n.enum t1 t2))) ))) -(def: overlap +(def: nested Test - (do r.monad + (do random.monad [some-interval ..interval - [x0 x1 x2 x3] (|> (r.set n.hash 4 r.nat) + [x0 x1 x2 x3] (|> (random.set n.hash 4 random.nat) (:: @ map (|>> set.to-list (list.sort n.<) (case> (^ (list x0 x1 x2 x3)) @@ -200,18 +198,11 @@ ($_ _.and (_.test "Every interval is nested into itself." (/.nested? some-interval some-interval)) - (_.test "No interval overlaps with itself." - (not (/.overlaps? some-interval some-interval))) (let [small-inner (/.between n.enum x1 x2) large-inner (/.between n.enum x0 x3)] (_.test "Inner intervals can be nested inside one another." (and (/.nested? large-inner small-inner) (not (/.nested? small-inner large-inner))))) - (let [left-inner (/.between n.enum x0 x2) - right-inner (/.between n.enum x1 x3)] - (_.test "Inner intervals can overlap one another." - (and (/.overlaps? left-inner right-inner) - (/.overlaps? right-inner left-inner)))) (let [small-outer (/.between n.enum x2 x1) large-outer (/.between n.enum x3 x0)] (_.test "Outer intervals can be nested inside one another." @@ -223,6 +214,28 @@ (_.test "Inners can be nested inside outers." (and (/.nested? outer left-inner) (/.nested? outer right-inner)))) + ))) + +(def: overlap + Test + (do random.monad + [some-interval ..interval + [x0 x1 x2 x3] (|> (random.set n.hash 4 random.nat) + (:: @ map (|>> set.to-list + (list.sort n.<) + (case> (^ (list x0 x1 x2 x3)) + [x0 x1 x2 x3] + + _ + (undefined)))))] + ($_ _.and + (_.test "No interval overlaps with itself." + (not (/.overlaps? some-interval some-interval))) + (let [left-inner (/.between n.enum x0 x2) + right-inner (/.between n.enum x1 x3)] + (_.test "Inner intervals can overlap one another." + (and (/.overlaps? left-inner right-inner) + (/.overlaps? right-inner left-inner)))) (let [left-inner (/.between n.enum x0 x2) right-inner (/.between n.enum x1 x3) outer (/.between n.enum x1 x2)] @@ -233,31 +246,31 @@ (def: #export test Test - (<| (_.context (%.name (name-of /.Interval))) + (<| (_.covering /._) ($_ _.and - ($equivalence.spec /.equivalence ..interval) - (<| (_.context "Types.") - ..types) - (<| (_.context "Boundaries.") - ..boundaries) - (<| (_.context (%.name (name-of /.union))) - ..union) - (<| (_.context (%.name (name-of /.intersection))) - ..intersection) - (<| (_.context (%.name (name-of /.complement))) - ..complement) - (<| (_.context "Positioning/location.") - ..location) - (<| (_.context "Touching intervals.") - ..touch) - (<| (_.context "Nesting & overlap.") - ..overlap) + (_.with-cover [/.equivalence] + ($equivalence.spec /.equivalence ..interval)) + + ..types + ..boundaries + (_.with-cover [/.union] + ..union) + (_.with-cover [/.intersection] + ..intersection) + (_.with-cover [/.complement] + ..complement) + ..location + ..touch + (_.with-cover [/.nested?] + ..nested) + (_.with-cover [/.overlaps?] + ..overlap) ))) (def: #export (spec (^open "/@.") gen-sample) (All [a] (-> (Interval a) (Random a) Test)) - (<| (_.context (%.name (name-of /.Interval))) - (do r.monad + (<| (_.with-cover [/.Interval]) + (do random.monad [sample gen-sample] ($_ _.and (_.test "No value is bigger than the top." |