File: test-srfi1-another.scm

package info (click to toggle)
sigscheme 0.9.1-3
links: PTS, VCS
area: main
in suites: forky, sid, trixie
size: 8,660 kB
sloc: lisp: 37,498; ansic: 31,109; sh: 4,368; makefile: 744; asm: 333; ruby: 290
file content (2517 lines) | stat: -rw-r--r-- 113,052 bytes
parent folder | download | duplicates (18)
#! /usr/bin/env sscm -C UTF-8

;;  Filename : test-srfi1-another.scm
;;  About    : unit test for SRFI-1 (another version)
;;
;;  Copyright (c) 2007-2008 SigScheme Project <uim-en AT googlegroups.com>
;;
;;  All rights reserved.
;;
;;  Redistribution and use in source and binary forms, with or without
;;  modification, are permitted provided that the following conditions
;;  are met:
;;
;;  1. Redistributions of source code must retain the above copyright
;;     notice, this list of conditions and the following disclaimer.
;;  2. Redistributions in binary form must reproduce the above copyright
;;     notice, this list of conditions and the following disclaimer in the
;;     documentation and/or other materials provided with the distribution.
;;  3. Neither the name of authors nor the names of its contributors
;;     may be used to endorse or promote products derived from this software
;;     without specific prior written permission.
;;
;;  THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ``AS
;;  IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
;;  THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
;;  PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR
;;  CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
;;  EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
;;  PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
;;  PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
;;  LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
;;  NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
;;  SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

(require-extension (unittest))

(require-extension (srfi 1 6 23 38))

(if (not (provided? "srfi-1"))
    (test-skip "SRFI-1 is not enabled"))

(define tn test-name)

;;(define drop list-tail)

;; To prevent being affected from possible bug of the C implementation of
;; list-tail, tests in this file use this R5RS definition of list-tail.
(define my-list-tail
  (lambda (x k)
    (if (zero? k)
        x
        (my-list-tail (cdr x) (- k 1)))))

;; unique objects
(define elm0 (list 0))
(define elm1 (list 1))
(define elm2 (list 2))
(define elm3 (list 3))
(define elm4 (list 4))
(define elm5 (list 5))
(define elm6 (list 6))
(define elm7 (list 7))
(define elm8 (list 8))
(define elm9 (list 9))
;; sublists
(define cdr9 (cons elm9 '()))
(define cdr8 (cons elm8 cdr9))
(define cdr7 (cons elm7 cdr8))
(define cdr6 (cons elm6 cdr7))
(define cdr5 (cons elm5 cdr6))
(define cdr4 (cons elm4 cdr5))
(define cdr3 (cons elm3 cdr4))
(define cdr2 (cons elm2 cdr3))
(define cdr1 (cons elm1 cdr2))
(define cdr0 (cons elm0 cdr1))
(define lst cdr0)
;; circular lists
(define clst1 (list 1))
(set-cdr! clst1 clst1)
(define clst2 (list 1 2))
(set-cdr! (my-list-tail clst2 1) clst2)
(define clst3 (list 1 2 3))
(set-cdr! (my-list-tail clst3 2) clst3)
(define clst4 (list 1 2 3 4))
(set-cdr! (my-list-tail clst4 3) clst4)


;;
;; Constructors
;;

(tn "xcons")
(assert-equal? (tn) (cons elm1 elm0)      (xcons elm0 elm1))
(assert-eq?    (tn) elm1             (car (xcons elm0 elm1)))
(assert-eq?    (tn) elm0             (cdr (xcons elm0 elm1)))

(tn "cons* invalid forms")
(assert-error  (tn) (lambda () (cons*)))
(tn "cons*")
(assert-eq?    (tn) elm0                         (cons* elm0))
(assert-equal? (tn) (cons elm0 elm1)             (cons* elm0 elm1))
(assert-equal? (tn) (cons elm0 (cons elm1 elm2)) (cons* elm0 elm1 elm2))
(assert-equal? (tn) lst                        (cons* elm0 elm1 elm2 cdr3))
(assert-false  (tn) (eq? lst                   (cons* elm0 elm1 elm2 cdr3)))
(assert-false  (tn) (eq? cdr2 (my-list-tail    (cons* elm0 elm1 elm2 cdr3) 2)))
(assert-true   (tn) (eq? cdr3 (my-list-tail    (cons* elm0 elm1 elm2 cdr3) 3)))
(assert-equal? (tn) '(1 2 3 4 5 6)               (cons* 1 2 3 '(4 5 6)))
(tn "cons* SRFI-1 examples")
(assert-equal? (tn) '(1 2 3 . 4) (cons* 1 2 3 4))
(assert-equal? (tn) 1            (cons* 1))

(tn "make-list invalid forms")
(assert-error  (tn) (lambda () (make-list #t)))
(assert-error  (tn) (lambda () (make-list -1)))
(assert-error  (tn) (lambda () (make-list 0 #t #t)))
(tn "make-list")
(define fill (if sigscheme?
                 (undef)
                 (error "filler value of make-list is unknown")))
(assert-equal? (tn) '()                        (make-list 0))
(assert-equal? (tn) (list fill)                (make-list 1))
(assert-equal? (tn) (list fill fill)           (make-list 2))
(assert-equal? (tn) (list fill fill fill)      (make-list 3))
(assert-equal? (tn) (list fill fill fill fill) (make-list 4))
(assert-equal? (tn) '()                        (make-list 0 elm0))
(assert-equal? (tn) (list elm0)                (make-list 1 elm0))
(assert-equal? (tn) (list elm0 elm0)           (make-list 2 elm0))
(assert-equal? (tn) (list elm0 elm0 elm0)      (make-list 3 elm0))
(assert-equal? (tn) (list elm0 elm0 elm0 elm0) (make-list 4 elm0))

(tn "list-tabulate invalid forms")
(assert-error  (tn) (lambda () (list-tabulate 0)))
(assert-error  (tn) (lambda () (list-tabulate 0 number->string #t)))
(assert-error  (tn) (lambda () (list-tabulate 0 #t #t)))
(assert-error  (tn) (lambda () (list-tabulate 1 string->number)))
(tn "list-tabulate")
(assert-equal? (tn) '()                (list-tabulate 0 number->string))
(assert-equal? (tn) '("0")             (list-tabulate 1 number->string))
(assert-equal? (tn) '("0" "1")         (list-tabulate 2 number->string))
(assert-equal? (tn) '("0" "1" "2")     (list-tabulate 3 number->string))
(assert-equal? (tn) '("0" "1" "2" "3") (list-tabulate 4 number->string))
(tn "list-tabulate SRFI-1 examples")
(assert-equal? (tn) '(0 1 2 3) (list-tabulate 4 values))

(tn "list-copy invalid forms")
(assert-error  (tn) (lambda () (list-copy)))
(tn "list-copy")
(assert-equal? (tn) lst (list-copy lst))
(assert-false  (tn) (eq? lst (list-copy lst)))
(assert-false  (tn) (eq? (my-list-tail lst             1)
                         (my-list-tail (list-copy lst) 1)))
(assert-false  (tn) (eq? (my-list-tail lst             2)
                         (my-list-tail (list-copy lst) 2)))
(assert-false  (tn) (eq? (my-list-tail lst             9)
                         (my-list-tail (list-copy lst) 9)))
;; null terminator
(assert-true   (tn) (eq? (my-list-tail lst             10)
                         (my-list-tail (list-copy lst) 10)))

(tn "circular-list invalid forms")
(assert-error  (tn) (lambda () (circular-list)))
(tn "circular-list length 1")
(assert-eq?    (tn) elm0 (car (my-list-tail (circular-list elm0) 0)))
(assert-eq?    (tn) elm0 (car (my-list-tail (circular-list elm0) 1)))
(assert-eq?    (tn) elm0 (car (my-list-tail (circular-list elm0) 2)))
(assert-eq?    (tn) elm0 (car (my-list-tail (circular-list elm0) 3)))
(assert-eq?    (tn) elm0 (car (my-list-tail (circular-list elm0) 4)))
(assert-eq?    (tn) elm0 (car (my-list-tail (circular-list elm0) 5)))
(tn "circular-list length 2")
(assert-eq?    (tn) elm0 (car (my-list-tail (circular-list elm0 elm1) 0)))
(assert-eq?    (tn) elm1 (car (my-list-tail (circular-list elm0 elm1) 1)))
(assert-eq?    (tn) elm0 (car (my-list-tail (circular-list elm0 elm1) 2)))
(assert-eq?    (tn) elm1 (car (my-list-tail (circular-list elm0 elm1) 3)))
(assert-eq?    (tn) elm0 (car (my-list-tail (circular-list elm0 elm1) 4)))
(assert-eq?    (tn) elm1 (car (my-list-tail (circular-list elm0 elm1) 5)))
(tn "circular-list length 3")
(assert-eq?    (tn) elm0 (car (my-list-tail (circular-list elm0 elm1 elm2) 0)))
(assert-eq?    (tn) elm1 (car (my-list-tail (circular-list elm0 elm1 elm2) 1)))
(assert-eq?    (tn) elm2 (car (my-list-tail (circular-list elm0 elm1 elm2) 2)))
(assert-eq?    (tn) elm0 (car (my-list-tail (circular-list elm0 elm1 elm2) 3)))
(assert-eq?    (tn) elm1 (car (my-list-tail (circular-list elm0 elm1 elm2) 4)))
(assert-eq?    (tn) elm2 (car (my-list-tail (circular-list elm0 elm1 elm2) 5)))
(assert-eq?    (tn) elm0 (car (my-list-tail (circular-list elm0 elm1 elm2) 6)))

(tn "iota invalid forms")
(assert-error  (tn) (lambda ()    (iota)))
(assert-error  (tn) (lambda ()    (iota -1)))
(assert-error  (tn) (lambda ()    (iota -1 0 1)))
(assert-error  (tn) (lambda ()    (iota -1 0 1)))
(assert-error  (tn) (lambda ()    (iota 0 0 0 0)))
(assert-error  (tn) (lambda ()    (iota 1 0 0 0)))
(tn "iota count only")
(assert-equal? (tn) '()           (iota 0))
(assert-equal? (tn) '(0)          (iota 1))
(assert-equal? (tn) '(0 1)        (iota 2))
(assert-equal? (tn) '(0 1 2)      (iota 3))
(assert-equal? (tn) '(0 1 2 3)    (iota 4))
(tn "iota count and start")
(assert-equal? (tn) '()           (iota 0 2))
(assert-equal? (tn) '(2)          (iota 1 2))
(assert-equal? (tn) '(2 3)        (iota 2 2))
(assert-equal? (tn) '(2 3 4)      (iota 3 2))
(assert-equal? (tn) '(2 3 4 5)    (iota 4 2))
;; nagative start
(assert-equal? (tn) '()           (iota 0 -2))
(assert-equal? (tn) '(-2)         (iota 1 -2))
(assert-equal? (tn) '(-2 -1)      (iota 2 -2))
(assert-equal? (tn) '(-2 -1 0)    (iota 3 -2))
(assert-equal? (tn) '(-2 -1 0 1)  (iota 4 -2))
(tn "iota count, start and step")
(assert-equal? (tn) '()           (iota 0 2 3))
(assert-equal? (tn) '(2)          (iota 1 2 3))
(assert-equal? (tn) '(2 5)        (iota 2 2 3))
(assert-equal? (tn) '(2 5 8)      (iota 3 2 3))
(assert-equal? (tn) '(2 5 8 11)   (iota 4 2 3))
;; negative step
(assert-equal? (tn) '()           (iota 0 2 -3))
(assert-equal? (tn) '(2)          (iota 1 2 -3))
(assert-equal? (tn) '(2 -1)       (iota 2 2 -3))
(assert-equal? (tn) '(2 -1 -4)    (iota 3 2 -3))
(assert-equal? (tn) '(2 -1 -4 -7) (iota 4 2 -3))
;; zero step
(assert-equal? (tn) '()           (iota 0 2 0))
(assert-equal? (tn) '(2)          (iota 1 2 0))
(assert-equal? (tn) '(2 2)        (iota 2 2 0))
(assert-equal? (tn) '(2 2 2)      (iota 3 2 0))
(assert-equal? (tn) '(2 2 2 2)    (iota 4 2 0))

;;
;; Predicates
;;

;; proper-list?
(tn "proper-list? proper list")
(assert-eq?    (tn) #t (proper-list? '()))
(assert-eq?    (tn) #t (proper-list? '(1)))
(assert-eq?    (tn) #t (proper-list? '(1 2)))
(assert-eq?    (tn) #t (proper-list? '(1 2 3)))
(assert-eq?    (tn) #t (proper-list? '(1 2 3 4)))
(tn "proper-list? dotted list")
(assert-eq?    (tn) #f (proper-list? 1))
(assert-eq?    (tn) #f (proper-list? '(1 . 2)))
(assert-eq?    (tn) #f (proper-list? '(1 2 . 3)))
(assert-eq?    (tn) #f (proper-list? '(1 2 3 . 4)))
(assert-eq?    (tn) #f (proper-list? '(1 2 3 4 . 5)))
(tn "proper-list? circular list")
(assert-eq?    (tn) #f (proper-list? clst1))
(assert-eq?    (tn) #f (proper-list? clst2))
(assert-eq?    (tn) #f (proper-list? clst3))
(assert-eq?    (tn) #f (proper-list? clst4))
(tn "proper-list? all kind of Scheme objects")
(if (and sigscheme?
         (provided? "siod-bugs"))
    (assert-eq? (tn) #t (proper-list? #f))
    (assert-eq? (tn) #f (proper-list? #f)))
(assert-eq? (tn) #f (proper-list? #t))
(assert-eq? (tn) #t (proper-list? '()))
(if sigscheme?
    (begin
      (assert-eq? (tn) #f (proper-list? (eof)))
      (assert-eq? (tn) #f (proper-list? (undef)))))
(assert-eq? (tn) #f (proper-list? 0))
(assert-eq? (tn) #f (proper-list? 1))
(assert-eq? (tn) #f (proper-list? 3))
(assert-eq? (tn) #f (proper-list? -1))
(assert-eq? (tn) #f (proper-list? -3))
(assert-eq? (tn) #f (proper-list? 'symbol))
(assert-eq? (tn) #f (proper-list? 'SYMBOL))
(assert-eq? (tn) #f (proper-list? #\a))
(assert-eq? (tn) #f (proper-list? #\あ))
(assert-eq? (tn) #f (proper-list? ""))
(assert-eq? (tn) #f (proper-list? " "))
(assert-eq? (tn) #f (proper-list? "a"))
(assert-eq? (tn) #f (proper-list? "A"))
(assert-eq? (tn) #f (proper-list? "aBc12!"))
(assert-eq? (tn) #f (proper-list? "あ"))
(assert-eq? (tn) #f (proper-list? "あ0イう12!"))
(assert-eq? (tn) #f (proper-list? +))
(assert-eq? (tn) #f (proper-list? (lambda () #t)))

;; syntactic keywords should not be appeared as operand
(if sigscheme?
    (begin
      ;; pure syntactic keyword
      (assert-error (tn) (lambda () (proper-list? else)))
      ;; expression keyword
      (assert-error (tn) (lambda () (proper-list? do)))))

(call-with-current-continuation
 (lambda (k)
   (assert-eq? (tn) #f (proper-list? k))))
(assert-eq? (tn) #f (proper-list? (current-output-port)))
(assert-eq? (tn) #f (proper-list? '(#t . #t)))
(assert-eq? (tn) #f (proper-list? (cons #t #t)))
(assert-eq? (tn) #t (proper-list? '(0 1 2)))
(assert-eq? (tn) #t (proper-list? (list 0 1 2)))
(assert-eq? (tn) #f (proper-list? '#()))
(assert-eq? (tn) #f (proper-list? (vector)))
(assert-eq? (tn) #f (proper-list? '#(0 1 2)))
(assert-eq? (tn) #f (proper-list? (vector 0 1 2)))

;; circular-list?
(tn "circular-list? proper list")
(assert-eq?    (tn) #f (circular-list? '()))
(assert-eq?    (tn) #f (circular-list? '(1)))
(assert-eq?    (tn) #f (circular-list? '(1 2)))
(assert-eq?    (tn) #f (circular-list? '(1 2 3)))
(assert-eq?    (tn) #f (circular-list? '(1 2 3 4)))
(tn "circular-list? dotted list")
(assert-eq?    (tn) #f (circular-list? 1))
(assert-eq?    (tn) #f (circular-list? '(1 . 2)))
(assert-eq?    (tn) #f (circular-list? '(1 2 . 3)))
(assert-eq?    (tn) #f (circular-list? '(1 2 3 . 4)))
(assert-eq?    (tn) #f (circular-list? '(1 2 3 4 . 5)))
(tn "circular-list? circular list")
(assert-eq?    (tn) #t (circular-list? clst1))
(assert-eq?    (tn) #t (circular-list? clst2))
(assert-eq?    (tn) #t (circular-list? clst3))
(assert-eq?    (tn) #t (circular-list? clst4))
(tn "circular-list? all kind of Scheme objects")
(if (and sigscheme?
         (provided? "siod-bugs"))
    (assert-eq? (tn) #f (circular-list? #f))
    (assert-eq? (tn) #f (circular-list? #f)))
(assert-eq? (tn) #f (circular-list? #t))
(assert-eq? (tn) #f (circular-list? '()))
(if sigscheme?
    (begin
      (assert-eq? (tn) #f (circular-list? (eof)))
      (assert-eq? (tn) #f (circular-list? (undef)))))
(assert-eq? (tn) #f (circular-list? 0))
(assert-eq? (tn) #f (circular-list? 1))
(assert-eq? (tn) #f (circular-list? 3))
(assert-eq? (tn) #f (circular-list? -1))
(assert-eq? (tn) #f (circular-list? -3))
(assert-eq? (tn) #f (circular-list? 'symbol))
(assert-eq? (tn) #f (circular-list? 'SYMBOL))
(assert-eq? (tn) #f (circular-list? #\a))
(assert-eq? (tn) #f (circular-list? #\あ))
(assert-eq? (tn) #f (circular-list? ""))
(assert-eq? (tn) #f (circular-list? " "))
(assert-eq? (tn) #f (circular-list? "a"))
(assert-eq? (tn) #f (circular-list? "A"))
(assert-eq? (tn) #f (circular-list? "aBc12!"))
(assert-eq? (tn) #f (circular-list? "あ"))
(assert-eq? (tn) #f (circular-list? "あ0イう12!"))
(assert-eq? (tn) #f (circular-list? +))
(assert-eq? (tn) #f (circular-list? (lambda () #t)))

;; syntactic keywords should not be appeared as operand
(if sigscheme?
    (begin
      ;; pure syntactic keyword
      (assert-error (tn) (lambda () (circular-list? else)))
      ;; expression keyword
      (assert-error (tn) (lambda () (circular-list? do)))))

(call-with-current-continuation
 (lambda (k)
   (assert-eq? (tn) #f (circular-list? k))))
(assert-eq? (tn) #f (circular-list? (current-output-port)))
(assert-eq? (tn) #f (circular-list? '(#t . #t)))
(assert-eq? (tn) #f (circular-list? (cons #t #t)))
(assert-eq? (tn) #f (circular-list? '(0 1 2)))
(assert-eq? (tn) #f (circular-list? (list 0 1 2)))
(assert-eq? (tn) #f (circular-list? '#()))
(assert-eq? (tn) #f (circular-list? (vector)))
(assert-eq? (tn) #f (circular-list? '#(0 1 2)))
(assert-eq? (tn) #f (circular-list? (vector 0 1 2)))

;; dotted-list?
(tn "dotted-list? proper list")
(assert-eq?    (tn) #f (dotted-list? '()))
(assert-eq?    (tn) #f (dotted-list? '(1)))
(assert-eq?    (tn) #f (dotted-list? '(1 2)))
(assert-eq?    (tn) #f (dotted-list? '(1 2 3)))
(assert-eq?    (tn) #f (dotted-list? '(1 2 3 4)))
(tn "dotted-list? dotted list")
(assert-eq?    (tn) #t (dotted-list? 1))
(assert-eq?    (tn) #t (dotted-list? '(1 . 2)))
(assert-eq?    (tn) #t (dotted-list? '(1 2 . 3)))
(assert-eq?    (tn) #t (dotted-list? '(1 2 3 . 4)))
(assert-eq?    (tn) #t (dotted-list? '(1 2 3 4 . 5)))
(tn "dotted-list? circular list")
(assert-eq?    (tn) #f (dotted-list? clst1))
(assert-eq?    (tn) #f (dotted-list? clst2))
(assert-eq?    (tn) #f (dotted-list? clst3))
(assert-eq?    (tn) #f (dotted-list? clst4))
(tn "dotted-list? all kind of Scheme objects")
(if (and sigscheme?
         (provided? "siod-bugs"))
    (assert-eq? (tn) #f (dotted-list? #f))
    (assert-eq? (tn) #t (dotted-list? #f)))
(assert-eq? (tn) #t (dotted-list? #t))
(assert-eq? (tn) #f (dotted-list? '()))
(if sigscheme?
    (begin
      (assert-eq? (tn) #t (dotted-list? (eof)))
      (assert-eq? (tn) #t (dotted-list? (undef)))))
(assert-eq? (tn) #t (dotted-list? 0))
(assert-eq? (tn) #t (dotted-list? 1))
(assert-eq? (tn) #t (dotted-list? 3))
(assert-eq? (tn) #t (dotted-list? -1))
(assert-eq? (tn) #t (dotted-list? -3))
(assert-eq? (tn) #t (dotted-list? 'symbol))
(assert-eq? (tn) #t (dotted-list? 'SYMBOL))
(assert-eq? (tn) #t (dotted-list? #\a))
(assert-eq? (tn) #t (dotted-list? #\あ))
(assert-eq? (tn) #t (dotted-list? ""))
(assert-eq? (tn) #t (dotted-list? " "))
(assert-eq? (tn) #t (dotted-list? "a"))
(assert-eq? (tn) #t (dotted-list? "A"))
(assert-eq? (tn) #t (dotted-list? "aBc12!"))
(assert-eq? (tn) #t (dotted-list? "あ"))
(assert-eq? (tn) #t (dotted-list? "あ0イう12!"))
(assert-eq? (tn) #t (dotted-list? +))
(assert-eq? (tn) #t (dotted-list? (lambda () #t)))

;; syntactic keywords should not be appeared as operand
(if sigscheme?
    (begin
      ;; pure syntactic keyword
      (assert-error (tn) (lambda () (dotted-list? else)))
      ;; expression keyword
      (assert-error (tn) (lambda () (dotted-list? do)))))

(call-with-current-continuation
 (lambda (k)
   (assert-eq? (tn) #t (dotted-list? k))))
(assert-eq? (tn) #t (dotted-list? (current-output-port)))
(assert-eq? (tn) #t (dotted-list? '(#t . #t)))
(assert-eq? (tn) #t (dotted-list? (cons #t #t)))
(assert-eq? (tn) #f (dotted-list? '(0 1 2)))
(assert-eq? (tn) #f (dotted-list? (list 0 1 2)))
(assert-eq? (tn) #t (dotted-list? '#()))
(assert-eq? (tn) #t (dotted-list? (vector)))
(assert-eq? (tn) #t (dotted-list? '#(0 1 2)))
(assert-eq? (tn) #t (dotted-list? (vector 0 1 2)))

;; null-list?
(tn "null-list? proper list")
(assert-eq?    (tn) #t (null-list? '()))
(assert-eq?    (tn) #f (null-list? '(1)))
(assert-eq?    (tn) #f (null-list? '(1 2)))
(assert-eq?    (tn) #f (null-list? '(1 2 3)))
(assert-eq?    (tn) #f (null-list? '(1 2 3 4)))
;; SRFI-1: List is a proper or circular list. It is an error to pass this
;; procedure a value which is not a proper or circular list.
(tn "null-list? dotted list")
(if sigscheme?
    (begin
      ;; SigScheme (SRFI-1 reference implementation) specific behavior
      (assert-error  (tn) (lambda () (null-list? 1)))
      (assert-eq?    (tn) #f         (null-list? '(1 . 2)))
      (assert-eq?    (tn) #f         (null-list? '(1 2 . 3)))
      (assert-eq?    (tn) #f         (null-list? '(1 2 3 . 4)))
      (assert-eq?    (tn) #f         (null-list? '(1 2 3 4 . 5)))))
(tn "null-list? circular list")
(assert-eq?    (tn) #f (null-list? clst1))
(assert-eq?    (tn) #f (null-list? clst2))
(assert-eq?    (tn) #f (null-list? clst3))
(assert-eq?    (tn) #f (null-list? clst4))

;; not-pair?
(tn "not-pair? proper list")
(assert-eq?    (tn) #t (not-pair? '()))
(assert-eq?    (tn) #f (not-pair? '(1)))
(assert-eq?    (tn) #f (not-pair? '(1 2)))
(assert-eq?    (tn) #f (not-pair? '(1 2 3)))
(assert-eq?    (tn) #f (not-pair? '(1 2 3 4)))
(tn "not-pair? dotted list")
(assert-eq?    (tn) #t (not-pair? 1))
(assert-eq?    (tn) #f (not-pair? '(1 . 2)))
(assert-eq?    (tn) #f (not-pair? '(1 2 . 3)))
(assert-eq?    (tn) #f (not-pair? '(1 2 3 . 4)))
(assert-eq?    (tn) #f (not-pair? '(1 2 3 4 . 5)))
(tn "not-pair? circular list")
(assert-eq?    (tn) #f (not-pair? clst1))
(assert-eq?    (tn) #f (not-pair? clst2))
(assert-eq?    (tn) #f (not-pair? clst3))
(assert-eq?    (tn) #f (not-pair? clst4))
(tn "not-pair? all kind of Scheme objects")
(assert-eq? (tn) #t (not-pair? #f))
(assert-eq? (tn) #t (not-pair? #t))
(assert-eq? (tn) #t (not-pair? '()))
(if sigscheme?
    (begin
      (assert-eq? (tn) #t (not-pair? (eof)))
      (assert-eq? (tn) #t (not-pair? (undef)))))
(assert-eq? (tn) #t (not-pair? 0))
(assert-eq? (tn) #t (not-pair? 1))
(assert-eq? (tn) #t (not-pair? 3))
(assert-eq? (tn) #t (not-pair? -1))
(assert-eq? (tn) #t (not-pair? -3))
(assert-eq? (tn) #t (not-pair? 'symbol))
(assert-eq? (tn) #t (not-pair? 'SYMBOL))
(assert-eq? (tn) #t (not-pair? #\a))
(assert-eq? (tn) #t (not-pair? #\あ))
(assert-eq? (tn) #t (not-pair? ""))
(assert-eq? (tn) #t (not-pair? " "))
(assert-eq? (tn) #t (not-pair? "a"))
(assert-eq? (tn) #t (not-pair? "A"))
(assert-eq? (tn) #t (not-pair? "aBc12!"))
(assert-eq? (tn) #t (not-pair? "あ"))
(assert-eq? (tn) #t (not-pair? "あ0イう12!"))
(assert-eq? (tn) #t (not-pair? +))
(assert-eq? (tn) #t (not-pair? (lambda () #t)))

;; syntactic keywords should not be appeared as operand
(if sigscheme?
    (begin
      ;; pure syntactic keyword
      (assert-error (tn) (lambda () (not-pair? else)))
      ;; expression keyword
      (assert-error (tn) (lambda () (not-pair? do)))))

(call-with-current-continuation
 (lambda (k)
   (assert-eq? (tn) #t (not-pair? k))))
(assert-eq? (tn) #t (not-pair? (current-output-port)))
(assert-eq? (tn) #f (not-pair? '(#t . #t)))
(assert-eq? (tn) #f (not-pair? (cons #t #t)))
(assert-eq? (tn) #f (not-pair? '(0 1 2)))
(assert-eq? (tn) #f (not-pair? (list 0 1 2)))
(assert-eq? (tn) #t (not-pair? '#()))
(assert-eq? (tn) #t (not-pair? (vector)))
(assert-eq? (tn) #t (not-pair? '#(0 1 2)))
(assert-eq? (tn) #t (not-pair? (vector 0 1 2)))

;; list=
(tn "list= SRFI-1 examples")
(assert-eq? (tn) #t (list= eq?))
(assert-eq? (tn) #t (list= eq? '(a)))
(tn "list= 1 list")
(assert-eq? (tn) #t (list= eq?    '()))
(assert-eq? (tn) #t (list= equal? '()))
(assert-eq? (tn) #t (list= eq?    lst))
(assert-eq? (tn) #t (list= equal? lst))
(assert-eq? (tn) #t (list= eq?    (list elm0)))
(assert-eq? (tn) #t (list= equal? (list elm0)))
(assert-eq? (tn) #t (list= equal? '("a" "b" "c")))
(assert-eq? (tn) #t (list= equal? (list "a" "b" "c")))
(tn "list= 2 lists")
(assert-eq? (tn) #t (list= eq?    '() '()))
(assert-eq? (tn) #t (list= equal? '() '()))
(assert-eq? (tn) #t (list= eq?    lst lst))
(assert-eq? (tn) #t (list= equal? lst lst))
(assert-eq? (tn) #t (list= eq?    (list elm0)           (list elm0)))
(assert-eq? (tn) #t (list= equal? (list elm0)           (list elm0)))
(assert-eq? (tn) #t (list= eq?    (list elm0 elm1)      (list elm0 elm1)))
(assert-eq? (tn) #t (list= equal? (list elm0 elm1)      (list elm0 elm1)))
(assert-eq? (tn) #t (list= eq?    (list elm0 elm1 elm2) (list elm0 elm1 elm2)))
(assert-eq? (tn) #t (list= equal? (list elm0 elm1 elm2) (list elm0 elm1 elm2)))
(assert-eq? (tn) #t (list= equal? '("a" "b" "c")        '("a" "b" "c")))
(assert-eq? (tn) #t (list= equal? (list "a" "b" "c")    (list "a" "b" "c")))
(tn "list= 2 lists unequal length")
(assert-eq? (tn) #f (list= eq?    (list elm0 elm1)      (list elm0 elm1 elm2)))
(assert-eq? (tn) #f (list= equal? (list elm0 elm1)      (list elm0 elm1 elm2)))
(assert-eq? (tn) #f (list= eq?    (list elm0 elm1 elm2) (list elm0 elm1)))
(assert-eq? (tn) #f (list= equal? (list elm0 elm1 elm2) (list elm0 elm1)))
(assert-eq? (tn) #f (list= eq?    '()                   (list elm0 elm1 elm2)))
(assert-eq? (tn) #f (list= equal? '()                   (list elm0 elm1 elm2)))
(assert-eq? (tn) #f (list= eq?    (list elm0 elm1 elm2) '()))
(assert-eq? (tn) #f (list= equal? (list elm0 elm1 elm2) '()))
(tn "list= 3 lists")
(assert-eq? (tn) #t (list= eq?    '() '() '()))
(assert-eq? (tn) #t (list= equal? '() '() '()))
(assert-eq? (tn) #t (list= eq?    lst lst lst))
(assert-eq? (tn) #t (list= equal? lst lst lst))
(assert-eq? (tn) #t (list= eq?    (list elm0) (list elm0) (list elm0)))
(assert-eq? (tn) #t (list= equal? (list elm0) (list elm0) (list elm0)))
(assert-eq? (tn) #t (list= eq?    (list elm0 elm1) (list elm0 elm1)
                                  (list elm0 elm1)))
(assert-eq? (tn) #t (list= equal? (list elm0 elm1) (list elm0 elm1)
                                  (list elm0 elm1)))
(assert-eq? (tn) #t (list= eq?    (list elm0 elm1 elm2) (list elm0 elm1 elm2)
                                  (list elm0 elm1 elm2)))
(assert-eq? (tn) #t (list= equal? (list elm0 elm1 elm2) (list elm0 elm1 elm2)
                                  (list elm0 elm1 elm2)))
(assert-eq? (tn) #t (list= equal? '("a" "b" "c") '("a" "b" "c")
                                  '("a" "b" "c")))
;; This test is failed on the original srfi-1-reference.scm
(assert-eq? (tn) #t (list= equal? (list "a" "b" "c") (list "a" "b" "c")
                                  (list "a" "b" "c")))
(tn "list= 3 lists unequal length")
(assert-eq? (tn) #f (list= eq?    (list elm0 elm1)      (list elm0 elm1 elm2)
                                  (list elm0 elm1 elm2)))
(assert-eq? (tn) #f (list= equal? (list elm0 elm1)      (list elm0 elm1 elm2)
                                  (list elm0 elm1 elm2)))
(assert-eq? (tn) #f (list= eq?    (list elm0 elm1 elm2) (list elm0 elm1)
                                  (list elm0 elm1 elm2)))
(assert-eq? (tn) #f (list= equal? (list elm0 elm1 elm2) (list elm0 elm1)
                                  (list elm0 elm1 elm2)))
(assert-eq? (tn) #f (list= eq?    (list elm0 elm1 elm2) (list elm0 elm1 elm2)
                                  (list elm0 elm1)))
(assert-eq? (tn) #f (list= equal? (list elm0 elm1 elm2) (list elm0 elm1 elm2)
                                  (list elm0 elm1)))
(assert-eq? (tn) #f (list= eq?    '()                   (list elm0 elm1 elm2)
                                  (list elm0 elm1 elm2)))
(assert-eq? (tn) #f (list= equal? '()                   (list elm0 elm1 elm2)
                                  (list elm0 elm1 elm2)))
(assert-eq? (tn) #f (list= eq?    (list elm0 elm1 elm2) '()             
                                  (list elm0 elm1 elm2)))
(assert-eq? (tn) #f (list= equal? (list elm0 elm1 elm2) '()             
                                  (list elm0 elm1 elm2)))
(assert-eq? (tn) #f (list= eq?    (list elm0 elm1 elm2) (list elm0 elm1 elm2)
                                  '()))
(assert-eq? (tn) #f (list= equal? (list elm0 elm1 elm2) (list elm0 elm1 elm2)
                                  '()))
(tn "list= 4 lists")
(assert-eq? (tn) #t (list= eq?    '() '() '() '()))
(assert-eq? (tn) #t (list= equal? '() '() '() '()))
(assert-eq? (tn) #t (list= eq?    lst lst lst lst))
(assert-eq? (tn) #t (list= equal? lst lst lst lst))
(assert-eq? (tn) #t (list= eq?    (list elm0) (list elm0)
                                  (list elm0) (list elm0)))
(assert-eq? (tn) #t (list= equal? (list elm0) (list elm0)
                                  (list elm0) (list elm0)))
(assert-eq? (tn) #t (list= eq?    (list elm0 elm1) (list elm0 elm1)
                                  (list elm0 elm1) (list elm0 elm1)))
(assert-eq? (tn) #t (list= equal? (list elm0 elm1) (list elm0 elm1)
                                  (list elm0 elm1) (list elm0 elm1)))
(assert-eq? (tn) #t (list= eq?    (list elm0 elm1 elm2) (list elm0 elm1 elm2)
                                  (list elm0 elm1 elm2) (list elm0 elm1 elm2)))
(assert-eq? (tn) #t (list= equal? (list elm0 elm1 elm2) (list elm0 elm1 elm2)
                                  (list elm0 elm1 elm2) (list elm0 elm1 elm2)))
(assert-eq? (tn) #t (list= equal? '("a" "b" "c") '("a" "b" "c")
                                  '("a" "b" "c") '("a" "b" "c")))
;; This test is failed on the original srfi-1-reference.scm
(assert-eq? (tn) #t (list= equal? (list "a" "b" "c") (list "a" "b" "c")
                                  (list "a" "b" "c") (list "a" "b" "c")))
(tn "list= 4 lists unequal length")
(assert-eq? (tn) #f (list= eq?    (list elm0 elm1)      (list elm0 elm1 elm2)
                                  (list elm0 elm1 elm2) (list elm0 elm1 elm2)))
(assert-eq? (tn) #f (list= equal? (list elm0 elm1)      (list elm0 elm1 elm2)
                                  (list elm0 elm1 elm2) (list elm0 elm1 elm2)))
(assert-eq? (tn) #f (list= eq?    (list elm0 elm1 elm2) (list elm0 elm1)
                                  (list elm0 elm1 elm2) (list elm0 elm1 elm2)))
(assert-eq? (tn) #f (list= equal? (list elm0 elm1 elm2) (list elm0 elm1)
                                  (list elm0 elm1 elm2) (list elm0 elm1 elm2)))
(assert-eq? (tn) #f (list= eq?    (list elm0 elm1 elm2) (list elm0 elm1 elm2)
                                  (list elm0 elm1)      (list elm0 elm1 elm2)))
(assert-eq? (tn) #f (list= equal? (list elm0 elm1 elm2) (list elm0 elm1 elm2)
                                  (list elm0 elm1)      (list elm0 elm1 elm2)))
(assert-eq? (tn) #f (list= eq?    '()                   (list elm0 elm1 elm2)
                                  (list elm0 elm1 elm2) (list elm0 elm1 elm2)))
(assert-eq? (tn) #f (list= equal? '()                   (list elm0 elm1 elm2)
                                  (list elm0 elm1 elm2) (list elm0 elm1 elm2)))
(assert-eq? (tn) #f (list= eq?    (list elm0 elm1 elm2) '()             
                                  (list elm0 elm1 elm2) (list elm0 elm1 elm2)))
(assert-eq? (tn) #f (list= equal? (list elm0 elm1 elm2) '()             
                                  (list elm0 elm1 elm2) (list elm0 elm1 elm2)))
(assert-eq? (tn) #f (list= eq?    (list elm0 elm1 elm2) (list elm0 elm1 elm2)
                                  '()                   (list elm0 elm1 elm2)))
(assert-eq? (tn) #f (list= equal? (list elm0 elm1 elm2) (list elm0 elm1 elm2)
                                  '()                   (list elm0 elm1 elm2)))
(assert-eq? (tn) #f (list= eq?    (list elm0 elm1 elm2) (list elm0 elm1 elm2)
                                  (list elm0 elm1 elm2) '()))
(assert-eq? (tn) #f (list= equal? (list elm0 elm1 elm2) (list elm0 elm1 elm2)
                                  (list elm0 elm1 elm2) '()))


;;
;; Selectors
;;

(tn "first")
(assert-eq? (tn) elm0 (first   lst))
(tn "second")
(assert-eq? (tn) elm1 (second  lst))
(tn "third")
(assert-eq? (tn) elm2 (third   lst))
(tn "fourth")
(assert-eq? (tn) elm3 (fourth  lst))
(tn "fifth")
(assert-eq? (tn) elm4 (fifth   lst))
(tn "sixth")
(assert-eq? (tn) elm5 (sixth   lst))
(tn "seventh")
(assert-eq? (tn) elm6 (seventh lst))
(tn "eighth")
(assert-eq? (tn) elm7 (eighth  lst))
(tn "ninth")
(assert-eq? (tn) elm8 (ninth   lst))
(tn "tenth")
(assert-eq? (tn) elm9 (tenth   lst))

(tn "car+cdr")
(assert-true (tn) (call-with-values
                      (lambda () (car+cdr (cons elm0 elm1)))
                    (lambda (kar kdr)
                      (and (eq? kar elm0)
                           (eq? kdr elm1)))))

;; take
;;
;; SRFI-1: take returns the first i elements of list x.
;; x may be any value -- a proper, circular, or dotted list.
(tn "take proper list invalid forms")
(assert-error  (tn) (lambda () (take '()        -1)))
(assert-error  (tn) (lambda () (take '(1 2)     -1)))
(tn "take proper list index 0")
(assert-equal? (tn) '()        (take '()        0))
(assert-equal? (tn) '()        (take '(1)       0))
(assert-equal? (tn) '()        (take '(1 2)     0))
(assert-equal? (tn) '()        (take '(1 2 3)   0))
(assert-equal? (tn) '()        (take '(1 2 3 4) 0))
(assert-eq?    (tn) '()        (take lst        0))
(assert-eq?    (tn) '()        (take cdr9       0))
(tn "take proper list index 1")
(assert-error  (tn) (lambda () (take '()        1)))
(assert-equal? (tn) '(1)       (take '(1)       1))
(assert-equal? (tn) '(1)       (take '(1 2)     1))
(assert-equal? (tn) '(1)       (take '(1 2 3)   1))
(assert-equal? (tn) '(1)       (take '(1 2 3 4) 1))
(assert-equal? (tn) (list elm0) (take lst        1))
(assert-equal? (tn) (list elm8) (take cdr8       1))
(assert-equal? (tn) (list elm9) (take cdr9       1))
(tn "take proper list index 2")
(assert-error  (tn) (lambda () (take '()        2)))
(assert-error  (tn) (lambda () (take '(1)       2)))
(assert-equal? (tn) '(1 2)     (take '(1 2)     2))
(assert-equal? (tn) '(1 2)     (take '(1 2 3)   2))
(assert-equal? (tn) '(1 2)     (take '(1 2 3 4) 2))
(assert-equal? (tn) (list elm0 elm1) (take lst        2))
(assert-equal? (tn) (list elm7 elm8) (take cdr7       2))
(assert-equal? (tn) (list elm8 elm9) (take cdr8       2))
(assert-error  (tn) (lambda () (take cdr9        2)))
(tn "take proper list index 3")
(assert-error  (tn) (lambda () (take '()        3)))
(assert-error  (tn) (lambda () (take '(1)       3)))
(assert-error  (tn) (lambda () (take '(1 2)     3)))
(assert-equal? (tn) '(1 2 3)   (take '(1 2 3)   3))
(assert-equal? (tn) '(1 2 3)   (take '(1 2 3 4) 3))
(assert-equal? (tn) (list elm0 elm1 elm2) (take lst        3))
(assert-equal? (tn) (list elm6 elm7 elm8) (take cdr6       3))
(assert-equal? (tn) (list elm7 elm8 elm9) (take cdr7       3))
(assert-error  (tn) (lambda () (take cdr8        3)))
(assert-error  (tn) (lambda () (take cdr9        3)))
(tn "take proper list index 4")
(assert-error  (tn) (lambda () (take '()        4)))
(assert-error  (tn) (lambda () (take '(1)       4)))
(assert-error  (tn) (lambda () (take '(1 2)     4)))
(assert-error  (tn) (lambda () (take '(1 2 3)   4)))
(assert-equal? (tn) '(1 2 3 4) (take '(1 2 3 4) 4))
(assert-equal? (tn) (list elm0 elm1 elm2 elm3) (take lst        4))
(assert-equal? (tn) (list elm5 elm6 elm7 elm8) (take cdr5       4))
(assert-equal? (tn) (list elm6 elm7 elm8 elm9) (take cdr6       4))
(assert-error  (tn) (lambda () (take cdr7        4)))
(assert-error  (tn) (lambda () (take cdr8        4)))
(assert-error  (tn) (lambda () (take cdr9        4)))
(tn "take proper list index 5")
(assert-error  (tn) (lambda () (take '()        5)))
(assert-error  (tn) (lambda () (take '(1)       5)))
(assert-error  (tn) (lambda () (take '(1 2)     5)))
(assert-error  (tn) (lambda () (take '(1 2 3)   5)))
(assert-error  (tn) (lambda () (take '(1 2 3 4) 5)))
(assert-equal? (tn) (list elm0 elm1 elm2 elm3 elm4) (take lst        5))
(assert-equal? (tn) (list elm4 elm5 elm6 elm7 elm8) (take cdr4       5))
(assert-equal? (tn) (list elm5 elm6 elm7 elm8 elm9) (take cdr5       5))
(assert-error  (tn) (lambda () (take cdr6        5)))
(assert-error  (tn) (lambda () (take cdr7        5)))
(assert-error  (tn) (lambda () (take cdr8        5)))
(assert-error  (tn) (lambda () (take cdr9        5)))
(tn "take proper list other indices")
(assert-equal? (tn)
               (list elm0 elm1 elm2 elm3 elm4 elm5)
               (take lst 6))
(assert-equal? (tn)
               (list elm0 elm1 elm2 elm3 elm4 elm5 elm6)
               (take lst 7))
(assert-equal? (tn)
               (list elm0 elm1 elm2 elm3 elm4 elm5 elm6 elm7)
               (take lst 8))
(assert-equal? (tn)
               (list elm0 elm1 elm2 elm3 elm4 elm5 elm6 elm7 elm8)
               (take lst 9))
(assert-equal? (tn)
               (list elm0 elm1 elm2 elm3 elm4 elm5 elm6 elm7 elm8 elm9)
               (take lst 10))
(assert-error  (tn) (lambda () (take lst 11)))

(tn "take dotted list invalid forms")
(assert-error  (tn) (lambda ()     (take 1              -1)))
(assert-error  (tn) (lambda ()     (take '(1 . 2)       -1)))
(tn "take dotted list index 0")
(assert-equal? (tn) '()            (take 1              0))
(assert-equal? (tn) '()            (take '(1 . 2)       0))
(assert-equal? (tn) '()            (take '(1 2 . 3)     0))
(assert-equal? (tn) '()            (take '(1 2 3 . 4)   0))
(assert-equal? (tn) '()            (take '(1 2 3 4 . 5) 0))
(tn "take dotted list index 1")
(assert-error  (tn) (lambda ()     (take 1              1)))
(assert-equal? (tn) '(1)           (take '(1 . 2)       1))
(assert-equal? (tn) '(1)           (take '(1 2 . 3)     1))
(assert-equal? (tn) '(1)           (take '(1 2 3 . 4)   1))
(assert-equal? (tn) '(1)           (take '(1 2 3 4 . 5) 1))
(tn "take dotted list index 2")
(assert-error  (tn) (lambda ()     (take 1              2)))
(assert-error  (tn) (lambda ()     (take '(1 . 2)       2)))
(assert-equal? (tn) '(1 2)         (take '(1 2 . 3)     2))
(assert-equal? (tn) '(1 2)         (take '(1 2 3 . 4)   2))
(assert-equal? (tn) '(1 2)         (take '(1 2 3 4 . 5) 2))
(tn "take dotted list index 3")
(assert-error  (tn) (lambda ()     (take 1              3)))
(assert-error  (tn) (lambda ()     (take '(1 . 2)       3)))
(assert-error  (tn) (lambda ()     (take '(1 2 . 3)     3)))
(assert-equal? (tn) '(1 2 3)       (take '(1 2 3 . 4)   3))
(assert-equal? (tn) '(1 2 3)       (take '(1 2 3 4 . 5) 3))
(tn "take dotted list index 4")
(assert-error  (tn) (lambda ()     (take 1              4)))
(assert-error  (tn) (lambda ()     (take '(1 . 2)       4)))
(assert-error  (tn) (lambda ()     (take '(1 2 . 3)     4)))
(assert-error  (tn) (lambda ()     (take '(1 2 3 . 4)   4)))
(assert-equal? (tn) '(1 2 3 4)     (take '(1 2 3 4 . 5) 4))
(tn "take dotted list index 5")
(assert-error  (tn) (lambda ()     (take 1              5)))
(assert-error  (tn) (lambda ()     (take '(1 . 2)       5)))
(assert-error  (tn) (lambda ()     (take '(1 2 . 3)     5)))
(assert-error  (tn) (lambda ()     (take '(1 2 3 . 4)   5)))
(assert-error  (tn) (lambda ()     (take '(1 2 3 4 . 5) 5)))

(tn "take circular list invalid forms")
;; SigScheme's implementation does not detect negative index on circular list
;; since it is an user error. It goes an infinite loop.
;;(assert-error  (tn) (lambda ()             (take clst1 -1)))
;;(assert-error  (tn) (lambda ()             (take clst2 -1)))
(tn "take circular list index 0")
(assert-eq?    (tn) '()                    (take clst1 0))
(assert-eq?    (tn) '()                    (take clst2 0))
(assert-eq?    (tn) '()                    (take clst3 0))
(assert-eq?    (tn) '()                    (take clst4 0))
(tn "take circular list index 1")
(assert-equal? (tn) (list (list-ref clst1 0)) (take clst1 1))
(assert-equal? (tn) (list (list-ref clst2 0)) (take clst2 1))
(assert-equal? (tn) (list (list-ref clst3 0)) (take clst3 1))
(assert-equal? (tn) (list (list-ref clst4 0)) (take clst4 1))
(tn "take circular list index 2")
(assert-equal? (tn) (list (list-ref clst1 0)
                          (list-ref clst1 0)) (take clst1 2))
(assert-equal? (tn) (list (list-ref clst2 0)
                          (list-ref clst2 1)) (take clst2 2))
(assert-equal? (tn) (list (list-ref clst3 0)
                          (list-ref clst3 1)) (take clst3 2))
(assert-equal? (tn) (list (list-ref clst4 0)
                          (list-ref clst4 1)) (take clst4 2))
(tn "take circular list index 3")
(assert-equal? (tn) (list (list-ref clst1 0)
                          (list-ref clst1 0)
                          (list-ref clst1 0)) (take clst1 3))
(assert-equal? (tn) (list (list-ref clst2 0)
                          (list-ref clst2 1)
                          (list-ref clst2 0)) (take clst2 3))
(assert-equal? (tn) (list (list-ref clst3 0)
                          (list-ref clst3 1)
                          (list-ref clst3 2)) (take clst3 3))
(assert-equal? (tn) (list (list-ref clst4 0)
                          (list-ref clst4 1)
                          (list-ref clst4 2)) (take clst4 3))
(tn "take circular list index 4")
(assert-equal? (tn) (list (list-ref clst1 0)
                          (list-ref clst1 0)
                          (list-ref clst1 0)
                          (list-ref clst1 0)) (take clst1 4))
(assert-equal? (tn) (list (list-ref clst2 0)
                          (list-ref clst2 1)
                          (list-ref clst2 0)
                          (list-ref clst2 1)) (take clst2 4))
(assert-equal? (tn) (list (list-ref clst3 0)
                          (list-ref clst3 1)
                          (list-ref clst3 2)
                          (list-ref clst3 0)) (take clst3 4))
(assert-equal? (tn) (list (list-ref clst4 0)
                          (list-ref clst4 1)
                          (list-ref clst4 2)
                          (list-ref clst4 3)) (take clst4 4))
(tn "take circular list index 5")
(assert-equal? (tn) (list (list-ref clst1 0)
                          (list-ref clst1 0)
                          (list-ref clst1 0)
                          (list-ref clst1 0)
                          (list-ref clst1 0)) (take clst1 5))
(assert-equal? (tn) (list (list-ref clst2 0)
                          (list-ref clst2 1)
                          (list-ref clst2 0)
                          (list-ref clst2 1)
                          (list-ref clst2 0)) (take clst2 5))
(assert-equal? (tn) (list (list-ref clst3 0)
                          (list-ref clst3 1)
                          (list-ref clst3 2)
                          (list-ref clst3 0)
                          (list-ref clst3 1)) (take clst3 5))
(assert-equal? (tn) (list (list-ref clst4 0)
                          (list-ref clst4 1)
                          (list-ref clst4 2)
                          (list-ref clst4 3)
                          (list-ref clst4 0)) (take clst4 5))
(tn "take freshly-allocated entire list")
;; SRFI-1: If the argument is a list of non-zero length, take is guaranteed to
;; return a freshly-allocated list, even in the case where the entire list is
;; taken, e.g. (take lis (length lis)).
(assert-false  (tn) (eq?    lst (take lst (length lst))))
(assert-true   (tn) (equal? lst (take lst (length lst))))
(define find-pair
  (lambda (x lst)
    (let rec ((rest lst))
      (if (null? rest)
          #f
          (or (eq? x rest)
              (rec (cdr rest)))))))
;; Check uniqueness for each pair in the new list.
(assert-true   (tn) (let rec ((rest (take lst (length lst))))
                      (if (null? rest)
                          #t
                          (and (not (find-pair rest lst))
                               (rec (cdr rest))))))
(tn "take SRFI-1 examples")
(assert-equal? (tn) '(a b)   (take '(a b c d e) 2))
(assert-equal? (tn) '(1 2)   (take '(1 2 3 . d) 2))
(assert-equal? (tn) '(1 2 3) (take '(1 2 3 . d) 3))

;; drop
;;
;; SRFI-1: drop returns all but the first i elements of list x.
;; x may be any value -- a proper, circular, or dotted list.
(tn "drop proper list invalid forms")
(assert-error  (tn) (lambda () (drop '()        -1)))
(assert-error  (tn) (lambda () (drop '(1 2)     -1)))
(tn "drop proper list index 0")
(assert-equal? (tn) '()        (drop '()        0))
(assert-equal? (tn) '(1)       (drop '(1)       0))
(assert-equal? (tn) '(1 2)     (drop '(1 2)     0))
(assert-equal? (tn) '(1 2 3)   (drop '(1 2 3)   0))
(assert-equal? (tn) '(1 2 3 4) (drop '(1 2 3 4) 0))
(assert-eq?    (tn) cdr0       (drop lst        0))
(assert-eq?    (tn) cdr9       (drop cdr9       0))
(tn "drop proper list index 1")
(assert-error  (tn) (lambda () (drop '()        1)))
(assert-equal? (tn) '()        (drop '(1)       1))
(assert-equal? (tn) '(2)       (drop '(1 2)     1))
(assert-equal? (tn) '(2 3)     (drop '(1 2 3)   1))
(assert-equal? (tn) '(2 3 4)   (drop '(1 2 3 4) 1))
(assert-eq?    (tn) cdr1       (drop lst        1))
(assert-eq?    (tn) cdr9       (drop cdr8       1))
(assert-eq?    (tn) '()        (drop cdr9       1))
(tn "drop proper list index 2")
(assert-error  (tn) (lambda () (drop '()        2)))
(assert-error  (tn) (lambda () (drop '(1)       2)))
(assert-equal? (tn) '()        (drop '(1 2)     2))
(assert-equal? (tn) '(3)       (drop '(1 2 3)   2))
(assert-equal? (tn) '(3 4)     (drop '(1 2 3 4) 2))
(assert-eq?    (tn) cdr2       (drop lst        2))
(assert-eq?    (tn) cdr9       (drop cdr7       2))
(assert-eq?    (tn) '()        (drop cdr8       2))
(assert-error  (tn) (lambda () (drop cdr9       2)))
(tn "drop proper list index 3")
(assert-error  (tn) (lambda () (drop '()        3)))
(assert-error  (tn) (lambda () (drop '(1)       3)))
(assert-error  (tn) (lambda () (drop '(1 2)     3)))
(assert-equal? (tn) '()        (drop '(1 2 3)   3))
(assert-equal? (tn) '(4)       (drop '(1 2 3 4) 3))
(assert-eq?    (tn) cdr3       (drop lst        3))
(assert-eq?    (tn) cdr9       (drop cdr6       3))
(assert-eq?    (tn) '()        (drop cdr7       3))
(assert-error  (tn) (lambda () (drop cdr8       3)))
(assert-error  (tn) (lambda () (drop cdr9       3)))
(tn "drop proper list index 4")
(assert-error  (tn) (lambda () (drop '()        4)))
(assert-error  (tn) (lambda () (drop '(1)       4)))
(assert-error  (tn) (lambda () (drop '(1 2)     4)))
(assert-error  (tn) (lambda () (drop '(1 2 3)   4)))
(assert-equal? (tn) '()        (drop '(1 2 3 4) 4))
(assert-eq?    (tn) cdr4       (drop lst        4))
(assert-eq?    (tn) cdr9       (drop cdr5       4))
(assert-eq?    (tn) '()        (drop cdr6       4))
(assert-error  (tn) (lambda () (drop cdr7       4)))
(assert-error  (tn) (lambda () (drop cdr8       4)))
(assert-error  (tn) (lambda () (drop cdr9       4)))
(tn "drop proper list index 5")
(assert-error  (tn) (lambda () (drop '()        5)))
(assert-error  (tn) (lambda () (drop '(1)       5)))
(assert-error  (tn) (lambda () (drop '(1 2)     5)))
(assert-error  (tn) (lambda () (drop '(1 2 3)   5)))
(assert-error  (tn) (lambda () (drop '(1 2 3 4) 5)))
(assert-eq?    (tn) cdr5       (drop lst        5))
(assert-eq?    (tn) cdr9       (drop cdr4       5))
(assert-eq?    (tn) '()        (drop cdr5       5))
(assert-error  (tn) (lambda () (drop cdr6       5)))
(assert-error  (tn) (lambda () (drop cdr7       5)))
(assert-error  (tn) (lambda () (drop cdr8       5)))
(assert-error  (tn) (lambda () (drop cdr9       5)))
(tn "drop proper list other indices")
(assert-eq?    (tn) cdr6       (drop lst        6))
(assert-eq?    (tn) cdr7       (drop lst        7))
(assert-eq?    (tn) cdr8       (drop lst        8))
(assert-eq?    (tn) cdr9       (drop lst        9))
(assert-eq?    (tn) '()        (drop lst        10))
(assert-error  (tn) (lambda () (drop lst        11)))

(tn "drop dotted list invalid forms")
(assert-error  (tn) (lambda ()     (drop 1              -1)))
(assert-error  (tn) (lambda ()     (drop '(1 . 2)       -1)))
(tn "drop dotted list index 0")
(assert-equal? (tn) 1              (drop 1              0))
(assert-equal? (tn) '(1 . 2)       (drop '(1 . 2)       0))
(assert-equal? (tn) '(1 2 . 3)     (drop '(1 2 . 3)     0))
(assert-equal? (tn) '(1 2 3 . 4)   (drop '(1 2 3 . 4)   0))
(assert-equal? (tn) '(1 2 3 4 . 5) (drop '(1 2 3 4 . 5) 0))
(tn "drop dotted list index 1")
(assert-error  (tn) (lambda ()     (drop 1              1)))
(assert-equal? (tn) 2              (drop '(1 . 2)       1))
(assert-equal? (tn) '(2 . 3)       (drop '(1 2 . 3)     1))
(assert-equal? (tn) '(2 3 . 4)     (drop '(1 2 3 . 4)   1))
(assert-equal? (tn) '(2 3 4 . 5)   (drop '(1 2 3 4 . 5) 1))
(tn "drop dotted list index 2")
(assert-error  (tn) (lambda ()     (drop 1              2)))
(assert-error  (tn) (lambda ()     (drop '(1 . 2)       2)))
(assert-equal? (tn) 3              (drop '(1 2 . 3)     2))
(assert-equal? (tn) '(3 . 4)       (drop '(1 2 3 . 4)   2))
(assert-equal? (tn) '(3 4 . 5)     (drop '(1 2 3 4 . 5) 2))
(tn "drop dotted list index 3")
(assert-error  (tn) (lambda ()     (drop 1              3)))
(assert-error  (tn) (lambda ()     (drop '(1 . 2)       3)))
(assert-error  (tn) (lambda ()     (drop '(1 2 . 3)     3)))
(assert-equal? (tn) 4              (drop '(1 2 3 . 4)   3))
(assert-equal? (tn) '(4 . 5)       (drop '(1 2 3 4 . 5) 3))
(tn "drop dotted list index 4")
(assert-error  (tn) (lambda ()     (drop 1              4)))
(assert-error  (tn) (lambda ()     (drop '(1 . 2)       4)))
(assert-error  (tn) (lambda ()     (drop '(1 2 . 3)     4)))
(assert-error  (tn) (lambda ()     (drop '(1 2 3 . 4)   4)))
(assert-equal? (tn) 5              (drop '(1 2 3 4 . 5) 4))
(tn "drop dotted list index 5")
(assert-error  (tn) (lambda ()     (drop 1              5)))
(assert-error  (tn) (lambda ()     (drop '(1 . 2)       5)))
(assert-error  (tn) (lambda ()     (drop '(1 2 . 3)     5)))
(assert-error  (tn) (lambda ()     (drop '(1 2 3 . 4)   5)))
(assert-error  (tn) (lambda ()     (drop '(1 2 3 4 . 5) 5)))

(tn "drop circular list invalid forms")
;; SigScheme's implementation does not detect negative index on circular list
;; since it is an user error. It goes an infinite loop.
;;(assert-error  (tn) (lambda ()             (drop clst1 -1)))
;;(assert-error  (tn) (lambda ()             (drop clst2 -1)))
(tn "drop circular list index 0")
(assert-eq?    (tn) clst1                  (drop clst1 0))
(assert-eq?    (tn) clst2                  (drop clst2 0))
(assert-eq?    (tn) clst3                  (drop clst3 0))
(assert-eq?    (tn) clst4                  (drop clst4 0))
(tn "drop circular list index 1")
(assert-eq?    (tn) clst1                  (drop clst1 1))
(assert-eq?    (tn) (my-list-tail clst2 1) (drop clst2 1))
(assert-eq?    (tn) (my-list-tail clst3 1) (drop clst3 1))
(assert-eq?    (tn) (my-list-tail clst4 1) (drop clst4 1))
(tn "drop circular list index 2")
(assert-eq?    (tn) clst1                  (drop clst1 2))
(assert-eq?    (tn) clst2                  (drop clst2 2))
(assert-eq?    (tn) (my-list-tail clst3 2) (drop clst3 2))
(assert-eq?    (tn) (my-list-tail clst4 2) (drop clst4 2))
(tn "drop circular list index 3")
(assert-eq?    (tn) clst1                  (drop clst1 3))
(assert-eq?    (tn) (my-list-tail clst2 1) (drop clst2 3))
(assert-eq?    (tn) clst3                  (drop clst3 3))
(assert-eq?    (tn) (my-list-tail clst4 3) (drop clst4 3))
(tn "drop circular list index 4")
(assert-eq?    (tn) clst1                  (drop clst1 4))
(assert-eq?    (tn) clst2                  (drop clst2 4))
(assert-eq?    (tn) (my-list-tail clst3 1) (drop clst3 4))
(assert-eq?    (tn) clst4                  (drop clst4 4))
(tn "drop circular list index 5")
(assert-eq?    (tn) clst1                  (drop clst1 5))
(assert-eq?    (tn) (my-list-tail clst2 1) (drop clst2 5))
(assert-eq?    (tn) (my-list-tail clst3 2) (drop clst3 5))
(assert-eq?    (tn) (my-list-tail clst4 1) (drop clst4 5))
(tn "drop circular list index 6")
(assert-eq?    (tn) clst1                  (drop clst1 6))
(assert-eq?    (tn) clst2                  (drop clst2 6))
(assert-eq?    (tn) clst3                  (drop clst3 6))
(assert-eq?    (tn) (my-list-tail clst4 2) (drop clst4 6))

(tn "drop SRFI-1 examples")
(assert-equal? (tn) '(c d e) (drop '(a b c d e) 2))
(assert-equal? (tn) '(3 . d) (drop '(1 2 3 . d) 2))
(assert-equal? (tn) 'd       (drop '(1 2 3 . d) 3))

;; take-right
;; drop-right
;; take!
;; drop-right!
;; split-at
;; split-at!

;; last
;;
;; SRFI-1: last returns the last element of the non-empty, finite list pair.
(tn "last invalid forms")
(assert-error  (tn) (lambda () (last '())))
(assert-error  (tn) (lambda () (last 1)))
(tn "last")
(assert-eq?    (tn) elm9       (last lst))
(assert-eq?    (tn) elm9       (last cdr7))
(assert-eq?    (tn) elm9       (last cdr8))
(assert-eq?    (tn) elm9       (last cdr9))
(assert-equal? (tn) 1          (last '(1 . 2)))
(assert-equal? (tn) 2          (last '(1 2 . 3)))
(assert-equal? (tn) 3          (last '(1 2 3 . 4)))

;; last-pair
;;
;; SRFI-1: last-pair returns the last pair in the non-empty, finite list pair.
(tn "last-pair invalid forms")
(assert-error  (tn) (lambda () (last-pair '())))
(assert-error  (tn) (lambda () (last-pair 1)))
(tn "last-pair")
(assert-eq?    (tn) cdr9       (last-pair lst))
(assert-eq?    (tn) cdr9       (last-pair cdr7))
(assert-eq?    (tn) cdr9       (last-pair cdr8))
(assert-eq?    (tn) cdr9       (last-pair cdr9))
(assert-equal? (tn) '(1 . 2)   (last-pair '(1 . 2)))
(assert-equal? (tn) '(2 . 3)   (last-pair '(1 2 . 3)))
(assert-equal? (tn) '(3 . 4)   (last-pair '(1 2 3 . 4)))


;;
;; Miscellaneous: length, append, concatenate, reverse, zip & count
;;

;; length+
(tn "length+ proper list")
(assert-equal? (tn) 0 (length+ '()))
(assert-equal? (tn) 1 (length+ '(1)))
(assert-equal? (tn) 2 (length+ '(1 2)))
(assert-equal? (tn) 3 (length+ '(1 2 3)))
(assert-equal? (tn) 4 (length+ '(1 2 3 4)))
(tn "length+ dotted list")
;; Although the behavior on dotted list is not defined in SRFI-1 itself, the
;; reference implementation returns its length. So SigScheme followed it.
(if sigscheme?
    (begin
      (assert-equal? (tn) 0 (length+ 1))
      (assert-equal? (tn) 1 (length+ '(1 . 2)))
      (assert-equal? (tn) 2 (length+ '(1 2 . 3)))
      (assert-equal? (tn) 3 (length+ '(1 2 3 . 4)))
      (assert-equal? (tn) 4 (length+ '(1 2 3 4 . 5)))))
(tn "length+ circular list")
(assert-eq?    (tn) #f (length+ clst1))
(assert-eq?    (tn) #f (length+ clst2))
(assert-eq?    (tn) #f (length+ clst3))
(assert-eq?    (tn) #f (length+ clst4))

;; append!
(tn "append!")
(assert-equal? (tn) '()            (append!))
(assert-equal? (tn) '()            (append! '()))
(assert-equal? (tn) '()            (append! '() '()))
(assert-equal? (tn) '()            (append! '() '() '()))
(assert-equal? (tn) '(a)           (append! (list 'a) '() '()))
(assert-equal? (tn) '(a)           (append! '() (list 'a) '()))
(assert-equal? (tn) '(a)           (append! '() '() '(a)))
(assert-equal? (tn) 'a             (append! 'a))
(assert-equal? (tn) '(a . b)       (append! '(a . b)))
(assert-equal? (tn) '(a . b)       (append! '() '() '(a . b)))
(assert-equal? (tn) '(1 2 3 a . b) (append! (list 1) (list 2 3) '(a . b)))
(assert-equal? (tn) 7              (append! (+ 3 4)))
(assert-equal? (tn) '(+ 3 4)       (append! '(+ 3 4)))
(assert-equal? (tn) '(a b)         (append! '(a b)))
(assert-equal? (tn) '(c d e a b)   (append! (list 'c) (list 'd 'e) '(a b)))
;; The reference implementation does not cause error on non-tail dotted list.
;;(assert-error  (tn) (lambda () (append! 'a 'b)))
;;(assert-error  (tn) (lambda () (append! 'a '(b))))
;;(assert-error  (tn) (lambda () (append! 'a '())))
;;(assert-error  (tn) (lambda () (append! (cons 'a 'b) '())))
;;(assert-error  (tn) (lambda () (append! '() (cons 'a  'b) '())))
(tn "append! shared tail")
;; SRFI-1: The last argument is never altered; the result list shares structure
;; with this parameter.
(assert-equal? (tn)
               (list 1 2 3 elm8 elm9)
               (append! (list 1) (list 2 3) cdr8))
(assert-eq?    (tn)
               cdr8
               (my-list-tail (append! (list 1) (list 2 3) cdr8) 3))

;; concatenate
(tn "concatenate invalid forms")
(assert-error  (tn) (lambda ()     (concatenate)))
(assert-error  (tn) (lambda ()     (concatenate #t)))
(tn "concatenate")
(assert-equal? (tn) '()            (concatenate '()))
(assert-equal? (tn) '()            (concatenate '(())))
(assert-equal? (tn) '()            (concatenate '(() ())))
(assert-equal? (tn) '()            (concatenate '(() () ())))
(assert-equal? (tn) '(a)           (concatenate '((a) () ())))
(assert-equal? (tn) '(a)           (concatenate '(() (a) ())))
(assert-equal? (tn) '(a)           (concatenate '(() () (a))))
(assert-equal? (tn) 'a             (concatenate '(a)))
(assert-equal? (tn) '(a . b)       (concatenate '((a . b))))
(assert-equal? (tn) '(a . b)       (concatenate '(() () (a . b))))
(assert-equal? (tn) '(1 2 3 a . b) (concatenate '((1) (2 3) (a . b))))
(assert-equal? (tn) 7              (concatenate (list (+ 3 4))))
(assert-equal? (tn) '(+ 3 4)       (concatenate '((+ 3 4))))
(assert-equal? (tn) '(a b)         (concatenate '((a b))))
(assert-equal? (tn) '(c d e a b)   (concatenate '((c) (d e) (a b))))

;; concatenate!
(tn "concatenate! invalid forms")
(assert-error  (tn) (lambda ()     (concatenate!)))
(assert-error  (tn) (lambda ()     (concatenate! #t)))
(tn "concatenate!")
(assert-equal? (tn) '()            (concatenate! '()))
(assert-equal? (tn) '()            (concatenate! (list '())))
(assert-equal? (tn) '()            (concatenate! (list '() '())))
(assert-equal? (tn) '()            (concatenate! (list '() '() '())))
(assert-equal? (tn) '(a)           (concatenate! (list (list 'a) '() '())))
(assert-equal? (tn) '(a)           (concatenate! (list '() (list 'a) '())))
(assert-equal? (tn) '(a)           (concatenate! (list '() '() '(a))))
(assert-equal? (tn) 'a             (concatenate! '(a)))
(assert-equal? (tn) '(a . b)       (concatenate! '((a . b))))
(assert-equal? (tn) '(a . b)       (concatenate! (list '() '() '(a . b))))
(assert-equal? (tn) '(1 2 3 a . b) (concatenate! (list (list 1) (list 2 3) '(a . b))))
(assert-equal? (tn) 7              (concatenate! (list (+ 3 4))))
(assert-equal? (tn) '(+ 3 4)       (concatenate! '((+ 3 4))))
(assert-equal? (tn) '(a b)         (concatenate! '((a b))))
(assert-equal? (tn) '(c d e a b)   (concatenate! (list (list 'c) (list 'd 'e) '(a b))))

;; reverse!

;;append-reverse
(tn "append-reverse invalid forms")
(assert-error  (tn) (lambda ()     (append-reverse #t       '())))
(tn "append-reverse")
(assert-equal? (tn) '()            (append-reverse '()      '()))
(assert-equal? (tn) '(3 2 1)       (append-reverse '(1 2 3) '()))
(assert-equal? (tn) '(3 2 1 4 5 6) (append-reverse '(1 2 3) '(4 5 6)))
(assert-equal? (tn) '(4 5 6)       (append-reverse '()      '(4 5 6)))
(assert-equal? (tn) '(3 2 1 . #t)  (append-reverse '(1 2 3) #t))
(assert-equal? (tn) #t             (append-reverse '()      #t))

;; append-reverse!
;;
;; SRFI-1: it is allowed, but not required, to alter rev-head's cons cells to
;; construct the result.
(tn "append-reverse! invalid forms")
(assert-error  (tn) (lambda ()     (append-reverse! #t           '())))
(tn "append-reverse!")
(assert-equal? (tn) '()            (append-reverse! '()          '()))
(assert-equal? (tn) '(3 2 1)       (append-reverse! (list 1 2 3) '()))
(assert-equal? (tn) '(3 2 1 4 5 6) (append-reverse! (list 1 2 3) '(4 5 6)))
(assert-equal? (tn) '(4 5 6)       (append-reverse! '()          '(4 5 6)))
(assert-equal? (tn) '(3 2 1 . #t)  (append-reverse! (list 1 2 3) #t))
(assert-equal? (tn) #t             (append-reverse! '()          #t))

;; zip
(tn "zip invalid forms")
(assert-error  (tn) (lambda ()     (zip)))
(tn "zip single list")
(assert-equal? (tn) '()            (zip '()))
(assert-equal? (tn) '((1))         (zip '(1)))
(assert-equal? (tn) '((1) (2))     (zip '(1 2)))
(assert-equal? (tn) '((1) (2) (3)) (zip '(1 2 3)))
(tn "zip 3 lists")
(assert-equal? (tn) '()                        (zip '() '() '()))
(assert-equal? (tn) '((1 4 7))                 (zip '(1) '(4) '(7)))
(assert-equal? (tn) '((1 4 7) (2 5 8))         (zip '(1 2) '(4 5) '(7 8)))
(assert-equal? (tn) '((1 4 7) (2 5 8) (3 6 9)) (zip '(1 2 3) '(4 5 6) '(7 8 9)))
(tn "zip 3 lists unequal length")
(assert-equal? (tn) '()                (zip '()  '(4) '(7)))
(assert-equal? (tn) '()                (zip '(1) '()  '(7)))
(assert-equal? (tn) '()                (zip '(1) '(4) '()))
(assert-equal? (tn) '((1 4 7))         (zip '(1)   '(4 5) '(7 8)))
(assert-equal? (tn) '((1 4 7))         (zip '(1 2) '(4)   '(7 8)))
(assert-equal? (tn) '((1 4 7))         (zip '(1 2) '(4 5) '(7)))
(assert-equal? (tn) '((1 4 7) (2 5 8)) (zip '(1 2)   '(4 5 6) '(7 8 9)))
(assert-equal? (tn) '((1 4 7) (2 5 8)) (zip '(1 2 3) '(4 5)   '(7 8 9)))
(assert-equal? (tn) '((1 4 7) (2 5 8)) (zip '(1 2 3) '(4 5 6) '(7 8)))
(tn "zip SRFI-1 examples")
(assert-equal? (tn)
               '((one 1 odd) (two 2 even) (three 3 odd))
               (zip '(one two three) 
                    '(1 2 3)
                    '(odd even odd even odd even odd even)))
(assert-equal? (tn)
               '((1) (2) (3))
               (zip '(1 2 3)))
;; SRFI-1: At least one of the argument lists must be finite.
(assert-equal? (tn)
               '((3 #f) (1 #t) (4 #f) (1 #t))
               (zip '(3 1 4 1) (circular-list #f #t)))

;; unzip1
;; unzip2
;; unzip3
;; unzip4
;; unzip5
;; count

;;
;; Fold, unfold & map
;;

;; fold
(tn "fold invalid forms")
(assert-error  (tn) (lambda () (fold cons)))
(assert-error  (tn) (lambda () (fold cons '())))
(assert-error  (tn) (lambda () (fold cons '#())))
(assert-error  (tn) (lambda () (fold cons '(1) '#(2))))
(assert-error  (tn) (lambda () (fold #\a '())))
(tn "fold single list")
(assert-equal? (tn) '()      (fold cons '() '()))
(assert-equal? (tn) '(1)     (fold cons '() '(1)))
(assert-equal? (tn) '(2 1)   (fold cons '() '(1 2)))
(assert-equal? (tn) '(3 2 1) (fold cons '() '(1 2 3)))
(tn "fold 3 lists")
(assert-equal? (tn)
               "cCzbByaAxNIL"
               (fold string-append
                     "NIL"
                     '("a" "b" "c") '("A" "B" "C") '("x" "y" "z")))
;; unequal length
(assert-equal? (tn)
               "bByaAxNIL"
               (fold string-append
                     "NIL"
                     '("a" "b" "c") '("A" "B") '("x" "y" "z")))
(assert-equal? (tn)
               "NIL"
               (fold string-append
                     "NIL"
                     '("a" "b" "c") '() '("x" "y" "z")))
(tn "fold SRFI-1 examples")
;; Add up the elements of list.
(assert-equal? (tn) 15 (fold + 0 '(1 2 3 4 5)))
;; Reverse LST.
(assert-equal? (tn)
               (list elm9 elm8 elm7 elm6 elm5 elm4 elm3 elm2 elm1 elm0)
               (fold cons '() lst))
;; See APPEND-REVERSE.
(assert-equal? (tn)
               '(10 9 8 1 2 3)
               (let ((tail '(1 2 3))
                     (rev-head '(8 9 10)))
                 (fold cons tail rev-head)))
;; How many symbols in list?
(assert-equal? (tn)
               0
               (fold (lambda (x count) (if (symbol? x) (+ count 1) count))
                     0
                     lst))
(assert-equal? (tn)
               3
               (fold (lambda (x count) (if (symbol? x) (+ count 1) count))
                     0
                     '(0 #\a a "a" b (0) c)))
;; Length of the longest string in list:
(assert-equal? (tn)
               17
               (fold (lambda (s max-len) (max max-len (string-length s)))
                     0
                     '("" "string-append" "str" "SigScheme Project" "SRFI-1")))
;; unequal length lists
(assert-equal? (tn)
               '(c 3 b 2 a 1)
               (fold cons* '() '(a b c) '(1 2 3 4 5)))

;; fold-right
;; pair-fold
;; pair-fold-right

;; reduce
(tn "reduce invalid forms")
(assert-error  (tn) (lambda () (reduce cons)))
(assert-error  (tn) (lambda () (reduce cons '())))
(assert-error  (tn) (lambda () (reduce cons '#())))
(assert-error  (tn) (lambda () (reduce cons '() '#(2))))
(assert-error  (tn) (lambda () (reduce #\a '())))
(tn "reduce")
(assert-equal? (tn) 0        (reduce + 0 '()))
(assert-equal? (tn) 1        (reduce + 0 '(1)))
(assert-equal? (tn) 3        (reduce + 0 '(1 2)))
(assert-equal? (tn) 6        (reduce + 0 '(1 2 3)))
(assert-equal? (tn) ""       (reduce string-append "" '()))
(assert-equal? (tn) "a"      (reduce string-append "" '("a")))
(assert-equal? (tn) "ba"     (reduce string-append "" '("a" "b")))
(assert-equal? (tn) "cba"    (reduce string-append "" '("a" "b" "c")))
(assert-equal? (tn) '()      (reduce cons '() '()))
(assert-equal? (tn) '(1)     (reduce cons '() '(() 1)))
(assert-equal? (tn) '(2 1)   (reduce cons '() '(() 1 2)))
(assert-equal? (tn) '(3 2 1) (reduce cons '() '(() 1 2 3)))
(tn "reduce SRFI-1 examples")
;; Take the max of a list of non-negative integers.
(assert-equal? (tn) 43       (reduce max 0 '(0 7 8 8 43 -4)))

;; reduce-right

;; unfold
(tn "unfold invalid forms")
(assert-error  (tn) (lambda () (unfold #\c  car cdr '(1 2 3))))
(assert-error  (tn) (lambda () (unfold cons #\a cdr '(1 2 3))))
(assert-error  (tn) (lambda () (unfold cons car #\d '(1 2 3))))
(assert-error  (tn) (lambda () (unfold cons car cdr '#(1 2 3))))
(assert-error  (tn) (lambda () (unfold cons car cdr '(1 2 3) '())))
(assert-error  (tn) (lambda () (unfold cons car cdr '(1 2 3) values '())))
(tn "unfold")
(assert-equal? (tn) '()            (unfold null?     car cdr '()))
(assert-error  (tn) (lambda ()     (unfold null?     car cdr 1)))
(assert-equal? (tn) '()            (unfold not-pair? car cdr 1))
(assert-equal? (tn) 1              (unfold not-pair? car cdr 1 values))
(assert-equal? (tn) '(1 2 3 4)     (unfold null?     car cdr '(1 2 3 4)))
(assert-error  (tn) (lambda ()     (unfold null?     car cdr '(1 2 3 4 . 5))))
(assert-equal? (tn) '(1 2 3 4)     (unfold not-pair? car cdr '(1 2 3 4 . 5)))
(assert-equal? (tn) '(1 2 3 4 . 5) (unfold not-pair? car cdr '(1 2 3 4 . 5) values))
(tn "unfold SRFI-1 examples")
;; List of squares: 1^2 ... 10^2
(assert-equal? (tn)
               '(1 4 9 16 25 36 49 64 81 100)
               (unfold (lambda (x) (> x 10))
                       (lambda (x) (* x x))
                       (lambda (x) (+ x 1))
                       1))
;; Copy a proper list.
(assert-true   (tn) (equal? lst (unfold null-list? car cdr lst)))
(assert-false  (tn) (eq?    lst (unfold null-list? car cdr lst)))
;; Read current input port into a list of values.
(assert-equal? (tn)
               '((equal? lst (unfold null-list? car cdr lst)))
               (let ((p (open-input-string
                         "(equal? lst (unfold null-list? car cdr lst))")))
                 (unfold eof-object? values (lambda (x) (read p)) (read p))))
;; Copy a possibly non-proper list:
(assert-true   (tn) (equal? lst (unfold not-pair? car cdr lst values)))
(assert-false  (tn) (eq?    lst (unfold not-pair? car cdr lst values)))
(let ((dlst (cons elm0 (cons elm1 (cons elm2 elm3)))))
  (assert-true   (tn) (equal? dlst (unfold not-pair? car cdr dlst values)))
  (assert-false  (tn) (eq?    dlst (unfold not-pair? car cdr dlst values))))
;; Append HEAD onto TAIL:
(assert-equal? (tn)
               '(1 2 3 4 5 6)
               (let ((head '(1 2 3))
                     (tail '(4 5 6)))
                 (unfold null-list? car cdr head 
                         (lambda (x) tail))))

;; unfold-right

;; map
(tn "map invalid forms")
(assert-error  (tn) (lambda ()        (map +)))
(assert-error  (tn) (lambda ()        (map + '#())))
(assert-error  (tn) (lambda ()        (map + '(1) '#(2))))
(assert-error  (tn) (lambda ()        (map #\a '(1))))
(tn "map single list")
(assert-equal? (tn) '()               (map +     '()))
(assert-equal? (tn) '()               (map even? '()))
(assert-equal? (tn) '(2 4 6 8)        (map +     '(2 4 6 8)))
(assert-equal? (tn) '(#t #t #t #t)    (map even? '(2 4 6 8)))
(assert-equal? (tn) '(#f #t #t #t #t) (map even? '(3 2 4 6 8)))
(assert-equal? (tn) '(#t #t #f #t #t) (map even? '(2 4 3 6 8)))
(assert-equal? (tn) '(#t #t #t #t #f) (map even? '(2 4 6 8 3)))
(tn "map 3 lists")
(assert-equal? (tn) '()               (map +     '() '() '()))
(assert-equal? (tn) '(12 17 22 27)    (map +
                                           '(2 4 6 8)
                                           '(1 3 5 7)
                                           '(9 10 11 12)))
(assert-equal? (tn) '(12 #f 22 #f)    (map (lambda args
                                             (let ((sum (apply + args)))
                                               (and (even? sum)
                                                    sum)))
                                           '(2 4 6 8)
                                           '(1 3 5 7)
                                           '(9 10 11 12)))
(assert-equal? (tn) '(12 18 22 28)    (map (lambda args
                                             (let ((sum (apply + args)))
                                               (and (even? sum)
                                                    sum)))
                                           '(2 4 6 8)
                                           '(1 4 5 8)
                                           '(9 10 11 12)))
(tn "map 3 lists unequal length")
(assert-equal? (tn) '(12 17 22)       (map +
                                           '(2 4 6)
                                           '(1 3 5 7)
                                           '(9 10 11 12)))
(assert-equal? (tn) '(12 17 22)       (map +
                                           '(2 4 6 8)
                                           '(1 3 5)
                                           '(9 10 11 12)))
(assert-equal? (tn) '(12 17 22)       (map +
                                           '(2 4 6 8)
                                           '(1 3 5 7)
                                           '(9 10 11)))
(assert-equal? (tn) '()               (map +
                                           '()
                                           '(1 3 5 7)
                                           '(9 10 11 12)))
(assert-equal? (tn) '()               (map +
                                           '(2 4 6 8)
                                           '()
                                           '(9 10 11 12)))
(assert-equal? (tn) '()               (map +
                                           '(2 4 6 8)
                                           '(1 3 5 7)
                                           '()))
(tn "map 3 lists with circular list")
(assert-equal? (tn) '(11 15 17 21)    (map +
                                           clst2
                                           '(1 3 5 7)
                                           '(9 10 11 12)))
(assert-equal? (tn) '(11 15 17 21)    (map +
                                           '(1 3 5 7)
                                           clst2
                                           '(9 10 11 12)))
(assert-equal? (tn) '(11 15 17 21)    (map +
                                           '(1 3 5 7)
                                           '(9 10 11 12)
                                           clst2))
(tn "map SRFI-1 examples")
(assert-equal? (tn)
               '(b e h)
               (map cadr '((a b) (d e) (g h))))
(define expt
  (lambda (x y)
    (apply * (make-list y x))))
(assert-equal? (tn)
               '(1 4 27 256 3125)
               (map (lambda (n) (expt n n))
                    '(1 2 3 4 5)))
(assert-equal? (tn)
               '(5 7 9)
               (map + '(1 2 3) '(4 5 6)))
(assert-true   (tn)
               (let ((result (let ((count 0))
                               (map (lambda (ignored)
                                      (set! count (+ count 1))
                                      count)
                                    '(a b)))))
                 (or (equal? result '(1 2))
                     (equal? result '(2 1)))))
(assert-equal? (tn)
               '(4 1 5 1)
               (map + '(3 1 4 1) (circular-list 1 0)))

;; for-each

;; append-map
(tn "append-map invalid forms")
(assert-error  (tn) (lambda () (append-map values)))
(assert-error  (tn) (lambda () (append-map #\a '())))
(assert-error  (tn) (lambda () (append-map values '#())))
(assert-error  (tn) (lambda () (append-map list '(1) '#(2))))
(tn "append-map single list")
(assert-equal? (tn)
               '()
               (append-map values '()))
(assert-equal? (tn)
               '(1 2 3 4 5 6 7)
               (append-map values '((1) (2 3) (4) (5 6 7))))
(assert-equal? (tn)
               '(1 3 2 4 7 6 5)
               (append-map reverse '((1) (2 3) (4) (5 6 7))))
(tn "append-map 3 lists")
(assert-equal? (tn)
               '()
               (append-map list '() '() '()))
(assert-equal? (tn)
               '(1 4 7 2 5 8 3 6 9)
               (append-map list '(1 2 3) '(4 5 6) '(7 8 9)))
(tn "append-map 3 lists unequal length")
(assert-equal? (tn)
               '(1 4 7 2 5 8)
               (append-map list '(1 2)   '(4 5 6) '(7 8 9)))
(assert-equal? (tn)
               '(1 4 7 2 5 8)
               (append-map list '(1 2 3) '(4 5)   '(7 8 9)))
(assert-equal? (tn)
               '(1 4 7 2 5 8)
               (append-map list '(1 2 3) '(4 5 6) '(7 8)))
(assert-equal? (tn)
               '()
               (append-map list '()      '(4 5 6) '(7 8 9)))
(assert-equal? (tn)
               '()
               (append-map list '(1 2 3) '()      '(7 8 9)))
(assert-equal? (tn)
               '()
               (append-map list '(1 2 3) '(4 5 6) '()))
(tn "append-map 3 lists with circular list")
;; SRFI-1: At least one of the list arguments must be finite.
(assert-equal? (tn)
               '(1 4 7 2 5 8 1 6 9)
               (append-map list clst2    '(4 5 6) '(7 8 9)))
(assert-equal? (tn)
               '(1 1 7 2 2 8 3 1 9)
               (append-map list '(1 2 3) clst2    '(7 8 9)))
(assert-equal? (tn)
               '(1 4 1 2 5 2 3 6 1)
               (append-map list '(1 2 3) '(4 5 6) clst2))
(tn "append-map SRFI-1 examples")
(assert-equal? (tn)
               '(1 -1 3 -3 8 -8)
               (append-map (lambda (x) (list x (- x))) '(1 3 8)))

;; append-map!
(tn "append-map! invalid forms")
(assert-error  (tn) (lambda () (append-map! values)))
(assert-error  (tn) (lambda () (append-map! #\a '())))
(assert-error  (tn) (lambda () (append-map! values '#())))
(assert-error  (tn) (lambda () (append-map! list '(1) '#(2))))
(tn "append-map! single list")
(assert-equal? (tn)
               '()
               (append-map! values '()))
(assert-equal? (tn)
               '(1 2 3 4 5 6 7)
               (append-map! values
                            (list (list 1) (list 2 3) (list 4) (list 5 6 7))))
(assert-equal? (tn)
               '(1 3 2 4 7 6 5)
               (append-map! reverse '((1) (2 3) (4) (5 6 7))))
(tn "append-map! 3 lists")
(assert-equal? (tn)
               '()
               (append-map! list '() '() '()))
(assert-equal? (tn)
               '(1 4 7 2 5 8 3 6 9)
               (append-map! list '(1 2 3) '(4 5 6) '(7 8 9)))
(tn "append-map! 3 lists unequal length")
(assert-equal? (tn)
               '(1 4 7 2 5 8)
               (append-map! list '(1 2)   '(4 5 6) '(7 8 9)))
(assert-equal? (tn)
               '(1 4 7 2 5 8)
               (append-map! list '(1 2 3) '(4 5)   '(7 8 9)))
(assert-equal? (tn)
               '(1 4 7 2 5 8)
               (append-map! list '(1 2 3) '(4 5 6) '(7 8)))
(assert-equal? (tn)
               '()
               (append-map! list '()      '(4 5 6) '(7 8 9)))
(assert-equal? (tn)
               '()
               (append-map! list '(1 2 3) '()      '(7 8 9)))
(assert-equal? (tn)
               '()
               (append-map! list '(1 2 3) '(4 5 6) '()))
(tn "append-map! 3 lists with circular list")
;; SRFI-1: At least one of the list arguments must be finite.
(assert-equal? (tn)
               '(1 4 7 2 5 8 1 6 9)
               (append-map! list clst2    '(4 5 6) '(7 8 9)))
(assert-equal? (tn)
               '(1 1 7 2 2 8 3 1 9)
               (append-map! list '(1 2 3) clst2    '(7 8 9)))
(assert-equal? (tn)
               '(1 4 1 2 5 2 3 6 1)
               (append-map! list '(1 2 3) '(4 5 6) clst2))
(tn "append-map! SRFI-1 examples")
(assert-equal? (tn)
               '(1 -1 3 -3 8 -8)
               (append-map! (lambda (x) (list x (- x))) '(1 3 8)))

;; map!

;; map-in-order
(tn "map-in-order")
;; derived from SRFI-1 example of map
(assert-equal? (tn)
               '()
               (let ((count 0))
                 (map-in-order (lambda (ignored)
                                 (set! count (+ count 1))
                                 count)
                               '())))
(assert-equal? (tn)
               '(1 2)
               (let ((count 0))
                 (map-in-order (lambda (ignored)
                                 (set! count (+ count 1))
                                 count)
                               '(a b))))
(assert-equal? (tn)
               '(1 2 3)
               (let ((count 0))
                 (map-in-order (lambda (ignored)
                                 (set! count (+ count 1))
                                 count)
                               '(a b c))))
(assert-equal? (tn)
               '(1 2 3 4)
               (let ((count 0))
                 (map-in-order (lambda (ignored)
                                 (set! count (+ count 1))
                                 count)
                               '(a b c d))))

;; pair-for-each

;; filter-map
(tn "filter-map invalid forms")
(assert-error  (tn) (lambda () (filter-map even?)))
(assert-error  (tn) (lambda () (filter-map #\a '())))
(assert-error  (tn) (lambda () (filter-map + '#(1))))
(assert-error  (tn) (lambda () (filter-map + '(1) '#(2))))
(tn "filter-map single list")
(assert-equal? (tn) '()        (filter-map even? '()))
(assert-equal? (tn) '(2 -8 12) (filter-map (lambda (x)
                                             (and (even? x)
                                                  x))
                                           '(2 7 3 -8 5 -3 9 12)))
(assert-equal? (tn) '()        (filter-map pair?
                                           '(2 7 3 -8 5 -3 9 12)))
(tn "filter-map 3 lists")
(assert-equal? (tn)
               '(112 320 72 27)
               (filter-map (lambda args
                             (let ((res (apply * args)))
                               (and (positive? res)
                                    res)))
                           '(2 8 7 3 5 -3 9)
                           '(6 -2 38 -2 8 4 3)
                           '(-1 -7 -5 2 8 -6 1)))
(tn "filter-map 3 lists unequal length")
(assert-equal? (tn)
               '(112 320)
               (filter-map (lambda args
                             (let ((res (apply * args)))
                               (and (positive? res)
                                    res)))
                           '(2 8 7 3 5 -3 9)
                           '(6 -2 38 -2 8)
                           '(-1 -7 -5 2 8 -6)))
(assert-equal? (tn)
               '()
               (filter-map (lambda args
                             (let ((res (apply * args)))
                               (and (positive? res)
                                    res)))
                           '()
                           '(6 -2 38 -2 8)
                           '(-1 -7 -5 2 8 -6)))
(assert-equal? (tn)
               '()
               (filter-map (lambda args
                             (let ((res (apply * args)))
                               (and (positive? res)
                                    res)))
                           '(2 8 7 3 5 -3 9)
                           '()
                           '(-1 -7 -5 2 8 -6)))
(assert-equal? (tn)
               '()
               (filter-map (lambda args
                             (let ((res (apply * args)))
                               (and (positive? res)
                                    res)))
                           '(2 8 7 3 5 -3 9)
                           '(6 -2 38 -2 8)
                           '()))
(tn "filter-map 3 lists unequal length with circular list")
;; SRFI-1: At least one of the list arguments must be finite.
(assert-equal? (tn)
               '(24 40 36)
               (filter-map (lambda args
                             (let ((res (apply * args)))
                               (and (positive? res)
                                    res)))
                           '(2 8 7 3 5 -3 9)
                           clst4
                           '(-1 -7 -5 2 8 -6)))
(assert-equal? (tn)
               '()
               (filter-map (lambda args
                             (let ((res (apply * args)))
                               (and (positive? res)
                                    res)))
                           '()
                           clst4
                           '(-1 -7 -5 2 8 -6)))
(assert-equal? (tn)
               '()
               (filter-map (lambda args
                             (let ((res (apply * args)))
                               (and (positive? res)
                                    res)))
                           '(2 8 7 3 5 -3 9)
                           '()
                           clst4))
(assert-equal? (tn)
               '()
               (filter-map (lambda args
                             (let ((res (apply * args)))
                               (and (positive? res)
                                    res)))
                           '(2 8 7 3 5 -3 9)
                           clst4
                           '()))
(tn "filter-map SRFI-1 examples")
(assert-equal? (tn)
               '(1 9 49)
               (filter-map (lambda (x)
                             (and (number? x)
                                  (* x x)))
                           '(a 1 b 3 c 7)))


;;
;; Filtering & partitioning
;;

;; filter
(tn "filter invalid forms")
(assert-error  (tn) (lambda ()     (filter #\a     '(1 2))))
(assert-error  (tn) (lambda ()     (filter cons    '(1 2))))
(assert-error  (tn) (lambda ()     (filter cons    '(1 2) '(3 4))))
(assert-error  (tn) (lambda ()     (filter even?   '(1 2) '(3 4))))
(tn "filter")
(assert-equal? (tn) '()            (filter even?   '()))
(assert-equal? (tn) '(2 4 6)       (filter even?   '(1 2 3 4 5 6)))
(assert-equal? (tn) '(1 3 5)       (filter odd?    '(1 2 3 4 5 6)))
(assert-equal? (tn) '(1 2 3 4 5 6) (filter number? '(1 2 3 4 5 6)))
(assert-equal? (tn) '()            (filter pair?   '(1 2 3 4 5 6)))
(tn "filter SRFI-1 examples")
(assert-equal? (tn) '(0 8 8 -4)    (filter even? '(0 7 8 8 43 -4)))

;; partition

;; remove
(tn "remove invalid forms")
(assert-error  (tn) (lambda ()       (remove #\a     '(1 2))))
(assert-error  (tn) (lambda ()       (remove cons    '(1 2))))
(assert-error  (tn) (lambda ()       (remove cons    '(1 2) '(3 4))))
(assert-error  (tn) (lambda ()       (remove even?   '(1 2) '(3 4))))
(tn "remove")
(assert-equal? (tn) '()              (remove even?   '()))
(assert-equal? (tn) '(0 8 8 -4)      (remove odd?    '(0 7 8 8 43 -4)))
(assert-equal? (tn) '()              (remove number? '(0 7 8 8 43 -4)))
(assert-equal? (tn) '(0 7 8 8 43 -4) (remove pair?   '(0 7 8 8 43 -4)))
(tn "remove SRFI-1 examples")
(assert-equal? (tn) '(7 43)          (remove even?   '(0 7 8 8 43 -4)))

;; filter!
;; partition!
;; remove!


;;
;; Searching
;;

;; find
(tn "find invalid forms")
(assert-error  (tn) (lambda ()   (find even? '#(1 2))))
(assert-error  (tn) (lambda ()   (find 1 '(1 2))))
(tn "find proper list")
(assert-false  (tn)      (find even?                     '()))
(assert-false  (tn)      (find (lambda (x) #f)           lst))
(assert-eq?    (tn) elm0 (find (lambda (x) (eq? x elm0)) lst))
(assert-eq?    (tn) elm1 (find (lambda (x) (eq? x elm1)) lst))
(assert-eq?    (tn) elm2 (find (lambda (x) (eq? x elm2)) lst))
(assert-eq?    (tn) elm8 (find (lambda (x) (eq? x elm8)) lst))
(assert-eq?    (tn) elm9 (find (lambda (x) (eq? x elm9)) lst))
(tn "find dotted list")
(assert-error  (tn) (lambda ()   (find even? 1)))
(assert-equal? (tn) 1            (find (lambda (x) (= x 1)) '(1 . 2)))
(assert-equal? (tn) 2            (find (lambda (x) (= x 2)) '(1 2 . 3)))
(assert-equal? (tn) 3            (find (lambda (x) (= x 3)) '(1 2 3 . 4)))
(assert-error  (tn) (lambda ()   (find even? '(1 . 2))))
(assert-equal? (tn) 2            (find even? '(1 2 . 3)))
(assert-equal? (tn) 2            (find even? '(1 2 3 . 4)))
(assert-equal? (tn) 1            (find odd?  '(1 . 2)))
(assert-equal? (tn) 1            (find odd?  '(1 2 . 3)))
(assert-equal? (tn) 1            (find odd?  '(1 2 3 . 4)))
(tn "find circular list")
;; Rotates the circular list as like as find-tail.
(assert-equal? (tn) 1 (find (lambda (x) (= x 1)) clst4))
(assert-equal? (tn) 2 (find (lambda (x) (= x 2)) clst4))
(assert-equal? (tn) 3 (find (lambda (x) (= x 3)) clst4))
(assert-equal? (tn) 4 (find (lambda (x) (= x 4)) clst4))
(assert-equal? (tn)
               1
               (let ((cnt 2))
                 (find (lambda (x)
                              (if (= x 1)
                                  (set! cnt (- cnt 1)))
                              (and (zero? cnt)
                                   (= x 1)))
                            clst4)))
(assert-equal? (tn)
               2
               (let ((cnt 2))
                 (find (lambda (x)
                              (if (= x 1)
                                  (set! cnt (- cnt 1)))
                              (and (zero? cnt)
                                   (= x 2)))
                            clst4)))
(assert-equal? (tn)
               3
               (let ((cnt 2))
                 (find (lambda (x)
                              (if (= x 1)
                                  (set! cnt (- cnt 1)))
                              (and (zero? cnt)
                                   (= x 3)))
                            clst4)))
(assert-equal? (tn)
               1
               (let ((cnt 3))
                 (find (lambda (x)
                              (if (= x 1)
                                  (set! cnt (- cnt 1)))
                              (and (zero? cnt)
                                   (= x 1)))
                            clst4)))
(assert-equal? (tn)
               1
               (let ((cnt 4))
                 (find (lambda (x)
                              (if (= x 1)
                                  (set! cnt (- cnt 1)))
                              (and (zero? cnt)
                                   (= x 1)))
                            clst4)))

;; find-tail
(tn "find-tail invalid forms")
(assert-error  (tn) (lambda ()   (find-tail even? '#(1 2))))
(assert-error  (tn) (lambda ()   (find-tail 1 '(1 2))))
(tn "find-tail proper list")
;; Although the behavior on null list is not explicitly defined in SRFI-1
;; itself, the reference implementation returns #f So SigScheme followed it.
(assert-false  (tn)      (find-tail even?                     '()))
(assert-false  (tn)      (find-tail (lambda (x) #f)           lst))
(assert-eq?    (tn) lst  (find-tail (lambda (x) (eq? x elm0)) lst))
(assert-eq?    (tn) cdr1 (find-tail (lambda (x) (eq? x elm1)) lst))
(assert-eq?    (tn) cdr2 (find-tail (lambda (x) (eq? x elm2)) lst))
(assert-eq?    (tn) cdr8 (find-tail (lambda (x) (eq? x elm8)) lst))
(assert-eq?    (tn) cdr9 (find-tail (lambda (x) (eq? x elm9)) lst))
(tn "find-tail dotted list")
(assert-error  (tn) (lambda ()   (find-tail even? 1)))
;; Although the behavior on dotted list is not defined in SRFI-1 itself, the
;; reference implementation returns the last pair. So SigScheme followed it.
(assert-equal? (tn) '(1 . 2)     (find-tail (lambda (x) (= x 1)) '(1 . 2)))
(assert-equal? (tn) '(2 . 3)     (find-tail (lambda (x) (= x 2)) '(1 2 . 3)))
(assert-equal? (tn) '(3 . 4)     (find-tail (lambda (x) (= x 3)) '(1 2 3 . 4)))
(assert-error  (tn) (lambda ()   (find-tail even? '(1 . 2))))
(assert-equal? (tn) '(2 . 3)     (find-tail even? '(1 2 . 3)))
(assert-equal? (tn) '(2 3 . 4)   (find-tail even? '(1 2 3 . 4)))
(assert-equal? (tn) '(1 . 2)     (find-tail odd?  '(1 . 2)))
(assert-equal? (tn) '(1 2 . 3)   (find-tail odd?  '(1 2 . 3)))
(assert-equal? (tn) '(1 2 3 . 4) (find-tail odd?  '(1 2 3 . 4)))
(tn "find-tail circular list")
;; SRFI-1: In the circular-list case, this procedure "rotates" the list.
(assert-eq?    (tn) clst4 (find-tail (lambda (x) (= x 1)) clst4))
(assert-eq?    (tn) (my-list-tail clst4 1) (find-tail (lambda (x) (= x 2))
                                                      clst4))
(assert-eq?    (tn) (my-list-tail clst4 2) (find-tail (lambda (x) (= x 3))
                                                      clst4))
(assert-eq?    (tn) (my-list-tail clst4 3) (find-tail (lambda (x) (= x 4))
                                                      clst4))
(assert-eq?    (tn)
               clst4
               (let ((cnt 2))
                 (find-tail (lambda (x)
                              (if (= x 1)
                                  (set! cnt (- cnt 1)))
                              (and (zero? cnt)
                                   (= x 1)))
                            clst4)))
(assert-eq?    (tn)
               (my-list-tail clst4 1)
               (let ((cnt 2))
                 (find-tail (lambda (x)
                              (if (= x 1)
                                  (set! cnt (- cnt 1)))
                              (and (zero? cnt)
                                   (= x 2)))
                            clst4)))
(assert-eq?    (tn)
               (my-list-tail clst4 2)
               (let ((cnt 2))
                 (find-tail (lambda (x)
                              (if (= x 1)
                                  (set! cnt (- cnt 1)))
                              (and (zero? cnt)
                                   (= x 3)))
                            clst4)))
(assert-eq?    (tn)
               clst4
               (let ((cnt 3))
                 (find-tail (lambda (x)
                              (if (= x 1)
                                  (set! cnt (- cnt 1)))
                              (and (zero? cnt)
                                   (= x 1)))
                            clst4)))
(assert-eq?    (tn)
               clst4
               (let ((cnt 4))
                 (find-tail (lambda (x)
                              (if (= x 1)
                                  (set! cnt (- cnt 1)))
                              (and (zero? cnt)
                                   (= x 1)))
                            clst4)))

;; take-while
;; take-while!
;; drop-while
;; span
;; span!
;; break
;; break!

;; any
(tn "any invalid forms")
(assert-error  (tn) (lambda ()      (any +)))
(assert-error  (tn) (lambda ()      (any + '#())))
(assert-error  (tn) (lambda ()      (any + '(1) '#(2))))
(assert-error  (tn) (lambda ()      (any #\a '(1))))
(tn "any single list")
(assert-equal? (tn) #f              (any +     '()))
(assert-equal? (tn) #f              (any even? '()))
(assert-equal? (tn) 2               (any +     '(2 4 6 8)))
(assert-equal? (tn) #f              (any odd?  '(2 4 6 8)))
(assert-equal? (tn) #t              (any odd?  '(3 2 4 6 8)))
(assert-equal? (tn) #t              (any odd?  '(2 4 3 6 8)))
(assert-equal? (tn) #t              (any odd?  '(2 4 6 8 3)))
(tn "any 3 lists")
(assert-equal? (tn) #f              (any +     '() '() '()))
(assert-equal? (tn) 12              (any +
                                         '(2 4 6 8)
                                         '(1 3 5 7)
                                         '(9 10 11 12)))
(assert-equal? (tn) 17              (any (lambda args
                                           (let ((sum (apply + args)))
                                             (and (odd? sum)
                                                  sum)))
                                         '(2 4 6 8)
                                         '(1 3 5 7)
                                         '(9 10 11 12)))
(assert-equal? (tn) #f              (any (lambda args
                                           (let ((sum (apply + args)))
                                             (and (odd? sum)
                                                  sum)))
                                         '(2 4 6 8)
                                         '(1 4 5 8)
                                         '(9 10 11 12)))
(tn "any 3 lists unequal length")
(assert-equal? (tn) 22              (any (lambda args
                                           (let ((sum (apply + args)))
                                             (and (< 20 sum)
                                                  sum)))
                                         '(2 4 6)
                                         '(1 3 5 7)
                                         '(9 10 11 12)))
(assert-equal? (tn) 22              (any (lambda args
                                           (let ((sum (apply + args)))
                                             (and (< 20 sum)
                                                  sum)))
                                         '(2 4 6 8)
                                         '(1 3 5)
                                         '(9 10 11 12)))
(assert-equal? (tn) 22              (any (lambda args
                                           (let ((sum (apply + args)))
                                             (and (< 20 sum)
                                                  sum)))
                                         '(2 4 6 8)
                                         '(1 3 5 7)
                                         '(9 10 11)))
(assert-equal? (tn) #f              (any (lambda args
                                           (let ((sum (apply + args)))
                                             (and (< 25 sum)
                                                  sum)))
                                         '(2 4 6)
                                         '(1 3 5 7)
                                         '(9 10 11 12)))
(assert-equal? (tn) #f              (any (lambda args
                                           (let ((sum (apply + args)))
                                             (and (< 25 sum)
                                                  sum)))
                                         '(2 4 6 8)
                                         '(1 3 5)
                                         '(9 10 11 12)))
(assert-equal? (tn) #f              (any (lambda args
                                           (let ((sum (apply + args)))
                                             (and (< 25 sum)
                                                  sum)))
                                         '(2 4 6 8)
                                         '(1 3 5 7)
                                         '(9 10 11)))
(assert-equal? (tn) #f              (any +
                                         '()
                                         '(1 3 5 7)
                                         '(9 10 11 12)))
(assert-equal? (tn) #f              (any +
                                         '(2 4 6 8)
                                         '()
                                         '(9 10 11 12)))
(assert-equal? (tn) #f              (any +
                                         '(2 4 6 8)
                                         '(1 3 5 7)
                                         '()))
(tn "any 3 lists with circular list")
(assert-equal? (tn) 11              (any +
                                         clst2
                                         '(1 3 5 7)
                                         '(9 10 11 12)))
(assert-equal? (tn) 21              (any (lambda args
                                           (let ((sum (apply + args)))
                                             (and (< 20 sum)
                                                  sum)))
                                         clst2
                                         '(1 3 5 7)
                                         '(9 10 11 12)))
(tn "any 3 SRFI-1 examples")
;;(assert-eq?    (tn) #t (any integer? '(a 3 b 2.7)))
(assert-eq?    (tn) #t (any integer? '(a 3 b #\2)))
;;(assert-eq?    (tn) #f (any integer? '(a 3.1 b 2.7)))
(assert-eq?    (tn) #f (any integer? '(a #\3 b #\2)))
(assert-eq?    (tn) #t (any < '(3 1 4 1 5)
                              '(2 7 1 8 2)))

;; every
(tn "every invalid forms")
(assert-error  (tn) (lambda ()      (every +)))
(assert-error  (tn) (lambda ()      (every + '#())))
(assert-error  (tn) (lambda ()      (every + '(1) '#(2))))
(assert-error  (tn) (lambda ()      (every #\a '(1))))
(tn "every single list")
(assert-equal? (tn) #t              (every +     '()))
(assert-equal? (tn) #t              (every even? '()))
(assert-equal? (tn) 8               (every +     '(2 4 6 8)))
(assert-equal? (tn) #t              (every even? '(2 4 6 8)))
(assert-equal? (tn) #f              (every even? '(3 2 4 6 8)))
(assert-equal? (tn) #f              (every even? '(2 4 3 6 8)))
(assert-equal? (tn) #f              (every even? '(2 4 6 8 3)))
(tn "every 3 lists")
(assert-equal? (tn) #t              (every +     '() '() '()))
(assert-equal? (tn) 27              (every +
                                           '(2 4 6 8)
                                           '(1 3 5 7)
                                           '(9 10 11 12)))
(assert-equal? (tn) #f              (every (lambda args
                                             (let ((sum (apply + args)))
                                             (and (even? sum)
                                                  sum)))
                                           '(2 4 6 8)
                                           '(1 3 5 7)
                                           '(9 10 11 12)))
(assert-equal? (tn) 28              (every (lambda args
                                             (let ((sum (apply + args)))
                                             (and (even? sum)
                                                  sum)))
                                           '(2 4 6 8)
                                           '(1 4 5 8)
                                           '(9 10 11 12)))
(tn "every 3 lists unequal length")
(assert-equal? (tn) 22              (every +
                                           '(2 4 6)
                                           '(1 3 5 7)
                                           '(9 10 11 12)))
(assert-equal? (tn) 22              (every +
                                           '(2 4 6 8)
                                           '(1 3 5)
                                           '(9 10 11 12)))
(assert-equal? (tn) 22              (every +
                                           '(2 4 6 8)
                                           '(1 3 5 7)
                                           '(9 10 11)))
(assert-equal? (tn) #t              (every +
                                           '()
                                           '(1 3 5 7)
                                           '(9 10 11 12)))
(assert-equal? (tn) #t              (every +
                                           '(2 4 6 8)
                                           '()
                                           '(9 10 11 12)))
(assert-equal? (tn) #t              (every +
                                           '(2 4 6 8)
                                           '(1 3 5 7)
                                           '()))
(tn "every 3 lists with circular list")
(assert-equal? (tn) 21              (every +
                                           clst2
                                           '(1 3 5 7)
                                           '(9 10 11 12)))

;; list-index
(tn "list-index invalid forms")
(assert-error  (tn) (lambda () (list-index even?)))
(assert-error  (tn) (lambda () (list-index even? '#())))
(assert-error  (tn) (lambda () (list-index #\a   '(1))))
(assert-error  (tn) (lambda () (list-index +     '(1) '#(2))))
(tn "list-index single list")
(assert-false  (tn)    (list-index even? '()))
(assert-false  (tn)    (list-index even? '(1)))
(assert-equal? (tn) 1  (list-index even? '(1 2)))
(assert-equal? (tn) 1  (list-index even? '(1 2 3)))
(assert-false  (tn)    (list-index odd?  '(2 4 6 8)))
(assert-equal? (tn) 0  (list-index odd?  '(3 2 4 6 8)))
(assert-equal? (tn) 2  (list-index odd?  '(2 4 3 6 8)))
(assert-equal? (tn) 4  (list-index odd?  '(2 4 6 8 3)))
(tn "list-index 3 lists")
(assert-false  (tn)    (list-index +     '() '() '()))
(assert-equal? (tn) 0  (list-index +
                                   '(2 4 6 8)
                                   '(1 3 5 7)
                                   '(9 10 11 12)))
(assert-equal? (tn) 1  (list-index (lambda args
                                     (let ((sum (apply + args)))
                                       (and (odd? sum)
                                            sum)))
                                   '(2 4 6 8)
                                   '(1 3 5 7)
                                   '(9 10 11 12)))
(assert-equal? (tn) #f (list-index (lambda args
                                     (let ((sum (apply + args)))
                                       (and (odd? sum)
                                            sum)))
                                   '(2 4 6 8)
                                   '(1 4 5 8)
                                   '(9 10 11 12)))
(tn "list-index 3 lists unequal length")
(assert-equal? (tn) 2               (list-index (lambda args
                                                  (let ((sum (apply + args)))
                                                    (and (< 20 sum)
                                                         sum)))
                                                '(2 4 6)
                                                '(1 3 5 7)
                                                '(9 10 11 12)))
(assert-equal? (tn) 2               (list-index (lambda args
                                                  (let ((sum (apply + args)))
                                                    (and (< 20 sum)
                                                         sum)))
                                                '(2 4 6 8)
                                                '(1 3 5)
                                                '(9 10 11 12)))
(assert-equal? (tn) 2               (list-index (lambda args
                                                  (let ((sum (apply + args)))
                                                    (and (< 20 sum)
                                                         sum)))
                                                '(2 4 6 8)
                                                '(1 3 5 7)
                                                '(9 10 11)))
(assert-equal? (tn) #f              (list-index (lambda args
                                                  (let ((sum (apply + args)))
                                                    (and (< 25 sum)
                                                         sum)))
                                                '(2 4 6)
                                                '(1 3 5 7)
                                                '(9 10 11 12)))
(assert-equal? (tn) #f              (list-index (lambda args
                                                  (let ((sum (apply + args)))
                                                    (and (< 25 sum)
                                                         sum)))
                                                '(2 4 6 8)
                                                '(1 3 5)
                                                '(9 10 11 12)))
(assert-equal? (tn) #f              (list-index (lambda args
                                                  (let ((sum (apply + args)))
                                                    (and (< 25 sum)
                                                         sum)))
                                                '(2 4 6 8)
                                                '(1 3 5 7)
                                                '(9 10 11)))
(assert-equal? (tn) #f              (list-index +
                                                '()
                                                '(1 3 5 7)
                                                '(9 10 11 12)))
(assert-equal? (tn) #f              (list-index +
                                                '(2 4 6 8)
                                                '()
                                                '(9 10 11 12)))
(assert-equal? (tn) #f              (list-index +
                                                '(2 4 6 8)
                                                '(1 3 5 7)
                                                '()))
(tn "list-index SRFI-1 examples")
(assert-equal? (tn) 2  (list-index even? '(3 1 4 1 5 9)))
(assert-equal? (tn) 1  (list-index < '(3 1 4 1 5 9 2 5 6) '(2 7 1 8 2)))
(assert-equal? (tn) #f (list-index = '(3 1 4 1 5 9 2 5 6) '(2 7 1 8 2)))

;; member
(tn "member invalid forms")
(assert-error  (tn) (lambda () (member 1)))
(assert-error  (tn) (lambda () (member 1 '#(1))))
(assert-error  (tn) (lambda () (member 1 '(1) #\a)))
(assert-error  (tn) (lambda () (member 1 '(1) = '())))
(tn "member")
(assert-eq?    (tn) #f         (member 1                '()))
(assert-eq?    (tn) #f         (member 1                '() eq?))
(assert-eq?    (tn) #f         (member 1                '() equal?))
(assert-eq?    (tn) cdr3       (member elm3             lst))
(assert-eq?    (tn) cdr3       (member elm3             lst eq?))
(assert-eq?    (tn) cdr3       (member elm3             lst equal?))
(assert-eq?    (tn) cdr3       (member (list-copy elm3) lst))
(assert-false  (tn)            (member (list-copy elm3) lst eq?))
(assert-eq?    (tn) cdr3       (member (list-copy elm3) lst equal?))


;;
;; Deleting
;;

;; delete
(tn "delete invalid forms")
(assert-error  (tn) (lambda ()       (delete 1)))
(assert-error  (tn) (lambda ()       (delete 1 '#(1))))
(assert-error  (tn) (lambda ()       (delete 1 '(1) #\a)))
(assert-error  (tn) (lambda ()       (delete 1 '(1) = '())))
(tn "delete")
(assert-equal? (tn) '()              (delete 1    '()))
(assert-equal? (tn) '()              (delete 1    '() eq?))
(assert-equal? (tn) '()              (delete 1    '() equal?))
(assert-equal? (tn) (list cdr0 cdr2) (delete cdr1 (list cdr0 cdr1 cdr2)))
(assert-equal? (tn) (list cdr0 cdr2) (delete cdr1 (list cdr0 cdr1 cdr2) eq?))
(assert-equal? (tn) (list cdr0 cdr2) (delete cdr1 (list cdr0 cdr1 cdr2) equal?))
(assert-equal? (tn) (list cdr0 cdr2)      (delete (list-copy cdr1)
                                                  (list cdr0 cdr1 cdr2)))
(assert-equal? (tn) (list cdr0 cdr1 cdr2) (delete (list-copy cdr1)
                                                  (list cdr0 cdr1 cdr2) eq?))
(assert-equal? (tn) (list cdr0 cdr2)      (delete (list-copy cdr1)
                                                  (list cdr0 cdr1 cdr2) equal?))
(tn "delete SRFI-1 examples")
(assert-equal? (tn) '(0 -4)          (delete 5 '(0 7 8 8 43 -4) <))

;; delete!
(tn "delete! invalid forms")
(assert-error  (tn) (lambda ()       (delete! 1)))
(assert-error  (tn) (lambda ()       (delete! 1 (vector 1))))
(assert-error  (tn) (lambda ()       (delete! 1 (list 1) #\a)))
(assert-error  (tn) (lambda ()       (delete! 1 (list 1) = '())))
(tn "delete!")
(assert-equal? (tn) '()              (delete! 1    '()))
(assert-equal? (tn) '()              (delete! 1    '() eq?))
(assert-equal? (tn) '()              (delete! 1    '() equal?))
(assert-equal? (tn) (list cdr0 cdr2) (delete! cdr1 (list cdr0 cdr1 cdr2)))
(assert-equal? (tn) (list cdr0 cdr2) (delete! cdr1 (list cdr0 cdr1 cdr2) eq?))
(assert-equal? (tn) (list cdr0 cdr2) (delete! cdr1 (list cdr0 cdr1 cdr2) equal?))
(assert-equal? (tn) (list cdr0 cdr2)      (delete! (list-copy cdr1)
                                                   (list cdr0 cdr1 cdr2)))
(assert-equal? (tn) (list cdr0 cdr1 cdr2) (delete! (list-copy cdr1)
                                                   (list cdr0 cdr1 cdr2) eq?))
(assert-equal? (tn) (list cdr0 cdr2)      (delete! (list-copy cdr1)
                                                   (list cdr0 cdr1 cdr2) equal?))
(tn "delete! SRFI-1 examples")
(assert-equal? (tn) '(0 -4)          (delete! 5 (list 0 7 8 8 43 -4) <))

;; delete-duplicates
;; delete-duplicates!


;;
;; Association lists
;;

(define alist-s '(("b" . 2) ("a" . 1) ("d" . 4) ("b" . 5) ("c" . 3)))
(define alist-n '((1 . a) (5 . e) (6 . f) (2 . b) (4 . d) (3 . c)
                  (4 . d) (3 . c) (7 . g) (6 . f) (5 . e) (7 . g)))

;; assoc
(tn "assoc (SRFI-1 extended) invalid forms")
(assert-error  (tn) (lambda () (assoc "a" alist-s #\a)))
(assert-error  (tn) (lambda () (assoc "a" alist-s string=? values)))
(tn "assoc (SRFI-1 extended)")
(assert-equal? (tn) '("b" . 2) (assoc "b" alist-s))
(assert-equal? (tn) '("a" . 1) (assoc "a" alist-s))
(assert-equal? (tn) '("d" . 4) (assoc "d" alist-s))
(assert-equal? (tn) '("c" . 3) (assoc "c" alist-s))
(assert-false  (tn)            (assoc "A" alist-s))
(assert-equal? (tn) '("b" . 2) (assoc "b" alist-s string=?))
(assert-equal? (tn) '("a" . 1) (assoc "a" alist-s string=?))
(assert-equal? (tn) '("d" . 4) (assoc "d" alist-s string=?))
(assert-equal? (tn) '("c" . 3) (assoc "c" alist-s string=?))
(assert-false  (tn)            (assoc "A" alist-s string=?))

;; alist-cons
(tn "alist-cons")
(assert-equal? (tn) '(("A" . 1))              (alist-cons "A" 1 '()))
(assert-equal? (tn) (cons '("A" . 1) alist-s) (alist-cons "A" 1 alist-s))
(assert-eq?    (tn) alist-s              (cdr (alist-cons "A" 1 alist-s)))

;; alist-copy
(tn "alist-copy")
(assert-equal? (tn) '()     (alist-copy '()))
(assert-equal? (tn) alist-s (alist-copy alist-s))
(assert-false  (tn) (eq?      (list-ref alist-s              0)
                              (list-ref (alist-copy alist-s) 0)))
(assert-true   (tn) (eq? (car (list-ref alist-s              0))
                         (car (list-ref (alist-copy alist-s) 0))))
(assert-true   (tn) (eq? (cdr (list-ref alist-s              0))
                         (cdr (list-ref (alist-copy alist-s) 0))))
(assert-false  (tn) (eq?      (list-ref alist-s              1)
                              (list-ref (alist-copy alist-s) 1)))
(assert-true   (tn) (eq? (car (list-ref alist-s              1))
                         (car (list-ref (alist-copy alist-s) 1))))
(assert-true   (tn) (eq? (cdr (list-ref alist-s              1))
                         (cdr (list-ref (alist-copy alist-s) 1))))
(assert-false  (tn) (eq?      (list-ref alist-s              2)
                              (list-ref (alist-copy alist-s) 2)))
(assert-true   (tn) (eq? (car (list-ref alist-s              2))
                         (car (list-ref (alist-copy alist-s) 2))))
(assert-true   (tn) (eq? (cdr (list-ref alist-s              2))
                         (cdr (list-ref (alist-copy alist-s) 2))))

;; alist-delete
(tn "alist-delete invalid forms")
(assert-error  (tn) (lambda () (alist-delete "A" '#())))
(assert-error  (tn) (lambda () (alist-delete "A" '(("a" . 1)) #\a)))
(assert-error  (tn) (lambda () (alist-delete #\a '(("a" . 1)) string=?)))
(tn "alist-delete")
(assert-equal? (tn) '() (alist-delete "A" '()))
(assert-equal? (tn) '() (alist-delete "A" '() string=?))
(assert-equal? (tn)
               '(("b" . 2) ("a" . 1) ("d" . 4) ("b" . 5) ("c" . 3))
               (alist-delete "A" alist-s))
(assert-equal? (tn)
               '(("b" . 2) ("d" . 4) ("b" . 5) ("c" . 3))
               (alist-delete "a" alist-s))
(assert-equal? (tn)
               '(("a" . 1) ("d" . 4) ("c" . 3))
               (alist-delete "b" alist-s))
(assert-equal? (tn)
               '(("a" . 1) ("d" . 4) ("c" . 3))
               (alist-delete "b" alist-s string=?))
(assert-equal? (tn)
               '((1 . a) (5 . e) (6 . f) (2 . b) (4 . d) (3 . c)
                 (4 . d) (3 . c) (7 . g) (6 . f) (5 . e) (7 . g))
               (alist-delete -1 alist-n))
(assert-equal? (tn)
               '((1 . a) (5 . e) (2 . b) (4 . d) (3 . c)
                 (4 . d) (3 . c) (7 . g) (5 . e) (7 . g))
               (alist-delete 6 alist-n))
(assert-equal? (tn)
               '((1 . a) (5 . e) (2 . b) (4 . d) (3 . c)
                 (4 . d) (3 . c) (7 . g) (5 . e) (7 . g))
               (alist-delete 6 alist-n =))
(tn "alist-delete SRFI-1 examples")
(assert-equal? (tn)
               '((1 . a) (5 . e) (2 . b) (4 . d) (3 . c)
                 (4 . d) (3 . c) (5 . e))
               (alist-delete 5 alist-n <))

;; alist-delete!
(tn "alist-delete! invalid forms")
(assert-error  (tn) (lambda () (alist-delete! "A" (vector))))
(assert-error  (tn) (lambda () (alist-delete! "A" (list (cons "a" 1)) #\a)))
(assert-error  (tn) (lambda () (alist-delete! #\a (list (cons "a" 1)) string=?)))
(tn "alist-delete!")
(assert-equal? (tn) '() (alist-delete! "A" '()))
(assert-equal? (tn) '() (alist-delete! "A" '() string=?))
(assert-equal? (tn)
               '(("b" . 2) ("a" . 1) ("d" . 4) ("b" . 5) ("c" . 3))
               (alist-delete! "A" (alist-copy alist-s)))
(assert-equal? (tn)
               '(("b" . 2) ("d" . 4) ("b" . 5) ("c" . 3))
               (alist-delete! "a" (alist-copy alist-s)))
(assert-equal? (tn)
               '(("a" . 1) ("d" . 4) ("c" . 3))
               (alist-delete! "b" (alist-copy alist-s)))
(assert-equal? (tn)
               '(("a" . 1) ("d" . 4) ("c" . 3))
               (alist-delete! "b" (alist-copy alist-s) string=?))
(assert-equal? (tn)
               '((1 . a) (5 . e) (6 . f) (2 . b) (4 . d) (3 . c)
                 (4 . d) (3 . c) (7 . g) (6 . f) (5 . e) (7 . g))
               (alist-delete! -1 (alist-copy alist-n)))
(assert-equal? (tn)
               '((1 . a) (5 . e) (2 . b) (4 . d) (3 . c)
                 (4 . d) (3 . c) (7 . g) (5 . e) (7 . g))
               (alist-delete! 6 (alist-copy alist-n)))
(assert-equal? (tn)
               '((1 . a) (5 . e) (2 . b) (4 . d) (3 . c)
                 (4 . d) (3 . c) (7 . g) (5 . e) (7 . g))
               (alist-delete! 6 (alist-copy alist-n) =))
(tn "alist-delete! SRFI-1 examples")
(assert-equal? (tn)
               '((1 . a) (5 . e) (2 . b) (4 . d) (3 . c)
                 (4 . d) (3 . c) (5 . e))
               (alist-delete! 5 (alist-copy alist-n) <))


;;
;; Set operations on lists
;;

;; lset<=
;; lset=
;; lset-adjoin
;; lset-union
;; lset-intersection
;; lset-difference

;; lset-xor
(tn "lset-xor")
;; To test the bug of the original srfi-1-reference.scm
(assert-equal? (tn)
               '("d")
               (lset-xor equal? '("a" "b" "c") '("d" "c" "a" "b")))

;; lset-diff+intersection
;; lset-union!
;; lset-intersection!
;; lset-difference!

;; lset-xor!
(tn "lset-xor!")
;; To test the bug of the original srfi-1-reference.scm
(assert-equal? (tn)
               '("d")
               (lset-xor equal? (list "a" "b" "c") (list "d" "c" "a" "b")))

;; lset-diff+intersection!


(total-report)