From c542e618266c2f321704bef381b14213c30cc2e0 Mon Sep 17 00:00:00 2001
From: Eduardo Julian
Date: Tue, 5 Feb 2019 19:54:18 -0400
Subject: Ported tests for lux/control/interval to the new format.
---
stdlib/source/lux/control/interval.lux | 6 +-
stdlib/source/test/lux.lux | 1 -
stdlib/source/test/lux/control.lux | 7 +-
stdlib/source/test/lux/control/apply.lux | 3 +-
stdlib/source/test/lux/control/equivalence.lux | 31 +-
stdlib/source/test/lux/control/functor.lux | 3 +-
stdlib/source/test/lux/control/interval.lux | 432 ++++++++++++-------------
stdlib/source/test/lux/control/monad.lux | 3 +-
8 files changed, 246 insertions(+), 240 deletions(-)
(limited to 'stdlib')
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 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 = sample sample))
- (test "Equivalence is symmetric."
- (if (:: Equivalence = sample another)
- (:: Equivalence = 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 [ ]
- [(def:
- (r.Random (&.Interval Int))
+ [(def: #export
+ (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 ( 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)
--
cgit v1.2.3