;;;; File: samples-test.scm
;;;; Author: Juergen Lorenz
;;;; ju (at) jugilo (dot) de
;;;; Date: Feb 12, 2011
;;;;       Feb 17, 2011
;;;;       Mar 06, 2011


(require 'samples 'tests 'srfi-102)
(import samples
        chicken   ; cut 
        (only srfi-102 procedure-arity-includes?)
        (only tests dispatcher compare-with))

(define-syntax values->list
  (syntax-rules ()
    ((_ vals)
     (call-with-values (lambda () vals) list))))

(define divisible?
  (lambda (x y) (= (remainder x y) 0)))

(define samples-test
  (dispatcher #f
    (quotient+remainder
      (compare-with equal?
        (values->list (quotient+remainder 25 3)) '(8 1)))
     (vector-tail
       (compare-with equal?
         (vector-tail (vector 0 1 2 3) 0) '#(0 1 2 3)
         (vector-tail (vector 0 1 2 3) 4) '#()
         (vector-tail (vector 0 1 2 3) 2) '#(2 3)))
     (vector-head
       (compare-with equal? 
         (vector-head (vector 0 1 2 3) 4) '#(0 1 2 3)
         (vector-head (vector 0 1 2 3) 0) '#()
         (vector-head (vector 0 1 2 3) 2) '#(0 1)))
     (vector-append
       (compare-with equal?
         (vector-append '#(1 2) '#(3 4 5)) '#(1 2 3 4 5)
         (vector-append '#(1 2) '#()) '#(1 2)
         (vector-append '#() '#(3 4 5)) '#(3 4 5)
         (vector-append '#() '#()) '#()))
     (string-tail
       (compare-with string=?
         (string-tail "0123" 0) "0123"
         (string-tail "0123" 4) ""
         (string-tail "0123" 2) "23"))
     (string-head
       (compare-with string=?
         (string-head "0123" 0) ""
         (string-head "0123" 4) "0123"
         (string-head "0123" 2) "01"))
     (create-list
       (compare-with equal?
         (create-list 5 (cut > <> 10) add1)
         '(5 6 7 8 9 10)
         (create-list 1 (cut > <> 100) (cut * 2 <>))
         '(1 2 4 8 16 32 64)             
         (create-list 5 zero? sub1)
         '(5 4 3 2 1)))
     (list-head
       (compare-with equal?
         (list-head '(1 2 3 4 5) 3) '(1 2 3)
         (list-head '(1 2 3 4 5) 0) '()))
     (enum
       (compare-with equal?
         (enum 0) '()
         (enum 5) '(0 1 2 3 4)))
     (sublist
       (compare-with equal?
         (sublist '(1 2 3 4 5) 1 5) '(2 3 4 5)
         (sublist '(1 2 3 4 5) 0 3) '(1 2 3)
         (sublist '(1 2 3 4 5) 3 3) '()
         (sublist '(1 2 3 4 5) 1 3) '(2 3)))
     (memp
       (compare-with equal?
         (memp even? '(1 2 3 4 5)) '(2 3 4 5)
         (memp odd? '()) #f
         (memp odd? '(2 4 6 8)) #f))
     (filter
       (compare-with equal?
         (filter even? '()) '()
         (filter even? '(1 3 5 7)) '()
         (filter even? '(1 2 3 4 5)) '(2 4)))
     (sieve
       (compare-with equal?
         (sieve divisible?
                (list-tail (enum 20) 2))
         '(2 3 5 7 11 13 17 19)
         (sieve (cut = <> <>) '(1 2 1 4 1 5 3 4 5))
         '(1 2 4 5 3)))
     (fold-left
       (compare-with =
         (fold-left (cut * <> <> <>) 1 '(1 2 3) '(1 2 3))
         36
         (fold-left (cut + <> <>) 0 '(1 2 3 4))
         10))
     (fold-right
       (compare-with equal?
         (fold-right (cut + <> <> <>) 0 '(1 2 3 4) '(10 20 30 40))
         110
         (fold-right cons '() '(1 2 3 4))
         '(1 2 3 4)))
     (fold-mapped
       (compare-with =
         (fold-mapped (cut + <> <>) 0 (cut * <> <>) '(1 2 3 4) '(1 2 3 4))
         30
         (fold-mapped (cut + <> <>) 0 (cut * <> 10) '(1 2 3 4))
         100))
     (last
       (compare-with =
         (last '(1 2 3))
         3))
     (append-item
       (compare-with equal?
         (append-item '() 1) '(1)
         (append-item '(1 2 3) 4) '(1 2 3 4)))
     (map*
       (compare-with equal?
         (map* sub1 '()) '()
         (map* sub1 '(1 (2 (3 (4))))) '(0 (1 (2 (3))))
         (map* add1 '(1 (2 3) 4)) '(2 (3 4) 5)))
     (filter*
       (compare-with equal?
         (filter* even? '()) '()
         (filter* odd? '(1 2 (3 4 (5 6 (7 8))))) '(1 (3 (5 (7))))
         (filter* even? '(1 (2 3) 4)) '((2) 4)))
     (plength
       (compare-with =
         (plength 1) 1
         (plength '(1 2 . 3)) 3))
     (listify
       (compare-with equal?
         (listify '(1 2 . 3)) '(1 2 3)
         (listify 1) '(1)
         (listify '(1 2 3)) '(1 2 3)))
     (unlist
       (compare-with equal?
         (unlist '(1 2 3)) '(1 2 . 3)
         (unlist '(1 (2 . 3) 4)) '(1 (2 . 3) . 4)
         (unlist '(1)) 1))
     (pmap
       (compare-with equal?
         (pmap add1 '(1 2 . 3))
         '(2 3 . 4)
         (pmap add1 1)
         2
         (pmap (cut * <> <> <>) 1 2 3)
         6
         (pmap (cut + <> <>) '(1 2 . 3) '(10 20 . 30))
         '(11 22 . 33)))
     (pmap*
       (compare-with equal?
         (pmap* add1 1)
         2
         (pmap* add1 '(1 (2 . 3) . 4))
         '(2 (3 . 4) . 5)))
     (pflat?
       (compare-with eq?
         (pflat? 1) #t
         (pflat? '(1 2 . 3)) #t
         (pflat? '()) #f
         (pflat? '(1 2 3)) #f))
     (pflatten
       (compare-with equal?
         (pflatten '(1 (2 . 3) . 4))
         '(1 2 3 4)))
     (cons*
       (compare-with equal?
         (cons* 1 2 3)
         '(1 2 . 3)
         (cons* 1)
         1
         (cons* 1 2 '(3 4))
         '(1 2 3 4)
         (cons* 1 '(2 3 . 4))
         '(1 2 3 . 4)))
))