diff options
| -rw-r--r-- | stdlib/source/lux/control/interval.lux | 6 | ||||
| -rw-r--r-- | stdlib/source/test/lux.lux | 1 | ||||
| -rw-r--r-- | stdlib/source/test/lux/control.lux | 7 | ||||
| -rw-r--r-- | stdlib/source/test/lux/control/apply.lux | 3 | ||||
| -rw-r--r-- | stdlib/source/test/lux/control/equivalence.lux | 31 | ||||
| -rw-r--r-- | stdlib/source/test/lux/control/functor.lux | 3 | ||||
| -rw-r--r-- | stdlib/source/test/lux/control/interval.lux | 432 | ||||
| -rw-r--r-- | stdlib/source/test/lux/control/monad.lux | 3 |
8 files changed, 246 insertions, 240 deletions
diff --git a/stdlib/source/lux/control/interval.lux b/stdlib/source/lux/control/interval.lux index 940b85a21..f4faa0ea7 100644 --- a/stdlib/source/lux/control/interval.lux +++ b/stdlib/source/lux/control/interval.lux @@ -136,9 +136,9 @@ (structure: #export equivalence (All [a] (Equivalence (Interval a))) (def: (= reference sample) - (let [(^open ".") reference] - (and (= bottom (:: sample bottom)) - (= top (:: sample top)))))) + (let [(^open "_/.") reference] + (and (_/= _/bottom (:: sample bottom)) + (_/= _/top (:: sample top)))))) (def: #export (nested? reference sample) (All [a] (-> (Interval a) (Interval a) Bit)) diff --git a/stdlib/source/test/lux.lux b/stdlib/source/test/lux.lux index 51f5c8277..7f5253955 100644 --- a/stdlib/source/test/lux.lux +++ b/stdlib/source/test/lux.lux @@ -96,7 +96,6 @@ ["/." jvm]] ["/." control]] ## [control - ## ## [interval (#+)] ## ## [pipe (#+)] ## ## [continuation (#+)] ## ## [reader (#+)] diff --git a/stdlib/source/test/lux/control.lux b/stdlib/source/test/lux/control.lux index f50bdf7a7..6c2204fbc 100644 --- a/stdlib/source/test/lux/control.lux +++ b/stdlib/source/test/lux/control.lux @@ -2,10 +2,13 @@ [lux #* ["_" test (#+ Test)]] [/ - ["/." exception]]) + ["/." exception] + ["/." interval]]) (def: #export test Test ($_ _.and (<| (_.context "/exception Exception-handling.") - /exception.test))) + /exception.test) + (<| (_.context "/interval") + /interval.test))) diff --git a/stdlib/source/test/lux/control/apply.lux b/stdlib/source/test/lux/control/apply.lux index 01fb33797..e703ac416 100644 --- a/stdlib/source/test/lux/control/apply.lux +++ b/stdlib/source/test/lux/control/apply.lux @@ -2,6 +2,7 @@ [lux #* [control [monad (#+ do)]] + data/text/format ["." function] [math ["r" random]] @@ -60,7 +61,7 @@ (def: #export (laws apply injection comparison) (All [f] (-> (Apply f) (Injection f) (Comparison f) Test)) - (_.context "Apply laws." + (_.context (%name (name-of /.Apply)) ($_ _.and (..identity apply injection comparison) (..homomorphism apply injection comparison) diff --git a/stdlib/source/test/lux/control/equivalence.lux b/stdlib/source/test/lux/control/equivalence.lux index daa2c81b3..714905c41 100644 --- a/stdlib/source/test/lux/control/equivalence.lux +++ b/stdlib/source/test/lux/control/equivalence.lux @@ -1,21 +1,24 @@ (.module: [lux #* + ["_" test (#+ Test)] [control - ["/" equivalence] [monad (#+ do)]] + data/text/format [math - ["r" random]] - test]) + ["r" random (#+ Random)]]] + {1 + ["." / (#+ Equivalence)]}) -(def: #export (spec Equivalence<a> generator) - (All [a] (-> (/.Equivalence a) (r.Random a) Test)) +(def: #export (test (^open "_/.") generator) + (All [a] (-> (Equivalence a) (Random a) Test)) (do r.monad - [sample generator - another generator] - ($_ seq - (test "Equivalence is reflexive." - (:: Equivalence<a> = sample sample)) - (test "Equivalence is symmetric." - (if (:: Equivalence<a> = sample another) - (:: Equivalence<a> = another sample) - #1))))) + [left generator + right generator] + (<| (_.context (%name (name-of /.Equivalence))) + ($_ _.and + (_.test "Reflexivity." + (_/= left left)) + (_.test "Symmetry." + (if (_/= left right) + (_/= right left) + (not (_/= right left)))))))) diff --git a/stdlib/source/test/lux/control/functor.lux b/stdlib/source/test/lux/control/functor.lux index a93edc291..66de9d57e 100644 --- a/stdlib/source/test/lux/control/functor.lux +++ b/stdlib/source/test/lux/control/functor.lux @@ -2,6 +2,7 @@ [lux #* [control [monad (#+ do)]] + data/text/format ["." function] [math ["r" random]] @@ -49,7 +50,7 @@ (def: #export (laws functor injection comparison) (All [f] (-> (Functor f) (Injection f) (Comparison f) Test)) - (_.context "Functor laws." + (_.context (%name (name-of /.Functor)) ($_ _.and (..identity functor injection comparison) (..homomorphism functor injection comparison) diff --git a/stdlib/source/test/lux/control/interval.lux b/stdlib/source/test/lux/control/interval.lux index 6d00a36e9..30d0dfa50 100644 --- a/stdlib/source/test/lux/control/interval.lux +++ b/stdlib/source/test/lux/control/interval.lux @@ -1,235 +1,233 @@ (.module: - lux/test [lux #* + ["_" test (#+ Test)] [control - ["M" monad (#+ do Monad)] - pipe - ["&" interval]] - [math - ["r" random]] + [pipe (#+ case>)] + [monad (#+ do)]] [data - ["." number] + [number + ["." nat]] [collection - ["S" set] - ["L" list]]]]) - -(context: "Equivalence." - (<| (times 100) - (do @ - [bottom r.int - top r.int - #let [(^open "&/.") &.equivalence]] - ($_ seq - (test "Every interval is equal to itself." - (and (let [self (&.between number.enum bottom top)] - (&/= self self)) - (let [self (&.between number.enum top bottom)] - (&/= self self)) - (let [self (&.singleton number.enum bottom)] - (&/= self self)))))))) - -(context: "Boundaries" - (<| (times 100) - (do @ - [bottom r.int - top r.int - #let [interval (&.between number.enum bottom top)]] - ($_ seq - (test "Every boundary value belongs to it's interval." - (and (&.within? interval bottom) - (&.within? interval top))) - (test "Every interval starts with its bottom." - (&.starts-with? bottom interval)) - (test "Every interval ends with its top." - (&.ends-with? top interval)) - (test "The boundary values border the interval." - (and (&.borders? interval bottom) - (&.borders? interval top))) - )))) - -(def: (list-to-4tuple list) - (-> (List Int) [Int Int Int Int]) - (case list - (^ (list x0 x1 x2 x3)) - [x0 x1 x2 x3] - - _ - (undefined))) - + ["." set] + ["." list]]] + [math + ["r" random (#+ Random)]]] + {1 + ["." / (#+ Interval) ("_/." equivalence)]} + {0 + [test + [lux + [control + [".T" equivalence]]]]}) (do-template [<name> <cmp>] - [(def: <name> - (r.Random (&.Interval Int)) + [(def: #export <name> + (Random (Interval Nat)) (do r.monad - [bottom r.int - top (|> r.int (r.filter (|>> (i/= bottom) not)))] + [bottom r.nat + top (|> r.nat (r.filter (|>> (n/= bottom) not)))] (if (<cmp> top bottom) - (wrap (&.between number.enum bottom top)) - (wrap (&.between number.enum top bottom)))))] + (wrap (/.between nat.enum bottom top)) + (wrap (/.between nat.enum top bottom)))))] - [gen-inner i/<] - [gen-outer i/>] + [inner n/<] + [outer n/>] ) -(def: gen-singleton - (r.Random (&.Interval Int)) +(def: #export singleton + (Random (Interval Nat)) (do r.monad - [point r.int] - (wrap (&.singleton number.enum point)))) + [point r.nat] + (wrap (/.singleton nat.enum point)))) -(def: gen-interval - (r.Random (&.Interval Int)) +(def: #export interval + (Random (Interval Nat)) ($_ r.either - gen-inner - gen-outer - gen-singleton)) - -(context: "Unions" - (<| (times 100) - (do @ - [some-interval gen-interval - left-inner gen-inner - right-inner gen-inner - left-singleton gen-singleton - right-singleton gen-singleton - left-outer gen-outer - right-outer gen-outer - #let [(^open "&/.") &.equivalence]] - ($_ seq - (test "The union of an interval to itself yields the same interval." - (&/= some-interval (&.union some-interval some-interval))) - (test "The union of 2 inner intervals is another inner interval." - (&.inner? (&.union left-inner right-inner))) - (test "The union of 2 outer intervals yields an inner interval when their complements don't overlap, and an outer when they do." - (if (&.overlaps? (&.complement left-outer) (&.complement right-outer)) - (&.outer? (&.union left-outer right-outer)) - (&.inner? (&.union left-outer right-outer)))) - )))) - -(context: "Intersections" - (<| (times 100) - (do @ - [some-interval gen-interval - left-inner gen-inner - right-inner gen-inner - left-singleton gen-singleton - right-singleton gen-singleton - left-outer gen-outer - right-outer gen-outer - #let [(^open "&/.") &.equivalence]] - ($_ seq - (test "The intersection of an interval to itself yields the same interval." - (&/= some-interval (&.intersection some-interval some-interval))) - (test "The intersection of 2 inner intervals yields an inner interval when they overlap, and an outer when they don't." - (if (&.overlaps? left-inner right-inner) - (&.inner? (&.intersection left-inner right-inner)) - (&.outer? (&.intersection left-inner right-inner)))) - (test "The intersection of 2 outer intervals is another outer interval." - (&.outer? (&.intersection left-outer right-outer))) - )))) - -(context: "Complement" - (<| (times 100) - (do @ - [some-interval gen-interval - #let [(^open "&/.") &.equivalence]] - ($_ seq - (test "The complement of a complement is the same as the original." - (&/= some-interval (|> some-interval &.complement &.complement))) - (test "The complement of an interval does not overlap it." - (not (&.overlaps? some-interval (&.complement some-interval)))) - )))) - -(context: "Positioning/location" - (<| (times 100) - (do @ - [[l m r] (|> (r.set number.hash 3 r.int) - (:: @ map (|>> S.to-list - (L.sort i/<) - (case> (^ (list b t1 t2)) - [b t1 t2] + ..inner + ..outer + ..singleton)) - _ - (undefined))))) - #let [left (&.singleton number.enum l) - right (&.singleton number.enum r)]] - ($_ seq - (test "'precedes?' and 'succeeds?' are symetric." - (and (&.precedes? right left) - (&.succeeds? left right))) - (test "Can check if an interval is before or after some element." - (and (&.before? m left) - (&.after? m right))) - )))) - -(context: "Touching intervals" - (<| (times 100) - (do @ - [[b t1 t2] (|> (r.set number.hash 3 r.int) - (:: @ map (|>> S.to-list - (L.sort i/<) - (case> (^ (list b t1 t2)) - [b t1 t2] +(def: boundaries + Test + (do r.monad + [bottom r.nat + top r.nat + #let [interval (/.between nat.enum bottom top)]] + ($_ _.and + (_.test "A boundary value belongs to its interval." + (and (/.within? interval bottom) + (/.within? interval top))) + (_.test "An interval starts with its bottom." + (/.starts-with? bottom interval)) + (_.test "An interval ends with its top." + (/.ends-with? top interval)) + (_.test "The boundary values border the interval." + (and (/.borders? interval bottom) + (/.borders? interval top))) + ))) + +(def: union + Test + (do r.monad + [some-interval ..interval + left-inner ..inner + right-inner ..inner + left-singleton ..singleton + right-singleton ..singleton + left-outer ..outer + right-outer ..outer] + ($_ _.and + (_.test "The union of an interval to itself yields the same interval." + (_/= some-interval (/.union some-interval some-interval))) + (_.test "The union of 2 inner intervals is another inner interval." + (/.inner? (/.union left-inner right-inner))) + (_.test "The union of 2 outer intervals yields an inner interval when their complements don't overlap, and an outer when they do." + (if (/.overlaps? (/.complement left-outer) (/.complement right-outer)) + (/.outer? (/.union left-outer right-outer)) + (/.inner? (/.union left-outer right-outer)))) + ))) + +(def: intersection + Test + (do r.monad + [some-interval ..interval + left-inner ..inner + right-inner ..inner + left-singleton ..singleton + right-singleton ..singleton + left-outer ..outer + right-outer ..outer] + ($_ _.and + (_.test "The intersection of an interval to itself yields the same interval." + (_/= some-interval (/.intersection some-interval some-interval))) + (_.test "The intersection of 2 inner intervals yields an inner interval when they overlap, and an outer when they don't." + (if (/.overlaps? left-inner right-inner) + (/.inner? (/.intersection left-inner right-inner)) + (/.outer? (/.intersection left-inner right-inner)))) + (_.test "The intersection of 2 outer intervals is another outer interval." + (/.outer? (/.intersection left-outer right-outer))) + ))) + +(def: complement + Test + (do r.monad + [some-interval ..interval] + ($_ _.and + (_.test "The complement of a complement is the same as the original." + (_/= some-interval (|> some-interval /.complement /.complement))) + (_.test "The complement of an interval does not overlap it." + (not (/.overlaps? some-interval (/.complement some-interval)))) + ))) + +(def: location + Test + (do r.monad + [[l m r] (|> (r.set nat.hash 3 r.nat) + (:: @ map (|>> set.to-list + (list.sort n/<) + (case> (^ (list b t1 t2)) + [b t1 t2] + + _ + (undefined))))) + #let [left (/.singleton nat.enum l) + right (/.singleton nat.enum r)]] + ($_ _.and + (_.test "'precedes?' and 'succeeds?' are symetric." + (and (/.precedes? right left) + (/.succeeds? left right))) + (_.test "Can check if an interval is before or after some element." + (and (/.before? m left) + (/.after? m right))) + ))) + +(def: touch + Test + (do r.monad + [[b t1 t2] (|> (r.set nat.hash 3 r.nat) + (:: @ map (|>> set.to-list + (list.sort n/<) + (case> (^ (list b t1 t2)) + [b t1 t2] + + _ + (undefined))))) + #let [int-left (/.between nat.enum t1 t2) + int-right (/.between nat.enum b t1)]] + ($_ _.and + (_.test "An interval meets another if its top is the other's bottom." + (/.meets? int-left int-right)) + (_.test "Two intervals touch one another if any one meets the other." + (/.touches? int-left int-right)) + (_.test "Can check if 2 intervals start together." + (/.starts? (/.between nat.enum b t2) + (/.between nat.enum b t1))) + (_.test "Can check if 2 intervals finish together." + (/.finishes? (/.between nat.enum b t2) + (/.between nat.enum t1 t2))) + ))) + +(def: overlap + Test + (do r.monad + [some-interval ..interval + [x0 x1 x2 x3] (|> (r.set nat.hash 4 r.nat) + (:: @ map (|>> set.to-list + (list.sort n/<) + (case> (^ (list x0 x1 x2 x3)) + [x0 x1 x2 x3] _ - (undefined))))) - #let [int-left (&.between number.enum t1 t2) - int-right (&.between number.enum b t1)]] - ($_ seq - (test "An interval meets another if it's top is the other's bottom." - (&.meets? int-left int-right)) - (test "Two intervals touch one another if any one meets the other." - (&.touches? int-left int-right)) - (test "Can check if 2 intervals start together." - (&.starts? (&.between number.enum b t2) - (&.between number.enum b t1))) - (test "Can check if 2 intervals finish together." - (&.finishes? (&.between number.enum b t2) - (&.between number.enum t1 t2))) - )))) - -(context: "Nesting & overlap" - (<| (times 100) - (do @ - [some-interval gen-interval - [x0 x1 x2 x3] (|> (r.set number.hash 4 r.int) - (:: @ map (|>> S.to-list - (L.sort i/<) - (case> (^ (list x0 x1 x2 x3)) - [x0 x1 x2 x3] - - _ - (undefined)))))] - ($_ seq - (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 number.enum x1 x2) - large-inner (&.between number.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 number.enum x0 x2) - right-inner (&.between number.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 number.enum x2 x1) - large-outer (&.between number.enum x3 x0)] - (test "Outer intervals can be nested inside one another." - (and (&.nested? small-outer large-outer) - (not (&.nested? large-outer small-outer))))) - (let [left-inner (&.between number.enum x0 x1) - right-inner (&.between number.enum x2 x3) - outer (&.between number.enum x0 x3)] - (test "Inners can be nested inside outers." - (and (&.nested? outer left-inner) - (&.nested? outer right-inner)))) - (let [left-inner (&.between number.enum x0 x2) - right-inner (&.between number.enum x1 x3) - outer (&.between number.enum x1 x2)] - (test "Inners can overlap outers." - (and (&.overlaps? outer left-inner) - (&.overlaps? outer right-inner)))) - )))) + (undefined)))))] + ($_ _.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 nat.enum x1 x2) + large-inner (/.between nat.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 nat.enum x0 x2) + right-inner (/.between nat.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 nat.enum x2 x1) + large-outer (/.between nat.enum x3 x0)] + (_.test "Outer intervals can be nested inside one another." + (and (/.nested? small-outer large-outer) + (not (/.nested? large-outer small-outer))))) + (let [left-inner (/.between nat.enum x0 x1) + right-inner (/.between nat.enum x2 x3) + outer (/.between nat.enum x0 x3)] + (_.test "Inners can be nested inside outers." + (and (/.nested? outer left-inner) + (/.nested? outer right-inner)))) + (let [left-inner (/.between nat.enum x0 x2) + right-inner (/.between nat.enum x1 x3) + outer (/.between nat.enum x1 x2)] + (_.test "Inners can overlap outers." + (and (/.overlaps? outer left-inner) + (/.overlaps? outer right-inner)))) + ))) + +(def: #export test + Test + ($_ _.and + (equivalenceT.test /.equivalence ..interval) + (<| (_.context "Boundaries.") + ..boundaries) + (<| (_.context "Union.") + ..union) + (<| (_.context "Intersection.") + ..intersection) + (<| (_.context "Complement.") + ..complement) + (<| (_.context "Positioning/location.") + ..location) + (<| (_.context "Touching intervals.") + ..touch) + (<| (_.context "Nesting & overlap.") + ..overlap))) diff --git a/stdlib/source/test/lux/control/monad.lux b/stdlib/source/test/lux/control/monad.lux index 412f3ab94..00a31d2d5 100644 --- a/stdlib/source/test/lux/control/monad.lux +++ b/stdlib/source/test/lux/control/monad.lux @@ -1,5 +1,6 @@ (.module: [lux #* + data/text/format ["." function] [math ["r" random]] @@ -47,7 +48,7 @@ (def: #export (laws monad injection comparison) (All [f] (-> (Monad f) (Injection f) (Comparison f) Test)) - (_.context "Monad laws." + (_.context (%name (name-of /.Monad)) ($_ _.and (..left-identity monad injection comparison) (..right-identity monad injection comparison) |