(use test (srfi 16 40))

(define stream->list
  (case-lambda
   ((stream) (stream->list -1 stream))
   ((n stream)
    (let loop ((n n)
               (stream stream))
      (if (or (zero? n) (stream-null? stream))
          '()
          (cons (let ((car (stream-car stream)))
                  (if (stream? car)
                      (stream->list car)
                      car))
                (loop (- n 1) (stream-cdr stream))))))))

(define stream-equal?
  (case-lambda
   ((x y) (stream-equal? -1 x y))
   ((n x y)
    (equal? (stream->list n x)
            (stream->list n y)))))

(define (stream-equal?-to-n n)
  (lambda (x y)
    (stream-equal? n x y)))

(define (with-test-comparator test-comparator thunk)
  (let ((old-test-comparator current-test-comparator))
    (dynamic-wind
        (lambda () (set! current-test-comparator
                         test-comparator))
        thunk
        (lambda () (set! current-test-comparator
                         old-test-comparator)))))

(define test-equal? current-test-comparator)

(with-test-comparator
 (lambda () stream-equal?)
 (lambda ()
   (test-group
    "srfi-40"

    (test
     "stream-null"
     stream-null
     (stream))

    (test
     "stream-cons with stream-null"
     (stream 'a)
     (stream-cons 'a stream-null))

    (test
     "stream-cons with symbols"
     (stream 'a 'b 'c 'd)
     (stream-cons 'a (stream 'b 'c 'd)))
 
              
    (test
     "stream-cons with string and symbols"
     (stream "a" 'b 'c)
     (stream-cons "a" (stream 'b 'c)))
                
    ;; hmm; should be an error, apparently
    ;; (test-error
    ;;  "stream-cons with error"
    ;;  (stream-cons 'a 3))

    (test
     "stream-cons with streams"
     (stream (stream 'a 'b) 'c)
     (stream-cons (stream 'a 'b) (stream 'c)))
 
    (test-assert
     "stream? with stream-null"
     (stream? stream-null))

    (test-assert
     "stream? with stream"
     (stream? (stream-cons 'a stream-null)))

    (with-test-comparator
     test-equal?
     (lambda ()
       (test
        "stream? with number"
        #f
        (stream? 3))

       (test-assert
        "stream-null?, reflexive"
        (stream-null? stream-null))

       (test
        "stream-null? on non-null stream"
        #f
        (stream-null? (stream-cons 'a stream-null)))

       (test
        "stream-null? on non-stream"
        #f
        (stream-null? 3))

       (test
        "stream-pair? on stream-null"
        #f
        (stream-pair? stream-null))

       (test-assert
        "stream-pair? on stream"
        (stream-pair? (stream-cons 'a stream-null)))

       (test
        "stream-pair? on non-stream"
        #f
        (stream-pair? 3))

       (test
        "stream-car"
        'a
        (stream-car (stream 'a 'b 'c)))

       (test-error
        "stream-car on stream-null"
        (stream-car stream-null))

       (test-error
        "stream-car on non-stream"
        (stream-car 3))))

    (test
     "stream-cdr"
     (stream 'b 'c)
     (stream-cdr (stream 'a 'b 'c)))

    (test-error
     "stream-cdr on stream-null"
     (stream-cdr stream-null))

    (test-error
     "stream-cdr on non-stream"
     (stream-cdr 3))

    (define from0
      (let loop ((x 0))
        (stream-delay
         (stream-cons x (loop (+ x 1))))))

    (with-test-comparator
     (lambda () (stream-equal?-to-n 7))
     (lambda ()
       (test
        "stream-delay"
        from0
        (stream 0 1 2 3 4 5 6))))

    (test
     "stream"
     (stream 'a 7 'c)
     (stream 'a 7 'c))

    (test
     "stream, medadic"
     stream-null
     (stream))

    (define (take5 s)
      (stream-unfoldn
       (lambda (x)
         (let ((n (car x)) (s (cdr x)))
           (if (zero? n)
               (values 'dummy '())
               (values
                (cons (- n 1) (stream-cdr s))
                (list (stream-car s))))))
       (cons 5 s)
       1))

    (test
     "stream-unfoldn"
     (stream 0 1 2 3 4)
     (take5 from0))

    (with-test-comparator
     (lambda () (stream-equal?-to-n 7))
     (lambda ()
       (test
        "stream-map"
        (stream 0 2 4 6 8 10 12)
        (stream-map (lambda (x) (+ x x)) from0))))
    
    (test
     "stream-map with multiple streams"
     (stream 5 7 9)
     (stream-map + (stream 1 2 3) (stream 4 5 6)))

    (test
     "stream-map with finite stream"
     (stream 1 4 27 256 3125)
     (stream-map (lambda (x) (expt x x))
                 (stream 1 2 3 4 5)))

    (with-test-comparator
     test-equal?
     (lambda ()
       (test
        "stream-for-each"
        "012345"
        (with-output-to-string
          (lambda ()
            (stream-for-each display (stream 0 1 2 3 4 5)))))))

    (test
     "stream-filter with stream-null"
     stream-null
     (stream-filter odd? stream-null))

    (test
     "stream-filter"
     (stream 1 3 5 7 9)
     (take5 (stream-filter odd? from0))))))

(test-exit)