diff options
Diffstat (limited to 'stdlib/source/test')
| -rw-r--r-- | stdlib/source/test/lux/control/continuation.lux | 14 | ||||
| -rw-r--r-- | stdlib/source/test/lux/control/reader.lux | 4 | ||||
| -rw-r--r-- | stdlib/source/test/lux/control/region.lux | 42 | ||||
| -rw-r--r-- | stdlib/source/test/lux/control/state.lux | 4 | ||||
| -rw-r--r-- | stdlib/source/test/lux/data/color.lux | 6 | ||||
| -rw-r--r-- | stdlib/source/test/lux/data/number/complex.lux | 332 | ||||
| -rw-r--r-- | stdlib/source/test/lux/data/number/ratio.lux | 4 | ||||
| -rw-r--r-- | stdlib/source/test/lux/data/text.lux | 20 | ||||
| -rw-r--r-- | stdlib/source/test/lux/host.jvm.lux | 4 | ||||
| -rw-r--r-- | stdlib/source/test/lux/host.old.lux | 4 | ||||
| -rw-r--r-- | stdlib/source/test/lux/macro/poly/equivalence.lux | 4 | ||||
| -rw-r--r-- | stdlib/source/test/lux/meta/annotation.lux | 5 | ||||
| -rw-r--r-- | stdlib/source/test/lux/time/duration.lux | 6 | ||||
| -rw-r--r-- | stdlib/source/test/lux/world/file.lux | 9 | ||||
| -rw-r--r-- | stdlib/source/test/lux/world/file/watch.lux | 155 |
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))))) + ))) |