;;;; tests.scm - tests for `sequences'


(import (rename sequences (take s-take) (drop s-drop) 
                (partition s-partition)))
(import test)
(import srfi-1)


(test-begin "sequences")

(test #t (sequence? '(a b c)))
(test #t (sequence? '#(a b c)))
(test #t (sequence? "abc"))
(test #f (sequence? 0))

(define ras
  (make-random-access-sequence 
   make-list 
   list-ref
   length))

(define ls
  (make-linear-sequence 
   make-list 
   car
   (lambda (x) 
     (and (not (null? x)) 
	  (not (null? (cdr x)))
	  (cdr x)))))

(test #t (random-access-sequence? ras))
(test #t (random-access-sequence? '#()))
(test #f (random-access-sequence? '()))

(test #t (linear-sequence? ls))
(test #t (linear-sequence? '()))
(test #f (linear-sequence? ras))
(test #f (linear-sequence? '#()))

(test 0 (size ras))
(test 3 (size '(a b c)))
(test 3 (size '#(a b c)))
(test 3 (size "abc"))
(test 0 (size ls))

(define r (sequence ras 98 99 100))

(test 3 (size r))

(define l (sequence ls 'a 'b 'c))

(test 3 (size l))

(test 'b (elt '(a b c) 1))
(test 'b (elt '#(a b c) 1))
(test #\b (elt "abc" 1))
(test 99 (elt r 1))
(test 'b (elt l 1))

(let ((s '(a b c)))
  (set! (elt s 1) 'x)
  (test 'x (elt s 1)))

(set! (elt l 1) 'x)
(test 'x (elt l 1))

(let ((s '#(a b c)))
  (set! (elt s 1) 'x)
  (test 'x (elt s 1)))

(let ((s "abc"))
  (set! (elt s 1) #\x)
  (test "axc" s))

(test '(1 1 1) (make '() 3 1))
(test '#(1 1 1) (make '#() 3 1))
(test "   " (make "" 3 #\space))
(test "aaa" (make "" 3 #\a))

(test '(c b a) (rev '(a b c)))
(test '#(c b a) (rev '#(a b c)))
(test "cba" (rev "abc"))

(let ((r2 (rev r)))
  (do ((i 0 (add1 i)))
      ((>= i (size r2)))
    (test (+ i 98) (elt r2 (- (size r2) i 1)))))

(let ((l2 (rev l)))
  (do ((i 0 (add1 i))
       (vs '(a x c) (cdr vs)))
      ((>= i 3))
    (test #t (eq? (car vs) (elt l2 i)))))

(test '(b) (sub '(a b c d) 1 2))
(test '(b c d) (sub '(a b c d) 1))
(test '#(b) (sub '#(a b c d) 1 2))
(test '#(b c d) (sub '#(a b c d) 1))
(test "b" (sub "abcd" 1 2))
(test "bcd" (sub "abcd" 1))

(let ((s '(a b c d)))
  (set! (sub s 1 3) '(x y))
  (test #t (equal? '(a x y d) s)))

(let ((s '#(a b c d)))
  (set! (sub s 1 3) '#(x y))
  (test #t (equal? '#(a x y d) s)))

(let ((s "abcd"))
  (set! (sub s 1 3) "xy")
  (test #t (equal? "axyd" s)))

(set! (sub r 1) (sequence ras 'x 'y))
(test 98 (elt r 0))
(test 'x (elt r 1))
(test 'y (elt r 2))

(test '(((() a) b) c) (foldl list '() '(a b c)))
(test '(a (b (c ()))) (foldr list '() '(a b c)))
(test '(((() a) b) c) (foldl list '() '#(a b c)))
(test '(a (b (c ()))) (foldr list '() '#(a b c)))
(test '(((() #\a) #\b) #\c) (foldl list '() "abc"))
(test '(#\a (#\b (#\c ()))) (foldr list '() "abc"))

(set! r (sequence ras 'a 'b 'c))
(test '(((() a) b) c) (foldl list '() r))
(test '(a (b (c ()))) (foldr list '() r))
(test '(a (x (c ()))) (foldr list '() l))

(let ((i 0))
  (for (lambda (x) 
	 (test i x)
	 (set! i (add1 i)))
       '(0 1 2 3 4 5)))

(let ((i 1))
  (for (lambda (x) 
	 (test i x)
	 (set! i (add1 i)))
       (sequence l 1 2 3)))

(test '(2 4 6) (smap '() (cut * <> 2) '(1 2 3)))
(test '#(2 4 6) (smap '#() (cut * <> 2) '(1 2 3)))
(test "ABC" (smap "" char-upcase "abc"))
(test '((a) (b) (c)) (smap '() list r))
(test '#((a) (b) (c)) (smap '#() list r))

;;XXX tests for smap on linear-sequence

(let ((i 0))
  (for* (lambda (s it)
	  (test #t (equal? (elt s it) (elt s i)))
	  (test #f (at-end? it))
	  (set! i (add1 i)))
	'#(1 2 3)))

(define it (iterator r))
(advance! it 3)
(test #t (at-end? it))

(test "abc" (smap* "" (lambda (s it) (char-downcase (elt s it))) '#(#\A #\B #\C)))

(define x "abc")
(set! (elt x (iterator x 1)) #\x)
(test "axc" x)

(test #f (pos odd? '(2 4 6)))
(test 2 (pos odd? '#(0 2 3 5)))
(test '(1 2) (s-take positive? '(1 2 -3 4)))
(test '(-3 1) (s-drop positive? '(5 2 -3 1)))
(test '((4 5) (-1 2)) (receive (split positive? '(4 5 -1 2))))

(test '(#(1 3) #(2 4)) (receive (s-partition odd? '#(1 2 3 4))))

(test '(a b c) (coerce '() (fill! (lambda (_ it) (index it)) r)))

(test #t ((is? '(33)) '(33)))
(test #f ((is? 1) 2))


;;; by Thomas Chust:

(let* ((s '(a b c))
       (it (iterator s)))
  (test #t (linear-iterator? it))
  (test #t (linear-sequence? s))
  (test 'a (elt s it))
  (advance! it)
  (test 'b (elt s it)))

(test #t (at-end? (iterator '())))
(test #f (at-end? (iterator '(1))))
(test #t (at-end? (iterator '#())))


;;; port-sequences

(define str "abcdef")

(let ((i 0))
  (for (lambda (x)
	 (assert (eq? (string-ref str i) x))
	 (set! i (add1 i)))
       (port->sequence (open-input-string str))))


;;; comprehensions

(import sequence-comprehensions srfi-42)

(let ((i 1))
  (do-ec (:seq j '(1 2 3))
	 (begin
	   (test #t (= i j))
	   (set! i (add1 i)))))

(test '(#\a #\b #\c) (list-ec (:seq x "aBbCDEc") (if (char-lower-case? x)) x))

(test 3 (peek '#(3)))
(test '(5 6) (pop '(4 5 6)))
(test "bc" (pop "abc"))
(test #t (all? odd? '(1 3 5)))
(test #f (all? char-whitespace? " \t1"))
(test #t (thereis? odd? '(2 4 1)))
(test #f (thereis? even? (sequence ras 1 3 5)))
(test '(1 3) (intersection '() = '(1 2 3) '#(1 3 5)))
(test #t (lset= = '(4 3 1 2) (vector->list (union '#() = '(1 2) '(3 4)))))
(test '#(3 4) (difference '#() = '#(3 4 5) '#(5)))

(test-end)

(test-exit)