diff options
Diffstat (limited to 'tests')
| -rw-r--r-- | tests/run.scm | 140 |
1 files changed, 139 insertions, 1 deletions
diff --git a/tests/run.scm b/tests/run.scm index eac7569..4005ef7 100644 --- a/tests/run.scm +++ b/tests/run.scm @@ -1,4 +1,6 @@ -(import (chicken load) (test)) +(import (chicken load) + (test) + (srfi 41)) (test-begin "algebraic-structures") @@ -23,6 +25,20 @@ (test 5 (mod7:<> 3 4)) +(test-begin "list") + +(import (prefix (algebraic-structures list semigroup) list:)) +(test '(a b c) (list:<> '(a b) '(c))) + +(test-end "list") + +(test-begin "stream") + +(import (prefix (algebraic-structures stream semigroup) stream:)) +(test '(a b c) (stream->list (stream:<> (stream 'a 'b) (stream 'c)))) + +(test-end "stream") + (test-end "semigroup") (test-begin "monoid") @@ -43,6 +59,20 @@ (test 1 mod7:unit) +(test-begin "list") + +(import (prefix (algebraic-structures list monoid) list:)) +(test '() (begin list:unit)) + +(test-end "list") + +(test-begin "stream") + +(import (prefix (algebraic-structures stream monoid) stream:)) +(test '() (stream->list stream:unit)) + +(test-end "stream") + (test-end "monoid") (test-begin "group") @@ -106,6 +136,37 @@ (test #t (list:member? 'c '(a b c) eq?)) (test #f (list:member? 'c '(a b) eq?)) +(test-begin "stream") + +(import (prefix (algebraic-structures stream foldable) stream:)) + +(test '(e d c b a) (stream:fold cons '() (stream 'a 'b 'c 'd 'e))) + +(test 0 (stream:length stream-null)) +(test 5 (stream:length (stream-take 5 (stream-from 1)))) + +(test 0 (stream:count even? (stream 1 3 5 7))) +(test 2 (stream:count even? (stream 1 3 4 7 8))) + +(test #f (stream:any (constantly #t) stream-null)) +(test #f (stream:any (cut member 'x <>) (stream '(a b c) '(d e f)))) +(test '(x f) (stream:any (cut member 'x <>) (stream '(a b c) '(d x f)))) +(test '(x f) (stream:any (cut member 'x <>) (stream '(a b c) '(d x f)))) +(test #t (stream:any even? (stream-from 1))) + +(test #t (stream:every (constantly #f) stream-null)) +(test #f (stream:every (cut member 'x <>) (stream '(a b c) '(d x f)))) +(test '(x f) (stream:every (cut member 'x <>) (stream '(a x c) '(d x f)))) +(test #f (stream:every even? (stream-from 0))) + +(test #t (stream:member? 3 (stream 1 3 7 5) =)) +(test #f (stream:member? 3 (stream 1 7 5) =)) +(test #t (stream:member? 'c (stream 'a 'b 'c) eq?)) +(test #f (stream:member? 'c (stream 'a 'b) eq?)) +(test #t (stream:member? 1000 (stream-from 1) =)) + +(test-end "stream") + (test-end "foldable") (test-begin "reducible") @@ -116,6 +177,16 @@ (test -3 (list:minimum '(1 8 -3 5 4) <)) (test 8 (list:maximum '(1 8 -3 5 4) <)) +(test-begin "stream") + +(import (prefix (algebraic-structures stream reducible) stream:)) + +(test 10 (stream:reduce + (stream 1 2 3 4))) +(test -3 (stream:minimum (stream 1 8 -3 5 4) <)) +(test 8 (stream:maximum (stream 1 8 -3 5 4) <)) + +(test-end "stream") + (test-end "reducible") (test-begin "semigroup.reducible") @@ -185,6 +256,14 @@ (test '((a) (b) (c)) (list:map1 list '(a b c))) +(test-begin "stream") + +(import (prefix (algebraic-structures stream functor) stream:)) + +(test '((a) (b) (c)) (stream->list (stream:map1 list (stream 'a 'b 'c)))) + +(test-end "stream") + (test-end "functor") (test-begin "applicative") @@ -199,6 +278,25 @@ (test '((a 1 z) (a 2 z) (b 1 z) (b 2 z) (c 1 z) (c 2 z)) (list:map list '(a b c) '(1 2) '(z))) +(test-begin "stream") + +(import (prefix (algebraic-structures stream applicative) stream:)) + +(test '(a) (stream->list (stream:pure 'a))) + +(test '((a 1) (a 2) (b 1) (b 2) (c 1) (c 2)) + (stream->list (stream:map2 list (stream 'a 'b 'c) (stream 1 2)))) + +(test '((a 1 z) (a 2 z) (b 1 z) (b 2 z) (c 1 z) (c 2 z)) + (stream->list + (stream:map list (stream 'a 'b 'c) (stream 1 2) (stream 'z)))) + +(test '((1 a) (1 b) (1 c) (2 a)) + (stream->list + (stream-take 4 (stream:map2 list (stream-from 1) (stream 'a 'b 'c))))) + +(test-end "stream") + (test-begin "list.zip") (import (prefix (algebraic-structures list zip applicative) list-zip:)) @@ -210,6 +308,17 @@ (test-end "list.zip") +(test-begin "stream.zip") + +(import (prefix (algebraic-structures stream zip applicative) stream-zip:)) + +(test '(a) (stream->list (stream:pure 'a))) + +(test '((a 1) (b 2)) + (stream->list (stream-zip:map2 list (stream 'a 'b 'c) (stream 1 2)))) + +(test-end "stream.zip") + (test-end "applicative") (test-begin "monad") @@ -229,6 +338,19 @@ (list 2) (list:pure (* x y z)))) +(test-begin "stream") + +(import (prefix (algebraic-structures stream monad) stream:)) + +(test '((1 a) (2 a)) + (stream->list + (stream:>>= (stream:pure 'a) + (lambda (x) + (stream (list 1 x) + (list 2 x)))))) + +(test-end "stream") + (test-end "monad") (test-begin "alternative") @@ -240,6 +362,22 @@ (list:guard (odd? x)) (list:pure (* x x)))) +(test-begin "stream") + +(import (prefix (algebraic-structures stream alternative) stream:)) + +(test '((3 4 5) (6 8 10) (5 12 13) (9 12 15) (8 15 17)) + (stream->list + (stream-take 5 + (stream:do (b <- (stream-from 1)) + (a <- (stream-range 1 b)) + (let c^2 = (+ (* a a) (* b b))) + (let-values (c r) = (exact-integer-sqrt c^2)) + (stream:guard (= r 0)) + (stream:pure (list a b c)))))) + +(test-end "stream") + (test-end "alternative") (test-end "algebraic-structures") |