aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/test
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--stdlib/source/test/lux/control/continuation.lux14
-rw-r--r--stdlib/source/test/lux/control/reader.lux4
-rw-r--r--stdlib/source/test/lux/control/region.lux42
-rw-r--r--stdlib/source/test/lux/control/state.lux4
-rw-r--r--stdlib/source/test/lux/data/color.lux6
-rw-r--r--stdlib/source/test/lux/data/number/complex.lux332
-rw-r--r--stdlib/source/test/lux/data/number/ratio.lux4
-rw-r--r--stdlib/source/test/lux/data/text.lux20
-rw-r--r--stdlib/source/test/lux/host.jvm.lux4
-rw-r--r--stdlib/source/test/lux/host.old.lux4
-rw-r--r--stdlib/source/test/lux/macro/poly/equivalence.lux4
-rw-r--r--stdlib/source/test/lux/meta/annotation.lux5
-rw-r--r--stdlib/source/test/lux/time/duration.lux6
-rw-r--r--stdlib/source/test/lux/world/file.lux9
-rw-r--r--stdlib/source/test/lux/world/file/watch.lux155
15 files changed, 429 insertions, 184 deletions
diff --git a/stdlib/source/test/lux/control/continuation.lux b/stdlib/source/test/lux/control/continuation.lux
index 99b56cfdc..0c09dcb23 100644
--- a/stdlib/source/test/lux/control/continuation.lux
+++ b/stdlib/source/test/lux/control/continuation.lux
@@ -32,8 +32,8 @@
(<| (_.covering /._)
(do random.monad
[sample random.nat
- #let [(^open "_@.") /.apply
- (^open "_@.") /.monad]
+ #let [(^open "_\.") /.apply
+ (^open "_\.") /.monad]
elems (random.list 3 random.nat)])
(_.with-cover [/.Cont])
($_ _.and
@@ -45,7 +45,7 @@
($monad.spec ..injection ..comparison /.monad))
(_.cover [/.run]
- (n.= sample (/.run (_@wrap sample))))
+ (n.= sample (/.run (_\wrap sample))))
(_.cover [/.call/cc]
(n.= (n.* 2 sample)
(/.run (do {! /.monad}
@@ -66,14 +66,14 @@
(restart [(n.+ 10 output) (inc idx)])
(wrap output))))))
(_.cover [/.shift /.reset]
- (let [(^open "_@.") /.monad
- (^open "list@.") (list.equivalence n.equivalence)
+ (let [(^open "_\.") /.monad
+ (^open "list\.") (list.equivalence n.equivalence)
visit (: (-> (List Nat)
(/.Cont (List Nat) (List Nat)))
(function (visit xs)
(case xs
#.Nil
- (_@wrap #.Nil)
+ (_\wrap #.Nil)
(#.Cons x xs')
(do {! /.monad}
@@ -82,7 +82,7 @@
[tail (k xs')]
(wrap (#.Cons x tail)))))]
(visit output)))))]
- (list@= elems
+ (list\= elems
(/.run (/.reset (visit elems))))))
(_.cover [/.continue]
(/.continue (is? sample)
diff --git a/stdlib/source/test/lux/control/reader.lux b/stdlib/source/test/lux/control/reader.lux
index 7b6a8a8c3..f211948e4 100644
--- a/stdlib/source/test/lux/control/reader.lux
+++ b/stdlib/source/test/lux/control/reader.lux
@@ -49,11 +49,11 @@
(_.cover [/.local]
(n.= (n.* factor sample)
(/.run sample (/.local (n.* factor) /.ask))))
- (let [(^open "io@.") io.monad]
+ (let [(^open "io\.") io.monad]
(_.cover [/.with /.lift]
(|> (: (/.Reader Any (IO Nat))
(do (/.with io.monad)
- [a (/.lift (io@wrap sample))
+ [a (/.lift (io\wrap sample))
b (wrap factor)]
(wrap (n.* b a))))
(/.run [])
diff --git a/stdlib/source/test/lux/control/region.lux b/stdlib/source/test/lux/control/region.lux
index 691bcbbce..d9f28e5db 100644
--- a/stdlib/source/test/lux/control/region.lux
+++ b/stdlib/source/test/lux/control/region.lux
@@ -26,23 +26,27 @@
["." / (#+ Region)
[//
["." thread (#+ Thread)]
- ["." exception (#+ exception:)]]]})
+ ["." exception (#+ Exception exception:)]]]})
(exception: oops)
-(template [<name> <success> <error>]
- [(def: (<name> result)
- (All [a] (-> (Try a) Bit))
- (case result
- (#try.Success _)
- <success>
-
- (#try.Failure _)
- <error>))]
+(def: (success? result)
+ (All [a] (-> (Try a) Bit))
+ (case result
+ (#try.Success _)
+ true
+
+ (#try.Failure _)
+ false))
- [success? #1 #0]
- [failure? #0 #1]
- )
+(def: (throws? exception result)
+ (All [e a] (-> (Exception e) (Try a) Bit))
+ (case result
+ (#try.Success _)
+ false
+
+ (#try.Failure error)
+ (exception.match? exception error)))
(def: (injection value)
(Injection (All [a] (All [! r] (Region r (Thread !) a))))
@@ -105,7 +109,7 @@
(enum.range n.enum 1 expected-clean-ups))]
(wrap [])))
actual-clean-ups (thread.read clean-up-counter)]
- (wrap (and (success? outcome)
+ (wrap (and (..success? outcome)
(n.= expected-clean-ups
actual-clean-ups))))))
(_.cover [/.fail]
@@ -124,7 +128,7 @@
_ (/.fail //@ (exception.construct ..oops []))]
(wrap [])))
actual-clean-ups (thread.read clean-up-counter)]
- (wrap (and (failure? outcome)
+ (wrap (and (..throws? ..oops outcome)
(n.= expected-clean-ups
actual-clean-ups))))))
(_.cover [/.throw]
@@ -143,10 +147,10 @@
_ (/.throw //@ ..oops [])]
(wrap [])))
actual-clean-ups (thread.read clean-up-counter)]
- (wrap (and (failure? outcome)
+ (wrap (and (..throws? ..oops outcome)
(n.= expected-clean-ups
actual-clean-ups))))))
- (_.cover [/.acquire]
+ (_.cover [/.acquire /.clean-up-error]
(thread.run
(do {! thread.monad}
[clean-up-counter (thread.box 0)
@@ -163,7 +167,7 @@
(wrap [])))
actual-clean-ups (thread.read clean-up-counter)]
(wrap (and (or (n.= 0 expected-clean-ups)
- (failure? outcome))
+ (..throws? /.clean-up-error outcome))
(n.= expected-clean-ups
actual-clean-ups))))))
(_.cover [/.lift]
@@ -176,7 +180,7 @@
[_ (/.lift //@ (thread.write expected-clean-ups clean-up-counter))]
(wrap [])))
actual-clean-ups (thread.read clean-up-counter)]
- (wrap (and (success? outcome)
+ (wrap (and (..success? outcome)
(n.= expected-clean-ups
actual-clean-ups))))))
))))
diff --git a/stdlib/source/test/lux/control/state.lux b/stdlib/source/test/lux/control/state.lux
index ffac9570f..3e30afab0 100644
--- a/stdlib/source/test/lux/control/state.lux
+++ b/stdlib/source/test/lux/control/state.lux
@@ -109,11 +109,11 @@
[state random.nat
left random.nat
right random.nat]
- (let [(^open "io@.") io.monad]
+ (let [(^open "io\.") io.monad]
(_.cover [/.State' /.with /.lift /.run']
(|> (: (/.State' io.IO Nat Nat)
(do (/.with io.monad)
- [a (/.lift io.monad (io@wrap left))
+ [a (/.lift io.monad (io\wrap left))
b (wrap right)]
(wrap (n.+ a b))))
(/.run' state)
diff --git a/stdlib/source/test/lux/data/color.lux b/stdlib/source/test/lux/data/color.lux
index d81ff7220..77b3652a1 100644
--- a/stdlib/source/test/lux/data/color.lux
+++ b/stdlib/source/test/lux/data/color.lux
@@ -187,9 +187,9 @@
(..encoding expected)
(_.cover [/.complement]
(let [~expected (/.complement expected)
- (^open "/@.") /.equivalence]
- (and (not (/@= expected ~expected))
- (/@= expected (/.complement ~expected)))))
+ (^open "/\.") /.equivalence]
+ (and (not (/\= expected ~expected))
+ (/\= expected (/.complement ~expected)))))
(_.cover [/.black /.white]
(and (:: /.equivalence = /.white (/.complement /.black))
(:: /.equivalence = /.black (/.complement /.white))))
diff --git a/stdlib/source/test/lux/data/number/complex.lux b/stdlib/source/test/lux/data/number/complex.lux
index 13497bfa5..6b623388c 100644
--- a/stdlib/source/test/lux/data/number/complex.lux
+++ b/stdlib/source/test/lux/data/number/complex.lux
@@ -17,190 +17,270 @@
[collection
["." list ("#\." functor)]]]
["." math
- ["r" random (#+ Random)]]]
+ ["." random (#+ Random)]]]
{1
- ["." / (#+ Complex)]})
+ ["." /]})
-(def: margin-of-error Frac +0.000000001)
-
-(def: (within? margin standard value)
- (-> Frac Complex Complex Bit)
- (let [real-dist (f.abs (f.- (get@ #/.real standard)
- (get@ #/.real value)))
- imgn-dist (f.abs (f.- (get@ #/.imaginary standard)
- (get@ #/.imaginary value)))]
- (and (f.< margin real-dist)
- (f.< margin imgn-dist))))
+(def: margin-of-error
+ +0.000000001)
(def: dimension
(Random Frac)
- (do {! r.monad}
- [factor (|> r.nat (:: ! map (|>> (n.% 1000) (n.max 1))))
- measure (|> r.safe-frac (r.filter (f.> +0.0)))]
+ (do {! random.monad}
+ [factor (|> random.nat (:: ! map (|>> (n.% 1000) (n.max 1))))
+ measure (|> random.safe-frac (random.filter (f.> +0.0)))]
(wrap (f.* (|> factor .int int.frac)
measure))))
-(def: #export complex
- (Random Complex)
- (do r.monad
+(def: #export random
+ (Random /.Complex)
+ (do random.monad
[real ..dimension
imaginary ..dimension]
(wrap (/.complex real imaginary))))
+(def: angle
+ (Random /.Complex)
+ (:: random.monad map
+ (|>> (update@ #/.real (f.% +1.0))
+ (update@ #/.imaginary (f.% +1.0)))
+ ..random))
+
(def: construction
Test
- (do r.monad
+ (do random.monad
[real ..dimension
imaginary ..dimension]
($_ _.and
- (_.test "Can build and tear apart complex numbers"
- (let [r+i (/.complex real imaginary)]
- (and (f.= real (get@ #/.real r+i))
- (f.= imaginary (get@ #/.imaginary r+i)))))
- (_.test "If either the real part or the imaginary part is NaN, the composite is NaN."
- (and (/.not-a-number? (/.complex f.not-a-number imaginary))
- (/.not-a-number? (/.complex real f.not-a-number))))
+ (_.cover [/.complex]
+ (and (let [r+i (/.complex real imaginary)]
+ (and (f.= real (get@ #/.real r+i))
+ (f.= imaginary (get@ #/.imaginary r+i))))
+ (let [r+i (/.complex real)]
+ (and (f.= real (get@ #/.real r+i))
+ (f.= +0.0 (get@ #/.imaginary r+i))))))
+ (_.cover [/.within?]
+ (/.within? ..margin-of-error
+ (/.complex real imaginary)
+ (/.complex real imaginary)))
+ (_.cover [/.not-a-number?]
+ (and (/.not-a-number? (/.complex f.not-a-number imaginary))
+ (/.not-a-number? (/.complex real f.not-a-number))))
+ )))
+
+(def: constant
+ Test
+ (do random.monad
+ [sample ..random
+ dimension ..dimension]
+ ($_ _.and
+ (_.cover [/.zero]
+ (/.= /.zero (/.* /.zero sample)))
+ (_.cover [/.+one]
+ (/.= sample (/.* /.+one sample)))
+ (_.cover [/.-one]
+ (and (/.= /.zero
+ (/.+ sample
+ (/.* /.-one sample)))
+ (/.= sample (/.* /.-one (/.* /.-one sample)))))
+ (_.cover [/.i]
+ (and (/.= (/.complex +0.0 dimension)
+ (/.* /.i (/.complex dimension)))
+ (/.= (/.* /.-one sample)
+ (/.* /.i (/.* /.i sample)))))
)))
-(def: absolute-value
+(def: absolute-value&argument
Test
- (do r.monad
+ (do random.monad
[real ..dimension
imaginary ..dimension]
($_ _.and
- (_.test "Absolute value of complex >= absolute value of any of the parts."
- (let [r+i (/.complex real imaginary)
- abs (get@ #/.real (/.abs r+i))]
- (and (f.>= (f.abs real) abs)
- (f.>= (f.abs imaginary) abs))))
- (_.test "The absolute value of a complex number involving a NaN on either dimension, results in a NaN value."
- (and (f.not-a-number? (get@ #/.real (/.abs (/.complex f.not-a-number imaginary))))
- (f.not-a-number? (get@ #/.real (/.abs (/.complex real f.not-a-number))))))
- (_.test "The absolute value of a complex number involving an infinity on either dimension, results in an infinite value."
- (and (f.= f.positive-infinity (get@ #/.real (/.abs (/.complex f.positive-infinity imaginary))))
- (f.= f.positive-infinity (get@ #/.real (/.abs (/.complex real f.positive-infinity))))
- (f.= f.positive-infinity (get@ #/.real (/.abs (/.complex f.negative-infinity imaginary))))
- (f.= f.positive-infinity (get@ #/.real (/.abs (/.complex real f.negative-infinity))))))
+ (_.cover [/.abs]
+ (let [normal!
+ (let [r+i (/.complex real imaginary)]
+ (and (f.>= (f.abs real) (/.abs r+i))
+ (f.>= (f.abs imaginary) (/.abs r+i))))
+
+ not-a-number!
+ (and (f.not-a-number? (/.abs (/.complex f.not-a-number imaginary)))
+ (f.not-a-number? (/.abs (/.complex real f.not-a-number))))
+
+ infinity!
+ (and (f.= f.positive-infinity (/.abs (/.complex f.positive-infinity imaginary)))
+ (f.= f.positive-infinity (/.abs (/.complex real f.positive-infinity)))
+ (f.= f.positive-infinity (/.abs (/.complex f.negative-infinity imaginary)))
+ (f.= f.positive-infinity (/.abs (/.complex real f.negative-infinity))))]
+ (and normal!
+ not-a-number!
+ infinity!)))
+ ## https://en.wikipedia.org/wiki/Argument_(complex_analysis)#Identities
+ (_.cover [/.argument]
+ (let [sample (/.complex real imaginary)]
+ (or (/.= /.zero sample)
+ (/.within? ..margin-of-error
+ sample
+ (/.*' (/.abs sample)
+ (/.exp (/.* /.i (/.complex (/.argument sample)))))))))
)))
(def: number
Test
- (do r.monad
- [x ..complex
- y ..complex
+ (do random.monad
+ [x ..random
+ y ..random
factor ..dimension]
($_ _.and
- (_.test "Adding 2 complex numbers is the same as adding their parts."
- (let [z (/.+ y x)]
- (and (/.= z
- (/.complex (f.+ (get@ #/.real y)
- (get@ #/.real x))
- (f.+ (get@ #/.imaginary y)
- (get@ #/.imaginary x)))))))
- (_.test "Subtracting 2 complex numbers is the same as adding their parts."
- (let [z (/.- y x)]
- (and (/.= z
- (/.complex (f.- (get@ #/.real y)
- (get@ #/.real x))
- (f.- (get@ #/.imaginary y)
- (get@ #/.imaginary x)))))))
- (_.test "Subtraction is the inverse of addition."
- (and (|> x (/.+ y) (/.- y) (within? margin-of-error x))
- (|> x (/.- y) (/.+ y) (within? margin-of-error x))))
- (_.test "Division is the inverse of multiplication."
- (|> x (/.* y) (/./ y) (within? margin-of-error x)))
- (_.test "Scalar division is the inverse of scalar multiplication."
- (|> x (/.*' factor) (/./' factor) (within? margin-of-error x)))
- (_.test "If you subtract the remainder, all divisions must be exact."
- (let [rem (/.% y x)
- quotient (|> x (/.- rem) (/./ y))
- floored (|> quotient
- (update@ #/.real math.floor)
- (update@ #/.imaginary math.floor))]
- (within? +0.000000000001
- x
- (|> quotient (/.* y) (/.+ rem)))))
+ (_.cover [/.+]
+ (let [z (/.+ y x)]
+ (and (/.= z
+ (/.complex (f.+ (get@ #/.real y)
+ (get@ #/.real x))
+ (f.+ (get@ #/.imaginary y)
+ (get@ #/.imaginary x)))))))
+ (_.cover [/.-]
+ (let [normal!
+ (let [z (/.- y x)]
+ (and (/.= z
+ (/.complex (f.- (get@ #/.real y)
+ (get@ #/.real x))
+ (f.- (get@ #/.imaginary y)
+ (get@ #/.imaginary x))))))
+
+ inverse!
+ (and (|> x (/.+ y) (/.- y) (/.within? ..margin-of-error x))
+ (|> x (/.- y) (/.+ y) (/.within? ..margin-of-error x)))]
+ (and normal!
+ inverse!)))
+ (_.cover [/.* /./]
+ (|> x (/.* y) (/./ y) (/.within? ..margin-of-error x)))
+ (_.cover [/.*' /./']
+ (|> x (/.*' factor) (/./' factor) (/.within? ..margin-of-error x)))
+ (_.cover [/.%]
+ (let [rem (/.% y x)
+ quotient (|> x (/.- rem) (/./ y))
+ floored (|> quotient
+ (update@ #/.real math.floor)
+ (update@ #/.imaginary math.floor))]
+ (/.within? +0.000000000001
+ x
+ (|> quotient (/.* y) (/.+ rem)))))
)))
(def: conjugate&reciprocal&signum&negation
Test
- (do r.monad
- [x ..complex]
+ (do random.monad
+ [x ..random]
($_ _.and
- (_.test "Conjugate has same real part as original, and opposite of imaginary part."
- (let [cx (/.conjugate x)]
- (and (f.= (get@ #/.real x)
- (get@ #/.real cx))
- (f.= (f.negate (get@ #/.imaginary x))
- (get@ #/.imaginary cx)))))
- (_.test "The reciprocal functions is its own inverse."
- (|> x /.reciprocal /.reciprocal (within? margin-of-error x)))
- (_.test "x*(x^-1) = 1"
- (|> x (/.* (/.reciprocal x)) (within? margin-of-error /.one)))
- (_.test "Absolute value of signum is always root2(2), 1 or 0."
- (let [signum-abs (|> x /.signum /.abs (get@ #/.real))]
- (or (f.= +0.0 signum-abs)
- (f.= +1.0 signum-abs)
- (f.= (math.pow +0.5 +2.0) signum-abs))))
- (_.test "Negation is its own inverse."
- (let [there (/.negate x)
- back-again (/.negate there)]
- (and (not (/.= there x))
- (/.= back-again x))))
- (_.test "Negation doesn't change the absolute value."
- (f.= (get@ #/.real (/.abs x))
- (get@ #/.real (/.abs (/.negate x)))))
+ (_.cover [/.conjugate]
+ (let [cx (/.conjugate x)]
+ (and (f.= (get@ #/.real x)
+ (get@ #/.real cx))
+ (f.= (f.negate (get@ #/.imaginary x))
+ (get@ #/.imaginary cx)))))
+ (_.cover [/.reciprocal]
+ (let [reciprocal!
+ (|> x (/.* (/.reciprocal x)) (/.within? ..margin-of-error /.+one))
+
+ own-inverse!
+ (|> x /.reciprocal /.reciprocal (/.within? ..margin-of-error x))]
+ (and reciprocal!
+ own-inverse!)))
+ (_.cover [/.signum]
+ ## Absolute value of signum is always root/2(2), 1 or 0.
+ (let [signum-abs (|> x /.signum /.abs)]
+ (or (f.= +0.0 signum-abs)
+ (f.= +1.0 signum-abs)
+ (f.= (math.pow +0.5 +2.0) signum-abs))))
+ (_.cover [/.negate]
+ (let [own-inverse!
+ (let [there (/.negate x)
+ back-again (/.negate there)]
+ (and (not (/.= there x))
+ (/.= back-again x)))
+
+ absolute!
+ (f.= (/.abs x)
+ (/.abs (/.negate x)))]
+ (and own-inverse!
+ absolute!)))
)))
(def: (trigonometric-symmetry forward backward angle)
- (-> (-> Complex Complex) (-> Complex Complex) Complex Bit)
+ (-> (-> /.Complex /.Complex) (-> /.Complex /.Complex) /.Complex Bit)
(let [normal (|> angle forward backward)]
- (|> normal forward backward (within? margin-of-error normal))))
+ (|> normal forward backward (/.within? ..margin-of-error normal))))
(def: trigonometry
Test
- (do {! r.monad}
- [angle (|> ..complex (:: ! map (|>> (update@ #/.real (f.% +1.0))
- (update@ #/.imaginary (f.% +1.0)))))]
+ (do {! random.monad}
+ [angle ..angle]
($_ _.and
- (_.test "Arc-sine is the inverse of sine."
- (trigonometric-symmetry /.sin /.asin angle))
- (_.test "Arc-cosine is the inverse of cosine."
- (trigonometric-symmetry /.cos /.acos angle))
- (_.test "Arc-tangent is the inverse of tangent."
- (trigonometric-symmetry /.tan /.atan angle)))))
+ (_.cover [/.sin /.asin]
+ (trigonometric-symmetry /.sin /.asin angle))
+ (_.cover [/.cos /.acos]
+ (trigonometric-symmetry /.cos /.acos angle))
+ (_.cover [/.tan /.atan]
+ (trigonometric-symmetry /.tan /.atan angle)))))
+
+(def: hyperbolic
+ Test
+ (do {! random.monad}
+ [angle ..angle]
+ ($_ _.and
+ (_.cover [/.sinh]
+ (/.within? ..margin-of-error
+ (|> angle (/.* /.i) /.sin (/.* /.i) (/.* /.-one))
+ (/.sinh angle)))
+ (_.cover [/.cosh]
+ (/.within? ..margin-of-error
+ (|> angle (/.* /.i) /.cos)
+ (/.cosh angle)))
+ (_.cover [/.tanh]
+ (/.within? ..margin-of-error
+ (|> angle (/.* /.i) /.tan (/.* /.i) (/.* /.-one))
+ (/.tanh angle)))
+ )))
(def: exponentiation&logarithm
Test
- (do r.monad
- [x ..complex]
+ (do random.monad
+ [x ..random]
($_ _.and
- (_.test "Root 2 is inverse of power 2."
- (|> x (/.pow' +2.0) (/.pow' +0.5) (within? margin-of-error x)))
- (_.test "Logarithm is inverse of exponentiation."
- (|> x /.log /.exp (within? margin-of-error x)))
+ (_.cover [/.pow /.root/2]
+ (|> x (/.pow (/.complex +2.0)) /.root/2 (/.within? ..margin-of-error x)))
+ (_.cover [/.pow']
+ (|> x (/.pow' +2.0) (/.pow' +0.5) (/.within? ..margin-of-error x)))
+ (_.cover [/.log /.exp]
+ (|> x /.log /.exp (/.within? ..margin-of-error x)))
)))
(def: root
Test
- (do {! r.monad}
- [sample ..complex
- degree (|> r.nat (:: ! map (|>> (n.max 1) (n.% 5))))]
- (_.test "Can calculate the N roots for any complex number."
- (|> sample
- (/.roots degree)
- (list\map (/.pow' (|> degree .int int.frac)))
- (list.every? (within? margin-of-error sample))))))
+ (do {! random.monad}
+ [sample ..random
+ degree (|> random.nat (:: ! map (|>> (n.max 1) (n.% 5))))]
+ (_.cover [/.roots]
+ (|> sample
+ (/.roots degree)
+ (list\map (/.pow' (|> degree .int int.frac)))
+ (list.every? (/.within? ..margin-of-error sample))))))
(def: #export test
Test
- (<| (_.context (%.name (name-of /._)))
+ (<| (_.covering /._)
+ (_.with-cover [/.Complex])
($_ _.and
+ (_.with-cover [/.= /.equivalence]
+ ($equivalence.spec /.equivalence ..random))
+
..construction
- ..absolute-value
+ ..constant
+ ..absolute-value&argument
..number
..conjugate&reciprocal&signum&negation
..trigonometry
+ ..hyperbolic
..exponentiation&logarithm
..root
)))
diff --git a/stdlib/source/test/lux/data/number/ratio.lux b/stdlib/source/test/lux/data/number/ratio.lux
index 788638fcf..a774b5e81 100644
--- a/stdlib/source/test/lux/data/number/ratio.lux
+++ b/stdlib/source/test/lux/data/number/ratio.lux
@@ -47,7 +47,7 @@
[denom0 ..part
denom1 ..part]
(_.test "All zeroes are the same."
- (let [(^open "/@.") /.equivalence]
- (/@= (/.ratio 0 denom0)
+ (let [(^open "/\.") /.equivalence]
+ (/\= (/.ratio 0 denom0)
(/.ratio 0 denom1)))))
))))
diff --git a/stdlib/source/test/lux/data/text.lux b/stdlib/source/test/lux/data/text.lux
index 5a6b2e4bb..7849ee04a 100644
--- a/stdlib/source/test/lux/data/text.lux
+++ b/stdlib/source/test/lux/data/text.lux
@@ -249,14 +249,14 @@
sampleR (random.unicode sizeR)
middle (random.unicode 1)
#let [sample (/.concat (list sampleL sampleR))
- (^open "/@.") /.equivalence]]
+ (^open "/\.") /.equivalence]]
($_ _.and
(_.cover [/.split]
(|> (/.split sizeL sample)
(case> (#.Right [_l _r])
- (and (/@= sampleL _l)
- (/@= sampleR _r)
- (/@= sample (/.concat (list _l _r))))
+ (and (/\= sampleL _l)
+ (/\= sampleR _r)
+ (/\= sample (/.concat (list _l _r))))
_
#0)))
@@ -266,10 +266,10 @@
(/.clip' sizeL sample)
(/.clip' 0 sample)]
(case> [(#.Right _l) (#.Right _r) (#.Right _r') (#.Right _f)]
- (and (/@= sampleL _l)
- (/@= sampleR _r)
- (/@= _r _r')
- (/@= sample _f))
+ (and (/\= sampleL _l)
+ (/\= sampleR _r)
+ (/\= _r _r')
+ (/\= sample _f))
_
#0)))
@@ -288,8 +288,8 @@
parts (random.list sizeL part-gen)
#let [sample1 (/.concat (list.interpose sep1 parts))
sample2 (/.concat (list.interpose sep2 parts))
- (^open "/@.") /.equivalence]]
+ (^open "/\.") /.equivalence]]
(_.cover [/.replace-all]
- (/@= sample2
+ (/\= sample2
(/.replace-all sep1 sep2 sample1))))
)))
diff --git a/stdlib/source/test/lux/host.jvm.lux b/stdlib/source/test/lux/host.jvm.lux
index 355be630f..bda13403b 100644
--- a/stdlib/source/test/lux/host.jvm.lux
+++ b/stdlib/source/test/lux/host.jvm.lux
@@ -4,7 +4,7 @@
[control
pipe]
[data
- ["." text ("#;." equivalence)]
+ ["." text ("#\." equivalence)]
[number
["n" nat]
["i" int]]]
@@ -107,7 +107,7 @@
(/.synchronized sample #1))
(_.test "Can access Class instances."
- (text;= "java.lang.Class" (java/lang/Class::getName (/.class-for java/lang/Class))))
+ (text\= "java.lang.Class" (java/lang/Class::getName (/.class-for java/lang/Class))))
(_.test "Can check if a value is null."
(and (/.null? (/.null))
diff --git a/stdlib/source/test/lux/host.old.lux b/stdlib/source/test/lux/host.old.lux
index fdb5d0c30..fa0ad409e 100644
--- a/stdlib/source/test/lux/host.old.lux
+++ b/stdlib/source/test/lux/host.old.lux
@@ -4,7 +4,7 @@
[control
pipe]
[data
- ["." text ("#;." equivalence)]
+ ["." text ("#\." equivalence)]
[number
["n" nat]
["i" int]]]
@@ -103,7 +103,7 @@
(/.synchronized sample #1))
(_.test "Can access Class instances."
- (text;= "java.lang.Class" (java/lang/Class::getName (/.class-for java/lang/Class))))
+ (text\= "java.lang.Class" (java/lang/Class::getName (/.class-for java/lang/Class))))
(_.test "Can check if a value is null."
(and (/.null? (/.null))
diff --git a/stdlib/source/test/lux/macro/poly/equivalence.lux b/stdlib/source/test/lux/macro/poly/equivalence.lux
index 1790c0111..fcc12c61b 100644
--- a/stdlib/source/test/lux/macro/poly/equivalence.lux
+++ b/stdlib/source/test/lux/macro/poly/equivalence.lux
@@ -78,6 +78,6 @@
(<| (_.context (%.name (name-of /._)))
(do random.monad
[sample gen-record
- #let [(^open "/@.") ..equivalence]]
+ #let [(^open "/\.") ..equivalence]]
(_.test "Every instance equals itself."
- (/@= sample sample)))))
+ (/\= sample sample)))))
diff --git a/stdlib/source/test/lux/meta/annotation.lux b/stdlib/source/test/lux/meta/annotation.lux
index 8acce1930..8ed76090c 100644
--- a/stdlib/source/test/lux/meta/annotation.lux
+++ b/stdlib/source/test/lux/meta/annotation.lux
@@ -10,7 +10,7 @@
[data
["." product]
["." bit]
- ["." name]
+ ["." name ("#\." equivalence)]
["." text
["%" format (#+ format)]]
[number
@@ -90,7 +90,8 @@
[key ..random-key]
(`` ($_ _.and
(do !
- [dummy ..random-key
+ [dummy (random.filter (|>> (name\= key) not)
+ ..random-key)
expected random.bit]
(_.cover [/.flagged?]
(and (|> expected code.bit
diff --git a/stdlib/source/test/lux/time/duration.lux b/stdlib/source/test/lux/time/duration.lux
index 7d40750a5..52454eae6 100644
--- a/stdlib/source/test/lux/time/duration.lux
+++ b/stdlib/source/test/lux/time/duration.lux
@@ -40,12 +40,12 @@
[sample (|> duration (:: ! map (/.frame /.day)))
frame duration
factor (|> random.nat (:: ! map (|>> (n.% 10) (n.max 1))))
- #let [(^open "/@.") /.order]]
+ #let [(^open "/\.") /.order]]
($_ _.and
(_.test "Can scale a duration."
(|> sample (/.scale-up factor) (/.query sample) (i.= (.int factor))))
(_.test "Scaling a duration by one does not change it."
- (|> sample (/.scale-up 1) (/@= sample)))
+ (|> sample (/.scale-up 1) (/\= sample)))
(_.test "Merging a duration with it's opposite yields an empty duration."
- (|> sample (/.merge (/.inverse sample)) (/@= /.empty)))))
+ (|> sample (/.merge (/.inverse sample)) (/\= /.empty)))))
)))
diff --git a/stdlib/source/test/lux/world/file.lux b/stdlib/source/test/lux/world/file.lux
index fa1edcfe8..5c633a048 100644
--- a/stdlib/source/test/lux/world/file.lux
+++ b/stdlib/source/test/lux/world/file.lux
@@ -22,6 +22,8 @@
[time
["." instant]
["." duration]]]
+ ["." / #_
+ ["#." watch]]
{1
["." / (#+ Path File)]}
[///
@@ -78,8 +80,9 @@
duration.from-millis
instant.absolute)))]
($_ _.and
- (creation-and-deletion 0)
- (read-and-write 1 dataL)
+ (..creation-and-deletion 0)
+ (..read-and-write 1 dataL)
+
(wrap (do promise.monad
[#let [path "temp_file_2"]
result (promise.future
@@ -197,4 +200,6 @@
confirmed?))))]
(_.assert "Can move a file from one path to another."
(try.default #0 result))))
+
+ /watch.test
))))
diff --git a/stdlib/source/test/lux/world/file/watch.lux b/stdlib/source/test/lux/world/file/watch.lux
new file mode 100644
index 000000000..8d27ab307
--- /dev/null
+++ b/stdlib/source/test/lux/world/file/watch.lux
@@ -0,0 +1,155 @@
+(.module:
+ [lux #*
+ ["_" test (#+ Test)]
+ [abstract
+ [predicate (#+ Predicate)]
+ [monad (#+ do)]]
+ [control
+ ["." try]
+ ["." exception]
+ [concurrency
+ ["." promise]]
+ [security
+ ["!" capability]]]
+ [data
+ ["." binary ("#\." equivalence)]
+ ["." text ("#\." equivalence)
+ ["%" format (#+ format)]]
+ [collection
+ ["." list]]]
+ [math
+ ["." random (#+ Random) ("#\." monad)]]]
+ {1
+ ["." /]}
+ [////
+ [data
+ ["_." binary]]])
+
+(def: concern
+ (Random [/.Concern (Predicate /.Concern)])
+ ($_ random.either
+ (random\wrap [/.creation /.creation?])
+ (random\wrap [/.modification /.modification?])
+ (random\wrap [/.deletion /.deletion?])
+ ))
+
+(def: concern\\test
+ Test
+ (<| (_.with-cover [/.Concern])
+ ($_ _.and
+ (_.cover [/.creation /.creation?]
+ (and (/.creation? /.creation)
+ (not (/.creation? /.modification))
+ (not (/.creation? /.deletion))))
+ (_.cover [/.modification /.modification?]
+ (and (not (/.modification? /.creation))
+ (/.modification? /.modification)
+ (not (/.modification? /.deletion))))
+ (_.cover [/.deletion /.deletion?]
+ (and (not (/.deletion? /.creation))
+ (not (/.deletion? /.modification))
+ (/.deletion? /.deletion)))
+ (do random.monad
+ [left ..concern
+ right (random.filter (|>> (is? left) not)
+ ..concern)
+ #let [[left left?] left
+ [right right?] right]]
+ (_.cover [/.also]
+ (let [composition (/.also left right)]
+ (and (left? composition)
+ (right? composition)))))
+ (_.cover [/.all]
+ (and (/.creation? /.all)
+ (/.modification? /.all)
+ (/.deletion? /.all)))
+ )))
+
+(def: exception
+ Test
+ (do {! random.monad}
+ [directory (random.ascii/alpha 5)
+ #let [[fs watcher] (/.mock "/")]]
+ ($_ _.and
+ (wrap (do promise.monad
+ [?concern (:: watcher concern directory)
+ ?stop (:: watcher stop directory)]
+ (_.cover' [/.not-being-watched]
+ (and (case ?concern
+ (#try.Failure error)
+ (exception.match? /.not-being-watched error)
+
+ (#try.Success _)
+ false)
+ (case ?stop
+ (#try.Failure error)
+ (exception.match? /.not-being-watched error)
+
+ (#try.Success _)
+ false)))))
+ )))
+
+(def: #export test
+ Test
+ (<| (_.covering /._)
+ (_.with-cover [/.Watcher])
+ ($_ _.and
+ ..concern\\test
+ ..exception
+
+ (do {! random.monad}
+ [directory (random.ascii/alpha 5)
+ #let [/ "/"
+ [fs watcher] (/.mock /)]
+ expected-path (:: ! map (|>> (format directory /))
+ (random.ascii/alpha 5))
+ data (_binary.random 10)]
+ (wrap (do {! promise.monad}
+ [verdict (do (try.with !)
+ [_ (!.use (:: fs create-directory) [directory])
+ _ (:: watcher start /.all directory)
+ poll/0 (:: watcher poll [])
+ #let [no-events-prior-to-creation!
+ (list.empty? poll/0)]
+ file (!.use (:: fs create-file) [expected-path])
+ poll/1 (:: watcher poll [])
+ #let [after-creation!
+ (case poll/1
+ (^ (list [actual-path concern]))
+ (and (text\= expected-path actual-path)
+ (and (/.creation? concern)
+ (not (/.modification? concern))
+ (not (/.deletion? concern))))
+
+ _
+ false)]
+ _ (!.use (:: file over-write) data)
+ poll/2 (:: watcher poll [])
+ #let [after-modification!
+ (case poll/2
+ (^ (list [actual-path concern]))
+ (and (text\= expected-path actual-path)
+ (and (not (/.creation? concern))
+ (/.modification? concern)
+ (not (/.deletion? concern))))
+
+ _
+ false)]
+ _ (!.use (:: file delete) [])
+ poll/3 (:: watcher poll [])
+ #let [after-deletion!
+ (case poll/3
+ (^ (list [actual-path concern]))
+ (and (not (/.creation? concern))
+ (not (/.modification? concern))
+ (/.deletion? concern))
+
+ _
+ false)]]
+ (wrap (and no-events-prior-to-creation!
+ after-creation!
+ after-modification!
+ after-deletion!)))]
+ (_.cover' [/.mock /.polling]
+ (try.default false verdict)))))
+ )))
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-27 14:33:37 +0000