summaryrefslogtreecommitdiff
path: root/Sacla/tests
diff options
context:
space:
mode:
Diffstat (limited to 'Sacla/tests')
-rw-r--r--Sacla/tests/ansi-tests.lisp89
-rw-r--r--Sacla/tests/desirable-printer.lisp223
-rw-r--r--Sacla/tests/must-array.lisp2297
-rw-r--r--Sacla/tests/must-character.lisp537
-rw-r--r--Sacla/tests/must-condition.lisp898
-rw-r--r--Sacla/tests/must-cons.lisp2309
-rw-r--r--Sacla/tests/must-data-and-control.lisp1660
-rw-r--r--Sacla/tests/must-do.lisp451
-rw-r--r--Sacla/tests/must-eval.lisp44
-rw-r--r--Sacla/tests/must-eval.patch15
-rw-r--r--Sacla/tests/must-hash-table.lisp696
-rw-r--r--Sacla/tests/must-hash-table.patch55
-rw-r--r--Sacla/tests/must-loop.lisp3605
-rw-r--r--Sacla/tests/must-loop.patch13
-rw-r--r--Sacla/tests/must-package.lisp2266
-rw-r--r--Sacla/tests/must-package.patch12
-rw-r--r--Sacla/tests/must-printer.lisp1610
-rw-r--r--Sacla/tests/must-printer.patch13
-rw-r--r--Sacla/tests/must-reader.lisp3052
-rw-r--r--Sacla/tests/must-reader.patch26
-rw-r--r--Sacla/tests/must-sequence.lisp10165
-rw-r--r--Sacla/tests/must-sequence.patch26
-rw-r--r--Sacla/tests/must-string.lisp608
-rw-r--r--Sacla/tests/must-symbol.lisp459
-rw-r--r--Sacla/tests/should-array.lisp229
-rw-r--r--Sacla/tests/should-array.patch32
-rw-r--r--Sacla/tests/should-character.lisp252
-rw-r--r--Sacla/tests/should-cons.lisp631
-rw-r--r--Sacla/tests/should-data-and-control.lisp49
-rw-r--r--Sacla/tests/should-eval.lisp40
-rw-r--r--Sacla/tests/should-hash-table.lisp48
-rw-r--r--Sacla/tests/should-package.lisp53
-rw-r--r--Sacla/tests/should-sequence.lisp375
-rw-r--r--Sacla/tests/should-string.lisp28
-rw-r--r--Sacla/tests/should-symbol.lisp227
-rw-r--r--Sacla/tests/x-sequence.lisp300
36 files changed, 33393 insertions, 0 deletions
diff --git a/Sacla/tests/ansi-tests.lisp b/Sacla/tests/ansi-tests.lisp
new file mode 100644
index 0000000..5245a61
--- /dev/null
+++ b/Sacla/tests/ansi-tests.lisp
@@ -0,0 +1,89 @@
+;; Copyright (C) 2004 Yuji Minejima <ggb01164@nifty.ne.jp>
+;; ALL RIGHTS RESERVED.
+;;
+;; $Id: ansi-tests.lisp,v 1.3 2004/09/28 01:53:23 yuji Exp $
+;;
+;; Redistribution and use in source and binary forms, with or without
+;; modification, are permitted provided that the following conditions
+;; are met:
+;;
+;; * Redistributions of source code must retain the above copyright
+;; notice, this list of conditions and the following disclaimer.
+;; * 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.
+;;
+;; 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
+;; OWNER 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.
+
+;;; Commentary:
+
+;; Support routines for Paul Dietz's ANSI testsuite.
+;;
+;; When testing loop.lisp, do the following.
+;; (load "loop.lisp")
+;; (load "tests/ansi-tests.lisp")
+;; (in-package "CL-TEST")
+;; (shadowing-import '(sacla-loop:loop sacla-loop:loop-finish))
+
+
+(defpackage "CL-TEST"
+ (:use "COMMON-LISP"))
+
+(in-package "CL-TEST")
+
+(defmacro deftest (name form &rest values)
+ `(equal (multiple-value-list ,form) ',values))
+
+
+
+;;;; from ansi-aux.lsp of GCL's ANSI-TESTS
+;;;; Author: Paul Dietz
+;;;; Created: Sat Mar 28 17:10:18 1998
+;;;; License: GPL
+(defmacro classify-error* (form)
+"Evaluate form in safe mode, returning its value if there is no error.
+If an error does occur, return a symbol classify the error, or allow
+the condition to go uncaught if it cannot be classified."
+`(locally (declare (optimize (safety 3)))
+ (handler-case ,form
+ (undefined-function () 'undefined-function)
+ (program-error () 'program-error)
+ (package-error () 'package-error)
+ (type-error () 'type-error)
+ (control-error () 'control-error)
+ (stream-error () 'stream-error)
+ (reader-error () 'reader-error)
+ (file-error () 'file-error)
+ (control-error () 'control-error)
+ (cell-error () 'cell-error)
+ (error () 'error)
+ )))
+
+(defun classify-error** (form)
+ (handler-bind ((warning #'(lambda (c) (declare (ignore c))
+ (muffle-warning))))
+ (classify-error* (eval form))))
+
+(defmacro classify-error (form)
+ `(classify-error** ',form))
+
+(defun notnot (x) (not (not x)))
+(defun eqlt (x y)
+ "Like EQL, but guaranteed to return T for true."
+ (apply #'values (mapcar #'notnot (multiple-value-list (eql x y)))))
+(defun equalt (x y)
+ "Like EQUAL, but guaranteed to return T for true."
+ (apply #'values (mapcar #'notnot (multiple-value-list (equal x y)))))
+(defun symbol< (x &rest args)
+ (apply #'string< (symbol-name x) (mapcar #'symbol-name args)))
diff --git a/Sacla/tests/desirable-printer.lisp b/Sacla/tests/desirable-printer.lisp
new file mode 100644
index 0000000..7ccee09
--- /dev/null
+++ b/Sacla/tests/desirable-printer.lisp
@@ -0,0 +1,223 @@
+;; Copyright (C) 2002-2004, Yuji Minejima <ggb01164@nifty.ne.jp>
+;; ALL RIGHTS RESERVED.
+;;
+;; $Id: desirable-printer.lisp,v 1.4 2004/02/20 07:23:42 yuji Exp $
+;;
+;; Redistribution and use in source and binary forms, with or without
+;; modification, are permitted provided that the following conditions
+;; are met:
+;;
+;; * Redistributions of source code must retain the above copyright
+;; notice, this list of conditions and the following disclaimer.
+;; * 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.
+;;
+;; 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
+;; OWNER 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.
+
+(let ((*readtable* (copy-readtable nil)))
+ (setf (readtable-case *readtable*) :upcase)
+ (string= (write-to-string '|ZEBRA| :pretty nil :readably t :case :upcase)
+ "ZEBRA"))
+
+(let ((*readtable* (copy-readtable nil)))
+ (setf (readtable-case *readtable*) :upcase)
+ (string= (write-to-string '|Zebra| :pretty nil :readably t :case :upcase)
+ "|Zebra|"))
+
+(let ((*readtable* (copy-readtable nil)))
+ (setf (readtable-case *readtable*) :upcase)
+ (string= (write-to-string '|zebra| :pretty nil :readably t :case :upcase)
+ "|zebra|"))
+
+
+(let ((*readtable* (copy-readtable nil)))
+ (setf (readtable-case *readtable*) :upcase)
+ (string= (write-to-string '|ZEBRA| :pretty nil :readably t :case :downcase)
+ "zebra"))
+
+(let ((*readtable* (copy-readtable nil)))
+ (setf (readtable-case *readtable*) :upcase)
+ (string= (write-to-string '|Zebra| :pretty nil :readably t :case :downcase)
+ "|Zebra|"))
+
+(let ((*readtable* (copy-readtable nil)))
+ (setf (readtable-case *readtable*) :upcase)
+ (string= (write-to-string '|zebra| :pretty nil :readably t :case :downcase)
+ "|zebra|"))
+
+
+(let ((*readtable* (copy-readtable nil)))
+ (setf (readtable-case *readtable*) :upcase)
+ (string= (write-to-string '|ZEBRA| :pretty nil :readably t :case :capitalize)
+ "Zebra"))
+
+(let ((*readtable* (copy-readtable nil)))
+ (setf (readtable-case *readtable*) :upcase)
+ (string= (write-to-string '|Zebra| :pretty nil :readably t :case :capitalize)
+ "|Zebra|"))
+
+(let ((*readtable* (copy-readtable nil)))
+ (setf (readtable-case *readtable*) :upcase)
+ (string= (write-to-string '|zebra| :pretty nil :readably t :case :capitalize)
+ "|zebra|"))
+
+;;
+
+(let ((*readtable* (copy-readtable nil)))
+ (setf (readtable-case *readtable*) :downcase)
+ (string= (write-to-string '|ZEBRA| :pretty nil :readably t :case :upcase)
+ "|ZEBRA|"))
+
+(let ((*readtable* (copy-readtable nil)))
+ (setf (readtable-case *readtable*) :downcase)
+ (string= (write-to-string '|Zebra| :pretty nil :readably t :case :upcase)
+ "|Zebra|"))
+
+(let ((*readtable* (copy-readtable nil)))
+ (setf (readtable-case *readtable*) :downcase)
+ (string= (write-to-string '|zebra| :pretty nil :readably t :case :upcase)
+ "ZEBRA"))
+
+
+(let ((*readtable* (copy-readtable nil)))
+ (setf (readtable-case *readtable*) :downcase)
+ (string= (write-to-string '|ZEBRA| :pretty nil :readably t :case :downcase)
+ "|ZEBRA|"))
+
+(let ((*readtable* (copy-readtable nil)))
+ (setf (readtable-case *readtable*) :downcase)
+ (string= (write-to-string '|Zebra| :pretty nil :readably t :case :downcase)
+ "|Zebra|"))
+
+(let ((*readtable* (copy-readtable nil)))
+ (setf (readtable-case *readtable*) :downcase)
+ (string= (write-to-string '|zebra| :pretty nil :readably t :case :downcase)
+ "zebra"))
+
+
+(let ((*readtable* (copy-readtable nil)))
+ (setf (readtable-case *readtable*) :downcase)
+ (string= (write-to-string '|ZEBRA| :pretty nil :readably t :case :capitalize)
+ "|ZEBRA|"))
+
+(let ((*readtable* (copy-readtable nil)))
+ (setf (readtable-case *readtable*) :downcase)
+ (string= (write-to-string '|Zebra| :pretty nil :readably t :case :capitalize)
+ "|Zebra|"))
+
+(let ((*readtable* (copy-readtable nil)))
+ (setf (readtable-case *readtable*) :downcase)
+ (string= (write-to-string '|zebra| :pretty nil :readably t :case :capitalize)
+ "Zebra"))
+
+
+;;
+(let ((*readtable* (copy-readtable nil)))
+ (setf (readtable-case *readtable*) :preserve)
+ (string= (write-to-string '|ZEBRA| :pretty nil :readably t :case :upcase)
+ "ZEBRA"))
+
+(let ((*readtable* (copy-readtable nil)))
+ (setf (readtable-case *readtable*) :preserve)
+ (string= (write-to-string '|Zebra| :pretty nil :readably t :case :upcase)
+ "Zebra"))
+
+(let ((*readtable* (copy-readtable nil)))
+ (setf (readtable-case *readtable*) :preserve)
+ (string= (write-to-string '|zebra| :pretty nil :readably t :case :upcase)
+ "zebra"))
+
+
+(let ((*readtable* (copy-readtable nil)))
+ (setf (readtable-case *readtable*) :preserve)
+ (string= (write-to-string '|ZEBRA| :pretty nil :readably t :case :downcase)
+ "ZEBRA"))
+
+(let ((*readtable* (copy-readtable nil)))
+ (setf (readtable-case *readtable*) :preserve)
+ (string= (write-to-string '|Zebra| :pretty nil :readably t :case :downcase)
+ "Zebra"))
+
+(let ((*readtable* (copy-readtable nil)))
+ (setf (readtable-case *readtable*) :preserve)
+ (string= (write-to-string '|zebra| :pretty nil :readably t :case :downcase)
+ "zebra"))
+
+
+(let ((*readtable* (copy-readtable nil)))
+ (setf (readtable-case *readtable*) :preserve)
+ (string= (write-to-string '|ZEBRA| :pretty nil :readably t :case :capitalize)
+ "ZEBRA"))
+
+(let ((*readtable* (copy-readtable nil)))
+ (setf (readtable-case *readtable*) :preserve)
+ (string= (write-to-string '|Zebra| :pretty nil :readably t :case :capitalize)
+ "Zebra"))
+
+(let ((*readtable* (copy-readtable nil)))
+ (setf (readtable-case *readtable*) :preserve)
+ (string= (write-to-string '|zebra| :pretty nil :readably t :case :capitalize)
+ "zebra"))
+
+
+;;
+(let ((*readtable* (copy-readtable nil)))
+ (setf (readtable-case *readtable*) :invert)
+ (string= (write-to-string '|ZEBRA| :pretty nil :readably t :case :upcase)
+ "zebra"))
+
+(let ((*readtable* (copy-readtable nil)))
+ (setf (readtable-case *readtable*) :invert)
+ (string= (write-to-string '|Zebra| :pretty nil :readably t :case :upcase)
+ "Zebra"))
+
+(let ((*readtable* (copy-readtable nil)))
+ (setf (readtable-case *readtable*) :invert)
+ (string= (write-to-string '|zebra| :pretty nil :readably t :case :upcase)
+ "ZEBRA"))
+
+
+(let ((*readtable* (copy-readtable nil)))
+ (setf (readtable-case *readtable*) :invert)
+ (string= (write-to-string '|ZEBRA| :pretty nil :readably t :case :downcase)
+ "zebra"))
+
+(let ((*readtable* (copy-readtable nil)))
+ (setf (readtable-case *readtable*) :invert)
+ (string= (write-to-string '|Zebra| :pretty nil :readably t :case :downcase)
+ "Zebra"))
+
+(let ((*readtable* (copy-readtable nil)))
+ (setf (readtable-case *readtable*) :invert)
+ (string= (write-to-string '|zebra| :pretty nil :readably t :case :downcase)
+ "ZEBRA"))
+
+
+(let ((*readtable* (copy-readtable nil)))
+ (setf (readtable-case *readtable*) :invert)
+ (string= (write-to-string '|ZEBRA| :pretty nil :readably t :case :capitalize)
+ "zebra"))
+
+(let ((*readtable* (copy-readtable nil)))
+ (setf (readtable-case *readtable*) :invert)
+ (string= (write-to-string '|Zebra| :pretty nil :readably t :case :capitalize)
+ "Zebra"))
+
+(let ((*readtable* (copy-readtable nil)))
+ (setf (readtable-case *readtable*) :invert)
+ (string= (write-to-string '|zebra| :pretty nil :readably t :case :capitalize)
+ "ZEBRA"))
+
+
diff --git a/Sacla/tests/must-array.lisp b/Sacla/tests/must-array.lisp
new file mode 100644
index 0000000..205f577
--- /dev/null
+++ b/Sacla/tests/must-array.lisp
@@ -0,0 +1,2297 @@
+;; Copyright (C) 2002-2004, Yuji Minejima <ggb01164@nifty.ne.jp>
+;; ALL RIGHTS RESERVED.
+;;
+;; $Id: must-array.lisp,v 1.9 2004/08/09 02:49:54 yuji Exp $
+;;
+;; Redistribution and use in source and binary forms, with or without
+;; modification, are permitted provided that the following conditions
+;; are met:
+;;
+;; * Redistributions of source code must retain the above copyright
+;; notice, this list of conditions and the following disclaimer.
+;; * 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.
+;;
+;; 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
+;; OWNER 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.
+
+(arrayp (make-array nil))
+(arrayp (make-array 10))
+(vectorp (make-array 10))
+(arrayp (make-array '(1 2)))
+(arrayp (make-array '(1 2 3)))
+(arrayp (make-array '(1 2 3 4)))
+(arrayp (make-array '(1 2 3 4 5)))
+(arrayp (make-array '(3 3 3)))
+(arrayp (make-array '(3 0 3)))
+(arrayp (make-array '5 :element-type 'character :displaced-to "array"))
+(arrayp "")
+(arrayp "array")
+(arrayp (make-array '(2 3 4) :adjustable t))
+(arrayp (make-array 6))
+(arrayp #*1011)
+(arrayp "hi")
+(not (arrayp 'hi))
+(not (arrayp 12))
+
+
+
+(let ((array (make-array '(2 3) :initial-contents '((0 1 2) (3 4 5)))))
+ (and (eql (aref array 0 0) 0)
+ (eql (aref array 0 1) 1)
+ (eql (aref array 0 2) 2)
+ (eql (aref array 1 0) 3)
+ (eql (aref array 1 1) 4)
+ (eql (aref array 1 2) 5)))
+
+(let ((array (make-array '(3 2 1)
+ :initial-contents '(((0) (1)) ((2) (3)) ((4) (5))))))
+ (and (eql (aref array 0 0 0) 0)
+ (eql (aref array 0 1 0) 1)
+ (eql (aref array 1 0 0) 2)
+ (eql (aref array 1 1 0) 3)
+ (eql (aref array 2 0 0) 4)
+ (eql (aref array 2 1 0) 5)))
+
+(let ((array (make-array '(2 2 2 2)
+ :initial-contents
+ '((((0 1) (2 3)) ((4 5) (6 7)))
+ (((8 9) (10 11)) ((12 13) (14 15)))))))
+ (and (eql (aref array 0 0 0 0) 0)
+ (eql (aref array 0 0 0 1) 1)
+ (eql (aref array 0 0 1 0) 2)
+ (eql (aref array 0 0 1 1) 3)
+ (eql (aref array 0 1 0 0) 4)
+ (eql (aref array 0 1 0 1) 5)
+ (eql (aref array 0 1 1 0) 6)
+ (eql (aref array 0 1 1 1) 7)
+ (eql (aref array 1 0 0 0) 8)
+ (eql (aref array 1 0 0 1) 9)
+ (eql (aref array 1 0 1 0) 10)
+ (eql (aref array 1 0 1 1) 11)
+ (eql (aref array 1 1 0 0) 12)
+ (eql (aref array 1 1 0 1) 13)
+ (eql (aref array 1 1 1 0) 14)
+ (eql (aref array 1 1 1 1) 15)))
+
+(let ((array (make-array '(3 3 3 3 3 3) :initial-element nil)))
+ (dotimes (i 729)
+ (setf (row-major-aref array i) i))
+ (dotimes (i 729 t)
+ (unless (= (aref array
+ (floor i (* 3 3 3 3 3))
+ (floor (mod i (* 3 3 3 3 3)) (* 3 3 3 3))
+ (floor (mod i (* 3 3 3 3)) (* 3 3 3))
+ (floor (mod i (* 3 3 3)) (* 3 3))
+ (floor (mod i (* 3 3)) (* 3))
+ (mod i 3))
+ i)
+ (return nil))))
+
+
+(zerop (aref (make-array '() :initial-contents 0)))
+(let ((array (make-array 10 :initial-contents '(0 1 2 3 4 5 6 7 8 9)))
+ (ok t))
+ (dotimes (i 10)
+ (unless (eql (aref array i) i)
+ (setq ok nil)
+ (return)))
+ ok)
+
+(let ((array (vector 0 1 2 3 4 5 6 7 8 9))
+ (ok t))
+ (dotimes (i 10)
+ (unless (eql (aref array i) i)
+ (setq ok nil)
+ (return)))
+ ok)
+
+(let ((array "0123456789")
+ (ok t))
+ (dotimes (i 10)
+ (unless (char= (aref array i) (char "0123456789" i))
+ (setq ok nil)
+ (return)))
+ ok)
+
+
+(let ((array (make-array '(2 3) :initial-contents '((0 1 2) (3 4 5)))))
+ (equal (array-dimensions array) '(2 3)))
+
+(equal (array-dimensions (make-array 4)) '(4))
+(equal (array-dimensions (make-array '(2 3))) '(2 3))
+(equal (array-dimensions (make-array 4 :fill-pointer 2)) '(4))
+(equal (array-dimensions (make-array '(2 3 4 5 6))) '(2 3 4 5 6))
+
+(eql (array-dimension (make-array 4) 0) 4)
+(eql (array-dimension (make-array '(2 3)) 1) 3)
+(eql (array-dimension (make-array '(2 3 4)) 2) 4)
+
+(eq (array-element-type (make-array 4)) t)
+(equal (array-element-type (make-array 12 :element-type '(unsigned-byte 8)))
+ (upgraded-array-element-type '(unsigned-byte 8)))
+
+
+(let ((array (make-array '())))
+ (multiple-value-bind (displaced-to displaced-index-offset)
+ (array-displacement array)
+ (and (not displaced-to)
+ (zerop displaced-index-offset))))
+
+(let ((array (make-array '10)))
+ (multiple-value-bind (displaced-to displaced-index-offset)
+ (array-displacement array)
+ (and (not displaced-to)
+ (zerop displaced-index-offset))))
+
+(let ((array (make-array '(2 3) :initial-contents '((0 1 2) (3 4 5)))))
+ (multiple-value-bind (displaced-to displaced-index-offset)
+ (array-displacement array)
+ (and (not displaced-to)
+ (zerop displaced-index-offset))))
+
+(let* ((source (make-array '(2 5)
+ :initial-contents '((1 2 3 4 5) (11 12 13 14 15))))
+ (array (make-array 10 :displaced-to source)))
+ (multiple-value-bind (displaced-to displaced-index-offset)
+ (array-displacement array)
+ (and (eq displaced-to source)
+ (zerop displaced-index-offset))))
+
+(let* ((source (make-array '10 :initial-element 0))
+ (array (make-array '(5 2) :displaced-to source)))
+ (multiple-value-bind (displaced-to displaced-index-offset)
+ (array-displacement array)
+ (and (eq displaced-to source)
+ (zerop displaced-index-offset))))
+
+(let* ((e0-0 (list 0 0))
+ (e0-1 (list 0 1))
+ (e1-0 (list 1 0))
+ (e1-1 (list 1 1))
+ (source (make-array '(2 2)
+ :initial-contents (list (list e0-0 e0-1)
+ (list e1-0 e1-1))))
+ (array (make-array 4 :displaced-to source)))
+ (multiple-value-bind (displaced-to displaced-index-offset)
+ (array-displacement array)
+ (and (eq displaced-to source)
+ (zerop displaced-index-offset)
+ (eq (aref array 0) e0-0)
+ (eq (aref array 1) e0-1)
+ (eq (aref array 2) e1-0)
+ (eq (aref array 3) e1-1))))
+
+
+(let* ((e0-0 (list 0 0))
+ (e0-1 (list 0 1))
+ (e1-0 (list 1 0))
+ (e1-1 (list 1 1))
+ (source (make-array '(2 2)
+ :initial-contents (list (list e0-0 e0-1)
+ (list e1-0 e1-1))))
+ (array (make-array 2 :displaced-to source :displaced-index-offset 1)))
+ (multiple-value-bind (displaced-to displaced-index-offset)
+ (array-displacement array)
+ (and (eq displaced-to source)
+ (eql displaced-index-offset 1)
+ (eq (aref array 0) e0-1)
+ (eq (aref array 1) e1-0))))
+
+(let ((array (make-array 4
+ :element-type 'character
+ :displaced-to "0123456789"
+ :displaced-index-offset 6)))
+ (multiple-value-bind (displaced-to displaced-index-offset)
+ (array-displacement array)
+ (and (string= displaced-to "0123456789")
+ (eql displaced-index-offset 6)
+ (eql (aref array 0) #\6)
+ (eql (aref array 1) #\7)
+ (eql (aref array 2) #\8)
+ (eql (aref array 3) #\9))))
+
+(let ((array (make-array '(1 2 5)
+ :element-type 'character
+ :displaced-to "0123456789")))
+ (multiple-value-bind (displaced-to displaced-index-offset)
+ (array-displacement array)
+ (and (string= displaced-to "0123456789")
+ (eql displaced-index-offset 0)
+ (eql (aref array 0 0 0) #\0)
+ (eql (aref array 0 0 1) #\1)
+ (eql (aref array 0 0 2) #\2)
+ (eql (aref array 0 0 3) #\3)
+ (eql (aref array 0 0 4) #\4)
+ (eql (aref array 0 1 0) #\5)
+ (eql (aref array 0 1 1) #\6)
+ (eql (aref array 0 1 2) #\7)
+ (eql (aref array 0 1 3) #\8)
+ (eql (aref array 0 1 4) #\9))))
+
+(let* ((source (make-array '(2 5)
+ :initial-contents '("love&" "peace")
+ :element-type 'character))
+ (array (make-array 10 :displaced-to source :element-type 'character)))
+ (multiple-value-bind (displaced-to displaced-index-offset)
+ (array-displacement array)
+ (and (eq displaced-to source)
+ (eql displaced-index-offset 0)
+ (string= array "love&peace"))))
+
+(array-in-bounds-p (make-array 5) 4)
+(not (array-in-bounds-p (make-array 5) -1))
+(let ((a (make-array '(7 11) :element-type 'string-char)))
+ (and (array-in-bounds-p a 0 0)
+ (array-in-bounds-p a 6 10)
+ (not (array-in-bounds-p a 0 -1))
+ (not (array-in-bounds-p a 0 11))
+ (not (array-in-bounds-p a 7 0))))
+
+
+
+
+(let ((array (make-array '(2 3) :initial-contents '((0 1 2) (3 4 5)))))
+ (eql (array-rank array) 2))
+
+(zerop (array-rank (make-array '())))
+(eql (array-rank (make-array 10)) 1)
+(eql (array-rank (make-array '(2 10))) 2)
+(eql (array-rank (make-array '(2 10 1))) 3)
+(eql (array-rank (make-array '(2 10 1 3))) 4)
+(eql (array-rank "") 1)
+(eql (array-rank "a") 1)
+
+(zerop (array-row-major-index (make-array '())))
+(zerop (array-row-major-index (make-array '5) 0))
+(eql (array-row-major-index (make-array '5) 4) 4)
+(eql (array-row-major-index (make-array '10) 3) 3)
+(zerop (array-row-major-index (make-array '(3 4)) 0 0))
+(eql (array-row-major-index (make-array '(3 4)) 2 3) 11)
+(zerop (array-row-major-index (make-array '(3 4 5)) 0 0 0))
+(eql (array-row-major-index (make-array '(3 4 5)) 2 3 4) 59)
+
+
+(let ((array (make-array '(2 3) :initial-contents '((0 1 2) (3 4 5)))))
+ (eql (array-total-size array) 6))
+
+(eql (array-total-size (make-array 4)) 4)
+(eql (array-total-size (make-array 4 :fill-pointer 2)) 4)
+(eql (array-total-size (make-array 0)) 0)
+(eql (array-total-size (make-array '(4 2))) 8)
+(eql (array-total-size (make-array '(4 0))) 0)
+(eql (array-total-size (make-array '())) 1)
+(eql (array-total-size (make-array '(2 3 4 5))) (* 2 3 4 5))
+
+
+(let ((array (make-array 10
+ :initial-contents '(0 1 2 3 4 5 6 7 8 9)
+ :fill-pointer 0)))
+ (dotimes (i 10 t)
+ (unless (eql (aref array i) i)
+ (return nil))))
+
+(let ((array (make-array '(10 10) :element-type 'number :initial-element 0)))
+ (dotimes (i 10)
+ (dotimes (j 10)
+ (unless (zerop (aref array i j))
+ (return nil))
+ (setf (aref array i j) (+ (* i 10) j))))
+ (dotimes (i 100 t)
+ (unless (eql (row-major-aref array i) i)
+ (return nil))))
+
+(let ((array (make-array '())))
+ (setf (aref array) 100)
+ (eql (aref array) 100))
+
+(let ((array (make-array 10 :initial-contents '(a b c d e f g h i j))))
+ (setf (aref array 0) #\a)
+ (setf (aref array 2) #\c)
+ (setf (aref array 4) #\e)
+ (setf (aref array 6) #\g)
+ (setf (aref array 8) #\i)
+ (and (eql (aref array 0) #\a) (eql (aref array 1) 'b)
+ (eql (aref array 2) #\c) (eql (aref array 3) 'd)
+ (eql (aref array 4) #\e) (eql (aref array 5) 'f)
+ (eql (aref array 6) #\g) (eql (aref array 7) 'h)
+ (eql (aref array 8) #\i) (eql (aref array 9) 'j)))
+
+(let ((array (vector 'a 'b 'c 'd 'e 'f 'g 'h 'i 'j)))
+ (setf (aref array 0) #\a)
+ (setf (aref array 2) #\c)
+ (setf (aref array 4) #\e)
+ (setf (aref array 6) #\g)
+ (setf (aref array 8) #\i)
+ (and (eql (aref array 0) #\a) (eql (aref array 1) 'b)
+ (eql (aref array 2) #\c) (eql (aref array 3) 'd)
+ (eql (aref array 4) #\e) (eql (aref array 5) 'f)
+ (eql (aref array 6) #\g) (eql (aref array 7) 'h)
+ (eql (aref array 8) #\i) (eql (aref array 9) 'j)))
+
+(let ((array (make-array '(3 4 5) :initial-element 0 :element-type 'number)))
+ (setf (aref array 0 0 0) 0)
+ (setf (aref array 1 1 1) 1)
+ (setf (aref array 2 2 2) 2)
+ (dotimes (i 3 t)
+ (unless (eql (aref array i i i) i)
+ (return nil))))
+
+(let* ((array (make-array '(3 4 5 6 7)
+ :initial-element 0 :element-type 'number))
+ (array2 (make-array (* 3 4 5 6 7) :displaced-to array)))
+ (setf (aref array 2 3 4 5 6) 100)
+ (setf (aref array 0 0 0 0 0) 200)
+ (eql (reduce #'+ array2) 300))
+
+(adjustable-array-p (make-array 5
+ :element-type 'character
+ :adjustable t
+ :fill-pointer 3))
+
+(let ((array (adjust-array (make-array '(2 3)
+ :initial-contents '((0 1 2) (3 4 5))
+ :adjustable t)
+ '(3 2) :initial-element 'undefined)))
+ (and (eql (aref array 0 0) 0)
+ (eql (aref array 0 1) 1)
+ (eql (aref array 1 0) 3)
+ (eql (aref array 1 1) 4)
+ (eql (aref array 2 0) 'undefined)
+ (eql (aref array 2 1) 'undefined)))
+
+(let ((array (adjust-array (make-array '(2 3)
+ :initial-contents '((0 1 2) (3 4 5))
+ :adjustable t)
+ '(3 2) :initial-element 'undefined)))
+ (equal (array-dimensions array) '(3 2)))
+
+(let ((array (adjust-array (make-array '(2 3)
+ :initial-contents '((0 1 2) (3 4 5))
+ :adjustable t)
+ '(3 2) :initial-element 'undefined)))
+ (not (array-has-fill-pointer-p array)))
+
+(let ((array (make-array '(2 3) :initial-contents '((0 1 2) (3 4 5)))))
+ (not (array-has-fill-pointer-p array)))
+
+(array-has-fill-pointer-p (make-array 10 :fill-pointer 0))
+(array-has-fill-pointer-p (make-array 8 :fill-pointer 0 :initial-element 8))
+(not (array-has-fill-pointer-p (make-array '(2 3 4))))
+
+
+
+(let ((array (adjust-array (make-array '(2 3)
+ :initial-contents '((0 1 2) (3 4 5))
+ :adjustable t)
+ '(3 2) :initial-element 'undefined)))
+ (multiple-value-bind (displaced-to displaced-index-offset)
+ (array-displacement array)
+ (and (not displaced-to)
+ (zerop displaced-index-offset))))
+
+(let ((array (adjust-array (make-array '(2 3)
+ :initial-contents '((0 1 2) (3 4 5))
+ :adjustable t)
+ '(3 2) :initial-element 'undefined)))
+ (eql (array-rank array) 2))
+
+(let ((array (adjust-array (make-array '(2 3)
+ :initial-contents '((0 1 2) (3 4 5))
+ :adjustable t)
+ '(3 2) :initial-element 'undefined)))
+ (eql (array-total-size array) 6))
+
+
+(eql (fill-pointer (make-array 8 :fill-pointer 4)) 4)
+(let ((array (make-array 8 :fill-pointer 4 :initial-element nil)))
+ (and (eql (length array) 4)
+ (setf (fill-pointer array) 3)
+ (eql (fill-pointer array) 3)
+ (eql (length array) 3)))
+
+(let ((vector (make-array 10
+ :fill-pointer 0
+ :initial-element #\Space
+ :element-type 'character)))
+ (and (eql (vector-push #\a vector) 0)
+ (eql (vector-push #\b vector) 1)
+ (eql (vector-push #\c vector) 2)
+ (string= vector "abc")))
+
+(let ((vector (make-array 3 :fill-pointer t :initial-contents '(a b c))))
+ (and (eql (array-dimension vector 0) (fill-pointer vector))
+ (equal (concatenate 'list vector) '(a b c))
+ (zerop (setf (fill-pointer vector) 0))
+ (null (concatenate 'list vector))
+ (eql (vector-push 'x vector) 0)
+ (equal (concatenate 'list vector) '(x))
+ (eq (vector-pop vector) 'x)
+ (zerop (length vector))))
+
+(let ((vector (make-array 10 :fill-pointer 0 :initial-element nil)))
+ (and (eql (length vector) 0)
+ (setf (fill-pointer vector) 10)
+ (eql (length vector) 10)
+ (setf (fill-pointer vector) 5)
+ (eql (length vector) 5)))
+
+
+(let ((array (make-array '(3 2 1)
+ :initial-contents '(((0) (1)) ((2) (3)) ((4) (5))))))
+ (and (eql (aref array 0 0 0) (row-major-aref array 0))
+ (eql (aref array 0 1 0) (row-major-aref array 1))
+ (eql (aref array 1 0 0) (row-major-aref array 2))
+ (eql (aref array 1 1 0) (row-major-aref array 3))
+ (eql (aref array 2 0 0) (row-major-aref array 4))
+ (eql (aref array 2 1 0) (row-major-aref array 5))))
+
+(let ((array (make-array '(3 2 1)
+ :initial-contents '(((0) (1)) ((2) (3)) ((4) (5))))))
+ (and (eql 0 (row-major-aref array 0))
+ (eql 1 (row-major-aref array 1))
+ (eql 2 (row-major-aref array 2))
+ (eql 3 (row-major-aref array 3))
+ (eql 4 (row-major-aref array 4))
+ (eql 5 (row-major-aref array 5))))
+
+
+(let* ((array0 (make-array '(3 2 1)
+ :initial-contents '(((0) (1)) ((2) (3)) ((4) (5)))))
+ (array1 (make-array 6 :displaced-to array0)))
+ (and (eql (aref array1 0) (row-major-aref array0 0))
+ (eql (aref array1 1) (row-major-aref array0 1))
+ (eql (aref array1 2) (row-major-aref array0 2))
+ (eql (aref array1 3) (row-major-aref array0 3))
+ (eql (aref array1 4) (row-major-aref array0 4))
+ (eql (aref array1 5) (row-major-aref array0 5))))
+
+(let* ((array0 (make-array 6
+ :element-type 'character
+ :initial-contents "abcdef"))
+ (array1 (make-array '(3 2 1)
+ :displaced-to array0
+ :element-type 'character)))
+ (and (eql (aref array0 0) (row-major-aref array1 0))
+ (eql (aref array0 1) (row-major-aref array1 1))
+ (eql (aref array0 2) (row-major-aref array1 2))
+ (eql (aref array0 3) (row-major-aref array1 3))
+ (eql (aref array0 4) (row-major-aref array1 4))
+ (eql (aref array0 5) (row-major-aref array1 5))))
+
+(let* ((array0 (make-array 6
+ :element-type 'character
+ :initial-contents "abcdef"))
+ (array1 (make-array '(3 2 1)
+ :displaced-to array0
+ :element-type 'character)))
+ (and (eql #\a (row-major-aref array1 0))
+ (eql #\b (row-major-aref array1 1))
+ (eql #\c (row-major-aref array1 2))
+ (eql #\d (row-major-aref array1 3))
+ (eql #\e (row-major-aref array1 4))
+ (eql #\f (row-major-aref array1 5))))
+
+(let ((array (make-array '(3 2 1) :initial-element nil)))
+ (setf (row-major-aref array 0) 'a)
+ (setf (row-major-aref array 1) 'b)
+ (setf (row-major-aref array 2) 'c)
+ (setf (row-major-aref array 3) 'd)
+ (setf (row-major-aref array 4) 'e)
+ (and (eql (aref array 0 0 0) 'a)
+ (eql (aref array 0 1 0) 'b)
+ (eql (aref array 1 0 0) 'c)
+ (eql (aref array 1 1 0) 'd)
+ (eql (aref array 2 0 0) 'e)
+ (eql (aref array 2 1 0) 'nil)))
+
+(let ((str "abcdefg"))
+ (dotimes (i 7 t)
+ (unless (eql (char str 0) (row-major-aref str 0))
+ (return nil))))
+
+(let ((str (make-array 5 :initial-contents "abcde")))
+ (dotimes (i 3)
+ (setf (row-major-aref str i) (row-major-aref str (- 4 i))))
+ (and (char= (row-major-aref str 0) #\e)
+ (char= (row-major-aref str 1) #\d)
+ (char= (row-major-aref str 2) #\c)
+ (char= (row-major-aref str 3) #\d)
+ (char= (row-major-aref str 4) #\e)))
+
+
+(eq (upgraded-array-element-type t) t)
+(and (subtypep (upgraded-array-element-type 'bit) 'bit)
+ (subtypep 'bit (upgraded-array-element-type 'bit)))
+(and (subtypep (upgraded-array-element-type 'base-char) 'base-char)
+ (subtypep 'base-char (upgraded-array-element-type 'base-char)))
+(and (subtypep (upgraded-array-element-type 'character) 'character)
+ (subtypep 'character (upgraded-array-element-type 'character)))
+
+
+(simple-vector-p (make-array 6))
+(not (simple-vector-p "aaaaaa"))
+
+(let ((sv (make-array 10)))
+ (dotimes (i 10)
+ (setf (svref sv i) (* i i)))
+ (dotimes (i 10 t)
+ (unless (eql (svref sv i) (* i i))
+ (return nil))))
+
+(let ((sv (vector 'a 'b 'c 'd 'e 'f)))
+ (and (eq (svref sv 0) 'a)
+ (eq (svref sv 1) 'b)
+ (eq (svref sv 2) 'c)
+ (eq (svref sv 3) 'd)
+ (eq (svref sv 4) 'e)
+ (eq (svref sv 5) 'f)))
+
+(let ((sv (make-array 3 :initial-contents '(1 2 last))))
+ (and (simple-vector-p sv)
+ (eq (svref sv 2) 'last)
+ (eql (svref sv 1) 2)
+ (eql (svref sv 0) 1)
+ (eql (setf (svref sv 1) 'last-but-one) 'last-but-one)
+ (eq (svref sv 1) 'last-but-one)))
+
+
+(let ((vec (vector 1 2 'last)))
+ (and (arrayp vec)
+ (vectorp vec)
+ (simple-vector-p vec)
+ (eql (length vec) 3)
+ (equal (concatenate 'list vec) '(1 2 last))))
+
+(eq (vector-pop (make-array 3 :initial-contents '(a b c) :fill-pointer t)) 'c)
+(eq (vector-pop (make-array 3 :initial-contents '(a b c) :fill-pointer 3)) 'c)
+(eq (vector-pop (make-array 3 :initial-contents '(a b c) :fill-pointer 2)) 'b)
+(eq (vector-pop (make-array 3 :initial-contents '(a b c) :fill-pointer 1)) 'a)
+
+(let ((vec (make-array 3 :fill-pointer 0)))
+ (and (eql (vector-push 'a vec) 0)
+ (eql (vector-push 'b vec) 1)
+ (eql (vector-push 'c vec) 2)
+ (eq (vector-pop vec) 'c)
+ (eq (vector-pop vec) 'b)
+ (eq (vector-pop vec) 'a)))
+
+(let ((vec (make-array 3 :fill-pointer t :initial-contents '(a b c))))
+ (and (setf (fill-pointer vec) 1)
+ (eql (vector-push 'y vec) 1)
+ (eql (vector-push 'z vec) 2)
+ (eq (vector-pop vec) 'z)
+ (eq (vector-pop vec) 'y)
+ (eq (vector-pop vec) 'a)
+ (eql (fill-pointer vec) 0)))
+
+(let ((vec (make-array 3 :fill-pointer t :initial-contents '(a b c))))
+ (and (not (vector-push 'x vec))
+ (not (vector-push 'y vec))
+ (eql (setf (fill-pointer vec) 0) 0)
+ (eql (vector-push 'x vec) 0)
+ (eql (vector-push 'y vec) 1)
+ (eql (vector-push 'z vec) 2)
+ (not (vector-push 'l vec))))
+
+
+
+(let ((vec (make-array 3
+ :fill-pointer 2
+ :initial-contents '(a b l)
+ :adjustable t)))
+ (and (eql (length vec) 2)
+ (eql (vector-push-extend 'c vec) 2)
+ (eql (length vec) 3)
+ (eq (vector-pop vec) 'c)
+ (eql (vector-push-extend 'c vec) 2)
+ (eql (vector-push-extend 'x vec) 3)
+ (eql (vector-push-extend 'y vec) 4)
+ (eql (vector-push-extend 'z vec) 5)
+ (eql (length vec) 6)))
+
+
+(let ((vec (make-array 0
+ :fill-pointer t
+ :adjustable t)))
+ (dotimes (i 50)
+ (vector-push-extend (* i i) vec))
+ (dotimes (i 50 t)
+ (unless (eql (vector-pop vec) (* (- 49 i) (- 49 i)))
+ (return nil))))
+
+(let ((vec (make-array 10
+ :element-type 'character
+ :initial-contents "abcdefghij"
+ :adjustable t
+ :fill-pointer t)))
+ (and (eql (vector-push-extend #\x vec) 10)
+ (eql (vector-push-extend #\y vec) 11)
+ (eql (vector-push-extend #\z vec) 12)
+ (string= vec "abcdefghijxyz")))
+
+(vectorp "aaaaaa")
+(vectorp (make-array 6 :fill-pointer t))
+(not (vectorp (make-array '(2 3 4))))
+(vectorp #*11)
+(not (vectorp #b11))
+(vectorp (make-array 3 :displaced-to "abc" :element-type 'character))
+
+(eql (bit (make-array 8 :element-type 'bit :initial-element 1) 3)
+ 1)
+(eql (sbit (make-array 8 :element-type 'bit :initial-element 1) 3)
+ 1)
+
+(let ((ba (make-array 8
+ :element-type 'bit
+ :initial-contents '(0 1 0 1 0 1 0 1))))
+ (dotimes (i 8 t)
+ (unless (or (and (evenp i) (zerop (bit ba i)))
+ (and (oddp i) (eql (bit ba i) 1)))
+ (return nil))))
+
+(let ((ba (make-array 8
+ :element-type 'bit
+ :initial-contents '(0 1 0 1 0 1 0 1))))
+ (dotimes (i 8 t)
+ (unless (or (and (evenp i) (zerop (sbit ba i)))
+ (and (oddp i) (eql (sbit ba i) 1)))
+ (return nil))))
+
+(let ((ba (make-array '(3 3)
+ :element-type 'bit
+ :initial-contents '((0 1 0) (1 0 1) (0 1 0)))))
+ (and (zerop (bit ba 0 0))
+ (eql (bit ba 0 1) 1)
+ (zerop (bit ba 0 2))
+ (eql (bit ba 1 0) 1)
+ (zerop (bit ba 1 1))
+ (eql (bit ba 1 2) 1)
+ (zerop (bit ba 2 0))
+ (eql (bit ba 2 1) 1)
+ (zerop (bit ba 2 2))))
+
+(let ((ba (make-array '(3 3)
+ :element-type 'bit
+ :initial-contents '((0 1 0) (1 0 1) (0 1 0)))))
+ (and (zerop (sbit ba 0 0))
+ (eql (sbit ba 0 1) 1)
+ (zerop (sbit ba 0 2))
+ (eql (sbit ba 1 0) 1)
+ (zerop (sbit ba 1 1))
+ (eql (sbit ba 1 2) 1)
+ (zerop (sbit ba 2 0))
+ (eql (sbit ba 2 1) 1)
+ (zerop (sbit ba 2 2))))
+
+(let ((ba (make-array '(3 3 3) :element-type 'bit)))
+ (dotimes (i (* 3 3 3))
+ (setf (bit ba
+ (floor i 9)
+ (floor (mod i 9) 3)
+ (mod i 3))
+ (if (evenp i) 0 1)))
+ (dotimes (i (* 3 3 3) t)
+ (unless (eql (row-major-aref ba i) (if (evenp i) 0 1))
+ (return nil))))
+
+(let ((ba (make-array '(3 3 3) :element-type 'bit)))
+ (dotimes (i (* 3 3 3))
+ (setf (sbit ba
+ (floor i 9)
+ (floor (mod i 9) 3)
+ (mod i 3))
+ (if (evenp i) 0 1)))
+ (dotimes (i (* 3 3 3) t)
+ (unless (eql (row-major-aref ba i) (if (evenp i) 0 1))
+ (return nil))))
+
+(let ((ba (make-array '(1 2 3 4 5) :element-type 'bit)))
+ (dotimes (i (* 1 2 3 4 5))
+ (setf (bit ba
+ (floor i (* 1 2 3 4 5))
+ (floor (mod i (* 2 3 4 5)) (* 3 4 5))
+ (floor (mod i (* 3 4 5)) (* 4 5))
+ (floor (mod i (* 4 5)) 5)
+ (mod i 5))
+ (if (evenp i) 0 1)))
+ (dotimes (i (* 1 2 3 4 5) t)
+ (unless (eql (row-major-aref ba i) (if (evenp i) 0 1))
+ (return nil))))
+
+(let ((ba (make-array '(1 2 3 4 5) :element-type 'bit)))
+ (dotimes (i (* 1 2 3 4 5))
+ (setf (sbit ba
+ (floor i (* 1 2 3 4 5))
+ (floor (mod i (* 2 3 4 5)) (* 3 4 5))
+ (floor (mod i (* 3 4 5)) (* 4 5))
+ (floor (mod i (* 4 5)) 5)
+ (mod i 5))
+ (if (evenp i) 0 1)))
+ (dotimes (i (* 1 2 3 4 5) t)
+ (unless (eql (row-major-aref ba i) (if (evenp i) 0 1))
+ (return nil))))
+
+(let ((ba (make-array 8 :element-type 'bit :initial-element 1)))
+ (and (eql (setf (bit ba 3) 0) 0)
+ (eql (bit ba 3) 0)
+ (eql (sbit ba 5) 1)
+ (eql (setf (sbit ba 5) 0) 0)
+ (eql (sbit ba 5) 0)))
+
+
+(let ((ba (make-array 10 :element-type 'bit :fill-pointer 0)))
+ (dotimes (i 10)
+ (vector-push (if (oddp i) 0 1) ba))
+ (dotimes (i 10 t)
+ (unless (and (eql (bit ba i) (if (oddp i) 0 1))
+ (or (not (simple-vector-p ba))
+ (eql (sbit ba i) (if (oddp i) 0 1)))
+ (eql (aref ba i) (if (oddp i) 0 1)))
+ (return nil))))
+
+(let ((ba (make-array 10 :element-type 'bit :fill-pointer 0)))
+ (dotimes (i 10)
+ (vector-push (if (oddp i) 0 1) ba))
+ (dotimes (j 10 t)
+ (let ((i (- 9 j)))
+ (unless (and (eql (bit ba i) (if (oddp i) 0 1))
+ (or (not (simple-vector-p ba))
+ (eql (sbit ba i) (if (oddp i) 0 1)))
+ (eql (aref ba i) (if (oddp i) 0 1))
+ (eql (vector-pop ba) (if (oddp i) 0 1)))
+ (return nil)))))
+
+
+(equal (bit-and #*11101010 #*01101011) #*01101010)
+(equal (bit-and #*11101010 #*01101011 nil) #*01101010)
+(equal (bit-and (make-array 8 :element-type 'bit :initial-contents #*11101010)
+ #*01101011 t)
+ #*01101010)
+(equal (bit-and #*11101010
+ #*01101011
+ (make-array 8 :element-type 'bit))
+ #*01101010)
+
+(let* ((ba1 (make-array 8 :element-type 'bit :initial-contents #*11101010))
+ (ba2 (make-array 8 :element-type 'bit :initial-contents #*01101011))
+ (ba (bit-and ba1 ba2)))
+ (and (not (eq ba1 ba))
+ (not (eq ba2 ba))
+ (not (eq ba1 ba2))
+ (equal ba #*01101010)))
+
+(let* ((ba1 (make-array 8 :element-type 'bit :initial-contents #*01010101))
+ (ba (bit-and ba1 #*10101010 t)))
+ (and (eq ba1 ba)
+ (equal ba1 #*00000000)))
+
+(let* ((ba1 (make-array 8 :element-type 'bit :initial-contents #*01110001))
+ (ba (bit-and ba1 #*00111110 t)))
+ (and (eq ba1 ba)
+ (equal ba1 #*00110000)))
+
+(let* ((ba1 (make-array 8 :element-type 'bit :initial-contents #*01110001))
+ (ba2 (make-array 8 :element-type 'bit :initial-contents #*00111110))
+ (ba3 (make-array 8 :element-type 'bit))
+ (ba4 (bit-and ba1 ba2 ba3)))
+ (and (eq ba3 ba4)
+ (equal ba3 #*00110000)
+ (not (eq ba1 ba3))
+ (not (eq ba1 ba4))
+ (not (eq ba2 ba3))
+ (not (eq ba2 ba4))))
+
+(equalp (bit-and (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*010 #*101))
+ (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*101 #*010)))
+ (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*000 #*000)))
+
+(equalp (bit-and (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*010 #*101))
+ (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*101 #*010))
+ nil)
+ (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*000 #*000)))
+
+
+(equalp (bit-and (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*010 #*101))
+ (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*101 #*010))
+ t)
+ (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*000 #*000)))
+
+(equalp (bit-and (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*010 #*101))
+ (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*101 #*010))
+ (make-array '(2 3)
+ :element-type 'bit))
+ (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*000 #*000)))
+
+(let* ((ba1 (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*010 #*101)))
+ (ba2 (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*101 #*010)))
+ (ba (bit-and ba1 ba2)))
+ (and (not (eq ba1 ba))
+ (not (eq ba2 ba))
+ (not (eq ba1 ba2))
+ (equalp ba (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*000 #*000)))))
+
+
+(let* ((ba1 (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*010 #*101)))
+ (ba2 (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*101 #*010)))
+ (ba (bit-and ba1 ba2 t)))
+ (and (eq ba1 ba)
+ (equalp ba1 (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*000 #*000)))))
+
+
+(let* ((ba1 (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*010 #*101)))
+ (ba2 (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*101 #*010)))
+ (ba3 (make-array '(2 3)
+ :element-type 'bit))
+ (ba4 (bit-and ba1 ba2 ba3)))
+ (and (eq ba3 ba4)
+ (equalp ba3 (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*000 #*000)))
+ (not (eq ba1 ba3))
+ (not (eq ba1 ba4))
+ (not (eq ba2 ba3))
+ (not (eq ba2 ba4))))
+
+
+(equal (bit-andc1 #*11101010 #*01101011) #*00000001)
+(equal (bit-andc1 #*11101010 #*01101011 nil) #*00000001)
+(equal (bit-andc1 (make-array 8 :element-type 'bit :initial-contents #*11101010)
+ #*01101011 t)
+ #*00000001)
+(equal (bit-andc1 #*11101010
+ #*01101011
+ (make-array 8 :element-type 'bit))
+ #*00000001)
+
+(let* ((ba1 (make-array 8 :element-type 'bit :initial-contents #*11101010))
+ (ba2 (make-array 8 :element-type 'bit :initial-contents #*01101011))
+ (ba (bit-andc1 ba1 ba2)))
+ (and (not (eq ba1 ba))
+ (not (eq ba2 ba))
+ (not (eq ba1 ba2))
+ (equal ba #*00000001)))
+
+(let* ((ba1 (make-array 8 :element-type 'bit :initial-contents #*01010101))
+ (ba (bit-andc1 ba1 #*10101010 t)))
+ (and (eq ba1 ba)
+ (equal ba1 #*10101010)))
+
+(let* ((ba1 (make-array 8 :element-type 'bit :initial-contents #*01110001))
+ (ba (bit-andc1 ba1 #*00111110 t)))
+ (and (eq ba1 ba)
+ (equal ba1 #*00001110)))
+
+(let* ((ba1 (make-array 8 :element-type 'bit :initial-contents #*01110001))
+ (ba2 (make-array 8 :element-type 'bit :initial-contents #*00111110))
+ (ba3 (make-array 8 :element-type 'bit))
+ (ba4 (bit-andc1 ba1 ba2 ba3)))
+ (and (eq ba3 ba4)
+ (equal ba3 #*00001110)
+ (not (eq ba1 ba3))
+ (not (eq ba1 ba4))
+ (not (eq ba2 ba3))
+ (not (eq ba2 ba4))))
+
+(equalp (bit-andc1 (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*010 #*101))
+ (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*101 #*010)))
+ (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*101 #*010)))
+
+(equalp (bit-andc1 (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*010 #*101))
+ (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*101 #*010))
+ nil)
+ (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*101 #*010)))
+
+(equalp (bit-andc1 (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*010 #*101))
+ (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*101 #*010))
+ t)
+ (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*101 #*010)))
+
+(equalp (bit-andc1 (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*010 #*101))
+ (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*101 #*010))
+ (make-array '(2 3)
+ :element-type 'bit))
+ (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*101 #*010)))
+
+(let* ((ba1 (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*010 #*101)))
+ (ba2 (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*101 #*010)))
+ (ba (bit-andc1 ba1 ba2)))
+ (and (not (eq ba1 ba))
+ (not (eq ba2 ba))
+ (not (eq ba1 ba2))
+ (equalp ba (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*101 #*010)))))
+
+(let* ((ba1 (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*010 #*101)))
+ (ba2 (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*101 #*010)))
+ (ba (bit-andc1 ba1 ba2 t)))
+ (and (eq ba1 ba)
+ (equalp ba1 (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*101 #*010)))))
+
+(let* ((ba1 (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*010 #*101)))
+ (ba2 (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*101 #*010)))
+ (ba3 (make-array '(2 3)
+ :element-type 'bit))
+ (ba4 (bit-andc1 ba1 ba2 ba3)))
+ (and (eq ba3 ba4)
+ (equalp ba3 (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*101 #*010)))
+ (not (eq ba1 ba3))
+ (not (eq ba1 ba4))
+ (not (eq ba2 ba3))
+ (not (eq ba2 ba4))))
+
+
+(equal (bit-andc2 #*11101010 #*01101011) #*10000000)
+(equal (bit-andc2 #*11101010 #*01101011 nil) #*10000000)
+(equal (bit-andc2 (make-array 8 :element-type 'bit :initial-contents #*11101010)
+ #*01101011 t)
+ #*10000000)
+(equal (bit-andc2 #*11101010
+ #*01101011
+ (make-array 8 :element-type 'bit))
+ #*10000000)
+(let* ((ba1 (make-array 8 :element-type 'bit :initial-contents #*11101010))
+ (ba2 (make-array 8 :element-type 'bit :initial-contents #*01101011))
+ (ba (bit-andc2 ba1 ba2)))
+ (and (not (eq ba1 ba))
+ (not (eq ba2 ba))
+ (not (eq ba1 ba2))
+ (equal ba #*10000000)))
+
+(let* ((ba1 (make-array 8 :element-type 'bit :initial-contents #*01010101))
+ (ba (bit-andc2 ba1 #*10101010 t)))
+ (and (eq ba1 ba)
+ (equal ba1 #*01010101)))
+
+(let* ((ba1 (make-array 8 :element-type 'bit :initial-contents #*01110001))
+ (ba (bit-andc2 ba1 #*00111110 t)))
+ (and (eq ba1 ba)
+ (equal ba1 #*01000001)))
+
+(let* ((ba1 (make-array 8 :element-type 'bit :initial-contents #*01110001))
+ (ba2 (make-array 8 :element-type 'bit :initial-contents #*00111110))
+ (ba3 (make-array 8 :element-type 'bit))
+ (ba4 (bit-andc2 ba1 ba2 ba3)))
+ (and (eq ba3 ba4)
+ (equal ba3 #*01000001)
+ (not (eq ba1 ba3))
+ (not (eq ba1 ba4))
+ (not (eq ba2 ba3))
+ (not (eq ba2 ba4))))
+
+(equalp (bit-andc2 (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*010 #*101))
+ (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*101 #*010)))
+ (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*010 #*101)))
+
+(equalp (bit-andc2 (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*010 #*101))
+ (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*101 #*010))
+ nil)
+ (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*010 #*101)))
+
+(equalp (bit-andc2 (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*010 #*101))
+ (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*101 #*010))
+ t)
+ (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*010 #*101)))
+
+(equalp (bit-andc2 (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*010 #*101))
+ (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*101 #*010))
+ (make-array '(2 3)
+ :element-type 'bit))
+ (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*010 #*101)))
+
+(let* ((ba1 (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*010 #*101)))
+ (ba2 (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*101 #*010)))
+ (ba (bit-andc2 ba1 ba2)))
+ (and (not (eq ba1 ba))
+ (not (eq ba2 ba))
+ (not (eq ba1 ba2))
+ (equalp ba (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*010 #*101)))))
+
+(let* ((ba1 (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*010 #*101)))
+ (ba2 (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*101 #*010)))
+ (ba (bit-andc2 ba1 ba2 t)))
+ (and (eq ba1 ba)
+ (equalp ba1 (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*010 #*101)))))
+
+(let* ((ba1 (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*010 #*101)))
+ (ba2 (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*101 #*010)))
+ (ba3 (make-array '(2 3)
+ :element-type 'bit))
+ (ba4 (bit-andc2 ba1 ba2 ba3)))
+ (and (eq ba3 ba4)
+ (equalp ba3 (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*010 #*101)))
+ (not (eq ba1 ba3))
+ (not (eq ba1 ba4))
+ (not (eq ba2 ba3))
+ (not (eq ba2 ba4))))
+
+
+(equal (bit-eqv #*11101010 #*01101011) #*01111110)
+(equal (bit-eqv #*11101010 #*01101011 nil) #*01111110)
+(equal (bit-eqv (make-array 8 :element-type 'bit :initial-contents #*11101010)
+ #*01101011 t)
+ #*01111110)
+(equal (bit-eqv #*11101010
+ #*01101011
+ (make-array 8 :element-type 'bit))
+ #*01111110)
+(let* ((ba1 (make-array 8 :element-type 'bit :initial-contents #*11101010))
+ (ba2 (make-array 8 :element-type 'bit :initial-contents #*01101011))
+ (ba (bit-eqv ba1 ba2)))
+ (and (not (eq ba1 ba))
+ (not (eq ba2 ba))
+ (not (eq ba1 ba2))
+ (equal ba #*01111110)))
+
+(let* ((ba1 (make-array 8 :element-type 'bit :initial-contents #*01010101))
+ (ba (bit-eqv ba1 #*10101010 t)))
+ (and (eq ba1 ba)
+ (equal ba1 #*00000000)))
+
+(let* ((ba1 (make-array 8 :element-type 'bit :initial-contents #*01110001))
+ (ba (bit-eqv ba1 #*00111110 t)))
+ (and (eq ba1 ba)
+ (equal ba1 #*10110000)))
+
+(let* ((ba1 (make-array 8 :element-type 'bit :initial-contents #*01110001))
+ (ba2 (make-array 8 :element-type 'bit :initial-contents #*00111110))
+ (ba3 (make-array 8 :element-type 'bit))
+ (ba4 (bit-eqv ba1 ba2 ba3)))
+ (and (eq ba3 ba4)
+ (equal ba3 #*10110000)
+ (not (eq ba1 ba3))
+ (not (eq ba1 ba4))
+ (not (eq ba2 ba3))
+ (not (eq ba2 ba4))))
+
+(equalp (bit-eqv (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*010 #*101))
+ (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*101 #*010)))
+ (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*000 #*000)))
+
+(equalp (bit-eqv (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*010 #*101))
+ (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*101 #*010))
+ nil)
+ (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*000 #*000)))
+
+
+(equalp (bit-eqv (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*010 #*101))
+ (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*101 #*010))
+ t)
+ (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*000 #*000)))
+
+(equalp (bit-eqv (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*010 #*101))
+ (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*101 #*010))
+ (make-array '(2 3)
+ :element-type 'bit))
+ (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*000 #*000)))
+
+(let* ((ba1 (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*010 #*101)))
+ (ba2 (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*101 #*010)))
+ (ba (bit-eqv ba1 ba2)))
+ (and (not (eq ba1 ba))
+ (not (eq ba2 ba))
+ (not (eq ba1 ba2))
+ (equalp ba (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*000 #*000)))))
+
+
+(let* ((ba1 (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*010 #*101)))
+ (ba2 (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*101 #*010)))
+ (ba (bit-eqv ba1 ba2 t)))
+ (and (eq ba1 ba)
+ (equalp ba1 (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*000 #*000)))))
+
+(let* ((ba1 (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*010 #*101)))
+ (ba2 (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*101 #*010)))
+ (ba3 (make-array '(2 3)
+ :element-type 'bit))
+ (ba4 (bit-eqv ba1 ba2 ba3)))
+ (and (eq ba3 ba4)
+ (equalp ba3 (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*000 #*000)))
+ (not (eq ba1 ba3))
+ (not (eq ba1 ba4))
+ (not (eq ba2 ba3))
+ (not (eq ba2 ba4))))
+
+
+
+
+(equal (bit-ior #*11101010 #*01101011) #*11101011)
+(equal (bit-ior #*11101010 #*01101011 nil) #*11101011)
+(equal (bit-ior (make-array 8 :element-type 'bit :initial-contents #*11101010)
+ #*01101011 t)
+ #*11101011)
+(equal (bit-ior #*11101010
+ #*01101011
+ (make-array 8 :element-type 'bit))
+ #*11101011)
+(let* ((ba1 (make-array 8 :element-type 'bit :initial-contents #*11101010))
+ (ba2 (make-array 8 :element-type 'bit :initial-contents #*01101011))
+ (ba (bit-ior ba1 ba2)))
+ (and (not (eq ba1 ba))
+ (not (eq ba2 ba))
+ (not (eq ba1 ba2))
+ (equal ba #*11101011)))
+
+(let* ((ba1 (make-array 8 :element-type 'bit :initial-contents #*01010101))
+ (ba (bit-ior ba1 #*10101010 t)))
+ (and (eq ba1 ba)
+ (equal ba1 #*11111111)))
+
+(let* ((ba1 (make-array 8 :element-type 'bit :initial-contents #*01110001))
+ (ba (bit-ior ba1 #*00111110 t)))
+ (and (eq ba1 ba)
+ (equal ba1 #*01111111)))
+(let* ((ba1 (make-array 8 :element-type 'bit :initial-contents #*01110001))
+ (ba2 (make-array 8 :element-type 'bit :initial-contents #*00111110))
+ (ba3 (make-array 8 :element-type 'bit))
+ (ba4 (bit-ior ba1 ba2 ba3)))
+ (and (eq ba3 ba4)
+ (equal ba3 #*01111111)
+ (not (eq ba1 ba3))
+ (not (eq ba1 ba4))
+ (not (eq ba2 ba3))
+ (not (eq ba2 ba4))))
+
+(equalp (bit-ior (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*010 #*101))
+ (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*101 #*010)))
+ (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*111 #*111)))
+
+(equalp (bit-ior (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*010 #*101))
+ (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*101 #*010))
+ nil)
+ (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*111 #*111)))
+
+(equalp (bit-ior (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*010 #*101))
+ (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*101 #*010))
+ t)
+ (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*111 #*111)))
+(equalp (bit-ior (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*010 #*101))
+ (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*101 #*010))
+ (make-array '(2 3)
+ :element-type 'bit))
+ (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*111 #*111)))
+(let* ((ba1 (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*010 #*101)))
+ (ba2 (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*101 #*010)))
+ (ba (bit-ior ba1 ba2)))
+ (and (not (eq ba1 ba))
+ (not (eq ba2 ba))
+ (not (eq ba1 ba2))
+ (equalp ba (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*111 #*111)))))
+
+
+(let* ((ba1 (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*010 #*101)))
+ (ba2 (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*101 #*010)))
+ (ba (bit-ior ba1 ba2 t)))
+ (and (eq ba1 ba)
+ (equalp ba1 (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*111 #*111)))))
+(let* ((ba1 (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*010 #*101)))
+ (ba2 (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*101 #*010)))
+ (ba3 (make-array '(2 3)
+ :element-type 'bit))
+ (ba4 (bit-ior ba1 ba2 ba3)))
+ (and (eq ba3 ba4)
+ (equalp ba3 (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*111 #*111)))
+ (not (eq ba1 ba3))
+ (not (eq ba1 ba4))
+ (not (eq ba2 ba3))
+ (not (eq ba2 ba4))))
+
+
+
+
+(equal (bit-nand #*11101010 #*01101011) #*10010101)
+(equal (bit-nand #*11101010 #*01101011 nil) #*10010101)
+(equal (bit-nand (make-array 8 :element-type 'bit :initial-contents #*11101010)
+ #*01101011 t)
+ #*10010101)
+(equal (bit-nand #*11101010
+ #*01101011
+ (make-array 8 :element-type 'bit))
+ #*10010101)
+(let* ((ba1 (make-array 8 :element-type 'bit :initial-contents #*11101010))
+ (ba2 (make-array 8 :element-type 'bit :initial-contents #*01101011))
+ (ba (bit-nand ba1 ba2)))
+ (and (not (eq ba1 ba))
+ (not (eq ba2 ba))
+ (not (eq ba1 ba2))
+ (equal ba #*10010101)))
+
+(let* ((ba1 (make-array 8 :element-type 'bit :initial-contents #*01010101))
+ (ba (bit-nand ba1 #*10101010 t)))
+ (and (eq ba1 ba)
+ (equal ba1 #*11111111)))
+
+(let* ((ba1 (make-array 8 :element-type 'bit :initial-contents #*01110001))
+ (ba (bit-nand ba1 #*00111110 t)))
+ (and (eq ba1 ba)
+ (equal ba1 #*11001111)))
+(let* ((ba1 (make-array 8 :element-type 'bit :initial-contents #*01110001))
+ (ba2 (make-array 8 :element-type 'bit :initial-contents #*00111110))
+ (ba3 (make-array 8 :element-type 'bit))
+ (ba4 (bit-nand ba1 ba2 ba3)))
+ (and (eq ba3 ba4)
+ (equal ba3 #*11001111)
+ (not (eq ba1 ba3))
+ (not (eq ba1 ba4))
+ (not (eq ba2 ba3))
+ (not (eq ba2 ba4))))
+(equalp (bit-nand (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*010 #*101))
+ (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*101 #*010)))
+ (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*111 #*111)))
+
+(equalp (bit-nand (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*010 #*101))
+ (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*101 #*010))
+ nil)
+ (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*111 #*111)))
+
+(equalp (bit-nand (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*010 #*101))
+ (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*101 #*010))
+ t)
+ (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*111 #*111)))
+(equalp (bit-nand (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*010 #*101))
+ (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*101 #*010))
+ (make-array '(2 3)
+ :element-type 'bit))
+ (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*111 #*111)))
+(let* ((ba1 (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*010 #*101)))
+ (ba2 (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*101 #*010)))
+ (ba (bit-nand ba1 ba2)))
+ (and (not (eq ba1 ba))
+ (not (eq ba2 ba))
+ (not (eq ba1 ba2))
+ (equalp ba (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*111 #*111)))))
+
+(let* ((ba1 (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*010 #*101)))
+ (ba2 (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*101 #*010)))
+ (ba (bit-nand ba1 ba2 t)))
+ (and (eq ba1 ba)
+ (equalp ba1 (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*111 #*111)))))
+(let* ((ba1 (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*010 #*101)))
+ (ba2 (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*101 #*010)))
+ (ba3 (make-array '(2 3)
+ :element-type 'bit))
+ (ba4 (bit-nand ba1 ba2 ba3)))
+ (and (eq ba3 ba4)
+ (equalp ba3 (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*111 #*111)))
+ (not (eq ba1 ba3))
+ (not (eq ba1 ba4))
+ (not (eq ba2 ba3))
+ (not (eq ba2 ba4))))
+
+
+
+
+(equal (bit-nor #*11101010 #*01101011) #*00010100)
+(equal (bit-nor #*11101010 #*01101011 nil) #*00010100)
+(equal (bit-nor (make-array 8 :element-type 'bit :initial-contents #*11101010)
+ #*01101011 t)
+ #*00010100)
+(equal (bit-nor #*11101010
+ #*01101011
+ (make-array 8 :element-type 'bit))
+ #*00010100)
+(let* ((ba1 (make-array 8 :element-type 'bit :initial-contents #*11101010))
+ (ba2 (make-array 8 :element-type 'bit :initial-contents #*01101011))
+ (ba (bit-nor ba1 ba2)))
+ (and (not (eq ba1 ba))
+ (not (eq ba2 ba))
+ (not (eq ba1 ba2))
+ (equal ba #*00010100)))
+(let* ((ba1 (make-array 8 :element-type 'bit :initial-contents #*01010101))
+ (ba (bit-nor ba1 #*10101010 t)))
+ (and (eq ba1 ba)
+ (equal ba1 #*00000000)))
+(let* ((ba1 (make-array 8 :element-type 'bit :initial-contents #*01110001))
+ (ba (bit-nor ba1 #*00111110 t)))
+ (and (eq ba1 ba)
+ (equal ba1 #*10000000)))
+(let* ((ba1 (make-array 8 :element-type 'bit :initial-contents #*01110001))
+ (ba2 (make-array 8 :element-type 'bit :initial-contents #*00111110))
+ (ba3 (make-array 8 :element-type 'bit))
+ (ba4 (bit-nor ba1 ba2 ba3)))
+ (and (eq ba3 ba4)
+ (equal ba3 #*10000000)
+ (not (eq ba1 ba3))
+ (not (eq ba1 ba4))
+ (not (eq ba2 ba3))
+ (not (eq ba2 ba4))))
+(equalp (bit-nor (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*010 #*101))
+ (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*101 #*010)))
+ (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*000 #*000)))
+
+(equalp (bit-nor (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*010 #*101))
+ (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*101 #*010))
+ nil)
+ (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*000 #*000)))
+
+(equalp (bit-nor (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*010 #*101))
+ (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*101 #*010))
+ t)
+ (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*000 #*000)))
+(equalp (bit-nor (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*010 #*101))
+ (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*101 #*010))
+ (make-array '(2 3)
+ :element-type 'bit))
+ (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*000 #*000)))
+(let* ((ba1 (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*010 #*101)))
+ (ba2 (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*101 #*010)))
+ (ba (bit-nor ba1 ba2)))
+ (and (not (eq ba1 ba))
+ (not (eq ba2 ba))
+ (not (eq ba1 ba2))
+ (equalp ba (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*000 #*000)))))
+
+(let* ((ba1 (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*010 #*101)))
+ (ba2 (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*101 #*010)))
+ (ba (bit-nor ba1 ba2 t)))
+ (and (eq ba1 ba)
+ (equalp ba1 (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*000 #*000)))))
+(let* ((ba1 (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*010 #*101)))
+ (ba2 (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*101 #*010)))
+ (ba3 (make-array '(2 3)
+ :element-type 'bit))
+ (ba4 (bit-nor ba1 ba2 ba3)))
+ (and (eq ba3 ba4)
+ (equalp ba3 (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*000 #*000)))
+ (not (eq ba1 ba3))
+ (not (eq ba1 ba4))
+ (not (eq ba2 ba3))
+ (not (eq ba2 ba4))))
+
+
+
+
+(equal (bit-orc1 #*11101010 #*01101011) #*01111111)
+(equal (bit-orc1 #*11101010 #*01101011 nil) #*01111111)
+(equal (bit-orc1 (make-array 8 :element-type 'bit :initial-contents #*11101010)
+ #*01101011 t)
+ #*01111111)
+(equal (bit-orc1 #*11101010
+ #*01101011
+ (make-array 8 :element-type 'bit))
+ #*01111111)
+(let* ((ba1 (make-array 8 :element-type 'bit :initial-contents #*11101010))
+ (ba2 (make-array 8 :element-type 'bit :initial-contents #*01101011))
+ (ba (bit-orc1 ba1 ba2)))
+ (and (not (eq ba1 ba))
+ (not (eq ba2 ba))
+ (not (eq ba1 ba2))
+ (equal ba #*01111111)))
+(let* ((ba1 (make-array 8 :element-type 'bit :initial-contents #*01010101))
+ (ba (bit-orc1 ba1 #*10101010 t)))
+ (and (eq ba1 ba)
+ (equal ba1 #*10101010)))
+(let* ((ba1 (make-array 8 :element-type 'bit :initial-contents #*01110001))
+ (ba (bit-orc1 ba1 #*00111110 t)))
+ (and (eq ba1 ba)
+ (equal ba1 #*10111110)))
+(let* ((ba1 (make-array 8 :element-type 'bit :initial-contents #*01110001))
+ (ba2 (make-array 8 :element-type 'bit :initial-contents #*00111110))
+ (ba3 (make-array 8 :element-type 'bit))
+ (ba4 (bit-orc1 ba1 ba2 ba3)))
+ (and (eq ba3 ba4)
+ (equal ba3 #*10111110)
+ (not (eq ba1 ba3))
+ (not (eq ba1 ba4))
+ (not (eq ba2 ba3))
+ (not (eq ba2 ba4))))
+(equalp (bit-orc1 (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*010 #*101))
+ (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*101 #*010)))
+ (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*101 #*010)))
+
+(equalp (bit-orc1 (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*010 #*101))
+ (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*101 #*010))
+ nil)
+ (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*101 #*010)))
+
+(equalp (bit-orc1 (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*010 #*101))
+ (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*101 #*010))
+ t)
+ (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*101 #*010)))
+(equalp (bit-orc1 (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*010 #*101))
+ (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*101 #*010))
+ (make-array '(2 3)
+ :element-type 'bit))
+ (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*101 #*010)))
+(let* ((ba1 (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*010 #*101)))
+ (ba2 (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*101 #*010)))
+ (ba (bit-orc1 ba1 ba2)))
+ (and (not (eq ba1 ba))
+ (not (eq ba2 ba))
+ (not (eq ba1 ba2))
+ (equalp ba (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*101 #*010)))))
+
+(let* ((ba1 (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*010 #*101)))
+ (ba2 (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*101 #*010)))
+ (ba (bit-orc1 ba1 ba2 t)))
+ (and (eq ba1 ba)
+ (equalp ba1 (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*101 #*010)))))
+(let* ((ba1 (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*010 #*101)))
+ (ba2 (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*101 #*010)))
+ (ba3 (make-array '(2 3)
+ :element-type 'bit))
+ (ba4 (bit-orc1 ba1 ba2 ba3)))
+ (and (eq ba3 ba4)
+ (equalp ba3 (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*101 #*010)))
+ (not (eq ba1 ba3))
+ (not (eq ba1 ba4))
+ (not (eq ba2 ba3))
+ (not (eq ba2 ba4))))
+
+
+
+(equal (bit-orc2 #*11101010 #*01101011) #*11111110)
+(equal (bit-orc2 #*11101010 #*01101011 nil) #*11111110)
+(equal (bit-orc2 (make-array 8 :element-type 'bit :initial-contents #*11101010)
+ #*01101011 t)
+ #*11111110)
+(equal (bit-orc2 #*11101010
+ #*01101011
+ (make-array 8 :element-type 'bit))
+ #*11111110)
+(let* ((ba1 (make-array 8 :element-type 'bit :initial-contents #*11101010))
+ (ba2 (make-array 8 :element-type 'bit :initial-contents #*01101011))
+ (ba (bit-orc2 ba1 ba2)))
+ (and (not (eq ba1 ba))
+ (not (eq ba2 ba))
+ (not (eq ba1 ba2))
+ (equal ba #*11111110)))
+(let* ((ba1 (make-array 8 :element-type 'bit :initial-contents #*01010101))
+ (ba (bit-orc2 ba1 #*10101010 t)))
+ (and (eq ba1 ba)
+ (equal ba1 #*01010101)))
+(let* ((ba1 (make-array 8 :element-type 'bit :initial-contents #*01110001))
+ (ba (bit-orc2 ba1 #*00111110 t)))
+ (and (eq ba1 ba)
+ (equal ba1 #*11110001)))
+(let* ((ba1 (make-array 8 :element-type 'bit :initial-contents #*01110001))
+ (ba2 (make-array 8 :element-type 'bit :initial-contents #*00111110))
+ (ba3 (make-array 8 :element-type 'bit))
+ (ba4 (bit-orc2 ba1 ba2 ba3)))
+ (and (eq ba3 ba4)
+ (equal ba3 #*11110001)
+ (not (eq ba1 ba3))
+ (not (eq ba1 ba4))
+ (not (eq ba2 ba3))
+ (not (eq ba2 ba4))))
+(equalp (bit-orc2 (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*010 #*101))
+ (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*101 #*010)))
+ (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*010 #*101)))
+
+(equalp (bit-orc2 (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*010 #*101))
+ (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*101 #*010))
+ nil)
+ (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*010 #*101)))
+
+(equalp (bit-orc2 (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*010 #*101))
+ (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*101 #*010))
+ t)
+ (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*010 #*101)))
+
+(equalp (bit-orc2 (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*010 #*101))
+ (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*101 #*010))
+ (make-array '(2 3)
+ :element-type 'bit))
+ (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*010 #*101)))
+
+(let* ((ba1 (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*010 #*101)))
+ (ba2 (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*101 #*010)))
+ (ba (bit-orc2 ba1 ba2)))
+ (and (not (eq ba1 ba))
+ (not (eq ba2 ba))
+ (not (eq ba1 ba2))
+ (equalp ba (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*010 #*101)))))
+
+(let* ((ba1 (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*010 #*101)))
+ (ba2 (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*101 #*010)))
+ (ba (bit-orc2 ba1 ba2 t)))
+ (and (eq ba1 ba)
+ (equalp ba1 (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*010 #*101)))))
+
+(let* ((ba1 (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*010 #*101)))
+ (ba2 (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*101 #*010)))
+ (ba3 (make-array '(2 3)
+ :element-type 'bit))
+ (ba4 (bit-orc2 ba1 ba2 ba3)))
+ (and (eq ba3 ba4)
+ (equalp ba3 (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*010 #*101)))
+ (not (eq ba1 ba3))
+ (not (eq ba1 ba4))
+ (not (eq ba2 ba3))
+ (not (eq ba2 ba4))))
+
+
+
+
+(equal (bit-xor #*11101010 #*01101011) #*10000001)
+(equal (bit-xor #*11101010 #*01101011 nil) #*10000001)
+(equal (bit-xor (make-array 8 :element-type 'bit :initial-contents #*11101010)
+ #*01101011 t)
+ #*10000001)
+(equal (bit-xor #*11101010
+ #*01101011
+ (make-array 8 :element-type 'bit))
+ #*10000001)
+(let* ((ba1 (make-array 8 :element-type 'bit :initial-contents #*11101010))
+ (ba2 (make-array 8 :element-type 'bit :initial-contents #*01101011))
+ (ba (bit-xor ba1 ba2)))
+ (and (not (eq ba1 ba))
+ (not (eq ba2 ba))
+ (not (eq ba1 ba2))
+ (equal ba #*10000001)))
+(let* ((ba1 (make-array 8 :element-type 'bit :initial-contents #*01010101))
+ (ba (bit-xor ba1 #*10101010 t)))
+ (and (eq ba1 ba)
+ (equal ba1 #*11111111)))
+(let* ((ba1 (make-array 8 :element-type 'bit :initial-contents #*01110001))
+ (ba (bit-xor ba1 #*00111110 t)))
+ (and (eq ba1 ba)
+ (equal ba1 #*01001111)))
+(let* ((ba1 (make-array 8 :element-type 'bit :initial-contents #*01110001))
+ (ba2 (make-array 8 :element-type 'bit :initial-contents #*00111110))
+ (ba3 (make-array 8 :element-type 'bit))
+ (ba4 (bit-xor ba1 ba2 ba3)))
+ (and (eq ba3 ba4)
+ (equal ba3 #*01001111)
+ (not (eq ba1 ba3))
+ (not (eq ba1 ba4))
+ (not (eq ba2 ba3))
+ (not (eq ba2 ba4))))
+(equalp (bit-xor (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*010 #*101))
+ (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*101 #*010)))
+ (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*111 #*111)))
+
+(equalp (bit-xor (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*010 #*101))
+ (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*101 #*010))
+ nil)
+ (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*111 #*111)))
+
+(equalp (bit-xor (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*010 #*101))
+ (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*101 #*010))
+ t)
+ (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*111 #*111)))
+(equalp (bit-xor (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*010 #*101))
+ (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*101 #*010))
+ (make-array '(2 3)
+ :element-type 'bit))
+ (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*111 #*111)))
+(let* ((ba1 (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*010 #*101)))
+ (ba2 (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*101 #*010)))
+ (ba (bit-xor ba1 ba2)))
+ (and (not (eq ba1 ba))
+ (not (eq ba2 ba))
+ (not (eq ba1 ba2))
+ (equalp ba (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*111 #*111)))))
+
+(let* ((ba1 (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*010 #*101)))
+ (ba2 (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*101 #*010)))
+ (ba (bit-xor ba1 ba2 t)))
+ (and (eq ba1 ba)
+ (equalp ba1 (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*111 #*111)))))
+(let* ((ba1 (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*010 #*101)))
+ (ba2 (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*101 #*010)))
+ (ba3 (make-array '(2 3)
+ :element-type 'bit))
+ (ba4 (bit-xor ba1 ba2 ba3)))
+ (and (eq ba3 ba4)
+ (equalp ba3 (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*111 #*111)))
+ (not (eq ba1 ba3))
+ (not (eq ba1 ba4))
+ (not (eq ba2 ba3))
+ (not (eq ba2 ba4))))
+
+
+
+(equal (bit-not #*11101010) #*00010101)
+(equal (bit-not #*11101010 nil) #*00010101)
+(equal (bit-not (make-array 8 :element-type 'bit :initial-contents #*11101010)
+ t)
+ #*00010101)
+(equal (bit-not #*11101010 (make-array 8 :element-type 'bit))
+ #*00010101)
+(let* ((ba1 (make-array 8 :element-type 'bit :initial-contents #*11101010))
+ (ba (bit-not ba1)))
+ (and (not (eq ba1 ba))
+ (equal ba #*00010101)))
+(let* ((ba1 (make-array 8 :element-type 'bit :initial-contents #*01010101))
+ (ba (bit-not ba1 t)))
+ (and (eq ba1 ba)
+ (equal ba1 #*10101010)))
+(let* ((ba1 (make-array 8 :element-type 'bit :initial-contents #*01110001))
+ (ba (bit-not ba1 t)))
+ (and (eq ba1 ba)
+ (equal ba1 #*10001110)))
+(let* ((ba1 (make-array 8 :element-type 'bit :initial-contents #*01110001))
+ (ba2 (make-array 8 :element-type 'bit))
+ (ba3 (bit-not ba1 ba2)))
+ (and (eq ba2 ba3)
+ (equal ba2 #*10001110)
+ (not (eq ba1 ba2))
+ (not (eq ba1 ba3))))
+
+(equalp (bit-not (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*010 #*101)))
+ (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*101 #*010)))
+
+(equalp (bit-not (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*010 #*101))
+ nil)
+ (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*101 #*010)))
+
+(equalp (bit-not (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*010 #*101))
+ t)
+ (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*101 #*010)))
+(equalp (bit-not (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*010 #*101))
+ (make-array '(2 3)
+ :element-type 'bit))
+ (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*101 #*010)))
+(let* ((ba1 (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*010 #*101)))
+ (ba (bit-not ba1)))
+ (and (not (eq ba1 ba))
+ (equalp ba (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*101 #*010)))))
+
+
+
+(let* ((ba1 (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*010 #*101)))
+ (ba (bit-not ba1 t)))
+ (and (eq ba1 ba)
+ (equalp ba1 (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*101 #*010)))))
+(let* ((ba1 (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*010 #*101)))
+ (ba3 (make-array '(2 3)
+ :element-type 'bit))
+ (ba4 (bit-not ba1 ba3)))
+ (and (eq ba3 ba4)
+ (equalp ba3 (make-array '(2 3)
+ :element-type 'bit
+ :initial-contents '(#*101 #*010)))
+ (not (eq ba1 ba3))
+ (not (eq ba1 ba4))))
+
+
+
+(bit-vector-p (make-array 6 :element-type 'bit :fill-pointer t))
+(bit-vector-p #*)
+(not (bit-vector-p (make-array 6)))
+
+(not (simple-bit-vector-p (make-array 6)))
+(simple-bit-vector-p #*)
+(simple-bit-vector-p #*0101)
+(simple-bit-vector-p #*0)
+(simple-bit-vector-p #*1)
+(simple-bit-vector-p (make-array 6 :element-type 'bit))
+
+(equal (concatenate 'list
+ (adjust-array (make-array 5 :initial-contents '(0 1 2 3 4))
+ 10
+ :initial-element -1))
+ '(0 1 2 3 4 -1 -1 -1 -1 -1))
+
+
+(let* ((array0 (make-array '(3 2)
+ :initial-contents
+ '((e0-0 e0-1) (e1-0 e1-1) (e2-0 e2-1))))
+ (array (adjust-array array0
+ '(4 3)
+ :initial-element 0)))
+ (and (eq (aref array 0 0) 'e0-0)
+ (eq (aref array 0 1) 'e0-1)
+ (eql (aref array 0 2) '0)
+ (eq (aref array 1 0) 'e1-0)
+ (eq (aref array 1 1) 'e1-1)
+ (eql (aref array 1 2) 0)
+ (eq (aref array 2 0) 'e2-0)
+ (eq (aref array 2 1) 'e2-1)
+ (eql (aref array 2 2) 0)))
+
+
+(let* ((array0 (make-array '(3 2)
+ :initial-contents
+ '((e0-0 e0-1) (e1-0 e1-1) (e2-0 e2-1))))
+ (array (adjust-array array0
+ '(1 1)
+ :initial-element 0)))
+ (eq (aref array 0 0) 'e0-0))
+
+
+(let* ((array0 (make-array '(3 2) :initial-element 0))
+ (array1 (make-array 6 :initial-element 1))
+ (array (adjust-array array1 3 :displaced-to array0)))
+ (and (equal (array-dimensions array) '(3))
+ (every #'zerop array)))
+
+
+
+(let* ((array0 (make-array '(3 2) :initial-contents '((0 1) (2 3) (4 5))))
+ (array1 (make-array 6 :initial-element 1))
+ (array (adjust-array array1 3
+ :displaced-to array0
+ :displaced-index-offset 3)))
+ (and (equal (array-dimensions array) '(3))
+ (eql (aref array 0) 3)
+ (eql (aref array 1) 4)
+ (eql (aref array 2) 5)))
+
+
+(let* ((array0 (make-array '(3 2) :initial-contents '((0 1) (2 3) (4 5))))
+ (array1 (make-array 6 :displaced-to array0))
+ (array (adjust-array array1 9 :initial-element '-1)))
+ (and (equal (array-dimensions array) '(9))
+ (multiple-value-bind (displaced-to displaced-index-offset)
+ (array-displacement array)
+ (and (null displaced-to) (zerop displaced-index-offset)))
+ (eql (aref array 0) 0)
+ (eql (aref array 1) 1)
+ (eql (aref array 2) 2)
+ (eql (aref array 3) 3)
+ (eql (aref array 4) 4)
+ (eql (aref array 5) 5)
+ (eql (aref array 6) -1)
+ (eql (aref array 7) -1)
+ (eql (aref array 8) -1)))
+
+
+(let* ((array0 (make-array '(4 4)
+ :adjustable t
+ :initial-contents
+ '(( alpha beta gamma delta )
+ ( epsilon zeta eta theta )
+ ( iota kappa lambda mu )
+ ( nu xi omicron pi ))))
+ (array (adjust-array array0 '(3 5) :initial-element 'baz)))
+ (equalp array
+ #2A(( alpha beta gamma delta baz )
+ ( epsilon zeta eta theta baz )
+ ( iota kappa lambda mu baz ))))
+
+
+(let* ((array0 (make-array 3 :initial-element 0))
+ (array1 (make-array 3 :adjustable t :displaced-to array0))
+ (array2 (make-array 3 :displaced-to array1)))
+ (and (adjustable-array-p array1)
+ (eq array1 (adjust-array array1 6 :initial-contents '(a b c d e f)))
+ (multiple-value-bind (displaced-to displaced-index-offset)
+ (array-displacement array1)
+ (and (null displaced-to) (zerop displaced-index-offset)))
+ (eq (aref array1 0) 'a)
+ (eq (aref array1 1) 'b)
+ (eq (aref array1 2) 'c)
+ (eq (aref array1 3) 'd)
+ (eq (aref array1 4) 'e)
+ (eq (aref array1 5) 'f)
+ (eq (aref array2 0) 'a)
+ (eq (aref array2 1) 'b)
+ (eq (aref array2 2) 'c)))
+
+(let* ((str0 (make-array 10
+ :element-type 'character
+ :initial-contents "abcdefghij"))
+ (str1 (make-array 7
+ :adjustable t
+ :element-type 'character
+ :displaced-to str0
+ :displaced-index-offset 3))
+ (str2 (make-array 3
+ :element-type 'character
+ :displaced-to str1
+ :displaced-index-offset 4)))
+ (and (string= str0 "abcdefghij")
+ (string= str1 "defghij")
+ (string= str2 "hij")
+ (adjustable-array-p str1)
+ (eq str1 (adjust-array str1 10 :initial-contents "QRSTUVWXYZ"))
+ (string= str2 "UVW")))
+
+
+(let* ((bv (make-array 10
+ :element-type 'bit
+ :initial-contents #*1010101010
+ :fill-pointer t)))
+ (and (dotimes (i 10 t)
+ (unless (eql (vector-pop bv) (if (evenp i) 0 1))
+ (return nil)))
+ (zerop (length bv))))
+
+(let* ((bv (make-array 10
+ :adjustable t
+ :element-type 'bit
+ :fill-pointer 0)))
+ (dotimes (i 100)
+ (vector-push-extend (if (oddp i) 0 1) bv))
+ (dotimes (i 100 t)
+ (unless (eql (vector-pop bv) (if (oddp i) 1 0))
+ (return nil))))
+
+
+
+(let* ((str (make-array 10
+ :element-type 'character
+ :initial-contents "abcdefghjk"
+ :fill-pointer t)))
+ (and (dotimes (i 10 t)
+ (unless (char= (vector-pop str) (aref "kjhgfedcba" i))
+ (return nil)))
+ (zerop (length str))))
+
+(let* ((str (make-array 10
+ :adjustable t
+ :element-type 'character
+ :fill-pointer 0)))
+ (dotimes (i 100)
+ (vector-push-extend (if (oddp i) #\a #\z) str))
+ (dotimes (i 100 t)
+ (unless (char= (vector-pop str) (if (oddp i) #\z #\a))
+ (return nil))))
+
+
diff --git a/Sacla/tests/must-character.lisp b/Sacla/tests/must-character.lisp
new file mode 100644
index 0000000..3cd9aa6
--- /dev/null
+++ b/Sacla/tests/must-character.lisp
@@ -0,0 +1,537 @@
+;; Copyright (C) 2002-2004, Yuji Minejima <ggb01164@nifty.ne.jp>
+;; ALL RIGHTS RESERVED.
+;;
+;; $Id: must-character.lisp,v 1.6 2004/02/20 07:23:42 yuji Exp $
+;;
+;; Redistribution and use in source and binary forms, with or without
+;; modification, are permitted provided that the following conditions
+;; are met:
+;;
+;; * Redistributions of source code must retain the above copyright
+;; notice, this list of conditions and the following disclaimer.
+;; * 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.
+;;
+;; 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
+;; OWNER 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.
+
+(char= #\d #\d)
+(not (char= #\A #\a))
+(not (char= #\d #\x))
+(not (char= #\d #\D))
+(not (char/= #\d #\d))
+(char/= #\d #\x)
+(char/= #\d #\D)
+(char= #\d #\d #\d #\d)
+(not (char/= #\d #\d #\d #\d))
+(not (char= #\d #\d #\x #\d))
+(not (char/= #\d #\d #\x #\d))
+(not (char= #\d #\y #\x #\c))
+(char/= #\d #\y #\x #\c)
+(not (char= #\d #\c #\d))
+(not (char/= #\d #\c #\d))
+(char< #\d #\x)
+(char<= #\d #\x)
+(not (char< #\d #\d))
+(char<= #\d #\d)
+(char< #\a #\e #\y #\z)
+(char<= #\a #\e #\y #\z)
+(not (char< #\a #\e #\e #\y))
+(char<= #\a #\e #\e #\y)
+(char> #\e #\d)
+(char>= #\e #\d)
+(char> #\d #\c #\b #\a)
+(char>= #\d #\c #\b #\a)
+(not (char> #\d #\d #\c #\a))
+(char>= #\d #\d #\c #\a)
+(not (char> #\e #\d #\b #\c #\a))
+(not (char>= #\e #\d #\b #\c #\a))
+(char-equal #\A #\a)
+(equal (stable-sort (list #\b #\A #\B #\a #\c #\C) #'char-lessp)
+ '(#\A #\a #\b #\B #\c #\C))
+
+(char= #\a)
+(char= #\a #\a)
+(char= #\a #\a #\a)
+(char= #\a #\a #\a #\a)
+(char= #\a #\a #\a #\a #\a)
+(char= #\a #\a #\a #\a #\a #\a)
+(let ((c #\z))
+ (and (eq c c)
+ (char= c c)))
+(not (char= #\Z #\z))
+(not (char= #\z #\z #\z #\a))
+(not (char= #\a #\z #\z #\z #\a))
+(not (char= #\z #\i #\z #\z))
+(not (char= #\z #\z #\Z #\z))
+
+(char/= #\a)
+(char/= #\a #\b)
+(char/= #\a #\b #\c)
+(char/= #\a #\b #\c #\d)
+(char/= #\a #\b #\c #\d #\e)
+(char/= #\a #\b #\c #\d #\e #\f)
+(let ((c #\z))
+ (and (eq c c)
+ (not (char/= c c))))
+(char/= #\Z #\z)
+(not (char/= #\z #\z #\z #\a))
+(not (char= #\a #\z #\z #\z #\a))
+(not (char= #\z #\i #\z #\z))
+(not (char= #\z #\z #\Z #\z))
+(not (char/= #\a #\a #\b #\c))
+(not (char/= #\a #\b #\a #\c))
+(not (char/= #\a #\b #\c #\a))
+
+(char< #\a)
+(char< #\a #\z)
+(char< #\a #\b #\c #\d #\e #\f #\g #\h #\i #\j #\k #\l #\m
+ #\n #\o #\p #\q #\r #\s #\t #\u #\v #\w #\x #\y #\z)
+(not (char< #\z #\y #\x #\w #\v #\u #\t #\s #\r #\q #\p #\o #\n
+ #\m #\l #\k #\j #\i #\h #\g #\f #\e #\d #\c #\b #\a))
+(char< #\A #\B #\C #\D #\E #\F #\G #\H #\I #\J #\K #\L #\M
+ #\N #\O #\P #\Q #\R #\S #\T #\U #\V #\W #\X #\Y #\Z)
+(not (char< #\Z #\Y #\X #\W #\V #\U #\T #\S #\R #\Q #\P #\O #\N
+ #\M #\L #\K #\J #\I #\H #\G #\F #\E #\D #\C #\B #\A))
+(char< #\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9)
+(not (char< #\9 #\8 #\7 #\6 #\5 #\4 #\3 #\2 #\1 #\0))
+(or (char< #\9 #\A)
+ (char< #\Z #\0))
+(or (char< #\9 #\a)
+ (char< #\z #\0))
+(not (char< #\a #\a #\b #\c))
+(not (char< #\a #\b #\a #\c))
+(not (char< #\a #\b #\c #\a))
+(not (char< #\9 #\0))
+
+(char> #\a)
+(not (char> #\a #\z))
+(char> #\z #\a)
+(not (char> #\a #\b #\c #\d #\e #\f #\g #\h #\i #\j #\k #\l #\m
+ #\n #\o #\p #\q #\r #\s #\t #\u #\v #\w #\x #\y #\z))
+(char> #\z #\y #\x #\w #\v #\u #\t #\s #\r #\q #\p #\o #\n
+ #\m #\l #\k #\j #\i #\h #\g #\f #\e #\d #\c #\b #\a)
+(not (char> #\A #\B #\C #\D #\E #\F #\G #\H #\I #\J #\K #\L #\M
+ #\N #\O #\P #\Q #\R #\S #\T #\U #\V #\W #\X #\Y #\Z))
+(char> #\Z #\Y #\X #\W #\V #\U #\T #\S #\R #\Q #\P #\O #\N
+ #\M #\L #\K #\J #\I #\H #\G #\F #\E #\D #\C #\B #\A)
+(not (char> #\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9))
+(char> #\9 #\8 #\7 #\6 #\5 #\4 #\3 #\2 #\1 #\0)
+(or (char> #\A #\9)
+ (char> #\0 #\Z))
+(or (char> #\a #\9)
+ (char> #\0 #\z))
+(not (char> #\a #\a #\b #\c))
+(not (char> #\a #\b #\a #\c))
+(not (char> #\a #\b #\c #\a))
+(char> #\9 #\0)
+
+(char<= #\a)
+(char<= #\a #\z)
+(char<= #\a #\a)
+(char<= #\Z #\Z)
+(char<= #\a #\b #\c #\d #\e #\f #\g #\h #\i #\j #\k #\l #\m
+ #\n #\o #\p #\q #\r #\s #\t #\u #\v #\w #\x #\y #\z)
+(char<= #\a #\a #\b #\b #\c #\c #\d #\d #\e #\e #\f #\f #\g #\g
+ #\h #\h #\i #\i #\j #\j #\k #\k #\l #\l #\m #\m
+ #\n #\n #\o #\o #\p #\p #\q #\q #\r #\r #\s #\s
+ #\t #\t #\u #\u #\v #\v #\w #\w #\x #\x #\y #\y #\z #\z)
+(not (char<= #\z #\y #\x #\w #\v #\u #\t #\s #\r #\q #\p #\o #\n
+ #\m #\l #\k #\j #\i #\h #\g #\f #\e #\d #\c #\b #\a))
+(char<= #\A #\B #\C #\D #\E #\F #\G #\H #\I #\J #\K #\L #\M
+ #\N #\O #\P #\Q #\R #\S #\T #\U #\V #\W #\X #\Y #\Z)
+(char<= #\A #\B #\B #\C #\D #\E #\E #\F #\G #\H #\I #\I #\J #\K #\L #\M
+ #\N #\N #\O #\P #\Q #\R #\S #\T #\T #\U #\V #\W #\X #\Y #\Z)
+(not (char<= #\Z #\Y #\X #\W #\V #\U #\T #\S #\R #\Q #\P #\O #\N
+ #\M #\L #\K #\J #\I #\H #\G #\F #\E #\D #\C #\B #\A))
+(char<= #\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9)
+(char<= #\0 #\1 #\2 #\2 #\3 #\3 #\3 #\3 #\4 #\5 #\6 #\7 #\8 #\9 #\9)
+(not (char<= #\9 #\8 #\7 #\6 #\5 #\4 #\3 #\2 #\1 #\0))
+(or (char<= #\9 #\A)
+ (char<= #\Z #\0))
+(or (char<= #\9 #\a)
+ (char<= #\z #\0))
+(char<= #\a #\a #\b #\c)
+(not (char<= #\a #\b #\a #\c))
+(not (char<= #\a #\b #\c #\a))
+(not (char<= #\9 #\0))
+
+(char>= #\a)
+(not (char>= #\a #\z))
+(char>= #\z #\a)
+(char>= #\a #\a)
+(char>= #\Z #\Z)
+(not (char>= #\a #\b #\c #\d #\e #\f #\g #\h #\i #\j #\k #\l #\m
+ #\n #\o #\p #\q #\r #\s #\t #\u #\v #\w #\x #\y #\z))
+(char>= #\z #\y #\x #\w #\v #\u #\t #\s #\r #\q #\p #\o #\n
+ #\m #\l #\k #\j #\i #\h #\g #\f #\e #\d #\c #\b #\a)
+(char>= #\z #\z #\y #\x #\w #\v #\u #\t #\s #\r #\q #\p #\o #\n #\n
+ #\m #\m #\l #\k #\j #\i #\h #\g #\f #\e #\d #\c #\b #\a #\a)
+(not (char>= #\A #\B #\C #\D #\E #\F #\G #\H #\I #\J #\K #\L #\M
+ #\N #\O #\P #\Q #\R #\S #\T #\U #\V #\W #\X #\Y #\Z))
+(char>= #\Z #\Y #\X #\W #\V #\U #\T #\S #\R #\Q #\P #\O #\N
+ #\M #\L #\K #\J #\I #\H #\G #\F #\E #\D #\C #\B #\A)
+(char>= #\Z #\Y #\X #\W #\V #\U #\U #\T #\T #\S #\S #\R #\Q #\P #\O #\N
+ #\M #\L #\K #\J #\I #\H #\H #\G #\G #\F #\F #\E #\D #\C #\B #\A)
+(not (char>= #\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9))
+(char>= #\9 #\8 #\7 #\6 #\5 #\4 #\3 #\2 #\1 #\0)
+(char>= #\9 #\8 #\8 #\8 #\7 #\6 #\5 #\4 #\3 #\3 #\3 #\2 #\1 #\0)
+(or (char>= #\A #\9)
+ (char>= #\0 #\Z))
+(or (char>= #\a #\9)
+ (char>= #\0 #\z))
+(char>= #\c #\b #\a #\a)
+(not (char>= #\c #\b #\a #\a #\b #\c))
+(not (char>= #\c #\b #\a #\c))
+(not (char>= #\c #\b #\c #\a))
+(char>= #\9 #\0)
+(not (char>= #\0 #\9))
+
+
+(char-equal #\a)
+(char-equal #\a #\a)
+(char-equal #\a #\a #\a)
+(char-equal #\a #\a #\a #\a)
+(char-equal #\a #\a #\a #\a #\a)
+(char-equal #\a #\a #\a #\a #\a #\a)
+(char-equal #\a #\A)
+(char-equal #\a #\A #\a)
+(char-equal #\a #\a #\A #\a)
+(char-equal #\a #\a #\a #\A #\a)
+(char-equal #\a #\a #\a #\a #\A #\a)
+(let ((c #\z))
+ (and (eq c c)
+ (char-equal c c)))
+(char-equal #\Z #\z)
+(not (char-equal #\z #\z #\z #\a))
+(not (char-equal #\a #\z #\z #\z #\a))
+(not (char-equal #\z #\i #\z #\z))
+(char-equal #\z #\z #\Z #\z)
+(char-equal #\a #\A #\a #\A #\a #\A #\a #\A #\a #\A)
+
+
+(char-not-equal #\a)
+(char-not-equal #\a #\b)
+(char-not-equal #\a #\b #\c)
+(char-not-equal #\a #\b #\c #\d)
+(char-not-equal #\a #\b #\c #\d #\e)
+(char-not-equal #\a #\b #\c #\d #\e #\f)
+(let ((c #\z))
+ (and (eq c c)
+ (not (char-not-equal c c))))
+(not (char-not-equal #\Z #\z))
+(not (char-not-equal #\z #\z #\z #\a))
+(not (char= #\a #\z #\z #\z #\a))
+(not (char= #\z #\i #\z #\z))
+(not (char= #\z #\z #\Z #\z))
+(not (char-not-equal #\a #\a #\b #\c))
+(not (char-not-equal #\a #\b #\a #\c))
+(not (char-not-equal #\a #\b #\c #\a))
+(not (char-not-equal #\a #\A #\a #\A))
+
+
+(char-lessp #\a)
+(char-lessp #\a #\z)
+(char-lessp #\a #\b #\c #\d #\e #\f #\g #\h #\i #\j #\k #\l #\m
+ #\n #\o #\p #\q #\r #\s #\t #\u #\v #\w #\x #\y #\z)
+(not (char-lessp #\z #\y #\x #\w #\v #\u #\t #\s #\r #\q #\p #\o #\n
+ #\m #\l #\k #\j #\i #\h #\g #\f #\e #\d #\c #\b #\a))
+(char-lessp #\A #\B #\C #\D #\E #\F #\G #\H #\I #\J #\K #\L #\M
+ #\N #\O #\P #\Q #\R #\S #\T #\U #\V #\W #\X #\Y #\Z)
+(not (char-lessp #\Z #\Y #\X #\W #\V #\U #\T #\S #\R #\Q #\P #\O #\N
+ #\M #\L #\K #\J #\I #\H #\G #\F #\E #\D #\C #\B #\A))
+(char-lessp #\a #\B #\c #\D #\e #\F #\g #\H #\i #\J #\k #\L #\m
+ #\N #\o #\P #\q #\R #\s #\T #\u #\V #\w #\X #\y #\Z)
+(char-lessp #\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9)
+(not (char-lessp #\9 #\8 #\7 #\6 #\5 #\4 #\3 #\2 #\1 #\0))
+(or (char-lessp #\9 #\A)
+ (char-lessp #\Z #\0))
+(or (char-lessp #\9 #\a)
+ (char-lessp #\z #\0))
+(not (char-lessp #\a #\a #\b #\c))
+(not (char-lessp #\a #\b #\a #\c))
+(not (char-lessp #\a #\b #\c #\a))
+(not (char-lessp #\9 #\0))
+(and (char-lessp #\a #\Z)
+ (char-lessp #\A #\z))
+
+
+(char-greaterp #\a)
+(not (char-greaterp #\a #\z))
+(char-greaterp #\z #\a)
+(not (char-greaterp #\a #\b #\c #\d #\e #\f #\g #\h #\i #\j #\k #\l #\m
+ #\n #\o #\p #\q #\r #\s #\t #\u #\v #\w #\x #\y #\z))
+(char-greaterp #\z #\y #\x #\w #\v #\u #\t #\s #\r #\q #\p #\o #\n
+ #\m #\l #\k #\j #\i #\h #\g #\f #\e #\d #\c #\b #\a)
+(not (char-greaterp #\A #\B #\C #\D #\E #\F #\G #\H #\I #\J #\K #\L #\M
+ #\N #\O #\P #\Q #\R #\S #\T #\U #\V #\W #\X #\Y #\Z))
+(char-greaterp #\Z #\Y #\X #\W #\V #\U #\T #\S #\R #\Q #\P #\O #\N
+ #\M #\L #\K #\J #\I #\H #\G #\F #\E #\D #\C #\B #\A)
+(char-greaterp #\z #\Y #\x #\W #\v #\U #\t #\S #\r #\Q #\p #\O #\n
+ #\M #\l #\K #\j #\I #\h #\G #\f #\E #\d #\C #\b #\A)
+(not (char-greaterp #\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9))
+(char-greaterp #\9 #\8 #\7 #\6 #\5 #\4 #\3 #\2 #\1 #\0)
+(or (char-greaterp #\A #\9)
+ (char-greaterp #\0 #\Z))
+(or (char-greaterp #\a #\9)
+ (char-greaterp #\0 #\z))
+(not (char-greaterp #\a #\a #\b #\c))
+(not (char-greaterp #\a #\b #\a #\c))
+(not (char-greaterp #\a #\b #\c #\a))
+(char-greaterp #\9 #\0)
+(and (char-greaterp #\z #\A)
+ (char-greaterp #\Z #\a))
+
+
+
+(char-not-greaterp #\a)
+(char-not-greaterp #\a #\z)
+(char-not-greaterp #\a #\a)
+(char-not-greaterp #\Z #\Z)
+(char-not-greaterp
+ #\a #\b #\c #\d #\e #\f #\g #\h #\i #\j #\k #\l #\m
+ #\n #\o #\p #\q #\r #\s #\t #\u #\v #\w #\x #\y #\z)
+(char-not-greaterp
+ #\a #\a #\b #\b #\c #\c #\d #\d #\e #\e #\f #\f #\g #\g
+ #\h #\h #\i #\i #\j #\j #\k #\k #\l #\l #\m #\m
+ #\n #\n #\o #\o #\p #\p #\q #\q #\r #\r #\s #\s
+ #\t #\t #\u #\u #\v #\v #\w #\w #\x #\x #\y #\y #\z #\z)
+(char-not-greaterp
+ #\a #\A #\b #\B #\c #\C #\d #\D #\e #\E #\f #\F #\g #\G
+ #\h #\H #\i #\I #\j #\J #\k #\K #\l #\L #\m #\M
+ #\n #\N #\o #\O #\p #\P #\q #\Q #\r #\R #\s #\S
+ #\t #\T #\u #\U #\v #\V #\w #\W #\x #\X #\y #\Y #\z #\z)
+(not (char-not-greaterp
+ #\z #\y #\x #\w #\v #\u #\t #\s #\r #\q #\p #\o #\n
+ #\m #\l #\k #\j #\i #\h #\g #\f #\e #\d #\c #\b #\a))
+(char-not-greaterp
+ #\A #\B #\C #\D #\E #\F #\G #\H #\I #\J #\K #\L #\M
+ #\N #\O #\P #\Q #\R #\S #\T #\U #\V #\W #\X #\Y #\Z)
+(char-not-greaterp
+ #\A #\B #\B #\C #\D #\E #\E #\F #\G #\H #\I #\I #\J #\K #\L #\M
+ #\N #\N #\O #\P #\Q #\R #\S #\T #\T #\U #\V #\W #\X #\Y #\Z)
+(not (char-not-greaterp
+ #\Z #\Y #\X #\W #\V #\U #\T #\S #\R #\Q #\P #\O #\N
+ #\M #\L #\K #\J #\I #\H #\G #\F #\E #\D #\C #\B #\A))
+(char-not-greaterp #\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9)
+(char-not-greaterp #\0 #\1 #\2 #\2 #\3 #\3 #\3 #\3 #\4 #\5 #\6 #\7 #\8 #\9 #\9)
+(not (char-not-greaterp #\9 #\8 #\7 #\6 #\5 #\4 #\3 #\2 #\1 #\0))
+(or (char-not-greaterp #\9 #\A)
+ (char-not-greaterp #\Z #\0))
+(or (char-not-greaterp #\9 #\a)
+ (char-not-greaterp #\z #\0))
+(char-not-greaterp #\a #\a #\b #\c)
+(not (char-not-greaterp #\a #\b #\a #\c))
+(not (char-not-greaterp #\a #\b #\c #\a))
+(not (char-not-greaterp #\9 #\0))
+(and (char-not-greaterp #\A #\z)
+ (char-not-greaterp #\a #\Z))
+
+
+(char-not-lessp #\a)
+(not (char-not-lessp #\a #\z))
+(char-not-lessp #\z #\a)
+(char-not-lessp #\a #\a)
+(char-not-lessp #\Z #\Z)
+(not (char-not-lessp #\a #\b #\c #\d #\e #\f #\g #\h #\i #\j #\k #\l #\m
+ #\n #\o #\p #\q #\r #\s #\t #\u #\v #\w #\x #\y #\z))
+(char-not-lessp #\z #\y #\x #\w #\v #\u #\t #\s #\r #\q #\p #\o #\n
+ #\m #\l #\k #\j #\i #\h #\g #\f #\e #\d #\c #\b #\a)
+(char-not-lessp #\z #\z #\y #\x #\w #\v #\u #\t #\s #\r #\q #\p #\o #\n #\n
+ #\m #\m #\l #\k #\j #\i #\h #\g #\f #\e #\d #\c #\b #\a #\a)
+(not (char-not-lessp #\A #\B #\C #\D #\E #\F #\G #\H #\I #\J #\K #\L #\M
+ #\N #\O #\P #\Q #\R #\S #\T #\U #\V #\W #\X #\Y #\Z))
+(char-not-lessp #\Z #\Y #\X #\W #\V #\U #\T #\S #\R #\Q #\P #\O #\N
+ #\M #\L #\K #\J #\I #\H #\G #\F #\E #\D #\C #\B #\A)
+(char-not-lessp #\Z #\Y #\X #\W #\V #\U #\U #\T #\T #\S #\S #\R #\Q #\P #\O #\N
+ #\M #\L #\K #\J #\I #\H #\H #\G #\G #\F #\F #\E #\D #\C #\B #\A)
+(char-not-lessp #\z #\Z #\y #\x #\w #\V #\v #\u #\t #\s #\r #\q #\p #\o #\n #\n
+ #\m #\M #\l #\k #\K #\j #\i #\h #\g #\f #\e #\d #\c #\b #\A #\a)
+(not (char-not-lessp #\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9))
+(char-not-lessp #\9 #\8 #\7 #\6 #\5 #\4 #\3 #\2 #\1 #\0)
+(char-not-lessp #\9 #\8 #\8 #\8 #\7 #\6 #\5 #\4 #\3 #\3 #\3 #\2 #\1 #\0)
+(or (char-not-lessp #\A #\9)
+ (char-not-lessp #\0 #\Z))
+(or (char-not-lessp #\a #\9)
+ (char-not-lessp #\0 #\z))
+(char-not-lessp #\c #\b #\a #\a)
+(not (char-not-lessp #\c #\b #\a #\a #\b #\c))
+(not (char-not-lessp #\c #\b #\a #\c))
+(not (char-not-lessp #\c #\b #\c #\a))
+(char-not-lessp #\9 #\0)
+(not (char-not-lessp #\0 #\9))
+(and (char-not-lessp #\z #\A)
+ (char-not-lessp #\Z #\a))
+
+(char= (character #\a) #\a)
+(char= (character #\b) #\b)
+(char= (character #\Space) #\Space)
+(char= (character "a") #\a)
+(char= (character "X") #\X)
+(char= (character "z") #\z)
+(char= (character 'a) #\A)
+(char= (character '\a) #\a)
+
+(alpha-char-p #\a)
+(every #'alpha-char-p '(#\a #\b #\c #\d #\e #\f #\g #\h #\i #\j #\k #\l #\m
+ #\n #\o #\p #\q #\r #\s #\t #\u #\v #\w #\x #\y #\z))
+(every #'alpha-char-p '(#\A #\B #\C #\D #\E #\F #\G #\H #\I #\J #\K #\L #\M
+ #\N #\O #\P #\Q #\R #\S #\T #\U #\V #\W #\X #\Y #\Z))
+(notany #'alpha-char-p '(#\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9))
+(not (alpha-char-p #\Newline))
+
+(alphanumericp #\Z)
+(alphanumericp #\9)
+(every #'alphanumericp '(#\a #\b #\c #\d #\e #\f #\g #\h #\i #\j #\k #\l #\m
+ #\n #\o #\p #\q #\r #\s #\t #\u #\v #\w #\x #\y #\z))
+(every #'alphanumericp '(#\A #\B #\C #\D #\E #\F #\G #\H #\I #\J #\K #\L #\M
+ #\N #\O #\P #\Q #\R #\S #\T #\U #\V #\W #\X #\Y #\Z))
+(every #'alphanumericp '(#\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9))
+(not (alphanumericp #\Newline))
+(not (alphanumericp #\#))
+
+(char= (digit-char 0) #\0)
+(char= (digit-char 10 11) #\A)
+(null (digit-char 10 10))
+(char= (digit-char 7) #\7)
+(null (digit-char 12))
+(char= (digit-char 12 16) #\C)
+(null (digit-char 6 2))
+(char= (digit-char 1 2) #\1)
+(char= (digit-char 35 36) #\Z)
+
+(do ((radix 2 (1+ radix)))
+ ((= radix 37) t)
+ (unless (dotimes (i radix t)
+ (unless (char= (digit-char i radix)
+ (svref #(#\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9
+ #\A #\B #\C #\D #\E #\F #\G #\H #\I #\J
+ #\K #\L #\M #\N #\O #\P #\Q #\R #\S #\T
+ #\U #\V #\W #\X #\Y #\Z) i))
+ (return nil)))
+ (return nil)))
+
+
+(= (digit-char-p #\0) 0)
+(= (digit-char-p #\5) 5)
+(not (digit-char-p #\5 2))
+(not (digit-char-p #\A))
+(not (digit-char-p #\a))
+(= (digit-char-p #\A 11) 10)
+(= (digit-char-p #\a 11) 10)
+(equal (mapcar #'(lambda (radix)
+ (map 'list #'(lambda (x) (digit-char-p x radix))
+ "059AaFGZ"))
+ '(2 8 10 16 36))
+ '((0 NIL NIL NIL NIL NIL NIL NIL)
+ (0 5 NIL NIL NIL NIL NIL NIL)
+ (0 5 9 NIL NIL NIL NIL NIL)
+ (0 5 9 10 10 15 NIL NIL)
+ (0 5 9 10 10 15 16 35)))
+
+(do ((radix 2 (1+ radix)))
+ ((= radix 37) t)
+ (unless (dotimes (i radix t)
+ (unless (= (digit-char-p (schar
+ "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" i)
+ radix)
+ i)
+ (return nil)))
+ (return nil)))
+
+(do ((radix 2 (1+ radix)))
+ ((= radix 37) t)
+ (unless (dotimes (i radix t)
+ (unless (= (digit-char-p (schar
+ "0123456789abcdefghijklmnopqrstuvwxyz" i)
+ radix)
+ i)
+ (return nil)))
+ (return nil)))
+
+
+(graphic-char-p #\G)
+(graphic-char-p #\#)
+(graphic-char-p #\Space)
+(not (graphic-char-p #\Newline))
+
+(standard-char-p #\a)
+(standard-char-p #\z)
+(standard-char-p #\Newline)
+(every #'standard-char-p " !\"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^_'abcdefghijklmnopqrstuvwxyz{|}~
+")
+
+
+(char= (char-upcase #\a) #\A)
+(char= (char-upcase #\A) #\A)
+(char= (char-upcase #\-) #\-)
+(char= (char-downcase #\A) #\a)
+(char= (char-downcase #\a) #\a)
+(char= (char-downcase #\-) #\-)
+(not (upper-case-p #\a))
+(upper-case-p #\A)
+(not (upper-case-p #\-))
+(not (lower-case-p #\A))
+(lower-case-p #\a)
+(not (lower-case-p #\-))
+(both-case-p #\a)
+(both-case-p #\A)
+(not (both-case-p #\-))
+
+(let ((chars " !\"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^_'abcdefghijklmnopqrstuvwxyz{|}~
+")
+ c)
+ (dotimes (i (length chars) t)
+ (setq c (schar chars i))
+ (cond
+ ((upper-case-p c)
+ (unless (and (both-case-p c)
+ (not (lower-case-p c))
+ (char= (char-upcase c) c)
+ (not (char= (char-downcase c) c)))
+ (return nil)))
+ ((lower-case-p c)
+ (unless (and (both-case-p c)
+ (char= (char-downcase c) c)
+ (not (char= (char-upcase c) c)))
+ (return nil)))
+ (t
+ (unless (and (not (upper-case-p c))
+ (not (lower-case-p c))
+ (not (both-case-p c))
+ (char= (char-upcase c) c)
+ (char= (char-downcase c) c))
+ (return nil))))))
+
+(every (complement #'minusp)
+ (map 'list #'char-code " !\"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^_'abcdefghijklmnopqrstuvwxyz{|}~
+"))
+
+(every (complement #'minusp)
+ (map 'list #'char-int " !\"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^_'abcdefghijklmnopqrstuvwxyz{|}~
+"))
+
+
+(every #'characterp
+ (map 'list #'code-char
+ (map 'list #'char-code " !\"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^_'abcdefghijklmnopqrstuvwxyz{|}~
+")))
+
+(dotimes (i char-code-limit t)
+ (unless (or (null (code-char i)) (characterp (code-char i)))
+ (return nil)))
+
+(char= #\ (name-char (char-name #\ )))
+(char= #\Space (name-char (char-name #\Space)))
+(char= #\Newline (name-char (char-name #\Newline)))
diff --git a/Sacla/tests/must-condition.lisp b/Sacla/tests/must-condition.lisp
new file mode 100644
index 0000000..08e7080
--- /dev/null
+++ b/Sacla/tests/must-condition.lisp
@@ -0,0 +1,898 @@
+;; Copyright (C) 2002-2004, Yuji Minejima <ggb01164@nifty.ne.jp>
+;; ALL RIGHTS RESERVED.
+;;
+;; $Id: must-condition.lisp,v 1.7 2004/02/20 07:23:42 yuji Exp $
+;;
+;; Redistribution and use in source and binary forms, with or without
+;; modification, are permitted provided that the following conditions
+;; are met:
+;;
+;; * Redistributions of source code must retain the above copyright
+;; notice, this list of conditions and the following disclaimer.
+;; * 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.
+;;
+;; 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
+;; OWNER 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.
+
+;; signal
+(eq (signal "test signal") nil)
+(eq (signal 'simple-error :format-control "simple-error" :format-arguments nil)
+ nil)
+(eq (signal 'simple-warning
+ :format-control "simple-warning" :format-arguments nil)
+ nil)
+(handler-case (signal "test simple-condition")
+ (simple-condition () t)
+ (condition () nil)
+ (:no-error (&rest rest) (declare (ignore rest)) nil))
+(handler-case (signal 'simple-warning :format-control "simple warning"
+ :format-arguments nil)
+ (simple-warning () t)
+ (warning () nil)
+ (condition () nil)
+ (:no-error (&rest rest) (declare (ignore rest)) nil))
+(handler-case (signal 'type-error :datum nil :expected-type 'vector)
+ (type-error () t)
+ (error () nil)
+ (:no-error (&rest rest) (declare (ignore rest)) nil))
+(let ((*break-on-signals* 'arithmetic-error))
+ (handler-case (signal 'type-error :datum nil :expected-type 'vector)
+ (type-error () t)
+ (error () nil)
+ (:no-error (&rest rest) (declare (ignore rest)) nil)))
+
+
+;; error
+(handler-case (error "simple-error test")
+ (simple-error () t)
+ (error () nil)
+ (:no-error (&rest rest) (declare (ignore rest)) nil))
+(handler-case (error 'type-error :datum nil :expected-type 'vector)
+ (type-error () t)
+ (error () nil)
+ (:no-error (&rest rest) (declare (ignore rest)) nil))
+(handler-case (error 'no-such-error!!)
+ (type-error () t)
+ (error () nil)
+ (:no-error (&rest rest) (declare (ignore rest)) nil))
+(handler-case (error 'simple-condition :format-control "simple-condition test")
+ (simple-condition () t)
+ (error () nil)
+ (:no-error (&rest rest) (declare (ignore rest)) nil))
+(handler-case (error 'simple-warning :format-control "simple-warning test")
+ (simple-warning () t)
+ (error () nil)
+ (:no-error (&rest rest) (declare (ignore rest)) nil))
+
+
+
+;; cerror
+(handler-case (cerror "Continue." "error test")
+ (simple-error () t)
+ (error () nil)
+ (:no-error (&rest rest) (declare (ignore rest)) nil))
+(handler-case (cerror "Continue." 'type-error :datum nil :expected-type 'vector)
+ (type-error () t)
+ (error () nil)
+ (:no-error (&rest rest) (declare (ignore rest)) nil))
+(handler-bind ((simple-error #'(lambda (condition)
+ (declare (ignore condition))
+ (invoke-restart 'continue))))
+ (eq (cerror "Continue." "error test") nil))
+(handler-bind ((type-error #'(lambda (condition)
+ (declare (ignore condition))
+ (invoke-restart 'continue))))
+ (eq (cerror "Continue." 'type-error :datum nil :expected-type 'vector) nil))
+
+
+
+;; warn
+(let ((*error-output* (make-string-output-stream)))
+ (and (eq (warn "I warn you!") nil)
+ (get-output-stream-string *error-output*)))
+(handler-bind ((warning #'(lambda (condition)
+ (declare (ignore condition))
+ (invoke-restart 'muffle-warning))))
+ (eq (warn "I warn you!") nil))
+(let ((*error-output* (make-string-output-stream)))
+ (handler-bind ((warning #'(lambda (condition)
+ (declare (ignore condition))
+ (invoke-restart 'muffle-warning))))
+ (and (eq (warn "I warn you!") nil)
+ (string= (get-output-stream-string *error-output*) ""))))
+(block tag
+ (handler-case (warn 'simple-error
+ :format-control "boom!" :format-arguments nil)
+ (type-error () t)
+ (simple-error () nil)
+ (error () nil)
+ (:no-error (&rest rest) (declare (ignore rest)) nil)))
+(block tag
+ (handler-case (warn 'simple-condition
+ :format-control "boom!" :format-arguments nil)
+ (type-error () t)
+ (simple-condition () nil)
+ (error () nil)
+ (:no-error (&rest rest) (declare (ignore rest)) nil)))
+(block tag
+ (let ((condition (make-condition 'simple-condition
+ :format-control "boom!"
+ :format-arguments nil)))
+ (handler-case (warn condition)
+ (type-error () t)
+ (simple-condition () nil)
+ (error () nil)
+ (:no-error (&rest rest) (declare (ignore rest)) nil))))
+(block tag
+ (let ((condition (make-condition 'simple-error
+ :format-control "boom!"
+ :format-arguments nil)))
+ (handler-case (warn condition)
+ (type-error () t)
+ (simple-error () nil)
+ (error () nil)
+ (:no-error (&rest rest) (declare (ignore rest)) nil))))
+(block tag
+ (let ((condition (make-condition 'simple-warning
+ :format-control "boom!"
+ :format-arguments nil)))
+ (handler-case (warn condition)
+ (type-error () nil)
+ (simple-warning () t)
+ (error () nil)
+ (:no-error (&rest rest) (declare (ignore rest)) nil))))
+(block tag
+ (let ((condition (make-condition 'simple-warning
+ :format-control "boom!"
+ :format-arguments nil)))
+ (handler-case (warn condition :format-control "boom!" :format-arguments nil)
+ (type-error () t)
+ (simple-warning () nil)
+ (error () nil)
+ (:no-error (&rest rest) (declare (ignore rest)) nil))))
+
+
+
+;; handler-bind
+(null (handler-bind ()))
+(handler-bind () t)
+(equal (multiple-value-list (handler-bind () 1 2 3 (values 4 5 6))) '(4 5 6))
+(eq 'handled
+ (block tag (handler-bind ((type-error #'(lambda (c)
+ (declare (ignore c))
+ (return-from tag 'handled))))
+ (error 'type-error :datum nil :expected-type 'vector))))
+(eq 'handled
+ (block tag (handler-bind ((error #'(lambda (c)
+ (declare (ignore c))
+ (return-from tag 'handled))))
+ (error 'type-error :datum nil :expected-type 'vector))))
+(eq 'handled
+ (block tag (handler-bind ((condition #'(lambda (c)
+ (declare (ignore c))
+ (return-from tag 'handled))))
+ (error 'type-error :datum nil :expected-type 'vector))))
+(eq 'outer-handler
+ (block tag
+ (handler-bind ((type-error #'(lambda (c)
+ (declare (ignore c))
+ (return-from tag 'outer-handler))))
+ (handler-bind ((type-error #'(lambda (c) (error c)))
+ (type-error #'(lambda (c)
+ (declare (ignore c))
+ (return-from tag 'inner-handler))))
+ (error 'type-error :datum nil :expected-type 'vector)))))
+(eq 'outer-handler
+ (block tag
+ (handler-bind ((error #'(lambda (c)
+ (declare (ignore c))
+ (return-from tag 'outer-handler))))
+ (handler-bind ((type-error #'(lambda (c) (error c)))
+ (type-error #'(lambda (c)
+ (declare (ignore c))
+ (return-from tag 'inner-handler))))
+ (error 'type-error :datum nil :expected-type 'vector)))))
+(eq 'left-handler
+ (block tag
+ (handler-bind ((type-error #'(lambda (c)
+ (declare (ignore c))
+ (return-from tag 'left-handler)))
+ (type-error #'(lambda (c)
+ (declare (ignore c))
+ (return-from tag 'right-handler))))
+ (error 'type-error :datum nil :expected-type 'vector))))
+(eq 'left-handler
+ (block tag
+ (handler-bind ((error #'(lambda (c)
+ (declare (ignore c))
+ (return-from tag 'left-handler)))
+ (type-error #'(lambda (c)
+ (declare (ignore c))
+ (return-from tag 'right-handler))))
+ (error 'type-error :datum nil :expected-type 'vector))))
+(eq 'left-handler
+ (block tag
+ (handler-bind ((type-error #'(lambda (c)
+ (declare (ignore c))
+ (return-from tag 'left-handler)))
+ (error #'(lambda (c)
+ (declare (ignore c))
+ (return-from tag 'right-handler))))
+ (error 'type-error :datum nil :expected-type 'vector))))
+(let ((handler-declined nil))
+ (and (eq (handler-bind ((type-error #'(lambda (c)
+ (declare (ignore c))
+ (setq handler-declined t))))
+ (signal 'type-error :datum nil :expected-type 'vector))
+ nil)
+ handler-declined))
+(let ((handler-declined nil))
+ (and (eq (handler-bind ((type-error #'(lambda (c)
+ (declare (ignore c))
+ (push 'outer handler-declined))))
+ (handler-bind ((type-error #'(lambda (c)
+ (declare (ignore c))
+ (push 'inner handler-declined))))
+ (signal 'type-error :datum nil :expected-type 'vector)))
+ nil)
+ (equal handler-declined '(outer inner))))
+(let ((handler-declined nil))
+ (and (eq (handler-bind
+ ((type-error #'(lambda (c)
+ (declare (ignore c))
+ (push 'outer-left-handler handler-declined)))
+ (type-error #'(lambda (c)
+ (declare (ignore c))
+ (push 'outer-right-handler handler-declined))))
+ (handler-bind
+ ((type-error #'(lambda (c)
+ (declare (ignore c))
+ (push 'inner-left-handler handler-declined)))
+ (type-error #'(lambda (c)
+ (declare (ignore c))
+ (push 'inner-right-handler handler-declined))))
+ (signal 'type-error :datum nil :expected-type 'vector)))
+ nil)
+ (equal handler-declined '(outer-right-handler outer-left-handler
+ inner-right-handler inner-left-handler))))
+(let ((handler-declined nil))
+ (and (eq (handler-bind
+ ((type-error #'(lambda (c)
+ (declare (ignore c))
+ (push 'outer-left-handler handler-declined)))
+ (type-error #'(lambda (c)
+ (declare (ignore c))
+ (push 'outer-right-handler handler-declined))))
+ (handler-bind
+ ((type-error #'(lambda (c)
+ (declare (ignore c))
+ (push 'inner-left-handler handler-declined)))
+ (type-error #'(lambda (c)
+ (signal c)
+ (push 'inner-right-handler handler-declined))))
+ (signal 'type-error :datum nil :expected-type 'vector)))
+ nil)
+ (equal handler-declined '(outer-right-handler
+ outer-left-handler
+ inner-right-handler
+
+ outer-right-handler
+ outer-left-handler
+
+ inner-left-handler))))
+(let ((*dynamic-var* nil))
+ (declare (special *dynamic-var*))
+ (block tag
+ (handler-bind ((type-error #'(lambda (c)
+ (declare (ignore c))
+ (return-from tag *dynamic-var*))))
+ (let ((*dynamic-var* t))
+ (declare (special *dynamic-var*))
+ (signal 'type-error :datum nil :expected-type 'vector)))))
+(let ((declined nil))
+ (and (eq nil
+ (handler-bind ((simple-condition #'(lambda (c)
+ (declare (ignore c))
+ (push 'specific declined))))
+ (handler-bind ((condition #'(lambda (c)
+ (declare (ignore c))
+ (push 'general declined))))
+ (signal "error"))))
+ (equal declined '(specific general))))
+(block tag
+ (handler-bind ((error #'(lambda (c) (return-from tag (typep c 'error)))))
+ (error "error")))
+(eq 'ok
+ (block tag
+ (handler-bind ((error #'(lambda (c)
+ (declare (ignore c))
+ (return-from tag 'ok))))
+ (handler-bind ((error #'(lambda (c)
+ (declare (ignore c))
+ (error "error3"))))
+ (handler-bind ((error #'(lambda (c)
+ (declare (ignore c))
+ (error "error2"))))
+ (error "error"))))))
+(eq 'ok
+ (block tag
+ (handler-bind
+ ((error
+ #'(lambda (c)
+ (declare (ignore c))
+ (handler-bind
+ ((error #'(lambda (c)
+ (declare (ignore c))
+ (handler-bind
+ ((error #'(lambda (c)
+ (declare (ignore c))
+ (return-from tag 'ok))))
+ (error "error2")))))
+ (error "error1")))))
+ (error "error0"))))
+
+
+;; handler-case
+(handler-case t)
+(handler-case nil
+ (:no-error (&rest rest) (declare (ignore rest)) t))
+(equal (multiple-value-list (handler-case (values 0 1 2 3 4)))
+ '(0 1 2 3 4))
+(equal (handler-case (values 0 1 2 3 4)
+ (:no-error (&rest rest) rest))
+ '(0 1 2 3 4))
+(equal (multiple-value-list (handler-case (values 0 1 2 3 4)
+ (:no-error (&rest rest) (values rest 5 6 7 8))))
+ '((0 1 2 3 4) 5 6 7 8))
+(eq t (handler-case t
+ (type-error () 'type-error)
+ (error () 'error)))
+(eq 'simple-error
+ (handler-case (error "error!")
+ (simple-error () 'simple-error)
+ (error () 'error)))
+(eq 'error
+ (handler-case (error "error!")
+ (error () 'error)
+ (simple-error () 'simple-error)))
+(eq 'error
+ (handler-case (error "error!")
+ (error () 'error)
+ (condition () 'condition)
+ (simple-error () 'simple-error)))
+(eq 'condition
+ (handler-case (error "error!")
+ (condition () 'condition)
+ (error () 'error)
+ (simple-error () 'simple-error)))
+(eq 'simple-error
+ (handler-case (signal 'simple-error
+ :format-control "error!" :format-arguments nil)
+ (simple-error () 'simple-error)
+ (error () 'error)))
+(eq 'simple-error-left
+ (handler-case (signal 'simple-error
+ :format-control "error!" :format-arguments nil)
+ (simple-error () 'simple-error-left)
+ (simple-error () 'simple-error-right)))
+(eq 'no-one-handled
+ (handler-case (progn
+ (signal 'simple-warning
+ :format-control "warning!" :format-arguments nil)
+ 'no-one-handled)
+ (simple-error () 'simple-error)
+ (error () 'error)))
+(equal (handler-case (progn
+ (signal 'simple-warning
+ :format-control "warning!" :format-arguments nil)
+ 'no-one-handled)
+ (:no-error (&rest rest) (cons 'no-error rest))
+ (simple-error () 'simple-error)
+ (error () 'error))
+ '(no-error no-one-handled))
+(let ((where 'out))
+ (eq (handler-case (let ((where 'in))
+ (declare (ignorable where))
+ (error "error!"))
+ (error () where))
+ 'out))
+(let ((where 'out))
+ (declare (special where))
+ (eq (handler-case (let ((where 'in))
+ (declare (special where))
+ (error "~S" where))
+ (error () where))
+ 'out))
+(typep (handler-case (error "error!")
+ (error (c) c))
+ 'simple-error)
+(typep (handler-case (error "error!")
+ (condition (c) c))
+ 'simple-error)
+(typep (handler-case (signal "condition")
+ (condition (c) c))
+ 'simple-condition)
+(typep (handler-case (warn "warning")
+ (condition (c) c))
+ 'simple-warning)
+
+
+
+;; restart-bind
+(null (restart-bind ()))
+(restart-bind () t)
+(= (restart-bind () 0 1 2) 2)
+(equal (multiple-value-list (restart-bind () 0 1 2 (values 3 4 5))) '(3 4 5))
+(block tag
+ (restart-bind ((continue #'(lambda (&rest rest)
+ (declare (ignore rest))
+ (return-from tag t))))
+ (handler-case (signal "testing simple-signal")
+ (simple-condition () (invoke-restart 'continue)))))
+(block tag
+ (handler-bind ((simple-condition #'(lambda (condition)
+ (declare (ignore condition))
+ (invoke-restart 'continue))))
+ (restart-bind ((continue #'(lambda (&rest rest)
+ (declare (ignore rest))
+ (return-from tag t))))
+ (signal "testing simple-condition"))))
+(block tag
+ (restart-bind ((continue #'(lambda (&rest rest)
+ (declare (ignore rest))
+ (return-from tag nil))))
+ (handler-bind ((simple-condition #'(lambda (condition)
+ (declare (ignore condition))
+ (invoke-restart 'continue))))
+ (restart-bind ((continue #'(lambda (&rest rest)
+ (declare (ignore rest))
+ (return-from tag t))))
+ (signal "testing simple-condition")))))
+(block tag
+ (restart-bind ((continue #'(lambda (&rest rest)
+ (declare (ignore rest))
+ (return-from tag t)))
+ (continue #'(lambda (&rest rest)
+ (declare (ignore rest))
+ (return-from tag nil))))
+ (handler-case (signal "testing simple-signal")
+ (simple-condition () (invoke-restart 'continue)))))
+(block tag
+ (restart-bind ((continue #'(lambda (&rest rest)
+ (declare (ignore rest))
+ (return-from tag t))
+ :report-function #'(lambda (stream)
+ (format stream "Continue"))))
+ (handler-case (signal "testing simple-signal")
+ (simple-condition () (invoke-restart 'continue)))))
+(block tag
+ (restart-bind ((continue #'(lambda (x) (return-from tag x))
+ :report-function
+ #'(lambda (stream) (format stream "Continue"))
+ :interactive-function #'(lambda () (list t))))
+ (handler-case (signal "testing simple-signal")
+ (simple-condition () (invoke-restart-interactively 'continue)))))
+(eq 'ok
+ (block tag
+ (restart-bind ((continue #'(lambda (x) (return-from tag x))))
+ (handler-case (signal "testing simple-signal")
+ (simple-condition () (invoke-restart 'continue 'ok))))))
+(block tag
+ (restart-bind ((continue #'(lambda (x) (return-from tag x))
+ :report-function
+ #'(lambda (stream) (format stream "Continue"))
+ :interactive-function #'(lambda () (list t))
+ :test-function (constantly t)))
+ (handler-case (signal "testing simple-signal")
+ (simple-condition () (invoke-restart-interactively 'continue)))))
+(block tag
+ (restart-bind ((continue #'(lambda (x) (return-from tag x))
+ :report-function
+ #'(lambda (stream) (format stream "Continue"))
+ :interactive-function #'(lambda () (list t))
+ :test-function
+ #'(lambda (c) (or (null c) (typep c 'simple-condition)))))
+ (handler-case (signal "testing simple-signal")
+ (simple-condition () (invoke-restart-interactively 'continue)))))
+(block tag
+ (restart-bind ((tb-continue #'(lambda (x) (return-from tag x))
+ :interactive-function #'(lambda () (list t))
+ :test-function (constantly nil)
+ :report-function
+ #'(lambda (stream) (format stream "Continue"))))
+ (not (find-restart 'tb-continue))))
+(block tag
+ (restart-bind ((tb-continue #'(lambda (x) (return-from tag x))
+ :interactive-function #'(lambda () (list t))
+ :test-function (constantly t)
+ :report-function #'(lambda (stream) (format stream "cont."))))
+ (handler-case (signal "testing simple-signal")
+ (simple-condition () (invoke-restart-interactively 'tb-continue)))))
+(null (let ((*dynamic-var* nil))
+ (declare (special *dynamic-var*))
+ (block tag
+ (restart-bind ((continue #'(lambda (x)
+ (declare (ignore x))
+ (return-from tag *dynamic-var*))
+ :interactive-function #'(lambda () (list t))
+ :test-function (constantly t)
+ :report-function
+ #'(lambda (stream) (format stream "cont."))))
+ (handler-case (let ((*dynamic-var* t))
+ (declare (special *dynamic-var*))
+ (signal "testing simple-signal"))
+ (simple-condition () (invoke-restart-interactively 'continue)))))))
+(let ((*dynamic-var* nil))
+ (declare (special *dynamic-var*))
+ (block tag
+ (restart-bind ((continue #'(lambda (x)
+ (declare (ignore x))
+ (return-from tag *dynamic-var*))
+ :interactive-function #'(lambda () (list t))
+ :test-function (constantly t)
+ :report-function
+ #'(lambda (stream) (format stream "cont."))))
+ (handler-bind ((simple-condition
+ #'(lambda (c)
+ (declare (ignore c))
+ (invoke-restart-interactively 'continue))))
+ (let ((*dynamic-var* t))
+ (declare (special *dynamic-var*))
+ (signal "testing simple-signal"))))))
+(block tag
+ (restart-bind ((nil #'(lambda (&rest rest)
+ (declare (ignore rest))
+ (return-from tag t))))
+ (handler-case (signal "testing simple-signal")
+ (simple-condition () (invoke-restart 'nil)))))
+
+
+
+;; restart-case
+(restart-case t)
+(restart-case t
+ (continue (&rest rest) (declare (ignore rest)) nil))
+(equal (multiple-value-list (restart-case (values 0 1 2 3 4))) '(0 1 2 3 4))
+(eq 'continued
+ (restart-case (continue)
+ (continue (&rest rest) (declare (ignore rest)) 'continued)))
+(eq nil
+ (restart-case (continue)
+ (continue (&rest rest) (declare (ignore rest)))))
+(eq 'continue-left
+ (restart-case (continue)
+ (continue (&rest rest) (declare (ignore rest)) 'continue-left)
+ (continue (&rest rest) (declare (ignore rest)) 'continue-right)))
+(null (restart-case (invoke-restart 'continue)
+ (continue (&rest rest)
+ :interactive (lambda () (list 0 1 2 3))
+ rest)))
+(equal (restart-case (invoke-restart-interactively 'continue)
+ (continue (&rest rest)
+ :interactive (lambda () (list 0 1 2 3))
+ rest))
+ '(0 1 2 3))
+(equal (restart-case (invoke-restart-interactively 'continue)
+ (continue (&rest rest)
+ :interactive (lambda () (list 0 1 2 3))
+ :report "continue"
+ rest))
+ '(0 1 2 3))
+(equal (restart-case (invoke-restart-interactively 'continue)
+ (continue (&rest rest)
+ :interactive (lambda () (list 0 1 2 3))
+ :report "continue"
+ :test (lambda (c) (declare (ignore c)) t)
+ rest))
+ '(0 1 2 3))
+(= (restart-case
+ (handler-bind ((error #'(lambda (c)
+ (declare (ignore c))
+ (invoke-restart 'my-restart 7))))
+ (error "Foo."))
+ (my-restart (&optional v) v))
+ 7)
+(eq (handler-bind ((error #'(lambda (c)
+ (declare (ignore c))
+ (invoke-restart 'my-restart 'restarted))))
+ (restart-case (error "Boo.")
+ (my-restart (&optional v) v)))
+ 'restarted)
+(eq (handler-bind ((error #'(lambda (c)
+ (invoke-restart (find-restart 'my-restart c)
+ 'restarted))))
+ (restart-case (error "Boo.")
+ (my-restart (&optional v) v)))
+ 'restarted)
+
+(> (length
+ (block tag
+ (handler-bind ((error #'(lambda (c)
+ (return-from tag (compute-restarts c)))))
+ (restart-case (error "Boo.")
+ (my-restart (&optional v) v)
+ (my-restart (&optional v) v)))))
+ 1)
+(eq 'ok
+ (restart-case (invoke-restart 'nil)
+ (nil (&rest rest) (declare (ignore rest)) 'ok)))
+
+
+
+
+
+
+;; compute-restarts
+(listp (mapcar #'restart-name (compute-restarts)))
+(listp (mapcar #'restart-name
+ (compute-restarts (make-condition 'simple-error
+ :format-control "error"
+ :format-arguments nil))))
+(restart-case (let ((list (compute-restarts)))
+ (and (member 'my-restart list
+ :test #'string= :key #'restart-name)
+ (member 'your-restart list
+ :test #'string= :key #'restart-name)))
+ (my-restart ())
+ (your-restart ()))
+(restart-case (let ((list (compute-restarts)))
+ (member 'my-restart
+ (cdr (member 'my-restart list
+ :test #'string= :key #'restart-name))
+ :test #'string= :key #'restart-name))
+ (my-restart ())
+ (my-restart ()))
+
+
+;; find-restart
+(or (find-restart 'continue) t)
+(restart-case (find-restart 'my-restart)
+ (my-restart ()))
+(restart-case (find-restart (find-restart 'my-restart))
+ (my-restart ()))
+(let ((condition (make-condition 'simple-error
+ :format-control "error" :format-arguments nil)))
+ (block tag
+ (handler-bind ((error
+ #'(lambda (c)
+ (return-from tag (and (eq c condition)
+ (find-restart 'my-restart c))))))
+ (restart-case (error condition)
+ (my-restart ())))))
+
+
+;; restart-name
+(string= "MY-RESTART"
+ (block tag
+ (handler-bind
+ ((error
+ #'(lambda (c)
+ (return-from tag (restart-name
+ (find-restart 'my-restart c))))))
+ (restart-case (error "error!")
+ (my-restart ())))))
+(null (block tag
+ (handler-bind
+ ((error
+ #'(lambda (c)
+ (return-from tag (restart-name
+ (find-restart 'nil c))))))
+ (restart-case (error "error!")
+ (nil ())))))
+
+
+;; with-condition-restarts
+(null (with-condition-restarts
+ (make-condition 'simple-error
+ :format-control "error" :format-arguments nil)
+ ()))
+(with-condition-restarts
+ (make-condition 'simple-error
+ :format-control "error" :format-arguments nil)
+ () t)
+(equal
+ (multiple-value-list
+ (with-condition-restarts
+ (make-condition 'simple-error
+ :format-control "error" :format-arguments nil)
+ () 0 1 2 (values 3 4 5)))
+ '(3 4 5))
+(let ((condition (make-condition 'simple-error
+ :format-control "error" :format-arguments nil))
+ (other (make-condition 'simple-error
+ :format-control "error" :format-arguments nil)))
+ (block tag
+ (handler-bind
+ ((error
+ #'(lambda (c)
+ (return-from tag (and (find-restart 'my-restart c)
+ (null (with-condition-restarts other
+ (compute-restarts)
+ (find-restart 'my-restart c))))))))
+ (restart-case (progn 3 2 1 'go (error condition))
+ (my-restart ())))))
+
+
+;; with-simple-restart
+(null (with-simple-restart (continue "continue")))
+(with-simple-restart (continue "continue") t)
+(equal (multiple-value-list
+ (with-simple-restart (continue "continue") 0 1 (values 2 3 4)))
+ '(2 3 4))
+(equal (multiple-value-list
+ (with-simple-restart (continue "continue")
+ (continue)))
+ '(nil t))
+(equal (multiple-value-list
+ (with-simple-restart (continue "continue")
+ (handler-case (error "boo")
+ (error (c) (declare (ignore c)) (invoke-restart 'continue)))))
+ '(nil t))
+
+
+;; abort
+(eq 'ok
+ (restart-case (abort)
+ (abort () 'ok)))
+(let ((condition (make-condition 'simple-error
+ :format-control "error" :format-arguments nil)))
+ (or (find-restart 'abort condition)
+ (eq 'handled
+ (handler-case (abort condition)
+ (control-error () 'handled)
+ (condition () nil)))))
+
+;; muffle-warning
+(eq 'ok
+ (restart-case (muffle-warning)
+ (muffle-warning () 'ok)))
+(let ((condition (make-condition 'simple-warning
+ :format-control "warning"
+ :format-arguments nil)))
+ (or (find-restart 'muffle-warning condition)
+ (eq 'handled
+ (handler-case (muffle-warning condition)
+ (control-error () 'handled)
+ (condition () nil)))))
+
+;; continue
+(eq 'ok
+ (restart-case (continue)
+ (continue () 'ok)))
+(let ((condition (make-condition 'simple-error
+ :format-control "error"
+ :format-arguments nil)))
+ (or (find-restart 'continue condition)
+ (null (continue condition))))
+
+;; store-value
+(eq 'ok
+ (restart-case (store-value 'ok)
+ (store-value (value) value)))
+(let ((condition (make-condition 'simple-error
+ :format-control "error"
+ :format-arguments nil)))
+ (or (find-restart 'store-value condition)
+ (null (store-value t condition))))
+
+;; use-value
+(eq 'ok
+ (restart-case (use-value 'ok)
+ (use-value (value) value)))
+(let ((condition (make-condition 'simple-error
+ :format-control "error"
+ :format-arguments nil)))
+ (or (find-restart 'use-value condition)
+ (null (use-value t condition))))
+
+
+
+
+
+;; assert
+(eq (assert t) nil)
+(handler-case (assert nil)
+ (error () t)
+ (:no-error (&rest rest) (declare (ignore rest)) nil))
+(let ((count 0))
+ (and (eq (assert (incf count)) nil)
+ (= count 1)))
+(handler-case (let ((var nil)) (assert var (var) "VAR should be true."))
+ (simple-error () t)
+ (error () nil)
+ (:no-error (&rest rest) (declare (ignore rest)) nil))
+(let ((str (copy-seq "ABC"))
+ (count 0))
+ (and (eq (assert (char= (aref str 0) #\A) ((aref (progn (incf count) str) 0)))
+ nil)
+ (zerop count)))
+(let ((str (copy-seq "ABC"))
+ (count 0))
+ (and (eq (assert (and (char= (aref str 0) #\A)
+ (char= (aref str 1) #\B))
+ ((aref (progn (incf count) str) 0)
+ (aref (progn (incf count) str) 1)))
+ nil)
+ (zerop count)))
+(handler-case (let ((var nil))
+ (assert var (var) 'type-error :expected-type 'array))
+ (type-error () t)
+ (error () nil)
+ (:no-error (&rest rest) (declare (ignore rest)) nil))
+
+
+;; check-type
+(null (let ((var nil)) (check-type var null)))
+(null (let ((var '(a b c))) (check-type var cons)))
+(handler-case (let ((var '(a b c))) (check-type var vector))
+ (type-error () t)
+ (error () nil)
+ (:no-error (&rest rest) (declare (ignore rest)) nil))
+(eq 'handled
+ (block tag
+ (handler-bind ((type-error
+ #'(lambda (c)
+ (declare (ignore c))
+ (return-from tag 'handled)))
+ (error #'(lambda (c)
+ (declare (ignore c))
+ (return-from tag nil))))
+ (let ((var '(a b c)))
+ (check-type var vector)
+ var))))
+(string= (block tag
+ (handler-bind ((type-error
+ #'(lambda (c)
+ (declare (ignore c))
+ (invoke-restart 'store-value "eat this")))
+ (error #'(lambda (c)
+ (declare (ignore c))
+ (return-from tag nil))))
+ (let ((var '(a b c)))
+ (check-type var vector)
+ var)))
+ "eat this")
+
+
+;; ignore-errors
+(null (ignore-errors))
+(ignore-errors t)
+(let ((result (multiple-value-list (ignore-errors (error "error")))))
+ (and (null (first result))
+ (typep (second result) 'simple-error)))
+(equal (multiple-value-list (ignore-errors 'a 'b 'c (values 'd 'e)))
+ '(d e))
+(let ((result (multiple-value-list
+ (ignore-errors (signal 'simple-error
+ :format-control "error"
+ :format-arguments nil)))))
+ (and (null (first result))
+ (typep (second result) 'simple-error)))
+(eq (ignore-errors (signal "only signal") 'ok) 'ok)
+(eq (block tag
+ (handler-bind ((condition #'(lambda (c)
+ (declare (ignore c))
+ (return-from tag 'handled))))
+ (ignore-errors (error 'simple-condition
+ :format-control "only condition"
+ :format-arguments nil))))
+ 'handled)
+(let ((result (multiple-value-list
+ (ignore-errors (warn 'simple-error
+ :format-control "an error, not a warning"
+ :format-arguments nil)))))
+ (and (null (first result))
+ (typep (second result) 'type-error)))
+
diff --git a/Sacla/tests/must-cons.lisp b/Sacla/tests/must-cons.lisp
new file mode 100644
index 0000000..a865e70
--- /dev/null
+++ b/Sacla/tests/must-cons.lisp
@@ -0,0 +1,2309 @@
+;; Copyright (C) 2002-2004, Yuji Minejima <ggb01164@nifty.ne.jp>
+;; ALL RIGHTS RESERVED.
+;;
+;; $Id: must-cons.lisp,v 1.4 2004/02/20 07:23:42 yuji Exp $
+;;
+;; Redistribution and use in source and binary forms, with or without
+;; modification, are permitted provided that the following conditions
+;; are met:
+;;
+;; * Redistributions of source code must retain the above copyright
+;; notice, this list of conditions and the following disclaimer.
+;; * 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.
+;;
+;; 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
+;; OWNER 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.
+
+(consp (cons 'a 'b))
+
+(consp '(1 . 2))
+
+(consp (list nil))
+
+(not (consp 'a))
+
+(not (consp nil))
+
+(not (consp 1))
+
+(not (consp #\a))
+
+(let ((a (cons 1 2)))
+ (and (eql (car a) 1)
+ (eql (cdr a) 2)))
+
+(equal (cons 1 nil) '(1))
+
+(equal (cons nil nil) '(nil))
+
+(equal (cons 'a (cons 'b (cons 'c '()))) '(a b c))
+
+(atom 'a)
+
+(atom nil)
+
+(atom 1)
+
+(atom #\a)
+
+(not (atom (cons 1 2)))
+
+(not (atom '(a . b)))
+
+(not (atom (list nil)))
+
+
+(listp nil)
+
+(listp '(a b c))
+
+(listp '(a . b))
+
+(listp (cons 'a 'b))
+
+(listp '#1=(1 2 . #1#))
+
+(not (listp 1))
+
+(not (listp 't))
+
+(null '())
+(null 'nil)
+(null nil)
+(not (null t))
+(null (cdr '(a)))
+(not (null (cdr '(1 . 2))))
+(not (null 'a))
+
+
+(endp '())
+(not (endp '(1)))
+(not (endp '(1 2)))
+(not (endp '(1 2 3)))
+(not (endp (cons 1 2)))
+(endp (cddr '(1 2)))
+
+
+(let ((a (cons 1 2)))
+ (and (eq (rplaca a 0) a)
+ (equal a '(0 . 2))))
+
+(let ((a (list 1 2 3)))
+ (and (eq (rplaca a 0) a)
+ (equal a '(0 2 3))))
+
+(let ((a (cons 1 2)))
+ (and (eq (rplacd a 0) a)
+ (equal a '(1 . 0))))
+
+(let ((a (list 1 2 3)))
+ (and (eq (rplacd a 0) a)
+ (equal a '(1 . 0))))
+
+(eq (car '(a . b)) 'a)
+
+(null (car nil))
+
+(let ((a (cons 1 2)))
+ (eq (car (list a)) a))
+
+(eq (car '#1=(a . #1#)) 'a)
+
+(eq (cdr '(a . b)) 'b)
+(eq (rest '(a . b)) 'b)
+
+(null (cdr nil))
+(null (rest nil))
+
+(let ((a (cons 1 2)))
+ (eq (cdr (cons 1 a)) a))
+(let ((a (cons 1 2)))
+ (eq (rest (cons 1 a)) a))
+
+(let ((x '#1=(a . #1#)))
+ (eq (cdr x) x))
+(let ((x '#1=(a . #1#)))
+ (eq (rest x) x))
+
+(eq (caar '((a) b c)) 'a)
+
+(eq (cadr '(a b c)) 'b)
+
+(eq (cdar '((a . aa) b c)) 'aa)
+
+(eq (cddr '(a b . c)) 'c)
+
+(eq (caaar '(((a)) b c)) 'a)
+
+(eq (caadr '(a (b) c)) 'b)
+
+(eq (cadar '((a aa) b c)) 'aa)
+
+(eq (caddr '(a b c)) 'c)
+
+(eq (cdaar '(((a . aa)) b c)) 'aa)
+
+(eq (cdadr '(a (b . bb) c)) 'bb)
+
+(eq (cddar '((a aa . aaa) b c)) 'aaa)
+
+(eq (cdddr '(a b c . d)) 'd)
+
+(eq (caaaar '((((a))) b c)) 'a)
+
+(eq (caaadr '(a ((b)) c)) 'b)
+
+(eq (caadar '((a (aa)) b c)) 'aa)
+
+(eq (caaddr '(a b (c))) 'c)
+
+(eq (cadaar '(((a aa)) b c)) 'aa)
+
+(eq (cadadr '(a (b bb) c)) 'bb)
+
+(eq (caddar '((a aa aaa) b c)) 'aaa)
+
+(eq (cadddr '(a b c d)) 'd)
+
+(eq (cdaaar '((((a . aa))) b c)) 'aa)
+
+(eq (cdaadr '(a ((b . bb)) c)) 'bb)
+
+(eq (cdadar '((a (aa . aaa)) b c)) 'aaa)
+
+(eq (cdaddr '(a b (c . cc))) 'cc)
+
+(eq (cddaar '(((a aa . aaa)) b c)) 'aaa)
+
+(eq (cddadr '(a (b bb . bbb) c)) 'bbb)
+
+(eq (cdddar '((a aa aaa . aaaa) b c)) 'aaaa)
+
+(eq (cddddr '(a b c d . e)) 'e)
+
+(let ((x (cons 1 2)))
+ (and (eql (setf (car x) 0) 0)
+ (equal x '(0 . 2))))
+
+(let ((x (cons 1 2)))
+ (and (eql (setf (cdr x) 0) 0)
+ (equal x '(1 . 0))))
+
+(let ((x (copy-tree '((a) b c))))
+ (and (eql (setf (caar x) 0) 0)
+ (equal x '((0) b c))))
+
+(let ((x (list 'a 'b 'c)))
+ (and (eql (setf (cadr x) 0) 0)
+ (equal x '(a 0 c))))
+
+(let ((x (copy-tree '((a . aa) b c))))
+ (and (eql (setf (cdar x) 0) 0)
+ (equal x '((a . 0) b c))))
+
+(let ((x (copy-tree '(a b . c))))
+ (and (eql (setf (cddr x) 0) 0)
+ (equal x '(a b . 0))))
+
+(let ((x (copy-tree '(((a)) b c))))
+ (and (eql (setf (caaar x) 0) 0)
+ (equal x '(((0)) b c))))
+
+(let ((x (copy-tree '(a (b) c))))
+ (and (eql (setf (caadr x) 0) 0)
+ (equal x '(a (0) c))))
+
+(let ((x (copy-tree '((a aa) b c))))
+ (and (eql (setf (cadar x) 0) 0)
+ (equal x '((a 0) b c))))
+
+(let ((x (list 'a 'b 'c)))
+ (and (eql (setf (caddr x) 0) 0)
+ (equal x '(a b 0))))
+
+(let ((x (copy-tree '(((a . aa)) b c))))
+ (and (eql (setf (cdaar x) 0) 0)
+ (equal x '(((a . 0)) b c))))
+
+(let ((x (copy-tree '(a (b . bb) c))))
+ (and (eql (setf (cdadr x) 0) 0)
+ (equal x '(a (b . 0) c))))
+
+(let ((x (copy-tree '((a aa . aaa) b c))))
+ (and (eql (setf (cddar x) 0) 0)
+ (equal x '((a aa . 0) b c))))
+
+(let ((x (copy-tree '(a b c . d))))
+ (and (eql (setf (cdddr x) 0) 0)
+ (equal x '(a b c . 0))))
+
+(let ((x (copy-tree '((((a))) b c))))
+ (and (eql (setf (caaaar x) 0) 0)
+ (equal x '((((0))) b c))))
+
+(let ((x (copy-tree '(a ((b)) c))))
+ (and (eql (setf (caaadr x) 0) 0)
+ (equal x '(a ((0)) c))))
+
+(let ((x (copy-tree '((a (aa)) b c))))
+ (and (eql (setf (caadar x) 0) 0)
+ (equal x '((a (0)) b c))))
+
+(let ((x (copy-tree '(a b (c)))))
+ (and (eql (setf (caaddr x) 0) 0)
+ (equal x '(a b (0)))))
+
+(let ((x (copy-tree '(((a aa)) b c))))
+ (and (eql (setf (cadaar x) 0) 0)
+ (equal x '(((a 0)) b c))))
+
+(let ((x (copy-tree '(a (b bb) c))))
+ (and (eql (setf (cadadr x) 0) 0)
+ (equal x '(a (b 0) c))))
+
+(let ((x (copy-tree '((a aa aaa) b c))))
+ (and (eql (setf (caddar x) 0) 0)
+ (equal x '((a aa 0) b c))))
+
+(let ((x (list 'a 'b 'c 'd)))
+ (and (eql (setf (cadddr x) 0) 0)
+ (equal x '(a b c 0))))
+
+(let ((x (copy-tree '((((a . aa))) b c))))
+ (and (eql (setf (cdaaar x) 0) 0)
+ (equal x '((((a . 0))) b c))))
+
+(let ((x (copy-tree '(a ((b . bb)) c))))
+ (and (eql (setf (cdaadr x) 0) 0)
+ (equal x '(a ((b . 0)) c))))
+
+(let ((x (copy-tree '((a (aa . aaa)) b c))))
+ (and (eql (setf (cdadar x) 0) 0)
+ (equal x '((a (aa . 0)) b c))))
+
+(let ((x (copy-tree '(a b (c . cc)))))
+ (and (eql (setf (cdaddr x) 0) 0)
+ (equal x '(a b (c . 0)))))
+
+(let ((x (copy-tree '(((a aa . aaa)) b c))))
+ (and (eql (setf (cddaar x) 0) 0)
+ (equal x '(((a aa . 0)) b c))))
+
+(let ((x (copy-tree '(a (b bb . bbb) c))))
+ (and (eql (setf (cddadr x) 0) 0)
+ (equal x '(a (b bb . 0) c))))
+
+(let ((x (copy-tree '((a aa aaa . aaaa) b c))))
+ (and (eql (setf (cdddar x) 0) 0)
+ (equal x '((a aa aaa . 0) b c))))
+
+(let ((x (copy-tree '(a b c d . e))))
+ (and (eql (setf (cddddr x) 0) 0)
+ (equal x '(a b c d . 0))))
+
+(eq (copy-tree 'a) 'a)
+
+(eq (copy-tree nil) nil)
+
+(let* ((a (list 'a))
+ (b (list 'b))
+ (c (list 'c))
+ (x3 (cons c nil))
+ (x2 (cons b x3))
+ (x (cons a x2))
+ (y (copy-tree x)))
+ (and (not (eq x y))
+ (not (eq (car x) (car y)))
+ (not (eq (cdr x) (cdr y)))
+ (not (eq (cadr x) (cadr y)))
+ (not (eq (cddr x) (cddr y)))
+ (not (eq (caddr x) (caddr y)))
+ (eq (cdddr x) (cdddr y))
+ (equal x y)
+ (eq (car x) a) (eq (car a) 'a) (eq (cdr a) nil)
+ (eq (cdr x) x2)
+ (eq (car x2) b) (eq (car b) 'b) (eq (cdr b) nil)
+ (eq (cdr x2) x3)
+ (eq (car x3) c) (eq (car c) 'c) (eq (cdr c) nil)
+ (eq (cdr x3) nil)))
+
+(let* ((x (list (list 'a 1) (list 'b 2) (list 'c 3)))
+ (y (copy-tree x)))
+ (and (not (eq (car x) (car y)))
+ (not (eq (cadr x) (cadr y)))
+ (not (eq (caddr x) (caddr y)))))
+
+(let* ((x (list (list (list 1))))
+ (y (copy-tree x)))
+ (and (not (eq x y))
+ (not (eq (car x) (car y)))
+ (not (eq (caar x) (caar y)))))
+
+
+(let ((x (list 'a 'b 'c 'd)))
+ (and (equal (sublis '((a . 1) (b . 2) (c . 3)) x)
+ '(1 2 3 d))
+ (equal x '(a b c d))))
+
+(let* ((n (cons 'n nil))
+ (m (cons 'm n))
+ (l (cons 'l m))
+ (x (sublis '((a . 1) (b . 2) (c . 3)) l)))
+ (and (eq x l)
+ (eq (car l) 'l)
+ (eq (cdr l) m)
+ (eq (car m) 'm)
+ (eq (cdr m) n)
+ (eq (car n) 'n)
+ (eq (cdr n) nil)))
+
+(eq (sublis '() '()) '())
+
+(equal (sublis '() '(1 2 3)) '(1 2 3))
+
+(eq (sublis '((a . 1) (b . 2)) '()) nil)
+
+(equal (sublis '((a b c) (b c d) (c d e))
+ '(a b c))
+ '((b c) (c d) (d e)))
+
+(equal (sublis '((a . 1) (b . 2) (c . 3))
+ '(((a)) (b) c))
+ '(((1)) (2) 3))
+
+(equal (sublis '(((a) . 1) ((b) . 2) ((c) . 3))
+ '((((a))) ((b)) (c)))
+ '((((a))) ((b)) (c)))
+
+(equal (sublis '(((a) . 1) ((b) . 2) ((c) . 3))
+ '((((a))) ((b)) (c))
+ :test #'equal)
+ '(((1)) (2) 3))
+
+(equal (sublis '(((a) . 1) ((b) . 2) ((c) . 3))
+ '((((a))) ((b)) (c))
+ :test-not (complement #'equal))
+ '(((1)) (2) 3))
+
+(equal (sublis '((a . 1) (b . 2) (c . 3))
+ '((((a))) ((b)) (c))
+ :key #'car)
+ '(((1)) (2) 3))
+
+(equal (sublis '(((a) . 1) ((b) . 2) ((c) . 3))
+ '((((a))) ((b)) (c))
+ :key #'car
+ :test #'equal)
+ '((1) 2 . 3))
+
+
+
+(equal (nsublis '((a . 1) (b . 2) (c . 3))
+ (list 'a 'b 'c 'd))
+ '(1 2 3 d))
+
+(let* ((x (list 'a 'b 'c 'd))
+ (y (nsublis '((a . 1) (b . 2) (c . 3)) x)))
+ (and (eq x y)
+ (equal x '(1 2 3 d))))
+
+(let ((x (list 'l 'm 'n)))
+ (and (eq (nsublis '((a . 1) (b . 2) (c . 3)) x) x)
+ (equal x '(l m n))))
+
+(let* ((n (cons 'n nil))
+ (m (cons 'm n))
+ (l (cons 'l m))
+ (x (nsublis '((a . 1) (b . 2) (c . 3)) l)))
+ (and (eq x l)
+ (eq (car l) 'l)
+ (eq (cdr l) m)
+ (eq (car m) 'm)
+ (eq (cdr m) n)
+ (eq (car n) 'n)
+ (eq (cdr n) nil)))
+
+(eq (nsublis '() '()) '())
+
+(equal (nsublis '() '(1 2 3)) '(1 2 3))
+
+(eq (nsublis '((a . 1) (b . 2)) '()) nil)
+
+(equal (nsublis '((a b c) (b c d) (c d e))
+ (list 'a 'b 'c))
+ '((b c) (c d) (d e)))
+
+(equal (nsublis '((a . 1) (b . 2) (c . 3))
+ (copy-tree '(((a)) (b) c)))
+ '(((1)) (2) 3))
+
+(equal (nsublis '(((a) . 1) ((b) . 2) ((c) . 3))
+ (copy-tree '((((a))) ((b)) (c))))
+ '((((a))) ((b)) (c)))
+
+(equal (nsublis '(((a) . 1) ((b) . 2) ((c) . 3))
+ (copy-tree '((((a))) ((b)) (c)))
+ :test #'equal)
+ '(((1)) (2) 3))
+
+(equal (nsublis '(((a) . 1) ((b) . 2) ((c) . 3))
+ (copy-tree '((((a))) ((b)) (c)))
+ :test-not (complement #'equal))
+ '(((1)) (2) 3))
+
+
+(equal (nsublis '((a . 1) (b . 2) (c . 3))
+ (copy-tree '((((a))) ((b)) (c)))
+ :key #'car)
+ '(((1)) (2) 3))
+
+(equal (nsublis '(((a) . 1) ((b) . 2) ((c) . 3))
+ (copy-tree '((((a))) ((b)) (c)))
+ :key 'car
+ :test #'equal)
+ '((1) 2 . 3))
+
+
+(let ((tree '(old (old) ((old)))))
+ (equal (subst 'new 'old tree)
+ '(new (new) ((new)))))
+
+(eq (subst 'new 'old 'old) 'new)
+
+(eq (subst 'new 'old 'not-old) 'not-old)
+
+(equal (subst 'new '(b) '(a ((b))) :test #'equal)
+ '(a (new)))
+
+(equal (subst 'new '(b) '(a ((b))) :test-not (complement #'equal))
+ '(a (new)))
+
+(equal (subst 'x 3 '(1 (1 2) (1 2 3) (1 2 3 4))
+ :key #'(lambda (y) (and (listp y) (third y))))
+ '(1 (1 2) X X))
+
+(equal (subst 'x "D" '("a" ("a" "b") ("a" "b" "c") ("a" "b" "c" "d"))
+ :test #'equalp
+ :key #'(lambda (y) (and (listp y) (fourth y))))
+ '("a" ("a" "b") ("a" "b" "c") X))
+
+
+(equal (subst-if 'new #'(lambda (x) (eq x 'old)) '(old old))
+ '(new new))
+
+(eq (subst-if 'new #'(lambda (x) (eq x 'old)) 'old) 'new)
+
+(equal (subst-if 'x #'(lambda (x) (eql x 3)) '(1 (1 2) (1 2 3) (1 2 3 4))
+ :key #'(lambda (y) (and (listp y) (third y))))
+ '(1 (1 2) x x))
+
+
+(let ((tree '(old (old) ((old)))))
+ (equal (subst-if 'new #'(lambda (x) (eq x 'old)) tree)
+ '(new (new) ((new)))))
+
+(eq (subst-if 'new #'(lambda (x) (eq x 'old)) 'old)
+ 'new)
+
+(eq (subst-if 'new #'(lambda (x) (eq x 'old)) 'not-old)
+ 'not-old)
+
+(equal (subst-if 'new #'(lambda (x) (equal x '(b))) '(a ((b))))
+ '(a (new)))
+
+(equal (subst-if 'x
+ #'(lambda (x) (eql x 3)) '(1 (1 2) (1 2 3) (1 2 3 4))
+ :key #'(lambda (y) (and (listp y) (third y))))
+ '(1 (1 2) X X))
+
+(equal (subst-if 'x
+ #'(lambda (x) (equalp x "D"))
+ '("a" ("a" "b") ("a" "b" "c") ("a" "b" "c" "d"))
+ :key #'(lambda (y) (and (listp y) (fourth y))))
+ '("a" ("a" "b") ("a" "b" "c") X))
+
+
+(equal (subst-if-not 'new #'(lambda (x) (not (eq x 'old))) '(old old))
+ '(new new))
+
+(eq (subst-if-not 'new #'(lambda (x) (not (eq x 'old))) 'old) 'new)
+
+(equal (subst-if-not 'x #'(lambda (x) (not (eql x 3)))
+ '(1 (1 2) (1 2 3) (1 2 3 4))
+ :key #'(lambda (y) (and (listp y) (third y))))
+ '(1 (1 2) x x))
+
+
+(let ((tree '(old (old) ((old)))))
+ (equal (subst-if-not 'new #'(lambda (x) (not (eq x 'old))) tree)
+ '(new (new) ((new)))))
+
+(eq (subst-if-not 'new #'(lambda (x) (not (eq x 'old))) 'old)
+ 'new)
+
+(eq (subst-if-not 'new #'(lambda (x) (not (eq x 'old))) 'not-old)
+ 'not-old)
+
+(equal (subst-if-not 'new #'(lambda (x) (not (equal x '(b)))) '(a ((b))))
+ '(a (new)))
+
+(equal (subst-if-not 'x
+ #'(lambda (x) (not (eql x 3)))
+ '(1 (1 2) (1 2 3) (1 2 3 4))
+ :key #'(lambda (y) (and (listp y) (third y))))
+ '(1 (1 2) X X))
+
+(equal (subst-if-not 'x
+ #'(lambda (x) (not (equalp x "D")))
+ '("a" ("a" "b") ("a" "b" "c") ("a" "b" "c" "d"))
+ :key #'(lambda (y) (and (listp y) (fourth y))))
+ '("a" ("a" "b") ("a" "b" "c") X))
+
+
+
+(let ((tree '(old (old) ((old)))))
+ (equal (nsubst 'new 'old (copy-tree tree))
+ '(new (new) ((new)))))
+
+(let* ((tree (copy-tree '(old (old) ((old)))))
+ (new-tree (nsubst 'new 'old tree)))
+ (and (eq tree new-tree)
+ (equal tree '(new (new) ((new))))))
+
+(eq (nsubst 'new 'old 'old) 'new)
+
+(eq (nsubst 'new 'old 'not-old) 'not-old)
+
+(equal (nsubst 'new '(b) (copy-tree '(a ((b)))) :test #'equal)
+ '(a (new)))
+
+(equal (nsubst 'new '(b) (copy-tree '(a ((b)))) :test-not (complement #'equal))
+ '(a (new)))
+
+(equal (nsubst 'x 3 (copy-tree '(1 (1 2) (1 2 3) (1 2 3 4)))
+ :key #'(lambda (y) (and (listp y) (third y))))
+ '(1 (1 2) X X))
+
+(equal (nsubst 'x "D"
+ (copy-tree '("a" ("a" "b") ("a" "b" "c") ("a" "b" "c" "d")))
+ :test #'equalp
+ :key #'(lambda (y) (and (listp y) (fourth y))))
+ '("a" ("a" "b") ("a" "b" "c") X))
+
+
+(equal (nsubst-if 'new #'(lambda (x) (eq x 'old)) (list 'old 'old))
+ '(new new))
+
+(eq (nsubst-if 'new #'(lambda (x) (eq x 'old)) 'old) 'new)
+
+(let* ((x (copy-tree '(old (old) ((old)) (old) old)))
+ (y (nsubst-if 'new #'(lambda (x) (eq x 'old)) x)))
+ (and (eq x y)
+ (equal x '(new (new) ((new)) (new) new))))
+
+(equal (nsubst-if 'x
+ #'(lambda (x) (eql x 3))
+ (copy-tree '(1 (1 2) (1 2 3) (1 2 3 4)))
+ :key #'(lambda (y) (and (listp y) (third y))))
+ '(1 (1 2) x x))
+
+(let ((tree '(old (old) ((old)))))
+ (equal (nsubst-if 'new #'(lambda (x) (eq x 'old)) (copy-tree tree))
+ '(new (new) ((new)))))
+
+(eq (nsubst-if 'new #'(lambda (x) (eq x 'old)) 'old)
+ 'new)
+
+(eq (nsubst-if 'new #'(lambda (x) (eq x 'old)) 'not-old)
+ 'not-old)
+
+(equal (nsubst-if 'new #'(lambda (x) (equal x '(b)))
+ (copy-tree '(a ((b)))))
+ '(a (new)))
+
+(equal (nsubst-if 'x
+ #'(lambda (x) (eql x 3))
+ (copy-tree '(1 (1 2) (1 2 3) (1 2 3 4)))
+ :key #'(lambda (y) (and (listp y) (third y))))
+ '(1 (1 2) X X))
+
+(equal (nsubst-if 'x
+ #'(lambda (x) (equalp x "D"))
+ (copy-tree '("a" ("a" "b") ("a" "b" "c") ("a" "b" "c" "d")))
+ :key #'(lambda (y) (and (listp y) (fourth y))))
+ '("a" ("a" "b") ("a" "b" "c") X))
+
+
+(equal (nsubst-if-not 'new #'(lambda (x) (not (eq x 'old)))
+ (list 'old 'old))
+ '(new new))
+
+(eq (nsubst-if-not 'new #'(lambda (x) (not (eq x 'old))) 'old) 'new)
+
+(let* ((x (copy-tree '(old (old) ((old)) (old) old)))
+ (y (nsubst-if-not 'new #'(lambda (x) (not (eq x 'old))) x)))
+ (and (eq x y)
+ (equal x '(new (new) ((new)) (new) new))))
+
+(equal (nsubst-if-not 'x #'(lambda (x) (not (eql x 3)))
+ (copy-tree '(1 (1 2) (1 2 3) (1 2 3 4)))
+ :key #'(lambda (y) (and (listp y) (third y))))
+ '(1 (1 2) x x))
+
+(let ((tree '(old (old) ((old)))))
+ (equal (nsubst-if-not 'new #'(lambda (x) (not (eq x 'old))) (copy-tree tree))
+ '(new (new) ((new)))))
+
+(eq (nsubst-if-not 'new #'(lambda (x) (not (eq x 'old))) 'old)
+ 'new)
+
+(eq (nsubst-if-not 'new #'(lambda (x) (not (eq x 'old))) 'not-old)
+ 'not-old)
+
+(equal (nsubst-if-not 'new #'(lambda (x) (not (equal x '(b))))
+ (copy-tree '(a ((b)))))
+ '(a (new)))
+
+(equal (nsubst-if-not 'x
+ #'(lambda (x) (not (eql x 3)))
+ (copy-tree '(1 (1 2) (1 2 3) (1 2 3 4)))
+ :key #'(lambda (y) (and (listp y) (third y))))
+ '(1 (1 2) X X))
+
+(equal
+ (nsubst-if-not 'x
+ #'(lambda (x) (not (equalp x "D")))
+ (copy-tree '("a" ("a" "b") ("a" "b" "c") ("a" "b" "c" "d")))
+ :key #'(lambda (y) (and (listp y) (fourth y))))
+ '("a" ("a" "b") ("a" "b" "c") X))
+
+
+
+(tree-equal 'a 'a)
+
+(not (tree-equal 'a 'b))
+
+(tree-equal '(a (b (c))) '(a (b (c))))
+
+(tree-equal '(a (b (c))) '(a (b (c))) :test #'eq)
+
+(tree-equal '(a (b (c))) '(a (b (c))) :test-not (complement #'eq))
+
+(not (tree-equal '("a" ("b" ("c"))) '("a" ("b" ("c")))))
+
+(tree-equal '("a" ("b" ("c"))) '("a" ("b" ("c"))) :test #'equal)
+
+(tree-equal '("a" ("b" ("c"))) '("a" ("b" ("c")))
+ :test-not (complement #'equal))
+
+(not (tree-equal '(a b) '(a (b))))
+
+
+(eq (copy-list '()) '())
+
+(equal (copy-list '(a b c))
+ '(a b c))
+
+(equal (copy-list '(a . b)) '(a . b))
+
+(let* ((x '(a b c))
+ (y (copy-list x)))
+ (and (equal x y)
+ (not (eq x y))))
+
+(let* ((a (list 'a))
+ (b (list 'b))
+ (c (list 'c))
+ (x (list a b c))
+ (y (copy-list x)))
+ (and (equal x y)
+ (not (eq x y))
+ (eq (car x) (car y))
+ (eq (cadr x) (cadr y))
+ (eq (caddr x) (caddr y))
+ (eq (caar x) 'a)
+ (eq (caadr x) 'b)
+ (eq (caaddr x) 'c)))
+
+
+(null (list))
+
+(equal (list 1) '(1))
+
+(equal (list 1 2 3) '(1 2 3))
+
+(equal (list* 1 2 '(3)) '(1 2 3))
+
+(equal (list* 1 2 'x) '(1 2 . x))
+
+(equal (list* 1 2 '(3 4)) '(1 2 3 4))
+
+(eq (list* 'x) 'x)
+
+
+(eql (list-length '()) 0)
+
+(eql (list-length '(1)) 1)
+
+(eql (list-length '(1 2)) 2)
+
+(null (list-length '#1=(1 2 3 4 . #1#)))
+
+
+(equal (make-list 5) '(nil nil nil nil nil))
+
+(equal (make-list 3 :initial-element 'rah) '(rah rah rah))
+
+(equal (make-list 2 :initial-element '(1 2 3)) '((1 2 3) (1 2 3)))
+
+(null (make-list 0))
+
+(null (make-list 0 :initial-element 'new-element))
+
+
+(let ((place nil))
+ (and (equal (push 0 place) '(0))
+ (equal place '(0))))
+
+(let ((place (list 1 2 3)))
+ (and (equal (push 0 place) '(0 1 2 3))
+ (equal place '(0 1 2 3))))
+
+(let ((a (list (list 1 2 3) 9)))
+ (and (equal (push 0 (car a)) '(0 1 2 3))
+ (equal a '((0 1 2 3) 9))))
+
+(let ((x (copy-tree '(a (b c) d))))
+ (and (equal (push 'aa (cadr x)) '(aa b c))
+ (equal x '(a (aa b c) d))))
+
+
+(let ((place (list 1 2 3)))
+ (and (eql (pop place) 1)
+ (equal place '(2 3))))
+
+(let ((place '()))
+ (and (eql (pop place) nil)
+ (equal place '())))
+
+(let ((a (list (list 1 2 3) 9)))
+ (and (eql (pop (car a)) 1)
+ (equal a '((2 3) 9))))
+
+(let ((x (list 'a 'b 'c)))
+ (and (eq (pop (cdr x)) 'b)
+ (equal x '(a c))))
+
+
+(eq (first '(a . b)) 'a)
+
+(null (first nil))
+
+(let ((a (cons 1 2)))
+ (eq (first (list a)) a))
+
+(eq (first '#1=(a . #1#)) 'a)
+
+(eql (first '(1 2 3)) '1)
+(eql (second '(1 2 3)) '2)
+(eql (third '(1 2 3)) '3)
+(eql (fourth '(1 2 3 4)) '4)
+(eql (fifth '(1 2 3 4 5)) '5)
+(eql (sixth '(1 2 3 4 5 6)) '6)
+(eql (seventh '(1 2 3 4 5 6 7)) '7)
+(eql (eighth '(1 2 3 4 5 6 7 8)) '8)
+(eql (ninth '(1 2 3 4 5 6 7 8 9)) '9)
+(eql (tenth '(1 2 3 4 5 6 7 8 9 10)) '10)
+
+
+(let ((x (list 'a 'b 'c)))
+ (and (eql (setf (first x) 0) 0)
+ (equal x '(0 b c))))
+
+(let ((x (list 'a 'b 'c)))
+ (and (eql (setf (second x) 0) 0)
+ (equal x '(a 0 c))))
+
+(let ((x (list 'a 'b 'c)))
+ (and (eql (setf (third x) 0) 0)
+ (equal x '(a b 0))))
+
+(let ((x (list 'a 'b 'c 'd)))
+ (and (eql (setf (fourth x) 0) 0)
+ (equal x '(a b c 0))))
+
+(let ((x (list 'a 'b 'c 'd 'e)))
+ (and (eql (setf (fifth x) 0) 0)
+ (equal x '(a b c d 0))))
+
+(let ((x (list 'a 'b 'c 'd 'e 'f)))
+ (and (eql (setf (sixth x) 0) 0)
+ (equal x '(a b c d e 0))))
+
+(let ((x (list 'a 'b 'c 'd 'e 'f 'g)))
+ (and (eql (setf (seventh x) 0) 0)
+ (equal x '(a b c d e f 0))))
+
+(let ((x (list 'a 'b 'c 'd 'e 'f 'g 'h)))
+ (and (eql (setf (eighth x) 0) 0)
+ (equal x '(a b c d e f g 0))))
+
+(let ((x (list 'a 'b 'c 'd 'e 'f 'g 'h 'i)))
+ (and (eql (setf (ninth x) 0) 0)
+ (equal x '(a b c d e f g h 0))))
+
+(let ((x (list 'a 'b 'c 'd 'e 'f 'g 'h 'i 'j)))
+ (and (eql (setf (tenth x) 0) 0)
+ (equal x '(a b c d e f g h i 0))))
+
+
+(let ((x '(a b c)))
+ (eq (nthcdr 0 x) x))
+
+(let ((x '(a b c)))
+ (eq (nthcdr 1 x) (cdr x)))
+
+(let ((x '(a b c)))
+ (eq (nthcdr 2 x) (cddr x)))
+
+(let ((x '(a b c)))
+ (eq (nthcdr 2 x) (cddr x)))
+
+(let ((x '(a b c)))
+ (eq (nthcdr 3 x) (cdddr x)))
+
+(equal (nthcdr 0 '(0 1 2)) '(0 1 2))
+(equal (nthcdr 1 '(0 1 2)) '(1 2))
+(equal (nthcdr 2 '(0 1 2)) '(2))
+(equal (nthcdr 3 '(0 1 2)) '())
+
+(eql (nthcdr 1 '(0 . 1)) 1)
+
+(eql (nth 0 '(a b c)) 'a)
+(eql (nth 1 '(a b c)) 'b)
+(eql (nth 2 '(a b c)) 'c)
+(eql (nth 3 '(a b c)) '())
+(eql (nth 4 '(a b c)) '())
+(eql (nth 5 '(a b c)) '())
+(eql (nth 6 '(a b c)) '())
+
+(eq (nth 0 '(a . b)) 'a)
+
+(let ((x (list 'a 'b 'c)))
+ (and (eq (setf (nth 0 x) 'z) 'z)
+ (equal x '(z b c))))
+
+(let ((x (list 'a 'b 'c)))
+ (and (eq (setf (nth 1 x) 'z) 'z)
+ (equal x '(a z c))))
+
+(let ((x (list 'a 'b 'c)))
+ (and (eq (setf (nth 2 x) 'z) 'z)
+ (equal x '(a b z))))
+
+(let ((0-to-3 (list 0 1 2 3)))
+ (and (equal (setf (nth 2 0-to-3) "two") "two")
+ (equal 0-to-3 '(0 1 "two" 3))))
+
+
+(eq (nconc) '())
+(equal (nconc nil (list 'a 'b 'c) (list 'd 'e 'f))
+ '(a b c d e f))
+
+(equal (nconc nil nil (list 'a 'b 'c) (list 'd 'e 'f))
+ '(a b c d e f))
+
+(equal (nconc nil nil nil (list 'a 'b 'c) (list 'd 'e 'f))
+ '(a b c d e f))
+
+
+(let* ((x (list 'a 'b 'c)))
+ (eq (nconc x) x))
+
+(let* ((x (list 'a 'b 'c))
+ (y (list 'd 'e 'f))
+ (list (nconc x y)))
+ (and (eq list x)
+ (eq (nthcdr 3 list) y)
+ (equal list '(a b c d e f))))
+
+(let* ((x (list 'a))
+ (y (list 'b))
+ (z (list 'c))
+ (list (nconc x y z)))
+ (and (eq x list)
+ (eq (first list) 'a)
+ (eq y (cdr list))
+ (eq (second list) 'b)
+ (eq z (cddr list))
+ (eq (third list) 'c)))
+
+(equal (append '(a b) '() '(c d) '(e f))
+ '(a b c d e f))
+
+(null (append))
+(null (append '()))
+(null (append '() '()))
+
+(eq (append 'a) 'a)
+
+(eq (append '() 'a) 'a)
+
+(eq (append '() '() 'a) 'a)
+
+
+(equal (append '(a b) 'c) '(a b . c))
+
+(let* ((x '(a b c))
+ (y '(d e f))
+ (z (append x y)))
+ (and (equal z '(a b c d e f))
+ (eq (nthcdr 3 z) y)
+ (not (eq x z))))
+
+
+(equal (revappend '(a b c) '(d e f))
+ '(c b a d e f))
+
+(let* ((x '(a b c))
+ (y '(d e f))
+ (z (revappend x y)))
+ (and (equal z '(c b a d e f))
+ (not (eq x z))
+ (eq (nthcdr 3 z) y)))
+
+(let ((x '(a b c)))
+ (eq (revappend '() x) x))
+
+(null (revappend '() '()))
+
+(eq (revappend '() 'a) 'a)
+
+(equal (revappend '(a) 'b) '(a . b))
+
+(equal (revappend '(a) '()) '(a))
+
+(equal (revappend '(1 2 3) '()) '(3 2 1))
+
+
+(equal (nreconc (list 'a 'b 'c) '(d e f))
+ '(c b a d e f))
+
+(let* ((x (list 'a 'b 'c))
+ (y '(d e f))
+ (z (nreconc x y)))
+ (and (equal z '(c b a d e f))
+ (eq (nthcdr 3 z) y)))
+
+(let ((x (list 'a 'b 'c)))
+ (eq (nreconc '() x) x))
+
+(null (nreconc '() '()))
+
+(eq (nreconc '() 'a) 'a)
+
+(equal (nreconc (list 'a) 'b) '(a . b))
+
+(equal (nreconc (list 'a) '()) '(a))
+
+(equal (nreconc (list 1 2 3) '()) '(3 2 1))
+
+
+(null (butlast nil))
+(null (butlast nil 1))
+(null (butlast nil 2))
+(null (butlast nil 3))
+(equal (butlast '(1 2 3 4 5)) '(1 2 3 4))
+(equal (butlast '(1 2 3 4 5) 1) '(1 2 3 4))
+(equal (butlast '(1 2 3 4 5) 2) '(1 2 3))
+(equal (butlast '(1 2 3 4 5) 3) '(1 2))
+(equal (butlast '(1 2 3 4 5) 4) '(1))
+(equal (butlast '(1 2 3 4 5) 5) '())
+(equal (butlast '(1 2 3 4 5) 6) '())
+(equal (butlast '(1 2 3 4 5) 7) '())
+
+(equal (butlast '(1 2 3 4 5 . 6)) '(1 2 3 4))
+(equal (butlast '(1 2 3 4 5 . 6) 1) '(1 2 3 4))
+(equal (butlast '(1 2 3 4 5 . 6) 2) '(1 2 3))
+(equal (butlast '(1 2 3 4 5 . 6) 3) '(1 2))
+(equal (butlast '(1 2 3 4 5 . 6) 4) '(1))
+(equal (butlast '(1 2 3 4 5 . 6) 5) '())
+(equal (butlast '(1 2 3 4 5 . 6) 6) '())
+(equal (butlast '(1 2 3 4 5 . 6) 7) '())
+
+(let ((a '(1 2 3 4 5)))
+ (equal (butlast a 3) '(1 2))
+ (equal a '(1 2 3 4 5)))
+
+
+(null (nbutlast nil))
+(null (nbutlast nil 1))
+(null (nbutlast nil 2))
+(null (nbutlast nil 3))
+(equal (nbutlast (list 1 2 3 4 5)) '(1 2 3 4))
+(equal (nbutlast (list 1 2 3 4 5) 1) '(1 2 3 4))
+(equal (nbutlast (list 1 2 3 4 5) 2) '(1 2 3))
+(equal (nbutlast (list 1 2 3 4 5) 3) '(1 2))
+(equal (nbutlast (list 1 2 3 4 5) 4) '(1))
+(equal (nbutlast (list 1 2 3 4 5) 5) '())
+(equal (nbutlast (list 1 2 3 4 5) 6) '())
+(equal (nbutlast (list 1 2 3 4 5) 7) '())
+
+(equal (nbutlast (list* 1 2 3 4 5 6)) '(1 2 3 4))
+(equal (nbutlast (list* 1 2 3 4 5 6) 1) '(1 2 3 4))
+(equal (nbutlast (list* 1 2 3 4 5 6) 2) '(1 2 3))
+(equal (nbutlast (list* 1 2 3 4 5 6) 3) '(1 2))
+(equal (nbutlast (list* 1 2 3 4 5 6) 4) '(1))
+(equal (nbutlast (list* 1 2 3 4 5 6) 5) '())
+(equal (nbutlast (list* 1 2 3 4 5 6) 6) '())
+(equal (nbutlast (list* 1 2 3 4 5 6) 7) '())
+
+(let* ((a '(1 2 3 4 5))
+ (b (nbutlast a 3)))
+ (and (eq a b)
+ (equal a '(1 2))))
+
+
+(let ((x '(0 1 2 3 4 5 6 7 8 9)))
+ (eq (last x) (nthcdr 9 x)))
+
+(null (last nil))
+
+(let ((x '(0 1 . 2)))
+ (eq (last x) (cdr x)))
+
+(eql (last '(1 . 2) 0) 2)
+
+(let ((x '(0 1 2 3 4)))
+ (eq (last x 0) nil))
+
+(let ((x '(0 1 2 3 4)))
+ (eq (last x) (nthcdr 4 x)))
+
+(let ((x '(0 1 2 3 4)))
+ (eq (last x 1) (nthcdr 4 x)))
+
+(let ((x '(0 1 2 3 4)))
+ (eq (last x 2) (cdddr x)))
+
+(let ((x '(0 1 2 3 4)))
+ (eq (last x 3) (cddr x)))
+
+(let ((x '(0 1 2 3 4)))
+ (eq (last x 4) (cdr x)))
+
+(let ((x '(0 1 2 3 4)))
+ (eq (last x 5) x))
+
+(let ((x '(0 1 2 3 4)))
+ (eq (last x 6) x))
+
+(let ((x '(0 1 2 3 4)))
+ (eq (last x 7) x))
+
+(let ((x '(0 1 2 3 4)))
+ (eq (last x 8) x))
+
+
+(tailp '() '())
+
+(tailp '() '(1))
+
+(tailp '() '(1 2 3 4 5 6 7 8 9))
+
+(let ((x '(1 2 3)))
+ (and (tailp x x)
+ (tailp (cdr x) x)
+ (tailp (cddr x) x)
+ (tailp (cdddr x) x)))
+
+(let ((x '(1 . 2)))
+ (and (tailp x x)
+ (tailp (cdr x) x)))
+
+(not (tailp nil '(1 . 2)))
+
+(not (tailp 'x '(1 2 3 4 5 6)))
+
+(not (tailp (list 1 2 3) '(1 2 3)))
+
+(let ((x '(1 2 3 4 5 . 6)))
+ (tailp (last x) x))
+
+(let ((x '(1 2 3 4 5 . 6)))
+ (tailp (last x) x))
+
+
+(null (ldiff '() '()))
+
+(equal (ldiff '(1 . 2) 2) '(1))
+
+(equal (ldiff '(1 2 3 4 5 6 7 8 9) '())
+ '(1 2 3 4 5 6 7 8 9))
+
+(let ((x '(1 2 3)))
+ (and (null (ldiff x x))
+ (equal (ldiff x (cdr x)) '(1))
+ (equal (ldiff x (cddr x)) '(1 2))
+ (equal (ldiff x (cdddr x)) '(1 2 3))))
+
+(let* ((x '(1 2 3))
+ (y '(a b c))
+ (z (ldiff x y)))
+ (and (not (eq x z))
+ (equal z '(1 2 3))))
+
+(equal (member 'a '(a b c d)) '(a b c d))
+(equal (member 'b '(a b c d)) '(b c d))
+(equal (member 'c '(a b c d)) '(c d))
+(equal (member 'd '(a b c d)) '(d))
+(equal (member 'e '(a b c d)) '())
+(equal (member 'f '(a b c d)) '())
+
+(let ((x '(a b c d)))
+ (eq (member 'a x) x)
+ (eq (member 'b x) (cdr x))
+ (eq (member 'c x) (cddr x))
+ (eq (member 'd x) (cdddr x))
+ (eq (member 'e x) nil))
+
+
+(equal (member 'a '(a b c d) :test #'eq) '(a b c d))
+(equal (member 'b '(a b c d) :test #'eq) '(b c d))
+(equal (member 'c '(a b c d) :test #'eq) '(c d))
+(equal (member 'd '(a b c d) :test #'eq) '(d))
+(equal (member 'e '(a b c d) :test #'eq) '())
+(equal (member 'f '(a b c d) :test #'eq) '())
+
+(null (member 'a '()))
+
+(let* ((x '((1 . a) (2 . b) (3 . c) (4 . d) (5 . e)))
+ (y (member 'd x :key #'cdr :test #'eq)))
+ (and (equal y '((4 . d) (5 . e)))
+ (eq y (nthcdr 3 x))))
+
+(let* ((x '((1 . a) (2 . b) (3 . c) (4 . d) (5 . e)))
+ (y (member 'd x :key #'cdr)))
+ (and (equal y '((4 . d) (5 . e)))
+ (eq y (nthcdr 3 x))))
+
+(let* ((x '((1 . a) (2 . b) (3 . c) (4 . d) (5 . e)))
+ (y (member 'd x :key #'cdr :test-not (complement #'eq))))
+ (and (equal y '((4 . d) (5 . e)))
+ (eq y (nthcdr 3 x))))
+
+(let* ((x '((1 . a) (2 . b) (3 . c) (4 . d) (5 . e)))
+ (y (member 'd x :test-not (complement #'eq))))
+ (eq y nil))
+
+(equal (member 2 '((1 . 2) (3 . 4)) :test-not #'= :key #'cdr)
+ '((3 . 4)))
+
+(equal (member-if #'(lambda (x) (eql x 'a)) '(a b c d)) '(a b c d))
+(equal (member-if #'(lambda (x) (eql x 'b)) '(a b c d)) '(b c d))
+(equal (member-if #'(lambda (x) (eql x 'c)) '(a b c d)) '(c d))
+(equal (member-if #'(lambda (x) (eql x 'd)) '(a b c d)) '(d))
+(equal (member-if #'(lambda (x) (eql x 'e)) '(a b c d)) '())
+(equal (member-if #'(lambda (x) (eql x 'f)) '(a b c d)) '())
+
+(null (member-if #'(lambda (x) (eql x 'a)) '()))
+
+(let* ((x '((1 . a) (2 . b) (3 . c) (4 . d) (5 . e)))
+ (y (member-if #'(lambda (p) (eq p 'd)) x :key #'cdr)))
+ (and (equal y '((4 . d) (5 . e)))
+ (eq y (nthcdr 3 x))))
+
+(equal (member-if #'cdr '((1) (2 . 2) (3 3 . 3)))
+ '((2 . 2) (3 3 . 3)))
+
+(null (member-if #'zerop '(7 8 9)))
+
+
+(equal (member-if-not #'(lambda (x) (not (eql x 'a))) '(a b c d)) '(a b c d))
+(equal (member-if-not #'(lambda (x) (not (eql x 'b))) '(a b c d)) '(b c d))
+(equal (member-if-not #'(lambda (x) (not (eql x 'c))) '(a b c d)) '(c d))
+(equal (member-if-not #'(lambda (x) (not (eql x 'd))) '(a b c d)) '(d))
+(equal (member-if-not #'(lambda (x) (not (eql x 'e))) '(a b c d)) '())
+(equal (member-if-not #'(lambda (x) (not (eql x 'f))) '(a b c d)) '())
+
+(null (member-if-not #'(lambda (x) (not (eql x 'a))) '()))
+
+(let* ((x '((1 . a) (2 . b) (3 . c) (4 . d) (5 . e)))
+ (y (member-if-not #'(lambda (p) (not (eq p 'd))) x :key #'cdr)))
+ (and (equal y '((4 . d) (5 . e)))
+ (eq y (nthcdr 3 x))))
+
+
+(let ((x '((1 2) (2 3) (3 4) (4 5)))
+ (y nil))
+ (and (eq (mapc #'(lambda (a) (push (car a) y)) x) x)
+ (equal y '(4 3 2 1))))
+
+(let ((dummy nil)
+ (list-1 '(1 2 3 4)))
+ (and (eq (mapc #'(lambda (&rest x) (setq dummy (append dummy x)))
+ list-1
+ '(a b c d e)
+ '(x y z))
+ list-1)
+ (equal dummy '(1 a x 2 b y 3 c z))))
+
+(let* ((x '(0 1 2 3))
+ (y nil)
+ (z (mapc #'(lambda (a b c) (push (list a b c) y))
+ x '(1 2 3 4) '(2 3 4 5))))
+ (and (eq z x)
+ (equal y '((3 4 5) (2 3 4) (1 2 3) (0 1 2)))))
+
+
+(let* ((x '(0 1 2 3))
+ (y nil)
+ (z (mapc #'(lambda (a b c) (push (list a b c) y))
+ nil x '(1 2 3 4) '(2 3 4 5))))
+ (and (null z)
+ (null y)))
+
+(let ((sum 0))
+ (mapc #'(lambda (&rest rest) (setq sum (+ sum (apply #'+ rest))))
+ '(0 1 2)
+ '(1 2 0)
+ '(2 0 1))
+ (eql sum 9))
+
+(let ((result 'initial-value)
+ (list-1 nil))
+ (and (eq (mapc #'(lambda (a b) (setq result (cons (cons a b) result))) list-1) list-1)
+ (eq result 'initial-value)))
+
+(let ((result 'initial-value)
+ (list-1 nil))
+ (and (eq (mapc #'(lambda (a b) (setq result (cons (cons a b) result)))
+ list-1
+ '(1 2 3))
+ list-1)
+ (eq result 'initial-value)))
+
+(let ((result 'initial-value)
+ (list-1 '(1 2 3)))
+ (and (eq (mapc #'(lambda (a b) (setq result (cons (cons a b) result)))
+ list-1
+ '())
+ list-1)
+ (eq result 'initial-value)))
+
+
+(equal (mapcar #'car '((1 2) (2 3) (3 4) (4 5)))
+ '(1 2 3 4))
+
+(null (mapcar #'identity '()))
+
+(equal (mapcar #'list '(0 1 2 3) '(a b c d) '(w x y z))
+ '((0 a w) (1 b x) (2 c y) (3 d z)))
+
+(null (mapcar #'list '() '(0 1 2 3) '(1 2 3 4) '(2 3 4 5)))
+(null (mapcar #'list '(0 1 2 3) '() '(1 2 3 4) '(2 3 4 5)))
+(null (mapcar #'list '(0 1 2 3) '(1 2 3 4) '() '(2 3 4 5)))
+(null (mapcar #'list '(0 1 2 3) '(1 2 3 4) '(2 3 4 5) '()))
+
+(equal (mapcar #'list '(0) '(a b) '(x y z)) '((0 a x)))
+(equal (mapcar #'list '(a b) '(0) '(x y z)) '((a 0 x)))
+(equal (mapcar #'list '(a b) '(x y z) '(0)) '((a x 0)))
+
+(equal (mapcar #'cons '(a b c) '(1 2 3))
+ '((A . 1) (B . 2) (C . 3)))
+
+
+(equal (mapcan #'cdr (copy-tree '((1 2) (2 3) (3 4) (4 5))))
+ '(2 3 4 5))
+
+(equal (mapcan #'append
+ '((1 2 3) (4 5 6) (7 8 9))
+ '((a) (b c) (d e f))
+ (list (list 'x 'y 'z) (list 'y 'z) (list 'z)))
+ '(1 2 3 a x y z 4 5 6 b c y z 7 8 9 d e f z))
+
+(null (mapcan #'append '((1 2 3) (4 5 6) (7 8 9)) '((a) (b c)) '()))
+(null (mapcan #'append '((1 2 3) (4 5 6) (7 8 9)) '() '((a) (b c))))
+(null (mapcan #'append '() '((1 2 3) (4 5 6) (7 8 9)) '((a) (b c))))
+
+(equal (mapcan #'list
+ (list 1 2 3 4 5)
+ (list 2 3 4 5 6)
+ (list 3 4 5 6 7)
+ (list 4 5 6 7 8))
+ '(1 2 3 4 2 3 4 5 3 4 5 6 4 5 6 7 5 6 7 8))
+
+(equal (mapcan #'(lambda (x y) (if (null x) nil (list x y)))
+ '(nil nil nil d e)
+ '(1 2 3 4 5 6))
+ '(d 4 e 5))
+
+(equal (mapcan #'(lambda (x) (and (numberp x) (list x)))
+ '(a 1 b c 3 4 d 5))
+ '(1 3 4 5))
+
+
+(equal (maplist #'identity '(a b c d))
+ '((a b c d) (b c d) (c d) (d)))
+
+(equal (maplist #'car '((1 2) (2 3) (3 4) (4 5)))
+ '((1 2) (2 3) (3 4) (4 5)))
+
+(equal (maplist #'list '(a b c) '(b c d) '(c d e))
+ '(((a b c) (b c d) (c d e))
+ ((b c) (c d) (d e))
+ ((c) (d) (e))))
+
+(equal (maplist #'append '(a b c) '(b c d) '(c d e))
+ '((a b c b c d c d e) (b c c d d e) (c d e)))
+
+(equal (maplist #'append '(a b c) '(b c) '(c))
+ '((a b c b c c)))
+
+(null (maplist #'append '() '(a b c) '(b c) '(c)))
+(null (maplist #'append '(a b c) '() '(b c) '(c)))
+(null (maplist #'append '(a b c) '(b c) '(c) '()))
+
+(let ((x '((1 2) (2 3) (3 4) (4 5)))
+ (y nil))
+ (and (eq (mapl #'(lambda (a) (push (car a) y)) x) x)
+ (equal y '((4 5) (3 4) (2 3) (1 2)))))
+
+(let ((x nil))
+ (and (null (mapl #'(lambda (&rest rest) (push rest x)) '() '(0) '(0 1)))
+ (null x)))
+
+(let ((x nil))
+ (and (equal (mapl #'(lambda (&rest rest) (push rest x)) '(0) '() '(0 1))
+ '(0))
+ (null x)))
+
+(let ((x nil))
+ (and (equal (mapl #'(lambda (&rest rest) (push rest x)) '(0) '(0 1) '())
+ '(0))
+ (null x)))
+
+(equal (mapcon #'car (copy-tree '((1 2) (2 3) (3 4) (4 5))))
+ '(1 2 2 3 3 4 4 5))
+
+
+(equal (mapcon #'list '(0 1 2 3) '(1 2 3 4) '(2 3 4 5) '(3 4 5 6))
+ '((0 1 2 3) (1 2 3 4) (2 3 4 5) (3 4 5 6) (1 2 3) (2 3 4) (3 4 5)
+ (4 5 6) (2 3) (3 4) (4 5) (5 6) (3) (4) (5) (6)))
+
+
+(null (mapcon #'list '() '(0 1 2 3) '(1 2 3 4) '(2 3 4 5) '(3 4 5 6)))
+(null (mapcon #'list '(0 1 2 3) '() '(1 2 3 4) '(2 3 4 5) '(3 4 5 6)))
+(null (mapcon #'list '(0 1 2 3) '(1 2 3 4) '() '(2 3 4 5) '(3 4 5 6)))
+(null (mapcon #'list '(0 1 2 3) '(1 2 3 4) '(2 3 4 5) '() '(3 4 5 6)))
+(null (mapcon #'list '(0 1 2 3) '(1 2 3 4) '(2 3 4 5) '(3 4 5 6) '()))
+
+
+(let* ((x '((apple . 1) (orange . 2) (grapes . 3)))
+ (y (acons 'plum 9 x)))
+ (and (equal y '((plum . 9) (apple . 1) (orange . 2) (grapes . 3)))
+ (eq x (cdr y))))
+
+(equal (acons 'a '0 nil) '((a . 0)))
+
+(equal (acons 'apple 1 (acons 'orange 2 (acons 'grapes '3 nil)))
+ '((apple . 1) (orange . 2) (grapes . 3)))
+
+(equal (acons nil nil nil) '((nil)))
+
+
+(let ((alist '((x . 100) (y . 200) (z . 50))))
+ (eq (assoc 'y alist) (cadr alist)))
+
+(null (assoc 'no-such-key '((x . 100) (y . 200) (z . 50))))
+
+(let ((alist '((x . 100) (y . 200) (z . 50))))
+ (eq (assoc 'y alist :test #'eq) (cadr alist)))
+
+(null (assoc 'key '()))
+(null (assoc 'nil '(())))
+(null (assoc 'nil '(() ())))
+(let ((alist '(nil nil nil (x . 100) (y . 200) (z . 50))))
+ (eq (assoc 'y alist) (car (cddddr alist))))
+(let ((alist '((1 . a) nil (2 . b) (nil))))
+ (eq (assoc 'nil alist) (cadddr alist)))
+
+(let ((alist '((x . 100) (y . 200) (x . 100) (z . 50))))
+ (eq (assoc 'y alist) (cadr alist)))
+
+(let ((alist '((a . 1) (b . 2) (c . 3) (d . 4))))
+ (eq (assoc 'a alist :test-not (complement #'eq)) (car alist)))
+
+(let ((alist '((a . 1) (b . 2) (c . 3) (d . 4))))
+ (null (assoc 'z alist :test-not (complement #'eq))))
+
+(let ((alist '(((a aa aaa)) ((b bb bbb)) ((c cc ccc)) ((d dd ddd)))))
+ (eq (assoc 'aa alist :key #'cadr :test #'eq) (car alist)))
+
+(let ((alist '(((a aa aaa)) ((b bb bbb)) ((c cc ccc)) ((d dd ddd)))))
+ (eq (assoc 'bb alist :key #'cadr :test #'eq) (cadr alist)))
+
+(let ((alist '(((a aa aaa)) ((b bb bbb)) ((c cc ccc)) ((d dd ddd)))))
+ (eq (assoc 'cc alist :key #'cadr :test #'eq) (caddr alist)))
+
+(let ((alist '(((a aa aaa)) ((b bb bbb)) ((c cc ccc)) ((d dd ddd)))))
+ (eq (assoc 'dd alist :key #'cadr :test #'eq) (cadddr alist)))
+
+(let ((alist '(((a aa aaa)) ((b bb bbb)) ((c cc ccc)) ((d dd ddd)))))
+ (null (assoc 'ee alist :key #'cadr :test #'eq)))
+
+(let ((alist '(((a aa aaa)) nil ((b bb bbb)) ((c cc ccc)) ((d dd ddd)))))
+ (eq (assoc 'dd alist :key #'cadr :test #'eq) (car (cddddr alist))))
+
+(let ((alist '(((a aa aaa)) ((b bb bbb)) nil ((c cc ccc)) ((d dd ddd)))))
+ (eq (assoc 'dd alist :key #'cadr :test #'eq) (car (cddddr alist))))
+
+(let ((alist '(((a aa aaa)) nil ((b bb bbb)) ((c cc ccc)) ((d dd ddd)))))
+ (eq (assoc 'dd alist :key #'cadr :test #'eq) (car (cddddr alist))))
+
+(let ((alist '(((a aa aaa)) ((b bb bbb)) ((c cc ccc)) ((d dd ddd)) nil)))
+ (eq (assoc 'dd alist :key #'cadr :test #'eq) (cadddr alist)))
+
+
+
+(let ((alist '((x . 100) (y . 200) (z . 50))))
+ (eq (assoc-if #'(lambda (arg) (eq arg 'y)) alist) (cadr alist)))
+
+(null (assoc-if #'consp '((x . 100) (y . 200) (z . 50))))
+
+(null (assoc-if #'(lambda (x) (eq x 'key)) '()))
+(null (assoc-if #'identity '(())))
+(null (assoc-if #'identity '(() ())))
+(let ((alist '(nil nil nil (x . 100) (y . 200) (z . 50))))
+ (eq (assoc-if #'(lambda (arg) (eq arg 'y)) alist) (car (cddddr alist))))
+(let ((alist '((1 . a) nil (2 . b) (nil))))
+ (eq (assoc-if #'(lambda (arg) (null arg)) alist) (cadddr alist)))
+
+
+(let ((alist '(((a aa aaa)) ((b bb bbb)) ((c cc ccc)) ((d dd ddd)))))
+ (eq (assoc-if #'(lambda (x) (eq x 'aa)) alist :key #'cadr) (car alist)))
+
+(let ((alist '(((a aa aaa)) ((b bb bbb)) ((c cc ccc)) ((d dd ddd)))))
+ (eq (assoc-if #'(lambda (x) (eq x 'bb)) alist :key #'cadr) (cadr alist)))
+
+(let ((alist '(((a aa aaa)) ((b bb bbb)) ((c cc ccc)) ((d dd ddd)))))
+ (null (assoc-if #'(lambda (x) (eq x 'ee)) alist :key #'cadr)))
+
+
+
+(let ((alist '((x . 100) (y . 200) (z . 50))))
+ (eq (assoc-if-not #'(lambda (arg) (not (eq arg 'y))) alist) (cadr alist)))
+
+(null (assoc-if-not (complement #'consp) '((x . 100) (y . 200) (z . 50))))
+
+(null (assoc-if-not #'(lambda (x) (not (eq x 'key))) '()))
+(null (assoc-if-not #'identity '(())))
+(null (assoc-if-not #'identity '(() ())))
+(let ((alist '(nil nil nil (x . 100) (y . 200) (z . 50))))
+ (eq (assoc-if-not #'(lambda (arg) (not (eq arg 'y))) alist)
+ (car (cddddr alist))))
+(let ((alist '((1 . a) nil (2 . b) (nil))))
+ (eq (assoc-if-not #'identity alist) (cadddr alist)))
+
+(let ((alist '(((a aa aaa)) ((b bb bbb)) ((c cc ccc)) ((d dd ddd)))))
+ (eq (assoc-if-not #'(lambda (x) (not (eq x 'aa))) alist :key #'cadr)
+ (car alist)))
+
+(let ((alist '(((a aa aaa)) ((b bb bbb)) ((c cc ccc)) ((d dd ddd)))))
+ (eq (assoc-if-not #'(lambda (x) (not (eq x 'bb))) alist :key #'cadr)
+ (cadr alist)))
+
+(let ((alist '(((a aa aaa)) ((b bb bbb)) ((c cc ccc)) ((d dd ddd)))))
+ (null (assoc-if-not #'(lambda (x) (not (eq x 'ee))) alist :key #'cadr)))
+
+
+(equal (copy-alist '((a . 10) (b . 100) (c . 1000)))
+ '((a . 10) (b . 100) (c . 1000)))
+
+(let* ((alist '((a . 10) (b . 100) (c . 1000)))
+ (copy (copy-alist alist)))
+ (and (not (eq alist copy))
+ (not (eq (cdr alist) (cdr copy)))
+ (not (eq (cddr alist) (cddr copy)))
+ (not (eq (car alist) (car copy)))
+ (not (eq (cadr alist) (cadr copy)))
+ (not (eq (caddr alist) (caddr copy)))))
+
+(let* ((alist '((a 10 x) (b 100 y) (c 1000 z)))
+ (copy (copy-alist alist)))
+ (and (not (eq alist copy))
+ (not (eq (cdr alist) (cdr copy)))
+ (not (eq (cddr alist) (cddr copy)))
+ (not (eq (car alist) (car copy)))
+ (not (eq (cadr alist) (cadr copy)))
+ (not (eq (caddr alist) (caddr copy)))
+ (eq (cdar alist) (cdar copy))
+ (eq (cdadr alist) (cdadr copy))
+ (eq (cdaddr alist) (cdaddr copy))))
+
+
+(let* ((alist (pairlis '(x y z) '(xx yy zz) '((a . aa) (b . bb)))))
+ (and (equal (assoc 'x alist) '(x . xx))
+ (equal (assoc 'y alist) '(y . yy))
+ (equal (assoc 'z alist) '(z . zz))
+ (equal (assoc 'a alist) '(a . aa))
+ (equal (assoc 'b alist) '(b . bb))
+ (null (assoc 'key alist))))
+
+(let* ((alist (pairlis '(x y z) '(xx yy zz))))
+ (and (equal (assoc 'x alist) '(x . xx))
+ (equal (assoc 'y alist) '(y . yy))
+ (equal (assoc 'z alist) '(z . zz))
+ (null (assoc 'key alist))))
+
+
+(let ((alist '((x . 100) (y . 200) (z . 50))))
+ (eq (rassoc '200 alist) (cadr alist)))
+
+(null (rassoc 'no-such-datum '((x . 100) (y . 200) (z . 50))))
+
+(let ((alist '((x . 100) (y . 200) (z . 50))))
+ (eq (rassoc '200 alist :test #'=) (cadr alist)))
+
+(null (rassoc 'key '()))
+(null (rassoc 'nil '(())))
+(null (rassoc 'nil '(() ())))
+
+(let ((alist '(nil nil nil (x . 100) (y . 200) (z . 50))))
+ (eq (rassoc '200 alist) (car (cddddr alist))))
+(let ((alist '((1 . a) nil (2 . b) (nil))))
+ (eq (rassoc 'nil alist) (cadddr alist)))
+
+(let ((alist '((x . 100) (y . 200) (x . 100) (z . 50))))
+ (eq (rassoc '200 alist) (cadr alist)))
+
+(let ((alist '((a . 1) (b . 2) (c . 3) (d . 4))))
+ (eq (rassoc '1 alist :test-not (complement #'=)) (car alist)))
+
+(let ((alist '((a . 1) (b . 2) (c . 3) (d . 4))))
+ (null (rassoc '9 alist :test-not (complement #'=))))
+
+(let ((alist '((a aa aaa) (b bb bbb) (c cc ccc) (d dd ddd))))
+ (eq (rassoc 'aa alist :key #'car :test #'eq) (car alist)))
+
+(let ((alist '((a aa aaa) (b bb bbb) (c cc ccc) (d dd ddd))))
+ (eq (rassoc 'ddd alist :key #'cadr :test #'eq) (cadddr alist)))
+
+(let ((alist '((a aa aaa) (b bb bbb) (c cc ccc) (d dd ddd))))
+ (null (rassoc 'eee alist :key #'cadr :test #'eq)))
+
+(let ((alist '((a aa aaa) nil (b bb bbb) (c cc ccc) (d dd ddd))))
+ (eq (rassoc 'ddd alist :key #'cadr :test #'eq) (car (cddddr alist))))
+
+(let ((alist '((a aa aaa) (b bb bbb) nil (c cc ccc) (d dd ddd))))
+ (eq (rassoc 'ddd alist :key #'cadr :test #'eq) (car (cddddr alist))))
+
+(let ((alist '((a aa aaa) (b bb bbb) (c cc ccc) (d dd ddd) nil)))
+ (eq (rassoc 'ddd alist :key #'cadr :test #'eq) (car (cdddr alist))))
+
+(let ((alist '((x . 100) (y . 200) (z . 50))))
+ (eq (rassoc-if #'(lambda (arg) (= arg 200)) alist) (cadr alist)))
+
+(null (rassoc-if #'consp '((x . 100) (y . 200) (z . 50))))
+
+(null (rassoc-if #'(lambda (x) (eq x 'key)) '()))
+(null (rassoc-if #'identity '(())))
+(null (rassoc-if #'identity '(() ())))
+(let ((alist '(nil nil nil (x . 100) (y . 200) (z . 50))))
+ (eq (rassoc-if #'(lambda (arg) (= arg 200)) alist) (car (cddddr alist))))
+(let ((alist '((1 . a) nil (2 . b) (nil))))
+ (eq (rassoc-if #'(lambda (arg) (null arg)) alist) (cadddr alist)))
+
+(let ((alist '((a aa aaa) (b bb bbb) (c cc ccc) (d dd ddd))))
+ (eq (rassoc-if #'(lambda (x) (eq x 'aaa)) alist :key #'cadr) (car alist)))
+
+(let ((alist '((a aa aaa) (b bb bbb) (c cc ccc) (d dd ddd))))
+ (eq (rassoc-if #'(lambda (x) (eq x 'bbb)) alist :key #'cadr) (cadr alist)))
+
+(let ((alist '((a aa aaa) (b bb bbb) (c cc ccc) (d dd ddd))))
+ (null (rassoc-if #'(lambda (x) (eq x 'eee)) alist :key #'cadr)))
+
+
+(let ((alist '((x . 100) (y . 200) (z . 50))))
+ (eq (rassoc-if-not #'(lambda (arg) (not (= arg 200))) alist) (cadr alist)))
+
+(null (rassoc-if-not (complement #'consp) '((x . 100) (y . 200) (z . 50))))
+
+(null (rassoc-if-not #'(lambda (x) (not (eq x 'key))) '()))
+(null (rassoc-if-not #'identity '(())))
+(null (rassoc-if-not #'identity '(() ())))
+(let ((alist '(nil nil nil (x . 100) (y . 200) (z . 50))))
+ (eq (rassoc-if-not #'(lambda (arg) (not (= arg 200))) alist)
+ (car (cddddr alist))))
+(let ((alist '((1 . a) nil (2 . b) (nil))))
+ (eq (assoc-if-not #'identity alist) (cadddr alist)))
+
+(let ((alist '((a aa aaa) (b bb bbb) (c cc ccc) (d dd ddd))))
+ (eq (rassoc-if-not #'(lambda (x) (not (eq x 'aaa))) alist :key #'cadr)
+ (car alist)))
+
+(let ((alist '((a aa aaa) (b bb bbb) (c cc ccc) (d dd ddd))))
+ (eq (rassoc-if-not #'(lambda (x) (not (eq x 'bbb))) alist :key #'cadr)
+ (cadr alist)))
+
+(let ((alist '(((a aa aaa) . 0) ((b bb bbb) . 1) ((c cc ccc) . 2))))
+ (eq (rassoc-if-not #'(lambda (x) (not (= x '2))) alist :key #'1+)
+ (cadr alist)))
+
+
+(let ((plist '(prop1 1 prop2 2 prop3 3 prop4 4)))
+ (multiple-value-bind (indicator value tail)
+ (get-properties plist '(prop3 prop4 propX propY))
+ (and (eq indicator 'prop3)
+ (eql value 3)
+ (eq tail (nthcdr 4 plist)))))
+
+(multiple-value-bind (indicator value tail)
+ (get-properties '(prop1 1 prop2 2 prop3 3 prop4 4)
+ '(propX propY propZ))
+ (and (eq indicator nil)
+ (eq value nil)
+ (eq tail nil)))
+
+(let ((plist '(prop1 1 prop2 2 prop3 3 prop4 4)))
+ (multiple-value-bind (indicator value tail)
+ (get-properties plist '(prop1))
+ (and (eq indicator 'prop1)
+ (eql value 1)
+ (eq tail plist))))
+
+(let ((plist '(prop1 1 nil nil prop2 2 prop3 3 prop4 4)))
+ (multiple-value-bind (indicator value tail)
+ (get-properties plist '(nil))
+ (and (eq indicator nil)
+ (eql value nil)
+ (eq tail (cddr plist)))))
+
+(let ((plist '(prop1 1 prop2 2 prop3 3 prop4 4)))
+ (multiple-value-bind (indicator value tail)
+ (get-properties plist '(prop3 prop4 propX propY prop1))
+ (and (eq indicator 'prop1)
+ (eql value 1)
+ (eq tail plist))))
+
+
+(let ((plist '(prop1 1 prop2 2 prop3 3 prop4 4)))
+ (eql (getf plist 'prop1) 1))
+
+(let ((plist '(prop1 1 prop2 2 prop3 3 prop4 4)))
+ (eql (getf plist 'prop2) 2))
+
+(let ((plist '(prop1 1 prop2 2 prop3 3 prop4 4)))
+ (eql (getf plist 'prop3) 3))
+
+(let ((plist '(prop1 1 prop2 2 prop3 3 prop4 4)))
+ (eql (getf plist 'prop4) 4))
+
+(let ((plist
+ '(prop1 1 prop2 2 prop3 3 prop4 4 prop1 5 prop2 6 prop3 7 prop4 8)))
+ (eql (getf plist 'prop1) 1))
+
+(let ((plist
+ '(prop1 1 prop2 2 prop3 3 prop4 4 prop1 5 prop2 6 prop3 7 prop4 8)))
+ (eql (getf plist 'prop2) 2))
+
+(let ((plist
+ '(prop1 1 prop2 2 prop3 3 prop4 4 prop1 5 prop2 6 prop3 7 prop4 8)))
+ (eql (getf plist 'prop3) 3))
+
+(let ((plist
+ '(prop1 1 prop2 2 prop3 3 prop4 4 prop1 5 prop2 6 prop3 7 prop4 8)))
+ (eql (getf plist 'prop4) 4))
+
+(let ((plist
+ '(prop1 1 prop2 2 prop3 3 prop4 4 prop1 5 prop2 6 prop3 7 prop4 8)))
+ (null (getf plist 'propX)))
+
+(let ((plist '(prop1 1 prop2 2 prop3 3 prop4 4)))
+ (eq (getf plist 'weird-property 'not-found) 'not-found))
+
+
+(let ((plist (copy-list '(prop1 1 prop2 2 prop3 3 prop4 4))))
+ (and (eql (setf (getf plist 'prop1) 9) 9)
+ (eql (getf plist 'prop1) 9)))
+
+(let ((plist nil))
+ (and (eql (setf (getf plist 'prop1) 9) 9)
+ (eql (getf plist 'prop1) 9)))
+
+(let ((plist '()))
+ (incf (getf plist 'count 0))
+ (eql (getf plist 'count) 1))
+
+(let ((x (list nil)))
+ (and (eql (setf (getf (car x) 'prop1) 9) 9)
+ (eql (getf (car x) 'prop1) 9)))
+
+
+(let ((plist (list 'p1 1 'p2 2 'p3 3 'p4 4)))
+ (and (remf plist 'p2)
+ (eq (getf plist 'p2 'not-found) 'not-found)))
+
+(let ((plist (list 'p1 1 'p2 2 'p3 3 'p4 4)))
+ (and (remf plist 'p3)
+ (eq (getf plist 'p3 'not-found) 'not-found)))
+
+(let ((plist (list 'p1 1 'p2 2 'p3 3 'p4 4)))
+ (and (remf plist 'p4)
+ (eq (getf plist 'p4 'not-found) 'not-found)))
+
+(let ((plist (list 'p1 1 'p2 2 'p3 3 'p4 4)))
+ (and (null (remf plist 'pX))
+ (equal plist '(p1 1 p2 2 p3 3 p4 4))))
+
+(let ((plist (list 'p1 1 'p2 2 'p3 3 'p4 4)))
+ (and (remf plist 'p4)
+ (remf plist 'p2)
+ (remf plist 'p3)
+ (remf plist 'p1)
+ (null (remf plist 'pX))
+ (null (remf plist 'p1))
+ (null (remf plist 'p2))
+ (null (remf plist 'p3))
+ (null (remf plist 'p4))
+ (null plist)))
+
+
+(let ((plist (list 'p1 1 'p2 2 'p3 3 'p4 4 'p1 5 'p2 6 'p3 7 'p4 8)))
+ (and (remf plist 'p4)
+ (remf plist 'p2)
+ (remf plist 'p3)
+ (remf plist 'p1)
+ (null (remf plist 'pX))
+ (eql (getf plist 'p1) 5)
+ (eql (getf plist 'p2) 6)
+ (eql (getf plist 'p3) 7)
+ (eql (getf plist 'p4) 8)))
+
+(let ((plist (list 'p1 100 'p1 1 'p2 2 'p3 3 'p4 4)))
+ (and (eql (getf plist 'p1) 100)
+ (remf plist 'p1)
+ (eql (getf plist 'p1) 1)
+ (remf plist 'p1)
+ (null (getf plist 'p1))))
+
+(let ((plist (list 'p1 1 'p2 2 'p3 3 'p4 4)))
+ (and (remf plist 'p4)
+ (null (getf plist 'p4))))
+
+
+(let ((list1 (list 1 1 2 3 4 'a 'b 'c "A" "B" "C" "d"))
+ (list2 (list 1 4 5 'b 'c 'd "a" "B" "c" "D")))
+ (null (set-exclusive-or (intersection list1 list2) '(C B 4 1 1)))
+ (null (set-exclusive-or (intersection list1 list2 :test 'equal)
+ '("B" C B 4 1 1)
+ :test 'equal))
+ (null (set-exclusive-or (intersection list1 list2 :test #'equalp)
+ '("d" "C" "B" "A" C B 4 1 1)
+ :test #'equalp)))
+
+(null (intersection '(0 1 2) '()))
+(null (intersection '() '()))
+(null (intersection '() '(0 1 2)))
+(equal (intersection '(0) '(0)) '(0))
+(equal (intersection '(0 1 2 3) '(2)) '(2))
+(member 0 (intersection '(0 0 0 0 0) '(0 1 2 3 4 5)))
+(null (set-exclusive-or (intersection '(0 1 2 3 4) '(4 3 2 1 0))
+ '(4 3 2 1 0)))
+(null (set-exclusive-or (intersection '(0 1 2 3 4) '(0 1 2 3 4))
+ '(0 1 2 3 4)))
+(null (set-exclusive-or (intersection '(0 1 2 3 4) '(4 3 2 1 0))
+ '(0 1 2 3 4)))
+
+
+(let ((list1 (list "A" "B" "C" "d" "e" "F" "G" "h"))
+ (list2 (list "a" "B" "c" "D" "E" "F" "g" "h")))
+ (null (set-exclusive-or (intersection list1 list2
+ :test #'char=
+ :key #'(lambda (x) (char x 0)))
+ '("B" "F" "h")
+ :test #'char=
+ :key #'(lambda (x) (char x 0)))))
+
+(let ((list1 (list "A" "B" "C" "d" "e" "F" "G" "h"))
+ (list2 (list "a" "B" "c" "D" "E" "F" "g" "h")))
+ (null (set-exclusive-or (intersection list1 list2
+ :test #'char-equal
+ :key #'(lambda (x) (char x 0)))
+ '("A" "B" "C" "d" "e" "F" "G" "h")
+ :test #'char-equal
+ :key #'(lambda (x) (char x 0)))))
+
+(let ((list1 (list "A" "B" "C" "d"))
+ (list2 (list "D" "E" "F" "g" "h")))
+ (null (set-exclusive-or (intersection list1 list2
+ :test #'char-equal
+ :key #'(lambda (x) (char x 0)))
+ '("d")
+ :test #'char-equal
+ :key #'(lambda (x) (char x 0)))))
+
+
+
+
+(let ((list1 (list 1 1 2 3 4 'a 'b 'c "A" "B" "C" "d"))
+ (list2 (list 1 4 5 'b 'c 'd "a" "B" "c" "D")))
+ (null (set-exclusive-or (nintersection (copy-list list1) list2) '(C B 4 1 1)))
+ (null (set-exclusive-or (nintersection (copy-list list1) list2 :test 'equal)
+ '("B" C B 4 1 1)
+ :test 'equal))
+ (null (set-exclusive-or (nintersection (copy-list list1) list2 :test #'equalp)
+ '("d" "C" "B" "A" C B 4 1 1)
+ :test #'equalp)))
+
+(null (nintersection (list 0 1 2) '()))
+(null (nintersection '() '()))
+(null (nintersection '() '(0 1 2)))
+(equal (nintersection (list 0) '(0)) '(0))
+(equal (nintersection (list 0 1 2 3) '(2)) '(2))
+(member 0 (nintersection (list 0 0 0 0 0) '(0 1 2 3 4 5)))
+(null (set-exclusive-or (nintersection (list 0 1 2 3 4) '(4 3 2 1 0))
+ '(4 3 2 1 0)))
+(null (set-exclusive-or (nintersection (list 0 1 2 3 4) '(0 1 2 3 4))
+ '(0 1 2 3 4)))
+(null (set-exclusive-or (nintersection (list 0 1 2 3 4) '(4 3 2 1 0))
+ '(0 1 2 3 4)))
+
+
+(let ((list1 (list "A" "B" "C" "d" "e" "F" "G" "h"))
+ (list2 (list "a" "B" "c" "D" "E" "F" "g" "h")))
+ (null (set-exclusive-or (nintersection list1 list2
+ :test #'char=
+ :key #'(lambda (x) (char x 0)))
+ '("B" "F" "h")
+ :test #'char=
+ :key #'(lambda (x) (char x 0)))))
+
+(let ((list1 (list "A" "B" "C" "d" "e" "F" "G" "h"))
+ (list2 (list "a" "B" "c" "D" "E" "F" "g" "h")))
+ (null (set-exclusive-or (nintersection list1 list2
+ :test #'char-equal
+ :key #'(lambda (x) (char x 0)))
+ '("A" "B" "C" "d" "e" "F" "G" "h")
+ :test #'char-equal
+ :key #'(lambda (x) (char x 0)))))
+
+(let ((list1 (list "A" "B" "C" "d"))
+ (list2 (list "D" "E" "F" "g" "h")))
+ (null (set-exclusive-or (nintersection list1 list2
+ :test #'char-equal
+ :key #'(lambda (x) (char x 0)))
+ '("d")
+ :test #'char-equal
+ :key #'(lambda (x) (char x 0)))))
+
+
+(let ((set '(a b c)))
+ (eq (adjoin 'a set) set))
+
+(let* ((set '(a b c))
+ (new-set (adjoin 'x set)))
+ (and (equal new-set '(x a b c))
+ (eq set (cdr new-set))))
+
+(equal (adjoin 1 nil) '(1))
+(equal (adjoin nil nil) '(nil))
+(equal (adjoin nil '(nil)) '(nil))
+(let ((set '((test-item 1))))
+ (equal (adjoin '(test-item 1) set) '((test-item 1) (test-item 1))))
+
+(let ((set '((test-item 1))))
+ (equal (adjoin '(test-item 1) set)
+ '((test-item 1) (test-item 1))))
+
+(let ((set '((test-item 1))))
+ (eq (adjoin '(test-item 1) set :test #'equal) set))
+
+(let ((set '((test-item 1))))
+ (eq (adjoin '(test-item) set :key #'car) set))
+
+(let ((set '((test-item 1))))
+ (eq (adjoin '(test-item) set :key #'car :test #'eq) set))
+
+(let ((set '(("test-item" 1))))
+ (eq (adjoin '("test-item") set :key #'car :test #'equal) set))
+
+
+(let ((set '((test-item 1))))
+ (eq (adjoin '(test-item 1) set :test-not (complement #'equal)) set))
+
+(let ((set '((test-item 1))))
+ (eq (adjoin '(test-item) set :test-not (complement #'eql) :key #'car) set))
+
+(let ((set '((test-item 1))))
+ (eq (adjoin '(test-item) set :key #'car :test-not (complement #'eq)) set))
+
+(let ((set '(("test-item" 1))))
+ (eq (adjoin '("test-item") set :key #'car :test-not (complement #'equal))
+ set))
+
+
+(let ((place nil))
+ (and (equal (pushnew 'a place) '(a))
+ (equal place '(a))))
+
+(let ((place nil))
+ (and (equal (pushnew 'a place) '(a))
+ (equal place '(a))))
+
+(let ((place '((a . 1) (b . 2))))
+ (and (equal (pushnew '(b . 2) place :test #'= :key #'cdr) '((a . 1) (b . 2)))
+ (equal place '((a . 1) (b . 2)))))
+
+(let ((place '((a . 1) (b . 2))))
+ (and (equal (pushnew '(b . 2) place :test-not (complement #'=) :key #'cdr)
+ '((a . 1) (b . 2)))
+ (equal place '((a . 1) (b . 2)))))
+
+(let ((place '((a . 1) (b . 2))))
+ (and (eq (pushnew '(z . 2) place :test #'= :key #'cdr) place)
+ (equal place '((a . 1) (b . 2)))))
+
+(let ((place '((a . 1) (b . 2))))
+ (and (eq (pushnew '(z . 2) place :test-not (complement #'=) :key #'cdr) place)
+ (equal place '((a . 1) (b . 2)))))
+
+(let ((place '("love" "peace")))
+ (equal (pushnew "war" place :test #'equal) '("war" "love" "peace")))
+
+(let ((place '("love" "peace")))
+ (equal (pushnew "war" place :test-not (complement #'equal))
+ '("war" "love" "peace")))
+
+(let ((place '("love" "peace")))
+ (and (eq (pushnew "peace" place :test #'equal) place)
+ (equal place '("love" "peace"))))
+
+(let ((place '("love" "peace")))
+ (and (eq (pushnew "peace" place :test-not (complement #'equal)) place)
+ (equal place '("love" "peace"))))
+
+(let ((place '(("love" . l) ("peace" . p))))
+ (equal (pushnew '("war" . w) place :test #'equal :key #'car)
+ '(("war" . w) ("love" . l) ("peace" . p))))
+
+(let ((place '(("love" . l) ("peace" . p))))
+ (equal (pushnew '("war" . w) place :test-not (complement #'equal) :key #'car)
+ '(("war" . w) ("love" . l) ("peace" . p))))
+
+(let ((place '(("love" . l) ("peace" . p))))
+ (and (eq (pushnew '("love" . l) place :test #'equal :key #'car) place)
+ (equal place '(("love" . l) ("peace" . p)))))
+
+(let ((place '(("love" . l) ("peace" . p))))
+ (and (eq (pushnew '("love" . l) place
+ :test-not (complement #'equal) :key #'car) place)
+ (equal place '(("love" . l) ("peace" . p)))))
+
+(let ((place '(("love" . l) ("peace" . p))))
+ (and (eq (pushnew '("LOVE" . L) place :test #'equalp :key #'car) place)
+ (equal place '(("love" . l) ("peace" . p)))))
+
+(let ((place '(("love" . l) ("peace" . p))))
+ (and (eq (pushnew '("LOVE" . L) place
+ :test-not (complement #'equalp) :key #'car) place)
+ (equal place '(("love" . l) ("peace" . p)))))
+
+(let ((place '(("love" . l) ("peace" . p))))
+ (equal (pushnew '("LOVE" . L) place :test #'equal :key #'car)
+ '(("LOVE" . L) ("love" . l) ("peace" . p))))
+
+(let ((place '(("love" . l) ("peace" . p))))
+ (equal (pushnew '("LOVE" . L) place :test-not (complement #'equal) :key #'car)
+ '(("LOVE" . L) ("love" . l) ("peace" . p))))
+
+(let ((list '((1) (1 2) (1 2 3))))
+ (and (equal (pushnew '(1) list) '((1) (1) (1 2) (1 2 3)))
+ (equal list '((1) (1) (1 2) (1 2 3)))))
+
+
+(let* ((list '((1) (1 2) (1 2 3)))
+ (original list))
+ (and (equal (pushnew '(1) list :test #'equal) '((1) (1 2) (1 2 3)))
+ (eq list original)))
+
+(let* ((list '((1) (1 2) (1 2 3)))
+ (original list))
+ (and (equal (pushnew '(1) list :test #'equal :key nil) '((1) (1 2) (1 2 3)))
+ (eq list original)))
+
+(let ((list (copy-tree '(1 (2) 3 4))))
+ (and (equal (pushnew 4 (cadr list)) '(4 2))
+ (equal list '(1 (4 2) 3 4))))
+
+(let ((list (copy-tree '(1 (2) 3 4))))
+ (and (equal (pushnew 4 (cadr list) :key nil) '(4 2))
+ (equal list '(1 (4 2) 3 4))))
+
+
+(null (set-difference (set-difference '(1 2 3 4 5 6 7 8 9)
+ '(2 4 6 8))
+ '(1 3 5 7 9)))
+(null (nset-difference (set-difference (list 1 2 3 4 5 6 7 8 9)
+ '(2 4 6 8))
+ '(1 3 5 7 9)))
+
+(null (set-difference (set-difference '("1" "2" "3" "4" "5" "6" "7" "8" "9")
+ '("2" "4" "6" "8") :test #'equal)
+ '("1" "3" "5" "7" "9") :test-not (complement #'equal)))
+
+(null (set-difference (set-difference '("1" "2" "3" "4" "5" "6" "7" "8" "9")
+ '("2" "4" "6" "8") :test #'equal)
+ '("1" "3" "5" "7" "9") :test-not (complement #'equal)))
+
+(null (nset-difference (nset-difference
+ (list "1" "2" "3" "4" "5" "6" "7" "8" "9")
+ '("2" "4" "6" "8") :test #'equal)
+ '("1" "3" "5" "7" "9") :test-not (complement #'equal)))
+
+(null (set-difference (set-difference '(("love") ("hate") ("peace") ("war"))
+ '(("love") ("peace"))
+ :key #'car
+ :test #'equal)
+ '(("hate") ("war"))
+ :key #'car
+ :test-not (complement #'equal)))
+
+(null (nset-difference (nset-difference
+ (list '("love") '("hate") '("peace") '("war"))
+ '(("love") ("peace"))
+ :key #'car
+ :test #'equal)
+ '(("hate") ("war"))
+ :key #'car
+ :test-not (complement #'equal)))
+
+
+(null (set-difference '() '()))
+(null (set-difference '() '() :test #'equal :key 'identity))
+(null (nset-difference '() '()))
+(null (set-difference '() '(1 2 3)))
+(null (set-difference '() '(1 2 3) :test #'equal :key 'identity))
+(null (nset-difference '() '(1 2 3)))
+
+(null (set-difference '(1 2 3 4) '(4 3 2 1)))
+(null (nset-difference (list 1 2 3 4) '(4 3 2 1)))
+(null (set-difference '(1 2 3 4) '(2 4 3 1)))
+(null (nset-difference (list 1 2 3 4) '(2 4 3 1)))
+(null (set-difference '(1 2 3 4) '(1 3 4 2)))
+(null (nset-difference (list 1 2 3 4) '(1 3 4 2)))
+(null (set-difference '(1 2 3 4) '(1 3 2 4)))
+(null (nset-difference (list 1 2 3 4) '(1 3 2 4)))
+
+
+(eq (set-difference (set-difference '(1 2 3) '())
+ '(1 2 3))
+ '())
+(eq (nset-difference (nset-difference (list 1 2 3) '())
+ '(1 2 3))
+ '())
+
+(eq (set-difference (set-difference '(1 2 3) '(1))
+ '(2 3))
+ '())
+(eq (nset-difference (nset-difference (list 1 2 3) '(1))
+ '(2 3))
+ '())
+
+(eq (set-difference (set-difference '(1 2 3) '(1 2))
+ '(3))
+ '())
+(eq (nset-difference (nset-difference (list 1 2 3) '(1 2))
+ '(3))
+ '())
+
+
+(null (set-exclusive-or (set-exclusive-or '(1 2 3) '(2 3 4))
+ '(1 4)))
+(null (nset-exclusive-or (nset-exclusive-or (list 1 2 3) '(2 3 4))
+ '(1 4)))
+(null (set-exclusive-or (set-exclusive-or '(1 2 3) '(1 3))
+ '(2)))
+(null (nset-exclusive-or (nset-exclusive-or (list 1 2 3) '(1 3))
+ '(2)))
+(null (set-exclusive-or '() '()))
+(null (nset-exclusive-or '() '()))
+(null (set-exclusive-or '(1 2 3) '(3 2 1)))
+(null (nset-exclusive-or (list 1 2 3) '(3 2 1)))
+(null (set-exclusive-or '(1 2 3) '(2 3 1)))
+(null (nset-exclusive-or (list 1 2 3) '(2 3 1)))
+(null (set-exclusive-or '(1 2 3) '(1 3 2)))
+(null (nset-exclusive-or (list 1 2 3) '(1 3 2)))
+
+(null (set-exclusive-or (set-exclusive-or '(1 2 3) '())
+ '(3 2 1)))
+(null (nset-exclusive-or (nset-exclusive-or (list 1 2 3) '())
+ '(3 2 1)))
+(null (set-exclusive-or (set-exclusive-or '() '(1 2 3))
+ '(2 1 3)))
+(null (nset-exclusive-or (nset-exclusive-or '() '(1 2 3))
+ '(2 1 3)))
+
+(null (set-exclusive-or '("car" "ship" "airplane" "submarine")
+ '("car" "ship" "airplane" "submarine")
+ :test #'equal))
+(null (nset-exclusive-or (copy-list '("car" "ship" "airplane" "submarine"))
+ '("car" "ship" "airplane" "submarine")
+ :test #'equal))
+
+(null (set-exclusive-or '("car" "ship" "airplane" "submarine")
+ '("CAR" "SHIP" "AIRPLANE" "SUBMARINE")
+ :test #'equalp))
+(null (nset-exclusive-or (copy-list '("car" "ship" "airplane" "submarine"))
+ '("CAR" "SHIP" "AIRPLANE" "SUBMARINE")
+ :test #'equalp))
+
+(null (set-exclusive-or '("car" "ship" "airplane" "submarine")
+ '("ship" "airplane" "submarine" "car")
+ :test-not (complement #'equal)))
+(null (nset-exclusive-or (copy-list '("car" "ship" "airplane" "submarine"))
+ '("ship" "airplane" "submarine" "car")
+ :test-not (complement #'equal)))
+
+(null (set-exclusive-or '(("car") ("ship") ("airplane") ("submarine"))
+ '(("car") ("ship") ("airplane") ("submarine"))
+ :test #'string=
+ :key #'car))
+(null (nset-exclusive-or (copy-tree
+ '(("car") ("ship") ("airplane") ("submarine")))
+ '(("car") ("ship") ("airplane") ("submarine"))
+ :test #'string=
+ :key #'car))
+
+(null (set-exclusive-or '(("car") ("ship") ("airplane") ("submarine"))
+ '(("car") ("ship") ("airplane") ("submarine"))
+ :test-not (complement #'string=)
+ :key #'car))
+(null (nset-exclusive-or (copy-tree
+ '(("car") ("ship") ("airplane") ("submarine")))
+ '(("car") ("ship") ("airplane") ("submarine"))
+ :test-not (complement #'string=)
+ :key #'car))
+
+(null (set-exclusive-or
+ (set-exclusive-or '("car" "ship" "airplane" "submarine")
+ '("car" "ship" "horse" "airplane" "submarine" "camel")
+ :test #'equal)
+ '("camel" "horse")
+ :test-not (complement #'equal)))
+
+(null (nset-exclusive-or
+ (nset-exclusive-or (list "car" "ship" "airplane" "submarine")
+ '("car" "ship" "horse" "airplane" "submarine" "camel")
+ :test #'equal)
+ '("camel" "horse")
+ :test-not (complement #'equal)))
+
+
+(subsetp '(1 2 3) '(1 2 3))
+(subsetp '(1 2 3) '(3 2 1))
+(subsetp '(1 2 3) '(2 1 3))
+
+(null (subsetp '(1 2 3 4) '(2 1 3)))
+(subsetp '(1) '(2 1 3))
+(subsetp '(1 2) '(1 2 3 4 5 6 7 8))
+(subsetp '(1 2 3 4 5) '(8 7 6 5 4 3 2 1))
+(null (subsetp '("car" "ship" "airplane" "submarine")
+ '("car" "ship" "horse" "airplane" "submarine" "camel")))
+
+(subsetp '("car" "ship" "airplane" "submarine")
+ '("car" "ship" "horse" "airplane" "submarine" "camel")
+ :test #'equal)
+
+(subsetp '("CAR" "SHIP" "AIRPLANE" "SUBMARINE")
+ '("car" "ship" "horse" "airplane" "submarine" "camel")
+ :test #'equalp)
+
+(subsetp '(("car") ("ship") ("airplane") ("submarine"))
+ '(("car") ("ship") ("horse") ("airplane") ("submarine") ("camel"))
+ :test #'string=
+ :key #'car)
+
+
+(null (union '() '()))
+(null (nunion '() '()))
+(null (set-difference (union '(1 2 3) '(2 3 4))
+ '(1 2 3 4)))
+(null (set-difference (nunion (list 1 2 3) (list 2 3 4))
+ '(1 2 3 4)))
+
+(null (set-difference (union '(1 2 3) '(1 2 3))
+ '(1 2 3)))
+(null (set-difference (nunion (list 1 2 3) (list 1 2 3))
+ '(1 2 3)))
+
+(null (set-difference (union '(1) '(3 2 1))
+ '(1 2 3)))
+(null (set-difference (nunion (list 1) (list 3 2 1))
+ '(1 2 3)))
+
+(null (set-difference (union '(1 2 3) '())
+ '(1 2 3)))
+(null (set-difference (nunion (list 1 2 3) '())
+ '(1 2 3)))
+
+(null (set-difference (union '() '(1 2 3))
+ '(1 2 3)))
+(null (set-difference (nunion '() (list 1 2 3))
+ '(1 2 3)))
+
+(null (set-difference (union '(1 2 3) '(2))
+ '(1 2 3)))
+(null (set-difference (nunion (list 1 2 3) (list 2))
+ '(1 2 3)))
+
+
+(null (set-difference (union '("Alpha" "Bravo" "Charlie")
+ '("Bravo" "Charlie" "Delta" "Echo")
+ :test #'string=)
+ '("Alpha" "Bravo" "Charlie" "Delta" "Echo")
+ :test-not (complement #'string=)))
+
+(null (set-difference (nunion (list "Alpha" "Bravo" "Charlie")
+ (list "Bravo" "Charlie" "Delta" "Echo")
+ :test #'string=)
+ '("Alpha" "Bravo" "Charlie" "Delta" "Echo")
+ :test-not (complement #'string=)))
+
+(null (set-difference
+ (union (copy-tree '(("Alpha") ("Bravo") ("Charlie")))
+ (copy-tree '(("Bravo") ("Charlie") ("Delta") ("Echo")))
+ :test #'string=
+ :key #'car)
+ '(("Alpha") ("Bravo") ("Charlie") ("Delta") ("Echo"))
+ :test-not (complement #'string=)
+ :key #'car))
+
+(null (set-difference
+ (nunion (copy-tree '(("Alpha") ("Bravo") ("Charlie")))
+ (copy-tree '(("Bravo") ("Charlie") ("Delta") ("Echo")))
+ :test #'string=
+ :key #'car)
+ '(("Alpha") ("Bravo") ("Charlie") ("Delta") ("Echo"))
+ :test-not (complement #'string=)
+ :key #'car))
+
+
+(null (set-difference (union '("Alpha" "Bravo" "Charlie")
+ '("BRAVO" "CHARLIE" "DELTA" "ECHO")
+ :test #'string-equal)
+ '("ALPHA" "BRAVO" "CHARLIE" "DELTA" "ECHO")
+ :test-not (complement #'string-equal)))
+
diff --git a/Sacla/tests/must-data-and-control.lisp b/Sacla/tests/must-data-and-control.lisp
new file mode 100644
index 0000000..0b0fb96
--- /dev/null
+++ b/Sacla/tests/must-data-and-control.lisp
@@ -0,0 +1,1660 @@
+;; Copyright (C) 2002-2004, Yuji Minejima <ggb01164@nifty.ne.jp>
+;; ALL RIGHTS RESERVED.
+;;
+;; $Id: must-data-and-control.lisp,v 1.15 2004/02/20 07:23:42 yuji Exp $
+;;
+;; Redistribution and use in source and binary forms, with or without
+;; modification, are permitted provided that the following conditions
+;; are met:
+;;
+;; * Redistributions of source code must retain the above copyright
+;; notice, this list of conditions and the following disclaimer.
+;; * 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.
+;;
+;; 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
+;; OWNER 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.
+
+(let (a b c)
+ (and (null (psetq a 1 b 2 c 3))
+ (eql a 1)
+ (eql b 2)
+ (eql c 3)))
+
+(let ((a 1)
+ (b 2)
+ (c 3))
+ (and (null (psetq a (1+ b) b (1+ a) c (+ a b)))
+ (eql a 3)
+ (eql b 2)
+ (eql c 3)))
+
+(let ((x (list 10 20 30)))
+ (symbol-macrolet ((y (car x)) (z (cadr x)))
+ (psetq y (1+ z) z (1+ y))
+ (equal (list x y z) '((21 11 30) 21 11))))
+
+(let ((a 1) (b 2))
+ (and (null (psetq a b b a))
+ (eql a 2)
+ (eql b 1)))
+
+
+(null (psetq))
+(let ((a nil))
+ (and (null (psetq a t))
+ (eq a t)))
+(let ((a 0)
+ (b 1))
+ (and (null (psetq a b
+ b a))
+ (eq a 1)
+ (eq b 0)))
+
+(let ((a 0)
+ (b 1)
+ (c 2))
+ (and (null (psetq a b
+ b c
+ c a))
+ (eq a 1)
+ (eq b 2)
+ (eq c 0)))
+
+(let ((a 0)
+ (b 1)
+ (c 2)
+ (d 3))
+ (and (null (psetq a b
+ b c
+ c d
+ d a))
+ (eq a 1)
+ (eq b 2)
+ (eq c 3)
+ (eq d 0)))
+
+
+
+(null (block nil (return) 1))
+(eql (block nil (return 1) 2) 1)
+(equal (multiple-value-list (block nil (return (values 1 2)) 3)) '(1 2))
+(eql (block nil (block alpha (return 1) 2)) 1)
+(eql (block alpha (block nil (return 1)) 2) 2)
+(eql (block nil (block nil (return 1) 2)) 1)
+
+(eq (dotimes (i 10 nil)
+ (return t))
+ t)
+
+(eq (dolist (elt (list 0 1 2 3) nil)
+ (when (numberp elt)
+ (return t)))
+ t)
+
+(not nil)
+(not '())
+(not (integerp 'sss))
+(null (not (integerp 1)))
+(null (not 3.7))
+(null (not 'apple))
+
+(not nil)
+(null (not t))
+(not (cdr '(a)))
+
+
+(equal 'a 'a)
+(not (equal 'a 'b))
+(equal 'abc 'abc)
+(equal 1 1)
+(equal 2 2)
+(equal 0.1 0.1)
+(equal 1/3 1/3)
+(not (equal 0 1))
+(not (equal 1 1.0))
+(not (equal 1/3 1/4))
+(equal #\a #\a)
+(equal #\b #\b)
+(not (equal #\b #\B))
+(not (equal #\C #\c))
+(equal '(0) '(0))
+(equal '(0 #\a) '(0 #\a))
+(equal '(0 #\a x) '(0 #\a x))
+(equal '(0 #\a x (0)) '(0 #\a x (0)))
+(equal '(0 #\a x (0 (#\a (x "abc" #*0101))))
+ '(0 #\a x (0 (#\a (x "abc" #*0101)))))
+(not (equal (make-array '(2 2) :initial-contents '((a b) (c d)))
+ (make-array '(2 2) :initial-contents '((a b) (c d)))))
+(let ((array (make-array '(2 2) :initial-contents '((a b) (c d)))))
+ (equal array array))
+
+
+(eql (identity 101) 101)
+(equal (mapcan #'identity (list (list 1 2 3) '(4 5 6))) '(1 2 3 4 5 6))
+(eq (identity 'x) 'x)
+
+
+
+(funcall (complement #'zerop) 1)
+(not (funcall (complement #'characterp) #\A))
+(not (funcall (complement #'member) 'a '(a b c)))
+(funcall (complement #'member) 'd '(a b c))
+
+
+
+(equal (mapcar (constantly 3) '(a b c d)) '(3 3 3 3))
+(let ((const-func (constantly 'xyz)))
+ (every #'(lambda (arg) (eq arg 'xyz))
+ (list (funcall const-func)
+ (funcall const-func 'a)
+ (funcall const-func 'a 'b)
+ (funcall const-func 'a 'b 'c)
+ (funcall const-func 'a 'b 'c 'd))))
+
+
+
+(let ((temp1 1)
+ (temp2 1)
+ (temp3 1))
+ (and (eql (and (incf temp1) (incf temp2) (incf temp3)) 2)
+ (and (eql 2 temp1) (eql 2 temp2) (eql 2 temp3))
+ (eql (decf temp3) 1)
+ (null (and (decf temp1) (decf temp2) (eq temp3 'nil) (decf temp3)))
+ (and (eql temp1 temp2) (eql temp2 temp3))
+ (and)))
+
+(eq (and) t)
+(equal (multiple-value-list (and 't 't 't (values 'a 'b 'c)))
+ '(a b c))
+(null (and 't 't (cdr '(a)) (error "error")))
+
+
+
+(let ((temp0 nil)
+ (temp1 10)
+ (temp2 20)
+ (temp3 30))
+ (and (eql (or temp0 temp1 (setq temp2 37)) 10)
+ (eql temp2 20)
+ (eql (or (incf temp1) (incf temp2) (incf temp3)) 11)
+ (eql temp1 11)
+ (eql temp2 20)
+ (eql temp3 30)
+ (equal (multiple-value-list (or (values) temp1)) '(11))
+ (equal (multiple-value-list (or (values temp1 temp2) temp3)) '(11))
+ (equal (multiple-value-list (or temp0 (values temp1 temp2))) '(11 20))
+ (equal (multiple-value-list (or (values temp0 temp1)
+ (values temp2 temp3)))
+ '(20 30))))
+
+(zerop (or '0 '1 '2))
+(let ((a 0))
+ (and (eql (or (incf a) (incf a) (incf a)) 1)
+ (eql a 1)))
+(equal (multiple-value-list (or (values) 1)) '(1))
+(equal (multiple-value-list (or (values 1 2) 3)) '(1))
+
+(null (or))
+(equal (multiple-value-list (or (values 0 1 2))) '(0 1 2))
+(equal (multiple-value-list (or nil (values 0 1 2))) '(0 1 2))
+(equal (multiple-value-list (or nil nil (values 0 1 2))) '(0 1 2))
+(equal (multiple-value-list (or nil nil nil (values 0 1 2))) '(0 1 2))
+
+
+(let ((a nil))
+ (flet ((select-options ()
+ (cond ((= a 1) (setq a 2))
+ ((= a 2) (setq a 3))
+ ((and (= a 3) (floor a 2)))
+ (t (floor a 3)))))
+ (and (eql (setq a 1) 1)
+ (eql (select-options) 2)
+ (eql a 2)
+ (eql (select-options) 3)
+ (eql a 3)
+ (eql (select-options) 1)
+ (setq a 5)
+ (equal (multiple-value-list (select-options)) '(1 2)))))
+
+(null (cond))
+(equal (multiple-value-list (cond ((values 1 2 3)))) '(1))
+(equal (multiple-value-list (cond (t (values 1 2 3)))) '(1 2 3))
+(equal (multiple-value-list (cond (t (values 1)
+ (values 1 2)
+ (values 1 2 3)))) '(1 2 3))
+(let ((a 0))
+ (and (eql (cond
+ ((incf a))
+ ((incf a))
+ ((incf a)))
+ 1)
+ (eql a 1)))
+
+(let ((a 0))
+ (and (eql (cond
+ ((incf a) (incf a) (incf a))
+ ((incf a) (incf a) (incf a))
+ ((incf a) (incf a) (incf a)))
+ 3)
+ (eql a 3)))
+
+
+
+(eq (when t 'hello) 'HELLO)
+(null (unless t 'hello))
+(null (when nil 'hello))
+(eq (unless nil 'hello) 'HELLO)
+(null (when t))
+(null (unless nil))
+(let ((x 3))
+ (equal (list (when (oddp x) (incf x) (list x))
+ (when (oddp x) (incf x) (list x))
+ (unless (oddp x) (incf x) (list x))
+ (unless (oddp x) (incf x) (list x))
+ (if (oddp x) (incf x) (list x))
+ (if (oddp x) (incf x) (list x))
+ (if (not (oddp x)) (incf x) (list x))
+ (if (not (oddp x)) (incf x) (list x)))
+ '((4) NIL (5) NIL 6 (6) 7 (7))))
+
+
+
+
+(equal (let ((list nil))
+ (dolist (k '(1 2 3 :four #\v () t 'other))
+ (push (case k
+ ((1 2) 'clause1)
+ (3 'clause2)
+ (nil 'no-keys-so-never-seen)
+ ((nil) 'nilslot)
+ ((:four #\v) 'clause4)
+ ((t) 'tslot)
+ (otherwise 'others))
+ list))
+ list)
+ '(OTHERS TSLOT NILSLOT CLAUSE4 CLAUSE4 CLAUSE2 CLAUSE1 CLAUSE1))
+
+
+(macro-function 'case)
+(macro-function 'ccase)
+(macro-function 'ecase)
+
+(eql (case 'a
+ ((a b c) 0)
+ (x 1)
+ (y 2)
+ (z 3))
+ 0)
+
+(eql (case 'j
+ ((a b c) 0)
+ (x 1)
+ (y 2)
+ (z 3)
+ (t 9))
+ 9)
+
+(eql (case 'j
+ ((a b c) 0)
+ (x 1)
+ (y 2)
+ (z 3)
+ (otherwise 9))
+ 9)
+
+(eql (case 'j
+ ((a b c) 0)
+ (x 1)
+ (y 2)
+ (z 3))
+ nil)
+
+(null (case 'x))
+
+(let ((x #\a))
+ (equal (case x
+ ((#\x #\y #\z) "xyz")
+ (#\a "a")
+ (t "-"))
+ "a"))
+
+(let ((x #\A))
+ (equal (case x
+ ((#\x #\y #\z) "xyz")
+ (#\a "a")
+ (t "-"))
+ "-"))
+
+(let ((x t))
+ (eql (case x
+ ((t) 0)
+ (t 1))
+ 0))
+
+(let ((x nil))
+ (eql (case x
+ ((t) 0)
+ (t 1))
+ 1))
+
+(let ((x 'a))
+ (eql (case x
+ ((t) 0))
+ nil))
+
+(let ((x 'otherwise))
+ (eql (case x
+ ((otherwise) 0)
+ (otherwise 1))
+ 0))
+
+(let ((x nil))
+ (eql (case x
+ ((otherwise) 0)
+ (otherwise 1))
+ 1))
+
+(let ((x 'a))
+ (eql (case x
+ ((otherwise) 0))
+ nil))
+
+
+(let ((x 'a))
+ (and (eql (case x
+ ((a b c) (setq x 0) 'a)
+ ((x y z) (setq x 1) 'x))
+ 'a)
+ (eql x 0)))
+
+(let ((x 'x))
+ (and (eql (case x
+ ((a b c) (setq x 0) 'a)
+ ((x y z) (setq x 1) 'x))
+ 'x)
+ (eql x 1)))
+
+
+(equal (mapcar #'(lambda (x) (case x (a 0) (b 1) (c 2) (d 3) (e 4)))
+ '(a b c d e f))
+ '(0 1 2 3 4 nil))
+
+(case 'a (otherwise t))
+
+(eql (case 'a (otherwise 10)) 10)
+
+(let ((a 0)
+ (b 1))
+ (and (eq (case (progn (incf a) (incf b))
+ (0 'a)
+ (1 'b)
+ (2 'c))
+ 'c)
+ (eql a 1)
+ (eql b 2)))
+
+(let ((a 0)
+ (b 1))
+ (and (eq (case (progn (incf a) (incf b))
+ (0 'a)
+ (1 'b)
+ (2 (incf a) (incf b) 'c))
+ 'c)
+ (eql a 2)
+ (eql b 3)))
+
+(let ((a (list 0 1 2 3)))
+ (eq (case (caddr a)
+ (0 'x)
+ (1 'y)
+ (2 'z)
+ (3 t))
+ 'z))
+
+
+(equal (multiple-value-list (case 2
+ (0 (values 0 'x))
+ (1 (values 1 'y))
+ (2 (values 2 'z))
+ (3 (values 3 't))))
+ '(2 z))
+
+
+
+(let ((a 'c))
+ (eql (ccase a
+ ((a b c) 0)
+ (x 1)
+ (y 2)
+ (z 3))
+ 0))
+
+(HANDLER-CASE
+ (PROGN
+ (LET ((A 'J))
+ (CCASE A ((A B C) 0) (X 1) (Y 2) (Z 3))))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+
+(HANDLER-CASE
+ (PROGN
+ (LET ((A NIL))
+ (CCASE A)))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+
+(HANDLER-CASE
+ (PROGN
+ (LET ((A #\a))
+ (CCASE A ((#\A #\B #\C) 0) ((#\X #\Y #\Z) 1))))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+
+(let ((a (list 0 1 2 3)))
+ (eq (ccase (caddr a)
+ (0 'x)
+ (1 'y)
+ (2 'z)
+ (3 t))
+ 'z))
+
+(let ((x #\a))
+ (equal (ccase x
+ ((#\x #\y #\z) "xyz")
+ (#\a "a"))
+ "a"))
+
+(let ((x 'a))
+ (and (eql (ccase x
+ ((a b c) (setq x 0) 'a)
+ ((x y z) (setq x 1) 'x))
+ 'a)
+ (eql x 0)))
+
+(let ((x 'x))
+ (and (eql (ccase x
+ ((a b c) (setq x 0) 'a)
+ ((x y z) (setq x 1) 'x))
+ 'x)
+ (eql x 1)))
+
+(equal (mapcar #'(lambda (x) (ccase x (a 0) (b 1) (c 2) (d 3) (e 4)))
+ '(a b c d e))
+ '(0 1 2 3 4))
+
+
+(equal (multiple-value-list (let ((a 2))
+ (ccase a
+ (0 (values 0 'x))
+ (1 (values 1 'y))
+ (2 (values 2 'z))
+ (3 (values 3 't)))))
+ '(2 z))
+
+(let ((a 'c))
+ (eql (ecase a
+ ((a b c) 0)
+ (x 1)
+ (y 2)
+ (z 3))
+ 0))
+
+(HANDLER-CASE
+ (PROGN
+ (LET ((A 'J))
+ (ECASE A ((A B C) 0) (X 1) (Y 2) (Z 3))))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+
+(HANDLER-CASE
+ (PROGN
+ (LET ((A NIL))
+ (ECASE A)))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+
+(HANDLER-CASE
+ (PROGN
+ (LET ((A #\a))
+ (ECASE A ((#\A #\B #\C) 0) ((#\X #\Y #\Z) 1))))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+
+(let ((a (list 0 1 2 3)))
+ (eq (ecase (caddr a)
+ (0 'x)
+ (1 'y)
+ (2 'z)
+ (3 t))
+ 'z))
+
+(let ((x #\a))
+ (equal (ecase x
+ ((#\x #\y #\z) "xyz")
+ (#\a "a"))
+ "a"))
+
+(let ((x 'a))
+ (and (eql (ecase x
+ ((a b c) (setq x 0) 'a)
+ ((x y z) (setq x 1) 'x))
+ 'a)
+ (eql x 0)))
+
+(let ((x 'x))
+ (and (eql (ecase x
+ ((a b c) (setq x 0) 'a)
+ ((x y z) (setq x 1) 'x))
+ 'x)
+ (eql x 1)))
+
+(equal (mapcar #'(lambda (x) (ecase x (a 0) (b 1) (c 2) (d 3) (e 4)))
+ '(a b c d e))
+ '(0 1 2 3 4))
+
+(equal (multiple-value-list (let ((a 2))
+ (ecase a
+ (0 (values 0 'x))
+ (1 (values 1 'y))
+ (2 (values 2 'z))
+ (3 (values 3 't)))))
+ '(2 z))
+
+
+(let ((x 'a))
+ (equal (typecase x
+ (cons "cons")
+ (symbol "symbol")
+ (number "number")
+ (otherwise "unknown"))
+ "symbol"))
+
+(let ((x (list 'a)))
+ (equal (typecase x
+ (cons "cons")
+ (symbol "symbol")
+ (number "number")
+ (otherwise "unknown"))
+ "cons"))
+
+(let ((x 0))
+ (equal (typecase x
+ (cons "cons")
+ (symbol "symbol")
+ (number "number")
+ (otherwise "unknown"))
+ "number"))
+
+(let ((x (make-array '(3 3))))
+ (equal (typecase x
+ (cons "cons")
+ (symbol "symbol")
+ (number "number")
+ (otherwise "unknown"))
+ "unknown"))
+
+
+(null (typecase 'a))
+(typecase 'a (otherwise t))
+(typecase 'a (t t))
+
+(let ((x (make-array '(3 3))))
+ (equal (typecase x
+ (cons "cons")
+ (symbol "symbol")
+ (number "number"))
+ nil))
+
+(let ((x ""))
+ (equal (typecase x
+ (t "anything")
+ (otherwise nil))
+ "anything"))
+
+(let ((x ""))
+ (and (eql (typecase x
+ (string (setq x 'string) 0)
+ (cons (setq x 'cons) 1)
+ (array (setq x 'array) 2)
+ (t (setq x 't) 9))
+ 0)
+ (eq x 'string)))
+
+(let ((x (list nil)))
+ (and (eql (typecase x
+ (string (setq x 'string) 0)
+ (cons (setq x 'cons) 1)
+ (array (setq x 'array) 2)
+ (t (setq x 't) 9))
+ 1)
+ (eq x 'cons)))
+
+
+(let ((x #*01))
+ (and (eql (typecase x
+ (string (setq x 'string) 0)
+ (cons (setq x 'cons) 1)
+ (array (setq x 'array) 2)
+ (t (setq x 't) 9))
+ 2)
+ (eq x 'array)))
+
+(let ((x #\a))
+ (and (eql (typecase x
+ (string (setq x 'string) 0)
+ (cons (setq x 'cons) 1)
+ (array (setq x 'array) 2)
+ (t (setq x 't) 9))
+ 9)
+ (eq x 't)))
+
+(let ((x #*01))
+ (and (equal (multiple-value-list (typecase x
+ (string (setq x 'string) (values 'string 0))
+ (cons (setq x 'cons) (values 'cons 1))
+ (array (setq x 'array) (values 'array 2))
+ (t (setq x 't) (values 't 9))))
+ '(array 2))
+ (eq x 'array)))
+
+
+(let ((x 'a))
+ (equal (ctypecase x
+ (cons "cons")
+ (symbol "symbol")
+ (number "number"))
+ "symbol"))
+
+(let ((x (list 'a)))
+ (equal (ctypecase x
+ (cons "cons")
+ (symbol "symbol")
+ (number "number"))
+ "cons"))
+
+(let ((x 0))
+ (equal (ctypecase x
+ (cons "cons")
+ (symbol "symbol")
+ (number "number"))
+ "number"))
+
+(HANDLER-CASE
+ (LET ((X (MAKE-ARRAY '(3 3))))
+ (CTYPECASE X
+ (CONS "cons")
+ (SYMBOL "symbol")
+ (NUMBER "number")))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+
+
+(HANDLER-CASE
+ (LET ((A NIL)) (CTYPECASE A))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+
+;; (let ((x ""))
+;; (equal (ctypecase x (t "anything"))
+;; "anything"))
+
+(let ((x ""))
+ (and (eql (ctypecase x
+ (string (setq x 'string) 0)
+ (cons (setq x 'cons) 1)
+ (array (setq x 'array) 2))
+ 0)
+ (eq x 'string)))
+
+(let ((x (list nil)))
+ (and (eql (ctypecase x
+ (string (setq x 'string) 0)
+ (cons (setq x 'cons) 1)
+ (array (setq x 'array) 2))
+ 1)
+ (eq x 'cons)))
+
+
+(let ((x #*01))
+ (and (eql (ctypecase x
+ (string (setq x 'string) 0)
+ (cons (setq x 'cons) 1)
+ (array (setq x 'array) 2))
+ 2)
+ (eq x 'array)))
+
+;; (let ((x #\a))
+;; (and (eql (ctypecase x
+;; (string (setq x 'string) 0)
+;; (cons (setq x 'cons) 1)
+;; (array (setq x 'array) 2)
+;; (t (setq x 't) 9))
+;; 9)
+;; (eq x 't)))
+
+(HANDLER-CASE
+ (LET ((X #\a))
+ (CTYPECASE X
+ (STRING (SETQ X 'STRING) 0)
+ (CONS (SETQ X 'CONS) 1)
+ (ARRAY (SETQ X 'ARRAY) 2)))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+
+(let ((x #*01))
+ (and (equal (multiple-value-list (ctypecase x
+ (string (setq x 'string) (values 'string 0))
+ (cons (setq x 'cons) (values 'cons 1))
+ (array (setq x 'array) (values 'array 2))))
+ '(array 2))
+ (eq x 'array)))
+
+
+(let ((x 'a))
+ (equal (etypecase x
+ (cons "cons")
+ (symbol "symbol")
+ (number "number"))
+ "symbol"))
+
+(let ((x (list 'a)))
+ (equal (etypecase x
+ (cons "cons")
+ (symbol "symbol")
+ (number "number"))
+ "cons"))
+
+(let ((x 0))
+ (equal (etypecase x
+ (cons "cons")
+ (symbol "symbol")
+ (number "number"))
+ "number"))
+
+(HANDLER-CASE
+ (PROGN
+ (LET ((X (MAKE-ARRAY '(3 3))))
+ (ETYPECASE X (CONS "cons") (SYMBOL "symbol") (NUMBER "number"))))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+
+
+(HANDLER-CASE
+ (PROGN
+ (LET ((A NIL))
+ (ETYPECASE A)))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+
+;; (let ((x ""))
+;; (equal (etypecase x
+;; (t "anything"))
+;; "anything"))
+
+(let ((x ""))
+ (and (eql (etypecase x
+ (string (setq x 'string) 0)
+ (cons (setq x 'cons) 1)
+ (array (setq x 'array) 2))
+ 0)
+ (eq x 'string)))
+
+(let ((x (list nil)))
+ (and (eql (etypecase x
+ (string (setq x 'string) 0)
+ (cons (setq x 'cons) 1)
+ (array (setq x 'array) 2))
+ 1)
+ (eq x 'cons)))
+
+
+(let ((x #*01))
+ (and (eql (etypecase x
+ (string (setq x 'string) 0)
+ (cons (setq x 'cons) 1)
+ (array (setq x 'array) 2))
+ 2)
+ (eq x 'array)))
+
+;; (let ((x #\a))
+;; (and (eql (etypecase x
+;; (string (setq x 'string) 0)
+;; (cons (setq x 'cons) 1)
+;; (array (setq x 'array) 2)
+;; (t (setq x 't) 9))
+;; 9)
+;; (eq x 't)))
+
+(HANDLER-CASE
+ (PROGN
+ (LET ((X #\a))
+ (ETYPECASE X
+ (STRING (SETQ X 'STRING) 0)
+ (CONS (SETQ X 'CONS) 1)
+ (ARRAY (SETQ X 'ARRAY) 2))))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+
+(let ((x #*01))
+ (and (equal (multiple-value-list (etypecase x
+ (string (setq x 'string) (values 'string 0))
+ (cons (setq x 'cons) (values 'cons 1))
+ (array (setq x 'array) (values 'array 2))))
+ '(array 2))
+ (eq x 'array)))
+
+
+(macro-function 'multiple-value-bind)
+(equal (multiple-value-bind (f r)
+ (floor 130 11)
+ (list f r))
+ '(11 9))
+
+(multiple-value-bind (a b c d)
+ (values 0 1 2 3 4 5)
+ (and (eql a 0)
+ (eql b 1)
+ (eql c 2)
+ (eql d 3)))
+
+(multiple-value-bind (a b c d)
+ (values 0 1)
+ (and (eql a 0)
+ (eql b 1)
+ (eql c nil)
+ (eql d nil)))
+
+(equal (multiple-value-list (multiple-value-bind (a b)
+ (values 0 1)
+ (values a b 2 3)))
+ '(0 1 2 3))
+
+(multiple-value-bind ()
+ (values 0 1 2)
+ t)
+
+(null (multiple-value-bind () nil))
+
+(eql (multiple-value-bind (a)
+ (floor 130 11)
+ (+ a 10))
+ 21)
+
+(eql (multiple-value-bind (a)
+ (floor 130 11)
+ (+ a 10)
+ (incf a 100)
+ (+ a 10))
+ 121)
+
+
+
+(equal (multiple-value-call #'list 1 '/ (values 2 3) '/ (values) '/ (floor 2.5))
+ '(1 / 2 3 / / 2 0.5))
+(eql (+ (floor 5 3) (floor 19 4)) (+ 1 4))
+(eql (multiple-value-call #'+ (floor 5 3) (floor 19 4)) (+ 1 2 4 3))
+
+(let ((list nil))
+ (and (eql (multiple-value-call (progn (push 'function list) #'+)
+ (progn (push 0 list) 0)
+ (progn (push 1 list) (values 1 2))
+ (progn (push 2 list) (values 3 4 5))
+ (progn (push 3 list) (values 6 7 8 9)))
+ 45)
+ (equal (reverse list) '(function 0 1 2 3))))
+
+(eql (multiple-value-call #'+ 0 1 2 3 4) 10)
+(eql (multiple-value-call #'+) 0)
+(equal (multiple-value-list
+ (multiple-value-call #'values
+ 0 1 (values 2) (values 3 4) (values 5 6 7)))
+ '(0 1 2 3 4 5 6 7))
+(special-operator-p 'multiple-value-call)
+
+
+
+(macro-function 'multiple-value-list)
+(equal (multiple-value-list (floor -3 4)) '(-1 1))
+(equal (multiple-value-list
+ (progn
+ (values 'a 'b)
+ 0))
+ '(0))
+(equal (multiple-value-list
+ (prog1
+ (values 'a 'b)
+ 0))
+ '(a))
+
+(equal (multiple-value-list
+ (multiple-value-prog1
+ (values 'a 'b)
+ 0))
+ '(a b))
+
+(special-operator-p 'multiple-value-prog1)
+(eql (multiple-value-prog1 1 2 3) 1)
+(eql (multiple-value-prog1 1 2 3) 1)
+
+
+(let ((temp '(1 2 3)))
+ (multiple-value-bind (a b c)
+ (multiple-value-prog1
+ (values-list temp)
+ (setq temp nil)
+ (values-list temp))
+ (and (eql a 1)
+ (eql b 2)
+ (eql c 3))))
+
+
+(zerop (multiple-value-prog1 0
+ (values 0 1)
+ (values 0 1 2)))
+
+(equal (multiple-value-list (multiple-value-prog1 (progn 0
+ (values 0 1)
+ (values 0 1 2))))
+ '(0 1 2))
+
+
+(let (quotient remainder)
+ (and (eql (multiple-value-setq (quotient remainder) (truncate 3.2 2)) 1)
+ (eql quotient 1)
+ (eql remainder 1.2)))
+(let ((a 7)
+ (b 8)
+ (c 9))
+ (and (eql (multiple-value-setq (a b c) (values 1 2)) 1)
+ (eql a 1)
+ (eql b 2)
+ (eql c NIL)))
+
+(let ((a 0)
+ (b 1))
+ (and (eql (multiple-value-setq (a b) (values 4 5 6)) 4)
+ (eql a 4)
+ (eql b 5)))
+
+
+(null (multiple-value-list (values-list nil)))
+(equal (multiple-value-list (values-list '(1))) '(1))
+(equal (multiple-value-list (values-list '(1 2))) '(1 2))
+(equal (multiple-value-list (values-list '(1 2 3))) '(1 2 3))
+
+(every #'(lambda (list) (equal (multiple-value-list (values-list list)) list))
+ '()
+ '(a)
+ '(a b)
+ '(a b c)
+ '(a b c d)
+ '(a b c d e)
+ '(a b c d e f)
+ '(a b c d e f g)
+ '(a b c d e f g h))
+
+
+(macro-function 'nth-value)
+(eql (nth-value 0 (values 'a 'b)) 'A)
+(eql (nth-value 1 (values 'a 'b)) 'B)
+(null (nth-value 2 (values 'a 'b)))
+(multiple-value-bind (a b eq?)
+ (let* ((x 83927472397238947423879243432432432)
+ (y 32423489732)
+ (a (nth-value 1 (floor x y)))
+ (b (mod x y)))
+ (values a b (= a b)))
+ (and (eql a 3332987528)
+ (eql b 3332987528)
+ eq?))
+
+(null (nth-value 0 (values)))
+(eql (nth-value 0 1) 1)
+(null (nth-value 1 1))
+(eql (nth-value 0 (values 0 1 2)) 0)
+(eql (nth-value 1 (values 0 1 2)) 1)
+(eql (nth-value 2 (values 0 1 2)) 2)
+(eql (nth-value 3 (values 0 1 2)) nil)
+(eql (nth-value 4 (values 0 1 2)) nil)
+(eql (nth-value 5 (values 0 1 2)) nil)
+
+
+(let ((z (list 0 1 2 3)))
+ (eql (prog* ((y z)
+ (x (car y)))
+ (return x))
+ (car z)))
+
+
+(macro-function 'prog)
+(macro-function 'prog*)
+(let ((a 1))
+ (eq (prog ((a 2) (b a)) (return (if (= a b) '= '/=))) '/=))
+
+(eq (prog* ((a 2) (b a)) (return (if (= a b) '= '/=))) '=)
+(null (prog () 'no-return-value))
+
+(flet ((king-of-confusion (w)
+ "Take a cons of two lists and make a list of conses.
+Think of this function as being like a zipper."
+ (prog (x y z) ;Initialize x, y, z to NIL
+ (setq y (car w) z (cdr w))
+ loop
+ (cond ((null y) (return x))
+ ((null z) (go err)))
+ rejoin
+ (setq x (cons (cons (car y) (car z)) x))
+ (setq y (cdr y) z (cdr z))
+ (go loop)
+ err
+ (cerror "Will self-pair extraneous items"
+ "Mismatch - gleep! ~S" y)
+ (setq z y)
+ (go rejoin))))
+ (and (equal (king-of-confusion '((0 1 2) . (a b c)))
+ '((2 . C) (1 . B) (0 . A)))
+ (equal (king-of-confusion '((0 1 2 3 4 5) . (a b c d e f)))
+ '((5 . F) (4 . E) (3 . D) (2 . C) (1 . B) (0 . A)))))
+
+
+(null (prog () t))
+(null (prog ()))
+(eql (let ((a 0)
+ (b 0))
+ (prog ((a 10)
+ (b 100))
+ (return (+ a b))))
+ 110)
+
+(prog (a
+ (b 1)
+ (c 2))
+ (return (and (null a) (eql b 1) (eql c 2))))
+
+(prog ((a 0)
+ b
+ (c 2))
+ (return (and (eql a 0) (null b) (eql c 2))))
+
+(prog ((a 0)
+ (b 1)
+ c)
+ (return (and (eql a 0) (eql b 1) (null c))))
+
+(prog (a b c)
+ (return (every #'null (list a b c))))
+
+(eql (let ((a 0))
+ (declare (special a))
+ (flet ((ref-a () a))
+ (prog ((a 10))
+ (declare (special a))
+ (return (ref-a)))))
+ 10)
+
+(let ((a 0))
+ (declare (special a))
+ (and (eql (flet ((ref-a () a))
+ (prog ((a 10)
+ b
+ (c 100))
+ (declare (special a))
+ (setq b 1)
+ (return (+ (ref-a) b c))))
+ 111)
+ (eql a 0)))
+
+(let ((a 0))
+ (declare (special a))
+ (and (equal (multiple-value-list (flet ((ref-a () a))
+ (prog ((a 10)
+ b
+ (c 100))
+ (declare (special a))
+ (setq b 1)
+ (return (values (ref-a) b c)))))
+ '(10 1 100))
+ (eql a 0)))
+
+(let ((a 0))
+ (and (eql (prog () (return a)) 0)
+ (eql a 0)))
+
+
+(flet ((rev (list)
+ (prog ((x list)
+ (result nil))
+ top
+ (when (null x)
+ (return result))
+ (psetq x (cdr x)
+ result (cons (car x) result))
+ (go top))))
+ (and (equal (rev '(0 1 2 3))
+ '(3 2 1 0))
+ (equal (rev nil)
+ nil)
+ (equal (rev '(0))
+ '(0))))
+
+(eql (prog (val)
+ (setq val 1)
+ (go point-a)
+ (incf val 16)
+ point-c
+ (incf val 04)
+ (go point-b)
+ (incf val 32)
+ point-a
+ (incf val 02)
+ (go point-c)
+ (incf val 64)
+ point-b
+ (incf val 08)
+ (return val))
+ 15)
+
+(let ((a 0))
+ (and (equal (multiple-value-list (prog ((a 100)
+ (b a)
+ (c 1))
+ (return (values a b c))))
+ '(100 0 1))
+ (eql a 0)))
+
+
+(null (prog* () 'no-return-value))
+(flet ((king-of-confusion (w)
+ "Take a cons of two lists and make a list of conses.
+Think of this function as being like a zipper."
+ (prog* (x y z) ;Initialize x, y, z to NIL
+ (setq y (car w) z (cdr w))
+ loop
+ (cond ((null y) (return x))
+ ((null z) (go err)))
+ rejoin
+ (setq x (cons (cons (car y) (car z)) x))
+ (setq y (cdr y) z (cdr z))
+ (go loop)
+ err
+ (cerror "Will self-pair extraneous items"
+ "Mismatch - gleep! ~S" y)
+ (setq z y)
+ (go rejoin))))
+ (and (equal (king-of-confusion '((0 1 2) . (a b c)))
+ '((2 . C) (1 . B) (0 . A)))
+ (equal (king-of-confusion '((0 1 2 3 4 5) . (a b c d e f)))
+ '((5 . F) (4 . E) (3 . D) (2 . C) (1 . B) (0 . A)))))
+
+(null (prog* () t))
+(null (prog* ()))
+(eql (let ((a 0)
+ (b 0))
+ (prog* ((a 10)
+ (b 100))
+ (return (+ a b))))
+ 110)
+
+(prog* (a
+ (b 1)
+ (c 2))
+ (return (and (null a) (eql b 1) (eql c 2))))
+
+(prog* ((a 0)
+ b
+ (c 2))
+ (return (and (eql a 0) (null b) (eql c 2))))
+
+(prog* ((a 0)
+ (b 1)
+ c)
+ (return (and (eql a 0) (eql b 1) (null c))))
+
+(prog* (a b c)
+ (return (every #'null (list a b c))))
+
+(eql (let ((a 0))
+ (declare (special a))
+ (flet ((ref-a () a))
+ (prog* ((a 10))
+ (declare (special a))
+ (return (ref-a)))))
+ 10)
+
+(let ((a 0))
+ (declare (special a))
+ (and (eql (flet ((ref-a () a))
+ (prog* ((a 10)
+ b
+ (c 100))
+ (declare (special a))
+ (setq b 1)
+ (return (+ (ref-a) b c))))
+ 111)
+ (eql a 0)))
+
+(let ((a 0))
+ (declare (special a))
+ (and (equal (multiple-value-list (flet ((ref-a () a))
+ (prog* ((a 10)
+ b
+ (c 100))
+ (declare (special a))
+ (setq b 1)
+ (return (values (ref-a) b c)))))
+ '(10 1 100))
+ (eql a 0)))
+
+(let ((a 0))
+ (and (eql (prog* () (return a)) 0)
+ (eql a 0)))
+
+
+(flet ((rev (list)
+ (prog* ((x list)
+ (result nil))
+ top
+ (when (null x)
+ (return result))
+ (psetq x (cdr x)
+ result (cons (car x) result))
+ (go top))))
+ (and (equal (rev '(0 1 2 3))
+ '(3 2 1 0))
+ (equal (rev nil)
+ nil)
+ (equal (rev '(0))
+ '(0))))
+
+(eql (prog* (val)
+ (setq val 1)
+ (go point-a)
+ (incf val 16)
+ point-c
+ (incf val 04)
+ (go point-b)
+ (incf val 32)
+ point-a
+ (incf val 02)
+ (go point-c)
+ (incf val 64)
+ point-b
+ (incf val 08)
+ (return val))
+ 15)
+
+(let ((a 0))
+ (and (equal (multiple-value-list (prog* ((a 100)
+ (b a)
+ (c 1))
+ (return (values a b c))))
+ '(100 100 1))
+ (eql a 0)))
+
+
+
+(macro-function 'prog1)
+(macro-function 'prog2)
+
+(eql (let ((temp 1))
+ (prog1 temp (incf temp) temp))
+ 1)
+(let ((temp t))
+ (and (eq (prog1 temp (setq temp nil)) 't)
+ (null temp)))
+
+(equal (multiple-value-list (prog1 (values 1 2 3) 4)) '(1))
+
+(let ((temp (list 'a 'b 'c)))
+ (and (eq (prog1 (car temp) (setf (car temp) 'alpha)) 'a)
+ (equal temp '(ALPHA B C))))
+
+(equal (flet ((swap-symbol-values (x y)
+ (setf (symbol-value x)
+ (prog1 (symbol-value y)
+ (setf (symbol-value y) (symbol-value x))))))
+ (let ((*foo* 1) (*bar* 2))
+ (declare (special *foo* *bar*))
+ (swap-symbol-values '*foo* '*bar*)
+ (list *foo* *bar*)))
+ '(2 1))
+
+(let ((temp 1))
+ (and (eql (prog2 (incf temp) (incf temp) (incf temp)) 3)
+ (eql temp 4)))
+
+(equal (multiple-value-list (prog2 1 (values 2 3 4) 5)) '(2))
+(equal (multiple-value-list (prog2 1 (values 2 3 4) 5 (values 6 7))) '(2))
+
+(eql (prog1 1) 1)
+(eql (prog1 1 2) 1)
+(eql (prog1 1 2 3) 1)
+
+(equal (multiple-value-list (prog1 (values 1 2 3))) '(1))
+
+(equal (multiple-value-list (prog1
+ (values 1 2 3)
+ (values 4 5 6)
+ (values 7 8 9)))
+ '(1))
+
+(eql (prog2 1 2) 2)
+(eql (prog2 1 2 3) 2)
+(eql (prog2 1 2 3 4) 2)
+
+(let ((x 0))
+ (and (eql (prog2 (incf x)
+ (incf x)
+ (incf x)
+ (incf x))
+ 2)
+ (eql x 4)))
+
+
+
+(let ((x (cons 'a 'b))
+ (y (list 1 2 3)))
+ (and (equal (setf (car x) 'x (cadr y) (car x) (cdr x) y) '(1 X 3))
+ (equal x '(X 1 X 3))
+ (equal y '(1 X 3))))
+
+(let ((x (cons 'a 'b))
+ (y (list 1 2 3)))
+ (and (null (psetf (car x) 'x (cadr y) (car x) (cdr x) y))
+ (equal x '(X 1 A 3))
+ (equal y '(1 A 3))))
+
+(null (setf))
+(null (psetf))
+
+(let ((a 0))
+ (and (eql (setf a 10) 10)
+ (eql a 10)))
+
+(let ((a 0)
+ (b 1))
+ (and (eql (setf a 10 b 20) 20)
+ (eql a 10)
+ (eql b 20)))
+
+(let ((a 0)
+ (b 1)
+ (c 2))
+ (and (eql (setf a 10 b (+ a 10) c (+ b 10)) 30)
+ (eql a 10)
+ (eql b 20)
+ (eql c 30)))
+
+(let ((x (list 0 1 2)))
+ (and (eq (setf (car x) 'a) 'a)
+ (eq (setf (cadr x) 'b) 'b)
+ (eq (setf (caddr x) 'c) 'c)
+ (equal x '(a b c))))
+
+
+(let ((a 0))
+ (and (null (psetf a 10))
+ (eql a 10)))
+
+(let ((a 0)
+ (b 1))
+ (and (null (psetf a 10 b 20))
+ (eql a 10)
+ (eql b 20)))
+
+(let ((a 0)
+ (b 1)
+ (c 2))
+ (and (null (psetf a 10 b (+ a 10) c (+ b 10)))
+ (eql a 10)
+ (eql b 10)
+ (eql c 11)))
+
+(let ((x (list 0 1 2)))
+ (and (null (psetf (car x) 'a))
+ (null (psetf (cadr x) 'b))
+ (null (psetf (caddr x) 'c))
+ (equal x '(a b c))))
+
+
+(let ((x (make-array '(2 3) :initial-contents '((a b c) (x y z)))))
+ (and (eql (setf (aref x 0 0) 0.0) 0.0)
+ (eql (setf (aref x 0 1) 0.1) 0.1)
+ (eql (setf (aref x 0 2) 0.2) 0.2)
+ (eql (setf (aref x 1 0) 1.0) 1.0)
+ (eql (setf (aref x 1 1) 1.1) 1.1)
+ (eql (setf (aref x 1 2) 1.2) 1.2)
+ (equalp x #2A((0.0 0.1 0.2) (1.0 1.1 1.2)))))
+
+(let ((x (make-array 4 :element-type 'bit :initial-element 0)))
+ (and (equalp x #*0000)
+ (eql (setf (bit x 0) 1) 1)
+ (eql (setf (bit x 2) 1) 1)
+ (equal x #*1010)))
+
+(let ((x (copy-seq "dog")))
+ (and (eql (setf (char x 0) #\c) #\c)
+ (eql (setf (char x 1) #\a) #\a)
+ (eql (setf (char x 2) #\t) #\t)
+ (equal x "cat")))
+
+(let ((x (copy-seq "dog")))
+ (and (eql (setf (schar x 0) #\c) #\c)
+ (eql (setf (schar x 1) #\a) #\a)
+ (eql (setf (schar x 2) #\t) #\t)
+ (equal x "cat")))
+
+(let ((x (copy-seq "dog")))
+ (and (eql (setf (elt x 0) #\c) #\c)
+ (eql (setf (elt x 1) #\a) #\a)
+ (eql (setf (elt x 2) #\t) #\t)
+ (equal x "cat")))
+
+(let ((x (list 0 1 2)))
+ (and (eql (setf (elt x 0) #\c) #\c)
+ (eql (setf (elt x 1) #\a) #\a)
+ (eql (setf (elt x 2) #\t) #\t)
+ (equal x '(#\c #\a #\t))))
+
+(let ((x #'(lambda (a) (+ a 10)))
+ (saved (when (fboundp 'test-fn) (fdefinition 'test-fn))))
+ (unwind-protect (and (eq (setf (fdefinition 'test-fn) x) x)
+ (eql (test-fn 10) 20))
+ (when saved
+ (setf (fdefinition 'test-fn) saved))))
+
+(let ((table (make-hash-table)))
+ (and (equal (multiple-value-list (gethash 1 table)) '(NIL NIL))
+ (equal (multiple-value-list (gethash 1 table 2)) '(2 NIL))
+ (equal (setf (gethash 1 table) "one") "one")
+ (equal (setf (gethash 2 table "two") "two") "two")
+ (multiple-value-bind (value present-p) (gethash 1 table)
+ (and (equal value "one")
+ present-p))
+ (multiple-value-bind (value present-p) (gethash 2 table)
+ (and (equal value "two")
+ present-p))))
+
+(let ((table (make-hash-table)))
+ (and (equal (multiple-value-list (gethash nil table)) '(NIL NIL))
+ (null (setf (gethash nil table) nil))
+ (multiple-value-bind (value present-p) (gethash nil table)
+ (and (equal value NIL)
+ present-p))))
+
+(let ((x (copy-seq #*0101)))
+ (and (eql (setf (sbit x 0) 1) 1)
+ (eql (setf (sbit x 2) 1) 1)
+ (equal x #*1111)))
+
+
+(let ((a 0)
+ (b 1))
+ (and (equal (multiple-value-list (setf (values a b) (values 'x 'y 'z)))
+ '(x y))
+ (eq a 'x)
+ (eq b 'y)))
+
+(let ((x (list 0 1 2))
+ (order nil))
+ (and
+ (equal (multiple-value-list (setf (values (car (prog1 x (push 0 order)))
+ (cadr (prog1 x (push 1 order)))
+ (caddr (prog1 x (push 2 order))))
+ (values 'a 'b)))
+ '(a b nil))
+ (equal x '(a b nil))
+ (equal order '(2 1 0))))
+
+
+(let ((a 'a)
+ (b 'b)
+ (c 'c))
+ (and (equal (multiple-value-list (setf (values (values a) (values b c))
+ (values 0 1 2 3 4)))
+ '(0 1))
+ (eql a 0)
+ (eql b 1)
+ (null c)))
+
+(let ((a 'a)
+ (b 'b)
+ (c 'c)
+ (d 'd))
+ (and (equal (multiple-value-list (setf (values (values a b) (values c d))
+ (values 0 1 2 3 4)))
+ '(0 1))
+ (eql a 0)
+ (null b)
+ (eql c 1)
+ (null d)))
+
+(let ((a 'a)
+ (b 'b)
+ (c 'c)
+ (d 'd))
+ (and (equal (multiple-value-list (setf (values (values a b) (values c d))
+ (values 0)))
+ '(0 nil))
+ (eql a 0)
+ (null b)
+ (null c)
+ (null d)))
+
+(let ((a 'a)
+ (b 'b)
+ (c 'c))
+ (and (equal (multiple-value-list (setf (values a) (values 0 1 2)))
+ '(0))
+ (eql a 0)
+ (eq b 'b)
+ (eq c 'c)))
+
+
+(let ((x (list 1 2 3))
+ (y 'trash))
+ (and (eq (shiftf y x (cdr x) '(hi there)) 'TRASH)
+ (equal x '(2 3))
+ (equal y '(1 HI THERE))))
+
+(let ((x (list 'a 'b 'c)))
+ (and (eq (shiftf (cadr x) 'z) 'B)
+ (equal x '(A Z C))
+ (eq (shiftf (cadr x) (cddr x) 'q) 'Z)
+ (equal x '(A (C) . Q))))
+
+(let ((n 0)
+ (x (list 'a 'b 'c 'd)))
+ (and (eq (shiftf (nth (setq n (+ n 1)) x) 'z) 'B)
+ (equal x '(A Z C D))))
+
+
+(let ((a 0)
+ (b 1)
+ (c 2)
+ (d 3))
+ (and (equal (multiple-value-list (shiftf (values a b) (values c d)
+ (values 4 5)))
+ '(0 1))
+ (eql a 2)
+ (eql b 3)
+ (eql c 4)
+ (eql d 5)))
+
+
+
+(let ((n 0)
+ (x (list 'a 'b 'c 'd 'e 'f 'g)))
+ (and (null (rotatef (nth (incf n) x)
+ (nth (incf n) x)
+ (nth (incf n) x)))
+ (equal x '(A C D B E F G))))
+
+(let ((x (list 'a 'b 'c)))
+ (and (null (rotatef (first x) (second x) (third x)))
+ (equal x '(b c a))))
+
+(let ((x (list 'a 'b 'c 'd 'e 'f)))
+ (and (null (rotatef (second x) (third x) (fourth x) (fifth x)))
+ (equal x '(a c d e b f))))
+
+(null (rotatef))
+(let ((a 0))
+ (and (null (rotatef a))
+ (zerop a)))
+
+(let ((x (list 'a 'b 'c))
+ (order nil))
+ (and (null (rotatef (first (progn (push 1 order) x))
+ (second (progn (push 2 order) x))
+ (third (progn (push 3 order) x))))
+ (equal x '(b c a))
+ (equal order '(3 2 1))))
+
+(let ((x (list 'a 'b 'c))
+ (order nil))
+ (and (null (psetf (first (progn (push 1 order) x))
+ (second (progn (push 2 order) x))
+
+ (second (progn (push 2 order) x))
+ (third (progn (push 3 order) x))
+
+ (third (progn (push 3 order) x))
+ (first (progn (push 1 order) x))))
+ (equal x '(b c a))
+ (equal order '(1 3 3 2 2 1))))
+
+(let ((a 0)
+ (b 1)
+ (c 2)
+ (d 3))
+ (and (null (rotatef (values a b) (values c d)))
+ (eql a 2)
+ (eql b 3)
+ (eql c 0)
+ (eql d 1)))
+
diff --git a/Sacla/tests/must-do.lisp b/Sacla/tests/must-do.lisp
new file mode 100644
index 0000000..7cbd326
--- /dev/null
+++ b/Sacla/tests/must-do.lisp
@@ -0,0 +1,451 @@
+;; Copyright (C) 2002-2004, Yuji Minejima <ggb01164@nifty.ne.jp>
+;; ALL RIGHTS RESERVED.
+;;
+;; $Id: must-do.lisp,v 1.8 2004/02/20 07:23:42 yuji Exp $
+;;
+;; Redistribution and use in source and binary forms, with or without
+;; modification, are permitted provided that the following conditions
+;; are met:
+;;
+;; * Redistributions of source code must retain the above copyright
+;; notice, this list of conditions and the following disclaimer.
+;; * 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.
+;;
+;; 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
+;; OWNER 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.
+
+;; dotimes
+(null (dotimes (i 10)))
+(= (dotimes (temp-one 10 temp-one)) 10)
+(let ((temp-two 0))
+ (and (eq t (dotimes (temp-one 10 t) (incf temp-two)))
+ (eql temp-two 10)))
+
+(progn
+ (defun palindromep (string &optional (start 0) (end (length string)))
+ (dotimes (k (floor (- end start) 2) t)
+ (unless (char-equal (char string (+ start k))
+ (char string (- end k 1)))
+ (return nil))))
+ (and (palindromep "Able was I ere I saw Elba")
+ (not (palindromep "A man, a plan, a canal--Panama!"))
+ (equal (remove-if-not #'alpha-char-p ;Remove punctuation.
+ "A man, a plan, a canal--Panama!")
+ "AmanaplanacanalPanama")
+ (palindromep (remove-if-not #'alpha-char-p
+ "A man, a plan, a canal--Panama!"))
+ (palindromep
+ (remove-if-not #'alpha-char-p
+ "Unremarkable was I ere I saw Elba Kramer, nu?"))))
+
+
+(let ((count 0))
+ (eql (dotimes (i 5 count) (incf count)) 5))
+
+(let ((count 0))
+ (eql (dotimes (i 1 count) (incf count)) 1))
+
+(let ((count 0))
+ (zerop (dotimes (i 0 count) (incf count))))
+
+(let ((count 0))
+ (zerop (dotimes (i -1 count) (incf count))))
+
+(let ((count 0))
+ (zerop (dotimes (i -100 count) (incf count))))
+
+(eql (dotimes (i 3 i)) 3)
+(eql (dotimes (i 2 i)) 2)
+(eql (dotimes (i 1 i)) 1)
+(eql (dotimes (i 0 i)) 0)
+(eql (dotimes (i -1 i)) 0)
+(eql (dotimes (i -2 i)) 0)
+(eql (dotimes (i -10 i)) 0)
+
+(let ((list nil))
+ (and (eq (dotimes (i 10 t) (push i list)) t)
+ (equal list '(9 8 7 6 5 4 3 2 1 0))))
+
+(let ((list nil))
+ (equal (dotimes (i 10 (push i list)) (push i list))
+ '(10 9 8 7 6 5 4 3 2 1 0)))
+
+(let ((list nil))
+ (equal (dotimes (i '10 (push i list)) (push i list))
+ '(10 9 8 7 6 5 4 3 2 1 0)))
+
+(let ((list nil))
+ (equal (dotimes (i (/ 100 10) (push i list)) (push i list))
+ '(10 9 8 7 6 5 4 3 2 1 0)))
+
+(null (dotimes (i 10 t) (return nil)))
+
+(equal (multiple-value-list (dotimes (i 10 t) (return (values 'a 'b 'c))))
+ '(a b c))
+
+(let ((val 0))
+ (= (dotimes (i 10 val)
+ (incf val 1)
+ (when (< i 9)
+ (go lp))
+ (incf val 2)
+ lp
+ (incf val 3))
+ 42))
+
+(= (let ((val 0))
+ (dotimes (i 10 val)
+ (when (< i 9)
+ (go loop))
+ 9
+ (incf val 100)
+ (go last)
+ loop
+ (when (= i 0)
+ (go 9))
+ (incf val)
+ last))
+ 208)
+
+(= 3 (let ((i 3)) (dotimes (i i i) (declare (fixnum i)))))
+(= 3 (let ((x 0)) (dotimes (i 3 x) (declare (fixnum i)) (incf x))))
+(= 3 (dotimes (i 3 i) (declare (fixnum i))))
+(= 3 (let ((x 0)) (dotimes (i 3 x) (declare (fixnum i)) (incf x))))
+(equal '((8 6 4 2 0) (9 7 5 3 1))
+ (let (even odd)
+ (dotimes (i 10 (list even odd))
+ (cond
+ ((evenp i) (go even))
+ ((oddp i) (go odd))
+ (t (error "logic error")))
+ even (push i even) (go end)
+ odd (push i odd) (go end)
+ end)))
+
+
+;; dolist
+(let ((list (copy-tree '((0) (1) (2) (3)))))
+ (and (null (dolist (item list) (incf (car item))))
+ (equal list '((1) (2) (3) (4)))))
+
+(eq 'ok (dolist (x '(0 1 2) t) (return 'ok)))
+(eq 'ok (dolist (x '(0 1 2) t) (return-from nil 'ok)))
+(equal '(ok fine)
+ (multiple-value-list (dolist (x '(0 1 2) t) (return (values 'ok 'fine)))))
+(equal '(ok fine)
+ (multiple-value-list (dolist (x '(0 1 2) t)
+ (return-from nil (values 'ok 'fine)))))
+
+(null (let ((x '(0 1 2))) (dolist (x x x))))
+(= 3 (let ((x '(0 1 2)) (i 0)) (dolist (x x i) (incf i))))
+
+(null (dolist (x '())))
+(null (dolist (x '(a))))
+(eq t (dolist (x nil t)))
+(= 6 (let ((sum 0))
+ (dolist (x '(0 1 2 3) sum)
+ (declare (fixnum x))
+ (incf sum x))))
+
+(equal '(5 4 3 2 1)
+ (let (stack)
+ (flet ((f () (declare (special x)) (1+ x)))
+ (dolist (x '(0 1 2 3 4) stack)
+ (declare (special x))
+ (declare (type fixnum x))
+ (push (f) stack)))))
+
+(equal '((3 1) (4 2 0))
+ (let (odd even)
+ (dolist (x '(0 1 2 3 4) (list odd even))
+ (cond
+ ((oddp x) (go odd))
+ ((evenp x) (go even))
+ (t (error "This code mustn't have got executed.")))
+ odd (push x odd) (go loop-end)
+ even (push x even) (go loop-end)
+ loop-end)))
+
+
+(let ((temp-two '()))
+ (equal (dolist (temp-one '(1 2 3 4) temp-two) (push temp-one temp-two))
+ '(4 3 2 1)))
+
+(let ((temp-two 0))
+ (and (null (dolist (temp-one '(1 2 3 4)) (incf temp-two)))
+ (eql temp-two 4)))
+
+
+(null (dolist (var nil var)))
+(let ((list nil))
+ (equal (dolist (var '(0 1 2 3) list)
+ (push var list))
+ '(3 2 1 0)))
+
+(let ((list nil))
+ (equal (dolist (var '(0 1 2 3) (push var list))
+ (push var list))
+ '(nil 3 2 1 0)))
+
+
+(null (dolist (var '(0 1 2 3))))
+
+(let ((list nil))
+ (and (null (dolist (var '(0 1 2 3))
+ (push var list)))
+ (equal list '(3 2 1 0))))
+
+(let ((list nil))
+ (and (eq (dolist (var '() t) (push var list)) t)
+ (null list)))
+
+(let ((list '((a) (b) (c)))
+ (count 0))
+ (dolist (var list t)
+ (unless (eq (nth count list) var)
+ (return nil))
+ (incf count)))
+
+(let ((list nil))
+ (and (null (dolist (var '(0 1 2 3) t)
+ (if (= var 2)
+ (return)
+ (push var list))))
+ (equal list '(1 0))))
+
+(let ((val 0))
+ (= (dolist (var '(a b c) val)
+ (incf val 1)
+ (unless (eq var 'c)
+ (go lp))
+ (incf val 2)
+ lp
+ (incf val 3))
+ 14))
+
+(= (let ((val 0))
+ (dolist (i '(0 1 2 3 4 5 6 7 8 9) val)
+ (when (< i 9)
+ (go loop))
+ 9
+ (incf val 100)
+ (go last)
+ loop
+ (when (= i 0)
+ (go 9))
+ (incf val)
+ last))
+ 208)
+
+(let ((val 0))
+ (= (dolist (i '(0 1 2 3 4 5 6 7 8 9) val)
+ (incf val 1)
+ (when (< i 9)
+ (go lp))
+ (incf val 2)
+ lp
+ (incf val 3))
+ 42))
+
+(eq 'ok (block nil
+ (tagbody
+ (dolist (x '(0 1 2 3) t) (when (oddp x) (go there)))
+ there (return 'ok))))
+
+
+
+;; do
+(flet ((rev (list)
+ (do ((x list (cdr x))
+ (reverse nil (cons (car x) reverse)))
+ ((null x) reverse))))
+ (and (null (rev nil))
+ (equal (rev '(0 1 2 3 4)) '(4 3 2 1 0))))
+
+(flet ((nrev (list)
+ (do ((1st (cdr list) (cdr 1st))
+ (2nd list 1st)
+ (3rd '() 2nd))
+ ((null 2nd) 3rd)
+ (rplacd 2nd 3rd))))
+ (and (null (nrev nil))
+ (equal (nrev (list 0 1 2 3 4)) '(4 3 2 1 0))))
+
+(flet ((sub (list start end)
+ (do* ((x (nthcdr start list) (cdr x))
+ (i start (1+ i))
+ (result (list nil))
+ (splice result))
+ ((>= i end) (cdr result))
+ (setq splice (cdr (rplacd splice (list (car x))))))))
+ (and (eq (sub '() 0 0) '())
+ (equal (sub '(0 1 2 3) 1 4) '(1 2 3))
+ (equal (sub '(0 1 2 3) 1 1) '())
+ (equal (sub '(0 1 2 3) 1 2) '(1))
+ (equal (sub '(0 1 2 3) 1 3) '(1 2))))
+
+
+(eql (do ((temp-one 1 (1+ temp-one))
+ (temp-two 0 (1- temp-two)))
+ ((> (- temp-one temp-two) 5) temp-one))
+ 4)
+
+(eql (do ((temp-one 1 (1+ temp-one))
+ (temp-two 0 (1+ temp-one)))
+ ((= 3 temp-two) temp-one))
+ 3)
+
+(eql (do* ((temp-one 1 (1+ temp-one))
+ (temp-two 0 (1+ temp-one)))
+ ((= 3 temp-two) temp-one))
+ 2)
+
+(let ((a-vector (vector 1 nil 3 nil)))
+ (and (null (do ((i 0 (+ i 1))
+ (n (array-dimension a-vector 0)))
+ ((= i n))
+ (when (null (aref a-vector i))
+ (setf (aref a-vector i) 0))))
+ (equalp a-vector #(1 0 3 0))))
+
+(let ((vec (vector 0 1 2 3 4 5 6 7 8 9)))
+ (equalp (do ((i 0 (1+ i))
+ n
+ (j 9 (1- j)))
+ ((>= i j) vec)
+ (setq n (aref vec i))
+ (setf (aref vec i) (aref vec j))
+ (setf (aref vec j) n))
+ #(9 8 7 6 5 4 3 2 1 0)))
+
+(let ((vec (vector 0 1 2 3 4 5 6 7 8 9)))
+ (and (null (do ((i 0 (1+ i))
+ n
+ (j 9 (1- j)))
+ ((>= i j))
+ (setq n (aref vec i))
+ (setf (aref vec i) (aref vec j))
+ (setf (aref vec j) n)))
+ (equalp vec #(9 8 7 6 5 4 3 2 1 0))))
+
+(let ((vec (vector 0 1 2 3 4 5 6 7 8 9)))
+ (and (null (do ((i 0 (1+ i))
+ n
+ (j 9 (1- j)))
+ ((>= i j))
+ (declare (fixnum i j n))
+ (setq n (aref vec i))
+ (setf (aref vec i) (aref vec j))
+ (setf (aref vec j) n)))
+ (equalp vec #(9 8 7 6 5 4 3 2 1 0))))
+
+(let ((vec (vector 0 1 2 3 4 5 6 7 8 9)))
+ (and (null (do ((i 0 (1+ i))
+ n
+ (j 9 (1- j)))
+ ((>= i j))
+ (declare (fixnum i))
+ (declare (fixnum j))
+ (declare (fixnum n))
+ (setq n (aref vec i))
+ (setf (aref vec i) (aref vec j))
+ (setf (aref vec j) n)))
+ (equalp vec #(9 8 7 6 5 4 3 2 1 0))))
+
+(let ((vec (vector 0 1 2 3 4 5 6 7 8 9)))
+ (and (null (do (n
+ (i 0 (1+ i))
+ (j 9 (1- j)))
+ ((>= i j))
+ (declare (fixnum i))
+ (declare (fixnum j))
+ (declare (fixnum n))
+ (setq n (aref vec i))
+ (setf (aref vec i) (aref vec j))
+ (setf (aref vec j) n)))
+ (equalp vec #(9 8 7 6 5 4 3 2 1 0))))
+
+(let ((vec (vector 0 1 2 3 4 5 6 7 8 9)))
+ (and (null (do ((i 0 (1+ i))
+ (j 9 (1- j))
+ n)
+ ((>= i j))
+ (declare (fixnum i))
+ (declare (fixnum j))
+ (declare (fixnum n))
+ (setq n (aref vec i))
+ (setf (aref vec i) (aref vec j))
+ (setf (aref vec j) n)))
+ (equalp vec #(9 8 7 6 5 4 3 2 1 0))))
+
+(= (do* ((list (list 0 1 2 3 4 5 6 7 8 9) (cdr list))
+ (elm (car list) (car list))
+ (n 0 (+ n (or elm 0))))
+ ((endp list) n))
+ 45)
+
+(= (do* ((list (list 0 1 2 3 4 5 6 7 8 9) (cdr list))
+ (elm (car list) (car list))
+ (n 0))
+ ((endp list) n)
+ (incf n elm))
+ 45)
+
+
+(let ((vec (vector 0 1 2 3 4 5 6 7 8 9)))
+ (and (null (do* (n
+ (i 0 (1+ i))
+ (j (- 9 i) (- 9 i)))
+ ((>= i j))
+ (declare (fixnum i))
+ (declare (fixnum j))
+ (declare (fixnum n))
+ (setq n (aref vec i))
+ (setf (aref vec i) (aref vec j))
+ (setf (aref vec j) n)))
+ (equalp vec #(9 8 7 6 5 4 3 2 1 0))))
+
+(let ((vec (vector 0 1 2 3 4 5 6 7 8 9)))
+ (and (null (do* ((i 0 (1+ i))
+ n
+ (j (- 9 i) (- 9 i)))
+ ((>= i j))
+ (declare (fixnum i j n))
+ (setq n (aref vec i))
+ (setf (aref vec i) (aref vec j))
+ (setf (aref vec j) n)))
+ (equalp vec #(9 8 7 6 5 4 3 2 1 0))))
+
+(let ((vec (vector 0 1 2 3 4 5 6 7 8 9)))
+ (and (null (do* ((i 0 (1+ i))
+ (j (- 9 i) (- 9 i))
+ n)
+ ((>= i j))
+ (declare (fixnum i j n))
+ (setq n (aref vec i))
+ (setf (aref vec i) (aref vec j))
+ (setf (aref vec j) n)))
+ (equalp vec #(9 8 7 6 5 4 3 2 1 0))))
+
+(let ((vec (vector 0 1 2 3 4 5 6 7 8 9)))
+ (and (null (do* ((i 0 (1+ i))
+ (j (- 9 i) (- 9 i))
+ n)
+ ((>= i j))
+ (setf n (aref vec i)
+ (aref vec i) (aref vec j)
+ (aref vec j) n)))
+ (equalp vec #(9 8 7 6 5 4 3 2 1 0))))
+
diff --git a/Sacla/tests/must-eval.lisp b/Sacla/tests/must-eval.lisp
new file mode 100644
index 0000000..5b4a8b7
--- /dev/null
+++ b/Sacla/tests/must-eval.lisp
@@ -0,0 +1,44 @@
+;; Copyright (C) 2002-2004, Yuji Minejima <ggb01164@nifty.ne.jp>
+;; ALL RIGHTS RESERVED.
+;;
+;; $Id: must-eval.lisp,v 1.8 2004/08/09 02:49:54 yuji Exp $
+;;
+;; Redistribution and use in source and binary forms, with or without
+;; modification, are permitted provided that the following conditions
+;; are met:
+;;
+;; * Redistributions of source code must retain the above copyright
+;; notice, this list of conditions and the following disclaimer.
+;; * 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.
+;;
+;; 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
+;; OWNER 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.
+
+(= (funcall (lambda (x) (+ x 3)) 4) 7)
+(= (funcall (lambda (&rest args) (apply #'+ args)) 1 2 3 4) 10)
+(functionp (lambda (&rest args) (apply #'+ args)))
+(functionp (macro-function 'lambda))
+
+
+
+(every #'special-operator-p '(block catch eval-when flet function go if labels let let* load-time-value locally macrolet multiple-value-call multiple-value-prog1 progn progv quote return-from setq symbol-macrolet tagbody the throw unwind-protect))
+(not (special-operator-p 'car))
+(not (special-operator-p 'cdr))
+;; Bruno: The spec of MACRO-FUNCTION says that an implementation can have
+;; additional special operators provided the macro expander is available through
+;; MACRO-FUNCTION.
+#-CLISP
+(not (special-operator-p 'cond))
+(not (special-operator-p 'values))
diff --git a/Sacla/tests/must-eval.patch b/Sacla/tests/must-eval.patch
new file mode 100644
index 0000000..8c1211b
--- /dev/null
+++ b/Sacla/tests/must-eval.patch
@@ -0,0 +1,15 @@
+*** sacla/lisp/test/must-eval.lisp 2004-08-03 08:34:54.000000000 +0200
+--- CLISP/clisp-20040712/sacla-tests/must-eval.lisp 2004-08-06 02:38:25.000000000 +0200
+***************
+*** 36,40 ****
+ (every #'special-operator-p '(block catch eval-when flet function go if labels let let* load-time-value locally macrolet multiple-value-call multiple-value-prog1 progn progv quote return-from setq symbol-macrolet tagbody the throw unwind-protect))
+ (not (special-operator-p 'car))
+ (not (special-operator-p 'cdr))
+! (not (special-operator-p 'cond))
+ (not (special-operator-p 'values))
+--- 36,40 ----
+ (every #'special-operator-p '(block catch eval-when flet function go if labels let let* load-time-value locally macrolet multiple-value-call multiple-value-prog1 progn progv quote return-from setq symbol-macrolet tagbody the throw unwind-protect))
+ (not (special-operator-p 'car))
+ (not (special-operator-p 'cdr))
+! #-CLISP (not (special-operator-p 'cond))
+ (not (special-operator-p 'values))
diff --git a/Sacla/tests/must-hash-table.lisp b/Sacla/tests/must-hash-table.lisp
new file mode 100644
index 0000000..d3c1e0c
--- /dev/null
+++ b/Sacla/tests/must-hash-table.lisp
@@ -0,0 +1,696 @@
+;; Copyright (C) 2002-2004, Yuji Minejima <ggb01164@nifty.ne.jp>
+;; ALL RIGHTS RESERVED.
+;;
+;; $Id: must-hash-table.lisp,v 1.8 2004/08/09 02:49:54 yuji Exp $
+;;
+;; Redistribution and use in source and binary forms, with or without
+;; modification, are permitted provided that the following conditions
+;; are met:
+;;
+;; * Redistributions of source code must retain the above copyright
+;; notice, this list of conditions and the following disclaimer.
+;; * 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.
+;;
+;; 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
+;; OWNER 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.
+
+(let ((table (make-hash-table)))
+ (and (hash-table-p table)
+ (eql (setf (gethash "one" table) 1) 1)
+ (equal (multiple-value-list (gethash (copy-seq "one") table))
+ '(NIL NIL))))
+
+(let ((table (make-hash-table :test 'equal)))
+ (and (hash-table-p table)
+ (eql (setf (gethash "one" table) 1) 1)
+ (equal (multiple-value-list (gethash (copy-seq "one") table))
+ '(1 T))))
+
+(make-hash-table :rehash-size 1.5 :rehash-threshold 0.7)
+
+(make-hash-table)
+(hash-table-p (make-hash-table))
+#-CLISP ; Bruno: unfounded expectations about hash-table-test
+(dolist (test '(eq eql equal equalp) t)
+ (let ((hash-table (make-hash-table :test test)))
+ (unless (and (hash-table-p hash-table)
+ (eq (hash-table-test hash-table) test))
+ (return nil))))
+#-CLISP ; Bruno: unfounded expectations about hash-table-test
+(dolist (test '(eq eql equal equalp) t)
+ (let* ((test-function (symbol-function test))
+ (hash-table (make-hash-table :test test-function)))
+ (unless (and (hash-table-p hash-table)
+ (eq (hash-table-test hash-table) test))
+ (return nil))))
+
+(hash-table-p (make-hash-table :size 0))
+(hash-table-p (make-hash-table :size 1))
+(hash-table-p (make-hash-table :size 2))
+(hash-table-p (make-hash-table :size 3))
+(hash-table-p (make-hash-table :size 1000))
+(hash-table-p (make-hash-table :rehash-size 1))
+(hash-table-p (make-hash-table :rehash-size 100))
+(hash-table-p (make-hash-table :rehash-size 1.5))
+#-clisp (hash-table-p (make-hash-table :rehash-size 1.0))
+(hash-table-p (make-hash-table :rehash-threshold 0))
+(hash-table-p (make-hash-table :rehash-threshold 0.0))
+(hash-table-p (make-hash-table :rehash-threshold 0.1))
+(hash-table-p (make-hash-table :rehash-threshold 0.12))
+(hash-table-p (make-hash-table :rehash-threshold 0.5))
+(hash-table-p (make-hash-table :rehash-threshold 2/3))
+(hash-table-p (make-hash-table :rehash-threshold 0.888))
+(hash-table-p (make-hash-table :rehash-threshold 0.99))
+(hash-table-p (make-hash-table :rehash-threshold 1))
+(hash-table-p (make-hash-table :rehash-threshold 1.0))
+
+(let ((table (make-hash-table :size 0 :rehash-size 1.1 :rehash-threshold 0)))
+ (and (dotimes (i 10 t)
+ (setf (gethash i table) i))
+ (dotimes (i 10 t)
+ (unless (eql (gethash i table) i)
+ (return nil)))
+ (hash-table-p table)))
+
+(let ((table (make-hash-table :size 1 :rehash-size 1 :rehash-threshold 1)))
+ (and (dotimes (i 100 t)
+ (setf (gethash i table) i))
+ (dotimes (i 100 t)
+ (unless (eql (gethash i table) i)
+ (return nil)))
+ (hash-table-p table)))
+
+
+
+(not (hash-table-p 'hash-table))
+
+(let ((table (make-hash-table)))
+ (hash-table-p table))
+(not (hash-table-p 37))
+(not (hash-table-p '((a . 1) (b . 2))))
+(not (hash-table-p (type-of (make-hash-table))))
+
+
+(let ((table (make-hash-table)))
+ (and (zerop (hash-table-count table))
+ (equal (setf (gethash 57 table) "fifty-seven") "fifty-seven")
+ (eql (hash-table-count table) 1)
+ (dotimes (i 100 t) (setf (gethash i table) i))
+ (eql (hash-table-count table) 100)))
+
+(zerop (hash-table-count (make-hash-table)))
+(let ((table (make-hash-table)))
+ (and (eql (setf (gethash 'key table) 9) 9)
+ (= (hash-table-count table) 1)))
+
+
+#-CLISP ;Bruno: unfounded expectations about hash-table-rehash-size
+(let ((table (make-hash-table :size 100 :rehash-size 1.4)))
+ (= (hash-table-rehash-size table) 1.4))
+
+#-CLISP ;Bruno: unfounded expectations about hash-table-rehash-threshold
+(let ((table (make-hash-table :size 100 :rehash-threshold 0.5)))
+ (= (hash-table-rehash-threshold table) 0.5))
+
+(<= 0 (hash-table-size (make-hash-table)))
+
+#-CLISP ;Bruno: unfounded expectations about hash-table-test
+(eq 'eq (hash-table-test (make-hash-table :test 'eq)))
+#-CLISP ;Bruno: unfounded expectations about hash-table-test
+(eq 'eq (hash-table-test (make-hash-table :test #'eq)))
+#-CLISP ;Bruno: unfounded expectations about hash-table-test
+(eq 'eql (hash-table-test (make-hash-table)))
+#-CLISP ;Bruno: unfounded expectations about hash-table-test
+(eq 'eql (hash-table-test (make-hash-table :test 'eql)))
+#-CLISP ;Bruno: unfounded expectations about hash-table-test
+(eq 'eql (hash-table-test (make-hash-table :test #'eql)))
+#-CLISP ;Bruno: unfounded expectations about hash-table-test
+(eq 'equal (hash-table-test (make-hash-table :test 'equal)))
+#-CLISP ;Bruno: unfounded expectations about hash-table-test
+(eq 'equal (hash-table-test (make-hash-table :test #'equal)))
+#-CLISP ;Bruno: unfounded expectations about hash-table-test
+(eq 'equalp (hash-table-test (make-hash-table :test 'equalp)))
+#-CLISP ;Bruno: unfounded expectations about hash-table-test
+(eq 'equalp (hash-table-test (make-hash-table :test #'equalp)))
+
+(let* ((table0 (make-hash-table))
+ (table (make-hash-table
+ :size (hash-table-size table0)
+ :test (hash-table-test table0)
+ :rehash-threshold (hash-table-rehash-threshold table0)
+ :rehash-size (hash-table-rehash-size table0))))
+ (and (hash-table-p table)
+ (zerop (hash-table-count table))
+ (eq (type-of table) 'hash-table)))
+
+
+(let ((table (make-hash-table)))
+ (and (equal (multiple-value-list (gethash 1 table)) '(NIL NIL))
+ (equal (multiple-value-list (gethash 1 table 2)) '(2 nil))
+ (equal (setf (gethash 1 table) "one") "one")
+ (equal (setf (gethash 2 table "two") "two") "two")
+ (multiple-value-bind (value present-p) (gethash 1 table)
+ (and (equal value "one") present-p))
+ (multiple-value-bind (value present-p) (gethash 2 table)
+ (and (equal value "two") present-p))
+ (equal (multiple-value-list (gethash nil table)) '(nil nil))
+ (null (setf (gethash nil table) nil))
+ (multiple-value-bind (value present-p) (gethash nil table)
+ (and (not value) present-p))))
+
+(multiple-value-bind (value present-p)
+ (gethash 'key (make-hash-table) 'default)
+ (and (eq value 'default) (not present-p)))
+
+(multiple-value-bind (value present-p)
+ (gethash 'key (make-hash-table))
+ (and (null value) (not present-p)))
+
+
+(let ((table (make-hash-table)))
+ (and (multiple-value-bind (value present-p) (gethash 'key table)
+ (and (null value) (not present-p)))
+ (eql (setf (gethash 'key table) 100) 100)
+ (multiple-value-bind (value present-p) (gethash 'key table)
+ (and (eql value 100) present-p))))
+
+(let ((table (make-hash-table))
+ (list nil))
+ (and (eql (setf (gethash (progn (push 0 list) 0)
+ (progn (push 1 list) table)
+ (progn (push 2 list) 'default))
+ (progn (push 3 list) 9))
+ 9)
+ (equal list '(3 2 1 0))))
+
+(let ((table (make-hash-table)))
+ (and (dotimes (i 100 t)
+ (unless (eql (setf (gethash i table) (* i 10)) (* i 10))
+ (return nil)))
+ (= (hash-table-count table) 100)
+ (dotimes (i 100 t)
+ (unless (multiple-value-bind (value present-p) (gethash i table)
+ (and (eql value (* i 10)) present-p))
+ (return nil)))))
+
+
+(let ((table (make-hash-table)))
+ (and (equal (setf (gethash 100 table) "C") "C")
+ (multiple-value-bind (value present-p) (gethash 100 table)
+ (and (equal value "C") present-p))
+ (remhash 100 table)
+ (multiple-value-bind (value present-p) (gethash 100 table)
+ (and (not value) (not present-p)))
+ (not (remhash 100 table))))
+
+(let ((table (make-hash-table)))
+ (and (zerop (hash-table-count table))
+ (eql (setf (gethash 'a table) 'abc) 'abc)
+ (multiple-value-bind (value present-p) (gethash 'a table)
+ (and (eq value 'abc) present-p))
+ (eql (hash-table-count table) 1)
+ (remhash 'a table)
+ (multiple-value-bind (value present-p) (gethash 'a table)
+ (and (not value) (not present-p)))
+ (zerop (hash-table-count table))))
+
+(not (remhash 'key (make-hash-table)))
+
+
+(with-hash-table-iterator (iterator (make-hash-table))
+ (macrolet ((test (&environment env)
+ (if (macro-function 'iterator env) t nil)))
+ (test)))
+
+
+(let ((table (make-hash-table))
+ (alist nil))
+ (dotimes (i 10) (setf (gethash i table) i))
+ (with-hash-table-iterator (iterator table)
+ (loop
+ (multiple-value-bind (more key value) (iterator)
+ (unless more
+ (return))
+ (push (list key value) alist))))
+ (setq alist (sort alist #'< :key #'car))
+ (equal alist '((0 0) (1 1) (2 2) (3 3) (4 4) (5 5) (6 6) (7 7) (8 8) (9 9))))
+
+
+(let ((table (make-hash-table))
+ (eval 0))
+ (dotimes (i 10) (setf (gethash i table) i))
+ (with-hash-table-iterator (iterator (progn (incf eval) table))
+ (loop
+ (multiple-value-bind (more key value) (iterator)
+ (declare (ignore key value))
+ (unless more
+ (return)))))
+ (eql eval 1))
+
+
+(with-hash-table-iterator (iterator (make-hash-table))
+ (null (iterator)))
+
+
+(let ((table (make-hash-table))
+ alist0 alist1 alist2)
+ (dotimes (i 100) (setf (gethash i table) i))
+ (and (with-hash-table-iterator (iterator0 table)
+ (with-hash-table-iterator (iterator1 table)
+ (with-hash-table-iterator (iterator2 table)
+ (loop
+ (multiple-value-bind (more0 key0 value0) (iterator0)
+ (multiple-value-bind (more1 key1 value1) (iterator1)
+ (multiple-value-bind (more2 key2 value2) (iterator2)
+ (unless (or (every #'null (list more0 more1 more2))
+ (every #'identity (list more0 more1 more2)))
+ (return nil))
+ (when (every #'null (list more0 more1 more2))
+ (return t))
+ (push (cons key0 value0) alist0)
+ (push (cons key1 value1) alist1)
+ (push (cons key2 value2) alist2))))))))
+ (equal (sort alist0 #'< :key #'car)
+ (setq alist1 (sort alist1 #'< :key #'car)))
+ (equal alist1 (sort alist2 #'< :key #'car))))
+
+
+
+(let ((table (make-hash-table :rehash-size 100))
+ (n 0)
+ (alist nil))
+ (and (dolist (key '(a b c d e f g h i j k) t)
+ (unless (eql (setf (gethash key table) n) n)
+ (return nil))
+ (incf n))
+ (remhash 'b table)
+ (remhash 'd table)
+ (remhash 'f table)
+ (remhash 'h table)
+ (remhash 'j table)
+ (not (remhash 'b table))
+ (not (remhash 'd table))
+ (not (remhash 'f table))
+ (not (remhash 'h table))
+ (not (remhash 'j table))
+ (with-hash-table-iterator (iterator table)
+ (loop
+ (multiple-value-bind (more key value) (iterator)
+ (unless more
+ (return t))
+ (push (cons key value) alist))))
+ (equal (sort alist #'< :key #'cdr)
+ '((a . 0) (c . 2) (e . 4) (g . 6) (i . 8) (k . 10)))))
+
+
+(let ((table (make-hash-table)))
+ (and (null (dotimes (i 10) (setf (gethash i table) i)))
+ (eql (let ((sum-of-squares 0))
+ (maphash #'(lambda (key val)
+ (let ((square (* val val)))
+ (incf sum-of-squares square)
+ (setf (gethash key table) square)))
+ table)
+ sum-of-squares)
+ 285)
+ (eql (hash-table-count table) 10)
+ (null (maphash #'(lambda (key val)
+ (when (oddp val) (remhash key table)))
+ table))
+ (eql (hash-table-count table) 5)
+ (let ((alist nil))
+ (and (null (maphash #'(lambda (key val)
+ (push (list key val) alist))
+ table))
+ (equalp (sort alist #'< :key #'car)
+ '((0 0) (2 4) (4 16) (6 36) (8 64)))))))
+
+
+(let ((table (make-hash-table))
+ (alist nil))
+ (and (null (dotimes (i 10) (setf (gethash i table) i)))
+ (null (maphash #'(lambda (key val)
+ (if (evenp key)
+ (setf (gethash key table) (* val val))
+ (remhash key table)))
+ table))
+ (null (maphash #'(lambda (key val) (push (cons key val) alist)) table))
+ (equal (sort alist #'< :key #'car)
+ '((0 . 0) (2 . 4) (4 . 16) (6 . 36) (8 . 64)))))
+
+
+
+(flet ((test-hash-table-iterator (hash-table)
+ (let ((all-entries '())
+ (generated-entries '())
+ (unique (list nil)))
+ (maphash #'(lambda (key value) (push (list key value) all-entries))
+ hash-table)
+ (with-hash-table-iterator (generator-fn hash-table)
+ (loop
+ (multiple-value-bind (more? key value) (generator-fn)
+ (unless more? (return))
+ (unless (eql value (gethash key hash-table unique))
+ (error "Key ~S not found for value ~S" key value))
+ (push (list key value) generated-entries))))
+ (unless (= (length all-entries)
+ (length generated-entries)
+ (length (union all-entries generated-entries
+ :key #'car
+ :test (hash-table-test hash-table))))
+ (error "Generated entries and Maphash entries don't correspond"))
+ t)))
+ (let ((table (make-hash-table :rehash-size 100))
+ (n 0))
+ (and (dolist (key '(a b c d e f g h i j k) t)
+ (unless (eql (setf (gethash key table) n) n)
+ (return nil))
+ (incf n))
+ (remhash 'b table)
+ (remhash 'd table)
+ (remhash 'f table)
+ (remhash 'h table)
+ (remhash 'j table)
+ (not (remhash 'b table))
+ (not (remhash 'd table))
+ (not (remhash 'f table))
+ (not (remhash 'h table))
+ (not (remhash 'j table))
+ (test-hash-table-iterator table)
+ (test-hash-table-iterator (make-hash-table)))))
+
+
+
+
+(let ((table (make-hash-table)))
+ (and (null (dotimes (i 100) (setf (gethash i table) (format nil "~R" i))))
+ (eql (hash-table-count table) 100)
+ (multiple-value-bind (value present-p) (gethash 57 table)
+ (and (equal value "fifty-seven") present-p))
+ (hash-table-p (clrhash table))
+ (zerop (hash-table-count table))
+ (multiple-value-bind (value present-p) (gethash 57 table)
+ (and (null value) (not present-p)))))
+
+
+(let ((code (sxhash 'a)))
+ (and (typep code 'fixnum)
+ (<= 0 code)))
+
+(dolist (item '(a "" #\a (make-hash-table) (make-array '(2 3 4)) #*0101 "xx") t)
+ (let ((code (sxhash item)))
+ (unless (and (typep code 'fixnum) (<= 0 code))
+ (return nil))))
+
+
+
+(let ((table (make-hash-table :rehash-threshold 0.8)))
+ (and (eql (setf (gethash 'key table) 'value0) 'value0)
+ (eql (hash-table-count table) 1)
+ (eql (setf (gethash 'key table) 'value1) 'value1)
+ (eql (hash-table-count table) 1)
+ (eq (gethash 'key table) 'value1)))
+
+(let ((table (make-hash-table :rehash-threshold 0.8)))
+ (and (eql (setf (gethash 'key0 table) 'value0) 'value0)
+ (eql (hash-table-count table) 1)
+ (eql (setf (gethash 'key1 table) 'value1) 'value1)
+ (eql (hash-table-count table) 2)
+ (eql (setf (gethash 'key2 table) 'value2) 'value2)
+ (eql (hash-table-count table) 3)
+ (eql (setf (gethash 'key0 table) 'value00) 'value00)
+ (eql (hash-table-count table) 3)
+ (eql (setf (gethash 'key2 table) 'value22) 'value22)
+ (eql (hash-table-count table) 3)
+ (eq (gethash 'key0 table) 'value00)
+ (eq (gethash 'key1 table) 'value1)
+ (eq (gethash 'key2 table) 'value22)))
+
+
+(let ((table (make-hash-table :size 0 :test 'eq))
+ (key0 (copy-seq "key"))
+ (key1 (copy-seq "key")))
+ (and (not (eq key0 key1))
+ (eq (setf (gethash key0 table) 'value) 'value)
+ (multiple-value-bind (value present-p) (gethash key1 table)
+ (and (null value) (not present-p)))
+ (multiple-value-bind (value present-p) (gethash key0 table)
+ (and (eq value 'value) present-p))))
+
+(let ((table (make-hash-table :size 0 :test 'eql))
+ (key0 (copy-seq "key"))
+ (key1 (copy-seq "key")))
+ (and (not (eql key0 key1))
+ (eq (setf (gethash key0 table) 'value) 'value)
+ (multiple-value-bind (value present-p) (gethash key1 table)
+ (and (null value) (not present-p)))
+ (multiple-value-bind (value present-p) (gethash key0 table)
+ (and (eq value 'value) present-p))))
+
+(let ((table (make-hash-table :size 0 :test 'eql))
+ (key0 1.0)
+ (key1 1.0))
+ (and (eql key0 key1)
+ (eq (setf (gethash key0 table) 'value) 'value)
+ (multiple-value-bind (value present-p) (gethash key1 table)
+ (and (eq value 'value) present-p))
+ (multiple-value-bind (value present-p) (gethash key0 table)
+ (and (eq value 'value) present-p))))
+
+(let ((table (make-hash-table :size 0 :test 'eql))
+ (key0 #\a)
+ (key1 #\a))
+ (and (eql key0 key1)
+ (eq (setf (gethash key0 table) 'value) 'value)
+ (multiple-value-bind (value present-p) (gethash key1 table)
+ (and (eq value 'value) present-p))
+ (multiple-value-bind (value present-p) (gethash key0 table)
+ (and (eq value 'value) present-p))))
+
+(let ((table (make-hash-table :size 0 :test 'eql))
+ (key0 #\a)
+ (key1 #\A))
+ (and (not (eql key0 key1))
+ (eq (setf (gethash key0 table) 'value) 'value)
+ (multiple-value-bind (value present-p) (gethash key1 table)
+ (and (null value) (not present-p)))
+ (multiple-value-bind (value present-p) (gethash key0 table)
+ (and (eq value 'value) present-p))))
+
+(let ((table (make-hash-table :size 16 :test 'equal))
+ (key0 'key)
+ (key1 'key))
+ (and (eq key0 key1)
+ (equal key0 key1)
+ (eq (setf (gethash key0 table) 'value) 'value)
+ (multiple-value-bind (value present-p) (gethash key1 table)
+ (and (eq value 'value) present-p))
+ (multiple-value-bind (value present-p) (gethash key0 table)
+ (and (eq value 'value) present-p))))
+
+(let ((table (make-hash-table :size 0 :test 'equal))
+ (key0 1.0)
+ (key1 1.0))
+ (and (equal key0 key1)
+ (eq (setf (gethash key0 table) 'value) 'value)
+ (multiple-value-bind (value present-p) (gethash key1 table)
+ (and (eq value 'value) present-p))
+ (multiple-value-bind (value present-p) (gethash key0 table)
+ (and (eq value 'value) present-p))))
+
+(let ((table (make-hash-table :size 0 :test 'equal))
+ (key0 #\a)
+ (key1 #\a))
+ (and (equal key0 key1)
+ (eq (setf (gethash key0 table) 'value) 'value)
+ (multiple-value-bind (value present-p) (gethash key1 table)
+ (and (eq value 'value) present-p))
+ (multiple-value-bind (value present-p) (gethash key0 table)
+ (and (eq value 'value) present-p))))
+
+(let ((table (make-hash-table :size 0 :test 'equal))
+ (key0 #\a)
+ (key1 #\A))
+ (and (not (equal key0 key1))
+ (eq (setf (gethash key0 table) 'value) 'value)
+ (multiple-value-bind (value present-p) (gethash key1 table)
+ (and (null value) (not present-p)))
+ (multiple-value-bind (value present-p) (gethash key0 table)
+ (and (eq value 'value) present-p))))
+
+(let ((table (make-hash-table :size 16 :test 'equal))
+ (key0 (copy-seq "key"))
+ (key1 (copy-seq "key")))
+ (and (not (eq key0 key1))
+ (equal key0 key1)
+ (eq (setf (gethash key0 table) 'value) 'value)
+ (multiple-value-bind (value present-p) (gethash key1 table)
+ (and (eq value 'value) present-p))
+ (multiple-value-bind (value present-p) (gethash key0 table)
+ (and (eq value 'value) present-p))))
+
+(let ((table (make-hash-table :size 16 :test 'equal))
+ (key0 (copy-seq "key"))
+ (key1 (copy-seq "KEY")))
+ (and (not (eq key0 key1))
+ (not (equal key0 key1))
+ (eq (setf (gethash key0 table) 'value) 'value)
+ (multiple-value-bind (value present-p) (gethash key1 table)
+ (and (null value) (not present-p)))
+ (multiple-value-bind (value present-p) (gethash key0 table)
+ (and (eq value 'value) present-p))))
+
+(let ((table (make-hash-table :size 10 :test 'equal))
+ (key0 (copy-seq '(key)))
+ (key1 (copy-seq '(key))))
+ (and (not (eq key0 key1))
+ (equal key0 key1)
+ (eq (setf (gethash key0 table) 'value) 'value)
+ (multiple-value-bind (value present-p) (gethash key1 table)
+ (and (eq value 'value) present-p))
+ (multiple-value-bind (value present-p) (gethash key0 table)
+ (and (eq value 'value) present-p))))
+
+(let ((table (make-hash-table :size 16 :test 'equal))
+ (key0 (copy-seq #*1010))
+ (key1 (copy-seq #*1010)))
+ (and (not (eq key0 key1))
+ (equal key0 key1)
+ (eq (setf (gethash key0 table) 'value) 'value)
+ (multiple-value-bind (value present-p) (gethash key1 table)
+ (and (eq value 'value) present-p))
+ (multiple-value-bind (value present-p) (gethash key0 table)
+ (and (eq value 'value) present-p))))
+
+(let ((table (make-hash-table :size 16 :test 'equal))
+ (key0 (copy-seq #(a b c)))
+ (key1 (copy-seq #(a b c))))
+ (and (not (eq key0 key1))
+ (not (equal key0 key1))
+ (eq (setf (gethash key0 table) 'value) 'value)
+ (multiple-value-bind (value present-p) (gethash key1 table)
+ (and (null value) (not present-p)))
+ (multiple-value-bind (value present-p) (gethash key0 table)
+ (and (eq value 'value) present-p))))
+
+(let ((table (make-hash-table :size 10 :test 'equal))
+ (key0 (make-pathname))
+ (key1 (make-pathname)))
+ (and (not (eq key0 key1))
+ (equal key0 key1)
+ (eq (setf (gethash key0 table) 'value) 'value)
+ (multiple-value-bind (value present-p) (gethash key1 table)
+ (and (eq value 'value) present-p))
+ (multiple-value-bind (value present-p) (gethash key0 table)
+ (and (eq value 'value) present-p))))
+
+
+(let ((table (make-hash-table :size 0 :test 'equalp))
+ (key0 (copy-seq "key"))
+ (key1 (copy-seq "key")))
+ (and (equalp key0 key1)
+ (eq (setf (gethash key0 table) 'value) 'value)
+ (multiple-value-bind (value present-p) (gethash key1 table)
+ (and (eq value 'value) present-p))
+ (multiple-value-bind (value present-p) (gethash key0 table)
+ (and (eq value 'value) present-p))))
+
+(let ((table (make-hash-table :size 0 :test 'equalp))
+ (key0 1.0)
+ (key1 1.0))
+ (and (equalp key0 key1)
+ (eq (setf (gethash key0 table) 'value) 'value)
+ (multiple-value-bind (value present-p) (gethash key1 table)
+ (and (eq value 'value) present-p))
+ (multiple-value-bind (value present-p) (gethash key0 table)
+ (and (eq value 'value) present-p))))
+
+(let ((table (make-hash-table :size 100 :test 'equalp))
+ (key0 1)
+ (key1 1.0))
+ (and (not (eq key0 key1))
+ (equalp key0 key1)
+ (eq (setf (gethash key0 table) 'value) 'value)
+ (multiple-value-bind (value present-p) (gethash key1 table)
+ (and (eq value 'value) present-p))
+ (multiple-value-bind (value present-p) (gethash key0 table)
+ (and (eq value 'value) present-p))))
+
+(let ((table (make-hash-table :size 0 :test 'equalp))
+ (key0 #\a)
+ (key1 #\a))
+ (and (equalp key0 key1)
+ (eq (setf (gethash key0 table) 'value) 'value)
+ (multiple-value-bind (value present-p) (gethash key1 table)
+ (and (eq value 'value) present-p))
+ (multiple-value-bind (value present-p) (gethash key0 table)
+ (and (eq value 'value) present-p))))
+
+(let ((table (make-hash-table :size 10 :test 'equalp))
+ (key0 #\a)
+ (key1 #\A))
+ (and (not (eq key0 key1))
+ (equalp key0 key1)
+ (eq (setf (gethash key0 table) 'value) 'value)
+ (multiple-value-bind (value present-p) (gethash key1 table)
+ (and (eq value 'value) present-p))
+ (multiple-value-bind (value present-p) (gethash key0 table)
+ (and (eq value 'value) present-p))))
+
+(let ((table (make-hash-table :size 3 :test 'equalp))
+ (key0 (copy-seq '(#\a)))
+ (key1 (copy-seq '(#\A))))
+ (and (not (eq key0 key1))
+ (equalp key0 key1)
+ (eq (setf (gethash key0 table) 'value) 'value)
+ (multiple-value-bind (value present-p) (gethash key1 table)
+ (and (eq value 'value) present-p))
+ (multiple-value-bind (value present-p) (gethash key0 table)
+ (and (eq value 'value) present-p))))
+
+(let ((table (make-hash-table :size 3 :test 'equalp))
+ (key0 (copy-seq '(#\a (1))))
+ (key1 (copy-seq '(#\A (1.0)))))
+ (and (not (eq key0 key1))
+ (equalp key0 key1)
+ (eq (setf (gethash key0 table) 'value) 'value)
+ (multiple-value-bind (value present-p) (gethash key1 table)
+ (and (eq value 'value) present-p))
+ (multiple-value-bind (value present-p) (gethash key0 table)
+ (and (eq value 'value) present-p))))
+
+(let ((table (make-hash-table :test 'equalp))
+ (key0 (make-hash-table))
+ (key1 (make-hash-table)))
+ (and (not (eq key0 key1))
+ (equalp key0 key1)
+ (eq (setf (gethash key0 table) 'value) 'value)
+ (multiple-value-bind (value present-p) (gethash key1 table)
+ (and (eq value 'value) present-p))
+ (multiple-value-bind (value present-p) (gethash key0 table)
+ (and (eq value 'value) present-p))))
+
+(let ((table (make-hash-table)))
+ (and (zerop (hash-table-count table))
+ (dolist (pair '((a abc) (a bc) (1 "one") (1.0 "ONE") (#\a a) (#\A b)) t)
+ (unless (eq (setf (gethash (car pair) table) (cadr pair)) (cadr pair))
+ (return nil)))
+ (eql (hash-table-count table) 5)
+ (eq (gethash 'a table) 'bc)
+ (equal (gethash 1 table) "one")
+ (equal (gethash 1.0 table) "ONE")
+ (eql (gethash #\A table) 'b)
+ (eql (gethash #\a table) 'a)))
+
diff --git a/Sacla/tests/must-hash-table.patch b/Sacla/tests/must-hash-table.patch
new file mode 100644
index 0000000..c9ea48c
--- /dev/null
+++ b/Sacla/tests/must-hash-table.patch
@@ -0,0 +1,55 @@
+*** sacla/lisp/test/must-hash-table.lisp 2004-08-03 08:34:54.000000000 +0200
+--- CLISP/clisp-20040712/sacla-tests/must-hash-table.lisp 2004-08-06 02:45:56.000000000 +0200
+***************
+*** 42,52 ****
+--- 42,54 ----
+
+ (make-hash-table)
+ (hash-table-p (make-hash-table))
++ #-CLISP ; unfounded expectations about hash-table-test
+ (dolist (test '(eq eql equal equalp) t)
+ (let ((hash-table (make-hash-table :test test)))
+ (unless (and (hash-table-p hash-table)
+ (eq (hash-table-test hash-table) test))
+ (return nil))))
++ #-CLISP ; unfounded expectations about hash-table-test
+ (dolist (test '(eq eql equal equalp) t)
+ (let* ((test-function (symbol-function test))
+ (hash-table (make-hash-table :test test-function)))
+***************
+*** 114,135 ****
+--- 116,148 ----
+ (= (hash-table-count table) 1)))
+
+
++ #-CLISP ; unfounded expectations about hash-table-rehash-size
+ (let ((table (make-hash-table :size 100 :rehash-size 1.4)))
+ (= (hash-table-rehash-size table) 1.4))
+
++ #-CLISP ; unfounded expectations about hash-table-rehash-threshold
+ (let ((table (make-hash-table :size 100 :rehash-threshold 0.5)))
+ (= (hash-table-rehash-threshold table) 0.5))
+
+ (<= 0 (hash-table-size (make-hash-table)))
+
++ #-CLISP ; unfounded expectations about hash-table-test
+ (eq 'eq (hash-table-test (make-hash-table :test 'eq)))
++ #-CLISP ; unfounded expectations about hash-table-test
+ (eq 'eq (hash-table-test (make-hash-table :test #'eq)))
++ #-CLISP ; unfounded expectations about hash-table-test
+ (eq 'eql (hash-table-test (make-hash-table)))
++ #-CLISP ; unfounded expectations about hash-table-test
+ (eq 'eql (hash-table-test (make-hash-table :test 'eql)))
++ #-CLISP ; unfounded expectations about hash-table-test
+ (eq 'eql (hash-table-test (make-hash-table :test #'eql)))
++ #-CLISP ; unfounded expectations about hash-table-test
+ (eq 'equal (hash-table-test (make-hash-table :test 'equal)))
++ #-CLISP ; unfounded expectations about hash-table-test
+ (eq 'equal (hash-table-test (make-hash-table :test #'equal)))
++ #-CLISP ; unfounded expectations about hash-table-test
+ (eq 'equalp (hash-table-test (make-hash-table :test 'equalp)))
++ #-CLISP ; unfounded expectations about hash-table-test
+ (eq 'equalp (hash-table-test (make-hash-table :test #'equalp)))
+
+ (let* ((table0 (make-hash-table))
+
diff --git a/Sacla/tests/must-loop.lisp b/Sacla/tests/must-loop.lisp
new file mode 100644
index 0000000..bb28d00
--- /dev/null
+++ b/Sacla/tests/must-loop.lisp
@@ -0,0 +1,3605 @@
+;; Copyright (C) 2002-2004, Yuji Minejima <ggb01164@nifty.ne.jp>
+;; ALL RIGHTS RESERVED.
+;;
+;; $Id: must-loop.lisp,v 1.16 2004/09/28 01:52:16 yuji Exp $
+;;
+;; Redistribution and use in source and binary forms, with or without
+;; modification, are permitted provided that the following conditions
+;; are met:
+;;
+;; * Redistributions of source code must retain the above copyright
+;; notice, this list of conditions and the following disclaimer.
+;; * 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.
+;;
+;; 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
+;; OWNER 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.
+
+
+;; simple loop
+(null (loop (return)))
+(loop (return-from nil t))
+(null (let ((stack '(0 1 2))) (loop (unless (pop stack) (return))) stack))
+(equal (multiple-value-list (loop (return (values 0 1 2)))) '(0 1 2))
+(= 100 (let ((i 0)) (loop (incf i) (when (>= i 100) (return i)))))
+(eq (let (x) (tagbody (loop (go end)) end (setq x t)) x) t)
+(eq t (catch 'end (loop (throw 'end t))))
+(eq t (block here (loop (return-from here t))))
+(= 3 (let ((i 0)) (loop (incf i) (if (= i 3) (return i)))))
+(= 9 (let ((i 0)(j 0))
+ (tagbody
+ (loop (incf j 3) (incf i) (if (= i 3) (go exit)))
+ exit)
+ j))
+
+
+;; loop keyword identity
+(equal (let (stack) (loop :for a :from 1 :to 3 :by 1 :do (push a stack)) stack)
+ '(3 2 1))
+(let ((for (make-symbol "FOR"))
+ (from (make-symbol "FROM"))
+ (to (make-symbol "TO"))
+ (by (make-symbol "BY"))
+ (do (make-symbol "DO")))
+ (equal (eval `(let (stack)
+ (loop ,for a ,from 1 ,to 3 ,by 1 ,do (push a stack))
+ stack))
+ '(3 2 1)))
+(let ((for (make-symbol "FOR")))
+ (equal (eval `(let (stack) (loop ,for a :from 1 :to 3 :by 1 :do (push a stack))
+ stack))
+ '(3 2 1)))
+
+(progn
+ (when (find-package "LOOP-KEY-TEST")
+ (delete-package "LOOP-KEY-TEST"))
+ (let* ((pkg (defpackage "LOOP-KEY-TEST"))
+ (for (intern "FOR" pkg))
+ (in (intern "IN" pkg))
+ (by (progn (import 'by pkg) (intern "BY" pkg)))
+ (collect (progn (import 'collect pkg) (intern "COLLECT" pkg))))
+ (export collect pkg)
+ (and (equal (eval `(loop ,for elt ,in '(1 2 3 4 5) ,by #'cddr
+ ,collect elt))
+ '(1 3 5))
+ (delete-package pkg))))
+
+
+;; for-as-arithmetic-up with 3 forms
+(equal (let (stack) (loop for a from 1 to 3 by 1 do (push a stack)) stack)
+ '(3 2 1))
+(equal (let (stack) (loop for a from 1 by 1 to 3 do (push a stack)) stack)
+ '(3 2 1))
+(equal (let (stack) (loop for a to 3 by 1 from 1 do (push a stack)) stack)
+ '(3 2 1))
+(equal (let (stack) (loop for a to 3 from 1 by 1 do (push a stack)) stack)
+ '(3 2 1))
+(equal (let (stack) (loop for a by 1 to 3 from 1 do (push a stack)) stack)
+ '(3 2 1))
+(equal (let (stack) (loop for a by 1 from 1 to 3 do (push a stack)) stack)
+ '(3 2 1))
+
+(equal (let (stack) (loop for a upfrom 1 to 3 by 1 do (push a stack)) stack)
+ '(3 2 1))
+(equal (let (stack) (loop for a upfrom 1 by 1 to 3 do (push a stack)) stack)
+ '(3 2 1))
+(equal (let (stack) (loop for a to 3 by 1 upfrom 1 do (push a stack)) stack)
+ '(3 2 1))
+(equal (let (stack) (loop for a to 3 upfrom 1 by 1 do (push a stack)) stack)
+ '(3 2 1))
+(equal (let (stack) (loop for a by 1 to 3 upfrom 1 do (push a stack)) stack)
+ '(3 2 1))
+(equal (let (stack) (loop for a by 1 upfrom 1 to 3 do (push a stack)) stack)
+ '(3 2 1))
+
+
+(equal (let (stack) (loop for a from 1 upto 3 by 1 do (push a stack)) stack)
+ '(3 2 1))
+(equal (let (stack) (loop for a from 1 by 1 upto 3 do (push a stack)) stack)
+ '(3 2 1))
+(equal (let (stack) (loop for a upto 3 by 1 from 1 do (push a stack)) stack)
+ '(3 2 1))
+(equal (let (stack) (loop for a upto 3 from 1 by 1 do (push a stack)) stack)
+ '(3 2 1))
+(equal (let (stack) (loop for a by 1 upto 3 from 1 do (push a stack)) stack)
+ '(3 2 1))
+(equal (let (stack) (loop for a by 1 from 1 upto 3 do (push a stack)) stack)
+ '(3 2 1))
+
+(equal (let (stack) (loop for a upfrom 1 upto 3 by 1 do (push a stack)) stack)
+ '(3 2 1))
+(equal (let (stack) (loop for a upfrom 1 by 1 upto 3 do (push a stack)) stack)
+ '(3 2 1))
+(equal (let (stack) (loop for a upto 3 by 1 upfrom 1 do (push a stack)) stack)
+ '(3 2 1))
+(equal (let (stack) (loop for a upto 3 upfrom 1 by 1 do (push a stack)) stack)
+ '(3 2 1))
+(equal (let (stack) (loop for a by 1 upto 3 upfrom 1 do (push a stack)) stack)
+ '(3 2 1))
+(equal (let (stack) (loop for a by 1 upfrom 1 upto 3 do (push a stack)) stack)
+ '(3 2 1))
+
+
+(equal (let (stack) (loop for a from 1 below 4 by 1 do (push a stack)) stack)
+ '(3 2 1))
+(equal (let (stack) (loop for a from 1 by 1 below 4 do (push a stack)) stack)
+ '(3 2 1))
+(equal (let (stack) (loop for a below 4 by 1 from 1 do (push a stack)) stack)
+ '(3 2 1))
+(equal (let (stack) (loop for a below 4 from 1 by 1 do (push a stack)) stack)
+ '(3 2 1))
+(equal (let (stack) (loop for a by 1 below 4 from 1 do (push a stack)) stack)
+ '(3 2 1))
+(equal (let (stack) (loop for a by 1 from 1 below 4 do (push a stack)) stack)
+ '(3 2 1))
+
+(equal (let (stack) (loop for a upfrom 1 below 4 by 1 do (push a stack)) stack)
+ '(3 2 1))
+(equal (let (stack) (loop for a upfrom 1 by 1 below 4 do (push a stack)) stack)
+ '(3 2 1))
+(equal (let (stack) (loop for a below 4 by 1 upfrom 1 do (push a stack)) stack)
+ '(3 2 1))
+(equal (let (stack) (loop for a below 4 upfrom 1 by 1 do (push a stack)) stack)
+ '(3 2 1))
+(equal (let (stack) (loop for a by 1 below 4 upfrom 1 do (push a stack)) stack)
+ '(3 2 1))
+(equal (let (stack) (loop for a by 1 upfrom 1 below 4 do (push a stack)) stack)
+ '(3 2 1))
+
+
+;; for-as-arithmetic-up with 2 forms
+(equal (let (stack) (loop for a from 1 to 3 do (push a stack)) stack) '(3 2 1))
+(equal (let (stack) (loop for a to 3 from 1 do (push a stack)) stack) '(3 2 1))
+
+(equal (let (stack) (loop for a upfrom 1 to 3 do (push a stack)) stack) '(3 2 1))
+(equal (let (stack) (loop for a to 3 upfrom 1 do (push a stack)) stack) '(3 2 1))
+
+
+(equal (let (stack) (loop for a from 1 upto 3 do (push a stack)) stack) '(3 2 1))
+(equal (let (stack) (loop for a upto 3 from 1 do (push a stack)) stack) '(3 2 1))
+
+(equal (let (stack) (loop for a upfrom 1 upto 3 do (push a stack)) stack)
+ '(3 2 1))
+(equal (let (stack) (loop for a upto 3 upfrom 1 do (push a stack)) stack)
+ '(3 2 1))
+
+
+(equal (let (stack) (loop for a from 1 below 4 do (push a stack)) stack) '(3 2 1))
+(equal (let (stack) (loop for a below 4 from 1 do (push a stack)) stack) '(3 2 1))
+
+(equal (let (stack) (loop for a upfrom 1 below 4 do (push a stack)) stack)
+ '(3 2 1))
+(equal (let (stack) (loop for a below 4 upfrom 1 do (push a stack)) stack)
+ '(3 2 1))
+
+
+(equal (let (stack) (loop for a to 3 by 1 do (push a stack)) stack) '(3 2 1 0))
+(equal (let (stack) (loop for a by 1 to 3 do (push a stack)) stack) '(3 2 1 0))
+
+(equal (let (stack) (loop for a upto 3 by 1 do (push a stack)) stack) '(3 2 1 0))
+(equal (let (stack) (loop for a by 1 upto 3 do (push a stack)) stack) '(3 2 1 0))
+
+(equal (let (stack) (loop for a below 4 by 1 do (push a stack)) stack)
+ '(3 2 1 0))
+(equal (let (stack) (loop for a by 1 below 4 do (push a stack)) stack)
+ '(3 2 1 0))
+
+
+(= 4 (let ((stack '(1 2 3)))
+ (loop for a from 1 by 1 do (unless (pop stack) (return a)))))
+(= 4 (let ((stack '(1 2 3)))
+ (loop for a by 1 from 1 do (unless (pop stack) (return a)))))
+
+(= 4 (let ((stack '(1 2 3)))
+ (loop for a upfrom 1 by 1 do (unless (pop stack) (return a)))))
+(= 4 (let ((stack '(1 2 3)))
+ (loop for a by 1 upfrom 1 do (unless (pop stack) (return a)))))
+
+
+;; for-as-arithmetic-up with 1 form
+(= 4 (let ((stack '(1 2 3)))
+ (loop for a from 1 do (unless (pop stack) (return a)))))
+(= 4 (let ((stack '(1 2 3)))
+ (loop for a upfrom 1 do (unless (pop stack) (return a)))))
+
+(equal (let (stack) (loop for a to 3 do (push a stack)) stack)
+ '(3 2 1 0))
+(equal (let (stack) (loop for a upto 3 do (push a stack)) stack)
+ '(3 2 1 0))
+(equal (let (stack) (loop for a below 4 do (push a stack)) stack)
+ '(3 2 1 0))
+
+(= 3 (let ((stack '(1 2 3)))
+ (loop for a by 1 do (unless (pop stack) (return a)))))
+
+
+;; for-as-arithmetic-downto with 3 forms
+(equal (let (stack) (loop for a from 3 downto 1 by 1 do (push a stack)) stack)
+ '(1 2 3))
+(equal (let (stack) (loop for a from 3 by 1 downto 1 do (push a stack)) stack)
+ '(1 2 3))
+(equal (let (stack) (loop for a downto 1 by 1 from 3 do (push a stack)) stack)
+ '(1 2 3))
+(equal (let (stack) (loop for a downto 1 from 3 by 1 do (push a stack)) stack)
+ '(1 2 3))
+(equal (let (stack) (loop for a by 1 from 3 downto 1 do (push a stack)) stack)
+ '(1 2 3))
+(equal (let (stack) (loop for a by 1 downto 1 from 3 do (push a stack)) stack)
+ '(1 2 3))
+
+(equal (let (stack) (loop for a from 3 above 0 by 1 do (push a stack)) stack)
+ '(1 2 3))
+(equal (let (stack) (loop for a from 3 by 1 above 0 do (push a stack)) stack)
+ '(1 2 3))
+(equal (let (stack) (loop for a above 0 by 1 from 3 do (push a stack)) stack)
+ '(1 2 3))
+(equal (let (stack) (loop for a above 0 from 3 by 1 do (push a stack)) stack)
+ '(1 2 3))
+(equal (let (stack) (loop for a by 1 from 3 above 0 do (push a stack)) stack)
+ '(1 2 3))
+(equal (let (stack) (loop for a by 1 above 0 from 3 do (push a stack)) stack)
+ '(1 2 3))
+
+
+;; for-as-arithmetic-downto with 2 forms
+(equal (let (stack) (loop for a from 3 downto 1 do (push a stack)) stack)
+ '(1 2 3))
+(equal (let (stack) (loop for a downto 1 from 3 do (push a stack)) stack)
+ '(1 2 3))
+
+(equal (let (stack) (loop for a from 3 above 0 do (push a stack)) stack)
+ '(1 2 3))
+(equal (let (stack) (loop for a above 0 from 3 do (push a stack)) stack)
+ '(1 2 3))
+
+
+;; for-as-arithmetic-downfrom with 3 forms
+(equal (let (stack) (loop for a downfrom 3 to 1 by 1 do (push a stack)) stack)
+ '(1 2 3))
+(equal (let (stack) (loop for a downfrom 3 by 1 to 1 do (push a stack)) stack)
+ '(1 2 3))
+
+(equal (let (stack) (loop for a to 1 by 1 downfrom 3 do (push a stack)) stack)
+ '(1 2 3))
+(equal (let (stack) (loop for a to 1 downfrom 3 by 1 do (push a stack)) stack)
+ '(1 2 3))
+
+(equal (let (stack) (loop for a by 1 to 1 downfrom 3 do (push a stack)) stack)
+ '(1 2 3))
+(equal (let (stack) (loop for a by 1 downfrom 3 to 1 do (push a stack)) stack)
+ '(1 2 3))
+
+
+(equal (let (stack) (loop for a downfrom 3 downto 1 by 1 do (push a stack))
+ stack)
+ '(1 2 3))
+(equal (let (stack) (loop for a downfrom 3 by 1 downto 1 do (push a stack))
+ stack)
+ '(1 2 3))
+
+(equal (let (stack) (loop for a downto 1 by 1 downfrom 3 do (push a stack))
+ stack)
+ '(1 2 3))
+(equal (let (stack) (loop for a downto 1 downfrom 3 by 1 do (push a stack))
+ stack)
+ '(1 2 3))
+
+(equal (let (stack) (loop for a by 1 downto 1 downfrom 3 do (push a stack))
+ stack)
+ '(1 2 3))
+(equal (let (stack) (loop for a by 1 downfrom 3 downto 1 do (push a stack))
+ stack)
+ '(1 2 3))
+
+
+(equal (let (stack) (loop for a downfrom 3 above 0 by 1 do (push a stack))
+ stack)
+ '(1 2 3))
+(equal (let (stack) (loop for a downfrom 3 by 1 above 0 do (push a stack))
+ stack)
+ '(1 2 3))
+
+(equal (let (stack) (loop for a above 0 by 1 downfrom 3 do (push a stack))
+ stack)
+ '(1 2 3))
+(equal (let (stack) (loop for a above 0 downfrom 3 by 1 do (push a stack))
+ stack)
+ '(1 2 3))
+
+(equal (let (stack) (loop for a by 1 above 0 downfrom 3 do (push a stack))
+ stack)
+ '(1 2 3))
+(equal (let (stack) (loop for a by 1 downfrom 3 above 0 do (push a stack))
+ stack)
+ '(1 2 3))
+
+
+;; for-as-arithmetic-downfrom with 2 forms
+(equal (let (stack) (loop for a downfrom 3 to 1 do (push a stack)) stack)
+ '(1 2 3))
+(equal (let (stack) (loop for a to 1 downfrom 3 do (push a stack)) stack)
+ '(1 2 3))
+
+(equal (let (stack) (loop for a downfrom 3 downto 1 do (push a stack)) stack)
+ '(1 2 3))
+(equal (let (stack) (loop for a downto 1 downfrom 3 do (push a stack)) stack)
+ '(1 2 3))
+
+(equal (let (stack) (loop for a downfrom 3 above 0 do (push a stack)) stack)
+ '(1 2 3))
+(equal (let (stack) (loop for a above 0 downfrom 3 do (push a stack)) stack)
+ '(1 2 3))
+
+
+(zerop (let ((stack '(0 1 2)))
+ (loop for a downfrom 3 by 1 do (unless (pop stack) (return a)))))
+(zerop (let ((stack '(0 1 2)))
+ (loop for a by 1 downfrom 3 do (unless (pop stack) (return a)))))
+
+;; for-as-arithmetic-downfrom with 1 form
+(zerop (let ((stack '(0 1 2)))
+ (loop for a downfrom 3 do (unless (pop stack) (return a)))))
+
+;; for-as-arithmetic form evaluation
+(equal (let (stack)
+ (loop for a from (+ 1 1) upto (+ 4 6) by (1+ 1) do (push a stack))
+ stack)
+ '(10 8 6 4 2))
+
+;; for-as-arithmetic form evaluation order
+(equal (let ((x 0)
+ stack)
+ (loop for a from (incf x) upto (+ (incf x) 10) by x do (push a stack))
+ stack)
+ '(11 9 7 5 3 1))
+
+(equal (let ((x 0)
+ stack)
+ (loop for a from (incf x) by (incf x) upto (+ x 10) do (push a stack))
+ stack)
+ '(11 9 7 5 3 1))
+
+(equal (let ((x 0)
+ stack)
+ (loop for a by (incf x) from (incf x) upto (+ x 10) do (push a stack))
+ stack)
+ '(12 11 10 9 8 7 6 5 4 3 2))
+
+(equal (let ((x 0)
+ stack)
+ (loop for a by (incf x) upto (+ (incf x) 10) from (incf x)
+ do (push a stack))
+ stack)
+ '(12 11 10 9 8 7 6 5 4 3))
+
+;; for-as-arithmetic type
+(equal (let (stack) (loop for a t from 1 to 3 by 1 do (push a stack)) stack)
+ '(3 2 1))
+
+(equal (let (stack) (loop for a fixnum from 1 to 3 by 1 do (push a stack)) stack)
+ '(3 2 1))
+
+(equal (let (stack) (loop for a float from 1.0 to 3.0 by 1.0 do (push a stack))
+ stack)
+ '(3.0 2.0 1.0))
+
+
+(equal (let (stack) (loop for a of-type t from 1 to 3 by 1 do (push a stack))
+ stack)
+ '(3 2 1))
+
+(equal (let (stack)
+ (loop for a of-type fixnum from 1 to 3 by 1 do (push a stack)) stack)
+ '(3 2 1))
+
+(equal (let (stack)
+ (loop for a of-type float from 1.0 to 3.0 by 1.0 do (push a stack))
+ stack)
+ '(3.0 2.0 1.0))
+
+(equal (let (stack)
+ (loop for a of-type number from 1 to 3 by 1 do (push a stack)) stack)
+ '(3 2 1))
+
+(equal (let (stack)
+ (loop for a of-type integer from 1 to 3 by 1 do (push a stack)) stack)
+ '(3 2 1))
+
+
+
+
+;; for-as-arithmetic misc
+(equal (let ((stack)) (loop for a from 0 upto 10 by 5 do (push a stack)) stack)
+ '(10 5 0))
+
+(equal (let ((stack)) (loop for a from 0 upto 10 by 3 do (push a stack)) stack)
+ '(9 6 3 0))
+
+(equal (let ((stack)) (loop for a from -3 upto 0 do (push a stack)) stack)
+ '(0 -1 -2 -3))
+
+(equal (let ((stack)) (loop for a downfrom 0 to -3 do (push a stack)) stack)
+ '(-3 -2 -1 0))
+(equal (let (stack) (loop as a from 1 to 3 by 1 do (push a stack)) stack)
+ '(3 2 1))
+(equal (let (stack) (loop as a upfrom 1 to 3 by 1 do (push a stack)) stack)
+ '(3 2 1))
+(equal (let (stack) (loop as a from 1 upto 3 by 1 do (push a stack)) stack)
+ '(3 2 1))
+(equal (let (stack) (loop as a upfrom 1 upto 3 by 1 do (push a stack)) stack)
+ '(3 2 1))
+(equal (let (stack) (loop as a from 1 below 4 by 1 do (push a stack)) stack)
+ '(3 2 1))
+(equal (let (stack) (loop as a upfrom 1 below 4 by 1 do (push a stack)) stack)
+ '(3 2 1))
+(equal (let (stack) (loop as a from 1 to 3 do (push a stack)) stack) '(3 2 1))
+(equal (let (stack) (loop as a upfrom 1 to 3 do (push a stack)) stack) '(3 2 1))
+(equal (let (stack) (loop as a from 1 upto 3 do (push a stack)) stack) '(3 2 1))
+(equal (let (stack) (loop as a upfrom 1 upto 3 do (push a stack)) stack)
+ '(3 2 1))
+(equal (let (stack) (loop as a from 1 below 4 do (push a stack)) stack) '(3 2 1))
+(equal (let (stack) (loop as a upfrom 1 below 4 do (push a stack)) stack)
+ '(3 2 1))
+(equal (let (stack) (loop as a to 3 by 1 do (push a stack)) stack) '(3 2 1 0))
+(equal (let (stack) (loop as a upto 3 by 1 do (push a stack)) stack) '(3 2 1 0))
+(equal (let (stack) (loop as a below 4 by 1 do (push a stack)) stack)
+ '(3 2 1 0))
+(= 4 (let ((stack '(1 2 3)))
+ (loop as a from 1 by 1 do (unless (pop stack) (return a)))))
+(= 4 (let ((stack '(1 2 3)))
+ (loop as a upfrom 1 by 1 do (unless (pop stack) (return a)))))
+(= 4 (let ((stack '(1 2 3)))
+ (loop as a from 1 do (unless (pop stack) (return a)))))
+(equal (let (stack) (loop as a to 3 do (push a stack)) stack) '(3 2 1 0))
+(= 3 (let ((stack '(1 2 3)))
+ (loop as a by 1 do (unless (pop stack) (return a)))))
+(equal (let (stack) (loop as a from 3 downto 1 by 1 do (push a stack)) stack)
+ '(1 2 3))
+(equal (let (stack) (loop as a from 3 above 0 by 1 do (push a stack)) stack)
+ '(1 2 3))
+(equal (let (stack) (loop as a from 3 downto 1 do (push a stack)) stack)
+ '(1 2 3))
+(equal (let (stack) (loop as a from 3 above 0 do (push a stack)) stack)
+ '(1 2 3))
+(equal (let (stack) (loop as a downfrom 3 to 1 by 1 do (push a stack)) stack)
+ '(1 2 3))
+(equal (let (stack) (loop as a to 1 by 1 downfrom 3 do (push a stack)) stack)
+ '(1 2 3))
+(equal (let (stack) (loop as a by 1 to 1 downfrom 3 do (push a stack)) stack)
+ '(1 2 3))
+(equal (let (stack) (loop as a downfrom 3 downto 1 by 1 do (push a stack))
+ stack)
+ '(1 2 3))
+(equal (let (stack) (loop as a downto 1 by 1 downfrom 3 do (push a stack))
+ stack)
+ '(1 2 3))
+(equal (let (stack) (loop as a by 1 downto 1 downfrom 3 do (push a stack))
+ stack)
+ '(1 2 3))
+(equal (let (stack) (loop as a downfrom 3 above 0 by 1 do (push a stack))
+ stack)
+ '(1 2 3))
+(equal (let (stack) (loop as a above 0 by 1 downfrom 3 do (push a stack))
+ stack)
+ '(1 2 3))
+(equal (let (stack) (loop as a by 1 above 0 downfrom 3 do (push a stack))
+ stack)
+ '(1 2 3))
+(equal (let (stack) (loop as a downfrom 3 to 1 do (push a stack)) stack)
+ '(1 2 3))
+(equal (let (stack) (loop as a downfrom 3 downto 1 do (push a stack)) stack)
+ '(1 2 3))
+(equal (let (stack) (loop as a downfrom 3 above 0 do (push a stack)) stack)
+ '(1 2 3))
+(zerop (let ((stack '(0 1 2)))
+ (loop as a downfrom 3 by 1 do (unless (pop stack) (return a)))))
+(zerop (let ((stack '(0 1 2)))
+ (loop as a downfrom 3 do (unless (pop stack) (return a)))))
+(equal (let (stack) (loop for a from 0 upto 0 do (push a stack)) stack) '(0))
+(null (loop for a upfrom 0 below 0))
+(null (loop for a upfrom 10 to -10 collect a))
+(equal (let (stack)
+ (loop for a from 1/3 upto 1 by 1/3 do (push a stack))
+ stack)
+ '(1 2/3 1/3))
+(equal (let (stack)
+ (loop for a of-type rational from 1/3 upto 5/3 by 1/3 do (push a stack))
+ stack)
+ '(5/3 4/3 1 2/3 1/3))
+(equal (let(stack) (loop for a fixnum below 3 do (push a stack)) stack)
+ '(2 1 0))
+(equal (let(stack) (loop for a of-type fixnum below 3 do (push a stack)) stack)
+ '(2 1 0))
+(equal (let(stack) (loop for a of-type (integer 0 2)
+ below 3 do (push a stack)) stack)
+ '(2 1 0))
+
+
+;; for-as-in-list
+(null (loop for a in '()))
+(equal (let (stack) (loop for a in '(0 1 2) do (push a stack)) stack)
+ '(2 1 0))
+(equal (let (stack)
+ (loop for a in (let ((i 0)) (list (incf i) (incf i) (incf i)))
+ do (push a stack))
+ stack)
+ '(3 2 1))
+(handler-case (loop for a in '(0 1 . 2))
+ (type-error ()
+ t)
+ (error () nil)
+ (:no-error (&rest rest)
+ (declare (ignore rest))
+ nil)) ; check must be done by endp
+(equal (let (stack)
+ (loop for a in '(0 1 2 3) by #'cdr do (push a stack))
+ stack)
+ '(3 2 1 0))
+(equal (let (stack)
+ (loop for a in '(0 1 2 3) by #'cddr do (push a stack))
+ stack)
+ '(2 0))
+(equal (let (stack)
+ (loop for a in '(0 1 2 3) by #'cdddr do (push a stack))
+ stack)
+ '(3 0))
+(equal (let (stack)
+ (loop for a in '(0 1 2 3) by #'cddddr do (push a stack))
+ stack)
+ '(0))
+(equal (let (stack) (loop for a t in '(0 1 2) do (push a stack)) stack) '(2 1 0))
+(equal (let (stack) (loop for a of-type t in '(0 1 2) do (push a stack)) stack)
+ '(2 1 0))
+(equal (let (stack) (loop for a fixnum in '(0 1 2) do (push a stack))
+ stack) '(2 1 0))
+(equal (let (stack) (loop for a of-type fixnum in '(0 1 2) do (push a stack))
+ stack) '(2 1 0))
+(equal (let (stack) (loop for a of-type t in '(0 1 2) do (push a stack))
+ stack) '(2 1 0))
+(equal (let (stack) (loop for a float in '(0.0 1.0 2.0) do (push a stack))
+ stack) '(2.0 1.0 0.0))
+(equal (let (stack) (loop for a of-type float in '(0.0 1.0 2.0)
+ do (push a stack))
+ stack) '(2.0 1.0 0.0))
+
+
+
+
+
+;; for-as-on-list
+(null (loop for a on '()))
+(equal (let (stack) (loop for a on '(0 1 2) do (push a stack)) stack)
+ '((2) (1 2) (0 1 2)))
+(equal (let (stack)
+ (loop for a on (let ((i 0)) (list (incf i) (incf i) (incf i)))
+ do (push (car a) stack))
+ stack)
+ '(3 2 1))
+(equal (let (stack) (loop for a on '(0 1 . 2) do (push a stack)) stack)
+ '((1 . 2) (0 1 . 2))) ; check must be done by atom
+(equal (let (stack)
+ (loop for a on '(0 1 2 3) by #'cdr do (push a stack))
+ stack)
+ '((3) (2 3) (1 2 3) (0 1 2 3)))
+(equal (let (stack)
+ (loop for a on '(0 1 2 3) by #'cddr do (push a stack))
+ stack)
+ '((2 3) (0 1 2 3)))
+(equal (let (stack)
+ (loop for a on '(0 1 2 3) by #'cdddr do (push a stack))
+ stack)
+ '((3) (0 1 2 3)))
+(equal (let (stack)
+ (loop for a on '(0 1 2 3) by #'cddddr do (push a stack))
+ stack)
+ '((0 1 2 3)))
+(equal (let (stack) (loop for a t on '(0 1 2) do (push a stack)) stack)
+ '((2) (1 2) (0 1 2)))
+(equal (let (stack) (loop for a of-type t on '(0 1 2) do (push a stack)) stack)
+ '((2) (1 2) (0 1 2)))
+(equal (let (stack) (loop for a of-type list on '(0 1 2) do (push a stack))
+ stack)
+ '((2) (1 2) (0 1 2)))
+
+(equal (let (stack)
+ (loop for a on '(0 1 2 3) by #'(lambda (arg) (cddddr arg))
+ do (push a stack))
+ stack)
+ '((0 1 2 3)))
+
+
+;; for-as-across
+(null (loop for a across ""))
+(null (let (stack) (loop for a across "" do (push a stack)) stack))
+(equal (let (stack) (loop for a across "abc" do (push a stack)) stack)
+ '(#\c #\b #\a))
+(equal (let (stack) (loop for a across #(x y z) do (push a stack)) stack)
+ '(z y x))
+(equal (let (stack) (loop for a across #*0101 do (push a stack)) stack)
+ '(1 0 1 0))
+(equal (let (stack) (loop for a t across "abc" do (push a stack)) stack)
+ '(#\c #\b #\a))
+(equal (let (stack) (loop for a of-type t across "abc" do (push a stack)) stack)
+ '(#\c #\b #\a))
+(equal (let (stack) (loop for a of-type character across "abc"
+ do (push a stack)) stack)
+ '(#\c #\b #\a))
+(equal (let (stack) (loop for a of-type base-char across "abc"
+ do (push a stack)) stack)
+ '(#\c #\b #\a))
+(equal (let (stack) (loop for a float across #(0.0 1.0 2.0)
+ do (push a stack)) stack)
+ '(2.0 1.0 0.0))
+(equal (let (stack) (loop for a of-type float across #(0.0 1.0 2.0)
+ do (push a stack)) stack)
+ '(2.0 1.0 0.0))
+(equal (let (stack) (loop for a fixnum across #(0 1 2)
+ do (push a stack)) stack)
+ '(2 1 0))
+(equal (let (stack) (loop for a of-type fixnum across #(0 1 2)
+ do (push a stack)) stack)
+ '(2 1 0))
+
+
+
+
+
+
+;; for-as-equals-then
+(= (let ((i 3)) (loop for a = 0 then (1+ a)
+ do (when (zerop (decf i)) (return a))))
+ 2)
+(equal (let (stack) (loop for a = '(0 1 2) then (cdr a)
+ do (if a (push (car a) stack) (return stack))))
+ '(2 1 0))
+(equal (let (stack) (loop with i = 0 for x = i
+ do (when (= i 3) (return))
+ (push x stack) (incf i)) stack)
+ '(2 1 0))
+(equal (let (stack)
+ (loop for i = 0 then (1+ i) do (push i stack) when (= i 3) return t)
+ stack)
+ '(3 2 1 0))
+(equal (let (stack)
+ (loop for i fixnum = 0 then (1+ i) do (push i stack)
+ when (= i 3) return t)
+ stack)
+ '(3 2 1 0))
+(equal (let (stack)
+ (loop for i of-type fixnum = 0 then (1+ i) do (push i stack)
+ when (= i 3) return t)
+ stack)
+ '(3 2 1 0))
+(equal (let (stack)
+ (loop for i float = 0.0 then (1+ i) do (push i stack)
+ when (= i 3.0) return t)
+ stack)
+ '(3.0 2.0 1.0 0.0))
+(equal (let (stack)
+ (loop for i of-type float = 0.0 then (1+ i) do (push i stack)
+ when (= i 3.0) return t)
+ stack)
+ '(3.0 2.0 1.0 0.0))
+(equal (let (stack)
+ (loop for i t = 0.0 then (1+ i) do (push i stack)
+ when (= i 3.0) return t)
+ stack)
+ '(3.0 2.0 1.0 0.0))
+(equal (let (stack)
+ (loop for i of-type t = 0.0 then (1+ i) do (push i stack)
+ when (= i 3.0) return t)
+ stack)
+ '(3.0 2.0 1.0 0.0))
+(let ((chars '(#\a #\b #\c #\d)))
+ (eq t (loop for c = (pop chars) unless chars return t)))
+(let ((chars '(#\a #\b #\c #\d)))
+ (eq t (loop for c of-type character = (pop chars) unless chars return t)))
+(let ((chars '(#\a #\b #\c #\d)))
+ (eq t (loop for c of-type base-char = (pop chars) unless chars return t)))
+(equal (let (stack)
+ (loop for i of-type (integer 0 3) = 0 then (1+ i) do (push i stack)
+ when (= i 3) return t)
+ stack)
+ '(3 2 1 0))
+
+(flet ((triple (n) (values n (+ n 1) (+ n 2))))
+ (equal (loop for i from 0 upto 2
+ for (a b c) = (multiple-value-list (triple i))
+ append `(,a ,b ,c))
+ '(0 1 2 1 2 3 2 3 4)))
+(flet ((triple (n) (values n `(,(+ n 1)) `((,(+ n 2))))))
+ (equal (loop for i from 0 upto 2
+ for (a (b) ((c))) = (multiple-value-list (triple i))
+ append `(,a ,b ,c))
+ '(0 1 2 1 2 3 2 3 4)))
+(flet ((triple (n) (values n
+ `(,(+ n 10) ,(+ n 11) ,(+ n 12) ,(+ n 13))
+ `(,(+ n 20) ,(+ n 21) ,(+ n 22)))))
+ (equal (loop for i from 0 upto 2
+ for (a (b0 b1 b2 b3) (c0 c1 c2)) = (multiple-value-list (triple i))
+ append `(,a ,b0 ,b1 ,b2 ,b3 ,c0 ,c1 ,c2))
+ '(0 10 11 12 13 20 21 22 1 11 12 13 14 21 22 23 2 12 13 14 15 22 23 24)))
+
+(flet ((triple (n) (values n
+ `(,(+ n 10) ,(+ n 11) ,(+ n 12) ,(+ n 13))
+ `(,(+ n 200)
+ (,(+ n 210) ,(+ n 211) ,(+ n 212) ,(+ n 213))
+ ,(+ n 220)))))
+ (equal (loop for i from 0 upto 2
+ for (a (b0 b1 b2 b3) (c0 (c10 c11 c12) c2)) =
+ (multiple-value-list (triple i))
+ append `(,a ,b0 ,b1 ,b2 ,b3 ,c0 ,c10 ,c11 ,c12 ,c2))
+ '(0 10 11 12 13 200 210 211 212 220
+ 1 11 12 13 14 201 211 212 213 221
+ 2 12 13 14 15 202 212 213 214 222)))
+
+
+
+
+
+
+
+;; for-as-hash
+(let ((table (make-hash-table))
+ stack)
+ (mapc #'(lambda (k v) (setf (gethash k table) v)) '(k0 k1 k2) '(v0 v1 v2))
+ (loop for k being each hash-key of table do (push k stack))
+ (null (set-difference stack '(k0 k1 k2))))
+(let ((table (make-hash-table))
+ stack)
+ (mapc #'(lambda (k v) (setf (gethash k table) v)) '(k0 k1 k2) '(v0 v1 v2))
+ (loop for k being the hash-key of table do (push k stack))
+ (null (set-difference stack '(k0 k1 k2))))
+(let ((table (make-hash-table))
+ stack)
+ (mapc #'(lambda (k v) (setf (gethash k table) v)) '(k0 k1 k2) '(v0 v1 v2))
+ (loop for k being each hash-keys of table do (push k stack))
+ (null (set-difference stack '(k0 k1 k2))))
+(let ((table (make-hash-table))
+ stack)
+ (mapc #'(lambda (k v) (setf (gethash k table) v)) '(k0 k1 k2) '(v0 v1 v2))
+ (loop for k being the hash-keys of table do (push k stack))
+ (null (set-difference stack '(k0 k1 k2))))
+
+(let ((table (make-hash-table))
+ stack)
+ (mapc #'(lambda (k v) (setf (gethash k table) v)) '(k0 k1 k2) '(v0 v1 v2))
+ (loop for k being each hash-key in table do (push k stack))
+ (null (set-difference stack '(k0 k1 k2))))
+(let ((table (make-hash-table))
+ stack)
+ (mapc #'(lambda (k v) (setf (gethash k table) v)) '(k0 k1 k2) '(v0 v1 v2))
+ (loop for k being the hash-key in table do (push k stack))
+ (null (set-difference stack '(k0 k1 k2))))
+(let ((table (make-hash-table))
+ stack)
+ (mapc #'(lambda (k v) (setf (gethash k table) v)) '(k0 k1 k2) '(v0 v1 v2))
+ (loop for k being each hash-keys in table do (push k stack))
+ (null (set-difference stack '(k0 k1 k2))))
+(let ((table (make-hash-table))
+ stack)
+ (mapc #'(lambda (k v) (setf (gethash k table) v)) '(k0 k1 k2) '(v0 v1 v2))
+ (loop for k being the hash-keys in table do (push k stack))
+ (null (set-difference stack '(k0 k1 k2))))
+
+(let ((table (make-hash-table))
+ stack)
+ (mapc #'(lambda (k v) (setf (gethash k table) v)) '(k0 k1 k2) '(v0 v1 v2))
+ (loop for k being each hash-key of table using (hash-value v)
+ do (push (list k v) stack))
+ (null (set-difference stack '((k0 v0) (k1 v1) (k2 v2)) :test #'equal)))
+(let ((table (make-hash-table))
+ stack)
+ (mapc #'(lambda (k v) (setf (gethash k table) v)) '(k0 k1 k2) '(v0 v1 v2))
+ (loop for k being the hash-key of table using (hash-value v)
+ do (push (list k v) stack))
+ (null (set-difference stack '((k0 v0) (k1 v1) (k2 v2)) :test #'equal)))
+(let ((table (make-hash-table))
+ stack)
+ (mapc #'(lambda (k v) (setf (gethash k table) v)) '(k0 k1 k2) '(v0 v1 v2))
+ (loop for k being each hash-keys of table using (hash-value v)
+ do (push (list k v) stack))
+ (null (set-difference stack '((k0 v0) (k1 v1) (k2 v2)) :test #'equal)))
+(let ((table (make-hash-table))
+ stack)
+ (mapc #'(lambda (k v) (setf (gethash k table) v)) '(k0 k1 k2) '(v0 v1 v2))
+ (loop for k being the hash-keys of table using (hash-value v)
+ do (push (list k v) stack))
+ (null (set-difference stack '((k0 v0) (k1 v1) (k2 v2)) :test #'equal)))
+(let ((table (make-hash-table))
+ stack)
+ (mapc #'(lambda (k v) (setf (gethash k table) v)) '(k0 k1 k2) '(v0 v1 v2))
+ (loop for k being each hash-key in table using (hash-value v)
+ do (push (list k v) stack))
+ (null (set-difference stack '((k0 v0) (k1 v1) (k2 v2)) :test #'equal)))
+(let ((table (make-hash-table))
+ stack)
+ (mapc #'(lambda (k v) (setf (gethash k table) v)) '(k0 k1 k2) '(v0 v1 v2))
+ (loop for k being the hash-key in table using (hash-value v)
+ do (push (list k v) stack))
+ (null (set-difference stack '((k0 v0) (k1 v1) (k2 v2)) :test #'equal)))
+(let ((table (make-hash-table))
+ stack)
+ (mapc #'(lambda (k v) (setf (gethash k table) v)) '(k0 k1 k2) '(v0 v1 v2))
+ (loop for k being each hash-keys in table using (hash-value v)
+ do (push (list k v) stack))
+ (null (set-difference stack '((k0 v0) (k1 v1) (k2 v2)) :test #'equal)))
+(let ((table (make-hash-table))
+ stack)
+ (mapc #'(lambda (k v) (setf (gethash k table) v)) '(k0 k1 k2) '(v0 v1 v2))
+ (loop for k being the hash-keys in table using (hash-value v)
+ do (push (list k v) stack))
+ (null (set-difference stack '((k0 v0) (k1 v1) (k2 v2)) :test #'equal)))
+
+
+
+(let ((table (make-hash-table))
+ stack)
+ (mapc #'(lambda (k v) (setf (gethash k table) v)) '(k0 k1 k2) '(v0 v1 v2))
+ (loop for v being each hash-value of table do (push v stack))
+ (null (set-exclusive-or stack '(v0 v1 v2))))
+(let ((table (make-hash-table))
+ stack)
+ (mapc #'(lambda (k v) (setf (gethash k table) v)) '(k0 k1 k2) '(v0 v1 v2))
+ (loop for v being the hash-value of table do (push v stack))
+ (null (set-exclusive-or stack '(v0 v1 v2))))
+(let ((table (make-hash-table))
+ stack)
+ (mapc #'(lambda (k v) (setf (gethash k table) v)) '(k0 k1 k2) '(v0 v1 v2))
+ (loop for v being each hash-values of table do (push v stack))
+ (null (set-exclusive-or stack '(v0 v1 v2))))
+(let ((table (make-hash-table))
+ stack)
+ (mapc #'(lambda (k v) (setf (gethash k table) v)) '(k0 k1 k2) '(v0 v1 v2))
+ (loop for v being the hash-values of table do (push v stack))
+ (null (set-exclusive-or stack '(v0 v1 v2))))
+(let ((table (make-hash-table))
+ stack)
+ (mapc #'(lambda (k v) (setf (gethash k table) v)) '(k0 k1 k2) '(v0 v1 v2))
+ (loop for v being each hash-value in table do (push v stack))
+ (null (set-exclusive-or stack '(v0 v1 v2))))
+(let ((table (make-hash-table))
+ stack)
+ (mapc #'(lambda (k v) (setf (gethash k table) v)) '(k0 k1 k2) '(v0 v1 v2))
+ (loop for v being the hash-value in table do (push v stack))
+ (null (set-exclusive-or stack '(v0 v1 v2))))
+(let ((table (make-hash-table))
+ stack)
+ (mapc #'(lambda (k v) (setf (gethash k table) v)) '(k0 k1 k2) '(v0 v1 v2))
+ (loop for v being each hash-values in table do (push v stack))
+ (null (set-exclusive-or stack '(v0 v1 v2))))
+(let ((table (make-hash-table))
+ stack)
+ (mapc #'(lambda (k v) (setf (gethash k table) v)) '(k0 k1 k2) '(v0 v1 v2))
+ (loop for v being the hash-values in table do (push v stack))
+ (null (set-exclusive-or stack '(v0 v1 v2))))
+
+(let ((table (make-hash-table))
+ stack)
+ (mapc #'(lambda (k v) (setf (gethash k table) v)) '(k0 k1 k2) '(v0 v1 v2))
+ (loop for v being each hash-value of table using (hash-key k)
+ do (push (list k v) stack))
+ (null (set-exclusive-or stack '((k0 v0) (k1 v1) (k2 v2)) :test #'equal)))
+(let ((table (make-hash-table))
+ stack)
+ (mapc #'(lambda (k v) (setf (gethash k table) v)) '(k0 k1 k2) '(v0 v1 v2))
+ (loop for v being the hash-value of table using (hash-key k)
+ do (push (list k v) stack))
+ (null (set-exclusive-or stack '((k0 v0) (k1 v1) (k2 v2)) :test #'equal)))
+(let ((table (make-hash-table))
+ stack)
+ (mapc #'(lambda (k v) (setf (gethash k table) v)) '(k0 k1 k2) '(v0 v1 v2))
+ (loop for v being each hash-values of table using (hash-key k)
+ do (push (list k v) stack))
+ (null (set-exclusive-or stack '((k0 v0) (k1 v1) (k2 v2)) :test #'equal)))
+(let ((table (make-hash-table))
+ stack)
+ (mapc #'(lambda (k v) (setf (gethash k table) v)) '(k0 k1 k2) '(v0 v1 v2))
+ (loop for v being the hash-values of table using (hash-key k)
+ do (push (list k v) stack))
+ (null (set-exclusive-or stack '((k0 v0) (k1 v1) (k2 v2)) :test #'equal)))
+(let ((table (make-hash-table))
+ stack)
+ (mapc #'(lambda (k v) (setf (gethash k table) v)) '(k0 k1 k2) '(v0 v1 v2))
+ (loop for v being each hash-value in table using (hash-key k)
+ do (push (list k v) stack))
+ (null (set-exclusive-or stack '((k0 v0) (k1 v1) (k2 v2)) :test #'equal)))
+(let ((table (make-hash-table))
+ stack)
+ (mapc #'(lambda (k v) (setf (gethash k table) v)) '(k0 k1 k2) '(v0 v1 v2))
+ (loop for v being the hash-value in table using (hash-key k)
+ do (push (list k v) stack))
+ (null (set-exclusive-or stack '((k0 v0) (k1 v1) (k2 v2)) :test #'equal)))
+(let ((table (make-hash-table))
+ stack)
+ (mapc #'(lambda (k v) (setf (gethash k table) v)) '(k0 k1 k2) '(v0 v1 v2))
+ (loop for v being each hash-values in table using (hash-key k)
+ do (push (list k v) stack))
+ (null (set-exclusive-or stack '((k0 v0) (k1 v1) (k2 v2)) :test #'equal)))
+(let ((table (make-hash-table))
+ stack)
+ (mapc #'(lambda (k v) (setf (gethash k table) v)) '(k0 k1 k2) '(v0 v1 v2))
+ (loop for v being the hash-values in table using (hash-key k)
+ do (push (list k v) stack))
+ (null (set-exclusive-or stack '((k0 v0) (k1 v1) (k2 v2)) :test #'equal)))
+
+(let ((table (make-hash-table :test 'equal))
+ stack)
+ (mapc #'(lambda (k v) (setf (gethash k table) v))
+ '((k0 k00) (k1 k11) (k2 k22)) '((v0 v00) (v1 v11) (v2 v22)))
+ (loop for (k kk) being each hash-key of table do (push (list k kk) stack))
+ (null (set-exclusive-or stack '((k0 k00) (k1 k11) (k2 k22)) :test #'equal)))
+
+(let ((table (make-hash-table :test 'equal))
+ stack)
+ (mapc #'(lambda (k v) (setf (gethash k table) v))
+ '((k0 k00) (k1 k11) (k2 k22)) '((v0 v00) (v1 v11) (v2 v22)))
+ (loop :for (k kk) :being :each :hash-key :of table :using (hash-value (v vv))
+ do (push (list k kk v vv) stack))
+ (null (set-exclusive-or stack
+ '((k0 k00 v0 v00) (k1 k11 v1 v11) (k2 k22 v2 v22))
+ :test #'equal)))
+
+(let ((table (make-hash-table :test 'equal))
+ stack)
+ (mapc #'(lambda (k v) (setf (gethash k table) v))
+ '((k0 k00) (k1 k11) (k2 k22)) '((v0 v00) (v1 v11) (v2 v22)))
+ (loop :for (v vv) :being :each :hash-value :of table :using (hash-key (k kk))
+ do (push (list k kk v vv) stack))
+ (null (set-exclusive-or stack
+ '((k0 k00 v0 v00) (k1 k11 v1 v11) (k2 k22 v2 v22))
+ :test #'equal)))
+
+(let ((table (make-hash-table))
+ stack)
+ (mapc #'(lambda (k v) (setf (gethash k table) v)) '(k0 k1 k2) '(v0 v1 v2))
+ (loop for k of-type symbol being each hash-key of table do (push k stack))
+ (null (set-exclusive-or stack '(k0 k1 k2))))
+
+(let ((table (make-hash-table :test 'equal))
+ stack)
+ (mapc #'(lambda (k v) (setf (gethash k table) v))
+ '((k0 k00) (k1 k11) (k2 k22)) '((v0 v00) (v1 v11) (v2 v22)))
+ (loop for (k kk) of-type symbol being each hash-key of table
+ do (push (list k kk) stack))
+ (null (set-exclusive-or stack '((k0 k00) (k1 k11) (k2 k22)) :test #'equal)))
+
+(let ((table (make-hash-table :test 'equal))
+ stack)
+ (mapc #'(lambda (k v) (setf (gethash k table) v))
+ '((k0 k00) (k1 k11) (k2 k22)) '((v0 v00) (v1 v11) (v2 v22)))
+ (loop for (k kk) of-type (symbol symbol) being each hash-key of table
+ do (push (list k kk) stack))
+ (null (set-exclusive-or stack '((k0 k00) (k1 k11) (k2 k22)) :test #'equal)))
+
+(let ((table (make-hash-table))
+ stack)
+ (mapc #'(lambda (k v) (setf (gethash k table) v)) '(0 1 2) '(v0 v1 v2))
+ (loop for k fixnum being each hash-key of table do (push k stack))
+ (null (set-exclusive-or stack '(0 1 2))))
+(let ((table (make-hash-table))
+ stack)
+ (mapc #'(lambda (k v) (setf (gethash k table) v)) '(0 1 2) '(v0 v1 v2))
+ (loop for k of-type fixnum being each hash-key of table do (push k stack))
+ (null (set-exclusive-or stack '(0 1 2))))
+(let ((table (make-hash-table))
+ stack)
+ (mapc #'(lambda (k v) (setf (gethash k table) v)) '(0.0 1.0 2.0) '(v0 v1 v2))
+ (loop for k float being each hash-key of table do (push k stack))
+ (null (set-exclusive-or stack '(0.0 1.0 2.0))))
+(let ((table (make-hash-table))
+ stack)
+ (mapc #'(lambda (k v) (setf (gethash k table) v)) '(0.0 1.0 2.0) '(v0 v1 v2))
+ (loop for k of-type float being each hash-key of table do (push k stack))
+ (null (set-exclusive-or stack '(0.0 1.0 2.0))))
+(let ((table (make-hash-table))
+ stack)
+ (mapc #'(lambda (k v) (setf (gethash k table) v)) '(0.0 1.0 2.0) '(v0 v1 v2))
+ (loop for k t being each hash-key of table do (push k stack))
+ (null (set-exclusive-or stack '(0.0 1.0 2.0))))
+(let ((table (make-hash-table))
+ stack)
+ (mapc #'(lambda (k v) (setf (gethash k table) v)) '(0.0 1.0 2.0) '(v0 v1 v2))
+ (loop for k of-type t being each hash-key of table do (push k stack))
+ (null (set-exclusive-or stack '(0.0 1.0 2.0))))
+(let ((table (make-hash-table))
+ stack)
+ (mapc #'(lambda (k v) (setf (gethash k table) v)) '(#\a #\b #\c) '(v0 v1 v2))
+ (loop for k of-type character being each hash-key of table do (push k stack))
+ (null (set-exclusive-or stack '(#\a #\b #\c))))
+(let ((table (make-hash-table))
+ stack)
+ (mapc #'(lambda (k v) (setf (gethash k table) v)) '(k0 k1 k2) '(v0 v1 v2))
+ (loop for v t being each hash-value of table do (push v stack))
+ (null (set-exclusive-or stack '(v0 v1 v2))))
+(let ((table (make-hash-table))
+ stack)
+ (mapc #'(lambda (k v) (setf (gethash k table) v)) '(k0 k1 k2) '(v0 v1 v2))
+ (loop for v of-type t being each hash-value of table do (push v stack))
+ (null (set-exclusive-or stack '(v0 v1 v2))))
+(let ((table (make-hash-table))
+ stack)
+ (mapc #'(lambda (k v) (setf (gethash k table) v)) '(k0 k1 k2) '(v0 v1 v2))
+ (loop for v of-type symbol being each hash-value of table do (push v stack))
+ (null (set-exclusive-or stack '(v0 v1 v2))))
+(let ((table (make-hash-table))
+ stack)
+ (mapc #'(lambda (k v) (setf (gethash k table) v)) '(k0 k1 k2) '(0 1 2))
+ (loop for v fixnum being each hash-value of table do (push v stack))
+ (null (set-exclusive-or stack '(0 1 2))))
+(let ((table (make-hash-table))
+ stack)
+ (mapc #'(lambda (k v) (setf (gethash k table) v)) '(k0 k1 k2) '(0 1 2))
+ (loop for v of-type (integer 0 2) being each hash-value of table
+ do (push v stack))
+ (null (set-exclusive-or stack '(0 1 2))))
+(let ((table (make-hash-table))
+ stack)
+ (mapc #'(lambda (k v) (setf (gethash k table) v)) '(k0 k1 k2) '(0.0 1.0 2.0))
+ (loop for v float being each hash-value of table do (push v stack))
+ (null (set-exclusive-or stack '(0.0 1.0 2.0))))
+(let ((table (make-hash-table))
+ stack)
+ (mapc #'(lambda (k v) (setf (gethash k table) v)) '(k0 k1 k2) '(#\a #\b #\c))
+ (loop for v of-type base-char being each hash-value of table do (push v stack))
+ (null (set-exclusive-or stack '(#\a #\b #\c))))
+
+
+
+
+;; for-as and preposition
+(equal (let (stack)
+ (loop for a from 1 upto 3 and x = 0 then a
+ do (push x stack))
+ stack)
+ '(2 1 0))
+(equal (let (stack)
+ (loop for a from 0 upto 3
+ for x = 0 then a
+ do (push x stack))
+ stack)
+ '(3 2 1 0))
+(equal (let ((i 4)
+ stack)
+ (loop for a = 0 then (1+ a)
+ for b = 0 then a
+ for c = 0 then b
+ do (when (zerop (decf i)) (return))
+ (push (list a b c) stack))
+ stack)
+ '((2 2 2) (1 1 1) (0 0 0)))
+(equal (let ((i 5)
+ stack)
+ (loop for a = 0 then (1+ a) and b = 0 then a and c = 0 then b
+ do (when (zerop (decf i)) (return))
+ (push (list a b c) stack))
+ stack)
+ '((3 2 1) (2 1 0) (1 0 0) (0 0 0)))
+(equal (let (stack) (loop for a in '(0 1 2 3) for x = a do (push x stack)) stack)
+ '(3 2 1 0))
+(equal (let (stack) (loop for a in '(0 1 2 3) and x = 100 then a
+ do (push x stack)) stack)
+ '(2 1 0 100))
+(equal (let (stack) (loop for a on '(0 1 2 3) for x = (car a)
+ do (push x stack)) stack)
+ '(3 2 1 0))
+(equal (let (stack) (loop for a on '(0 1 2 3) and x = 100 then (car a)
+ do (push x stack)) stack)
+ '(2 1 0 100))
+(equal (let (stack) (loop for a across #(0 1 2 3) for x = a
+ do (push x stack)) stack)
+ '(3 2 1 0))
+(equal (let (stack) (loop for a across #(0 1 2 3) and x = 100 then a
+ do (push x stack)) stack)
+ '(2 1 0 100))
+(equal (loop for x from 1 to 10
+ for y = nil then x
+ collect (list x y))
+ '((1 NIL) (2 2) (3 3) (4 4) (5 5) (6 6) (7 7) (8 8) (9 9) (10 10)))
+(equal (loop for x from 1 to 10
+ and y = nil then x
+ collect (list x y))
+ '((1 NIL) (2 1) (3 2) (4 3) (5 4) (6 5) (7 6) (8 7) (9 8) (10 9)))
+(= 280 (loop for a upfrom 0 upto 9
+ and b downfrom 9 downto 0
+ and c from 0 to 9
+ and d from 10 above 0
+ and e below 10
+ and f to 9
+ summing (+ a b c d e f)))
+(equal (loop for a from 1 upto 9
+ as b = 0 then a
+ as c = -1 then b
+ as d = -2 then c
+ as e = -3 then d
+ as f = -4 then e
+ collecting (list a b c d e f))
+ '((1 0 -1 -2 -3 -4) (2 2 2 2 2 2) (3 3 3 3 3 3) (4 4 4 4 4 4)
+ (5 5 5 5 5 5) (6 6 6 6 6 6) (7 7 7 7 7 7) (8 8 8 8 8 8) (9 9 9 9 9 9)))
+(equal (loop for a from 1 upto 9
+ and b = 0 then a
+ and c = -1 then b
+ and d = -2 then c
+ and e = -3 then d
+ and f = -4 then e
+ collecting (list a b c d e f))
+ '((1 0 -1 -2 -3 -4) (2 1 0 -1 -2 -3) (3 2 1 0 -1 -2) (4 3 2 1 0 -1)
+ (5 4 3 2 1 0) (6 5 4 3 2 1) (7 6 5 4 3 2) (8 7 6 5 4 3) (9 8 7 6 5 4)))
+(equal (loop for a from 1 upto 9
+ and b = 0 then a
+ and c = -1 then b
+ and d = -2 then c
+ and e = -3 then d
+ and f = -4 then e
+ for i from 9 downto 1
+ and j = 8 then i
+ and k = 7 then j
+ and l = 6 then k
+ and m = 5 then l
+ and n = 4 then m
+ collecting (list a b c d e f)
+ collecting (list i j k l m n))
+ '((1 0 -1 -2 -3 -4) (9 8 7 6 5 4) (2 1 0 -1 -2 -3) (8 9 8 7 6 5)
+ (3 2 1 0 -1 -2)
+ (7 8 9 8 7 6) (4 3 2 1 0 -1) (6 7 8 9 8 7) (5 4 3 2 1 0) (5 6 7 8 9 8)
+ (6 5 4 3 2 1) (4 5 6 7 8 9) (7 6 5 4 3 2) (3 4 5 6 7 8) (8 7 6 5 4 3)
+ (2 3 4 5 6 7) (9 8 7 6 5 4) (1 2 3 4 5 6)))
+
+(let (stack)
+ (loop for a on (progn (push 1 stack) '(0 1 2))
+ and b across (progn (push 2 stack) "abc"))
+ (equal '(2 1) stack))
+
+
+
+;; ambiguous cases
+(equal (let ((a 5))
+ (loop for a from 0 upto 5
+ and b from a downto 0
+ collect (list a b)))
+ '((0 5) (1 4) (2 3) (3 2) (4 1) (5 0)))
+(equal (let ((a :outer))
+ (loop for a from 0 upto 5
+ and b in (list a)
+ collect (list a b)))
+ '((0 :outer)))
+(equal (let ((b 0))
+ (loop for a from b upto 5
+ and b in '(a b c)
+ collecting (list a b)))
+ '((0 a) (1 b) (2 c)))
+
+
+;; with-clause
+(zerop (loop with x = 0 do (return x)))
+(equal (let (stack)
+ (loop with x = 1 for a from x to 3 by 1 do (push a stack)) stack)
+ '(3 2 1))
+(equal (loop with a = 1
+ with b = (+ a 2)
+ with c = (+ b 3)
+ return (list a b c))
+ '(1 3 6))
+(equal (loop with a = 1
+ and b = 2
+ and c = 3
+ return (list a b c))
+ '(1 2 3))
+(let ((a 5)
+ (b 10))
+ (equal (loop with a = 1
+ and b = (+ a 2)
+ and c = (+ b 3)
+ return (list a b c))
+ '(1 7 13)))
+(equal (loop with (a b c) of-type (float integer float)
+ return (list a b c))
+ '(0.0 0 0.0))
+(equal (loop with (a b c) of-type float
+ return (list a b c))
+ '(0.0 0.0 0.0))
+(flet ((triple () (values 0 1 2)))
+ (equal (loop with (a b c) = (multiple-value-list (triple))
+ do (return (list a b c)))
+ '(0 1 2)))
+(flet ((triple () (values 0 '(1) 2)))
+ (equal (loop with (a (b) c) = (multiple-value-list (triple))
+ do (return (list a b c)))
+ '(0 1 2)))
+(flet ((triple () (values 0 '(0 1 2) 2)))
+ (equal (loop with (a (nil b) c d) = (multiple-value-list (triple))
+ do (return (list a b c d)))
+ '(0 1 2 nil)))
+
+(flet ((triple () (values 0 1 2)))
+ (equal (loop with (a b c) fixnum = (multiple-value-list (triple))
+ do (return (list a b c)))
+ '(0 1 2)))
+(flet ((triple () (values 0 '(1) 2)))
+ (equal (loop with (a (b) c) of-type (fixnum (fixnum) fixnum) =
+ (multiple-value-list (triple))
+ do (return (list a b c)))
+ '(0 1 2)))
+
+
+
+;; binding (preferable)
+(equal (loop for a from 0 upto 5
+ for b from a downto -5
+ collect (list a b))
+ '((0 0) (1 -1) (2 -2) (3 -3) (4 -4) (5 -5)))
+(equal (loop for a from 0 upto 5
+ with x = a
+ collect (list a x))
+ '((0 0) (1 0) (2 0) (3 0) (4 0) (5 0)))
+
+
+;; initial-final-clause
+(zerop (loop initially (return 0)))
+(zerop (loop repeat 2 finally (return 0)))
+(= (loop with x = 0 initially (incf x) return x) 1)
+(= (loop with x = 0 for a from 0 below 3
+ initially (incf x) finally (return (incf x)))
+ 2)
+(= (loop with x = 0 for a from 0 below 3
+ initially (incf x) (incf x) finally (return (incf x)))
+ 3)
+(= (loop with x = 0 for a from 0 upto 3
+ initially (incf x) finally (incf x) (return (incf x)))
+ 3)
+(= (loop with x = 0 for a from 0 upto 3
+ initially (incf x) (incf x) finally (incf x) (return (incf x)))
+ 4)
+(= (loop with x = 0 for a from 0 below 3
+ do (incf x)
+ initially (incf x) (incf x) finally (incf x) (return (incf x)))
+ 7)
+
+; #-CLISP
+; ;;Bruno: unfounded expectations about the value of for-as iteration
+; ;;variables in INITIALLY and FINALLY clauses
+; ;;(See http://www.cliki.net/Proposed%20ANSI%20Revisions%20and%20Clarifications
+; ;;for a discussion of this spec weakness.)
+; (equal (let (val) (loop for a downto 3 from 100
+; for b in '(x y z) and c = 50 then (1+ c)
+; initially (setq val (list a b c))
+; finally (setq val (append (list a b c) val)))
+; val)
+; '(97 z 52 100 x 50))
+(= 33 (loop with x = 2
+ initially (setq x (* x 3))
+ for i below 3
+ initially (setq x (* x 5))
+ do (incf x i)
+ finally (return x)))
+(equal (loop with x = nil
+ repeat 2
+ initially (push 'initially0 x)
+ finally (push 'finally0 x)
+ initially (push 'initially1 x)
+ finally (push 'finally1 x)
+ do (push 'body0 x)
+ finally (push 'finally2 x) (push 'finally3 x)
+ finally (return (reverse x))
+ initially (push 'initially2 x) (push 'initially3 x)
+ do (push 'body1 x))
+ '(initially0 initially1 initially2 initially3
+ body0 body1 body0 body1
+ finally0 finally1 finally2 finally3))
+
+
+
+;; do-clause
+(equal (loop with i = 3
+ with stack = nil
+ do (when (zerop i) (loop-finish))
+ (decf i)
+ (push i stack)
+ finally (return stack))
+ '(0 1 2))
+(equal (loop with i = 3
+ with stack = nil
+ doing (when (zerop i) (loop-finish))
+ (decf i)
+ (push i stack)
+ finally (return stack))
+ '(0 1 2))
+(= (loop with x = 10 do (return x)) 10)
+(= (loop with x = 10 doing (return x)) 10)
+(= (loop with x = 0 do (incf x) doing (incf x) (return x)) 2)
+(= (loop with x = 0 do (incf x) doing (incf x) do (return x)) 2)
+(= (loop with x = 0 do (incf x) (incf x) doing (return x)) 2)
+(= (loop with x = 0 do (incf x) (incf x) (incf x) doing (incf x) (return x)) 4)
+
+
+
+;; conditional-clauses
+(let ((odd 0)
+ (even 0))
+ (and (null (loop for a from 1 upto 10
+ if (oddp a) do (incf odd) else do (incf even) end))
+ (= 5 odd even)))
+(let ((odd+ 0) (even+ 0) (odd- 0) (even- 0))
+ (and (null (loop for a from -10 upto 10
+ if (oddp a) if (> a 0) do (incf odd+) else do (incf odd-) end
+ else if (> a 0) do (incf even+) else do (incf even-)))
+ (= 5 odd+ even+ odd-)
+ (= even- 6)))
+(let ((odd+ 0) (even+ 0) (odd- 0) (even- 0))
+ (and (null (loop for a from -10 upto 10
+ unless (zerop a)
+ if (oddp a)
+ if (> a 0) do (incf odd+) else do (incf odd-) end
+ else
+ if (> a 0) do (incf even+) else do (incf even-)))
+ (= 5 odd+ even+ odd- even-)))
+(let ((odd+ 0) (even+ 0) (odd- 0) (even- 0))
+ (and (null (loop for a from -10 upto 10
+ if (not (zerop a))
+ when (oddp a)
+ unless (< a 0) do (incf odd+) else do (incf odd-) end
+ else
+ unless (<= a 0) do (incf even+) else do (incf even-)))
+ (= 5 odd+ even+ odd- even-)))
+(handler-bind ((simple-error #'(lambda (c) (declare (ignore c)) (continue))))
+ (eq 'continued
+ (loop for item in '(1 2 3 a 4 5)
+ when (not (numberp item))
+ return (or (cerror "ignore this error" "non-numeric value: ~s" item)
+ 'continued))))
+(equal (loop for i in '(1 324 2345 323 2 4 235 252)
+ when (oddp i) collect i into odd-numbers
+ else ; I is even.
+ collect i into even-numbers
+ finally
+ (return (list odd-numbers even-numbers)))
+ '((1 2345 323 235) (324 2 4 252)))
+(equal (loop for i in '(1 2 3 4 5 6)
+ when (and (> i 3) i)
+ collect it)
+ '(4 5 6))
+(= 4 (loop for i in '(1 2 3 4 5 6)
+ when (and (> i 3) i)
+ return it))
+(equal (let ((list '(0 3.0 apple 4 5 9.8 orange banana)))
+ (loop for i in list
+ when (numberp i)
+ when (floatp i)
+ collect i into float-numbers
+ else ; Not (floatp i)
+ collect i into other-numbers
+ else ; Not (numberp i)
+ when (symbolp i)
+ collect i into symbol-list
+ else ; Not (symbolp i)
+ do (error "found a funny value in list ~S, value ~S~%" list i)
+ finally (return (list float-numbers other-numbers symbol-list))))
+ '((3.0 9.8) (0 4 5) (APPLE ORANGE BANANA)))
+(equal (loop for i below 5 if (oddp i) collecting i) '(1 3))
+(equal (loop for i below 5 when (oddp i) collecting i) '(1 3))
+(equal (loop for i below 5
+ if (oddp i) collecting i else collecting (list i))
+ '((0) 1 (2) 3 (4)))
+(equal (loop for i below 5
+ when (oddp i) collecting i else collecting (list i))
+ '((0) 1 (2) 3 (4)))
+(equal (loop for i below 5 unless (evenp i) collecting i) '(1 3))
+(equal (loop for i below 5
+ unless (evenp i) collecting i else collecting (list i))
+ '((0) 1 (2) 3 (4)))
+
+(equal (loop for i below 5 if (oddp i) collecting i end) '(1 3))
+(equal (loop for i below 5 when (oddp i) collecting i end) '(1 3))
+(equal (loop for i below 5
+ if (oddp i) collecting i else collecting (list i) end)
+ '((0) 1 (2) 3 (4)))
+(equal (loop for i below 5
+ when (oddp i) collecting i else collecting (list i) end)
+ '((0) 1 (2) 3 (4)))
+(equal (loop for i below 5 unless (evenp i) collecting i end) '(1 3))
+(equal (loop for i below 5
+ unless (evenp i) collecting i else collecting (list i) end)
+ '((0) 1 (2) 3 (4)))
+
+(equal (loop for (a b) in '((0 0) (0 1))
+ if (zerop a) if (zerop b) collect '0-0 else collect '0-1)
+ '(|0-0| |0-1|))
+(equal (loop for (a b) in '((0 0) (0 1))
+ when (zerop a) if (zerop b) collect '0-0 else collect '0-1)
+ '(|0-0| |0-1|))
+(equal (loop for (a b) in '((0 0) (0 1) (1 0) (1 1))
+ if (zerop a) if (= b 1) collect '0-1 end
+ else collect '1-X)
+ '(|0-1| |1-X| |1-X|))
+(equal (loop for (a b) in '((0 0) (0 1) (1 0) (1 1))
+ when (zerop a) if (= b 1) collect '0-1 end
+ else collect '1-X)
+ '(|0-1| |1-X| |1-X|))
+(equal (loop for (a b) in '((0 0) (0 1))
+ unless (not (zerop a)) if (zerop b) collect '0-0 else collect '0-1)
+ '(|0-0| |0-1|))
+(equal (loop for (a b) in '((0 0) (0 1) (1 0) (1 1))
+ unless (not (zerop a)) if (= b 1) collect '0-1 end
+ else collect '1-X)
+ '(|0-1| |1-X| |1-X|))
+
+(equal (loop for (a b c) in '((0 0 0) (0 0 1)
+ (0 1 0) (0 1 1)
+ (1 0 0) (1 0 1)
+ (1 1 0) (1 1 1))
+ if (zerop a)
+ if (zerop b)
+ if (zerop c) collect 'x0-0-0 else collect 'x0-0-1
+ else if (zerop c) collect 'x0-1-0 else collect 'x0-1-1
+ else if (zerop b)
+ if (zerop c) collect 'x1-0-0 else collect 'x1-0-1
+ else if (zerop c) collect 'x1-1-0 else collect 'x1-1-1)
+ '(x0-0-0 x0-0-1 x0-1-0 x0-1-1 x1-0-0 x1-0-1 x1-1-0 x1-1-1))
+
+(equal (loop for a below 10
+ if (oddp a) collect a into bag and sum a into odd
+ else collect (list a) into bag and sum a into even
+ finally (return (list bag odd even)))
+ '(((0) 1 (2) 3 (4) 5 (6) 7 (8) 9) 25 20))
+
+(equal (loop for a below 10
+ if (oddp a)
+ collect a and collect (list a) and collect (list (list a))
+ else collect a)
+ '(0 1 (1) ((1)) 2 3 (3) ((3)) 4 5 (5) ((5)) 6 7 (7) ((7)) 8 9 (9) ((9))))
+
+(let ((c0 0) (c1 0))
+ (and (equal (loop for a below 10
+ when (oddp a)
+ collect a and do (incf c0) (decf c1) and collect (list a))
+ '(1 (1) 3 (3) 5 (5) 7 (7) 9 (9)))
+ (= c0 5)
+ (= c1 -5)))
+
+
+
+
+
+
+;; return-clause
+(zerop (loop return 0))
+(= (loop for a from 0 below 3 when (and (oddp a) a) return it) 1)
+(eq (loop for a in '(nil nil ok nil ok2) when a return it) 'ok)
+(eq 'ok (loop with a = 'ok if a return it else return it))
+(equal (multiple-value-list (loop return (values 0 1 2))) '(0 1 2))
+(let ((flag nil))
+ (and (eq t (loop for a below 3 when (oddp a) return t finally (setq flag t)))
+ (not flag)))
+(equal (loop for a in '(0 1 2 3) and b in '(3 2 1 0)
+ if (and (oddp a) a)
+ if (and (evenp b) b)
+ when (and (= (* a b) 0) (list a b)) return it)
+ '(3 0))
+
+
+;;; list-accumulation-clauses
+
+;; collect
+(equal (loop for a from 0 below 3 collect a) '(0 1 2))
+(equal (loop for a from 0 below 3 collecting a) '(0 1 2))
+(equal (loop for a in '(nil 0 nil nil 1 2 nil 3 nil 4)
+ when a collect it) '(0 1 2 3 4))
+(equal (loop for a in '(nil 0 nil nil 1 2 nil 3 nil 4)
+ when a collecting it) '(0 1 2 3 4))
+(equal (loop for a in '(nil 0 nil nil 1 2 nil 3 nil 4)
+ when a collect it into bag
+ finally (return bag))
+ '(0 1 2 3 4))
+(equal (loop for a in '(nil 0 nil nil 1 2 nil 3 nil 4)
+ when a collecting it into bag
+ finally (return bag))
+ '(0 1 2 3 4))
+(equal (loop for a below 10
+ if (oddp a) collect a into odd else collect a into even end
+ finally (return (list odd even)))
+ '((1 3 5 7 9) (0 2 4 6 8)))
+(equal (loop for a below 3
+ for b on '(2 1 0)
+ collecting a
+ appending b)
+ '(0 2 1 0 1 1 0 2 0))
+
+
+
+(= 15 (loop for i of-type fixnum in '(1 2 3 4 5) sum i))
+(= 22.4 (let ((series '(1.2 4.3 5.7))) (loop for v in series sum (* 2.0 v))))
+(equal (loop for a below 10
+ if (oddp a) collect a into odd and sum a into sum
+ finally (return (list odd sum)))
+ '((1 3 5 7 9) 25))
+
+(equal (loop for a below 10
+ if (oddp a) collect a into odd and sum a into odd-sum
+ else collect a into even and sum a into even-sum
+ end
+ finally (return (list odd odd-sum even even-sum)))
+ '((1 3 5 7 9) 25 (0 2 4 6 8) 20))
+(equal (loop for i in '(bird 3 4 turtle (1 . 4) horse cat)
+ when (symbolp i) collect i)
+ '(BIRD TURTLE HORSE CAT))
+(equal (loop for i below 3
+ for j upto 2
+ collecting i
+ collecting j)
+ '(0 0 1 1 2 2))
+(equal (loop for a from -10 upto 0
+ collecting a)
+ '(-10 -9 -8 -7 -6 -5 -4 -3 -2 -1 0))
+(null (loop for a from -10 upto 0
+ collecting a into list)) ;; not return automatically
+
+
+;; append
+(let* ((zero (list 0))
+ (one (list 1))
+ (two (list 2))
+ (list (list zero one two)))
+ (and (equal (loop for a in list append a) '(0 1 2))
+ (equal zero '(0))
+ (equal one '(1))
+ (equal two '(2))))
+(equal (loop for a in '(nil (1) nil (2)) when a append a) '(1 2))
+(equal (loop for a in '(nil (1) nil (2)) when a appending a) '(1 2))
+(null (loop for a in '(nil (1) nil (2)) when a append a into x))
+(null (loop for a in '(nil (1) nil (2)) when a appending a into x))
+(equal (loop for a in '(nil (1) nil (2)) when a append a into x
+ finally (return x)) '(1 2))
+(equal (loop for a in '(nil (1) nil (2)) when a appending a into x
+ finally (return x)) '(1 2))
+(equal (loop for a in '(nil (1) nil (2)) when a append it) '(1 2))
+(equal (loop for a in '(nil (1) nil (2)) when a appending it) '(1 2))
+(equal (loop for a on (list 0 1 2 3 4) when (oddp (car a)) append a)
+ '(1 2 3 4 3 4))
+(equal (loop for a on (list 0 1 2 3 4) when (oddp (car a)) appending a)
+ '(1 2 3 4 3 4))
+(equal (loop for x in '((a) (b) ((c))) append x) '(A B (C)))
+
+;; nconc
+(let ((list (list (list 0) (list 1) (list 2) (list 3))))
+ (and (equal (loop for a in list nconc a) '(0 1 2 3))
+ (equal list '((0 1 2 3) (1 2 3) (2 3) (3)))))
+(let ((list (list (list 0) (list 1) (list 2) (list 3))))
+ (and (equal (loop for a in list nconcing a) '(0 1 2 3))
+ (equal list '((0 1 2 3) (1 2 3) (2 3) (3)))))
+(let ((list (list nil (list 0) nil nil (list 1) (list 2) nil (list 3) nil)))
+ (and (equal (loop for a in list when a nconc it) '(0 1 2 3))
+ (equal list '(nil (0 1 2 3) nil nil (1 2 3) (2 3) nil (3) nil))))
+(let ((list (list nil (list 0) nil nil (list 1) (list 2) nil (list 3) nil)))
+ (and (equal (loop for a in list when a nconcing it) '(0 1 2 3))
+ (equal list '(nil (0 1 2 3) nil nil (1 2 3) (2 3) nil (3) nil))))
+(null (loop for a in (list (list (list 0) (list 1) (list 2) (list 3)))
+ nconc a into x))
+(null (loop for a in (list (list (list 0) (list 1) (list 2) (list 3)))
+ nconcing a into x))
+(let ((list (list (list 0) (list 1) (list 2) (list 3))))
+ (and (equal (loop for a in list nconc a into x finally (return x)) '(0 1 2 3))
+ (equal list '((0 1 2 3) (1 2 3) (2 3) (3)))))
+(let ((list (list (list 0) (list 1) (list 2) (list 3))))
+ (and (equal (loop for a in list nconcing a into x finally (return x)) '(0 1 2 3))
+ (equal list '((0 1 2 3) (1 2 3) (2 3) (3)))))
+(equal (loop for i upfrom 0 as x in '(a b (c))
+ nconc (if (evenp i) (list x) nil))
+ '(A (C)))
+
+
+(equal (loop for a in '(0 3 6)
+ for b in '((1) (4) (7))
+ for c in (copy-tree '((2) (5) (8)))
+ collecting a
+ appending b
+ nconcing c)
+ '(0 1 2 3 4 5 6 7 8))
+(equal (loop for a in '(0 3 6)
+ for b in (copy-tree '((1) (4) (7)))
+ for c in (list (list 2) (list 5) (list 8))
+ collecting a
+ nconcing b
+ appending c)
+ '(0 1 2 3 4 5 6 7 8))
+(equal (loop for a in '((0) (3) (6))
+ for b in (copy-tree '((1) (4) (7)))
+ for c in '(2 5 8)
+ appending a
+ nconcing b
+ collecting c)
+ '(0 1 2 3 4 5 6 7 8))
+(equal (loop for a in '((0) (3) (6))
+ for b in '(1 4 7)
+ for c in (copy-tree '((2) (5) (8)))
+ appending a
+ collecting b
+ nconcing c)
+ '(0 1 2 3 4 5 6 7 8))
+(equal (loop for a in (copy-tree '((0) (3) (6)))
+ for b in '(1 4 7)
+ for c in '((2) (5) (8))
+ nconcing a
+ collecting b
+ appending c)
+ '(0 1 2 3 4 5 6 7 8))
+(equal (loop for a in (copy-tree '((0) (3) (6)))
+ for b in '((1) (4) (7))
+ for c in '(2 5 8)
+ nconcing a
+ appending b
+ collecting c)
+ '(0 1 2 3 4 5 6 7 8))
+(equal (loop for a in '(0 6)
+ for b in '((1 2 3) (7 8 9))
+ for c in (copy-tree '((4 5) (10)))
+ collect a
+ append b
+ nconc c)
+ '(0 1 2 3 4 5 6 7 8 9 10))
+(null (loop for a in '()
+ for b in '((1 2 3) (7 8 9))
+ for c in (copy-tree '((4 5) (10)))
+ collect a
+ append b
+ nconc c))
+(equal (loop for a in '(0 3 6)
+ for b in '((1) (4) (7))
+ for c in (copy-tree '((2) (5) (8)))
+ collecting a into list
+ appending b into list
+ nconcing c into list
+ finally (return list))
+ '(0 1 2 3 4 5 6 7 8))
+(equal (loop for a in '(0 3 6)
+ for b in '(1 4 7)
+ for c in (copy-tree '((2) (5) (8)))
+ collect a collect b nconc c)
+ '(0 1 2 3 4 5 6 7 8))
+
+(= 60 (loop for a upto 10 summing a when (oddp a) counting it))
+(= 220 (loop for a upto 10
+ for b downfrom 20
+ sum a
+ summing b))
+(= 60 (loop for a upto 10
+ summing a into sum
+ when (oddp a) counting it into sum
+ finally (return sum)))
+(= 21 (loop for a in '(a 1 b 3 c 4 5 x 2 y z)
+ if (and (numberp a) a) summing it
+ else counting 1))
+
+
+(= 5 (loop for a from 3 to 5 maximizing a minimizing a))
+(= 3 (loop for a upto 3 for b from 6 downto 3 maximize a minimize b))
+(equal (loop for a in '(0 -1 1 -2 2 -3 3)
+ maximize a into plus
+ minimize a into minus
+ finally (return (list minus plus)))
+ '(-3 3))
+
+(equal (let (val)
+ (list (loop for a below 10
+ collecting a
+ summing a into sum
+ counting a into count
+ maximizing a into max
+ minimizing a into min
+ finally (setq val (list sum count max min)))
+ val))
+ '((0 1 2 3 4 5 6 7 8 9) (45 10 9 0)))
+(eq 'ok (loop for a below 3 collecting a
+ finally (return 'ok)))
+(let ((flag nil))
+ (and (equal (loop for a below 3 collecting a
+ finally (setq flag t))
+ '(0 1 2))
+ flag))
+(eq 'ok (loop for a below 3 appending (list a)
+ finally (return 'ok)))
+(eq 'ok (loop for a below 3 nconcing (list a)
+ finally (return 'ok)))
+
+
+
+
+
+
+
+;; numeric-accumulation-clauses
+;; count
+(= 5 (loop for a from 1 upto 10
+ counting (evenp a)))
+(= (loop for a downfrom 10 above 0 count a) 10)
+(= (loop for a downfrom 10 above 0 counting a) 10)
+(null (loop for a downfrom 10 above 0 count a into x))
+(null (loop for a downfrom 10 above 0 counting a into x))
+(= (loop for a downfrom 10 above 0 count a into x finally (return x)) 10)
+(= (loop for a downfrom 10 above 0 counting a into x finally (return x)) 10)
+(= (loop for a in '(nil a nil nil b nil c d e nil nil nil nil f)
+ when a count it) 6)
+(= (loop for a in '(nil a nil nil b nil c d e nil nil nil nil f)
+ when a counting it) 6)
+(null (loop for a in '(nil a nil nil b nil c d e nil nil nil nil f)
+ when a count it into x))
+(null (loop for a in '(nil a nil nil b nil c d e nil nil nil nil f)
+ when a counting it into x))
+(= (loop for a in '(nil a nil nil b nil c d e nil nil nil nil f)
+ when a count it into x finally (return x)) 6)
+(= (loop for a in '(nil a nil nil b nil c d e nil nil nil nil f)
+ when a counting it into x finally (return x)) 6)
+(= 5 (loop for i in '(a b nil c nil d e) count i))
+
+;; sum
+(= (loop for a to 10 sum a) 55)
+(= (loop for a to 10 summing a) 55)
+(= (loop for a in '(0 nil 1 nil 2 3 nil 4 5 6 7 nil 8 9 10 nil)
+ if a sum it) 55)
+(= (loop for a in '(0 nil 1 nil 2 3 nil 4 5 6 7 nil 8 9 10 nil)
+ if a summing it) 55)
+(loop for a to 10
+ sum a into sum
+ if (oddp a) sum a into odd
+ else sum a into even
+ finally (return (= sum (+ odd even))))
+(loop for a to 10
+ summing a into sum
+ if (oddp a) sum a into odd
+ else summing a into even
+ finally (return (= sum (+ odd even))))
+(= 15 (loop for a downfrom 5 to 1
+ summing a))
+(null (loop for a downfrom 5 to 1
+ summing a into n)) ;; not return automatically
+
+(= (loop for i from 1 to 4
+ sum i fixnum
+ count t fixnum)
+ 14)
+
+
+;; maximize
+(= 5 (loop for i in '(2 1 5 3 4) maximize i))
+(= (loop for a in '(0 5 9) maximize a) 9)
+(= (loop for a in '(0 5 9) maximizing a) 9)
+(= (loop for a in '(0 9 5) maximize a) 9)
+(= (loop for a in '(0 9 5) maximizing a) 9)
+(= (loop for a in '(9 0 5) maximize a) 9)
+(= (loop for a in '(9 0 5) maximizing a) 9)
+(= (loop for a in '(9 0 9 5) maximize a) 9)
+(= (loop for a in '(9 0 9 5) maximizing a) 9)
+(let (list)
+ (loop (when (= (first (push (random 10) list)) 9) (return)))
+ (= (loop for a in list maximize a) 9))
+(let (list)
+ (loop (when (= (first (push (random 10) list)) 9) (return)))
+ (= (loop for a in list maximizing a) 9))
+(let (list)
+ (loop (when (= (first (push (random 100) list)) 99) (return)))
+ (= (loop for a in list maximize a) 99))
+(let (list)
+ (loop (when (= (first (push (random 100) list)) 99) (return)))
+ (= (loop for a in list maximizing a) 99))
+(let (list)
+ (loop (when (= (first (push (random 1000) list)) 999) (return)))
+ (= (loop for a in list maximize a) 999))
+(let (list)
+ (loop (when (= (first (push (random 1000) list)) 999) (return)))
+ (= (loop for a in list maximizing a) 999))
+(null (loop for a in '(0 5 9) maximize a into max))
+(null (loop for a in '(0 5 9) maximizing a into max))
+(= (loop for a in '(0 5 9) maximize a into max finally (return max)) 9)
+(= (loop for a in '(0 5 9) maximizing a into max finally (return max)) 9)
+(= (loop for a in '(0 5 9) maximize a into max of-type integer
+ finally (return max)) 9)
+(= (loop for a in '(0 5 9) maximizing a into max of-type integer
+ finally (return max)) 9)
+(= (loop for a in '(0.0 5.0 9.0) maximize a into max float
+ finally (return max)) 9.0)
+(= (loop for a in '(0.0 5.0 9.0) maximizing a into max float
+ finally (return max)) 9.0)
+(let ((series '(1.2 4.3 5.7)))
+ (= 6 (loop for v in series maximize (round v) of-type fixnum)))
+
+;; minimize
+(= 1 (loop for i in '(2 1 5 3 4) minimize i))
+(= (loop for a in '(0 5 9) minimize a) 0)
+(= (loop for a in '(0 5 9) minimizing a) 0)
+(= (loop for a in '(9 5 0) minimize a) 0)
+(= (loop for a in '(9 5 0) minimizing a) 0)
+(= (loop for a in '(9 0 5) minimize a) 0)
+(= (loop for a in '(9 0 5) minimizing a) 0)
+(= (loop for a in '(9 0 9 0 5 0) minimizing a) 0)
+(= (loop for a in '(9 0 9 0 5 0) minimizing a) 0)
+(= (loop for a in '(1 5 9) minimize a) 1)
+(= (loop for a in '(1 5 9) minimizing a) 1)
+(= (loop for a in '(9 5 1) minimize a) 1)
+(= (loop for a in '(9 5 1) minimizing a) 1)
+(= (loop for a in '(9 1 5) minimize a) 1)
+(= (loop for a in '(9 1 5) minimizing a) 1)
+(= (loop for a in '(9 1 9 1 5 1) minimizing a) 1)
+(= (loop for a in '(9 1 9 1 5 1) minimizing a) 1)
+(let (list)
+ (loop (when (zerop (first (push (random 10) list))) (return)))
+ (zerop (loop for a in list minimize a)))
+(let (list)
+ (loop (when (zerop (first (push (random 10) list))) (return)))
+ (zerop (loop for a in list minimizing a)))
+(let (list)
+ (loop (when (zerop (first (push (random 100) list))) (return)))
+ (zerop (loop for a in list minimize a)))
+(let (list)
+ (loop (when (zerop (first (push (random 100) list))) (return)))
+ (zerop (loop for a in list minimizing a)))
+(let (list)
+ (loop (when (zerop (first (push (random 1000) list))) (return)))
+ (zerop (loop for a in list minimize a)))
+(let (list)
+ (loop (when (zerop (first (push (random 1000) list))) (return)))
+ (zerop (loop for a in list minimizing a)))
+(null (loop for a in '(0 5 9) minimize a into min))
+(null (loop for a in '(0 5 9) minimizing a into min))
+(zerop (loop for a in '(0 5 9) minimize a into min finally (return min)))
+(zerop (loop for a in '(0 5 9) minimizing a into min finally (return min)))
+(zerop (loop for a in '(0 5 9) minimize a into min of-type integer
+ finally (return min)))
+(zerop (loop for a in '(0 5 9) minimizing a into min of-type integer
+ finally (return min)))
+(= (loop for a in '(0.0 5.0 9.0) minimize a into min float
+ finally (return min)) 0.0)
+(= (loop for a in '(0.0 5.0 9.0) minimizing a into min float
+ finally (return min)) 0.0)
+(= 1 (let ((series '(1.2 4.3 5.7)))
+ (loop for v of-type float in series
+ minimize (round v) into result of-type fixnum
+ finally (return result))))
+(= 10 (loop for a in '(nil 1 nil 2 nil 3 nil 4)
+ when a summing it fixnum))
+(= 10 (loop for a in '(nil 1 nil 2 nil 3 nil 4)
+ when a summing it of-type fixnum))
+(= 10.0 (loop for a in '(nil 1.0 nil 2.0 nil 3.0 nil 4.0)
+ when a summing it float))
+(= 10.0 (loop for a in '(nil 1.0 nil 2.0 nil 3.0 nil 4.0)
+ when a summing it of-type float))
+(= 10 (loop for a in '(nil 1 nil 2 nil 3 nil 4)
+ when a summing it of-type number))
+(= 10 (loop for a in '(nil 1 nil 2 nil 3 nil 4)
+ when a summing it of-type (integer 0)))
+
+(= 10 (loop for a in '(nil 1 nil 2 nil 3 nil 4)
+ when a summing a fixnum))
+(= 10 (loop for a in '(nil 1 nil 2 nil 3 nil 4)
+ when a summing a of-type fixnum))
+(= 10.0 (loop for a in '(nil 1.0 nil 2.0 nil 3.0 nil 4.0)
+ when a summing a float))
+(= 10.0 (loop for a in '(nil 1.0 nil 2.0 nil 3.0 nil 4.0)
+ when a summing a of-type float))
+(= 10 (loop for a in '(nil 1 nil 2 nil 3 nil 4)
+ when a summing a of-type number))
+(= 10 (loop for a in '(nil 1 nil 2 nil 3 nil 4)
+ when a summing a of-type (integer 0)))
+
+(= 10 (loop for a in '(nil 1 nil 2 nil 3 nil 4)
+ when a summing a into sum fixnum finally (return sum)))
+(= 10 (loop for a in '(nil 1 nil 2 nil 3 nil 4)
+ when a summing a into sum of-type fixnum finally (return sum)))
+(= 10.0 (loop for a in '(nil 1.0 nil 2.0 nil 3.0 nil 4.0)
+ when a summing a into sum float finally (return sum)))
+(= 10.0 (loop for a in '(nil 1.0 nil 2.0 nil 3.0 nil 4.0)
+ when a summing a into sum of-type float finally (return sum)))
+(= 10 (loop for a in '(nil 1 nil 2 nil 3 nil 4)
+ when a summing a into sum of-type number finally (return sum)))
+(= 10 (loop for a in '(nil 1 nil 2 nil 3 nil 4)
+ when a summing a into sum of-type (integer 0) finally (return sum)))
+
+
+(= 10 (loop for a in '(nil 1 nil 2 nil 3 nil 4)
+ when a sum it fixnum))
+(= 10 (loop for a in '(nil 1 nil 2 nil 3 nil 4)
+ when a sum it of-type fixnum))
+(= 10.0 (loop for a in '(nil 1.0 nil 2.0 nil 3.0 nil 4.0)
+ when a sum it float))
+(= 10.0 (loop for a in '(nil 1.0 nil 2.0 nil 3.0 nil 4.0)
+ when a sum it of-type float))
+(= 10 (loop for a in '(nil 1 nil 2 nil 3 nil 4)
+ when a sum it of-type number))
+(= 10 (loop for a in '(nil 1 nil 2 nil 3 nil 4)
+ when a sum it of-type (integer 0)))
+
+(= 10 (loop for a in '(nil 1 nil 2 nil 3 nil 4)
+ when a sum a fixnum))
+(= 10 (loop for a in '(nil 1 nil 2 nil 3 nil 4)
+ when a sum a of-type fixnum))
+(= 10.0 (loop for a in '(nil 1.0 nil 2.0 nil 3.0 nil 4.0)
+ when a sum a float))
+(= 10.0 (loop for a in '(nil 1.0 nil 2.0 nil 3.0 nil 4.0)
+ when a sum a of-type float))
+(= 10 (loop for a in '(nil 1 nil 2 nil 3 nil 4)
+ when a sum a of-type number))
+(= 10 (loop for a in '(nil 1 nil 2 nil 3 nil 4)
+ when a sum a of-type (integer 0)))
+
+(= 10 (loop for a in '(nil 1 nil 2 nil 3 nil 4)
+ when a sum a into sum fixnum finally (return sum)))
+(= 10 (loop for a in '(nil 1 nil 2 nil 3 nil 4)
+ when a sum a into sum of-type fixnum finally (return sum)))
+(= 10.0 (loop for a in '(nil 1.0 nil 2.0 nil 3.0 nil 4.0)
+ when a sum a into sum float finally (return sum)))
+(= 10.0 (loop for a in '(nil 1.0 nil 2.0 nil 3.0 nil 4.0)
+ when a sum a into sum of-type float finally (return sum)))
+(= 10 (loop for a in '(nil 1 nil 2 nil 3 nil 4)
+ when a sum a into sum of-type number finally (return sum)))
+(= 10 (loop for a in '(nil 1 nil 2 nil 3 nil 4)
+ when a sum a into sum of-type (integer 0) finally (return sum)))
+
+(= 7 (loop for a in '(nil a nil b nil c nil d e nil f g nil nil nil nil)
+ counting a fixnum))
+(= 7 (loop for a in '(nil a nil b nil c nil d e nil f g nil nil nil nil)
+ counting a of-type fixnum))
+(= 7 (loop for a in '(nil a nil b nil c nil d e nil f g nil nil nil nil)
+ counting a of-type integer))
+(= 7 (loop for a in '(nil a nil b nil c nil d e nil f g nil nil nil nil)
+ counting a of-type (integer 0)))
+(= 7 (loop for a in '(nil a nil b nil c nil d e nil f g nil nil nil nil)
+ counting a of-type number))
+
+(= 7 (loop for a in '(nil a nil b nil c nil d e nil f g nil nil nil nil)
+ counting a into x fixnum finally (return x)))
+(= 7 (loop for a in '(nil a nil b nil c nil d e nil f g nil nil nil nil)
+ counting a into x of-type fixnum finally (return x)))
+(= 7 (loop for a in '(nil a nil b nil c nil d e nil f g nil nil nil nil)
+ counting a into x of-type integer finally (return x)))
+(= 7 (loop for a in '(nil a nil b nil c nil d e nil f g nil nil nil nil)
+ counting a into x of-type (integer 0) finally (return x)))
+(= 7 (loop for a in '(nil a nil b nil c nil d e nil f g nil nil nil nil)
+ counting a into x of-type number finally (return x)))
+
+(= 99 (loop for a in '(3 5 8 0 7 7 99 3) maximize a fixnum))
+(= 99 (loop for a in '(3 5 8 0 7 7 99 3) maximize a of-type fixnum))
+(= 99.0 (loop for a in '(3.0 5.0 8.0 0.0 7.0 7.0 99.0 3.0)
+ maximize a float))
+(= 99.0 (loop for a in '(3.0 5.0 8.0 0.0 7.0 7.0 99.0 3.0)
+ maximize a of-type float))
+(= 99.0 (loop for a in '(3.0 5.0 2.2 8.0 0 3/5 7.0 7 99 3.0)
+ maximize a of-type real))
+(= 99 (loop for a in '(3 5 8 0 7 7 99 3) maximize a of-type (integer 0)))
+
+
+(= 99 (loop for a in '(3 5 8 0 7 7 99 3) maximize a into max fixnum
+ finally (return max)))
+(= 99 (loop for a in '(3 5 8 0 7 7 99 3) maximize a into max of-type fixnum
+ finally (return max)))
+(= 99.0 (loop for a in '(3.0 5.0 8.0 0.0 7.0 7.0 99.0 3.0)
+ maximize a into max float finally (return max)))
+(= 99.0 (loop for a in '(3.0 5.0 8.0 0.0 7.0 7.0 99.0 3.0)
+ maximize a into max of-type float finally (return max)))
+(= 99.0 (loop for a in '(3.0 5.0 2.2 8.0 0 3/5 7.0 7 99 3.0)
+ maximize a into max of-type real finally (return max)))
+(= 99 (loop for a in '(3 5 8 0 7 7 99 3)
+ maximize a into max of-type (integer 0)
+ finally (return max)))
+
+(= 99 (loop for a in '(3 nil 5 8 nil 0 nil 7 7 99 3) when a maximize it fixnum))
+(= 99 (loop for a in '(nil 3 nil 5 nil 8 0 7 7 nil 99 nil 3)
+ when a maximize it of-type fixnum))
+(= 99.0 (loop for a in '(3.0 nil 5.0 8.0 0.0 nil nil nil nil 7.0 nil 7.0 99.0
+ nil 3.0 nil nil nil)
+ when a maximize it float))
+(= 99.0 (loop for a in '(nil nil nil nil nil 3.0 nil 5.0 8.0 0.0
+ nil nil nil 7.0 7.0 nil nil 99.0 3.0)
+ when a maximize it of-type float))
+(= 99.0 (loop for a in '(3.0 5.0 nil nil 2.2 nil nil 8.0 0
+ nil nil 3/5 nil nil 7.0 7 99 3.0)
+ when a maximize it of-type real))
+(= 99 (loop for a in '(3 nil nil 5 8 0 nil nil 7 7 99 nil nil 3)
+ when a maximize a of-type (integer 0)))
+
+(= 99 (loop for a in '(3 nil 5 8 nil 0 nil 7 7 99 3)
+ when a maximize it into max fixnum
+ finally (return max)))
+(= 99 (loop for a in '(nil 3 nil 5 nil 8 0 7 7 nil 99 nil 3)
+ when a maximize it into max of-type fixnum finally (return max)))
+(= 99.0 (loop for a in '(3.0 nil 5.0 8.0 0.0 nil nil nil nil 7.0 nil 7.0 99.0
+ nil 3.0 nil nil nil)
+ when a maximize it into max float finally (return max)))
+(= 99.0 (loop for a in '(nil nil nil nil nil 3.0 nil 5.0 8.0 0.0
+ nil nil nil 7.0 7.0 nil nil 99.0 3.0)
+ when a maximize it into max of-type float finally (return max)))
+(= 99.0 (loop for a in '(3.0 5.0 nil nil 2.2 nil nil 8.0 0
+ nil nil 3/5 nil nil 7.0 7 99 3.0)
+ when a maximize it into max of-type real finally (return max)))
+(= 99 (loop for a in '(3 nil nil 5 8 0 nil nil 7 7 99 nil nil 3)
+ when a maximize it into max of-type (integer 0)
+ finally (return max)))
+
+
+
+(= 99 (loop for a in '(3 5 8 0 7 7 99 3) maximizing a fixnum))
+(= 99 (loop for a in '(3 5 8 0 7 7 99 3) maximizing a of-type fixnum))
+(= 99.0 (loop for a in '(3.0 5.0 8.0 0.0 7.0 7.0 99.0 3.0)
+ maximizing a float))
+(= 99.0 (loop for a in '(3.0 5.0 8.0 0.0 7.0 7.0 99.0 3.0)
+ maximizing a of-type float))
+(= 99.0 (loop for a in '(3.0 5.0 2.2 8.0 0 3/5 7.0 7 99 3.0)
+ maximizing a of-type real))
+(= 99 (loop for a in '(3 5 8 0 7 7 99 3) maximizing a of-type (integer 0)))
+
+
+(= 99 (loop for a in '(3 5 8 0 7 7 99 3) maximizing a into max fixnum
+ finally (return max)))
+(= 99 (loop for a in '(3 5 8 0 7 7 99 3) maximizing a into max of-type fixnum
+ finally (return max)))
+(= 99.0 (loop for a in '(3.0 5.0 8.0 0.0 7.0 7.0 99.0 3.0)
+ maximizing a into max float finally (return max)))
+(= 99.0 (loop for a in '(3.0 5.0 8.0 0.0 7.0 7.0 99.0 3.0)
+ maximizing a into max of-type float finally (return max)))
+(= 99.0 (loop for a in '(3.0 5.0 2.2 8.0 0 3/5 7.0 7 99 3.0)
+ maximizing a into max of-type real finally (return max)))
+(= 99 (loop for a in '(3 5 8 0 7 7 99 3)
+ maximizing a into max of-type (integer 0)
+ finally (return max)))
+
+(= 99 (loop for a in '(3 nil 5 8 nil 0 nil 7 7 99 3) when a maximizing it fixnum))
+(= 99 (loop for a in '(nil 3 nil 5 nil 8 0 7 7 nil 99 nil 3)
+ when a maximizing it of-type fixnum))
+(= 99.0 (loop for a in '(3.0 nil 5.0 8.0 0.0 nil nil nil nil 7.0 nil 7.0 99.0
+ nil 3.0 nil nil nil)
+ when a maximizing it float))
+(= 99.0 (loop for a in '(nil nil nil nil nil 3.0 nil 5.0 8.0 0.0
+ nil nil nil 7.0 7.0 nil nil 99.0 3.0)
+ when a maximizing it of-type float))
+(= 99.0 (loop for a in '(3.0 5.0 nil nil 2.2 nil nil 8.0 0
+ nil nil 3/5 nil nil 7.0 7 99 3.0)
+ when a maximizing it of-type real))
+(= 99 (loop for a in '(3 nil nil 5 8 0 nil nil 7 7 99 nil nil 3)
+ when a maximizing a of-type (integer 0)))
+
+(= 99 (loop for a in '(3 nil 5 8 nil 0 nil 7 7 99 3)
+ when a maximizing it into max fixnum
+ finally (return max)))
+(= 99 (loop for a in '(nil 3 nil 5 nil 8 0 7 7 nil 99 nil 3)
+ when a maximizing it into max of-type fixnum finally (return max)))
+(= 99.0 (loop for a in '(3.0 nil 5.0 8.0 0.0 nil nil nil nil 7.0 nil 7.0 99.0
+ nil 3.0 nil nil nil)
+ when a maximizing it into max float finally (return max)))
+(= 99.0 (loop for a in '(nil nil nil nil nil 3.0 nil 5.0 8.0 0.0
+ nil nil nil 7.0 7.0 nil nil 99.0 3.0)
+ when a maximizing it into max of-type float finally (return max)))
+(= 99.0 (loop for a in '(3.0 5.0 nil nil 2.2 nil nil 8.0 0
+ nil nil 3/5 nil nil 7.0 7 99 3.0)
+ when a maximizing it into max of-type real finally (return max)))
+(= 99 (loop for a in '(3 nil nil 5 8 0 nil nil 7 7 99 nil nil 3)
+ when a maximizing it into max of-type (integer 0)
+ finally (return max)))
+
+
+(= 3 (loop for a in '(3 5 8 4 7 7 99 3) minimize a fixnum))
+(= 3 (loop for a in '(3 5 8 4 7 7 99 3) minimize a of-type fixnum))
+(= 3.0 (loop for a in '(5.0 8.0 7.0 3.0 7.0 99.0) minimize a float))
+(= 3.0 (loop for a in '(5.0 8.0 7.0 3.0 7.0 99.0) minimize a of-type float))
+(= 3.0 (loop for a in '(5.0 8 7 3 7.0 3.0 99.0 1000) minimize a of-type real))
+(= 5 (loop for a in '(6 5 8 7 7 99) minimize a of-type (integer 0)))
+
+(= 3 (loop for a in '(5 8 4 7 7 99 3) minimize a into min fixnum
+ finally (return min)))
+(= 3 (loop for a in '(5 8 4 7 7 99 3) minimize a into min of-type fixnum
+ finally (return min)))
+(= 3.0 (loop for a in '(5.0 8.0 4.0 7.0 7.0 99.0 3.0) minimize a into min float
+ finally (return min)))
+(= 3.0 (loop for a in '(5.0 8.0 4.0 7.0 7.0 99.0 3.0)
+ minimize a into min of-type float finally (return min)))
+(= 3.0 (loop for a in '(5.0 8 4.0 31/3 7.0 7 99.0 3.0)
+ minimize a into min of-type real finally (return min)))
+(= 5 (loop for a in '(6 5 8 7 7 99) minimize a into min of-type (integer 0)
+ finally (return min)))
+
+(= 3 (loop for a in '(nil 5 8 nil nil 7 7 nil 99 3) when a minimize it fixnum))
+(= 3 (loop for a in '(nil 5 8 nil nil 7 7 nil 99 3)
+ when a minimize it of-type fixnum))
+(= 3.0 (loop for a in '(nil 5.0 8.0 nil nil 7.0 7.0 nil 99.0 3.0)
+ when a minimize it float))
+(= 3.0 (loop for a in '(nil 5.0 8.0 nil nil 7.0 7.0 nil 99.0 3.0)
+ when a minimize it of-type float))
+(= 3 (loop for a in '(nil 5.0 8.0 nil nil 7.0 7.0 nil 99.0 3.0)
+ when a minimize it of-type real))
+(= 3 (loop for a in '(nil 5 8 nil nil 7 7 nil 99 3)
+ when a minimize it of-type (integer 0)))
+(= -99 (loop for a in '(nil -5 8 nil nil 7 7 nil -99 3)
+ when a minimize it of-type (integer)))
+
+
+(= 3 (loop for a in '(3 5 8 4 7 7 99 3) minimizing a fixnum))
+(= 3 (loop for a in '(3 5 8 4 7 7 99 3) minimizing a of-type fixnum))
+(= 3.0 (loop for a in '(5.0 8.0 7.0 3.0 7.0 99.0) minimizing a float))
+(= 3.0 (loop for a in '(5.0 8.0 7.0 3.0 7.0 99.0) minimizing a of-type float))
+(= 3.0 (loop for a in '(5.0 8 7 3 7.0 3.0 99.0 1000) minimizing a of-type real))
+(= 5 (loop for a in '(6 5 8 7 7 99) minimizing a of-type (integer 0)))
+
+(= 3 (loop for a in '(5 8 4 7 7 99 3) minimizing a into min fixnum
+ finally (return min)))
+(= 3 (loop for a in '(5 8 4 7 7 99 3) minimizing a into min of-type fixnum
+ finally (return min)))
+(= 3.0 (loop for a in '(5.0 8.0 4.0 7.0 7.0 99.0 3.0) minimizing a into min float
+ finally (return min)))
+(= 3.0 (loop for a in '(5.0 8.0 4.0 7.0 7.0 99.0 3.0)
+ minimizing a into min of-type float finally (return min)))
+(= 3.0 (loop for a in '(5.0 8 4.0 31/3 7.0 7 99.0 3.0)
+ minimizing a into min of-type real finally (return min)))
+(= 5 (loop for a in '(6 5 8 7 7 99) minimizing a into min of-type (integer 0)
+ finally (return min)))
+
+(= 3 (loop for a in '(nil 5 8 nil nil 7 7 nil 99 3) when a minimizing it fixnum))
+(= 3 (loop for a in '(nil 5 8 nil nil 7 7 nil 99 3)
+ when a minimizing it of-type fixnum))
+(= 3.0 (loop for a in '(nil 5.0 8.0 nil nil 7.0 7.0 nil 99.0 3.0)
+ when a minimizing it float))
+(= 3.0 (loop for a in '(nil 5.0 8.0 nil nil 7.0 7.0 nil 99.0 3.0)
+ when a minimizing it of-type float))
+(= 3 (loop for a in '(nil 5.0 8.0 nil nil 7.0 7.0 nil 99.0 3.0)
+ when a minimizing it of-type real))
+(= 3 (loop for a in '(nil 5 8 nil nil 7 7 nil 99 3)
+ when a minimizing it of-type (integer 0)))
+(= -99 (loop for a in '(nil -5 8 nil nil 7 7 nil -99 3)
+ when a minimizing it of-type (integer)))
+(eq 'ok (loop for i from 0 upto 10 summing i finally (return 'ok)))
+(eq 'ok (loop for i in '(nil nil 3 nil 5 nil 6)
+ counting i finally (return 'ok)))
+(eq 'ok (loop for i in '(nil nil 3 nil 5 nil 6)
+ when i maximizing it finally (return 'ok)))
+(eq 'ok (loop for i in '(nil nil 3 nil 5 nil 6)
+ when i minimizing it finally (return 'ok)))
+
+
+
+
+;; termination-test-clauses
+(null (loop with x = '(a b c d) while x do (pop x)))
+(equal (loop with stack = nil and x = '(0 1 2 3)
+ while x do (push (pop x) stack) finally (return stack))
+ '(3 2 1 0))
+(equal (loop with stack = nil and x = '(0 1 2 3)
+ until (null x) do (push (pop x) stack) finally (return stack))
+ '(3 2 1 0))
+(equal (let ((stack '(a b c d e f)))
+ (loop for item = (length stack) then (pop stack)
+ collect item
+ while stack))
+ '(6 A B C D E F))
+(equal (loop for i fixnum from 3
+ when (oddp i) collect i
+ while (< i 5))
+ '(3 5))
+(equal (loop for a below 10
+ when (and (evenp a) a) collect it
+ while (< a 6)
+ collect a)
+ '(0 0 1 2 2 3 4 4 5 6))
+(equal (loop for a below 10
+ when (and (evenp a) a) collect it
+ until (>= a 6)
+ collect a)
+ '(0 0 1 2 2 3 4 4 5 6))
+(equal (loop for a below 10
+ when (and (evenp a) a) collect it
+ while (< a 6)
+ collect a
+ until (>= a 4)
+ collect a)
+ '(0 0 0 1 1 2 2 2 3 3 4 4))
+
+;; repeat
+(= 3 (loop with x = 0 repeat 3 do (incf x) finally (return x)))
+(= 1000 (loop repeat 1000 counting 1))
+(null (loop repeat 3))
+(null (loop repeat 0))
+(let ((body-flag nil))
+ (and (null (loop repeat 0 do (setq body-flag t))) (null body-flag)))
+(= 1 (let ((x 0)) (loop repeat (incf x) sum x)))
+(= 4 (let ((x 1)) (loop repeat (incf x) sum x)))
+(= 9 (let ((x 2)) (loop repeat (incf x) sum x)))
+(= 16 (let ((x 3)) (loop repeat (incf x) sum x)))
+(null (loop repeat -15 return t))
+(let ((body-flag nil))
+ (and (null (loop repeat -10 do (setq body-flag t))) (null body-flag)))
+(let ((eval-count 0)
+ (loop-count 0))
+ (loop repeat (progn (incf eval-count) 2) do (incf loop-count))
+ (and (= 1 eval-count)
+ (= 2 loop-count)))
+(let ((eval-count 0)
+ (loop-count 0))
+ (loop repeat (progn (incf eval-count) 0) do (incf loop-count))
+ (and (= 1 eval-count)
+ (zerop loop-count)))
+(let ((eval-count 0)
+ (loop-count 0))
+ (loop repeat (progn (incf eval-count) -100) do (incf loop-count))
+ (and (= 1 eval-count)
+ (zerop loop-count)))
+
+;; always
+(eq t (loop for i from 0 to 10 always (< i 11)))
+(eq t (loop for a in '() always (oddp a)))
+(null (loop for a in '(0 1 2) always (oddp a)))
+(eq t (loop for a in '(1 3 5) always (oddp a)))
+(let ((flag nil))
+ (and (null (loop for i from 0 to 10 always (< i 5)
+ finally (setq flag t) (return t)))
+ (not flag)))
+(eq 'ok (loop for i below 3 always (numberp i) finally (return 'ok)))
+(eq t (loop repeat 3 always t))
+(handler-case (macroexpand '(loop for i from 0 upto 10
+ always (integerp i)
+ collect i))
+ (program-error () t)
+ (error () nil)
+ (:no-error (&rest rest) (declare (ignore rest)) nil))
+
+;; never
+(eq t (loop for i from 0 to 10 never (> i 11)))
+(eq t (loop for a in '() never (oddp a)))
+(null (loop for a in '(0 1 2) never (oddp a)))
+(eq t (loop for a in '(1 3 5) never (evenp a)))
+(null (loop never t finally (return t)))
+(let ((flag nil))
+ (and (null (loop for a below 3 never (oddp a)
+ finally (setq flag t) (return t)))
+ (null flag)))
+(eq 'ok (loop for i below 3 never (consp i) finally (return 'ok)))
+(eq t (loop repeat 3 never nil))
+(handler-case (macroexpand '(loop for i from 0 upto 10
+ never (integerp i)
+ append (list i)))
+ (program-error () t)
+ (error () nil)
+ (:no-error (&rest rest) (declare (ignore rest)) nil))
+
+;; thereis
+(null (loop for a in '(0 2 4) thereis (oddp a)))
+(= 11 (loop for i from 0 thereis (when (> i 10) i)))
+(eq (loop thereis 'someone) 'someone)
+(eq (loop for i from 1 to 10
+ thereis (> i 11)
+ finally (return 'got-here))
+ 'got-here)
+(let ((count 0))
+ (and (null (loop for a below 10 for b in '(nil nil nil nil c)
+ always (< a 8)
+ never b
+ do (incf count)))
+ (= count 4)))
+(eq (loop for a in '(nil nil nil found-it! nil nil)
+ for b from 10 downto 0
+ never (< b 0)
+ thereis a) 'found-it!)
+(= 4 (loop for i in '(1 2 3 4 5 6)
+ thereis (and (> i 3) i)))
+(let ((flag nil))
+ (loop for a below 3
+ thereis (and (oddp a) a)
+ finally (setq flag t))
+ (null flag))
+(eq 'ok (loop for i below 3 thereis (consp i) finally (return 'ok)))
+(null (loop repeat 3 thereis nil))
+(handler-case (macroexpand '(loop for i from 0 upto 10
+ thereis (integerp i)
+ nconc (list i)))
+ (program-error () t)
+ (error () nil)
+ (:no-error (&rest rest) (declare (ignore rest)) nil))
+
+
+
+;; name-clause
+(loop named bar do (return-from bar t))
+(eq t (loop named outer do (loop named inner do (return-from outer t))))
+
+
+
+
+
+
+;; destructuring
+(equal (loop for (a b c) of-type (integer integer float) in
+ '((1 2 4.0) (5 6 8.3) (8 9 10.4))
+ collect (list c b a))
+ '((4.0 2 1) (8.3 6 5) (10.4 9 8)))
+
+(equal (loop for (a b c) of-type float in
+ '((1.0 2.0 4.0) (5.0 6.0 8.3) (8.0 9.0 10.4))
+ collect (list c b a))
+ '((4.0 2.0 1.0) (8.3 6.0 5.0) (10.4 9.0 8.0)))
+
+(equal (loop with (a b) of-type float = '(1.0 2.0)
+ and (c d) of-type integer = '(3 4)
+ and (e f)
+ return (list a b c d e f))
+ '(1.0 2.0 3 4 NIL NIL))
+(equal (let (stack)
+ (loop for (a (b) ((c))) in '((0 (1) ((2))) (3 (4) ((5))) (6 (7) ((8))))
+ do (push (list a b c) stack))
+ stack)
+ '((6 7 8) (3 4 5) (0 1 2)))
+(equal (let (stack)
+ (loop for (a nil ((b))) in '((0 (1) ((2))) (3 (4) ((5))) (6 (7) ((8))))
+ do (push (list a b) stack))
+ stack)
+ '((6 8) (3 5) (0 2)))
+(equal (let (stack)
+ (loop for (a nil ((((b))))) in
+ '((0 (1) ((((2))))) (3 (4) ((((5))))) (6 (7) ((((8))))))
+ do (push (list a b) stack))
+ stack)
+ '((6 8) (3 5) (0 2)))
+(equal (let (stack)
+ (loop for (a . b) in '((0 . 1) (2 . 3)) do (push (cons a b) stack))
+ stack)
+ '((2 . 3) (0 . 1)))
+(equal (let (stack)
+ (loop for (a . (b)) in '((0 1) (2 3)) do (push (list a b) stack))
+ stack)
+ '((2 3) (0 1)))
+(equal (let (stack)
+ (loop for (a) on '(0 1 2 3) do (push a stack)) stack)
+ '(3 2 1 0))
+(equal (let (stack)
+ (loop for (a . b) on '(0 1 2 3 4) do (push (list a b) stack))
+ stack)
+ '((4 nil) (3 (4)) (2 (3 4)) (1 (2 3 4)) (0 (1 2 3 4))))
+(equal (let (stack) (loop for (a b) across #((0 1) (2 3) (4 5))
+ do (push (list a b) stack))
+ stack)
+ '((4 5) (2 3) (0 1)))
+(equal (let (stack) (loop for (a ((b))) across #((0 ((1))) (2 ((3))) (4 ((5))))
+ do (push (list a b) stack))
+ stack)
+ '((4 5) (2 3) (0 1)))
+(equal (loop with (a b) = '(0 1) return (list a b)) '(0 1))
+(equal (loop with (a b c) = '(0) return (list a b c)) '(0 nil nil))
+(= 2 (loop with (nil nil x) = '(0 1 2) return x))
+(equal (loop for (a b c) in '((0) (1) (2))
+ collect (list a b c))
+ '((0 nil nil) (1 nil nil) (2 nil nil)))
+(equal (loop for (a nil b) in '((0 1 2) (1 2 3) (2 3 4))
+ collect (list a b))
+ '((0 2) (1 3) (2 4)))
+
+(equal (loop for (a . b) t in '((0 . x) (1 . y) (2 . z)) collecting (cons a b))
+ '((0 . x) (1 . y) (2 . z)))
+(equal (loop for (a . b) of-type t in '((0 . x) (1 . y) (2 . z))
+ collecting (cons a b))
+ '((0 . x) (1 . y) (2 . z)))
+(equal (loop for (a . b) of-type (fixnum . symbol) in '((0 . x) (1 . y) (2 . z))
+ collecting (cons a b))
+ '((0 . x) (1 . y) (2 . z)))
+(equal (loop for (a ((b))) of-type (fixnum ((symbol))) in
+ '((0 ((x))) (1 ((y))) (2 ((z))))
+ collecting (cons a b))
+ '((0 . x) (1 . y) (2 . z)))
+(equal (loop for (a ((b))) of-type (fixnum symbol) in
+ '((0 ((x))) (1 ((y))) (2 ((z))))
+ collecting (cons a b))
+ '((0 . x) (1 . y) (2 . z)))
+(equal (loop for (a ((b))) fixnum in '((0 ((10))) (1 ((11))) (2 ((12))))
+ collecting (cons a b))
+ '((0 . 10) (1 . 11) (2 . 12)))
+(equal (loop for (a ((b)) c (((d)))) fixnum in
+ '((0 ((10)) 20 (((30))))
+ (1 ((11)) 21 (((31))))
+ (2 ((12)) 22 (((32)))))
+ collecting (list a b c d))
+ '((0 10 20 30) (1 11 21 31) (2 12 22 32)))
+(equal (loop for (a ((b)) c (((d))))
+ of-type (fixnum ((fixnum)) fixnum (((fixnum)))) in
+ '((0 ((10)) 20 (((30))))
+ (1 ((11)) 21 (((31))))
+ (2 ((12)) 22 (((32)))))
+ collecting (list a b c d))
+ '((0 10 20 30) (1 11 21 31) (2 12 22 32)))
+(equal (loop for (a nil nil (((b)))) of-type (fixnum nil nil (((fixnum)))) in
+ '((0 ((10)) 20 (((30))))
+ (1 ((11)) 21 (((31))))
+ (2 ((12)) 22 (((32)))))
+ collecting (list a b))
+ '((0 30) (1 31) (2 32)))
+
+(equal (loop for (a) fixnum on '(0 1 2) collecting a) '(0 1 2))
+(equal (loop for (a) of-type fixnum on '(0 1 2) collecting a) '(0 1 2))
+(equal (loop for (a) float on '(0.3 1.3 2.3) collecting a) '(0.3 1.3 2.3))
+(equal (loop for (a) of-type float on '(0.3 1.3 2.3) collecting a)
+ '(0.3 1.3 2.3))
+(equal (loop for (a) t on '(0 1 2) collecting a) '(0 1 2))
+(equal (loop for (a) of-type t on '(0 1 2) collecting a) '(0 1 2))
+(equal (loop for (a) of-type real on '(0 1.0 2/3) collecting a) '(0 1.0 2/3))
+(equal (loop for (a nil b) fixnum on '(0 1 2) collecting (list a b))
+ '((0 2) (1 nil) (2 nil)))
+(equal (loop for (a nil b) of-type (fixnum nil fixnum) on '(0 1 2)
+ collecting (list a b))
+ '((0 2) (1 nil) (2 nil)))
+(equal (loop for (nil . tail) t on '(0 1 2 3) append tail)
+ '(1 2 3 2 3 3))
+(equal (loop for (nil . tail) of-type t on '(0 1 2 3) append tail)
+ '(1 2 3 2 3 3))
+(equal (loop for (nil . tail) of-type list on '(0 1 2 3) append tail)
+ '(1 2 3 2 3 3))
+
+(equal (loop for (a b) t across #((x 0) (y 1) (z 2)) collecting (list b a))
+ '((0 x) (1 y) (2 z)))
+(equal (loop for (a b) of-type t across #((x 0) (y 1) (z 2))
+ collecting (list b a))
+ '((0 x) (1 y) (2 z)))
+(equal (loop for (a b) of-type ((member x y z) (member 0 1 2))
+ across #((x 0) (y 1) (z 2))
+ collecting (list b a))
+ '((0 x) (1 y) (2 z)))
+
+
+(eq t (loop for (a) t := '(0) then (list (1+ a))
+ when (= a 3) return t))
+(eq t (loop for (a) of-type t := '(0) then (list (1+ a))
+ when (= a 3) return t))
+(eq t (loop for (a) of-type (t) := '(0) then (list (1+ a))
+ when (= a 3) return t))
+(eq t (loop for (a) fixnum := '(0) then (list (1+ a))
+ when (= a 3) return t))
+(eq t (loop for (a) of-type fixnum := '(0) then (list (1+ a))
+ when (= a 3) return t))
+(eq t (loop for (a) of-type (fixnum) := '(0) then (list (1+ a))
+ when (= a 3) return t))
+(eq t (loop for (a) float := '(0.0) then (list (1+ a))
+ when (= a 3.0) return t))
+(eq t (loop for (a) of-type float := '(0.0) then (list (1+ a))
+ when (= a 3.0) return t))
+(eq t (loop for (a) of-type (float) := '(0.0) then (list (1+ a))
+ when (= a 3.0) return t))
+(equal (loop for (a b) t := '(0 1) then (list (1+ b) (+ b 2))
+ when (> a 5) do (loop-finish)
+ collect (list a b))
+ '((0 1) (2 3) (4 5)))
+(equal (loop for (a b) of-type t := '(0 1) then (list (1+ b) (+ b 2))
+ when (> a 5) do (loop-finish)
+ collect (list a b))
+ '((0 1) (2 3) (4 5)))
+(equal (loop for (a b) of-type (t t) := '(0 1) then (list (1+ b) (+ b 2))
+ when (> a 5) do (loop-finish)
+ collect (list a b))
+ '((0 1) (2 3) (4 5)))
+(equal (loop for (a b) fixnum := '(0 1) then (list (1+ b) (+ b 2))
+ when (> a 5) do (loop-finish)
+ collect (list a b))
+ '((0 1) (2 3) (4 5)))
+(equal (loop for (a b) of-type fixnum := '(0 1) then (list (1+ b) (+ b 2))
+ when (> a 5) do (loop-finish)
+ collect (list a b))
+ '((0 1) (2 3) (4 5)))
+(equal (loop for (a b) of-type (fixnum fixnum) := '(0 1)
+ then (list (1+ b) (+ b 2))
+ when (> a 5) do (loop-finish)
+ collect (list a b))
+ '((0 1) (2 3) (4 5)))
+(equal (loop for (a b) float := '(0.0 1.0) then (list (1+ b) (+ b 2.0))
+ when (> a 5) do (loop-finish)
+ collect (list a b))
+ '((0.0 1.0) (2.0 3.0) (4.0 5.0)))
+(equal (loop for (a b) of-type float := '(0.0 1.0) then (list (1+ b) (+ b 2.0))
+ when (> a 5) do (loop-finish)
+ collect (list a b))
+ '((0.0 1.0) (2.0 3.0) (4.0 5.0)))
+(equal (loop for (a b) of-type (float float) := '(0.0 1.0)
+ then (list (1+ b) (+ b 2.0))
+ when (> a 5) do (loop-finish)
+ collect (list a b))
+ '((0.0 1.0) (2.0 3.0) (4.0 5.0)))
+(equal (loop for (a b) of-type (fixnum float) := '(0 1.0)
+ then (list (+ a 2) (+ b 2.0))
+ when (> a 5) do (loop-finish)
+ collect (list a b))
+ '((0 1.0) (2 3.0) (4 5.0)))
+
+(let ((table (make-hash-table :test 'equal))
+ stack)
+ (mapc #'(lambda (k v) (setf (gethash k table) v))
+ '((k0 0) (k1 1) (k2 2)) '(v0 v1 v2))
+ (loop for (k kn) t being each hash-key of table do (push (list k kn) stack))
+ (null (set-exclusive-or stack '((k0 0) (k1 1) (k2 2)) :test #'equal)))
+(let ((table (make-hash-table :test 'equal))
+ stack)
+ (mapc #'(lambda (k v) (setf (gethash k table) v))
+ '((k0 0) (k1 1) (k2 2)) '(v0 v1 v2))
+ (loop for (k kn) of-type t being each hash-key of table
+ do (push (list k kn) stack))
+ (null (set-exclusive-or stack '((k0 0) (k1 1) (k2 2)) :test #'equal)))
+(let ((table (make-hash-table :test 'equal))
+ stack)
+ (mapc #'(lambda (k v) (setf (gethash k table) v))
+ '((k0 0) (k1 1) (k2 2)) '(v0 v1 v2))
+ (loop for (k kn) of-type (symbol fixnum) being each hash-key of table
+ do (push (list k kn) stack))
+ (null (set-exclusive-or stack '((k0 0) (k1 1) (k2 2)) :test #'equal)))
+(let ((table (make-hash-table :test 'equal))
+ stack)
+ (mapc #'(lambda (k v) (setf (gethash k table) v))
+ '((k0 0) (k1 1) (k2 2)) '(v0 v1 v2))
+ (loop for (k kn) of-type t being each hash-key of table
+ do (push (list k kn) stack))
+ (null (set-exclusive-or stack '((k0 0) (k1 1) (k2 2)) :test #'equal)))
+(let ((table (make-hash-table :test 'equal))
+ stack)
+ (mapc #'(lambda (k v) (setf (gethash k table) v))
+ '((k0 0) (k1 1) (k2 2)) '(v0 v1 v2))
+ (loop for (k kn) of-type (t t) being each hash-key of table
+ do (push (list k kn) stack))
+ (null (set-exclusive-or stack '((k0 0) (k1 1) (k2 2)) :test #'equal)))
+
+
+
+
+;; double binding
+(handler-case
+ (macroexpand '(loop with a = 0 for a downfrom 10 to 0 do (print a)))
+ (program-error () t)
+ (error () nil)
+ (:no-error (&rest rest)
+ (declare (ignore rest))
+ nil))
+(handler-case
+ (macroexpand '(loop for a from 0 upto 10 collect t into a))
+ (program-error () t)
+ (error () nil)
+ (:no-error (&rest rest)
+ (declare (ignore rest))
+ nil))
+
+
+
+
+;; misc
+(= 4 (loop for (item . x) of-type (t . fixnum) in '((A . 1) (B . 2) (C . 3))
+ unless (eq item 'B) sum x))
+(equal (loop for sublist on '(a b c d) collect sublist)
+ '((A B C D) (B C D) (C D) (D)))
+(equal (loop for (item) on '(1 2 3) collect item) '(1 2 3))
+(equal (loop for item = 1 then (+ item 10)
+ for iteration from 1 to 5
+ collect item)
+ '(1 11 21 31 41))
+(equal (loop for i below 3 collecting (loop for j below 2 collecting (list i j)))
+ '(((0 0) (0 1)) ((1 0) (1 1)) ((2 0) (2 1))))
+(zerop (loop for i from -10 upto 0 maximizing i))
+(equal (loop for i from -10 upto 0 maximizing i into max minimizing i into min
+ finally (return (list max min)))
+ '(0 -10))
+(equal (loop for c across "aBcDeFg" when (and (upper-case-p c) c) collecting it)
+ '(#\B #\D #\F))
+(equal (loop named my-loop for i below 3 collect i into x
+ finally (return-from my-loop x))
+ '(0 1 2))
+(equal (loop named nil for i below 3 collect i into x
+ finally (return-from nil x))
+ '(0 1 2))
+(equal (loop for i below 3 collect i into x
+ finally (return-from nil x))
+ '(0 1 2))
+(equal (loop for i below 3 collect i into x
+ finally (return x))
+ '(0 1 2))
+(equal (loop for a from 10 above 0
+ for b in '(1 2 3 4 5 6 7 8 9 10)
+ for c on '(j k l m n o p q r s)
+ for d = 100 then (1- d)
+ collect (list a b (first c) d))
+ '((10 1 j 100) (9 2 k 99) (8 3 l 98) (7 4 m 97) (6 5 n 96)
+ (5 6 o 95) (4 7 p 94) (3 8 q 93) (2 9 r 92) (1 10 s 91)))
+
+(equal (loop with e = 0
+ for a from 10 above 0
+ for b in '(1 2 3 4 5 6 7 8 9 10)
+ for c on '(j k l m n o p q r s)
+ for d = 100 then (1- d)
+ append (list a b (first c) d) into values
+ initially (setq e 1000)
+ repeat 1
+ finally (return (cons e values)))
+ '(1000 10 1 j 100))
+(equal (loop with e = 0
+ for a from 10 above 0
+ for b in '(1 2 3 4 5 6 7 8 9 10)
+ for c on '(j k l m n o p q r s)
+ for d = 100 then (1- d)
+ append (list a b (first c) d) into values
+ initially (setq e 1000)
+ repeat 2
+ finally (return (cons e values)))
+ '(1000 10 1 j 100 9 2 k 99))
+
+(equal (loop for a from 0 upto 100 by 2
+ repeat 1000
+ when (zerop (mod a 10)) collect a)
+ '(0 10 20 30 40 50 60 70 80 90 100))
+
+
+;; it
+(let ((it '0))
+ (equal (loop for a in '(nil x y nil z) when a collect it and collect it)
+ '(x 0 y 0 z 0)))
+
+(let ((it '0))
+ (equal (loop for a in '(x nil y nil z nil)
+ if a collect it end
+ collect it)
+ '(X 0 0 Y 0 0 Z 0 0)))
+
+
+
+;; for-as-package
+(subsetp '(cl:car cl:cdr cl:list)
+ (let (bag)
+ (loop for sym being the external-symbols of 'common-lisp
+ do (push sym bag))
+ bag))
+
+(progn
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (let ((pkg (make-package "TB-FOO" :use nil))
+ bag)
+ (and (null (loop for sym being the symbols of pkg do (push sym bag)))
+ (null bag))))
+(progn
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (let ((pkg (make-package "TB-FOO" :use nil))
+ bag)
+ (and (null (loop for sym being the external-symbols of pkg
+ do (push sym bag)))
+ (null bag))))
+(progn
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (let ((pkg (make-package "TB-FOO" :use nil))
+ bag)
+ (and (null (loop for sym being the present-symbols of pkg
+ do (push sym bag)))
+ (null bag))))
+
+
+(progn
+ (when (find-package "TB-BAR-TO-USE")
+ (mapcan #'delete-package (package-used-by-list "TB-BAR-TO-USE"))
+ (delete-package "TB-BAR-TO-USE"))
+ (make-package "TB-BAR-TO-USE")
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (let ((pkg (make-package "TB-FOO" :use '("TB-BAR-TO-USE")))
+ bag0 bag)
+ (mapc #'(lambda (name)
+ (push (intern name "TB-BAR-TO-USE") bag0)
+ (export (intern name "TB-BAR-TO-USE") "TB-BAR-TO-USE"))
+ '("J" "K" "L"))
+ (mapc #'(lambda (name) (push (intern name pkg) bag0)) '("A" "B" "C"))
+ (mapc #'(lambda (name)
+ (push (intern name pkg) bag0)
+ (export (intern name pkg) pkg)) '("X" "Y" "Z"))
+ (loop for sym being the symbols of pkg do (push sym bag))
+ (null (set-exclusive-or bag0 bag))))
+(progn
+ (when (find-package "TB-BAR-TO-USE")
+ (mapcan #'delete-package (package-used-by-list "TB-BAR-TO-USE"))
+ (delete-package "TB-BAR-TO-USE"))
+ (make-package "TB-BAR-TO-USE")
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (let ((pkg (make-package "TB-FOO" :use '("TB-BAR-TO-USE")))
+ bag0 bag)
+ (mapc #'(lambda (name)
+ (push (intern name "TB-BAR-TO-USE") bag0)
+ (export (intern name "TB-BAR-TO-USE") "TB-BAR-TO-USE"))
+ '("J" "K" "L"))
+ (mapc #'(lambda (name) (push (intern name pkg) bag0)) '("A" "B" "C"))
+ (mapc #'(lambda (name)
+ (push (intern name pkg) bag0)
+ (export (intern name pkg) pkg)) '("X" "Y" "Z"))
+ (loop for sym being each symbols of pkg do (push sym bag))
+ (null (set-exclusive-or bag0 bag))))
+
+
+(progn
+ (when (find-package "TB-BAR-TO-USE")
+ (mapcan #'delete-package (package-used-by-list "TB-BAR-TO-USE"))
+ (delete-package "TB-BAR-TO-USE"))
+ (make-package "TB-BAR-TO-USE")
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (let ((pkg (make-package "TB-FOO" :use '("TB-BAR-TO-USE")))
+ bag0 bag)
+ (mapc #'(lambda (name)
+ (push (intern name "TB-BAR-TO-USE") bag0)
+ (export (intern name "TB-BAR-TO-USE") "TB-BAR-TO-USE"))
+ '("J" "K" "L"))
+ (mapc #'(lambda (name) (push (intern name pkg) bag0)) '("A" "B" "C"))
+ (mapc #'(lambda (name)
+ (push (intern name pkg) bag0)
+ (export (intern name pkg) pkg)) '("X" "Y" "Z"))
+ (loop for sym being the symbol of pkg do (push sym bag))
+ (null (set-exclusive-or bag0 bag))))
+(progn
+ (when (find-package "TB-BAR-TO-USE")
+ (mapcan #'delete-package (package-used-by-list "TB-BAR-TO-USE"))
+ (delete-package "TB-BAR-TO-USE"))
+ (make-package "TB-BAR-TO-USE")
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (let ((pkg (make-package "TB-FOO" :use '("TB-BAR-TO-USE")))
+ bag0 bag)
+ (mapc #'(lambda (name)
+ (push (intern name "TB-BAR-TO-USE") bag0)
+ (export (intern name "TB-BAR-TO-USE") "TB-BAR-TO-USE"))
+ '("J" "K" "L"))
+ (mapc #'(lambda (name) (push (intern name pkg) bag0)) '("A" "B" "C"))
+ (mapc #'(lambda (name)
+ (push (intern name pkg) bag0)
+ (export (intern name pkg) pkg)) '("X" "Y" "Z"))
+ (loop for sym being each symbol of pkg do (push sym bag))
+ (null (set-exclusive-or bag0 bag))))
+
+
+(progn
+ (when (find-package "TB-BAR-TO-USE")
+ (mapcan #'delete-package (package-used-by-list "TB-BAR-TO-USE"))
+ (delete-package "TB-BAR-TO-USE"))
+ (make-package "TB-BAR-TO-USE")
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (let ((pkg (make-package "TB-FOO" :use '("TB-BAR-TO-USE")))
+ bag0 bag)
+ (mapc #'(lambda (name)
+ (push (intern name "TB-BAR-TO-USE") bag0)
+ (export (intern name "TB-BAR-TO-USE") "TB-BAR-TO-USE"))
+ '("J" "K" "L"))
+ (mapc #'(lambda (name) (push (intern name pkg) bag0)) '("A" "B" "C"))
+ (mapc #'(lambda (name)
+ (push (intern name pkg) bag0)
+ (export (intern name pkg) pkg)) '("X" "Y" "Z"))
+ (loop for sym being the symbols in pkg do (push sym bag))
+ (null (set-exclusive-or bag0 bag))))
+(progn
+ (when (find-package "TB-BAR-TO-USE")
+ (mapcan #'delete-package (package-used-by-list "TB-BAR-TO-USE"))
+ (delete-package "TB-BAR-TO-USE"))
+ (make-package "TB-BAR-TO-USE")
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (let ((pkg (make-package "TB-FOO" :use '("TB-BAR-TO-USE")))
+ bag0 bag)
+ (mapc #'(lambda (name)
+ (push (intern name "TB-BAR-TO-USE") bag0)
+ (export (intern name "TB-BAR-TO-USE") "TB-BAR-TO-USE"))
+ '("J" "K" "L"))
+ (mapc #'(lambda (name) (push (intern name pkg) bag0)) '("A" "B" "C"))
+ (mapc #'(lambda (name)
+ (push (intern name pkg) bag0)
+ (export (intern name pkg) pkg)) '("X" "Y" "Z"))
+ (loop for sym being each symbols in pkg do (push sym bag))
+ (null (set-exclusive-or bag0 bag))))
+
+
+(progn
+ (when (find-package "TB-BAR-TO-USE")
+ (mapcan #'delete-package (package-used-by-list "TB-BAR-TO-USE"))
+ (delete-package "TB-BAR-TO-USE"))
+ (make-package "TB-BAR-TO-USE")
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (let ((pkg (make-package "TB-FOO" :use '("TB-BAR-TO-USE")))
+ bag0 bag)
+ (mapc #'(lambda (name)
+ (push (intern name "TB-BAR-TO-USE") bag0)
+ (export (intern name "TB-BAR-TO-USE") "TB-BAR-TO-USE"))
+ '("J" "K" "L"))
+ (mapc #'(lambda (name) (push (intern name pkg) bag0)) '("A" "B" "C"))
+ (mapc #'(lambda (name)
+ (push (intern name pkg) bag0)
+ (export (intern name pkg) pkg)) '("X" "Y" "Z"))
+ (loop for sym being the symbol in pkg do (push sym bag))
+ (null (set-exclusive-or bag0 bag))))
+(progn
+ (when (find-package "TB-BAR-TO-USE")
+ (mapcan #'delete-package (package-used-by-list "TB-BAR-TO-USE"))
+ (delete-package "TB-BAR-TO-USE"))
+ (make-package "TB-BAR-TO-USE")
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (let ((pkg (make-package "TB-FOO" :use '("TB-BAR-TO-USE")))
+ bag0 bag)
+ (mapc #'(lambda (name)
+ (push (intern name "TB-BAR-TO-USE") bag0)
+ (export (intern name "TB-BAR-TO-USE") "TB-BAR-TO-USE"))
+ '("J" "K" "L"))
+ (mapc #'(lambda (name) (push (intern name pkg) bag0)) '("A" "B" "C"))
+ (mapc #'(lambda (name)
+ (push (intern name pkg) bag0)
+ (export (intern name pkg) pkg)) '("X" "Y" "Z"))
+ (loop for sym being each symbol in pkg do (push sym bag))
+ (null (set-exclusive-or bag0 bag))))
+
+
+
+(progn
+ (when (find-package "TB-BAR-TO-USE")
+ (mapcan #'delete-package (package-used-by-list "TB-BAR-TO-USE"))
+ (delete-package "TB-BAR-TO-USE"))
+ (make-package "TB-BAR-TO-USE")
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (let ((pkg (make-package "TB-FOO" :use '("TB-BAR-TO-USE")))
+ bag0 bag)
+ (mapc #'(lambda (name)
+ (export (intern name "TB-BAR-TO-USE") "TB-BAR-TO-USE"))
+ '("J" "K" "L"))
+ (mapc #'(lambda (name) (push (intern name pkg) bag0)) '("A" "B" "C"))
+ (mapc #'(lambda (name)
+ (push (intern name pkg) bag0)
+ (export (intern name pkg) pkg)) '("X" "Y" "Z"))
+ (loop for sym being the present-symbols of pkg do (push sym bag))
+ (null (set-exclusive-or bag0 bag))))
+(progn
+ (when (find-package "TB-BAR-TO-USE")
+ (mapcan #'delete-package (package-used-by-list "TB-BAR-TO-USE"))
+ (delete-package "TB-BAR-TO-USE"))
+ (make-package "TB-BAR-TO-USE")
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (let ((pkg (make-package "TB-FOO" :use '("TB-BAR-TO-USE")))
+ bag0 bag)
+ (mapc #'(lambda (name)
+ (export (intern name "TB-BAR-TO-USE") "TB-BAR-TO-USE"))
+ '("J" "K" "L"))
+ (mapc #'(lambda (name) (push (intern name pkg) bag0)) '("A" "B" "C"))
+ (mapc #'(lambda (name)
+ (push (intern name pkg) bag0)
+ (export (intern name pkg) pkg)) '("X" "Y" "Z"))
+ (loop for sym being each present-symbols of pkg do (push sym bag))
+ (null (set-exclusive-or bag0 bag))))
+
+
+(progn
+ (when (find-package "TB-BAR-TO-USE")
+ (mapcan #'delete-package (package-used-by-list "TB-BAR-TO-USE"))
+ (delete-package "TB-BAR-TO-USE"))
+ (make-package "TB-BAR-TO-USE")
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (let ((pkg (make-package "TB-FOO" :use '("TB-BAR-TO-USE")))
+ bag0 bag)
+ (mapc #'(lambda (name)
+ (export (intern name "TB-BAR-TO-USE") "TB-BAR-TO-USE"))
+ '("J" "K" "L"))
+ (mapc #'(lambda (name) (push (intern name pkg) bag0)) '("A" "B" "C"))
+ (mapc #'(lambda (name)
+ (push (intern name pkg) bag0)
+ (export (intern name pkg) pkg)) '("X" "Y" "Z"))
+ (loop for sym being the present-symbol of pkg do (push sym bag))
+ (null (set-exclusive-or bag0 bag))))
+(progn
+ (when (find-package "TB-BAR-TO-USE")
+ (mapcan #'delete-package (package-used-by-list "TB-BAR-TO-USE"))
+ (delete-package "TB-BAR-TO-USE"))
+ (make-package "TB-BAR-TO-USE")
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (let ((pkg (make-package "TB-FOO" :use '("TB-BAR-TO-USE")))
+ bag0 bag)
+ (mapc #'(lambda (name)
+ (export (intern name "TB-BAR-TO-USE") "TB-BAR-TO-USE"))
+ '("J" "K" "L"))
+ (mapc #'(lambda (name) (push (intern name pkg) bag0)) '("A" "B" "C"))
+ (mapc #'(lambda (name)
+ (push (intern name pkg) bag0)
+ (export (intern name pkg) pkg)) '("X" "Y" "Z"))
+ (loop for sym being each present-symbol of pkg do (push sym bag))
+ (null (set-exclusive-or bag0 bag))))
+
+
+(progn
+ (when (find-package "TB-BAR-TO-USE")
+ (mapcan #'delete-package (package-used-by-list "TB-BAR-TO-USE"))
+ (delete-package "TB-BAR-TO-USE"))
+ (make-package "TB-BAR-TO-USE")
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (let ((pkg (make-package "TB-FOO" :use '("TB-BAR-TO-USE")))
+ bag0 bag)
+ (mapc #'(lambda (name)
+ (export (intern name "TB-BAR-TO-USE") "TB-BAR-TO-USE"))
+ '("J" "K" "L"))
+ (mapc #'(lambda (name) (push (intern name pkg) bag0)) '("A" "B" "C"))
+ (mapc #'(lambda (name)
+ (push (intern name pkg) bag0)
+ (export (intern name pkg) pkg)) '("X" "Y" "Z"))
+ (loop for sym being the present-symbols in pkg do (push sym bag))
+ (null (set-exclusive-or bag0 bag))))
+(progn
+ (when (find-package "TB-BAR-TO-USE")
+ (mapcan #'delete-package (package-used-by-list "TB-BAR-TO-USE"))
+ (delete-package "TB-BAR-TO-USE"))
+ (make-package "TB-BAR-TO-USE")
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (let ((pkg (make-package "TB-FOO" :use '("TB-BAR-TO-USE")))
+ bag0 bag)
+ (mapc #'(lambda (name)
+ (export (intern name "TB-BAR-TO-USE") "TB-BAR-TO-USE"))
+ '("J" "K" "L"))
+ (mapc #'(lambda (name) (push (intern name pkg) bag0)) '("A" "B" "C"))
+ (mapc #'(lambda (name)
+ (push (intern name pkg) bag0)
+ (export (intern name pkg) pkg)) '("X" "Y" "Z"))
+ (loop for sym being each present-symbols in pkg do (push sym bag))
+ (null (set-exclusive-or bag0 bag))))
+
+
+(progn
+ (when (find-package "TB-BAR-TO-USE")
+ (mapcan #'delete-package (package-used-by-list "TB-BAR-TO-USE"))
+ (delete-package "TB-BAR-TO-USE"))
+ (make-package "TB-BAR-TO-USE")
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (let ((pkg (make-package "TB-FOO" :use '("TB-BAR-TO-USE")))
+ bag0 bag)
+ (mapc #'(lambda (name)
+ (export (intern name "TB-BAR-TO-USE") "TB-BAR-TO-USE"))
+ '("J" "K" "L"))
+ (mapc #'(lambda (name) (push (intern name pkg) bag0)) '("A" "B" "C"))
+ (mapc #'(lambda (name)
+ (push (intern name pkg) bag0)
+ (export (intern name pkg) pkg)) '("X" "Y" "Z"))
+ (loop for sym being the present-symbol in pkg do (push sym bag))
+ (null (set-exclusive-or bag0 bag))))
+(progn
+ (when (find-package "TB-BAR-TO-USE")
+ (mapcan #'delete-package (package-used-by-list "TB-BAR-TO-USE"))
+ (delete-package "TB-BAR-TO-USE"))
+ (make-package "TB-BAR-TO-USE")
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (let ((pkg (make-package "TB-FOO" :use '("TB-BAR-TO-USE")))
+ bag0 bag)
+ (mapc #'(lambda (name)
+ (export (intern name "TB-BAR-TO-USE") "TB-BAR-TO-USE"))
+ '("J" "K" "L"))
+ (mapc #'(lambda (name) (push (intern name pkg) bag0)) '("A" "B" "C"))
+ (mapc #'(lambda (name)
+ (push (intern name pkg) bag0)
+ (export (intern name pkg) pkg)) '("X" "Y" "Z"))
+ (loop for sym being each present-symbol in pkg do (push sym bag))
+ (null (set-exclusive-or bag0 bag))))
+
+
+
+(progn
+ (when (find-package "TB-BAR-TO-USE")
+ (mapcan #'delete-package (package-used-by-list "TB-BAR-TO-USE"))
+ (delete-package "TB-BAR-TO-USE"))
+ (make-package "TB-BAR-TO-USE")
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (let ((pkg (make-package "TB-FOO" :use '("TB-BAR-TO-USE")))
+ bag0 bag)
+ (mapc #'(lambda (name)
+ (export (intern name "TB-BAR-TO-USE") "TB-BAR-TO-USE"))
+ '("J" "K" "L"))
+ (mapc #'(lambda (name) (intern name pkg)) '("A" "B" "C"))
+ (mapc #'(lambda (name)
+ (push (intern name pkg) bag0)
+ (export (intern name pkg) pkg)) '("X" "Y" "Z"))
+ (loop for sym being the external-symbols of pkg do (push sym bag))
+ (null (set-exclusive-or bag0 bag))))
+(progn
+ (when (find-package "TB-BAR-TO-USE")
+ (mapcan #'delete-package (package-used-by-list "TB-BAR-TO-USE"))
+ (delete-package "TB-BAR-TO-USE"))
+ (make-package "TB-BAR-TO-USE")
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (let ((pkg (make-package "TB-FOO" :use '("TB-BAR-TO-USE")))
+ bag0 bag)
+ (mapc #'(lambda (name)
+ (export (intern name "TB-BAR-TO-USE") "TB-BAR-TO-USE"))
+ '("J" "K" "L"))
+ (mapc #'(lambda (name) (intern name pkg)) '("A" "B" "C"))
+ (mapc #'(lambda (name)
+ (push (intern name pkg) bag0)
+ (export (intern name pkg) pkg)) '("X" "Y" "Z"))
+ (loop for sym being each external-symbols of pkg do (push sym bag))
+ (null (set-exclusive-or bag0 bag))))
+(progn
+ (when (find-package "TB-BAR-TO-USE")
+ (mapcan #'delete-package (package-used-by-list "TB-BAR-TO-USE"))
+ (delete-package "TB-BAR-TO-USE"))
+ (make-package "TB-BAR-TO-USE")
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (let ((pkg (make-package "TB-FOO" :use '("TB-BAR-TO-USE")))
+ bag0 bag)
+ (mapc #'(lambda (name)
+ (export (intern name "TB-BAR-TO-USE") "TB-BAR-TO-USE"))
+ '("J" "K" "L"))
+ (mapc #'(lambda (name) (intern name pkg)) '("A" "B" "C"))
+ (mapc #'(lambda (name)
+ (push (intern name pkg) bag0)
+ (export (intern name pkg) pkg)) '("X" "Y" "Z"))
+ (loop for sym being the external-symbol of pkg do (push sym bag))
+ (null (set-exclusive-or bag0 bag))))
+(progn
+ (when (find-package "TB-BAR-TO-USE")
+ (mapcan #'delete-package (package-used-by-list "TB-BAR-TO-USE"))
+ (delete-package "TB-BAR-TO-USE"))
+ (make-package "TB-BAR-TO-USE")
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (let ((pkg (make-package "TB-FOO" :use '("TB-BAR-TO-USE")))
+ bag0 bag)
+ (mapc #'(lambda (name)
+ (export (intern name "TB-BAR-TO-USE") "TB-BAR-TO-USE"))
+ '("J" "K" "L"))
+ (mapc #'(lambda (name) (intern name pkg)) '("A" "B" "C"))
+ (mapc #'(lambda (name)
+ (push (intern name pkg) bag0)
+ (export (intern name pkg) pkg)) '("X" "Y" "Z"))
+ (loop for sym being each external-symbol of pkg do (push sym bag))
+ (null (set-exclusive-or bag0 bag))))
+(progn
+ (when (find-package "TB-BAR-TO-USE")
+ (mapcan #'delete-package (package-used-by-list "TB-BAR-TO-USE"))
+ (delete-package "TB-BAR-TO-USE"))
+ (make-package "TB-BAR-TO-USE")
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (let ((pkg (make-package "TB-FOO" :use '("TB-BAR-TO-USE")))
+ bag0 bag)
+ (mapc #'(lambda (name)
+ (export (intern name "TB-BAR-TO-USE") "TB-BAR-TO-USE"))
+ '("J" "K" "L"))
+ (mapc #'(lambda (name) (intern name pkg)) '("A" "B" "C"))
+ (mapc #'(lambda (name)
+ (push (intern name pkg) bag0)
+ (export (intern name pkg) pkg)) '("X" "Y" "Z"))
+ (loop for sym being the external-symbols in pkg do (push sym bag))
+ (null (set-exclusive-or bag0 bag))))
+(progn
+ (when (find-package "TB-BAR-TO-USE")
+ (mapcan #'delete-package (package-used-by-list "TB-BAR-TO-USE"))
+ (delete-package "TB-BAR-TO-USE"))
+ (make-package "TB-BAR-TO-USE")
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (let ((pkg (make-package "TB-FOO" :use '("TB-BAR-TO-USE")))
+ bag0 bag)
+ (mapc #'(lambda (name)
+ (export (intern name "TB-BAR-TO-USE") "TB-BAR-TO-USE"))
+ '("J" "K" "L"))
+ (mapc #'(lambda (name) (intern name pkg)) '("A" "B" "C"))
+ (mapc #'(lambda (name)
+ (push (intern name pkg) bag0)
+ (export (intern name pkg) pkg)) '("X" "Y" "Z"))
+ (loop for sym being each external-symbols in pkg do (push sym bag))
+ (null (set-exclusive-or bag0 bag))))
+(progn
+ (when (find-package "TB-BAR-TO-USE")
+ (mapcan #'delete-package (package-used-by-list "TB-BAR-TO-USE"))
+ (delete-package "TB-BAR-TO-USE"))
+ (make-package "TB-BAR-TO-USE")
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (let ((pkg (make-package "TB-FOO" :use '("TB-BAR-TO-USE")))
+ bag0 bag)
+ (mapc #'(lambda (name)
+ (export (intern name "TB-BAR-TO-USE") "TB-BAR-TO-USE"))
+ '("J" "K" "L"))
+ (mapc #'(lambda (name) (intern name pkg)) '("A" "B" "C"))
+ (mapc #'(lambda (name)
+ (push (intern name pkg) bag0)
+ (export (intern name pkg) pkg)) '("X" "Y" "Z"))
+ (loop for sym being the external-symbol in pkg do (push sym bag))
+ (null (set-exclusive-or bag0 bag))))
+(progn
+ (when (find-package "TB-BAR-TO-USE")
+ (mapcan #'delete-package (package-used-by-list "TB-BAR-TO-USE"))
+ (delete-package "TB-BAR-TO-USE"))
+ (make-package "TB-BAR-TO-USE")
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (let ((pkg (make-package "TB-FOO" :use '("TB-BAR-TO-USE")))
+ bag0 bag)
+ (mapc #'(lambda (name)
+ (export (intern name "TB-BAR-TO-USE") "TB-BAR-TO-USE"))
+ '("J" "K" "L"))
+ (mapc #'(lambda (name) (intern name pkg)) '("A" "B" "C"))
+ (mapc #'(lambda (name)
+ (push (intern name pkg) bag0)
+ (export (intern name pkg) pkg)) '("X" "Y" "Z"))
+ (loop for sym being each external-symbol in pkg do (push sym bag))
+ (null (set-exclusive-or bag0 bag))))
+
+(progn
+ (when (find-package "TB-BAR-TO-USE")
+ (mapcan #'delete-package (package-used-by-list "TB-BAR-TO-USE"))
+ (delete-package "TB-BAR-TO-USE"))
+ (make-package "TB-BAR-TO-USE")
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (let ((pkg (make-package "TB-FOO" :use '("TB-BAR-TO-USE")))
+ bag0 bag)
+ (mapc #'(lambda (name)
+ (push (intern name "TB-BAR-TO-USE") bag0)
+ (export (intern name "TB-BAR-TO-USE") "TB-BAR-TO-USE"))
+ '("J" "K" "L"))
+ (mapc #'(lambda (name) (push (intern name pkg) bag0)) '("A" "B" "C"))
+ (mapc #'(lambda (name)
+ (push (intern name pkg) bag0)
+ (export (intern name pkg) pkg)) '("X" "Y" "Z"))
+ (loop as sym being the symbols of pkg do (push sym bag))
+ (null (set-exclusive-or bag0 bag))))
+(progn
+ (when (find-package "TB-BAR-TO-USE")
+ (mapcan #'delete-package (package-used-by-list "TB-BAR-TO-USE"))
+ (delete-package "TB-BAR-TO-USE"))
+ (make-package "TB-BAR-TO-USE")
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (let ((pkg (make-package "TB-FOO" :use '("TB-BAR-TO-USE")))
+ bag0 bag)
+ (mapc #'(lambda (name)
+ (push (intern name "TB-BAR-TO-USE") bag0)
+ (export (intern name "TB-BAR-TO-USE") "TB-BAR-TO-USE"))
+ '("J" "K" "L"))
+ (mapc #'(lambda (name) (push (intern name pkg) bag0)) '("A" "B" "C"))
+ (mapc #'(lambda (name)
+ (push (intern name pkg) bag0)
+ (export (intern name pkg) pkg)) '("X" "Y" "Z"))
+ (loop as sym being each symbols of pkg do (push sym bag))
+ (null (set-exclusive-or bag0 bag))))
+
+
+(progn
+ (when (find-package "TB-BAR-TO-USE")
+ (mapcan #'delete-package (package-used-by-list "TB-BAR-TO-USE"))
+ (delete-package "TB-BAR-TO-USE"))
+ (make-package "TB-BAR-TO-USE")
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (let ((pkg (make-package "TB-FOO" :use '("TB-BAR-TO-USE")))
+ bag0 bag)
+ (mapc #'(lambda (name)
+ (push (intern name "TB-BAR-TO-USE") bag0)
+ (export (intern name "TB-BAR-TO-USE") "TB-BAR-TO-USE"))
+ '("J" "K" "L"))
+ (mapc #'(lambda (name) (push (intern name pkg) bag0)) '("A" "B" "C"))
+ (mapc #'(lambda (name)
+ (push (intern name pkg) bag0)
+ (export (intern name pkg) pkg)) '("X" "Y" "Z"))
+ (loop as sym being the symbol of pkg do (push sym bag))
+ (null (set-exclusive-or bag0 bag))))
+(progn
+ (when (find-package "TB-BAR-TO-USE")
+ (mapcan #'delete-package (package-used-by-list "TB-BAR-TO-USE"))
+ (delete-package "TB-BAR-TO-USE"))
+ (make-package "TB-BAR-TO-USE")
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (let ((pkg (make-package "TB-FOO" :use '("TB-BAR-TO-USE")))
+ bag0 bag)
+ (mapc #'(lambda (name)
+ (push (intern name "TB-BAR-TO-USE") bag0)
+ (export (intern name "TB-BAR-TO-USE") "TB-BAR-TO-USE"))
+ '("J" "K" "L"))
+ (mapc #'(lambda (name) (push (intern name pkg) bag0)) '("A" "B" "C"))
+ (mapc #'(lambda (name)
+ (push (intern name pkg) bag0)
+ (export (intern name pkg) pkg)) '("X" "Y" "Z"))
+ (loop as sym being each symbol of pkg do (push sym bag))
+ (null (set-exclusive-or bag0 bag))))
+
+
+(progn
+ (when (find-package "TB-BAR-TO-USE")
+ (mapcan #'delete-package (package-used-by-list "TB-BAR-TO-USE"))
+ (delete-package "TB-BAR-TO-USE"))
+ (make-package "TB-BAR-TO-USE")
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (let ((pkg (make-package "TB-FOO" :use '("TB-BAR-TO-USE")))
+ bag0 bag)
+ (mapc #'(lambda (name)
+ (push (intern name "TB-BAR-TO-USE") bag0)
+ (export (intern name "TB-BAR-TO-USE") "TB-BAR-TO-USE"))
+ '("J" "K" "L"))
+ (mapc #'(lambda (name) (push (intern name pkg) bag0)) '("A" "B" "C"))
+ (mapc #'(lambda (name)
+ (push (intern name pkg) bag0)
+ (export (intern name pkg) pkg)) '("X" "Y" "Z"))
+ (loop as sym being the symbols in pkg do (push sym bag))
+ (null (set-exclusive-or bag0 bag))))
+(progn
+ (when (find-package "TB-BAR-TO-USE")
+ (mapcan #'delete-package (package-used-by-list "TB-BAR-TO-USE"))
+ (delete-package "TB-BAR-TO-USE"))
+ (make-package "TB-BAR-TO-USE")
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (let ((pkg (make-package "TB-FOO" :use '("TB-BAR-TO-USE")))
+ bag0 bag)
+ (mapc #'(lambda (name)
+ (push (intern name "TB-BAR-TO-USE") bag0)
+ (export (intern name "TB-BAR-TO-USE") "TB-BAR-TO-USE"))
+ '("J" "K" "L"))
+ (mapc #'(lambda (name) (push (intern name pkg) bag0)) '("A" "B" "C"))
+ (mapc #'(lambda (name)
+ (push (intern name pkg) bag0)
+ (export (intern name pkg) pkg)) '("X" "Y" "Z"))
+ (loop as sym being each symbols in pkg do (push sym bag))
+ (null (set-exclusive-or bag0 bag))))
+
+
+(progn
+ (when (find-package "TB-BAR-TO-USE")
+ (mapcan #'delete-package (package-used-by-list "TB-BAR-TO-USE"))
+ (delete-package "TB-BAR-TO-USE"))
+ (make-package "TB-BAR-TO-USE")
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (let ((pkg (make-package "TB-FOO" :use '("TB-BAR-TO-USE")))
+ bag0 bag)
+ (mapc #'(lambda (name)
+ (push (intern name "TB-BAR-TO-USE") bag0)
+ (export (intern name "TB-BAR-TO-USE") "TB-BAR-TO-USE"))
+ '("J" "K" "L"))
+ (mapc #'(lambda (name) (push (intern name pkg) bag0)) '("A" "B" "C"))
+ (mapc #'(lambda (name)
+ (push (intern name pkg) bag0)
+ (export (intern name pkg) pkg)) '("X" "Y" "Z"))
+ (loop as sym being the symbol in pkg do (push sym bag))
+ (null (set-exclusive-or bag0 bag))))
+(progn
+ (when (find-package "TB-BAR-TO-USE")
+ (mapcan #'delete-package (package-used-by-list "TB-BAR-TO-USE"))
+ (delete-package "TB-BAR-TO-USE"))
+ (make-package "TB-BAR-TO-USE")
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (let ((pkg (make-package "TB-FOO" :use '("TB-BAR-TO-USE")))
+ bag0 bag)
+ (mapc #'(lambda (name)
+ (push (intern name "TB-BAR-TO-USE") bag0)
+ (export (intern name "TB-BAR-TO-USE") "TB-BAR-TO-USE"))
+ '("J" "K" "L"))
+ (mapc #'(lambda (name) (push (intern name pkg) bag0)) '("A" "B" "C"))
+ (mapc #'(lambda (name)
+ (push (intern name pkg) bag0)
+ (export (intern name pkg) pkg)) '("X" "Y" "Z"))
+ (loop as sym being each symbol in pkg do (push sym bag))
+ (null (set-exclusive-or bag0 bag))))
+
+
+
+(progn
+ (when (find-package "TB-BAR-TO-USE")
+ (mapcan #'delete-package (package-used-by-list "TB-BAR-TO-USE"))
+ (delete-package "TB-BAR-TO-USE"))
+ (make-package "TB-BAR-TO-USE")
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (let ((pkg (make-package "TB-FOO" :use '("TB-BAR-TO-USE")))
+ bag0 bag)
+ (mapc #'(lambda (name)
+ (export (intern name "TB-BAR-TO-USE") "TB-BAR-TO-USE"))
+ '("J" "K" "L"))
+ (mapc #'(lambda (name) (push (intern name pkg) bag0)) '("A" "B" "C"))
+ (mapc #'(lambda (name)
+ (push (intern name pkg) bag0)
+ (export (intern name pkg) pkg)) '("X" "Y" "Z"))
+ (loop as sym being the present-symbols of pkg do (push sym bag))
+ (null (set-exclusive-or bag0 bag))))
+(progn
+ (when (find-package "TB-BAR-TO-USE")
+ (mapcan #'delete-package (package-used-by-list "TB-BAR-TO-USE"))
+ (delete-package "TB-BAR-TO-USE"))
+ (make-package "TB-BAR-TO-USE")
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (let ((pkg (make-package "TB-FOO" :use '("TB-BAR-TO-USE")))
+ bag0 bag)
+ (mapc #'(lambda (name)
+ (export (intern name "TB-BAR-TO-USE") "TB-BAR-TO-USE"))
+ '("J" "K" "L"))
+ (mapc #'(lambda (name) (push (intern name pkg) bag0)) '("A" "B" "C"))
+ (mapc #'(lambda (name)
+ (push (intern name pkg) bag0)
+ (export (intern name pkg) pkg)) '("X" "Y" "Z"))
+ (loop as sym being each present-symbols of pkg do (push sym bag))
+ (null (set-exclusive-or bag0 bag))))
+
+
+(progn
+ (when (find-package "TB-BAR-TO-USE")
+ (mapcan #'delete-package (package-used-by-list "TB-BAR-TO-USE"))
+ (delete-package "TB-BAR-TO-USE"))
+ (make-package "TB-BAR-TO-USE")
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (let ((pkg (make-package "TB-FOO" :use '("TB-BAR-TO-USE")))
+ bag0 bag)
+ (mapc #'(lambda (name)
+ (export (intern name "TB-BAR-TO-USE") "TB-BAR-TO-USE"))
+ '("J" "K" "L"))
+ (mapc #'(lambda (name) (push (intern name pkg) bag0)) '("A" "B" "C"))
+ (mapc #'(lambda (name)
+ (push (intern name pkg) bag0)
+ (export (intern name pkg) pkg)) '("X" "Y" "Z"))
+ (loop as sym being the present-symbol of pkg do (push sym bag))
+ (null (set-exclusive-or bag0 bag))))
+(progn
+ (when (find-package "TB-BAR-TO-USE")
+ (mapcan #'delete-package (package-used-by-list "TB-BAR-TO-USE"))
+ (delete-package "TB-BAR-TO-USE"))
+ (make-package "TB-BAR-TO-USE")
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (let ((pkg (make-package "TB-FOO" :use '("TB-BAR-TO-USE")))
+ bag0 bag)
+ (mapc #'(lambda (name)
+ (export (intern name "TB-BAR-TO-USE") "TB-BAR-TO-USE"))
+ '("J" "K" "L"))
+ (mapc #'(lambda (name) (push (intern name pkg) bag0)) '("A" "B" "C"))
+ (mapc #'(lambda (name)
+ (push (intern name pkg) bag0)
+ (export (intern name pkg) pkg)) '("X" "Y" "Z"))
+ (loop as sym being each present-symbol of pkg do (push sym bag))
+ (null (set-exclusive-or bag0 bag))))
+
+
+(progn
+ (when (find-package "TB-BAR-TO-USE")
+ (mapcan #'delete-package (package-used-by-list "TB-BAR-TO-USE"))
+ (delete-package "TB-BAR-TO-USE"))
+ (make-package "TB-BAR-TO-USE")
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (let ((pkg (make-package "TB-FOO" :use '("TB-BAR-TO-USE")))
+ bag0 bag)
+ (mapc #'(lambda (name)
+ (export (intern name "TB-BAR-TO-USE") "TB-BAR-TO-USE"))
+ '("J" "K" "L"))
+ (mapc #'(lambda (name) (push (intern name pkg) bag0)) '("A" "B" "C"))
+ (mapc #'(lambda (name)
+ (push (intern name pkg) bag0)
+ (export (intern name pkg) pkg)) '("X" "Y" "Z"))
+ (loop as sym being the present-symbols in pkg do (push sym bag))
+ (null (set-exclusive-or bag0 bag))))
+(progn
+ (when (find-package "TB-BAR-TO-USE")
+ (mapcan #'delete-package (package-used-by-list "TB-BAR-TO-USE"))
+ (delete-package "TB-BAR-TO-USE"))
+ (make-package "TB-BAR-TO-USE")
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (let ((pkg (make-package "TB-FOO" :use '("TB-BAR-TO-USE")))
+ bag0 bag)
+ (mapc #'(lambda (name)
+ (export (intern name "TB-BAR-TO-USE") "TB-BAR-TO-USE"))
+ '("J" "K" "L"))
+ (mapc #'(lambda (name) (push (intern name pkg) bag0)) '("A" "B" "C"))
+ (mapc #'(lambda (name)
+ (push (intern name pkg) bag0)
+ (export (intern name pkg) pkg)) '("X" "Y" "Z"))
+ (loop as sym being each present-symbols in pkg do (push sym bag))
+ (null (set-exclusive-or bag0 bag))))
+
+
+(progn
+ (when (find-package "TB-BAR-TO-USE")
+ (mapcan #'delete-package (package-used-by-list "TB-BAR-TO-USE"))
+ (delete-package "TB-BAR-TO-USE"))
+ (make-package "TB-BAR-TO-USE")
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (let ((pkg (make-package "TB-FOO" :use '("TB-BAR-TO-USE")))
+ bag0 bag)
+ (mapc #'(lambda (name)
+ (export (intern name "TB-BAR-TO-USE") "TB-BAR-TO-USE"))
+ '("J" "K" "L"))
+ (mapc #'(lambda (name) (push (intern name pkg) bag0)) '("A" "B" "C"))
+ (mapc #'(lambda (name)
+ (push (intern name pkg) bag0)
+ (export (intern name pkg) pkg)) '("X" "Y" "Z"))
+ (loop as sym being the present-symbol in pkg do (push sym bag))
+ (null (set-exclusive-or bag0 bag))))
+(progn
+ (when (find-package "TB-BAR-TO-USE")
+ (mapcan #'delete-package (package-used-by-list "TB-BAR-TO-USE"))
+ (delete-package "TB-BAR-TO-USE"))
+ (make-package "TB-BAR-TO-USE")
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (let ((pkg (make-package "TB-FOO" :use '("TB-BAR-TO-USE")))
+ bag0 bag)
+ (mapc #'(lambda (name)
+ (export (intern name "TB-BAR-TO-USE") "TB-BAR-TO-USE"))
+ '("J" "K" "L"))
+ (mapc #'(lambda (name) (push (intern name pkg) bag0)) '("A" "B" "C"))
+ (mapc #'(lambda (name)
+ (push (intern name pkg) bag0)
+ (export (intern name pkg) pkg)) '("X" "Y" "Z"))
+ (loop as sym being each present-symbol in pkg do (push sym bag))
+ (null (set-exclusive-or bag0 bag))))
+
+
+
+(progn
+ (when (find-package "TB-BAR-TO-USE")
+ (mapcan #'delete-package (package-used-by-list "TB-BAR-TO-USE"))
+ (delete-package "TB-BAR-TO-USE"))
+ (make-package "TB-BAR-TO-USE")
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (let ((pkg (make-package "TB-FOO" :use '("TB-BAR-TO-USE")))
+ bag0 bag)
+ (mapc #'(lambda (name)
+ (export (intern name "TB-BAR-TO-USE") "TB-BAR-TO-USE"))
+ '("J" "K" "L"))
+ (mapc #'(lambda (name) (intern name pkg)) '("A" "B" "C"))
+ (mapc #'(lambda (name)
+ (push (intern name pkg) bag0)
+ (export (intern name pkg) pkg)) '("X" "Y" "Z"))
+ (loop as sym being the external-symbols of pkg do (push sym bag))
+ (null (set-exclusive-or bag0 bag))))
+(progn
+ (when (find-package "TB-BAR-TO-USE")
+ (mapcan #'delete-package (package-used-by-list "TB-BAR-TO-USE"))
+ (delete-package "TB-BAR-TO-USE"))
+ (make-package "TB-BAR-TO-USE")
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (let ((pkg (make-package "TB-FOO" :use '("TB-BAR-TO-USE")))
+ bag0 bag)
+ (mapc #'(lambda (name)
+ (export (intern name "TB-BAR-TO-USE") "TB-BAR-TO-USE"))
+ '("J" "K" "L"))
+ (mapc #'(lambda (name) (intern name pkg)) '("A" "B" "C"))
+ (mapc #'(lambda (name)
+ (push (intern name pkg) bag0)
+ (export (intern name pkg) pkg)) '("X" "Y" "Z"))
+ (loop as sym being each external-symbols of pkg do (push sym bag))
+ (null (set-exclusive-or bag0 bag))))
+(progn
+ (when (find-package "TB-BAR-TO-USE")
+ (mapcan #'delete-package (package-used-by-list "TB-BAR-TO-USE"))
+ (delete-package "TB-BAR-TO-USE"))
+ (make-package "TB-BAR-TO-USE")
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (let ((pkg (make-package "TB-FOO" :use '("TB-BAR-TO-USE")))
+ bag0 bag)
+ (mapc #'(lambda (name)
+ (export (intern name "TB-BAR-TO-USE") "TB-BAR-TO-USE"))
+ '("J" "K" "L"))
+ (mapc #'(lambda (name) (intern name pkg)) '("A" "B" "C"))
+ (mapc #'(lambda (name)
+ (push (intern name pkg) bag0)
+ (export (intern name pkg) pkg)) '("X" "Y" "Z"))
+ (loop as sym being the external-symbol of pkg do (push sym bag))
+ (null (set-exclusive-or bag0 bag))))
+(progn
+ (when (find-package "TB-BAR-TO-USE")
+ (mapcan #'delete-package (package-used-by-list "TB-BAR-TO-USE"))
+ (delete-package "TB-BAR-TO-USE"))
+ (make-package "TB-BAR-TO-USE")
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (let ((pkg (make-package "TB-FOO" :use '("TB-BAR-TO-USE")))
+ bag0 bag)
+ (mapc #'(lambda (name)
+ (export (intern name "TB-BAR-TO-USE") "TB-BAR-TO-USE"))
+ '("J" "K" "L"))
+ (mapc #'(lambda (name) (intern name pkg)) '("A" "B" "C"))
+ (mapc #'(lambda (name)
+ (push (intern name pkg) bag0)
+ (export (intern name pkg) pkg)) '("X" "Y" "Z"))
+ (loop as sym being each external-symbol of pkg do (push sym bag))
+ (null (set-exclusive-or bag0 bag))))
+(progn
+ (when (find-package "TB-BAR-TO-USE")
+ (mapcan #'delete-package (package-used-by-list "TB-BAR-TO-USE"))
+ (delete-package "TB-BAR-TO-USE"))
+ (make-package "TB-BAR-TO-USE")
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (let ((pkg (make-package "TB-FOO" :use '("TB-BAR-TO-USE")))
+ bag0 bag)
+ (mapc #'(lambda (name)
+ (export (intern name "TB-BAR-TO-USE") "TB-BAR-TO-USE"))
+ '("J" "K" "L"))
+ (mapc #'(lambda (name) (intern name pkg)) '("A" "B" "C"))
+ (mapc #'(lambda (name)
+ (push (intern name pkg) bag0)
+ (export (intern name pkg) pkg)) '("X" "Y" "Z"))
+ (loop as sym being the external-symbols in pkg do (push sym bag))
+ (null (set-exclusive-or bag0 bag))))
+(progn
+ (when (find-package "TB-BAR-TO-USE")
+ (mapcan #'delete-package (package-used-by-list "TB-BAR-TO-USE"))
+ (delete-package "TB-BAR-TO-USE"))
+ (make-package "TB-BAR-TO-USE")
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (let ((pkg (make-package "TB-FOO" :use '("TB-BAR-TO-USE")))
+ bag0 bag)
+ (mapc #'(lambda (name)
+ (export (intern name "TB-BAR-TO-USE") "TB-BAR-TO-USE"))
+ '("J" "K" "L"))
+ (mapc #'(lambda (name) (intern name pkg)) '("A" "B" "C"))
+ (mapc #'(lambda (name)
+ (push (intern name pkg) bag0)
+ (export (intern name pkg) pkg)) '("X" "Y" "Z"))
+ (loop as sym being each external-symbols in pkg do (push sym bag))
+ (null (set-exclusive-or bag0 bag))))
+(progn
+ (when (find-package "TB-BAR-TO-USE")
+ (mapcan #'delete-package (package-used-by-list "TB-BAR-TO-USE"))
+ (delete-package "TB-BAR-TO-USE"))
+ (make-package "TB-BAR-TO-USE")
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (let ((pkg (make-package "TB-FOO" :use '("TB-BAR-TO-USE")))
+ bag0 bag)
+ (mapc #'(lambda (name)
+ (export (intern name "TB-BAR-TO-USE") "TB-BAR-TO-USE"))
+ '("J" "K" "L"))
+ (mapc #'(lambda (name) (intern name pkg)) '("A" "B" "C"))
+ (mapc #'(lambda (name)
+ (push (intern name pkg) bag0)
+ (export (intern name pkg) pkg)) '("X" "Y" "Z"))
+ (loop as sym being the external-symbol in pkg do (push sym bag))
+ (null (set-exclusive-or bag0 bag))))
+(progn
+ (when (find-package "TB-BAR-TO-USE")
+ (mapcan #'delete-package (package-used-by-list "TB-BAR-TO-USE"))
+ (delete-package "TB-BAR-TO-USE"))
+ (make-package "TB-BAR-TO-USE")
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (let ((pkg (make-package "TB-FOO" :use '("TB-BAR-TO-USE")))
+ bag0 bag)
+ (mapc #'(lambda (name)
+ (export (intern name "TB-BAR-TO-USE") "TB-BAR-TO-USE"))
+ '("J" "K" "L"))
+ (mapc #'(lambda (name) (intern name pkg)) '("A" "B" "C"))
+ (mapc #'(lambda (name)
+ (push (intern name pkg) bag0)
+ (export (intern name pkg) pkg)) '("X" "Y" "Z"))
+ (loop as sym being each external-symbol in pkg do (push sym bag))
+ (null (set-exclusive-or bag0 bag))))
+(eq t (loop for symbol being the symbols of 'cl finally (return t)))
+(progn
+ (when (find-package "TB-BAR-TO-USE")
+ (mapcan #'delete-package (package-used-by-list "TB-BAR-TO-USE"))
+ (delete-package "TB-BAR-TO-USE"))
+ (make-package "TB-BAR-TO-USE")
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (let ((pkg (make-package "TB-FOO" :use '("TB-BAR-TO-USE")))
+ bag0 bag)
+ (mapc #'(lambda (name)
+ (export (intern name "TB-BAR-TO-USE") "TB-BAR-TO-USE"))
+ '("J" "K" "L"))
+ (mapc #'(lambda (name) (intern name pkg)) '("A" "B" "C"))
+ (mapc #'(lambda (name)
+ (push (intern name pkg) bag0)
+ (export (intern name pkg) pkg)) '("X" "Y" "Z"))
+ (loop as sym of-type symbol being the external-symbols of pkg
+ do (push sym bag))
+ (null (set-exclusive-or bag0 bag))))
+(progn
+ (when (find-package "TB-BAR-TO-USE")
+ (mapcan #'delete-package (package-used-by-list "TB-BAR-TO-USE"))
+ (delete-package "TB-BAR-TO-USE"))
+ (make-package "TB-BAR-TO-USE")
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (let ((pkg (make-package "TB-FOO" :use '("TB-BAR-TO-USE")))
+ bag0 bag)
+ (mapc #'(lambda (name)
+ (export (intern name "TB-BAR-TO-USE") "TB-BAR-TO-USE"))
+ '("J" "K" "L"))
+ (mapc #'(lambda (name) (intern name pkg)) '("A" "B" "C"))
+ (mapc #'(lambda (name)
+ (push (intern name pkg) bag0)
+ (export (intern name pkg) pkg)) '("X" "Y" "Z"))
+ (loop as sym t being the external-symbols of pkg
+ do (push sym bag))
+ (null (set-exclusive-or bag0 bag))))
+(progn
+ (when (find-package "TB-BAR-TO-USE")
+ (mapcan #'delete-package (package-used-by-list "TB-BAR-TO-USE"))
+ (delete-package "TB-BAR-TO-USE"))
+ (make-package "TB-BAR-TO-USE")
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (let ((pkg (make-package "TB-FOO" :use '("TB-BAR-TO-USE")))
+ bag0 bag)
+ (mapc #'(lambda (name)
+ (export (intern name "TB-BAR-TO-USE") "TB-BAR-TO-USE"))
+ '("J" "K" "L"))
+ (mapc #'(lambda (name) (intern name pkg)) '("A" "B" "C"))
+ (mapc #'(lambda (name)
+ (push (intern name pkg) bag0)
+ (export (intern name pkg) pkg)) '("X" "Y" "Z"))
+ (loop as sym of-type t being the external-symbols of pkg
+ do (push sym bag))
+ (null (set-exclusive-or bag0 bag))))
+
+(eq t (loop for c in '(#\A #\S #\Z #\a)
+ always (eq t (loop for s in
+ (loop for s being the external-symbols of 'cl
+ when (char= c (char (symbol-name s) 0))
+ collect s)
+ always (char= c (char (symbol-name s) 0))))))
+
diff --git a/Sacla/tests/must-loop.patch b/Sacla/tests/must-loop.patch
new file mode 100644
index 0000000..51b53b8
--- /dev/null
+++ b/Sacla/tests/must-loop.patch
@@ -0,0 +1,13 @@
+*** sacla/lisp/test/must-loop.lisp 2004-08-03 08:34:55.000000000 +0200
+--- CLISP/clisp-20040712/sacla-tests/must-loop.lisp 2004-08-06 02:49:13.000000000 +0200
+***************
+*** 1195,1200 ****
+--- 1195,1202 ----
+ do (incf x)
+ initially (incf x) (incf x) finally (incf x) (return (incf x)))
+ 7)
++ #-CLISP ; unfounded expectations about the value of for-as iteration variables
++ ; in INITIALLY and FINALLY clauses
+ (equal (let (val) (loop for a downto 3 from 100
+ for b in '(x y z) and c = 50 then (1+ c)
+ initially (setq val (list a b c))
diff --git a/Sacla/tests/must-package.lisp b/Sacla/tests/must-package.lisp
new file mode 100644
index 0000000..192c570
--- /dev/null
+++ b/Sacla/tests/must-package.lisp
@@ -0,0 +1,2266 @@
+;; Copyright (C) 2002-2004, Yuji Minejima <ggb01164@nifty.ne.jp>
+;; ALL RIGHTS RESERVED.
+;;
+;; $Id: must-package.lisp,v 1.12 2004/08/09 02:49:54 yuji Exp $
+;;
+;; Redistribution and use in source and binary forms, with or without
+;; modification, are permitted provided that the following conditions
+;; are met:
+;;
+;; * Redistributions of source code must retain the above copyright
+;; notice, this list of conditions and the following disclaimer.
+;; * 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.
+;;
+;; 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
+;; OWNER 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.
+
+
+;; list-all-packages
+(listp (list-all-packages))
+(find "COMMON-LISP" (mapcar #'package-name (list-all-packages)) :test #'string=)
+(find "COMMON-LISP-USER" (mapcar #'package-name (list-all-packages)) :test #'string=)
+(find "KEYWORD" (mapcar #'package-name (list-all-packages)) :test #'string=)
+(every #'packagep (list-all-packages))
+
+
+;; find-package
+(packagep (find-package "COMMON-LISP"))
+(packagep (find-package "CL"))
+(packagep (find-package "COMMON-LISP-USER"))
+(packagep (find-package "CL-USER"))
+(packagep (find-package "KEYWORD"))
+(let ((cl (find-package "COMMON-LISP")))
+ (eq cl (find-package cl)))
+(eq (find-package "CL") (find-package "COMMON-LISP"))
+(eq (find-package 'cl) (find-package "COMMON-LISP"))
+(eq (find-package 'cl) (find-package 'common-lisp))
+(let ((name "NO-SUCH-PACKAGE"))
+ (when (find-package name)
+ (delete-package name))
+ (not (find-package name)))
+(= (length (multiple-value-list (find-package "CL"))) 1)
+(= (length (multiple-value-list (find-package "NO-SUCH-PACKAGE"))) 1)
+(packagep (find-package (find-package (find-package "KEYWORD"))))
+
+
+;; packagep
+(every (complement #'packagep) '(nil a b "CL" "KEYWORD" (a) cl common-lisp-user))
+
+;; make-package
+(progn (when (find-package "a") (delete-package "a"))
+ (and (packagep (make-package #\a)) (delete-package "a")))
+(progn (when (find-package "a") (delete-package "a"))
+ (and (packagep (make-package '|a|)) (delete-package "a")))
+(progn (when (find-package "a") (delete-package "a"))
+ (and (packagep (make-package "a")) (delete-package "a")))
+(progn (when (find-package "a") (delete-package "a"))
+ (and (packagep (make-package "a" :use nil)) (delete-package "a")))
+(progn (when (find-package "a") (delete-package "a"))
+ (and (packagep (make-package "a" :use '(cl))) (delete-package "a")))
+(progn (when (find-package "a") (delete-package "a"))
+ (and (packagep (make-package "a" :use '(cl) :nicknames '("b")))
+ (delete-package "b")))
+(progn (when (find-package "a") (delete-package "a"))
+ (and (packagep (make-package "a" :use '(cl) :nicknames '("b" "c")))
+ (delete-package "c")))
+(progn (when (find-package "a") (delete-package "a"))
+ (and (packagep (make-package "a" :use '(cl) :nicknames '(#\b "c")))
+ (delete-package "b")))
+(progn (when (find-package "a") (delete-package "a"))
+ (and (packagep (make-package "a" :use '(cl) :nicknames '(|b| "c")))
+ (delete-package "b")))
+(HANDLER-CASE
+ (PROGN
+ (WHEN (FIND-PACKAGE "a") (DELETE-PACKAGE "a"))
+ (WHEN (FIND-PACKAGE "b") (DELETE-PACKAGE "b"))
+ (AND (PACKAGEP (MAKE-PACKAGE "b" :USE '(CL)))
+ (PACKAGEP (MAKE-PACKAGE "a" :USE '(CL) :NICKNAMES '(|b| "c")))))
+ (ERROR NIL T)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE
+ (PROGN
+ (WHEN (FIND-PACKAGE "a") (DELETE-PACKAGE "a"))
+ (WHEN (FIND-PACKAGE "b") (DELETE-PACKAGE "b"))
+ (AND (PACKAGEP (MAKE-PACKAGE "a" :USE '(CL)))
+ (PACKAGEP (MAKE-PACKAGE "a" :USE '(CL) :NICKNAMES '(|b| "c")))))
+ (ERROR NIL T)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE
+ (PROGN
+ (WHEN (FIND-PACKAGE "a") (DELETE-PACKAGE "a"))
+ (WHEN (FIND-PACKAGE "d") (DELETE-PACKAGE "b"))
+ (AND (PACKAGEP (MAKE-PACKAGE "a" :USE '(CL) :NICKNAMES '("b" "c")))
+ (PACKAGEP (MAKE-PACKAGE "d" :USE '(CL) :NICKNAMES '("c")))))
+ (ERROR NIL T)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE
+ (PROGN
+ (WHEN (FIND-PACKAGE "TB-FOO") (DELETE-PACKAGE "TB-FOO"))
+ (WHEN (FIND-PACKAGE "TB-BAR-TO-USE")
+ (MAPCAN #'DELETE-PACKAGE (PACKAGE-USED-BY-LIST "TB-BAR-TO-USE"))
+ (DELETE-PACKAGE "TB-BAR-TO-USE"))
+ (AND (PACKAGEP (MAKE-PACKAGE "TB-BAR-TO-USE" :USE NIL))
+ (EXPORT (INTERN "CAR" 'TB-BAR-TO-USE) 'TB-BAR-TO-USE)
+ (MAKE-PACKAGE "TB-FOO" :USE '(CL "TB-BAR-TO-USE"))))
+ (ERROR NIL T)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+
+
+
+;; package-name
+(string= (package-name "COMMON-LISP") "COMMON-LISP")
+(string= (package-name 'common-lisp) "COMMON-LISP")
+(string= (package-name (find-package 'common-lisp)) "COMMON-LISP")
+(string= (package-name "CL") "COMMON-LISP")
+(string= (package-name 'cl) "COMMON-LISP")
+(string= (package-name (find-package 'cl)) "COMMON-LISP")
+(let ((designator-list
+ (list 'cl 'common-lisp "CL" "COMMON-LISP" (find-package 'cl)
+ 'cl-user 'common-lisp-user "CL-USER" "COMMON-LISP-USER"
+ (find-package 'cl-user)
+ 'keyword "KEYWORD" (find-package 'keyword))))
+ (every #'stringp (mapcar #'package-name designator-list)))
+(every #'stringp (mapcar #'package-name (list-all-packages)))
+(let* ((name "TB-FOO")
+ (package (or (find-package name) (make-package name :use nil))))
+ (and (delete-package name)
+ (not (find-package name))
+ (null (package-name package))))
+
+
+;; package-nicknames
+(member "CL" (package-nicknames "COMMON-LISP") :test #'string=)
+(member "CL" (package-nicknames 'common-lisp) :test #'string=)
+(member "CL" (package-nicknames (find-package 'common-lisp)) :test #'string=)
+(member "CL" (package-nicknames "CL") :test #'string=)
+(member "CL" (package-nicknames 'cl) :test #'string=)
+(member "CL" (package-nicknames (find-package 'cl)) :test #'string=)
+(let ((name 'test-foo)
+ (nicknames '(test-foo-nickname1 test-foo-nickname2 test-foo-nickname3)))
+ (dolist (name (cons name nicknames))
+ (when (find-package name) (delete-package name)))
+ (every #'stringp (package-nicknames (make-package name :nicknames nicknames))))
+(every #'stringp (mapcan #'(lambda (package)
+ (copy-list (package-nicknames package)))
+ (list-all-packages)))
+(progn
+ (when (find-package 'test-foo) (delete-package 'test-foo))
+ (null (set-difference
+ (package-nicknames (make-package 'test-foo
+ :nicknames '("TB-FOO" "test-foo")))
+ '("TB-FOO" "test-foo")
+ :test #'string=)))
+(let ((designator-list
+ (list 'cl 'common-lisp "CL" "COMMON-LISP" (find-package 'cl)
+ 'cl-user 'common-lisp-user "CL-USER" "COMMON-LISP-USER"
+ (find-package 'cl-user)
+ 'keyword "KEYWORD" (find-package 'keyword))))
+ (every #'stringp (mapcan #'(lambda (designator)
+ (copy-list (package-nicknames designator)))
+ designator-list)))
+
+
+;; package-shadowing-symbols
+(every #'listp (mapcar #'package-shadowing-symbols (list-all-packages)))
+(every #'symbolp (mapcan #'(lambda (package)
+ (copy-list (package-shadowing-symbols package)))
+ (list-all-packages)))
+(listp (package-shadowing-symbols 'cl))
+(listp (package-shadowing-symbols "CL-USER"))
+(listp (package-shadowing-symbols "COMMON-LISP"))
+(listp (package-shadowing-symbols (find-package 'keyword)))
+(let ((designator-list
+ (list 'cl 'common-lisp "CL" "COMMON-LISP" (find-package 'cl)
+ 'cl-user 'common-lisp-user "CL-USER" "COMMON-LISP-USER"
+ (find-package 'cl-user)
+ 'keyword "KEYWORD" (find-package 'keyword))))
+ (every #'symbolp (mapcan #'(lambda (designator)
+ (copy-list (package-shadowing-symbols designator)))
+ designator-list)))
+
+
+;; package-use-list
+(every #'listp (mapcar #'package-use-list (list-all-packages)))
+(every #'packagep (mapcan #'(lambda (package)
+ (copy-list (package-use-list package)))
+ (list-all-packages)))
+(listp (package-use-list 'cl))
+(listp (package-use-list "CL-USER"))
+(listp (package-use-list "COMMON-LISP"))
+(listp (package-use-list (find-package 'keyword)))
+(let ((designator-list
+ (list 'cl 'common-lisp "CL" "COMMON-LISP" (find-package 'cl)
+ 'cl-user 'common-lisp-user "CL-USER" "COMMON-LISP-USER"
+ (find-package 'cl-user)
+ 'keyword "KEYWORD" (find-package 'keyword))))
+ (every #'packagep (mapcan #'(lambda (designator)
+ (copy-list (package-use-list designator)))
+ designator-list)))
+
+
+;; package-used-by-list
+(every #'listp (mapcar #'package-used-by-list (list-all-packages)))
+(every #'packagep (mapcan #'(lambda (package)
+ (copy-list (package-used-by-list package)))
+ (list-all-packages)))
+(listp (package-used-by-list 'cl))
+(listp (package-used-by-list "CL-USER"))
+(listp (package-used-by-list "COMMON-LISP"))
+(listp (package-used-by-list (find-package 'keyword)))
+(let ((designator-list
+ (list 'cl 'common-lisp "CL" "COMMON-LISP" (find-package 'cl)
+ 'cl-user 'common-lisp-user "CL-USER" "COMMON-LISP-USER"
+ (find-package 'cl-user)
+ 'keyword "KEYWORD" (find-package 'keyword))))
+ (every #'packagep (mapcan #'(lambda (designator)
+ (copy-list (package-used-by-list designator)))
+ designator-list)))
+
+
+;; rename-package
+(progn
+ (mapcar #'(lambda (package)
+ (when (find-package package) (delete-package package)))
+ '("TB-FOO" "TB-FOO-RENAMED"))
+ (let* ((package (make-package "TB-FOO" :use nil)))
+ (and (eq (rename-package "TB-FOO" "TB-FOO-RENAMED") package)
+ (eq (find-package "TB-FOO-RENAMED") package))))
+(progn
+ (mapcar #'(lambda (package)
+ (when (find-package package) (delete-package package)))
+ '("TB-FOO-0" "TB-FOO-1" "TB-FOO-2" "TB-FOO-3" "TB-FOO-4"))
+ (let* ((package (make-package "TB-FOO-0" :use nil)))
+ (and (eq (rename-package "TB-FOO-0" "TB-FOO-1") package)
+ (eq (rename-package "TB-FOO-1" "TB-FOO-2") package)
+ (eq (rename-package "TB-FOO-2" "TB-FOO-3") package)
+ (eq (rename-package "TB-FOO-3" "TB-FOO-4") package)
+ (eq (find-package "TB-FOO-4") package))))
+(progn
+ (mapcar #'(lambda (package)
+ (when (find-package package) (delete-package package)))
+ '("TB-FOO-0" "TB-FOO-1" "TB-FOO-2" "TB-FOO-3" "TB-FOO-4"))
+ (let* ((package (make-package "TB-FOO-0" :use nil)))
+ (and (eq (rename-package (find-package "TB-FOO-0") "TB-FOO-1") package)
+ (eq (rename-package (find-package "TB-FOO-1") "TB-FOO-2") package)
+ (eq (rename-package (find-package "TB-FOO-2") "TB-FOO-3") package)
+ (eq (rename-package (find-package "TB-FOO-3") "TB-FOO-4") package)
+ (eq (find-package "TB-FOO-4") package))))
+(progn
+ (mapcar #'(lambda (package)
+ (when (find-package package) (delete-package package)))
+ '(#\a #\b))
+ (let ((package (make-package #\a :use nil)))
+ (and (eq (rename-package #\a #\b) package)
+ (eq (find-package #\b) package)
+ (string= (package-name package) #\b))))
+(let ((name-list (list #\a 'b "TB-FOO-0" "TB-FOO-1" 'test-foo-2)))
+ (mapcar #'(lambda (package)
+ (when (find-package package) (delete-package package)))
+ name-list)
+ (let* ((old (pop name-list))
+ (package (make-package old :use nil)))
+ (dolist (new name-list t)
+ (unless (eq (rename-package old new) package)
+ (return nil))
+ (setq old new))))
+(progn
+ (mapcar #'(lambda (package)
+ (when (find-package package) (delete-package package)))
+ '("TB-FOO" "TB-FOO-RENAMED"
+ "TB-FOO-NICKNAME-0" "TB-FOO-NICKNAME-1"))
+ (let* ((package (make-package "TB-FOO"
+ :use nil
+ :nicknames '("TB-FOO-NICKNAME-0"
+ "TB-FOO-NICKNAME-1"))))
+ (and (eq (rename-package "TB-FOO" "TB-FOO-RENAMED") package)
+ (eq (find-package "TB-FOO-RENAMED") package)
+ (null (set-difference (package-nicknames "TB-FOO-RENAMED")
+ '("TB-FOO-NICKNAME-0" "TB-FOO-NICKNAME-1")
+ :test #'string=)))))
+(progn
+ (mapcar #'(lambda (package)
+ (when (find-package package) (delete-package package)))
+ '("TB-FOO-0" "TB-FOO-1" "TB-FOO-2"
+ "TB-FOO-3" "TB-FOO-4" "TB-FOO-5"))
+ (let* ((package (make-package "TB-FOO-0"
+ :use nil
+ :nicknames '("TB-FOO-1" "TB-FOO-2"))))
+ (and (eq (rename-package package "TB-FOO-3" '("TB-FOO-4" "TB-FOO-5"))
+ package)
+ (eq (find-package "TB-FOO-3") package)
+ (eq (find-package "TB-FOO-4") package)
+ (eq (find-package "TB-FOO-5") package)
+ (not (every #'find-package
+ '("TB-FOO-0" "TB-FOO-1" "TB-FOO-2"))))))
+(progn
+ (mapcar #'(lambda (package)
+ (when (find-package package) (delete-package package)))
+ '("TB-FOO-0" "TB-FOO-1" "TB-FOO-2"))
+ (let* ((package (make-package "TB-FOO-0" :use nil :nicknames '("TB-FOO-1"))))
+ (eq (rename-package package "TB-FOO-1" '("TB-FOO-2")) package)))
+(progn
+ (mapcar #'(lambda (package)
+ (when (find-package package) (delete-package package)))
+ '("TB-FOO-0" "TB-FOO-1" "TB-FOO-2"
+ "TB-FOO-3" "TB-FOO-4" "TB-FOO-5"))
+ (let* ((package (make-package "TB-FOO-0" :use nil :nicknames '("TB-FOO-1"))))
+ (and (eq (rename-package package "TB-FOO-1" '("TB-FOO-2")) package)
+ (eq (rename-package package "TB-FOO-2" '("TB-FOO-3")) package)
+ (eq (rename-package package "TB-FOO-3" '("TB-FOO-4")) package)
+ (eq (rename-package package "TB-FOO-4" '("TB-FOO-5")) package)
+ (eq (rename-package package "TB-FOO-5" '("TB-FOO-0")) package)
+ (eq (find-package 'test-foo-5) (find-package 'test-foo-0)))))
+(progn
+ (mapcar #'(lambda (package)
+ (when (find-package package) (delete-package package)))
+ '("TB-FOO-0" "TB-FOO-1" "TB-FOO-2"))
+ (let* ((package (make-package "TB-FOO-0" :use nil
+ :nicknames '("TB-FOO-1" "TB-FOO-2"))))
+ (and (eq (rename-package package "TB-FOO-2" '("TB-FOO-3" "TB-FOO-1"))
+ package)
+ (string= (package-name package) "TB-FOO-2")
+ (null (set-difference (package-nicknames package)
+ '("TB-FOO-3" "TB-FOO-1")
+ :test #'string=)))))
+(progn
+ (mapcar #'(lambda (package)
+ (when (find-package package) (delete-package package)))
+ '("TB-FOO-0" "TB-FOO-1" "TB-FOO-2"))
+ (let* ((package (make-package "TB-FOO-0" :use nil
+ :nicknames '("TB-FOO-1" "TB-FOO-2"))))
+ (and (eq (rename-package package "TB-FOO-3") package)
+ (string= (package-name package) "TB-FOO-3")
+ (null (package-nicknames package)))))
+
+
+;; find-symbol
+(equal (multiple-value-list (find-symbol "CAR" "CL")) '(cl:car :EXTERNAL))
+(equal (multiple-value-list (find-symbol "CDR" "CL")) '(cl:cdr :EXTERNAL))
+(equal (multiple-value-list (find-symbol "CDR" 'cl)) '(cl:cdr :EXTERNAL))
+(equal (multiple-value-list (find-symbol "CDR" (find-package 'cl)))
+ '(cl:cdr :EXTERNAL))
+(equal (multiple-value-list (find-symbol "NIL" "CL")) '(nil :EXTERNAL))
+(let ((*package* (find-package 'cl)))
+ (equal (multiple-value-list (find-symbol "CDR")) '(cl:cdr :EXTERNAL)))
+(progn
+ (when (find-package "A") (delete-package "A"))
+ (make-package "A" :use nil)
+ (equal (multiple-value-list (find-symbol "A" #\A)) '(nil nil)))
+(progn
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (make-package "TB-FOO" :use nil)
+ (equal (multiple-value-list (find-symbol "A" "TB-FOO")) '(nil nil)))
+(progn
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (make-package "TB-FOO" :use nil)
+ (multiple-value-bind (symbol0 status0) (intern "A" "TB-FOO")
+ (multiple-value-bind (symbol1 status1) (find-symbol "A" "TB-FOO")
+ (and (eq symbol0 symbol1)
+ (null status0)
+ (eq status1 :internal)))))
+(progn
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (make-package "TB-FOO" :use '("CL"))
+ (equal (multiple-value-list (find-symbol "CAR" "TB-FOO"))
+ '(cl:car :inherited)))
+(do-external-symbols (symbol "CL" t)
+ (multiple-value-bind (symbol-found status)
+ (find-symbol (symbol-name symbol) "COMMON-LISP-USER")
+ (unless (and (eq symbol symbol-found) (eq status :inherited))
+ (error "Symbol ~S is ~S" symbol-found status))))
+(progn
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (let ((*package* (make-package "TB-FOO" :use '("COMMON-LISP"))))
+ (and (equal (multiple-value-list (find-symbol "APPEND"))
+ '(cl:append :inherited))
+ (equal (multiple-value-list (find-symbol "FIND"))
+ '(cl:find :inherited))
+ (equal (multiple-value-list (find-symbol "CAR"))
+ '(cl:car :inherited)))))
+(equal (multiple-value-list (find-symbol "NIL" 'cl)) '(nil :external))
+(progn
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (let* ((*package* (make-package "TB-FOO" :use (list 'cl)))
+ (symbol (intern "car" *package*)))
+ (and (equal (multiple-value-list (find-symbol "car"))
+ (list symbol :internal))
+ (equal (multiple-value-list (find-symbol "CAR"))
+ (list 'cl:car :inherited)))))
+
+
+;; find-all-symbols
+(member 'cl:car (find-all-symbols 'car))
+(member 'cl:cdr (find-all-symbols "CDR"))
+(every #'symbolp (find-all-symbols "LOOP"))
+(every #'(lambda (name) (string= name "FIND"))
+ (mapcar #'symbol-name (find-all-symbols "FIND")))
+(dolist (name (list "CAR" "CDR" #\a #\A 'common-lisp 'join "" "XXX" "aA"
+ "LONGLONGLONGLONGLONGLONGLONGLONGLONGLONG"
+ 'long-long-long-long-long-long-name) t)
+ (unless (every #'(lambda (symbol-name) (string= symbol-name name))
+ (mapcar #'symbol-name (find-all-symbols name)))
+ (return nil)))
+
+
+;; intern
+(symbolp (intern "SYMBOL"))
+(symbolp (intern "long-long-name-in-lower-case"))
+(equal (multiple-value-list (intern "NIL" 'cl)) '(nil :external))
+(multiple-value-bind (boo status) (intern "BOO")
+ (and (symbolp boo)
+ (member status '(nil :internal :external :inherited))
+ (string= (symbol-name boo) "BOO")))
+(let ((*package* (find-package "CL")))
+ (equal (multiple-value-list (intern "CAR")) '(cl:car :external)))
+(let ((*package* (find-package "KEYWORD")))
+ (equal (multiple-value-list (intern "TEST")) '(:test :external)))
+(progn
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (make-package "TB-FOO" :use nil)
+ (and (multiple-value-list (intern "BOO" 'tb-foo))
+ (list (find-symbol "BOO" 'tb-foo) nil)
+ (eq (symbol-package (find-symbol "BOO" 'tb-foo)) (find-package 'tb-foo))))
+(progn
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (let ((*package* (make-package "TB-FOO" :use '(cl))))
+ (and (eq (intern "CAR") 'cl:car)
+ (equal (multiple-value-list (intern "ZZZ"))
+ (list (find-symbol "ZZZ") nil))
+ (equal (multiple-value-list (intern "ZZZ"))
+ (list (find-symbol "ZZZ") :internal))
+ (export (find-symbol "ZZZ"))
+ (equal (multiple-value-list (intern "ZZZ"))
+ (list (find-symbol "ZZZ") :external)))))
+
+;; export
+(eq (export ()) t)
+(progn
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (let ((*package* (make-package "TB-FOO" :use nil))
+ buz)
+ (and (setq buz (intern "BUZ"))
+ (equal (multiple-value-list (find-symbol "BUZ")) (list buz :internal))
+ (eq (export buz) t)
+ (equal (multiple-value-list (find-symbol "BUZ"))
+ (list buz :external)))))
+(progn
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (let ((*package* (make-package "TB-FOO" :use '(cl))))
+ (and (equal (multiple-value-list (find-symbol "CAR")) '(cl:car :inherited))
+ (eq (export 'cl:car) t)
+ (equal (multiple-value-list (find-symbol "CAR")) '(cl:car :external)))))
+(progn
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (let ((*package* (make-package "TB-FOO" :use '(cl))))
+ (and (equal (multiple-value-list (find-symbol "CAR")) '(cl:car :inherited))
+ (eq (export '(cl:car)) t)
+ (equal (multiple-value-list (find-symbol "CAR")) '(cl:car :external)))))
+(progn
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (let ((*package* (make-package "TB-FOO" :use '(cl))))
+ (and (equal (multiple-value-list (find-symbol "CAR")) '(cl:car :inherited))
+ (equal (multiple-value-list (find-symbol "CDR")) '(cl:cdr :inherited))
+ (eq (export '(cl:car cl:cdr)) t)
+ (equal (multiple-value-list (find-symbol "CAR")) '(cl:car :external))
+ (equal (multiple-value-list (find-symbol "CDR")) '(cl:cdr :external)))))
+(progn
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (let ((*package* (make-package "TB-FOO" :use '(cl)))
+ (buz (make-symbol "BUZ")))
+ (import buz)
+ (and (equal (multiple-value-list (find-symbol "CAR")) '(cl:car :inherited))
+ (equal (multiple-value-list (find-symbol "CDR")) '(cl:cdr :inherited))
+ (equal (multiple-value-list (find-symbol "BUZ")) (list buz :internal))
+ (eq (export (list 'cl:car buz 'cl:cdr)) t)
+ (equal (multiple-value-list (find-symbol "CAR")) '(cl:car :external))
+ (equal (multiple-value-list (find-symbol "CDR")) '(cl:cdr :external))
+ (equal (multiple-value-list (find-symbol "BUZ"))
+ (list buz :external)))))
+(progn
+ (when (find-package "A") (delete-package "A"))
+ (make-package "A" :use nil)
+ (import 'cl:car "A")
+ (and (eq (export 'cl:car "A") t)
+ (equal (multiple-value-list (find-symbol "CAR" "A"))
+ '(cl:car :external))))
+(progn
+ (when (find-package "A") (delete-package "A"))
+ (make-package "A" :use nil)
+ (import 'cl:car "A")
+ (and (eq (export 'cl:car #\A) t)
+ (equal (multiple-value-list (find-symbol "CAR" "A"))
+ '(cl:car :external))))
+(progn
+ (when (find-package "A") (delete-package "A"))
+ (make-package "A" :use nil)
+ (import 'cl:car "A")
+ (and (eq (export 'cl:car 'a) t)
+ (equal (multiple-value-list (find-symbol "CAR" "A"))
+ '(cl:car :external))))
+(progn
+ (when (find-package "A") (delete-package "A"))
+ (make-package "A" :use nil)
+ (import 'cl:car "A")
+ (and (eq (export 'cl:car (find-package 'a)) t)
+ (equal (multiple-value-list (find-symbol "CAR" "A"))
+ '(cl:car :external))))
+(progn
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (let ((*package* (make-package "TB-FOO" :use '(cl))))
+ (and (equal (multiple-value-list (find-symbol "CAR")) '(cl:car :inherited))
+ (eq (export 'cl:car) t)
+ (equal (multiple-value-list (find-symbol "CAR")) '(cl:car :external))
+ (unuse-package 'cl)
+ (equal (multiple-value-list (find-symbol "CAR")) '(cl:car :external)))))
+(progn
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (when (find-package "TB-BAR-TO-USE")
+ (mapcan #'delete-package (package-used-by-list "TB-BAR-TO-USE"))
+ (delete-package "TB-BAR-TO-USE"))
+ (make-package "TB-BAR-TO-USE" :use nil)
+ (make-package "TB-FOO" :use '("TB-BAR-TO-USE"))
+ (let ((buz (intern "BUZ" 'tb-bar-to-use)))
+ (and (equal (multiple-value-list (find-symbol "BUZ" 'tb-foo)) '(nil nil))
+ (export buz 'tb-bar-to-use)
+ (equal (multiple-value-list (find-symbol "BUZ" 'tb-foo))
+ (list buz :inherited)))))
+(HANDLER-CASE
+ (PROGN
+ (WHEN (FIND-PACKAGE "TB-FOO") (DELETE-PACKAGE "TB-FOO"))
+ (MAKE-PACKAGE "TB-FOO" :USE NIL)
+ (EXPORT 'CAR "TB-FOO"))
+ (PACKAGE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE
+ (PROGN
+ (WHEN (FIND-PACKAGE "TB-FOO") (DELETE-PACKAGE "TB-FOO"))
+ (WHEN (FIND-PACKAGE "TB-BAR-TO-USE")
+ (MAPCAN #'DELETE-PACKAGE (PACKAGE-USED-BY-LIST "TB-BAR-TO-USE"))
+ (DELETE-PACKAGE "TB-BAR-TO-USE"))
+ (MAKE-PACKAGE "TB-BAR-TO-USE" :USE NIL)
+ (MAKE-PACKAGE "TB-FOO" :USE '("TB-BAR-TO-USE"))
+ (INTERN "BUZ" 'TB-FOO)
+ (LET ((BUZ (INTERN "BUZ" 'TB-BAR-TO-USE)))
+ (EXPORT BUZ 'TB-BAR-TO-USE)))
+ (PACKAGE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+
+
+;; unexport
+(progn
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (let ((*package* (make-package "TB-FOO" :use nil))
+ buz)
+ (and (export (setq buz (intern "BUZ")))
+ (equal (multiple-value-list (find-symbol "BUZ")) (list buz :external))
+ (eq (unexport buz) t)
+ (equal (multiple-value-list (find-symbol "BUZ"))
+ (list buz :internal)))))
+(progn
+ (when (find-package "A") (delete-package "A"))
+ (make-package "A" :use nil)
+ (let (buz)
+ (and (export (setq buz (intern "BUZ" 'a)) 'a)
+ (equal (multiple-value-list (find-symbol "BUZ" 'a))
+ (list buz :external))
+ (eq (unexport buz 'a) t)
+ (equal (multiple-value-list (find-symbol "BUZ" 'a))
+ (list buz :internal)))))
+(progn
+ (when (find-package "A") (delete-package "A"))
+ (make-package "A" :use nil)
+ (let (buz)
+ (and (export (setq buz (intern "BUZ" 'a)) 'a)
+ (equal (multiple-value-list (find-symbol "BUZ" 'a))
+ (list buz :external))
+ (eq (unexport buz #\A) t)
+ (equal (multiple-value-list (find-symbol "BUZ" 'a))
+ (list buz :internal)))))
+(progn
+ (when (find-package "A") (delete-package "A"))
+ (make-package "A" :use nil)
+ (let (buz)
+ (and (export (setq buz (intern "BUZ" 'a)) 'a)
+ (equal (multiple-value-list (find-symbol "BUZ" 'a))
+ (list buz :external))
+ (eq (unexport buz "A") t)
+ (equal (multiple-value-list (find-symbol "BUZ" 'a))
+ (list buz :internal)))))
+(progn
+ (when (find-package "A") (delete-package "A"))
+ (make-package "A" :use nil)
+ (let (buz)
+ (and (export (setq buz (intern "BUZ" 'a)) 'a)
+ (equal (multiple-value-list (find-symbol "BUZ" 'a))
+ (list buz :external))
+ (eq (unexport buz (find-package "A")) t)
+ (equal (multiple-value-list (find-symbol "BUZ" 'a))
+ (list buz :internal)))))
+(progn
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (make-package "TB-FOO" :use nil)
+ (let (buz)
+ (and (export (setq buz (intern "BUZ" 'tb-foo)) 'tb-foo)
+ (equal (multiple-value-list (find-symbol "BUZ" 'tb-foo))
+ (list buz :external))
+ (eq (unexport buz 'tb-foo) t)
+ (equal (multiple-value-list (find-symbol "BUZ" 'tb-foo))
+ (list buz :internal)))))
+(progn
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (let* ((*package* (make-package "TB-FOO" :use nil))
+ (names '("A" "BC" "DEF" "GHIJ"))
+ (symbols (mapcar #'intern names)))
+ (and (export symbols)
+ (eq (unexport symbols) t)
+ (every #'(lambda (status) (eq status :internal))
+ (mapcar #'(lambda (name)
+ (cadr (multiple-value-list (find-symbol name))))
+ names)))))
+(progn
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (let* ((*package* (make-package "TB-FOO" :use nil)))
+ (import '(cl:nil))
+ (export '(cl:nil))
+ (and (eq (unexport 'cl:nil) t)
+ (equal (multiple-value-list (find-symbol "NIL")) '(cl:nil :external)))))
+(progn
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (let* ((*package* (make-package "TB-FOO" :use nil)))
+ (import '(cl:nil))
+ (export '(cl:nil))
+ (and (eq (unexport '(cl:nil)) t)
+ (equal (multiple-value-list (find-symbol "NIL")) '(nil :internal)))))
+(progn
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (let* ((*package* (make-package "TB-FOO" :use nil))
+ (baz (intern "BAZ" *package*)))
+ (and
+ (equal (multiple-value-list (find-symbol "BAZ")) (list baz :internal))
+ (eq (unexport (list baz) *package*) t)
+ (equal (multiple-value-list (find-symbol "BAZ")) (list baz :internal)))))
+(progn
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (let* ((*package* (make-package "TB-FOO" :use nil))
+ (baz (intern "BAZ" *package*))
+ (woo (intern "WOO" *package*)))
+ (export woo)
+ (and
+ (equal (multiple-value-list (find-symbol "BAZ")) (list baz :internal))
+ (equal (multiple-value-list (find-symbol "WOO")) (list woo :external))
+ (eq (unexport (list baz woo) *package*) t)
+ (equal (multiple-value-list (find-symbol "BAZ")) (list baz :internal))
+ (equal (multiple-value-list (find-symbol "WOO")) (list woo :internal)))))
+(HANDLER-CASE
+ (PROGN
+ (WHEN (FIND-PACKAGE "TB-FOO") (DELETE-PACKAGE "TB-FOO"))
+ (LET* ((*PACKAGE* (MAKE-PACKAGE "TB-FOO" :USE NIL)))
+ (UNEXPORT 'CAR)))
+ (PACKAGE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE
+ (PROGN
+ (WHEN (FIND-PACKAGE "TB-FOO") (DELETE-PACKAGE "TB-FOO"))
+ (LET* ((*PACKAGE* (MAKE-PACKAGE "TB-FOO" :USE NIL))
+ (BAZ (INTERN "BAZ" *PACKAGE*))
+ (WOO (INTERN "WOO" *PACKAGE*)))
+ (EXPORT WOO)
+ (UNEXPORT (LIST BAZ 'NIL WOO) *PACKAGE*)))
+ (PACKAGE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+
+
+
+
+;; shadow
+(eq (shadow '()) t)
+(progn
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (make-package "TB-FOO" :use nil)
+ (and (eq (shadow "A" 'tb-foo) t)
+ (eq (cadr (multiple-value-list (find-symbol "A" 'tb-foo))) :internal)
+ (equal (package-shadowing-symbols 'tb-foo)
+ (list (find-symbol "A" 'tb-foo)))))
+(eq (shadow '()) t)
+(progn
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (make-package "TB-FOO" :use nil)
+ (and (eq (shadow #\A 'tb-foo) t)
+ (eq (cadr (multiple-value-list (find-symbol "A" 'tb-foo))) :internal)
+ (equal (package-shadowing-symbols 'tb-foo)
+ (list (find-symbol "A" 'tb-foo)))))
+(eq (shadow '()) t)
+(progn
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (make-package "TB-FOO" :use nil)
+ (and (eq (shadow 'a 'tb-foo) t)
+ (eq (cadr (multiple-value-list (find-symbol "A" 'tb-foo))) :internal)
+ (equal (package-shadowing-symbols 'tb-foo)
+ (list (find-symbol "A" 'tb-foo)))))
+(progn
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (make-package "TB-FOO" :use nil)
+ (and (eq (shadow '(a) 'tb-foo) t)
+ (eq (cadr (multiple-value-list (find-symbol "A" 'tb-foo))) :internal)
+ (equal (package-shadowing-symbols 'tb-foo)
+ (list (find-symbol "A" 'tb-foo)))))
+(progn
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (make-package "TB-FOO" :use nil)
+ (and (eq (shadow '("A") 'tb-foo) t)
+ (eq (cadr (multiple-value-list (find-symbol "A" 'tb-foo))) :internal)
+ (equal (package-shadowing-symbols 'tb-foo)
+ (list (find-symbol "A" 'tb-foo)))))
+(progn
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (make-package "TB-FOO" :use nil)
+ (and (eq (shadow '(#\A) 'tb-foo) t)
+ (eq (cadr (multiple-value-list (find-symbol "A" 'tb-foo))) :internal)
+ (equal (package-shadowing-symbols 'tb-foo)
+ (list (find-symbol "A" 'tb-foo)))))
+(progn
+ (when (find-package "A") (delete-package "A"))
+ (make-package "A" :use nil)
+ (and (eq (shadow "BUZ" #\A) t)
+ (eq (cadr (multiple-value-list (find-symbol "BUZ" 'a))) :internal)
+ (equal (package-shadowing-symbols 'a)
+ (list (find-symbol "BUZ" 'a)))))
+(progn
+ (when (find-package "A") (delete-package "A"))
+ (make-package "A" :use nil)
+ (and (eq (shadow "BUZ" "A") t)
+ (eq (cadr (multiple-value-list (find-symbol "BUZ" 'a))) :internal)
+ (equal (package-shadowing-symbols 'a)
+ (list (find-symbol "BUZ" 'a)))))
+(progn
+ (when (find-package "A") (delete-package "A"))
+ (make-package "A" :use nil)
+ (and (eq (shadow "BUZ" 'a) t)
+ (eq (cadr (multiple-value-list (find-symbol "BUZ" 'a))) :internal)
+ (equal (package-shadowing-symbols 'a)
+ (list (find-symbol "BUZ" 'a)))))
+(progn
+ (when (find-package "A") (delete-package "A"))
+ (make-package "A" :use nil)
+ (and (eq (shadow "BUZ" (find-package 'a)) t)
+ (eq (cadr (multiple-value-list (find-symbol "BUZ" 'a))) :internal)
+ (equal (package-shadowing-symbols 'a)
+ (list (find-symbol "BUZ" 'a)))))
+(progn
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (let ((*package* (make-package "TB-FOO" :use nil))
+ (names '(a #\B "C" "BUZ")))
+ (and (eq (shadow names) t)
+ (every #'(lambda (name)
+ (eq (cadr (multiple-value-list (find-symbol name)))
+ :internal))
+ names)
+ (null (set-difference (mapcar #'find-symbol (mapcar #'string names))
+ (package-shadowing-symbols *package*))))))
+(progn
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (let ((*package* (make-package "TB-FOO" :use '(cl)))
+ (names '(a #\B "C" "BUZ" "CAR"))
+ a b c)
+ (setq a (intern "A"))
+ (export (setq b (intern "B")))
+ (shadowing-import (setq c (intern "C")))
+ (and (eq (shadow names) t)
+ (equal (multiple-value-list (find-symbol "A")) (list a :internal))
+ (equal (multiple-value-list (find-symbol "B")) (list b :external))
+ (equal (multiple-value-list (find-symbol "C")) (list c :internal))
+ (eq (cadr (multiple-value-list (find-symbol "BUZ"))) :internal)
+ (eq (cadr (multiple-value-list (find-symbol "CAR"))) :internal)
+ (not (eq (car (multiple-value-list (find-symbol "CAR"))) 'cl:car))
+ (null (set-difference (mapcar #'find-symbol (mapcar #'string names))
+ (package-shadowing-symbols *package*))))))
+
+
+
+
+;; shadowing-import
+(eq (shadowing-import '()) t)
+(progn
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (shadowing-import '() (make-package "TB-FOO" :use nil))
+ (let ((list nil))
+ (null (do-symbols (symbol "TB-FOO" list) (push symbol list)))))
+(progn
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (let ((*package* (make-package "TB-FOO" :use nil)))
+ (and (not (find-symbol "CAR"))
+ (not (find-symbol "CDR"))
+ (not (find-symbol "LIST"))
+ (eq (shadowing-import '(cl:car cl:cdr cl:list)) t)
+ (eq (find-symbol "CAR") 'cl:car)
+ (eq (find-symbol "CDR") 'cl:cdr)
+ (eq (find-symbol "LIST") 'cl:list))))
+(progn
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (let* ((*package* (make-package "TB-FOO" :use (list 'cl)))
+ (names '("CAR" "CDR" "LIST" "APPEND"))
+ (symbols (mapcar #'make-symbol names)))
+ (and (eq (shadowing-import symbols) t)
+ (every #'eq symbols (mapcar #'find-symbol names))
+ (every #'(lambda (symbol)
+ (member symbol (package-shadowing-symbols *package*)))
+ symbols))))
+(progn
+ (when (find-package "A") (delete-package "A"))
+ (make-package "A" :use nil)
+ (let ((symbol (make-symbol "CAR")))
+ (and (eq (shadowing-import symbol "A") t)
+ (equal (multiple-value-list (find-symbol "CAR" "A"))
+ (list symbol :internal)))))
+(progn
+ (when (find-package "A") (delete-package "A"))
+ (make-package "A" :use nil)
+ (let ((symbol (make-symbol "CAR")))
+ (and (eq (shadowing-import symbol #\A) t)
+ (equal (multiple-value-list (find-symbol "CAR" "A"))
+ (list symbol :internal)))))
+(progn
+ (when (find-package "A") (delete-package "A"))
+ (make-package "A" :use nil)
+ (let ((symbol (make-symbol "CAR")))
+ (and (eq (shadowing-import symbol 'a) t)
+ (equal (multiple-value-list (find-symbol "CAR" "A"))
+ (list symbol :internal)))))
+(progn
+ (when (find-package "A") (delete-package "A"))
+ (make-package "A" :use nil)
+ (let ((symbol (make-symbol "CAR")))
+ (and (eq (shadowing-import symbol (find-package 'a)) t)
+ (equal (multiple-value-list (find-symbol "CAR" "A"))
+ (list symbol :internal)))))
+(progn
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (make-package "TB-FOO" :use nil)
+ (let ((buz0 (intern "BUZ" 'tb-foo))
+ (buz1 (make-symbol "BUZ")))
+ (and (equal (multiple-value-list (find-symbol "BUZ" 'tb-foo))
+ (list buz0 :internal))
+ (eq (shadowing-import buz1 'tb-foo) t)
+
+ (equal (multiple-value-list (find-symbol "BUZ" 'tb-foo))
+ (list buz1 :internal))
+ (equal (list buz1) (package-shadowing-symbols 'tb-foo))
+ (unintern buz1 'tb-foo)
+ (equal (multiple-value-list (find-symbol "BUZ" 'tb-foo)) '(nil nil))
+ (null (package-shadowing-symbols 'tb-foo)))))
+(progn
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (make-package "TB-FOO" :use nil)
+ (let ((buz0 (intern "BUZ" 'tb-foo))
+ (buz1 (make-symbol "BUZ")))
+ (shadow buz0 'tb-foo)
+ (and (equal (multiple-value-list (find-symbol "BUZ" 'tb-foo))
+ (list buz0 :internal))
+ (eq (shadowing-import buz1 'tb-foo) t)
+
+ (equal (multiple-value-list (find-symbol "BUZ" 'tb-foo))
+ (list buz1 :internal))
+ (equal (list buz1) (package-shadowing-symbols 'tb-foo))
+ (unintern buz1 'tb-foo)
+ (equal (multiple-value-list (find-symbol "BUZ" 'tb-foo)) '(nil nil))
+ (null (package-shadowing-symbols 'tb-foo)))))
+(progn
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (make-package "TB-FOO" :use nil)
+ (let ((buz0 (intern "BUZ" 'tb-foo))
+ (buz1 (make-symbol "BUZ")))
+ (export buz0 'tb-foo)
+ (and (equal (multiple-value-list (find-symbol "BUZ" 'tb-foo))
+ (list buz0 :external))
+ (eq (shadowing-import buz1 'tb-foo) t)
+
+ (equal (multiple-value-list (find-symbol "BUZ" 'tb-foo))
+ (list buz1 :internal))
+ (equal (list buz1) (package-shadowing-symbols 'tb-foo))
+ (unintern buz1 'tb-foo)
+ (equal (multiple-value-list (find-symbol "BUZ" 'tb-foo)) '(nil nil))
+ (null (package-shadowing-symbols 'tb-foo)))))
+(progn
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (make-package "TB-FOO" :use nil)
+ (let ((buz0 (intern "BUZ" 'tb-foo))
+ (buz1 (make-symbol "BUZ")))
+ (export buz0 'tb-foo)
+ (shadow buz0 'tb-foo)
+ (and (equal (multiple-value-list (find-symbol "BUZ" 'tb-foo))
+ (list buz0 :external))
+ (eq (shadowing-import buz1 'tb-foo) t)
+ (equal (multiple-value-list (find-symbol "BUZ" 'tb-foo))
+ (list buz1 :internal))
+ (equal (list buz1) (package-shadowing-symbols 'tb-foo))
+ (unintern buz1 'tb-foo)
+ (equal (multiple-value-list (find-symbol "BUZ" 'tb-foo)) '(nil nil))
+ (null (package-shadowing-symbols 'tb-foo)))))
+
+
+
+;; import
+(eq (import '()) t)
+(progn
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (make-package "TB-FOO" :use nil)
+ (let ((list nil))
+ (and (eq (import '() "TB-FOO") t)
+ (null (do-symbols (symbol "TB-FOO" list) (push symbol list))))))
+(progn
+ (when (find-package "A") (delete-package "A"))
+ (make-package "A" :use nil)
+ (and (not (find-symbol "CAR" 'a))
+ (eq (import 'cl:car 'a) t)
+ (equal (multiple-value-list (find-symbol "CAR" 'a)) '(cl:car :internal))))
+(progn
+ (when (find-package "A") (delete-package "A"))
+ (make-package "A" :use nil)
+ (and (not (find-symbol "CAR" 'a))
+ (eq (import 'cl:car #\A) t)
+ (equal (multiple-value-list (find-symbol "CAR" 'a)) '(cl:car :internal))))
+(progn
+ (when (find-package "A") (delete-package "A"))
+ (make-package "A" :use nil)
+ (and (not (find-symbol "CAR" 'a))
+ (eq (import 'cl:car "A") t)
+ (equal (multiple-value-list (find-symbol "CAR" 'a)) '(cl:car :internal))))
+(progn
+ (when (find-package "A") (delete-package "A"))
+ (make-package "A" :use nil)
+ (and (not (find-symbol "CAR" 'a))
+ (eq (import 'cl:car (find-package "A")) t)
+ (equal (multiple-value-list (find-symbol "CAR" 'a)) '(cl:car :internal))))
+(progn
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (make-package "TB-FOO" :use nil)
+ (and (not (find-symbol "CAR" 'tb-foo))
+ (eq (import 'cl:car 'tb-foo) t)
+ (equal (multiple-value-list (find-symbol "CAR" 'tb-foo))
+ '(cl:car :internal))))
+(progn
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (make-package "TB-FOO" :use nil)
+ (and (not (find-symbol "CAR" 'tb-foo))
+ (eq (import (list 'cl:car 'cl:cdr 'cl:list :test) 'tb-foo) t)
+ (equal (multiple-value-list (find-symbol "CAR" 'tb-foo))
+ '(cl:car :internal))
+ (equal (multiple-value-list (find-symbol "CDR" 'tb-foo))
+ '(cl:cdr :internal))
+ (equal (multiple-value-list (find-symbol "TEST" 'tb-foo))
+ '(:test :internal))))
+(progn
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (let ((*package* (make-package "TB-FOO" :use nil)))
+ (and (not (find-symbol "CAR" 'tb-foo))
+ (eq (import (list 'cl:car 'cl:cdr 'cl:list :test)) t)
+ (equal (multiple-value-list (find-symbol "CAR" 'tb-foo))
+ '(cl:car :internal))
+ (equal (multiple-value-list (find-symbol "CDR" 'tb-foo))
+ '(cl:cdr :internal))
+ (equal (multiple-value-list (find-symbol "TEST" 'tb-foo))
+ '(:test :internal)))))
+(progn
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (let (buz)
+ (make-package "TB-FOO" :use nil)
+ (and (export (setq buz (intern "BUZ" "TB-FOO")) "TB-FOO")
+ (equal (multiple-value-list (find-symbol "BUZ" "TB-FOO"))
+ (list buz :external))
+ (eq (import buz "TB-FOO") t)
+ (equal (multiple-value-list (find-symbol "BUZ" "TB-FOO"))
+ (list buz :external)))))
+(progn
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (let (buz)
+ (make-package "TB-FOO" :use nil)
+ (and (setq buz (intern "BUZ" "TB-FOO"))
+ (equal (multiple-value-list (find-symbol "BUZ" "TB-FOO"))
+ (list buz :internal))
+ (eq (import buz "TB-FOO") t)
+ (equal (multiple-value-list (find-symbol "BUZ" "TB-FOO"))
+ (list buz :internal)))))
+(progn
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (let ((*package* (make-package "TB-FOO" :use '(cl))))
+ (and (equal (multiple-value-list (find-symbol "CAR")) '(cl:car :inherited))
+ (eq (import 'cl:car) t)
+ (equal (multiple-value-list (find-symbol "CAR")) '(cl:car :internal)))))
+(progn
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (make-package "TB-FOO" :use nil)
+ (let ((buz (make-symbol "BUZ")))
+ (and (null (symbol-package buz))
+ (eq (import buz 'tb-foo) t)
+ (eq (symbol-package buz) (find-package 'tb-foo)))))
+(HANDLER-CASE
+ (PROGN
+ (WHEN (FIND-PACKAGE "TB-FOO") (DELETE-PACKAGE "TB-FOO"))
+ (LET ((*PACKAGE* (MAKE-PACKAGE "TB-FOO" :USE '(CL))))
+ (IMPORT (MAKE-SYMBOL "CAR"))))
+ (PACKAGE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE
+ (PROGN
+ (WHEN (FIND-PACKAGE "TB-FOO") (DELETE-PACKAGE "TB-FOO"))
+ (LET ((*PACKAGE* (MAKE-PACKAGE "TB-FOO" :USE NIL)))
+ (INTERN "BUZ")
+ (IMPORT (MAKE-SYMBOL "BUZ"))))
+ (PACKAGE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE
+ (PROGN
+ (WHEN (FIND-PACKAGE "TB-FOO") (DELETE-PACKAGE "TB-FOO"))
+ (LET ((*PACKAGE* (MAKE-PACKAGE "TB-FOO" :USE NIL)))
+ (EXPORT (INTERN "BUZ"))
+ (IMPORT (MAKE-SYMBOL "BUZ"))))
+ (PACKAGE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE
+ (PROGN
+ (WHEN (FIND-PACKAGE "TB-FOO") (DELETE-PACKAGE "TB-FOO"))
+ (LET ((*PACKAGE* (MAKE-PACKAGE "TB-FOO" :USE NIL)))
+ (SHADOWING-IMPORT (MAKE-SYMBOL "BUZ"))
+ (IMPORT (MAKE-SYMBOL "BUZ"))))
+ (PACKAGE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+
+
+
+;; unintern
+(progn
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (make-package "TB-FOO" :use nil)
+ (not (unintern 'cl:car "TB-FOO")))
+(progn
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (make-package "TB-FOO" :use nil)
+ (and (unintern (intern "BUZ" "TB-FOO") "TB-FOO")
+ (not (find-symbol "BUZ" "TB-FOO"))))
+(progn
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (let ((*package* (make-package "TB-FOO" :use nil)))
+ (not (unintern 'cl:car))))
+(progn
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (let ((*package* (make-package "TB-FOO" :use nil)))
+ (and (unintern (intern "BUZ"))
+ (not (find-symbol "BUZ")))))
+(progn
+ (when (find-package "A") (delete-package "A"))
+ (make-package "A" :use nil)
+ (and (unintern (intern "BUZ" "A") #\A)
+ (not (find-symbol "BUZ" "A"))))
+(progn
+ (when (find-package "A") (delete-package "A"))
+ (make-package "A" :use nil)
+ (and (unintern (intern "BUZ" "A") "A")
+ (not (find-symbol "BUZ" "A"))))
+(progn
+ (when (find-package "A") (delete-package "A"))
+ (make-package "A" :use nil)
+ (and (unintern (intern "BUZ" "A") 'a)
+ (not (find-symbol "BUZ" "A"))))
+(progn
+ (when (find-package "A") (delete-package "A"))
+ (make-package "A" :use nil)
+ (and (unintern (intern "BUZ" "A") (find-package 'a))
+ (not (find-symbol "BUZ" "A"))))
+(progn
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (let ((*package* (make-package "TB-FOO" :use '(cl))))
+ (and (equal (multiple-value-list (find-symbol "CAR")) '(cl:car :inherited))
+ (not (unintern 'cl:car)))))
+(progn
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (let ((*package* (make-package "TB-FOO" :use nil)))
+ (and (import 'cl:car)
+ (equal (multiple-value-list (find-symbol "CAR")) '(cl:car :internal))
+ (unintern 'cl:car)
+ (not (find-symbol "CAR")))))
+(progn
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (let ((*package* (make-package "TB-FOO" :use '(cl))))
+ (and (equal (multiple-value-list (find-symbol "CAR")) '(cl:car :inherited))
+ (import 'cl:car)
+ (equal (multiple-value-list (find-symbol "CAR")) '(cl:car :internal))
+ (unintern 'cl:car)
+ (equal (multiple-value-list (find-symbol "CAR"))
+ '(cl:car :inherited)))))
+(progn
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (let ((*package* (make-package "TB-FOO" :use nil))
+ (buz (make-symbol "BUZ")))
+ (and (null (symbol-package buz))
+ (import buz)
+ (shadow buz)
+ (eq (symbol-package buz) *package*)
+ (member buz (package-shadowing-symbols *package*))
+ (unintern buz)
+ (not (find-symbol "BUZ"))
+ (not (member buz (package-shadowing-symbols *package*)))
+ (null (symbol-package buz)))))
+(HANDLER-CASE
+ (PROGN
+ (WHEN (FIND-PACKAGE "TB-FOO") (DELETE-PACKAGE "TB-FOO"))
+ (WHEN (FIND-PACKAGE "TB-BAR-TO-USE")
+ (MAPCAN #'DELETE-PACKAGE (PACKAGE-USED-BY-LIST "TB-BAR-TO-USE"))
+ (DELETE-PACKAGE "TB-BAR-TO-USE"))
+ (LET ((*PACKAGE* (MAKE-PACKAGE "TB-FOO" :USE NIL)) SYMBOL)
+ (AND (SETQ SYMBOL (INTERN "CAR"))
+ (SHADOW "CAR")
+ (MAKE-PACKAGE "TB-BAR-TO-USE" :USE NIL)
+ (EXPORT (INTERN "CAR" "TB-BAR-TO-USE") "TB-BAR-TO-USE")
+ (USE-PACKAGE (LIST "TB-BAR-TO-USE" "CL"))
+ (EQUAL (MULTIPLE-VALUE-LIST (FIND-SYMBOL "CAR"))
+ (LIST SYMBOL :INTERNAL))
+ (UNINTERN SYMBOL))))
+ (PACKAGE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(progn
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (when (find-package "TB-BAR-TO-USE")
+ (mapcan #'delete-package (package-used-by-list "TB-BAR-TO-USE"))
+ (delete-package "TB-BAR-TO-USE"))
+ (let ((*package* (make-package "TB-FOO" :use nil))
+ symbol)
+ (and (setq symbol (intern "CAR"))
+ (shadow "CAR")
+ (make-package "TB-BAR-TO-USE" :use nil)
+ (import 'cl:car "TB-BAR-TO-USE")
+ (export 'cl:car "TB-BAR-TO-USE")
+ (use-package (list "TB-BAR-TO-USE" "CL"))
+ (equal (multiple-value-list (find-symbol "CAR"))
+ (list symbol :internal))
+ (unintern symbol))))
+
+
+
+;; use-package
+(progn
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (let ((*package* (make-package "TB-FOO" :use nil)))
+ (and (not (find-symbol "CAR"))
+ (eq (use-package 'cl) t)
+ (find-symbol "CAR"))))
+(progn
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (let ((*package* (make-package "TB-FOO" :use nil)))
+ (and (not (find-symbol "CAR"))
+ (eq (use-package "COMMON-LISP") t)
+ (find-symbol "CAR"))))
+(progn
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (let ((*package* (make-package "TB-FOO" :use nil)))
+ (and (not (find-symbol "CAR"))
+ (eq (use-package (find-package "COMMON-LISP")) t)
+ (find-symbol "CAR"))))
+(progn
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (let ((*package* (make-package "TB-FOO" :use nil)))
+ (and (not (find-symbol "CAR"))
+ (eq (use-package '(cl)) t)
+ (find-symbol "CAR"))))
+(progn
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (let ((*package* (make-package "TB-FOO" :use nil)))
+ (and (not (find-symbol "CAR"))
+ (eq (use-package '("COMMON-LISP")) t)
+ (find-symbol "CAR"))))
+(progn
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (let ((*package* (make-package "TB-FOO" :use nil)))
+ (and (not (find-symbol "CAR"))
+ (eq (use-package (list (find-package "COMMON-LISP"))) t)
+ (find-symbol "CAR"))))
+(progn
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (let ((package (make-package "TB-FOO" :use nil))
+ (*package* (find-package 'cl-user)))
+ (and (not (find-symbol "CAR" package))
+ (eq (use-package (list (find-package "COMMON-LISP")) package) t)
+ (find-symbol "CAR" package))))
+(progn
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (let ((package (make-package "TB-FOO" :use nil))
+ (*package* (find-package 'cl-user)))
+ (and (not (find-symbol "CAR" package))
+ (eq (use-package (list (find-package "COMMON-LISP")) "TB-FOO") t)
+ (find-symbol "CAR" package))))
+(progn
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (let ((package (make-package "TB-FOO" :use nil))
+ (*package* (find-package 'cl-user)))
+ (and (not (find-symbol "CAR" package))
+ (eq (use-package (list (find-package "COMMON-LISP")) 'tb-foo) t)
+ (find-symbol "CAR" package))))
+(progn
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (let ((package (make-package "TB-FOO" :use nil))
+ (*package* (find-package 'cl-user)))
+ (and (not (find-symbol "CAR" package))
+ (eq (use-package (list (find-package "COMMON-LISP"))
+ (find-package 'tb-foo))
+ t)
+ (find-symbol "CAR" package))))
+(progn
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (let ((*package* (make-package "TB-FOO" :use nil)))
+ (and (use-package 'cl)
+ (member (find-package 'cl) (package-use-list *package*)))))
+(progn
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (when (find-package "TB-BAR-TO-USE")
+ (mapcan #'delete-package (package-used-by-list "TB-BAR-TO-USE"))
+ (delete-package "TB-BAR-TO-USE"))
+ (let* ((*package* (make-package "TB-FOO" :use nil))
+ boo woo buz)
+ (and (make-package "TB-BAR-TO-USE" :use nil)
+ (export (list (setq boo (intern "BOO" 'tb-bar-to-use))) 'tb-bar-to-use)
+ (setq woo (intern "WOO"))
+ (export (list (setq buz (intern "BUZ"))))
+ (use-package (list 'tb-bar-to-use 'cl))
+ (equal (multiple-value-list (find-symbol "BOO")) (list boo :inherited))
+ (equal (multiple-value-list (find-symbol "WOO")) (list woo :internal))
+ (equal (multiple-value-list (find-symbol "BUZ")) (list buz :external))
+ (equal (multiple-value-list (find-symbol "CAR"))
+ (list 'cl:car :inherited))
+ (equal (multiple-value-list (find-symbol "LIST"))
+ (list 'cl:list :inherited)))))
+(HANDLER-CASE
+ (PROGN
+ (WHEN (FIND-PACKAGE "TB-FOO") (DELETE-PACKAGE "TB-FOO"))
+ (MAKE-PACKAGE "TB-FOO" :USE NIL)
+ (INTERN "CAR" 'TB-FOO)
+ (USE-PACKAGE 'CL 'TB-FOO))
+ (PACKAGE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE
+ (PROGN
+ (WHEN (FIND-PACKAGE "TB-FOO") (DELETE-PACKAGE "TB-FOO"))
+ (MAKE-PACKAGE "TB-FOO" :USE NIL)
+ (EXPORT (INTERN "CAR" 'TB-FOO) 'TB-FOO)
+ (USE-PACKAGE 'CL 'TB-FOO))
+ (PACKAGE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE
+ (PROGN
+ (WHEN (FIND-PACKAGE "TB-FOO") (DELETE-PACKAGE "TB-FOO"))
+ (WHEN (FIND-PACKAGE "TB-BAR-TO-USE")
+ (MAPCAN #'DELETE-PACKAGE (PACKAGE-USED-BY-LIST "TB-BAR-TO-USE"))
+ (DELETE-PACKAGE "TB-BAR-TO-USE"))
+ (MAKE-PACKAGE "TB-FOO" :USE '(CL))
+ (MAKE-PACKAGE "TB-BAR-TO-USE" :USE NIL)
+ (EXPORT (INTERN "CAR" 'TB-BAR-TO-USE) 'TB-BAR-TO-USE)
+ (USE-PACKAGE 'TB-BAR-TO-USE 'TB-FOO))
+ (PACKAGE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+
+
+
+;; unuse-package
+(progn
+ (when (find-package "TB-FOO-TO-USE")
+ (unuse-package (package-use-list "TB-FOO-TO-USE") "TB-FOO-TO-USE"))
+ (when (find-package "TB-BAR-TO-USE")
+ (unuse-package (package-use-list "TB-BAR-TO-USE") "TB-BAR-TO-USE"))
+ (when (find-package "TB-FOO-TO-USE")
+ (mapcan #'delete-package (package-used-by-list "TB-FOO-TO-USE"))
+ (delete-package "TB-FOO-TO-USE"))
+ (when (find-package "TB-BAR-TO-USE")
+ (mapcan #'delete-package (package-used-by-list "TB-BAR-TO-USE"))
+ (delete-package "TB-BAR-TO-USE"))
+ (and (make-package "TB-FOO-TO-USE" :use nil)
+ (make-package "TB-BAR-TO-USE" :use '("TB-FOO-TO-USE"))
+ (use-package "TB-BAR-TO-USE" "TB-FOO-TO-USE")
+ (export (intern "FOO" "TB-FOO-TO-USE") "TB-FOO-TO-USE")
+ (export (intern "BAR" "TB-BAR-TO-USE") "TB-BAR-TO-USE")
+ (eq (cadr (multiple-value-list (find-symbol "FOO" "TB-FOO-TO-USE")))
+ :external)
+ (eq (cadr (multiple-value-list (find-symbol "BAR" "TB-FOO-TO-USE")))
+ :inherited)
+ (eq (cadr (multiple-value-list (find-symbol "FOO" "TB-BAR-TO-USE")))
+ :inherited)
+ (eq (cadr (multiple-value-list (find-symbol "BAR" "TB-BAR-TO-USE")))
+ :external)
+ (unuse-package (package-use-list "TB-FOO-TO-USE") "TB-FOO-TO-USE")
+ (unuse-package (package-use-list "TB-BAR-TO-USE") "TB-BAR-TO-USE")))
+
+
+;; delete-package
+(progn
+ (when (find-package "a") (delete-package "a"))
+ (and (make-package "a" :use nil)
+ (delete-package "a")
+ (not (find-package "a"))))
+(progn
+ (when (find-package "a") (delete-package "a"))
+ (and (make-package "a" :use nil)
+ (delete-package #\a)
+ (not (find-package "a"))))
+(progn
+ (when (find-package "a") (delete-package "a"))
+ (and (make-package "a" :use nil)
+ (delete-package '|a|)
+ (not (find-package "a"))))
+(progn
+ (when (find-package "a") (delete-package "a"))
+ (and (make-package "a" :use nil)
+ (delete-package (find-package '|a|))
+ (not (find-package "a"))))
+(progn
+ (mapc #'(lambda (name) (when (find-package name) (delete-package name)))
+ '("a" "b" "c" "d" "e"))
+ (and (make-package "a" :nicknames '("b" "c" "d" "e") :use nil)
+ (delete-package "a")
+ (not (find-package "a"))
+ (not (find-package "b"))
+ (not (find-package "c"))
+ (not (find-package "d"))
+ (not (find-package "e"))))
+(progn
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (let ((package (make-package "TB-FOO" :use nil)))
+ (and (delete-package "TB-FOO")
+ (not (find-package "TB-FOO"))
+ (packagep package)
+ (null (package-name package)))))
+(progn
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (let ((package (make-package "TB-FOO" :use nil)))
+ (and (delete-package "TB-FOO")
+ (not (member package (list-all-packages))))))
+(progn
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (let ((package (make-package "TB-FOO" :use nil)))
+ (and (delete-package "TB-FOO")
+ (null (delete-package package)))))
+(progn
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (let ((car-home-package (symbol-package 'cl:car)))
+ (and (make-package "TB-FOO" :use nil)
+ (import 'cl:car "TB-FOO")
+ (delete-package 'tb-foo)
+ (eq 'cl:car (find-symbol "CAR" 'cl))
+ (eq (symbol-package 'cl:car) car-home-package)
+ (eq (intern "CAR" 'cl) 'cl:car))))
+(HANDLER-CASE
+ (PROGN
+ (WHEN (FIND-PACKAGE "TB-FOO") (DELETE-PACKAGE "TB-FOO"))
+ (WHEN (FIND-PACKAGE "TB-BAR-TO-USE")
+ (MAPCAN #'DELETE-PACKAGE (PACKAGE-USED-BY-LIST "TB-BAR-TO-USE"))
+ (DELETE-PACKAGE "TB-BAR-TO-USE"))
+ (AND (MAKE-PACKAGE "TB-BAR-TO-USE" :USE NIL)
+ (MAKE-PACKAGE "TB-FOO" :USE '("TB-BAR-TO-USE"))
+ (DELETE-PACKAGE "TB-BAR-TO-USE")))
+ (PACKAGE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+
+
+;; in-package
+(progn
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (let ((*package* (make-package "TB-FOO" :use nil)))
+ (in-package cl-user)
+ (eq *package* (find-package 'cl-user))))
+(progn
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (let ((*package* (make-package "TB-FOO" :use nil)))
+ (in-package "CL-USER")
+ (eq *package* (find-package 'cl-user))))
+(progn
+ (when (find-package "A") (delete-package "A"))
+ (make-package "A" :use nil)
+ (let ((*package* *package*))
+ (in-package "A")
+ (eq *package* (find-package 'a))))
+(progn
+ (when (find-package "A") (delete-package "A"))
+ (make-package "A" :use nil)
+ (let ((*package* *package*))
+ (in-package #\A)
+ (eq *package* (find-package 'a))))
+(progn
+ (when (find-package "A") (delete-package "A"))
+ (make-package "A" :use nil)
+ (let ((*package* *package*))
+ (in-package a)
+ (eq *package* (find-package 'a))))
+(progn
+ (when (find-package "A") (delete-package "A"))
+ (HANDLER-CASE (PROGN (IN-PACKAGE "A"))
+ (PACKAGE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL)))
+
+
+;; defpackage
+(progn
+ (when (find-package "A") (delete-package "A"))
+ (packagep (defpackage #\A)))
+(progn
+ (when (find-package "A") (delete-package "A"))
+ (packagep (defpackage a)))
+(progn
+ (when (find-package "A") (delete-package "A"))
+ (packagep (defpackage "A")))
+(progn
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (and (packagep (defpackage "TB-FOO"))
+ (null (package-nicknames 'tb-foo))
+ (null (package-shadowing-symbols 'tb-foo))))
+(progn
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (and (packagep (defpackage "TB-FOO" (:nicknames)))
+ (null (package-nicknames 'tb-foo))))
+(progn
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (and (packagep (defpackage "TB-FOO" (:nicknames) (:shadow)))
+ (null (package-nicknames 'tb-foo))
+ (null (package-shadowing-symbols 'tb-foo))))
+(progn
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (and (packagep (defpackage "TB-FOO"
+ (:nicknames)
+ (:shadow)
+ (:shadowing-import-from common-lisp)))
+ (null (package-nicknames 'tb-foo))
+ (null (package-shadowing-symbols 'tb-foo))))
+(progn
+ (mapc #'(lambda (name) (when (find-package name) (delete-package name)))
+ '("TB-FOO" "TB-FOO-NICKNAME-1" "TB-FOO-NICKNAME-2" "TB-FOO-NICKNAME-3"))
+ (and (packagep (defpackage "TB-FOO" (:nicknames tb-foo-nickname-1)))
+ (equal (package-nicknames 'tb-foo) '("TB-FOO-NICKNAME-1"))))
+#-CLISP
+;; Bruno: unfounded assumptions about the order of the package-nicknames list
+(progn
+ (mapc #'(lambda (name) (when (find-package name) (delete-package name)))
+ '("TB-FOO" "TB-FOO-NICKNAME-1" "TB-FOO-NICKNAME-2" "TB-FOO-NICKNAME-3"))
+ (and (packagep (defpackage "TB-FOO"
+ (:nicknames tb-foo-nickname-1 tb-foo-nickname-2
+ tb-foo-nickname-3)))
+ (equal (package-nicknames 'tb-foo)
+ '("TB-FOO-NICKNAME-1" "TB-FOO-NICKNAME-2" "TB-FOO-NICKNAME-3"))))
+(progn
+ (mapc #'(lambda (name) (when (find-package name) (delete-package name)))
+ '("A" "B" "C" "D"))
+ (and (packagep (defpackage "A" (:nicknames #\B c "D")))
+ (null (set-difference (package-nicknames 'a) '("B" "C" "D")
+ :test #'string=))))
+(progn
+ (mapc #'(lambda (name) (when (find-package name) (delete-package name)))
+ '("A" "B" "C" "D"))
+ (and (packagep (defpackage "A"
+ (:nicknames) (:nicknames #\B) (:nicknames c "D")))
+ (null (set-difference (package-nicknames 'a) '("B" "C" "D")
+ :test #'string=))))
+;(progn
+; (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+; (and (packagep (defpackage "TB-FOO"
+; (:nicknames) (:documentation "doc for tb-foo package")))
+; (packagep (find-package 'tb-foo))))
+(progn
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (and (packagep (defpackage "TB-FOO" (:use)))
+ (null (package-use-list 'tb-foo))))
+(progn
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (and (packagep (defpackage "TB-FOO" (:use cl)))
+ (equal (package-use-list 'tb-foo) (list (find-package 'cl)))))
+(progn
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (when (find-package "TB-BAR-TO-USE")
+ (mapcan #'delete-package (package-used-by-list "TB-BAR-TO-USE"))
+ (delete-package "TB-BAR-TO-USE"))
+ (make-package "TB-BAR-TO-USE" :use nil)
+ (and (packagep (defpackage "TB-FOO" (:use cl tb-bar-to-use)))
+ (null (set-difference (package-use-list 'tb-foo)
+ (mapcar #'find-package '(cl tb-bar-to-use))))))
+(progn
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (when (find-package "TB-BAR-TO-USE")
+ (mapcan #'delete-package (package-used-by-list "TB-BAR-TO-USE"))
+ (delete-package "TB-BAR-TO-USE"))
+ (make-package "TB-BAR-TO-USE" :use nil)
+ (and (packagep (defpackage "TB-FOO" (:use cl) (:use) (:use tb-bar-to-use)))
+ (null (set-difference (package-use-list 'tb-foo)
+ (mapcar #'find-package '(cl tb-bar-to-use))))))
+(progn
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (when (find-package "TB-BAR-TO-USE")
+ (mapcan #'delete-package (package-used-by-list "TB-BAR-TO-USE"))
+ (delete-package "TB-BAR-TO-USE"))
+ (make-package "TB-BAR-TO-USE" :use nil)
+ (and (packagep (defpackage "TB-FOO" (:use cl) (:use) (:use "TB-BAR-TO-USE")))
+ (null (set-difference (package-use-list 'tb-foo)
+ (mapcar #'find-package '(cl tb-bar-to-use))))))
+(progn
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (when (find-package "B")
+ (mapcan #'delete-package (package-used-by-list "B"))
+ (delete-package "B"))
+ (make-package "B" :use nil)
+ (and (packagep (defpackage "TB-FOO" (:use cl) (:use) (:use "B")))
+ (null (set-difference (package-use-list 'tb-foo)
+ (mapcar #'find-package '(cl b))))))
+(progn
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (when (find-package "B")
+ (mapcan #'delete-package (package-used-by-list "B"))
+ (delete-package "B"))
+ (make-package "B" :use nil)
+ (and (packagep (defpackage "TB-FOO" (:use cl) (:use) (:use #\B)))
+ (null (set-difference (package-use-list 'tb-foo)
+ (mapcar #'find-package '(cl b))))))
+(progn
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (when (find-package "B")
+ (mapcan #'delete-package (package-used-by-list "B"))
+ (delete-package "B"))
+ (make-package "B" :use nil)
+ (and (packagep (eval `(defpackage "TB-FOO"
+ (:use cl) (:use) (:use ,(find-package #\B)))))
+ (null (set-difference (package-use-list 'tb-foo)
+ (mapcar #'find-package '(cl b))))))
+(progn
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (and (packagep (defpackage "TB-FOO" (:shadow)))
+ (null (package-shadowing-symbols 'tb-foo))))
+(progn
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (and (packagep (defpackage "TB-FOO" (:shadow "A")))
+ (equal (package-shadowing-symbols 'tb-foo)
+ (list (find-symbol "A" 'tb-foo)))))
+(progn
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (and (packagep (defpackage "TB-FOO" (:shadow a #\b "c" "D")))
+ (null (set-difference (package-shadowing-symbols 'tb-foo)
+ (mapcar #'(lambda (name) (find-symbol name 'tb-foo))
+ '("A" "b" "c" "D"))))))
+(progn
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (and (packagep (defpackage "TB-FOO" (:shadow a) (:shadow )
+ (:shadow #\b "c" "D"))))
+ (null (set-difference (package-shadowing-symbols 'tb-foo)
+ (mapcar #'(lambda (name) (find-symbol name 'tb-foo))
+ '("A" "b" "c" "D")))))
+(progn
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (and (packagep (defpackage "TB-FOO" (:shadowing-import-from cl)))))
+(progn
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (and (packagep (defpackage "TB-FOO" (:shadowing-import-from "COMMON-LISP")))
+ (null (package-shadowing-symbols 'tb-foo))))
+(progn
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (and (packagep (defpackage "TB-FOO"
+ (:shadowing-import-from "COMMON-LISP" car cdr list)))
+ (every #'(lambda (name) (find-symbol name 'tb-foo)) '("CAR" "CDR" "LIST"))
+ (null (set-difference (package-shadowing-symbols 'tb-foo)
+ '(cl:car cl:cdr cl:list)))))
+(progn
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (and (packagep (defpackage "TB-FOO"
+ (:shadowing-import-from "COMMON-LISP" car cdr)
+ (:shadowing-import-from "COMMON-LISP")
+ (:shadowing-import-from "COMMON-LISP" list)))
+ (every #'(lambda (name) (find-symbol name 'tb-foo)) '("CAR" "CDR" "LIST"))
+ (null (set-difference (package-shadowing-symbols 'tb-foo)
+ '(cl:car cl:cdr cl:list)))))
+(progn
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (when (find-package "TB-BAR-TO-USE")
+ (mapcan #'delete-package (package-used-by-list "TB-BAR-TO-USE"))
+ (delete-package "TB-BAR-TO-USE"))
+ (make-package "TB-BAR-TO-USE" :use nil)
+ (let ((buz (intern "BUZ" 'tb-bar-to-use)))
+ (and (packagep (defpackage "TB-FOO"
+ (:shadowing-import-from "COMMON-LISP" car cdr)
+ (:shadowing-import-from tb-bar-to-use "BUZ")))
+ (every #'(lambda (name) (find-symbol name 'tb-foo)) '("CAR" "CDR"))
+ (null (set-difference (package-shadowing-symbols 'tb-foo)
+ (list 'cl:car 'cl:cdr buz))))))
+(progn
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (when (find-package "TB-BAR-TO-USE")
+ (mapcan #'delete-package (package-used-by-list "TB-BAR-TO-USE"))
+ (delete-package "TB-BAR-TO-USE"))
+ (make-package "TB-BAR-TO-USE" :use nil)
+ (let ((buz (intern "BUZ" 'tb-bar-to-use))
+ (baz (intern "BAZ" 'tb-bar-to-use)))
+ (and (packagep (defpackage "TB-FOO"
+ (:shadowing-import-from "COMMON-LISP" car cdr)
+ (:shadowing-import-from tb-bar-to-use "BUZ" "BAZ")))
+ (every #'(lambda (name) (find-symbol name 'tb-foo))
+ '("CAR" "CDR" "BUZ" "BAZ"))
+ (null (set-difference (package-shadowing-symbols 'tb-foo)
+ (list 'cl:car 'cl:cdr buz baz))))))
+(progn
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (when (find-package "TB-BAR-TO-USE")
+ (mapcan #'delete-package (package-used-by-list "TB-BAR-TO-USE"))
+ (delete-package "TB-BAR-TO-USE"))
+ (make-package "TB-BAR-TO-USE" :use nil)
+ (let ((buz (intern "BUZ" 'tb-bar-to-use))
+ (baz (intern "BAZ" 'tb-bar-to-use)))
+ (and (packagep (defpackage "TB-FOO"
+ (:shadow "BOO")
+ (:shadowing-import-from "COMMON-LISP" car cdr)
+ (:shadowing-import-from tb-bar-to-use "BUZ" "BAZ")))
+ (every #'(lambda (name) (find-symbol name 'tb-foo))
+ '("CAR" "CDR" "BUZ" "BAZ" "BOO"))
+ (null (set-difference (package-shadowing-symbols 'tb-foo)
+ (list 'cl:car 'cl:cdr buz baz
+ (find-symbol "BOO" 'tb-foo)))))))
+(progn
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (and (packagep (eval `(defpackage "TB-FOO"
+ (:shadowing-import-from ,(find-package 'cl)
+ "CAR" "CDR"))))
+ (every #'(lambda (name) (find-symbol name 'tb-foo)) '("CAR" "CDR"))))
+(progn
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (and (packagep (eval `(defpackage "TB-FOO"
+ (:import-from ,(find-package 'cl)
+ "CAR" "CDR"))))
+ (every #'(lambda (name) (find-symbol name 'tb-foo)) '("CAR" "CDR"))))
+(progn
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (packagep (defpackage "TB-FOO" (:import-from cl))))
+(progn
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (and (packagep (defpackage "TB-FOO" (:import-from cl "CAR" "CDR")))
+ (every #'(lambda (name) (find-symbol name 'tb-foo)) '("CAR" "CDR"))))
+(progn
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (and (packagep (defpackage "TB-FOO"
+ (:import-from "COMMON-LISP" car cdr list)))
+ (every #'(lambda (name) (find-symbol name 'tb-foo))
+ '("CAR" "CDR" "LIST"))))
+(progn
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (and (packagep (defpackage "TB-FOO"
+ (:import-from "COMMON-LISP" car cdr)
+ (:import-from "COMMON-LISP")
+ (:import-from "COMMON-LISP" list)))
+ (every #'(lambda (name) (find-symbol name 'tb-foo))
+ '("CAR" "CDR" "LIST"))))
+(progn
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (when (find-package "TB-BAR-TO-USE")
+ (mapcan #'delete-package (package-used-by-list "TB-BAR-TO-USE"))
+ (delete-package "TB-BAR-TO-USE"))
+ (make-package "TB-BAR-TO-USE" :use nil)
+ (let ((buz (intern "BUZ" 'tb-bar-to-use)))
+ (and (packagep (defpackage "TB-FOO"
+ (:import-from "COMMON-LISP" car cdr)
+ (:import-from tb-bar-to-use "BUZ")))
+ (every #'(lambda (name) (find-symbol name 'tb-foo)) '("CAR" "CDR"))
+ (eq (find-symbol "BUZ" 'tb-foo) buz))))
+(progn
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (when (find-package "TB-BAR-TO-USE")
+ (mapcan #'delete-package (package-used-by-list "TB-BAR-TO-USE"))
+ (delete-package "TB-BAR-TO-USE"))
+ (make-package "TB-BAR-TO-USE" :use nil)
+ (let ((buz (intern "BUZ" 'tb-bar-to-use))
+ (baz (intern "BAZ" 'tb-bar-to-use)))
+ (and (packagep (defpackage "TB-FOO"
+ (:import-from "COMMON-LISP" car cdr)
+ (:import-from tb-bar-to-use "BUZ" "BAZ")))
+ (every #'(lambda (name) (find-symbol name 'tb-foo))
+ '("CAR" "CDR" "BUZ" "BAZ"))
+ (eq (find-symbol "BUZ" 'tb-foo) buz)
+ (eq (find-symbol "BAZ" 'tb-foo) baz))))
+(progn
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (packagep (defpackage "TB-FOO" (:export))))
+(progn
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (packagep (defpackage "TB-FOO" (:export) (:export))))
+(progn
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (and (packagep (defpackage "TB-FOO" (:export "A")))
+ (eq (cadr (multiple-value-list (find-symbol "A" 'tb-foo))) :external)))
+(progn
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (and (packagep (defpackage "TB-FOO" (:export "A" "B" "C")))
+ (every #'(lambda (name)
+ (eq (cadr (multiple-value-list (find-symbol name 'tb-foo)))
+ :external))
+ '("A" "B" "C"))))
+(progn
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (and (packagep (defpackage "TB-FOO" (:export "A" "B" "C")))
+ (every #'(lambda (name)
+ (eq (cadr (multiple-value-list (find-symbol name 'tb-foo)))
+ :external))
+ '("A" "B" "C"))))
+(progn
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (and (packagep (defpackage "TB-FOO"
+ (:export "A") (:export "B") (:export "C")))
+ (every #'(lambda (name)
+ (eq (cadr (multiple-value-list (find-symbol name 'tb-foo)))
+ :external))
+ '("A" "B" "C"))))
+(progn
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (and (packagep (defpackage "TB-FOO"
+ (:export "A" "B" "C" "CAR")
+ (:use cl)))
+ (every #'(lambda (name)
+ (eq (cadr (multiple-value-list (find-symbol name 'tb-foo)))
+ :external))
+ '("A" "B" "C" "CAR"))
+ (eq (find-symbol "CAR" 'tb-foo) 'cl:car)))
+(progn
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (and (packagep (defpackage "TB-FOO"
+ (:export "A" "B" "C" "CAR")
+ (:import-from cl "CAR")))
+ (every #'(lambda (name)
+ (eq (cadr (multiple-value-list (find-symbol name 'tb-foo)))
+ :external))
+ '("A" "B" "C" "CAR"))
+ (eq (find-symbol "CAR" 'tb-foo) 'cl:car)))
+(progn
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (and (packagep (defpackage "TB-FOO"
+ (:export "A" "B" "C" "CAR")
+ (:shadowing-import-from cl "CAR")))
+ (every #'(lambda (name)
+ (eq (cadr (multiple-value-list (find-symbol name 'tb-foo)))
+ :external))
+ '("A" "B" "C" "CAR"))
+ (eq (find-symbol "CAR" 'tb-foo) 'cl:car)))
+(progn
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (when (find-package "TB-BAR-TO-USE")
+ (mapcan #'delete-package (package-used-by-list "TB-BAR-TO-USE"))
+ (delete-package "TB-BAR-TO-USE"))
+ (make-package "TB-BAR-TO-USE" :use nil)
+ (let ((buz (intern "BUZ" 'tb-bar-to-use)))
+ (and (packagep (defpackage "TB-FOO"
+ (:export "A" "B" "C" "CAR" "CDR" "BUZ")
+ (:use tb-bar-to-use)
+ (:import-from cl "CDR")
+ (:shadowing-import-from cl "CAR")))
+ (every #'(lambda (name)
+ (eq (cadr (multiple-value-list (find-symbol name 'tb-foo)))
+ :external))
+ '("A" "B" "C" "CAR" "CDR" "BUZ"))
+ (eq (find-symbol "CAR" 'tb-foo) 'cl:car)
+ (eq (find-symbol "CDR" 'tb-foo) 'cl:cdr)
+ (eq (find-symbol "BUZ" 'tb-bar-to-use) buz))))
+(progn
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (packagep (defpackage "TB-FOO" (:intern))))
+(progn
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (packagep (defpackage "TB-FOO" (:intern) (:intern))))
+(progn
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (and (packagep (defpackage "TB-FOO" (:intern "A")))
+ (eq (cadr (multiple-value-list (find-symbol "A" 'tb-foo))) :internal)))
+(progn
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (and (packagep (defpackage "TB-FOO" (:intern "A" "B" "C")))
+ (every #'(lambda (name)
+ (eq (cadr (multiple-value-list (find-symbol name 'tb-foo)))
+ :internal))
+ '("A" "B" "C"))))
+(progn
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (and (packagep (defpackage "TB-FOO" (:intern "A" "B" "C")))
+ (every #'(lambda (name)
+ (eq (cadr (multiple-value-list (find-symbol name 'tb-foo)))
+ :internal))
+ '("A" "B" "C"))))
+(progn
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (and (packagep (defpackage "TB-FOO"
+ (:intern "A") (:intern "B") (:intern "C")))
+ (every #'(lambda (name)
+ (eq (cadr (multiple-value-list (find-symbol name 'tb-foo)))
+ :internal))
+ '("A" "B" "C"))))
+(progn
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (and (packagep (defpackage "TB-FOO"
+ (:intern "A" "B" "C" "CAR")
+ (:use cl)))
+ (every #'(lambda (name)
+ (eq (cadr (multiple-value-list (find-symbol name 'tb-foo)))
+ :internal))
+ '("A" "B" "C"))
+ (equal (multiple-value-list (find-symbol "CAR" 'tb-foo))
+ '(cl:car :inherited))))
+(progn
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (and (packagep (defpackage "TB-FOO" (:size 10)))))
+(progn
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (and (packagep (defpackage "TB-FOO" (:size 0)))))
+(progn
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (and (packagep (defpackage "TB-FOO" (:size 1000)))))
+
+(progn
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (when (find-package "TB-BAR-TO-USE")
+ (mapcan #'delete-package (package-used-by-list "TB-BAR-TO-USE"))
+ (delete-package "TB-BAR-TO-USE"))
+ (make-package "TB-BAR-TO-USE" :use nil)
+ (let ((buz (intern "BUZ" 'tb-bar-to-use)))
+ (export buz 'tb-bar-to-use)
+ (and
+ (packagep
+ (defpackage "TB-FOO"
+ (:size 10)
+ (:shadow "SHADOW1" "SHADOW2")
+ (:shadowing-import-from cl "CAR" "CDR")
+ (:use tb-bar-to-use)
+ (:import-from keyword "TEST")
+ (:intern "S0" "S1")
+ ;;(:documentation "doc")
+ (:nicknames "TB-FOO-NICKNAME-0" "TB-FOO-NICKNAME-1" "TB-FOO-NICKNAME-2")
+ (:export "SHADOW1" "CAR")))
+ (equal (multiple-value-list (find-symbol "BUZ" 'tb-foo-nickname-0))
+ (list buz :inherited))
+ (eq (cadr (multiple-value-list (find-symbol "SHADOW1" 'tb-foo-nickname-2)))
+ :external)
+ (eq (cadr (multiple-value-list (find-symbol "SHADOW2" 'tb-foo-nickname-2)))
+ :internal)
+ (equal (multiple-value-list (find-symbol "CAR" 'tb-foo-nickname-2))
+ (list 'cl:car :external))
+ (equal (multiple-value-list (find-symbol "CDR" 'tb-foo-nickname-2))
+ (list 'cl:cdr :internal))
+ (equal (multiple-value-list (find-symbol "TEST" 'tb-foo-nickname-2))
+ (list :test :internal))
+ (eq (cadr (multiple-value-list (find-symbol "S0" 'tb-foo-nickname-2)))
+ :internal)
+ (eq (cadr (multiple-value-list (find-symbol "S1" 'tb-foo-nickname-2)))
+ :internal)
+ )))
+
+(progn
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (when (find-package "TB-BAR-TO-USE")
+ (mapcan #'delete-package (package-used-by-list "TB-BAR-TO-USE"))
+ (delete-package "TB-BAR-TO-USE"))
+ (make-package "TB-BAR-TO-USE" :use nil)
+ (let ((buz (intern "BUZ" 'tb-bar-to-use)))
+ (export buz 'tb-bar-to-use)
+ (and
+ (packagep
+ (defpackage "TB-FOO"
+ (:export "SHADOW1")
+ (:size 10)
+ (:nicknames "TB-FOO-NICKNAME-1" "TB-FOO-NICKNAME-2")
+ (:shadow "SHADOW1")
+ (:shadowing-import-from cl "CAR")
+ (:intern "S1")
+ (:shadowing-import-from cl)
+ (:use tb-bar-to-use)
+ (:nicknames "TB-FOO-NICKNAME-0")
+ (:shadowing-import-from cl "CDR")
+ (:shadow "SHADOW2")
+ (:import-from keyword "TEST")
+ (:intern "S0")
+ ;;(:documentation "doc")
+ (:nicknames)
+ (:export "CAR")))
+ (equal (multiple-value-list (find-symbol "BUZ" 'tb-foo-nickname-0))
+ (list buz :inherited))
+ (eq (cadr (multiple-value-list (find-symbol "SHADOW1" 'tb-foo-nickname-2)))
+ :external)
+ (eq (cadr (multiple-value-list (find-symbol "SHADOW2" 'tb-foo-nickname-2)))
+ :internal)
+ (equal (multiple-value-list (find-symbol "CAR" 'tb-foo-nickname-2))
+ (list 'cl:car :external))
+ (equal (multiple-value-list (find-symbol "CDR" 'tb-foo-nickname-2))
+ (list 'cl:cdr :internal))
+ (equal (multiple-value-list (find-symbol "TEST" 'tb-foo-nickname-2))
+ (list :test :internal))
+ (eq (cadr (multiple-value-list (find-symbol "S0" 'tb-foo-nickname-2)))
+ :internal)
+ (eq (cadr (multiple-value-list (find-symbol "S1" 'tb-foo-nickname-2)))
+ :internal)
+ )))
+
+
+
+
+
+;; with-package-iterator
+(with-package-iterator (get "CL" :external)
+ (multiple-value-bind (more symbol status pkg) (get) (declare (ignore more))
+ (and (symbolp symbol) (eq status :external) (eq pkg (find-package 'cl)))))
+
+(with-package-iterator (get 'cl :external)
+ (multiple-value-bind (more symbol status pkg) (get) (declare (ignore more))
+ (and (symbolp symbol) (eq status :external) (eq pkg (find-package 'cl)))))
+
+(with-package-iterator (get (find-package 'cl) :external)
+ (multiple-value-bind (more symbol status pkg) (get) (declare (ignore more))
+ (and (symbolp symbol) (eq status :external) (eq pkg (find-package 'cl)))))
+
+(with-package-iterator (get '(cl) :external)
+ (multiple-value-bind (more symbol status pkg) (get) (declare (ignore more))
+ (and (symbolp symbol) (eq status :external) (eq pkg (find-package 'cl)))))
+
+(with-package-iterator (get (list "CL") :external)
+ (multiple-value-bind (more symbol status pkg) (get) (declare (ignore more))
+ (and (symbolp symbol) (eq status :external) (eq pkg (find-package 'cl)))))
+
+(with-package-iterator (get (list (find-package "COMMON-LISP")) :external)
+ (multiple-value-bind (more symbol status pkg) (get) (declare (ignore more))
+ (and (symbolp symbol) (eq status :external) (eq pkg (find-package 'cl)))))
+
+(with-package-iterator (get 'cl :external :internal :inherited)
+ (multiple-value-bind (more symbol status pkg) (get)
+ (declare (ignore more))
+ (and (symbolp symbol)
+ (member status '(:external :internal :inherited))
+ (eq pkg (find-package 'cl)))))
+
+(with-package-iterator (get (list 'cl) :internal)
+ (multiple-value-bind (more symbol status pkg) (get)
+ (or (not more)
+ (and (symbolp symbol)
+ (eq status :internal)
+ (eq pkg (find-package 'cl))))))
+
+(with-package-iterator (get (list 'cl) :inherited)
+ (multiple-value-bind (more symbol status pkg) (get)
+ (or (not more)
+ (and (symbolp symbol)
+ (eq status :inherited)
+ (eq pkg (find-package 'cl))))))
+
+;;; cmucl barfs on (macrolet () (declare))
+(progn
+ #-cmu
+ (with-package-iterator (get "CL" :external)
+ (declare (optimize (safety 3)))
+ (multiple-value-bind (more symbol status pkg) (get)
+ (declare (ignore more))
+ (and (symbolp symbol) (eq status :external) (eq pkg (find-package 'cl)))))
+ #+cmu 'skipped)
+(progn
+ (when (find-package "TB-FOO")
+ (delete-package "TB-FOO"))
+ (let ((package (make-package "TB-FOO" :use nil))
+ list)
+ (with-package-iterator (get package :internal)
+ (and (loop
+ (multiple-value-bind (more symbol status pkg) (get)
+ (declare (ignore status pkg))
+ (unless more (return t))
+ (push symbol list)))
+ (null list)))))
+(progn
+ (when (find-package "TB-FOO")
+ (delete-package "TB-FOO"))
+ (let ((package (make-package "TB-FOO" :use nil)))
+ (dolist (name '(a b c d e f g "S1" "S2" "ss"))
+ (intern name package))
+ (with-package-iterator (get package :internal)
+ (loop
+ (multiple-value-bind (more symbol status pkg) (get)
+ (unless more (return t))
+ (unless (and (eq status :internal)
+ (eq pkg package)
+ (eq symbol (find-symbol (string symbol) pkg)))
+ (return nil)))))))
+(progn
+ (when (find-package #\a)
+ (delete-package #\a))
+ (let ((package (make-package #\a :use nil)))
+ (dolist (name '(a b c d e f g "S1" "S2" "ss"))
+ (intern name package))
+ (with-package-iterator (get #\a :internal)
+ (loop
+ (multiple-value-bind (more symbol status pkg) (get)
+ (unless more (return t))
+ (unless (and (eq status :internal)
+ (eq pkg package)
+ (eq symbol (find-symbol (string symbol) pkg)))
+ (return nil)))))))
+(progn
+ (when (find-package #\a)
+ (delete-package #\a))
+ (let ((package (make-package #\a :use nil)))
+ (dolist (name '(a b c d e f g "S1" "S2" "ss"))
+ (intern name package))
+ (with-package-iterator (get (list #\a) :internal)
+ (loop
+ (multiple-value-bind (more symbol status pkg) (get)
+ (unless more (return t))
+ (unless (and (eq status :internal)
+ (eq pkg package)
+ (eq symbol (find-symbol (string symbol) pkg)))
+ (return nil)))))))
+(progn
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (when (find-package "TB-BAR-TO-USE")
+ (mapcan #'delete-package (package-used-by-list "TB-BAR-TO-USE"))
+ (delete-package "TB-BAR-TO-USE"))
+ (let* ((package (make-package "TB-BAR-TO-USE" :use nil))
+ (package-1 (make-package "TB-FOO" :use (list package)))
+ (symbol-list nil))
+ (export (intern "S" package) package)
+ (shadow '("S") package-1)
+ (with-package-iterator (get package-1 :internal :external :inherited)
+ (loop
+ (multiple-value-bind (more symbol status pkg) (get)
+ (declare (ignore status pkg))
+ (unless more (return t))
+ (push symbol symbol-list))))
+ (not (member (intern "S" package) symbol-list))))
+(progn
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (let* ((package (make-package "TB-FOO" :use nil))
+ (symbol-list nil))
+ (with-package-iterator (get package :internal :external)
+ (loop
+ (multiple-value-bind (more symbol status pkg) (get)
+ (declare (ignore status pkg))
+ (unless more (return t))
+ (push symbol symbol-list))))
+ (null symbol-list)))
+(progn
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (let* ((package (make-package "TB-FOO" :use nil))
+ (symbol-list '(a b c d car cdr i lisp))
+ (list nil))
+ (dolist (symbol symbol-list)
+ (shadowing-import symbol package))
+ (with-package-iterator (get package :internal)
+ (loop
+ (multiple-value-bind (more symbol status pkg) (get)
+ (declare (ignore status pkg))
+ (unless more (return t))
+ (push symbol list))))
+ (null (set-difference symbol-list list))))
+(with-package-iterator (get 'cl :external)
+ (loop
+ (multiple-value-bind (more symbol status package) (get)
+ (unless more (return t))
+ (unless (and (eq status :external)
+ (eq package (find-package 'cl))
+ (eq symbol (find-symbol (symbol-name symbol) 'cl-user)))
+ (return nil)))))
+(progn
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (let* ((package (make-package "TB-FOO" :use 'cl)))
+ (shadow '("CAR") package)
+ (with-package-iterator (get package :external :inherited :internal)
+ (loop
+ (multiple-value-bind (more symbol status pkg) (get)
+ (declare (ignore pkg status))
+ (unless more (return t))
+ (when (eq symbol 'cl:car) (return nil)))))))
+(progn
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (let* ((*package* (make-package "TB-FOO" :use nil))
+ (names '("BLACK" "RED" "WHITE" "YELLOW" "VIOLET" "BROWN" "BLUE"))
+ list)
+ (mapc #'intern names)
+ (export (mapcar #'find-symbol
+ (mapcan #'(lambda (name)
+ (when (= (length name) 5) (list name))) names)))
+ (with-package-iterator (get *package* :external :inherited :internal)
+ (loop
+ (multiple-value-bind (more symbol status pkg) (get)
+ (declare (ignore pkg))
+ (unless more (return))
+ (push (symbol-name symbol) (getf list status)))))
+ (and (null (set-difference (getf list :external) '("BLACK" "WHITE" "BROWN")
+ :test #'string=))
+ (null (set-difference (getf list :internal)
+ '("RED" "YELLOW" "VIOLET" "BLUE")
+ :test #'string=))
+ (null (getf list :inherited)))))
+
+
+(flet ((test-package-iterator (package)
+ (unless (packagep package)
+ (setq package (find-package package)))
+ (let ((all-entries '())
+ (generated-entries '()))
+ (do-symbols (x package)
+ (multiple-value-bind (symbol accessibility)
+ (find-symbol (symbol-name x) package)
+ (push (list symbol accessibility) all-entries)))
+ (with-package-iterator (generator-fn package
+ :internal :external :inherited)
+ (loop
+ (multiple-value-bind (more? symbol accessibility pkg)
+ (generator-fn)
+ (declare (ignore pkg))
+ (unless more? (return))
+ (let ((l (multiple-value-list (find-symbol (symbol-name symbol)
+ package))))
+ (unless (equal l (list symbol accessibility))
+ (error "Symbol ~S not found as ~S in package ~A [~S]"
+ symbol accessibility (package-name package) l))
+ (push l generated-entries)))))
+ (unless (and (subsetp all-entries generated-entries :test #'equal)
+ (subsetp generated-entries all-entries :test #'equal))
+ (error "Generated entries and Do-Symbols entries don't correspond"))
+ t)))
+ (every #'test-package-iterator '("CL" "CL-USER" "KEYWORD")))
+
+
+;; do-symbols
+(null (do-symbols (symbol) (declare (ignore symbol))))
+(null (do-symbols (symbol *package*) (declare (ignore symbol))))
+(null (do-external-symbols (symbol) (declare (ignore symbol))))
+(null (do-external-symbols (symbol *package*) (declare (ignore symbol))))
+(null (do-all-symbols (symbol) (declare (ignore symbol))))
+(do-symbols (symbol *package* (null symbol)))
+(do-external-symbols (symbol *package* (null symbol)))
+(do-all-symbols (symbol (null symbol)))
+(do-symbols (symbol 'CL nil) (declare (ignore symbol)) (return t))
+(do-external-symbols (symbol 'CL nil) (declare (ignore symbol)) (return t))
+(do-all-symbols (symbol nil) (declare (ignore symbol)) (return t))
+(do-symbols (symbol 'cl nil)
+ (go start)
+ found
+ (return t)
+ start
+ (when (eq symbol 'cl:car)
+ (go found)))
+(do-external-symbols (symbol 'cl nil)
+ (go start)
+ found
+ (return t)
+ start
+ (when (eq symbol 'cl:car)
+ (go found)))
+(do-all-symbols (symbol nil)
+ (go start)
+ found
+ (return t)
+ start
+ (when (eq symbol 'cl:car)
+ (go found)))
+(let ((i 0)
+ (list nil)
+ (*package* (find-package "COMMON-LISP-USER")))
+ (do-symbols (symbol)
+ (push symbol list)
+ (incf i)
+ (when (= i 10) (return)))
+ (every #'symbolp list))
+(progn
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (let ((*package* (make-package "TB-FOO" :use nil))
+ (name-list '("A" "B" "DOG" "CAT" "giraffe" "hippo" "wolf"))
+ (list))
+ (export (mapcar #'intern name-list))
+ (null (set-difference (do-symbols (symbol *package* list)
+ (pushnew symbol list))
+ (mapcar #'find-symbol name-list)))))
+(progn
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (let ((*package* (make-package "TB-FOO" :use nil))
+ list)
+ (do-symbols (symbol *package*) (push symbol list))
+ (null list)))
+(progn
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (let ((*package* (make-package "TB-FOO" :use nil))
+ list)
+ (do-symbols (symbol) (push symbol list))
+ (null list)))
+(do-symbols (symbol 'cl t)
+ (unless (eq symbol (find-symbol (symbol-name symbol) 'cl))
+ (return nil)))
+(do-symbols (symbol 'keyword t)
+ (unless (equal
+ (multiple-value-list (find-symbol (symbol-name symbol) 'keyword))
+ (list symbol :external))
+ (return nil)))
+
+
+;; do-external-symbols
+(let (list1 list2)
+ (and (do-external-symbols (symbol 'keyword t) (push symbol list1))
+ (do-symbols (symbol 'keyword t) (push symbol list2))
+ (null (set-difference list1 list2))))
+(progn
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (let ((*package* (make-package "TB-FOO" :use nil))
+ list)
+ (do-external-symbols (symbol *package*) (push symbol list))
+ (null list)))
+(progn
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (let ((*package* (make-package "TB-FOO" :use nil))
+ list)
+ (do-external-symbols (symbol) (push symbol list))
+ (null list)))
+(progn
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (let ((*package* (make-package "TB-FOO" :use nil))
+ (name-list '("A" "B" "DOG" "CAT" "giraffe" "hippo" "wolf"))
+ (list))
+ (export (mapcar #'intern name-list))
+ (null (set-difference (do-external-symbols (symbol *package* list)
+ (pushnew symbol list))
+ (mapcar #'find-symbol name-list)))))
+(progn
+ (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+ (let ((*package* (make-package "TB-FOO" :use nil))
+ (name-list '("A" "B" "DOG" "CAT" "giraffe" "hippo" "wolf"))
+ (list))
+ (mapcar #'intern name-list)
+ (null (do-external-symbols (symbol *package* list)
+ (pushnew symbol list)))))
+
+
+;; do-all-symbols
+(let ((i 0)
+ (list nil))
+ (do-all-symbols (symbol)
+ (push symbol list)
+ (incf i)
+ (when (= i 10) (return)))
+ (every #'symbolp list))
+(let ((list nil))
+ (do-all-symbols (symbol) (push symbol list))
+ (with-package-iterator (get (list-all-packages) :external :internal)
+ (loop
+ (multiple-value-bind (more symbol status package) (get)
+ (declare (ignore status package))
+ (unless more (return t))
+ (unless (member symbol list) (return nil))))))
+
diff --git a/Sacla/tests/must-package.patch b/Sacla/tests/must-package.patch
new file mode 100644
index 0000000..0bc747e
--- /dev/null
+++ b/Sacla/tests/must-package.patch
@@ -0,0 +1,12 @@
+*** sacla/lisp/test/must-package.lisp 2004-08-03 08:34:55.000000000 +0200
+--- CLISP/clisp-20040712/sacla-tests/must-package.lisp 2004-08-06 03:13:08.000000000 +0200
+***************
+*** 1459,1464 ****
+--- 1459,1465 ----
+ '("TB-FOO" "TB-FOO-NICKNAME-1" "TB-FOO-NICKNAME-2" "TB-FOO-NICKNAME-3"))
+ (and (packagep (defpackage "TB-FOO" (:nicknames tb-foo-nickname-1)))
+ (equal (package-nicknames 'tb-foo) '("TB-FOO-NICKNAME-1"))))
++ #-CLISP ; unfounded assumptions about the order of the package-nicknames list
+ (progn
+ (mapc #'(lambda (name) (when (find-package name) (delete-package name)))
+ '("TB-FOO" "TB-FOO-NICKNAME-1" "TB-FOO-NICKNAME-2" "TB-FOO-NICKNAME-3"))
diff --git a/Sacla/tests/must-printer.lisp b/Sacla/tests/must-printer.lisp
new file mode 100644
index 0000000..33a43ee
--- /dev/null
+++ b/Sacla/tests/must-printer.lisp
@@ -0,0 +1,1610 @@
+;; Copyright (C) 2002-2004, Yuji Minejima <ggb01164@nifty.ne.jp>
+;; ALL RIGHTS RESERVED.
+;;
+;; $Id: must-printer.lisp,v 1.16 2004/08/09 02:49:54 yuji Exp $
+;;
+;; Redistribution and use in source and binary forms, with or without
+;; modification, are permitted provided that the following conditions
+;; are met:
+;;
+;; * Redistributions of source code must retain the above copyright
+;; notice, this list of conditions and the following disclaimer.
+;; * 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.
+;;
+;; 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
+;; OWNER 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.
+
+;; printer control variables
+(eql *print-base* 10)
+(null *print-radix*)
+(eq *print-case* :upcase)
+*print-gensym*
+(null *print-level*)
+(null *print-length*)
+(null *print-circle*)
+*print-escape*
+(null *print-readably*)
+*print-pprint-dispatch*
+(null *print-lines*)
+(null *print-right-margin*)
+
+
+;; string
+(string= "abc" (write-to-string "abc" :escape nil))
+(string= "\"abc\"" (write-to-string "abc" :readably t))
+(string= "\"abc\"" (write-to-string "abc" :escape nil :readably t))
+
+(string= "ABC" (write-to-string "ABC" :escape nil))
+(string= "\"ABC\"" (write-to-string "ABC" :readably t))
+(string= "\"ABC\"" (write-to-string "ABC" :escape nil :readably t))
+
+(string= "\"A\\\\B\\\"C\"" (write-to-string "A\\B\"C" :escape nil :readably t))
+(string= "\"A\\\\B\\\"C\"" (write-to-string "A\\B\"C"))
+(string= "A\\B\"C" (write-to-string "A\\B\"C" :escape nil))
+(let ((str "a\\b\""))
+ (and (= 4 (length str))
+ (string= str (read-from-string (write-to-string str)))))
+(let ((str "a\\b\""))
+ (and (= 4 (length str))
+ (string= str (read-from-string
+ (write-to-string str :escape nil :readably t)))))
+
+(string= "\"\\\"\"" (write-to-string "\""))
+(string= "\"\\\"\"" (write-to-string "\"" :escape nil :readably t))
+(string= "\"" (read-from-string (write-to-string "\"")))
+(string= "\"" (read-from-string (write-to-string "\"" :escape nil :readably t)))
+
+(string= "\"\"" (write-to-string ""))
+(string= "\"\"" (write-to-string "" :escape nil :readably t))
+(string= "" (write-to-string "" :escape nil))
+
+(string= "\" \"" (write-to-string " "))
+(string= "\" \"" (write-to-string " " :escape nil :readably t))
+(string= " " (write-to-string " " :escape nil))
+
+(string= "\" \"" (write-to-string " "))
+(string= "\" \"" (write-to-string " " :escape nil :readably t))
+(string= " " (write-to-string " " :escape nil))
+
+(string= "\"
+\"" (write-to-string "
+" :escape nil :readably t))
+(string= "
+" (write-to-string "
+" :escape nil))
+
+
+(string= "\"\\\"\\\"\\\"\\\"\\\"\\\"\""
+ (write-to-string "\"\"\"\"\"\"" :readably t))
+(string= "\"\"\"\"\"\""
+ (read-from-string (write-to-string "\"\"\"\"\"\"" :readably t)))
+(string= "\"\"\"\"\"\""
+ (write-to-string "\"\"\"\"\"\"" :readably nil :escape nil))
+(string= "\" \""
+ (write-to-string " " :readably t))
+
+(string= "\"\\\"Hi\\\" \\\"Oh, hi!\\\"\""
+ (write-to-string "\"Hi\" \"Oh, hi!\"" :readably t))
+(string= "\"Hi\" \"Oh, hi!\""
+ (write-to-string "\"Hi\" \"Oh, hi!\""
+ :pretty nil :readably nil :escape nil))
+
+(string= "abc"
+ (write-to-string "abc" :array nil :escape nil)
+ ;; 22.1.3.4 Printing Strings
+ ;; http://www.lispworks.com/reference/HyperSpec/Body/22_acd.htm
+ ;; The printing of strings is not affected by *print-array*.
+ )
+
+
+
+(string= "abc"
+ (write-to-string (make-array 10
+ :element-type 'character
+ :initial-contents "abcdefghij"
+ :fill-pointer 3)
+ :escape nil))
+
+
+
+;; integer, *print-base*, *print-radix*
+(string= (write-to-string 0) "0")
+(string= (write-to-string -0) "0")
+(string= (write-to-string 9) "9")
+(string= (write-to-string -10) "-10")
+(string= (write-to-string 1234567890987654321234567890987654321)
+ "1234567890987654321234567890987654321")
+(let ((*print-radix* t)) (string= (write-to-string 0) "0."))
+(let ((*print-radix* t)) (string= (write-to-string -52) "-52."))
+(let ((*print-radix* t))
+ (string= (write-to-string -1234567890987654321234567890987654321)
+ "-1234567890987654321234567890987654321."))
+
+(let ((*print-base* 2)) (string= (write-to-string 0) "0"))
+(let ((*print-base* 2)) (string= (write-to-string 10) "1010"))
+(let ((*print-base* 2))
+ (string= (write-to-string -1234567890987654321234567890987654321)
+ "-111011011100010011100101100000010011000101110111101001110100010101110010000101001111011010110110001011000001110010110001"))
+(let ((*print-base* 2) (*print-radix* t))
+ (string= (write-to-string 11) "#b1011"))
+(let ((*print-base* 2) (*print-radix* t))
+ (string= (write-to-string -15) "#b-1111"))
+(let ((*print-base* 2) (*print-radix* t))
+ (string= (write-to-string 1234567890987654321234567890987654321)
+ "#b111011011100010011100101100000010011000101110111101001110100010101110010000101001111011010110110001011000001110010110001"))
+
+
+(let ((*print-base* 8)) (string= (write-to-string 10) "12"))
+(let ((*print-base* 8)) (string= (write-to-string -21) "-25"))
+(let ((*print-base* 8) (*print-radix* t))
+ (string= (write-to-string 11) "#o13"))
+(let ((*print-base* 8) (*print-radix* t))
+ (string= (write-to-string -13) "#o-15"))
+(let ((*print-base* 8))
+ (string= (write-to-string 1234567890987654321234567890987654321)
+ "7334234540230567516425620517326613016261"))
+(let ((*print-base* 8) (*print-radix* t))
+ (string= (write-to-string -1234567890987654321234567890987654321)
+ "#o-7334234540230567516425620517326613016261"))
+
+
+(let ((*print-base* 16)) (string= (write-to-string 20) "14"))
+(let ((*print-base* 16)) (string= (write-to-string -22) "-16"))
+(let ((*print-base* 16)) (string= (string-upcase (write-to-string -30)) "-1E"))
+(let ((*print-base* 16) (*print-radix* t))
+ (string= (write-to-string 21) "#x15"))
+(let ((*print-base* 16) (*print-radix* t))
+ (string= (write-to-string -23) "#x-17"))
+(let ((*print-base* 16))
+ (string= (string-upcase (write-to-string 1234567890987654321234567890987654321))
+ "EDC4E5813177A7457214F6B62C1CB1"))
+(let ((*print-base* 16) (*print-radix* t))
+ (string= (string-upcase (write-to-string -1234567890987654321234567890987654321))
+ "#X-EDC4E5813177A7457214F6B62C1CB1"))
+
+(let ((*print-base* 24.)) (string= (write-to-string 9) "9"))
+(let ((*print-base* 24.))
+ (string= (string-upcase (write-to-string 17)) "H"))
+(let ((*print-base* 24.))
+ (string= (string-upcase (write-to-string -17)) "-H"))
+(let ((*print-base* 24.) (*print-radix* t))
+ (string= (write-to-string 9.) "#24r9"))
+(let ((*print-base* 24.) (*print-radix* t))
+ (string-equal (write-to-string 23.) "#24rN"))
+(let ((*print-base* 24.) (*print-radix* t))
+ (string-equal (write-to-string -23.) "#24r-N"))
+(let ((*print-base* 24))
+ (string= (string-upcase (write-to-string 1234567890987654321234567890987654321))
+ "1EDFC9EAF544D8D12FI44J4FMCH"))
+
+(loop for *print-base* from 2 upto 36
+ always (string= (write-to-string 0) "0"))
+(loop for *print-base* from 2 upto 36
+ always (string= (write-to-string -1) "-1"))
+(loop for *print-base* from 2 upto 36
+ always (string= (string-upcase (write-to-string (1- *print-base*)))
+ (string (char "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
+ (1- *print-base*)))))
+(loop for *print-base* from 2 upto 36
+ always (string= (write-to-string *print-base*) "10"))
+(let ((list nil))
+ (equal (dotimes (i 35 (reverse list))
+ (let ((*print-base* (+ i 2)))
+ ;;collect the decimal number 40 in each base from 2 to 36
+ (push (string-upcase (write-to-string 40)) list)))
+ '("101000" "1111" "220" "130" "104" "55" "50" "44" "40" "37" "34"
+ "31" "2C" "2A" "28" "26" "24" "22" "20" "1J" "1I" "1H" "1G" "1F"
+ "1E" "1D" "1C" "1B" "1A" "19" "18" "17" "16" "15" "14")))
+(let ((list nil))
+ (equal (dotimes (i 35 (reverse list))
+ (let ((*print-base* (+ i 2))
+ (*print-radix* t))
+ ;;collect the decimal number 40 in each base from 2 to 36
+ (push (string-upcase (write-to-string 40)) list)))
+ '("#B101000" "#3R1111" "#4R220" "#5R130" "#6R104" "#7R55" "#O50"
+ "#9R44" "40." "#11R37" "#12R34" "#13R31" "#14R2C" "#15R2A"
+ "#X28" "#17R26" "#18R24" "#19R22" "#20R20" "#21R1J" "#22R1I"
+ "#23R1H" "#24R1G" "#25R1F" "#26R1E" "#27R1D" "#28R1C" "#29R1B"
+ "#30R1A" "#31R19" "#32R18" "#33R17" "#34R16" "#35R15" "#36R14")))
+
+
+;; ratio, *print-base*, *print-radix*
+(string= (write-to-string 1/3) "1/3")
+(string= (write-to-string -1/2) "-1/2")
+(string= (write-to-string -3/5) "-3/5")
+(let ((*print-radix* t))
+ ;; Variable *PRINT-BASE*, *PRINT-RADIX*
+ ;; http://www.lispworks.com/reference/HyperSpec/Body/v_pr_bas.htm
+ ;; For integers, base ten is indicated by a trailing decimal point instead
+ ;; of a leading radix specifier; for ratios, #10r is used.
+ (string= (write-to-string 1/15) "#10r1/15"))
+(let ((*print-radix* t))
+ (string= (write-to-string -4/15) "#10r-4/15"))
+(string= (write-to-string 2/1234567890987654321234567890987654321)
+ "2/1234567890987654321234567890987654321")
+(string= (write-to-string 1234567890987654321234567890987654321/4)
+ "1234567890987654321234567890987654321/4")
+(let ((*print-radix* t))
+ (string= (write-to-string 2/1234567890987654321234567890987654321)
+ "#10r2/1234567890987654321234567890987654321"))
+
+(let ((*print-base* 2)) (string= (write-to-string 1/3) "1/11"))
+(let ((*print-base* 2)) (string= (write-to-string -1/2) "-1/10"))
+(let ((*print-base* 2)) (string= (write-to-string -3/5) "-11/101"))
+(let ((*print-base* 2) (*print-radix* t))
+ (string= (write-to-string 1/15) "#b1/1111"))
+(let ((*print-base* 2) (*print-radix* t))
+ (string= (write-to-string -3/16) "#b-11/10000"))
+(let ((*print-base* 2))
+ (string= (write-to-string 2/1234567890987654321234567890987654321)
+ "10/111011011100010011100101100000010011000101110111101001110100010101110010000101001111011010110110001011000001110010110001"))
+(let ((*print-base* 2))
+ (string= (write-to-string -1234567890987654321234567890987654321/2)
+ "-111011011100010011100101100000010011000101110111101001110100010101110010000101001111011010110110001011000001110010110001/10"))
+(let ((*print-base* 2) (*print-radix* t))
+ (string= (write-to-string 2/1234567890987654321234567890987654321)
+ "#b10/111011011100010011100101100000010011000101110111101001110100010101110010000101001111011010110110001011000001110010110001"))
+
+(let ((*print-base* 8)) (string= (write-to-string 1/3) "1/3"))
+(let ((*print-base* 8)) (string= (write-to-string -1/4) "-1/4"))
+(let ((*print-base* 8)) (string= (write-to-string -3/7) "-3/7"))
+(let ((*print-base* 8)
+ (*print-radix* t))
+ (string= (write-to-string 1/3) "#o1/3"))
+(let ((*print-base* 8)
+ (*print-radix* t))
+ (string= (write-to-string -3/7) "#o-3/7"))
+(let ((*print-base* 8)
+ (*print-radix* t))
+ (string= (write-to-string -15/11) "#o-17/13"))
+(let ((*print-base* 8))
+ (string= (write-to-string 2/1234567890987654321234567890987654321)
+ "2/7334234540230567516425620517326613016261"))
+(let ((*print-base* 8)
+ (*print-radix* t))
+ (string= (write-to-string -1234567890987654321234567890987654321/4)
+ "#o-7334234540230567516425620517326613016261/4"))
+
+(let ((*print-base* 16)) (string= (write-to-string 1/8) "1/8"))
+(let ((*print-base* 16)) (string= (write-to-string -1/9) "-1/9"))
+(let ((*print-base* 16)) (string-equal (write-to-string -9/10) "-9/A"))
+(let ((*print-base* 16)
+ (*print-radix* t))
+ (string= (write-to-string 1/3) "#x1/3"))
+(let ((*print-base* 16)
+ (*print-radix* t))
+ (string= (write-to-string 3/8) "#x3/8"))
+(let ((*print-base* 16)
+ (*print-radix* t))
+ (string= (write-to-string -4/9) "#x-4/9"))
+(let ((*print-base* 16))
+ (string= (write-to-string 2/1234567890987654321234567890987654321)
+ "2/EDC4E5813177A7457214F6B62C1CB1"))
+(let ((*print-base* 16)
+ (*print-radix* t))
+ (string-equal (write-to-string 1234567890987654321234567890987654321/4)
+ "#xEDC4E5813177A7457214F6B62C1CB1/4"))
+(let ((*print-base* 16)
+ (*print-radix* t))
+ (string-equal (write-to-string 1234567890987654321234567890987654321/1234)
+ "#xEDC4E5813177A7457214F6B62C1CB1/4D2"))
+
+(let ((*print-base* 21)) (string= (write-to-string 1/8) "1/8"))
+(let ((*print-base* 21)) (string= (write-to-string -1/9) "-1/9"))
+(let ((*print-base* 21)) (string-equal (write-to-string -9/10) "-9/A"))
+(let ((*print-base* 21)
+ (*print-radix* t))
+ (string= (write-to-string 1/4) "#21r1/4"))
+(let ((*print-base* 21)
+ (*print-radix* t))
+ (string-equal (write-to-string -1/20) "#21r-1/K"))
+(let ((*print-base* 21))
+ (string= (write-to-string 2/1234567890987654321234567890987654321)
+ "2/29FADE40CGDJK4D0654KEAD5K6EK"))
+(let ((*print-base* 21)
+ (*print-radix* t))
+ (string-equal (write-to-string 1234567890987654321234567890987654321/1234)
+ "#21r29FADE40CGDJK4D0654KEAD5K6EK/2GG"))
+
+(loop for *print-base* from 3 upto 36
+ always (string= (write-to-string 1/2) "1/2"))
+(loop for *print-base* from 4 upto 36
+ always (string= (write-to-string -1/3) "-1/3"))
+(loop for *print-base* from 3 upto 36
+ always (string=
+ (string-upcase (write-to-string (/ 1 (1- *print-base*))))
+ (concatenate 'string
+ "1/"
+ (string (char "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
+ (1- *print-base*))))))
+(loop for *print-base* from 2 upto 36
+ always (string= (write-to-string (/ 1 *print-base*)) "1/10"))
+(let ((list nil))
+ (equal (dotimes (i 35 (reverse list))
+ (let ((*print-base* (+ i 2)))
+ ;;collect the decimal number 40 in each base from 2 to 36
+ (push (string-upcase (write-to-string 41/40)) list)))
+ '("101001/101000" "1112/1111" "221/220" "131/130" "105/104"
+ "56/55" "51/50" "45/44" "41/40" "38/37" "35/34"
+ "32/31" "2D/2C" "2B/2A" "29/28" "27/26" "25/24" "23/22" "21/20"
+ "1K/1J" "1J/1I" "1I/1H" "1H/1G" "1G/1F"
+ "1F/1E" "1E/1D" "1D/1C" "1C/1B" "1B/1A" "1A/19" "19/18" "18/17"
+ "17/16" "16/15" "15/14")))
+(let ((list nil))
+ (equal (dotimes (i 35 (reverse list))
+ (let ((*print-base* (+ i 2))
+ (*print-radix* t))
+ ;;collect the decimal number 40 in each base from 2 to 36
+ (push (string-upcase (write-to-string 41/40)) list)))
+ '("#B101001/101000" "#3R1112/1111" "#4R221/220" "#5R131/130"
+ "#6R105/104" "#7R56/55" "#O51/50" "#9R45/44" "#10R41/40"
+ "#11R38/37" "#12R35/34" "#13R32/31" "#14R2D/2C" "#15R2B/2A"
+ "#X29/28" "#17R27/26" "#18R25/24" "#19R23/22" "#20R21/20"
+ "#21R1K/1J" "#22R1J/1I" "#23R1I/1H" "#24R1H/1G" "#25R1G/1F"
+ "#26R1F/1E" "#27R1E/1D" "#28R1D/1C" "#29R1C/1B" "#30R1B/1A"
+ "#31R1A/19" "#32R19/18" "#33R18/17" "#34R17/16" "#35R16/15"
+ "#36R15/14")))
+
+;; character
+(let ((*print-escape* nil))
+ (string= (write-to-string #\a) "a"))
+(let ((*print-escape* nil)
+ (*print-readably* nil))
+ (string= (write-to-string #\d) "d"))
+(let ((*print-escape* nil))
+ (string= (write-to-string #\m) "m"))
+(let ((*print-escape* nil))
+ (string= (write-to-string #\z) "z"))
+(let ((*print-escape* nil)
+ (*print-readably* nil))
+ (loop for c across " !\"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^_'abcdefghijklmnopqrstuvwxyz{|}~"
+ always (string= (write-to-string c) (string c))))
+(let ((*print-escape* nil))
+ (loop for c across " !\"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^_'abcdefghijklmnopqrstuvwxyz{|}~"
+ always (string= (write-to-string c) (string c))))
+
+(string= (write-to-string #\b) "#\\b")
+(string= (write-to-string #\n) "#\\n")
+(string= (write-to-string #\x) "#\\x")
+(let ((*print-escape* nil)
+ (*print-readably* t))
+ (string= (write-to-string #\c) "#\\c"))
+(loop for c across "!#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[]^_'abcdefghijklmnopqrstuvwxyz{|}~"
+ always (string= (write-to-string c) (concatenate 'string "#\\" (string c))))
+(string= (write-to-string #\\) "#\\\\")
+(string= (write-to-string #\") "#\\\"")
+(let ((*print-readably* t)
+ (*print-escape* nil))
+ (loop for c across "!#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[]^_'abcdefghijklmnopqrstuvwxyz{|}~"
+ always (string= (write-to-string c) (concatenate 'string "#\\" (string c)))))
+(let ((*print-readably* t)
+ (*print-escape* t))
+ (loop for c across "!#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[]^_'abcdefghijklmnopqrstuvwxyz{|}~"
+ always (string= (write-to-string c) (concatenate 'string "#\\" (string c)))))
+(let ((*print-readably* nil)
+ (*print-escape* t))
+ (loop for c across "!#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[]^_'abcdefghijklmnopqrstuvwxyz{|}~"
+ always (string= (write-to-string c) (concatenate 'string "#\\" (string c)))))
+
+(progn
+ (let ((*print-readably* t))
+ ;; 22.1.3.2 Printing Characters
+ ;; http://www.lispworks.com/reference/HyperSpec/Body/22_acb.htm
+ ;; For the graphic standard characters, the character itself is always used
+ ;; for printing in #\ notation---even if the character also has a name[5].
+ ;;
+ ;; http://www.lispworks.com/reference/HyperSpec/Body/26_glo_g.htm#graphic
+ ;; graphic adj. -snip- Space is defined to be graphic.
+ (string= (write-to-string #\Space) "#\\ "))
+ 'skipped)
+
+
+;;; symbol
+;; accessible symbol, escaping off, *print-case* :capitalize
+(let ((*readtable* (copy-readtable nil)))
+ (setf (readtable-case *readtable*) :upcase)
+ (string= "abc" (write-to-string '|abc| :escape nil :case :capitalize)))
+
+(let ((*readtable* (copy-readtable nil)))
+ (setf (readtable-case *readtable*) :downcase)
+ (string= "Abc" (write-to-string '|abc| :escape nil :case :capitalize)))
+
+(let ((*readtable* (copy-readtable nil)))
+ (setf (readtable-case *readtable*) :preserve)
+ (string= "abc" (write-to-string '|abc| :escape nil :case :capitalize)))
+
+(let ((*readtable* (copy-readtable nil)))
+ (setf (readtable-case *readtable*) :invert)
+ (string= "ABC" (write-to-string '|abc| :escape nil :case :capitalize)))
+
+
+(let ((*readtable* (copy-readtable nil)))
+ (setf (readtable-case *readtable*) :upcase)
+ (string= "Abc" (write-to-string '|ABC| :escape nil :case :capitalize)))
+
+(let ((*readtable* (copy-readtable nil)))
+ (setf (readtable-case *readtable*) :downcase)
+ (string= "ABC" (write-to-string '|ABC| :escape nil :case :capitalize)))
+
+(let ((*readtable* (copy-readtable nil)))
+ (setf (readtable-case *readtable*) :preserve)
+ (string= "ABC" (write-to-string '|ABC| :escape nil :case :capitalize)))
+
+(let ((*readtable* (copy-readtable nil)))
+ (setf (readtable-case *readtable*) :invert)
+ (string= "abc" (write-to-string '|ABC| :escape nil :case :capitalize)))
+
+
+(let ((*readtable* (copy-readtable nil)))
+ (setf (readtable-case *readtable*) :upcase)
+ (string= "Abc-abc"
+ (write-to-string '|ABC-abc| :escape nil :case :capitalize)))
+
+(let ((*readtable* (copy-readtable nil)))
+ (setf (readtable-case *readtable*) :downcase)
+ (string= "ABC-Abc"
+ (write-to-string '|ABC-abc| :escape nil :case :capitalize)))
+
+(let ((*readtable* (copy-readtable nil)))
+ (setf (readtable-case *readtable*) :preserve)
+ (string= "ABC-abc"
+ (write-to-string '|ABC-abc| :escape nil :case :capitalize)))
+
+(let ((*readtable* (copy-readtable nil)))
+ (setf (readtable-case *readtable*) :invert)
+ (string= "ABC-abc"
+ (write-to-string '|ABC-abc| :escape nil :case :capitalize)))
+
+
+(let ((*readtable* (copy-readtable nil)))
+ (setf (readtable-case *readtable*) :upcase)
+ (string= "abc-Abc"
+ (write-to-string '|abc-ABC| :escape nil :case :capitalize)))
+
+(let ((*readtable* (copy-readtable nil)))
+ (setf (readtable-case *readtable*) :downcase)
+ (string= "Abc-ABC"
+ (write-to-string '|abc-ABC| :escape nil :case :capitalize)))
+
+(let ((*readtable* (copy-readtable nil)))
+ (setf (readtable-case *readtable*) :preserve)
+ (string= "abc-ABC"
+ (write-to-string '|abc-ABC| :escape nil :case :capitalize)))
+
+(let ((*readtable* (copy-readtable nil)))
+ (setf (readtable-case *readtable*) :invert)
+ (string= "abc-ABC"
+ (write-to-string '|abc-ABC| :escape nil :case :capitalize)))
+
+
+;; accessible symbol, escaping off, *print-case* :upcase
+(let ((*readtable* (copy-readtable nil)))
+ (setf (readtable-case *readtable*) :upcase)
+ (string= "abc" (write-to-string '|abc| :escape nil :case :upcase)))
+
+(let ((*readtable* (copy-readtable nil)))
+ (setf (readtable-case *readtable*) :downcase)
+ (string= "ABC" (write-to-string '|abc| :escape nil :case :upcase)))
+
+(let ((*readtable* (copy-readtable nil)))
+ (setf (readtable-case *readtable*) :preserve)
+ (string= "abc" (write-to-string '|abc| :escape nil :case :upcase)))
+
+(let ((*readtable* (copy-readtable nil)))
+ (setf (readtable-case *readtable*) :invert)
+ (string= "ABC" (write-to-string '|abc| :escape nil :case :upcase)))
+
+
+(let ((*readtable* (copy-readtable nil)))
+ (setf (readtable-case *readtable*) :upcase)
+ (string= "ABC" (write-to-string '|ABC| :escape nil :case :upcase)))
+
+(let ((*readtable* (copy-readtable nil)))
+ (setf (readtable-case *readtable*) :downcase)
+ (string= "ABC" (write-to-string '|ABC| :escape nil :case :upcase)))
+
+(let ((*readtable* (copy-readtable nil)))
+ (setf (readtable-case *readtable*) :preserve)
+ (string= "ABC" (write-to-string '|ABC| :escape nil :case :upcase)))
+
+(let ((*readtable* (copy-readtable nil)))
+ (setf (readtable-case *readtable*) :invert)
+ (string= "abc" (write-to-string '|ABC| :escape nil :case :upcase)))
+
+
+(let ((*readtable* (copy-readtable nil)))
+ (setf (readtable-case *readtable*) :upcase)
+ (string= "ABC-abc" (write-to-string '|ABC-abc| :escape nil :case :upcase)))
+
+(let ((*readtable* (copy-readtable nil)))
+ (setf (readtable-case *readtable*) :downcase)
+ (string= "ABC-ABC" (write-to-string '|ABC-abc| :escape nil :case :upcase)))
+
+(let ((*readtable* (copy-readtable nil)))
+ (setf (readtable-case *readtable*) :preserve)
+ (string= "ABC-abc" (write-to-string '|ABC-abc| :escape nil :case :upcase)))
+
+(let ((*readtable* (copy-readtable nil)))
+ (setf (readtable-case *readtable*) :invert)
+ (string= "ABC-abc" (write-to-string '|ABC-abc| :escape nil :case :upcase)))
+
+
+(let ((*readtable* (copy-readtable nil)))
+ (setf (readtable-case *readtable*) :upcase)
+ (string= "abc-ABC" (write-to-string '|abc-ABC| :escape nil :case :upcase)))
+
+(let ((*readtable* (copy-readtable nil)))
+ (setf (readtable-case *readtable*) :downcase)
+ (string= "ABC-ABC" (write-to-string '|abc-ABC| :escape nil :case :upcase)))
+
+(let ((*readtable* (copy-readtable nil)))
+ (setf (readtable-case *readtable*) :preserve)
+ (string= "abc-ABC" (write-to-string '|abc-ABC| :escape nil :case :upcase)))
+
+(let ((*readtable* (copy-readtable nil)))
+ (setf (readtable-case *readtable*) :invert)
+ (string= "abc-ABC" (write-to-string '|abc-ABC| :escape nil :case :upcase)))
+
+
+;; accessible symbol, escaping off, *print-case* :downcase
+(let ((*readtable* (copy-readtable nil)))
+ (setf (readtable-case *readtable*) :upcase)
+ (string= "abc" (write-to-string '|abc| :escape nil :case :downcase)))
+
+(let ((*readtable* (copy-readtable nil)))
+ (setf (readtable-case *readtable*) :downcase)
+ (string= "abc" (write-to-string '|abc| :escape nil :case :downcase)))
+
+(let ((*readtable* (copy-readtable nil)))
+ (setf (readtable-case *readtable*) :preserve)
+ (string= "abc" (write-to-string '|abc| :escape nil :case :downcase)))
+
+(let ((*readtable* (copy-readtable nil)))
+ (setf (readtable-case *readtable*) :invert)
+ (string= "ABC" (write-to-string '|abc| :escape nil :case :downcase)))
+
+
+(let ((*readtable* (copy-readtable nil)))
+ (setf (readtable-case *readtable*) :upcase)
+ (string= "abc" (write-to-string '|ABC| :escape nil :case :downcase)))
+
+(let ((*readtable* (copy-readtable nil)))
+ (setf (readtable-case *readtable*) :downcase)
+ (string= "ABC" (write-to-string '|ABC| :escape nil :case :downcase)))
+
+(let ((*readtable* (copy-readtable nil)))
+ (setf (readtable-case *readtable*) :preserve)
+ (string= "ABC" (write-to-string '|ABC| :escape nil :case :downcase)))
+
+(let ((*readtable* (copy-readtable nil)))
+ (setf (readtable-case *readtable*) :invert)
+ (string= "abc" (write-to-string '|ABC| :escape nil :case :downcase)))
+
+
+(let ((*readtable* (copy-readtable nil)))
+ (setf (readtable-case *readtable*) :upcase)
+ (string= "abc-abc" (write-to-string '|ABC-abc| :escape nil :case :downcase)))
+
+(let ((*readtable* (copy-readtable nil)))
+ (setf (readtable-case *readtable*) :downcase)
+ (string= "ABC-abc" (write-to-string '|ABC-abc| :escape nil :case :downcase)))
+
+(let ((*readtable* (copy-readtable nil)))
+ (setf (readtable-case *readtable*) :preserve)
+ (string= "ABC-abc" (write-to-string '|ABC-abc| :escape nil :case :downcase)))
+
+(let ((*readtable* (copy-readtable nil)))
+ (setf (readtable-case *readtable*) :invert)
+ (string= "ABC-abc" (write-to-string '|ABC-abc| :escape nil :case :downcase)))
+
+
+(let ((*readtable* (copy-readtable nil)))
+ (setf (readtable-case *readtable*) :upcase)
+ (string= "abc-abc" (write-to-string '|abc-ABC| :escape nil :case :downcase)))
+
+(let ((*readtable* (copy-readtable nil)))
+ (setf (readtable-case *readtable*) :downcase)
+ (string= "abc-ABC" (write-to-string '|abc-ABC| :escape nil :case :downcase)))
+
+(let ((*readtable* (copy-readtable nil)))
+ (setf (readtable-case *readtable*) :preserve)
+ (string= "abc-ABC" (write-to-string '|abc-ABC| :escape nil :case :downcase)))
+
+(let ((*readtable* (copy-readtable nil)))
+ (setf (readtable-case *readtable*) :invert)
+ (string= "abc-ABC" (write-to-string '|abc-ABC| :escape nil :case :downcase)))
+
+
+
+;; keyword symbol, escaping off
+(let ((*readtable* (copy-readtable nil)))
+ (setf (readtable-case *readtable*) :upcase)
+ (string= "abc-Abc"
+ (write-to-string ':|abc-ABC| :escape nil :case :capitalize)))
+
+(let ((*readtable* (copy-readtable nil)))
+ (setf (readtable-case *readtable*) :upcase)
+ (string= "abc-ABC" (write-to-string ':|abc-ABC| :escape nil :case :upcase)))
+
+(let ((*readtable* (copy-readtable nil)))
+ (setf (readtable-case *readtable*) :upcase)
+ (string= "abc-abc" (write-to-string ':|abc-ABC| :escape nil :case :downcase)))
+
+
+;; non accessible symbol, escaping off
+(let ((*readtable* (copy-readtable nil)))
+ (when (find-package "TEST-PKG0") (delete-package "TEST-PKG0"))
+ (make-package "TEST-PKG0" :use ())
+ (setf (readtable-case *readtable*) :upcase)
+ (string= "abc" (write-to-string (intern "abc" "TEST-PKG0")
+ :escape nil :case :capitalize)))
+
+(let ((*readtable* (copy-readtable nil)))
+ (when (find-package "TEST-PKG0") (delete-package "TEST-PKG0"))
+ (make-package "TEST-PKG0" :use ())
+ (setf (readtable-case *readtable*) :upcase)
+ (string= "abc" (write-to-string (intern "abc" "TEST-PKG0")
+ :escape nil :case :upcase)))
+
+(let ((*readtable* (copy-readtable nil)))
+ (when (find-package "TEST-PKG0") (delete-package "TEST-PKG0"))
+ (make-package "TEST-PKG0" :use ())
+ (setf (readtable-case *readtable*) :upcase)
+ (string= "abc" (write-to-string (intern "abc" "TEST-PKG0")
+ :escape nil :case :downcase)))
+
+
+
+;; accessible symbol, *print-readably* t
+(loop
+ named loop0
+ with printed-name
+ with *readtable* = (copy-readtable nil)
+ for readtable-case in '(:upcase :downcase :preserve :invert)
+ do (loop
+ for *print-case* in '(:upcase :downcase :capitalize)
+ do (loop
+ for symbol in '(|ZEBRA| |Zebra| |zebra|)
+ do (setf (readtable-case *readtable*) readtable-case)
+ (setq printed-name (write-to-string symbol :readably t))
+ unless (eq symbol (read-from-string printed-name))
+ do (format t "~&Symbol = ~S~%Erroneous printed representation = ~S~%readtable-case = ~S~%*print-case* = ~S~%"
+ symbol printed-name readtable-case *print-case*)
+ (return-from loop0 nil)))
+ finally (return-from loop0 t))
+
+;; keyword symbol, *print-readably* t
+(loop
+ named loop0
+ with printed-name
+ with *readtable* = (copy-readtable nil)
+ for readtable-case in '(:upcase :downcase :preserve :invert)
+ do (loop
+ for *print-case* in '(:upcase :downcase :capitalize)
+ do (loop
+ for symbol in '(:|ZEBRA| :|Zebra| :|zebra|)
+ do (setf (readtable-case *readtable*) readtable-case)
+ (setq printed-name (write-to-string symbol :readably t))
+ unless (eq symbol (read-from-string printed-name))
+ do (format t "~&Symbol = ~S~%Erroneous printed representation = ~S~%readtable-case = ~S~%*print-case* = ~S~%"
+ symbol printed-name readtable-case *print-case*)
+ (return-from loop0 nil)))
+ finally (return-from loop0 t))
+
+;; non accessible symbol, *print-readably* t
+(progn
+ (when (find-package "TEST-PKG0") (delete-package "TEST-PKG0"))
+ (make-package "TEST-PKG0" :use ())
+ (loop
+ named loop0
+ with printed-name
+ with *readtable* = (copy-readtable nil)
+ for readtable-case in '(:upcase :downcase :preserve :invert)
+ do (loop
+ for *print-case* in '(:upcase :downcase :capitalize)
+ do (loop
+ for symbol in (mapcar #'(lambda (name) (intern name "TEST-PKG0"))
+ '("ZEBRA" "Zebra" "zebra"))
+ do (setf (readtable-case *readtable*) readtable-case)
+ (setq printed-name (write-to-string symbol :readably t))
+ unless (eq symbol (read-from-string printed-name))
+ do (format t "~&Symbol = ~S~%Erroneous printed representation = ~S~%readtable-case = ~S~%*print-case* = ~S~%"
+ symbol printed-name readtable-case *print-case*)
+ (return-from loop0 nil)))
+ finally (return-from loop0 t)))
+
+
+;; symbols having nongraphic characters in their name
+(eq '| | (read-from-string (write-to-string '| | :readably t)))
+(eq '|
+| (read-from-string (write-to-string '|
+| :readably t)))
+
+;; symbols having nonalphabetic characters in their name
+(eq '| | (read-from-string (write-to-string '| | :readably t)))
+(eq '|"| (read-from-string (write-to-string '|"| :readably t)))
+(eq '|#| (read-from-string (write-to-string '|#| :readably t)))
+(eq '|'| (read-from-string (write-to-string '|'| :readably t)))
+(eq '|(| (read-from-string (write-to-string '|(| :readably t)))
+(eq '|)| (read-from-string (write-to-string '|)| :readably t)))
+(eq '|,| (read-from-string (write-to-string '|,| :readably t)))
+(eq '|;| (read-from-string (write-to-string '|;| :readably t)))
+(eq '|\\| (read-from-string (write-to-string '|\\| :readably t)))
+(= 1 (length (symbol-name (read-from-string (write-to-string '|\\|
+ :readably t)))))
+(eq '|`| (read-from-string (write-to-string '|`| :readably t)))
+(eq '|\|| (read-from-string (write-to-string '|\|| :readably t)))
+(= 1 (length (symbol-name (read-from-string (write-to-string '|\||
+ :readably t)))))
+(loop
+ for symbol in '(|-!-| |/*/| |$$$| |^^^^^^^^^^^^^|)
+ always (loop
+ with *readtable* = (copy-readtable nil)
+ for table-case in '(:upcase :downcase :preserve :invert)
+ do (setf (readtable-case *readtable*) table-case)
+ always (loop for *print-case in '(:upcase :downcase :capitalize)
+ always (string= (symbol-name symbol)
+ (write-to-string symbol :escape nil)))))
+
+;; uninterned symbols
+(string= "ABC"
+ (symbol-name (read-from-string (write-to-string (make-symbol "ABC")
+ :readably t
+ :case :upcase))))
+(string= "ABC"
+ (symbol-name (read-from-string (write-to-string (make-symbol "ABC")
+ :readably t
+ :case :downcase))))
+(string= "ABC"
+ (symbol-name (read-from-string (write-to-string (make-symbol "ABC")
+ :readably t
+ :case :capitalize))))
+(string= "G01" (write-to-string (make-symbol "G01") :escape t :gensym nil))
+(string= "G01" (write-to-string (make-symbol "G01") :escape nil :gensym nil))
+(string= "#:G01" (write-to-string (make-symbol "G01") :escape t :gensym t))
+#-CLISP ;Bruno: CLISP prints symbols readably with vertical bars: "#:|G01|"
+(string= "#:G01"
+ ;; Variable *PRINT-READABLY*
+ ;; http://www.lispworks.com/reference/HyperSpec/Body/v_pr_rda.htm
+ ;; If the value of some other printer control variable is such
+ ;; that these requirements would be violated, the value of that
+ ;; other variable is ignored.
+ ;; Specifically, if *print-readably* is true, printing proceeds
+ ;; as if *print-escape*, *print-array*, and *print-gensym* were
+ ;; also true, and as if *print-length*, *print-level*, and
+ ;; *print-lines* were false.
+ (write-to-string (make-symbol "G01")
+ :escape nil :gensym nil :readably t))
+
+
+;; "FACE" as a symbol when *read-base* is 16
+(let ((face (let ((*print-base* 16)) (write-to-string 'face :readably t)))
+ (*read-base* 16))
+ ;; 22.1.3.3 Printing Symbols
+ ;; http://www.lispworks.com/reference/HyperSpec/Body/22_acc.htm
+ ;; When printing a symbol, the printer inserts enough single escape
+ ;; and/or multiple escape characters (backslashes and/or vertical-bars)
+ ;; so that if read were called with the same *readtable* and with
+ ;; *read-base* bound to the current output base, it would return the same
+ ;; symbol (if it is not apparently uninterned) or an uninterned symbol
+ ;; with the same print name (otherwise).
+ ;; For example, if the value of *print-base* were 16 when printing the
+ ;; symbol face, it would have to be printed as \FACE or \Face or |FACE|,
+ ;; because the token face would be read as a hexadecimal number (decimal
+ ;; value 64206) if the value of *read-base* were 16.
+ (eq 'face (read-from-string face)))
+
+
+(eq '|01| (read-from-string (write-to-string '|01| :readably t)))
+(eq '|1| (read-from-string (write-to-string '|1| :readably t)))
+(eq '|0123456789| (read-from-string (write-to-string '|0123456789|
+ :readably t)))
+
+;; symbols in a package with a mixed case name, *print-readably* t
+(progn
+ (when (find-package "Test-Pkg0") (delete-package "Test-Pkg0"))
+ (make-package "Test-Pkg0" :use ())
+ (loop
+ named loop0
+ with printed-name
+ with *readtable* = (copy-readtable nil)
+ for readtable-case in '(:upcase :downcase :preserve :invert)
+ do (loop
+ for *print-case* in '(:upcase :downcase :capitalize)
+ do (loop
+ for symbol in (mapcar #'(lambda (name) (intern name "Test-Pkg0"))
+ '("ZEBRA" "Zebra" "zebra"))
+ do (setf (readtable-case *readtable*) readtable-case)
+ (setq printed-name (write-to-string symbol :readably t))
+ unless (eq symbol (read-from-string printed-name))
+ do (format t "~&Symbol = ~S~%Erroneous printed representation = ~S~%readtable-case = ~S~%*print-case* = ~S~%"
+ symbol printed-name readtable-case *print-case*)
+ (return-from loop0 nil)))
+ finally (return-from loop0 t)))
+
+;; symbols in a package with weird chars in the name, *print-readably* t
+(progn
+ (when (find-package "Test\|Pkg 0\;") (delete-package "Test\|Pkg 0\;"))
+ (make-package "Test\|Pkg 0\;" :use ())
+ (loop
+ named loop0
+ with *readtable* = (copy-readtable nil)
+ for readtable-case in '(:upcase :downcase :preserve :invert)
+ do (loop
+ for *print-case* in '(:upcase :downcase :capitalize)
+ do (loop
+ for symbol in (mapcar #'(lambda (name) (intern name "Test\|Pkg 0\;"))
+ '("ZEBRA" "Zebra" "zebra"))
+ do (setf (readtable-case *readtable*) readtable-case)
+ unless (eq symbol (read-from-string (write-to-string symbol
+ :readably t)))
+ do (format t "~&Symbol = ~S~%Erroneous printed representation = ~S~%readtable-case = ~S~%*print-case* = ~S~%"
+ symbol printed-name readtable-case *print-case*)
+ (return-from loop0 nil)))
+ finally (return-from loop0 t)))
+
+
+;; weird symbols in a weird package, *print-readably* t
+(progn
+ (when (find-package "Test\|Pkg 0\;") (delete-package "Test\|Pkg 0\;"))
+ (make-package "Test\|Pkg 0\;" :use ())
+ (loop
+ named loop0
+ with *readtable* = (copy-readtable nil)
+ for readtable-case in '(:upcase :downcase :preserve :invert)
+ do (loop
+ for *print-case* in '(:upcase :downcase :capitalize)
+ do (loop
+ for symbol in (mapcar #'(lambda (name) (intern name "Test\|Pkg 0\;"))
+ '("Z\\E\"BRA" "Z\;e\|bra" "z\:e bra"))
+ do (setf (readtable-case *readtable*) readtable-case)
+ unless (eq symbol (read-from-string (write-to-string symbol
+ :readably t)))
+ do (format t "~&Symbol = ~S~%Erroneous printed representation = ~S~%readtable-case = ~S~%*print-case* = ~S~%"
+ symbol printed-name readtable-case *print-case*)
+ (return-from loop0 nil)))
+ finally (return-from loop0 t)))
+
+
+
+;; bit-vector
+(string= "#*0101" (write-to-string #*0101 :readably t :array t))
+(string= "#*01" (write-to-string #*01 :readably t :array t))
+(string= "#*0" (write-to-string #*0 :readably t :array t))
+(string= "#*1" (write-to-string #*1 :readably t :array t))
+(string= "#*" (write-to-string #* :readably t :array t))
+(string= "#*10101111000" (write-to-string #*10101111000
+ :readably t :array t))
+
+(string= "#*0101" (write-to-string #*0101 :readably t :array nil))
+(string= "#*01" (write-to-string #*01 :readably t :array nil))
+(string= "#*0" (write-to-string #*0 :readably t :array nil))
+(string= "#*1" (write-to-string #*1 :readably t :array nil))
+(string= "#*" (write-to-string #* :readably t :array nil))
+(string= "#*10101111000" (write-to-string #*10101111000
+ :readably t :array nil))
+
+(string= "#*0101" (write-to-string #*0101 :array t))
+(string= "#*01" (write-to-string #*01 :array t))
+(string= "#*0" (write-to-string #*0 :array t))
+(string= "#*1" (write-to-string #*1 :array t))
+(string= "#*" (write-to-string #* :array t))
+(string= "#*10101111000" (write-to-string #*10101111000 :array t))
+
+(zerop (search "#<" (write-to-string #*0101 :array nil)))
+(zerop (search "#<" (write-to-string #*01 :array nil)))
+(zerop (search "#<" (write-to-string #*0 :array nil)))
+(zerop (search "#<" (write-to-string #*1 :array nil)))
+(zerop (search "#<" (write-to-string #* :array nil)))
+(zerop (search "#<" (write-to-string #*10101111000 :array nil)))
+(string= "#*01"
+ (write-to-string (make-array 10
+ :element-type 'bit
+ :initial-contents '(0 1 0 1 0 1 0 1 0 1)
+ :fill-pointer 2)
+ :readably t :array t))
+
+
+;; list
+(null (read-from-string (write-to-string '())))
+(string= (write-to-string '(1) :pretty nil) "(1)")
+(string= (write-to-string '(1 2) :pretty nil) "(1 2)")
+(string= (write-to-string '(1 2 3) :pretty nil) "(1 2 3)")
+(string= (write-to-string '(1 2 3 4) :pretty nil) "(1 2 3 4)")
+(string= (write-to-string '(1 . 2) :pretty nil) "(1 . 2)")
+(string= (write-to-string '(1 2 . 3) :pretty nil) "(1 2 . 3)")
+(string= (write-to-string '(1 2 3 . 4) :pretty nil) "(1 2 3 . 4)")
+(let ((list (loop for i from 0 upto 100 collect i)))
+ (equal (read-from-string (write-to-string list)) list))
+
+;; list *print-level* *print-length*
+(string= (write-to-string '(1 (2 (3 (4 (5 (6)))))) :pretty nil :level 0) "#")
+(string= (write-to-string '(1 (2 (3 (4 (5 (6)))))) :pretty nil :level 1)
+ "(1 #)")
+(string= (write-to-string '(1 (2 (3 (4 (5 (6)))))) :pretty nil :level 2)
+ "(1 (2 #))")
+(string= (write-to-string '(1 (2 (3 (4 (5 (6)))))) :pretty nil :level 3)
+ "(1 (2 (3 #)))")
+(string= (write-to-string '(1 (2 (3 (4 (5 (6)))))) :pretty nil :level 4)
+ "(1 (2 (3 (4 #))))")
+(string= (write-to-string '(1 (2 (3 (4 (5 (6)))))) :pretty nil :level 4)
+ "(1 (2 (3 (4 #))))")
+(string= (write-to-string '(1 (2 (3 (4 (5 (6)))))) :pretty nil :level 5)
+ "(1 (2 (3 (4 (5 #)))))")
+(string= (write-to-string '(1 (2 (3 (4 (5 (6)))))) :pretty nil :level 6)
+ "(1 (2 (3 (4 (5 (6))))))")
+(string= (write-to-string '(1 (2 (3 (4 (5 (6)))))) :pretty nil :level 7)
+ "(1 (2 (3 (4 (5 (6))))))")
+(string= (write-to-string '(1 (2 (3 (4 (5 (6)))))) :pretty nil :level 100)
+ "(1 (2 (3 (4 (5 (6))))))")
+
+(string= (write-to-string '(1 2 3 4 5 6) :pretty nil :length 0) "(...)")
+(string= (write-to-string '(1 2 3 4 5 6) :pretty nil :length 1) "(1 ...)")
+(string= (write-to-string '(1 2 3 4 5 6) :pretty nil :length 2) "(1 2 ...)")
+(string= (write-to-string '(1 2 3 4 5 6) :pretty nil :length 3) "(1 2 3 ...)")
+(string= (write-to-string '(1 2 3 4 5 6) :pretty nil :length 4) "(1 2 3 4 ...)")
+(string= (write-to-string '(1 2 3 4 5 6) :pretty nil :length 5)
+ "(1 2 3 4 5 ...)")
+(string= (write-to-string '(1 2 3 4 5 6) :pretty nil :length 6)
+ "(1 2 3 4 5 6)")
+(string= (write-to-string '(1 2 3 4 5 6) :pretty nil :length 7)
+ "(1 2 3 4 5 6)")
+(string= (write-to-string '(1 2 3 4 5 6) :pretty nil :length 100)
+ "(1 2 3 4 5 6)")
+
+(string= (write-to-string '(1 2 . 3) :pretty nil :length 0) "(...)")
+(string= (write-to-string '(1 2 . 3) :pretty nil :length 1) "(1 ...)")
+(string= (write-to-string '(1 2 . 3) :pretty nil :length 2) "(1 2 . 3)")
+(string= (write-to-string '(1 2 . 3) :pretty nil :length 3) "(1 2 . 3)")
+
+(string= (write-to-string '(1 (2 (3 (4 (5 (6))))))
+ :pretty nil :level 0 :length 0)
+ "#")
+(string= (write-to-string '(1 (2 (3 (4 (5 (6))))))
+ :pretty nil :level 1 :length 0)
+ "(...)")
+(string= (write-to-string '(1 (2 (3 (4 (5 (6))))))
+ :pretty nil :level 0 :length 1)
+ "#")
+(string= (write-to-string '(1 (2 (3 (4 (5 (6))))))
+ :pretty nil :level 1 :length 1)
+ "(1 ...)")
+(string= (write-to-string '(1 (2 (3 (4 (5 (6))))))
+ :pretty nil :level 2 :length 1)
+ "(1 ...)")
+(string= (write-to-string '(1 (2 (3 (4 (5 (6))))))
+ :pretty nil :level 2 :length 2)
+ "(1 (2 #))")
+
+(string= (write-to-string '((((1))) ((2)) (3) 4)
+ :pretty nil :level 0 :length 0)
+ "#")
+(string= (write-to-string '((((1))) ((2)) (3) 4)
+ :pretty nil :level 1 :length 0)
+ "(...)")
+(string= (write-to-string '((((1))) ((2)) (3) 4)
+ :pretty nil :level 1 :length 4)
+ "(# # # 4)")
+(string= (write-to-string '((((1))) ((2)) (3) 4)
+ :pretty nil :level 2 :length 3)
+ "((#) (#) (3) ...)")
+(string= (write-to-string '((((1))) ((2)) (3) 4)
+ :pretty nil :level 3 :length 3)
+ "(((#)) ((2)) (3) ...)")
+(string= (write-to-string '((((1))) ((2)) (3) 4)
+ :pretty nil :level 4 :length 3)
+ "((((1))) ((2)) (3) ...)")
+(string= (write-to-string '((((1))) ((2)) (3) 4)
+ :pretty nil :level 2 :length 4)
+ "((#) (#) (3) 4)")
+(string= (write-to-string '((((1))) ((2)) (3) 4)
+ :pretty nil :level 4 :length 4)
+ "((((1))) ((2)) (3) 4)")
+
+(string= (write-to-string '((((1))) ((2)) (3) 4 (5) ((6)) (((7))))
+ :pretty nil :level 3 :length 6)
+ "(((#)) ((2)) (3) 4 (5) ((6)) ...)")
+
+(string= (write-to-string '((((1 ((2)) (3)))) ((2 (3) 4 5 6)) (3 (4 (5 6))))
+ :pretty nil :level 6 :length 3)
+ "((((1 ((2)) (3)))) ((2 (3) 4 ...)) (3 (4 (5 6))))")
+(string= (write-to-string '((((1 ((2)) (3)))) ((2 (3) 4 5 6)) (3 (4 (5 6))))
+ :pretty nil :level 2 :length 2)
+ "((#) (#) ...)")
+(string= (write-to-string '((((1 ((2)) (3)))) ((2 (3) 4 5 6)) (3 (4 (5 6))))
+ :pretty nil :level 3 :length 2)
+ "(((#)) ((2 # ...)) ...)")
+(string= (write-to-string '(((1)) ((1) 2 ((3)) (((4)))) 3 (4))
+ :pretty nil :level 2 :length 3)
+ "((#) (# 2 # ...) 3 ...)")
+
+
+
+;; vector
+;; 22.1.3.7 Printing Other Vectors
+;; http://www.lispworks.com/reference/HyperSpec/Body/22_acg.htm
+;; If *print-array* is true and *print-readably* is false, any vector
+;; other than a string or bit vector is printed using general-vector
+;; syntax; this means that information about specialized vector
+;; representations does not appear. The printed representation of a
+;; zero-length vector is #(). The printed representation of a
+;; non-zero-length vector begins with #(. Following that, the first
+;; element of the vector is printed. If there are any other elements,
+;; they are printed in turn, with each such additional element preceded
+;; by a space if *print-pretty* is false, or whitespace[1] if
+;; *print-pretty* is true. A right-parenthesis after the last element
+;; terminates the printed representation of the vector.
+(string= (write-to-string '#() :pretty nil :array t) "#()")
+(string= (write-to-string '#(1) :pretty nil :array t) "#(1)")
+(string= (write-to-string '#(1 2 3) :pretty nil :array t) "#(1 2 3)")
+(string= (write-to-string (make-array 10
+ :initial-contents '(0 1 2 3 4 5 6 7 8 9)
+ :fill-pointer 3)
+ :pretty nil :array t)
+ "#(0 1 2)")
+
+;; vector *print-level* *print-length*
+(string= (write-to-string '#(1 (2 (3 (4 (5 (6))))))
+ :pretty nil :array t :level 0) "#")
+(string= (write-to-string '#(1 (2 (3 (4 (5 (6))))))
+ :pretty nil :array t :level 1)
+ "#(1 #)")
+(string= (write-to-string '#(1 (2 (3 (4 (5 (6))))))
+ :pretty nil :array t :level 2)
+ "#(1 (2 #))")
+(string= (write-to-string '#(1 (2 (3 (4 (5 (6))))))
+ :pretty nil :array t :level 3)
+ "#(1 (2 (3 #)))")
+(string= (write-to-string '#(1 (2 (3 (4 (5 (6))))))
+ :pretty nil :array t :level 4)
+ "#(1 (2 (3 (4 #))))")
+(string= (write-to-string '#(1 (2 (3 (4 (5 (6))))))
+ :pretty nil :array t :level 4)
+ "#(1 (2 (3 (4 #))))")
+(string= (write-to-string '#(1 (2 (3 (4 (5 (6))))))
+ :pretty nil :array t :level 5)
+ "#(1 (2 (3 (4 (5 #)))))")
+(string= (write-to-string '#(1 (2 (3 (4 (5 (6))))))
+ :pretty nil :array t :level 6)
+ "#(1 (2 (3 (4 (5 (6))))))")
+(string= (write-to-string '#(1 (2 (3 (4 (5 (6))))))
+ :pretty nil :array t :level 7)
+ "#(1 (2 (3 (4 (5 (6))))))")
+(string= (write-to-string '#(1 (2 (3 (4 (5 (6))))))
+ :pretty nil :array t :level 100)
+ "#(1 (2 (3 (4 (5 (6))))))")
+
+(string= (write-to-string '#(1 2 3 4 5 6) :pretty nil :array t :length 0)
+ "#(...)")
+(string= (write-to-string '#(1 2 3 4 5 6) :pretty nil :array t :length 1)
+ "#(1 ...)")
+(string= (write-to-string '#(1 2 3 4 5 6) :pretty nil :array t :length 2)
+ "#(1 2 ...)")
+(string= (write-to-string '#(1 2 3 4 5 6) :pretty nil :array t :length 3)
+ "#(1 2 3 ...)")
+(string= (write-to-string '#(1 2 3 4 5 6) :pretty nil :array t :length 4)
+ "#(1 2 3 4 ...)")
+(string= (write-to-string '#(1 2 3 4 5 6) :pretty nil :array t :length 5)
+ "#(1 2 3 4 5 ...)")
+(string= (write-to-string '#(1 2 3 4 5 6) :pretty nil :array t :length 6)
+ "#(1 2 3 4 5 6)")
+(string= (write-to-string '#(1 2 3 4 5 6) :pretty nil :array t :length 7)
+ "#(1 2 3 4 5 6)")
+(string= (write-to-string '#(1 2 3 4 5 6) :pretty nil :array t :length 100)
+ "#(1 2 3 4 5 6)")
+
+(string= (write-to-string '#(1 #(2 #(3 #(4 #(5 #(6))))))
+ :pretty nil :array t :level 0 :length 0)
+ "#")
+(string= (write-to-string '#(1 #(2 #(3 #(4 #(5 #(6))))))
+ :pretty nil :array t :level 1 :length 0)
+ "#(...)")
+(string= (write-to-string '#(1 #(2 #(3 #(4 #(5 #(6))))))
+ :pretty nil :array t :level 0 :length 1)
+ "#")
+(string= (write-to-string '#(1 #(2 #(3 #(4 #(5 #(6))))))
+ :pretty nil :array t :level 1 :length 1)
+ "#(1 ...)")
+(string= (write-to-string '#(1 #(2 #(3 #(4 #(5 #(6))))))
+ :pretty nil :array t :level 2 :length 1)
+ "#(1 ...)")
+(string= (write-to-string '#(1 #(2 #(3 #(4 #(5 #(6))))))
+ :pretty nil :array t :level 2 :length 2)
+ "#(1 #(2 #))")
+
+(string= (write-to-string '#(#(#(#(1))) #(#(2)) #(3) 4)
+ :pretty nil :array t :level 0 :length 0)
+ "#")
+(string= (write-to-string '#(#(#(#(1))) #(#(2)) #(3) 4)
+ :pretty nil :array t :level 1 :length 0)
+ "#(...)")
+(string= (write-to-string '#(#(#(#(1))) #(#(2)) #(3) 4)
+ :pretty nil :array t :level 1 :length 4)
+ "#(# # # 4)")
+(string= (write-to-string '#(#(#(#(1))) #(#(2)) #(3) 4)
+ :pretty nil :array t :level 2 :length 3)
+ "#(#(#) #(#) #(3) ...)")
+(string= (write-to-string '#(#(#(#(1))) #(#(2)) #(3) 4)
+ :pretty nil :array t :level 3 :length 3)
+ "#(#(#(#)) #(#(2)) #(3) ...)")
+(string= (write-to-string '#(#(#(#(1))) #(#(2)) #(3) 4)
+ :pretty nil :array t :level 4 :length 3)
+ "#(#(#(#(1))) #(#(2)) #(3) ...)")
+(string= (write-to-string '#(#(#(#(1))) #(#(2)) #(3) 4)
+ :pretty nil :array t :level 2 :length 4)
+ "#(#(#) #(#) #(3) 4)")
+(string= (write-to-string '#(#(#(#(1))) #(#(2)) #(3) 4)
+ :pretty nil :array t :level 4 :length 4)
+ "#(#(#(#(1))) #(#(2)) #(3) 4)")
+
+(string= (write-to-string '#(#(#(#(1))) #(#(2)) #(3) 4 #(5) #(#(6)) #(#(#(7))))
+ :pretty nil :array t :level 3 :length 6)
+ "#(#(#(#)) #(#(2)) #(3) 4 #(5) #(#(6)) ...)")
+
+(string= (write-to-string '#(#(#(#(1 #(#(2)) #(3))))
+ #(#(2 #(3) 4 5 6))
+ #(3 #(4 #(5 6))))
+ :pretty nil :array t :level 6 :length 3)
+ "#(#(#(#(1 #(#(2)) #(3)))) #(#(2 #(3) 4 ...)) #(3 #(4 #(5 6))))")
+(string= (write-to-string '#(#(#(#(1 #(#(2)) #(3))))
+ #(#(2 #(3) 4 5 6))
+ #(3 #(4 #(5 6))))
+ :pretty nil :array t :level 2 :length 2)
+ "#(#(#) #(#) ...)")
+(string= (write-to-string '#(#(#(#(1 #(#(2)) #(3))))
+ #(#(2 #(3) 4 5 6))
+ #(3 #(4 #(5 6))))
+ :pretty nil :array t :level 3 :length 2)
+ "#(#(#(#)) #(#(2 # ...)) ...)")
+(string= (write-to-string '#(#(#(1)) #(#(1) 2 #(#(3)) #(#(#(4)))) 3 #(4))
+ :pretty nil :array t :level 2 :length 3)
+ "#(#(#) #(# 2 # ...) 3 ...)")
+
+
+;; array
+(string= (write-to-string '#0A1 :pretty nil :array t) "#0A1")
+(string= (write-to-string '#1A() :pretty nil :array t) "#()")
+(string= (write-to-string '#1A(1 2 3) :pretty nil :array t) "#(1 2 3)")
+(string= (write-to-string '#2A((1 2 3) (4 5 6)) :pretty nil :array t)
+ "#2A((1 2 3) (4 5 6))")
+(string= (write-to-string '#3A(((1 a) (2 b) (3 c))
+ ((4 d) (5 e) (6 f))) :pretty nil :array t)
+ "#3A(((1 A) (2 B) (3 C)) ((4 D) (5 E) (6 F)))")
+(string= (write-to-string (make-array (make-list 20 :initial-element 1)
+ :initial-element 0)
+ :pretty nil :array t)
+ "#20A((((((((((((((((((((0))))))))))))))))))))")
+
+;; array *print-level* *print-length*
+;(string= (write-to-string '#0A10 :pretty nil :array t :level 0 :length 0) "#")
+(string= (write-to-string '#0A10 :pretty nil :array t :level 1 :length 1)
+ "#0A10")
+(string= (write-to-string '#2A((0) (1) (2) (3))
+ :pretty nil :array t :level 1 :length 1)
+ "#2A(# ...)")
+(string= (write-to-string '#2A((0) (1) (2) (3))
+ :pretty nil :array t :level 2 :length 2)
+ "#2A((0) (1) ...)")
+(string= (write-to-string '#2A((0) (1) (2) (3))
+ :pretty nil :array t :level 2 :length 0)
+ "#2A(...)")
+(string= (write-to-string '#3A(((0) (1) (2)) ((3) (4) (5)))
+ :pretty nil :array t :level 3 :length 2)
+ "#3A(((0) (1) ...) ((3) (4) ...))")
+(string= (write-to-string (make-array (make-list 20 :initial-element 1)
+ :initial-element 0)
+ :pretty nil :array t :level 0 :length 100)
+ "#")
+(string= (write-to-string (make-array (make-list 20 :initial-element 1)
+ :initial-element 0)
+ :pretty nil :array t :level 100 :length 0)
+ "#20A(...)")
+(string= (write-to-string (make-array (make-list 20 :initial-element 1)
+ :initial-element 0)
+ :pretty nil :array t :level 10 :length 100)
+ "#20A((((((((((#))))))))))")
+(string= (write-to-string '#2A((0 1 2) (3 4 5) (6 7 8) (9 10 11))
+ :pretty nil :array t :level 2 :length 2)
+ "#2A((0 1 ...) (3 4 ...) ...)")
+(string= (write-to-string '#2A((0 1 2) (3 4 5) (6 7 8) (9 10 11))
+ :pretty nil :array t :level 1 :length 2)
+ "#2A(# # ...)")
+(string= (write-to-string '#3A(((0) (1) (2)) ((3) (4) (5))
+ ((6) (7) (8)) ((9) (10) (11)))
+ :pretty nil :array t :level 2 :length 3)
+ "#3A((# # #) (# # #) (# # #) ...)")
+(string= (write-to-string '#3A(((0) (1) (2)) ((3) (4) (5))
+ ((6) (7) (8)) ((9) (10) (11)))
+ :pretty nil :array t :level 3 :length 4)
+ "#3A(((0) (1) (2)) ((3) (4) (5)) ((6) (7) (8)) ((9) (10) (11)))")
+
+
+;; *print-array*
+(string= (write-to-string "abc" :array t :escape nil) "abc")
+(string= (write-to-string "abc" :array nil :escape nil) "abc")
+(= 2 (mismatch "#<" (write-to-string #() :array nil)))
+(= 2 (mismatch "#<" (write-to-string #(1 2 3) :array nil)))
+(= 2 (mismatch "#<" (write-to-string #*1010 :array nil)))
+(= 2 (mismatch "#<" (write-to-string #2A((0 1 2) (3 4 5)) :array nil)))
+(= 2 (mismatch "#<" (write-to-string #3A(((0 1) (2 3)) ((4 5) (6 7)))
+ :array nil)))
+(= 2 (mismatch "#<" (write-to-string #4A((((0) (1)) ((2) (3)))
+ (((4) (5)) ((6) (7)))
+ (((8) (9)) ((10) (11)))
+ (((12) (13)) ((14) (15))))
+ :array nil)))
+
+
+
+;; label
+(let* ((list '#1=(#1# . #1#))
+ (x (read-from-string (write-to-string list :circle t))))
+ (and (eq x (car x))
+ (eq x (cdr x))))
+
+(let* ((list '#1=(a . #1#))
+ (x (read-from-string (write-to-string list :circle t))))
+ (and (eq (car x) 'a)
+ (eq x (cdr x))))
+
+(let* ((list '(a . #1=(b c . #1#)))
+ (x (read-from-string (write-to-string list :circle t))))
+ (and (eq (first x) 'a)
+ (eq (second x) 'b)
+ (eq (third x) 'c)
+ (eq (fourth x) 'b)
+ (eq (cdr x) (nthcdr 3 x))))
+
+(let* ((list '(#1=#:G1041 #1#))
+ (x (read-from-string (write-to-string list :circle t))))
+ ;; 22.1.3.3.1 Package Prefixes for Symbols
+ ;; http://www.lispworks.com/reference/HyperSpec/Body/22_acca.htm
+ ;; Because the #: syntax does not intern the following symbol, it is
+ ;; necessary to use circular-list syntax if *print-circle* is true and
+ ;; the same uninterned symbol appears several times in an expression to
+ ;; be printed. For example, the result of
+ ;;
+ ;; (let ((x (make-symbol "FOO"))) (list x x))
+ ;;
+ ;; would be printed as (#:foo #:foo) if *print-circle* were false, but as
+ ;; (#1=#:foo #1#) if *print-circle* were true.
+ (and (= 2 (length x))
+ (symbolp (first x))
+ (eq (first x) (second x))))
+
+(let* ((list '#1=(a (b #2=(x y z) . #1#) . #2#))
+ (x (read-from-string (write-to-string list :circle t))))
+ (and (eq (first x) 'a)
+ (eq x (cddr (second x)))
+ (eq (second (second x)) (cddr x))))
+
+(let* ((list '#1=#(#1# a))
+ (x (read-from-string (write-to-string list :circle t))))
+ (and (eq x (aref x 0))
+ (eq 'a (aref x 1))))
+
+(let* ((list '#1=#(a #1#))
+ (x (read-from-string (write-to-string list :circle t))))
+ (and (eq (aref x 0) 'a)
+ (eq x (aref x 1))))
+
+(let* ((list '#(#1=#:G00 #1#))
+ (x (read-from-string (write-to-string list :circle t))))
+ (and (eq (aref x 0) (aref x 1))
+ (string= (symbol-name (aref x 0)) "G00")
+ (null (symbol-package (aref x 0)))))
+
+(let* ((list '#(#(#1=#:G00) #2=#(#1# a) #(#2# #1#)))
+ (x (read-from-string (write-to-string list :circle t))))
+ (and (= 3 (length x))
+ (= 1 (length (aref x 0)))
+ (= 2 (length (aref x 1)))
+ (= 2 (length (aref x 2)))
+ (eq (aref (aref x 0) 0) (aref (aref x 1) 0))
+ (eq 'a (aref (aref x 1) 1))
+ (eq (aref (aref x 0) 0) (aref (aref x 2) 1))
+ (eq (aref x 1) (aref (aref x 2) 0))))
+
+(let* ((array '#1=#0A#1#)
+ (x (read-from-string (write-to-string array :array t :circle t))))
+ (and (null (array-dimensions array))
+ (eq x (aref x))))
+(let* ((array '#1=#2A((1 2 3) (4 5 #1#)))
+ (x (read-from-string (write-to-string array :array t :circle t))))
+ (and (equal (array-dimensions array) '(2 3))
+ (= 1 (aref x 0 0))
+ (= 2 (aref x 0 1))
+ (= 3 (aref x 0 2))
+ (= 4 (aref x 1 0))
+ (= 5 (aref x 1 1))
+ (eq x (aref x 1 2))))
+(let* ((array #1=#3A(((1 a) (2 b) (3 #1#)) ((4 d) (5 e) (6 f))))
+ (x (read-from-string (write-to-string array :array t :circle t))))
+ (and (equal (array-dimensions array) '(2 3 2))
+ (= 1 (aref x 0 0 0))
+ (eq 'a (aref x 0 0 1))
+ (= 2 (aref x 0 1 0))
+ (eq 'b (aref x 0 1 1))
+ (= 3 (aref x 0 2 0))
+ (eq x (aref x 0 2 1))
+ (= 4 (aref x 1 0 0))
+ (eq 'd (aref x 1 0 1))
+ (= 5 (aref x 1 1 0))
+ (eq 'e (aref x 1 1 1))
+ (= 6 (aref x 1 2 0))
+ (eq 'f (aref x 1 2 1))))
+
+(let* ((array #3A(((1 #1=#:G0) (#2=#:G1 b) (3 #1#)) ((4 d) (5 e) (#2# f))))
+ (x (read-from-string (write-to-string array :array t :circle t))))
+ (and (equal (array-dimensions array) '(2 3 2))
+ (= 1 (aref x 0 0 0))
+ (eq (aref x 0 0 1) (aref x 0 2 1))
+ (null (symbol-package (aref x 0 0 1)))
+ (string= "G0" (symbol-name (aref x 0 0 1)))
+ (eq (aref x 0 1 0) (aref x 1 2 0))
+ (null (symbol-package (aref x 0 1 0)))
+ (string= "G1" (symbol-name (aref x 0 1 0)))
+ (eq 'b (aref x 0 1 1))
+ (= 3 (aref x 0 2 0))
+ (= 4 (aref x 1 0 0))
+ (eq 'd (aref x 1 0 1))
+ (= 5 (aref x 1 1 0))
+ (eq 'e (aref x 1 1 1))
+ (eq 'f (aref x 1 2 1))))
+
+(let* ((array #1=#3A(((#1# #2=#:G0) (#3=#:G1 #2#) (#3# #1#))
+ ((#1# #2#) (#2# #3#) (#2# #1#))))
+ (x (read-from-string (write-to-string array :array t :circle t))))
+ (and (equal (array-dimensions array) '(2 3 2))
+ (eq x (aref x 0 0 0))
+ (null (symbol-package (aref x 0 0 1)))
+ (string= (symbol-name (aref x 0 0 1)) "G0")
+ (null (symbol-package (aref x 0 1 0)))
+ (string= (symbol-name (aref x 0 1 0)) "G1")
+ (eq (aref x 0 1 0) (aref x 0 2 0))
+ (eq x (aref x 0 2 1))
+ (eq x (aref x 1 0 0))
+ (eq (aref x 1 0 1) (aref x 0 0 1))
+ (eq (aref x 1 1 0) (aref x 0 0 1))
+ (eq (aref x 1 1 1) (aref x 0 1 0))
+ (eq (aref x 1 2 0) (aref x 0 0 1))
+ (eq (aref x 1 2 1) x)))
+
+(let* ((array #4A((((0 #1=#:G00 2) (#1# 4 #2=#:G01))
+ ((#3=#:G02 #2# 8) (9 #4=#:G03 #3#))
+ ((#4# 12 #5=#:G04) (#6=#:G05 #6# #5#)))))
+ (x (read-from-string (write-to-string array :array t :circle t))))
+ (and (equal (array-dimensions array) '(1 3 2 3))
+ (= 0 (aref x 0 0 0 0))
+ (null (symbol-package (aref x 0 0 0 1)))
+ (string= (symbol-name (aref x 0 0 0 1)) "G00")
+ (= 2 (aref x 0 0 0 2))
+
+ (eq (aref x 0 0 1 0) (aref x 0 0 0 1))
+ (= 4 (aref x 0 0 1 1))
+ (null (symbol-package (aref x 0 0 1 2)))
+ (string= (symbol-name (aref x 0 0 1 2)) "G01")
+
+ (null (symbol-package (aref x 0 1 0 0)))
+ (string= (symbol-name (aref x 0 1 0 0)) "G02")
+ (eq (aref x 0 1 0 1) (aref x 0 0 1 2))
+ (= 8 (aref x 0 1 0 2))
+
+ (= 9 (aref x 0 1 1 0))
+ (null (symbol-package (aref x 0 1 1 1)))
+ (string= (symbol-name (aref x 0 1 1 1)) "G03")
+ (eq (aref x 0 1 1 2) (aref x 0 1 0 0))
+
+ (eq (aref x 0 2 0 0) (aref x 0 1 1 1))
+ (= 12 (aref x 0 2 0 1))
+ (null (symbol-package (aref x 0 2 0 2)))
+ (string= (symbol-name (aref x 0 2 0 2)) "G04")
+
+ (null (symbol-package (aref x 0 2 1 0)))
+ (string= (symbol-name (aref x 0 2 1 0)) "G05")
+ (eq (aref x 0 2 1 1) (aref x 0 2 1 0))
+ (eq (aref x 0 2 1 2) (aref x 0 2 0 2))))
+
+
+(let* ((sequence '#1=(#(0 #2=(#1#) #1# 3) #3=#2A((#1# #2#) (#3# 4))))
+ (x (read-from-string (write-to-string sequence :array t :circle t))))
+ (and (= 2 (length x))
+ (= 4 (length (first x)))
+ (= 0 (aref (first x) 0))
+ (eq x (first (aref (first x) 1)))
+ (eq x (aref (first x) 2))
+ (= 3 (aref (first x) 3))
+ (equal (array-dimensions (second x)) '(2 2))
+ (eq x (aref (second x) 0 0))
+ (eq (aref (second x) 0 1) (aref (first x) 1))
+ (eq (aref (second x) 1 0) (second x))
+ (= 4 (aref (second x) 1 1))))
+
+(let* ((sequence '#1=#(#2=(0 1 . #3=(2)) #(#3# #2# #1#) #3A(((#1# #2# #3#)))))
+ (x (read-from-string (write-to-string sequence :array t :circle t))))
+ (and (= 3 (length x))
+ (= 3 (length (aref x 0)))
+ (= 0 (first (aref x 0)))
+ (= 1 (second (aref x 0)))
+ (= 2 (third (aref x 0)))
+ (= 3 (length (aref x 1)))
+ (eq (aref (aref x 1) 0) (cddr (aref x 0)))
+ (eq (aref (aref x 1) 1) (aref x 0))
+ (eq (aref (aref x 1) 2) x)
+ (equal (array-dimensions (aref x 2)) '(1 1 3))
+ (eq (aref (aref x 2) 0 0 0) x)
+ (eq (aref (aref x 2) 0 0 1) (aref x 0))
+ (eq (aref (aref x 2) 0 0 2) (cddr (aref x 0)))))
+
+;; *print-level* *print-length* array, vector, list intermingled
+(let* ((sequence '((1 2 3) #(4 5 6) #2A((7 8 9) (10 11 12)))))
+ (string= (write-to-string sequence
+ :pretty nil :array t :level 0 :length 10)
+ "#"))
+(let* ((sequence '((1 2 3) #(4 5 6) #2A((7 8 9) (10 11 12)))))
+ (string= (write-to-string sequence
+ :pretty nil :array t :level 1 :length 10)
+ "(# # #)"))
+(let* ((sequence '((1 2 3) #(4 5 6) #2A((7 8 9) (10 11 12)))))
+ (string= (write-to-string sequence
+ :pretty nil :array t :level 2 :length 10)
+ "((1 2 3) #(4 5 6) #2A(# #))"))
+(let* ((sequence '((1 2 3) #(4 5 6) #2A((7 8 9) (10 11 12)))))
+ (string= (write-to-string sequence
+ :pretty nil :array t :level 3 :length 10)
+ "((1 2 3) #(4 5 6) #2A((7 8 9) (10 11 12)))"))
+(let* ((sequence '((1 2 3) #(4 5 6) #2A((7 8 9) (10 11 12)))))
+ (string= (write-to-string sequence
+ :pretty nil :array t :level 3 :length 1)
+ "((1 ...) ...)"))
+(let* ((sequence '((1 2 3) #(4 5 6) #2A((7 8 9) (10 11 12)))))
+ (string= (write-to-string sequence
+ :pretty nil :array t :level 3 :length 2)
+ "((1 2 ...) #(4 5 ...) ...)"))
+(let* ((sequence '((1 2 3) #(4 5 6) #2A((7 8 9) (10 11 12)))))
+ (string= (write-to-string sequence
+ :pretty nil :array t :level 3 :length 3)
+ "((1 2 3) #(4 5 6) #2A((7 8 9) (10 11 12)))"))
+(let* ((sequence '((1 2 3) #(4 5 6) #2A((7 8 9 10) (11 12 13 14)))))
+ (string= (write-to-string sequence
+ :pretty nil :array t :level 3 :length 3)
+ "((1 2 3) #(4 5 6) #2A((7 8 9 ...) (11 12 13 ...)))"))
+
+(let* ((sequence '#((1 2 3) #(4 5 6) #2A((7 8 9) (10 11 12)))))
+ (string= (write-to-string sequence
+ :pretty nil :array t :level 0 :length 10)
+ "#"))
+(let* ((sequence '#((1 2 3) #(4 5 6) #2A((7 8 9) (10 11 12)))))
+ (string= (write-to-string sequence
+ :pretty nil :array t :level 1 :length 10)
+ "#(# # #)"))
+(let* ((sequence '#((1 2 3) #(4 5 6) #2A((7 8 9) (10 11 12)))))
+ (string= (write-to-string sequence
+ :pretty nil :array t :level 2 :length 10)
+ "#((1 2 3) #(4 5 6) #2A(# #))"))
+(let* ((sequence '#((1 2 3) #(4 5 6) #2A((7 8 9) (10 11 12)))))
+ (string= (write-to-string sequence
+ :pretty nil :array t :level 3 :length 10)
+ "#((1 2 3) #(4 5 6) #2A((7 8 9) (10 11 12)))"))
+(let* ((sequence '#((1 2 3) #(4 5 6) #2A((7 8 9) (10 11 12)))))
+ (string= (write-to-string sequence
+ :pretty nil :array t :level 3 :length 1)
+ "#((1 ...) ...)"))
+(let* ((sequence '#((1 2 3) #(4 5 6) #2A((7 8 9) (10 11 12)))))
+ (string= (write-to-string sequence
+ :pretty nil :array t :level 3 :length 2)
+ "#((1 2 ...) #(4 5 ...) ...)"))
+(let* ((sequence '#((1 2 3) #(4 5 6) #2A((7 8 9) (10 11 12)))))
+ (string= (write-to-string sequence
+ :pretty nil :array t :level 3 :length 3)
+ "#((1 2 3) #(4 5 6) #2A((7 8 9) (10 11 12)))"))
+(let* ((sequence '#((1 2 3) #(4 5 6) #2A((7 8 9 10) (11 12 13 14)))))
+ (string= (write-to-string sequence
+ :pretty nil :array t :level 3 :length 3)
+ "#((1 2 3) #(4 5 6) #2A((7 8 9 ...) (11 12 13 ...)))"))
+
+(let* ((array '#2A(((10) #(100)) ((0 1 2) #2A((3) (4) (5) (6) (7))))))
+ (string= (write-to-string array
+ :pretty nil :array t :level 0 :length 0)
+ "#"))
+(let* ((array '#2A(((10) #(100)) ((0 1 2) #2A((3) (4) (5) (6) (7))))))
+ (string= (write-to-string array
+ :pretty nil :array t :level 1 :length 0)
+ "#2A(...)"))
+(let* ((array '#2A(((10) #(100)) ((0 1 2) #2A((3) (4) (5) (6) (7))))))
+ (string= (write-to-string array
+ :pretty nil :array t :level 1 :length 1)
+ "#2A(# ...)"))
+(let* ((array '#2A(((10) #(100)) ((0 1 2) #2A((3) (4) (5) (6) (7))))))
+ (string= (write-to-string array
+ :pretty nil :array t :level 2 :length 1)
+ "#2A((# ...) ...)"))
+(let* ((array '#2A(((10) #(100)) ((0 1 2) #2A((3) (4) (5) (6) (7))))))
+ (string= (write-to-string array
+ :pretty nil :array t :level 2 :length 2)
+ "#2A((# #) (# #))"))
+(let* ((array '#2A(((10) #(100)) ((0 1 2) #2A((3) (4) (5) (6) (7))))))
+ (string= (write-to-string array
+ :pretty nil :array t :level 3 :length 1)
+ "#2A(((10) ...) ...)"))
+(let* ((array '#2A(((10) #(100)) ((0 1 2) #2A((3) (4) (5) (6) (7))))))
+ (string= (write-to-string array
+ :pretty nil :array t :level 3 :length 2)
+ "#2A(((10) #(100)) ((0 1 ...) #2A(# # ...)))"))
+(let* ((array '#2A(((10) #(100)) ((0 1 2) #2A((3) (4) (5) (6) (7))))))
+ (string= (write-to-string array
+ :pretty nil :array t :level 4 :length 2)
+ "#2A(((10) #(100)) ((0 1 ...) #2A((3) (4) ...)))"))
+(let* ((array '#2A(((10) #(100)) ((0 1 2) #2A((3) (4) (5) (6) (7))))))
+ (string= (write-to-string array
+ :pretty nil :array t :level 4 :length 3)
+ "#2A(((10) #(100)) ((0 1 2) #2A((3) (4) (5) ...)))"))
+(let* ((array '#2A(((10) #(100)) ((0 1 2) #2A((3) (4) (5) (6) (7))))))
+ (string= (write-to-string array
+ :pretty nil :array t :level 4 :length 5)
+ "#2A(((10) #(100)) ((0 1 2) #2A((3) (4) (5) (6) (7))))"))
+(let* ((array '#2A(((10) #((100)))
+ ((0 (1) ((2))) #2A((3) ((4)) (((5))) ((6)) (7))))))
+ (string= (write-to-string array
+ :pretty nil :array t :level 3 :length 5)
+ "#2A(((10) #(#)) ((0 # #) #2A(# # # # #)))"))
+(let* ((array '#2A(((10) #((100)))
+ ((0 (1) ((2))) #2A((3) ((4)) (((5))) ((6)) (7))))))
+ (string= (write-to-string array
+ :pretty nil :array t :level 4 :length 5)
+ "#2A(((10) #((100))) ((0 (1) (#)) #2A((3) (#) (#) (#) (7))))"))
+(let* ((array '#2A(((10) #((100)))
+ ((0 (1) ((2))) #2A((3) ((4)) (((5))) ((6)) (7))))))
+ (string=
+ (write-to-string array :pretty nil :array t :level 5 :length 5)
+ "#2A(((10) #((100))) ((0 (1) ((2))) #2A((3) ((4)) ((#)) ((6)) (7))))"))
+(let* ((array '#2A(((10) #((100)))
+ ((0 (1) ((2))) #2A((3) ((4)) (((5))) ((6)) (7))))))
+ (string=
+ (write-to-string array :pretty nil :array t :level 6 :length 4)
+ "#2A(((10) #((100))) ((0 (1) ((2))) #2A((3) ((4)) (((5))) ((6)) ...)))"))
+
+
+;; (string= (write-to-string '#1=(0 #1#) :pretty nil :length 1 :circle t)
+;; "(0 ...)") ;; or "#1=(0 ...)"
+
+;; *print-readably*, *print-level*, and *print-length
+(equal (read-from-string
+ (write-to-string '(0 1 2) :pretty nil :readably t :level 0 :length 0))
+ '(0 1 2))
+(equalp (read-from-string
+ (write-to-string #(0 1 2) :pretty nil :readably t :level 0 :length 0))
+ #(0 1 2))
+(equalp (read-from-string
+ (write-to-string #2A((0) (1) (2))
+ :pretty nil :readably t :level 0 :length 0))
+ #2A((0) (1) (2)))
+
+
+;; *print-level* *print-length*
+;; Variable *PRINT-LEVEL*, *PRINT-LENGTH*
+;; http://www.lispworks.com/reference/HyperSpec/Body/v_pr_lev.htm
+;; *print-level* and *print-length* affect the printing of an any object
+;; printed with a list-like syntax. They do not affect the printing of
+;; symbols, strings, and bit vectors.
+(string= "LENGTH" (write-to-string 'LENGTH :escape nil :level 0))
+(string= "LENGTH" (write-to-string 'LENGTH :escape nil :length 2))
+(string= "LENGTH" (write-to-string 'LENGTH :escape nil :level 0 :length 0))
+(string= "abcdefg" (write-to-string "abcdefg" :escape nil :level 0))
+(string= "abcdefg" (write-to-string "abcdefg" :escape nil :length 2))
+(string= "abcdefg" (write-to-string "abcdefg" :escape nil :level 0 :length 0))
+(string= "#*0101" (write-to-string #*0101 :array t :level 0))
+(string= "#*0101" (write-to-string #*0101 :array t :length 2))
+(string= "#*0101" (write-to-string #*0101 :array t :level 0 :length 0))
diff --git a/Sacla/tests/must-printer.patch b/Sacla/tests/must-printer.patch
new file mode 100644
index 0000000..0f3b883
--- /dev/null
+++ b/Sacla/tests/must-printer.patch
@@ -0,0 +1,13 @@
+*** sacla/lisp/test/must-printer.lisp 2004-08-03 08:34:55.000000000 +0200
+--- CLISP/clisp-20040712/sacla-tests/must-printer.lisp 2004-08-07 02:40:21.000000000 +0200
+***************
+*** 774,779 ****
+--- 774,780 ----
+ (string= "G01" (write-to-string (make-symbol "G01") :escape t :gensym nil))
+ (string= "G01" (write-to-string (make-symbol "G01") :escape nil :gensym nil))
+ (string= "#:G01" (write-to-string (make-symbol "G01") :escape t :gensym t))
++ #-CLISP ; CLISP prints symbols readably with vertical bars: "#:|G01|"
+ (string= "#:G01"
+ ;; Variable *PRINT-READABLY*
+ ;; http://www.lispworks.com/reference/HyperSpec/Body/v_pr_rda.htm
+
diff --git a/Sacla/tests/must-reader.lisp b/Sacla/tests/must-reader.lisp
new file mode 100644
index 0000000..d491390
--- /dev/null
+++ b/Sacla/tests/must-reader.lisp
@@ -0,0 +1,3052 @@
+;; Copyright (C) 2002-2004, Yuji Minejima <ggb01164@nifty.ne.jp>
+;; ALL RIGHTS RESERVED.
+;;
+;; $Id: must-reader.lisp,v 1.11 2004/08/09 02:49:54 yuji Exp $
+;;
+;; Redistribution and use in source and binary forms, with or without
+;; modification, are permitted provided that the following conditions
+;; are met:
+;;
+;; * Redistributions of source code must retain the above copyright
+;; notice, this list of conditions and the following disclaimer.
+;; * 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.
+;;
+;; 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
+;; OWNER 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.
+
+
+(symbolp (read-from-string"|ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789!$\"'(),_-./:;?+<=>#%&*@[\\]{\|}`^~|"))
+(eq (read-from-string "this") 'this)
+(eq (read-from-string "cl:car") 'cl:car)
+(eq (read-from-string ":ok") :ok)
+(eq (read-from-string "ok#") 'ok\#)
+(eq (read-from-string "x#x") 'x\#x)
+(eq (read-from-string "abc(x y z)") 'abc)
+(multiple-value-bind (obj pos) (read-from-string "abc(x y z)")
+ (and (eq obj 'abc)
+ (equal (read-from-string "abc(x y z)" t nil :start pos) '(x y z))))
+(eq (read-from-string "abc") (read-from-string "ABC"))
+(eq (read-from-string "abc") (read-from-string "|ABC|"))
+(eq (read-from-string "abc") (read-from-string "a|B|c"))
+(not (eq (read-from-string "abc") (read-from-string "|abc|")))
+(eq (read-from-string "abc") (read-from-string "\\A\\B\\C"))
+(eq (read-from-string "abc") (read-from-string "a\\Bc"))
+(eq (read-from-string "abc") (read-from-string "\\ABC"))
+(not (eq (read-from-string "abc") (read-from-string "\\abc")))
+
+(= 1 (eval (read-from-string "(length '(this-that))")))
+(= 3 (eval (read-from-string "(length '(this - that))")))
+(= 2 (eval (read-from-string "(length '(a
+ b))")))
+(= 34 (eval (read-from-string "(+ 34)")))
+(= 7 (eval (read-from-string "(+ 3 4)")))
+
+
+(eq :key (let ((*package* (find-package "KEYWORD"))) (read-from-string "key")))
+(progn
+ (when (find-package 'test-foo) (delete-package 'test-foo))
+ (let ((*package* (make-package 'test-foo :use nil)))
+ (and (not (find-symbol "BAR"))
+ (eq (read-from-string "bar") (find-symbol "BAR")))))
+
+
+
+
+(= (read-from-string "1.0") 1.0)
+(= (read-from-string "2/3") 2/3)
+(zerop (read-from-string "0"))
+(zerop (read-from-string "0.0"))
+(zerop (read-from-string "0/3"))
+
+(null (read-from-string "()"))
+(equal (read-from-string "(a)") '(a))
+(equal (read-from-string "(a b)") '(a b))
+(equal (read-from-string "(a b c)") '(a b c))
+(equal (read-from-string "(a b c d)") '(a b c d))
+(equal (read-from-string "(a b c d e)") '(a b c d e))
+(equal (read-from-string "(a b c d e f)") '(a b c d e f))
+(equal (read-from-string "(a b c d e f g)") '(a b c d e f g))
+(equal (read-from-string "(a b c d e f g h)") '(a b c d e f g h))
+(handler-case (read-from-string ".")
+ (reader-error () t)
+ (error () nil)
+ (:no-error (&rest rest) (declare (ignore rest)) nil))
+(handler-case (read-from-string "...")
+ (reader-error () t)
+ (error () nil)
+ (:no-error (&rest rest) (declare (ignore rest)) nil))
+
+(let ((*read-base* 8)) (= (read-from-string "0") 0))
+(let ((*read-base* 8)) (= (read-from-string "1") 1))
+(let ((*read-base* 8)) (= (read-from-string "2") 2))
+(let ((*read-base* 8)) (= (read-from-string "3") 3))
+(let ((*read-base* 8)) (= (read-from-string "4") 4))
+(let ((*read-base* 8)) (= (read-from-string "5") 5))
+(let ((*read-base* 8)) (= (read-from-string "6") 6))
+(let ((*read-base* 8)) (= (read-from-string "7") 7))
+(let ((*read-base* 8)) (= (read-from-string "8.") 8))
+(let ((*read-base* 8)) (= (read-from-string "10") 8))
+(let ((*read-base* 8)) (= (read-from-string "11") 9))
+(let ((*read-base* 8)) (= (read-from-string "12") 10))
+(let ((*read-base* 8)) (= (read-from-string "13") 11))
+(let ((*read-base* 8)) (= (read-from-string "14") 12))
+(let ((*read-base* 8)) (= (read-from-string "15") 13))
+(let ((*read-base* 8)) (= (read-from-string "16") 14))
+(let ((*read-base* 8)) (= (read-from-string "17") 15))
+(let ((*read-base* 8)) (= (read-from-string "20") 16))
+(let ((*read-base* 8)) (= (read-from-string "21") 17))
+
+(let ((*read-base* 16)) (= (read-from-string "0") 0))
+(let ((*read-base* 16)) (= (read-from-string "1") 1))
+(let ((*read-base* 16)) (= (read-from-string "2") 2))
+(let ((*read-base* 16)) (= (read-from-string "3") 3))
+(let ((*read-base* 16)) (= (read-from-string "4") 4))
+(let ((*read-base* 16)) (= (read-from-string "5") 5))
+(let ((*read-base* 16)) (= (read-from-string "6") 6))
+(let ((*read-base* 16)) (= (read-from-string "7") 7))
+(let ((*read-base* 16)) (= (read-from-string "8") 8))
+(let ((*read-base* 16)) (= (read-from-string "9") 9))
+(let ((*read-base* 16)) (= (read-from-string "A") 10))
+(let ((*read-base* 16)) (= (read-from-string "a") 10))
+(let ((*read-base* 16)) (= (read-from-string "B") 11))
+(let ((*read-base* 16)) (= (read-from-string "b") 11))
+(let ((*read-base* 16)) (= (read-from-string "C") 12))
+(let ((*read-base* 16)) (= (read-from-string "c") 12))
+(let ((*read-base* 16)) (= (read-from-string "D") 13))
+(let ((*read-base* 16)) (= (read-from-string "d") 13))
+(let ((*read-base* 16)) (= (read-from-string "E") 14))
+(let ((*read-base* 16)) (= (read-from-string "e") 14))
+(let ((*read-base* 16)) (= (read-from-string "F") 15))
+(let ((*read-base* 16)) (= (read-from-string "f") 15))
+(let ((*read-base* 16)) (= (read-from-string "10") 16))
+(let ((*read-base* 16)) (= (read-from-string "11") 17))
+(let ((*read-base* 16)) (= (read-from-string "12") 18))
+(let ((*read-base* 16)) (= (read-from-string "13") 19))
+(let ((*read-base* 16)) (= (read-from-string "14") 20))
+(let ((*read-base* 16)) (= (read-from-string "15") 21))
+(let ((*read-base* 16)) (= (read-from-string "16") 22))
+(let ((*read-base* 16)) (= (read-from-string "17") 23))
+(let ((*read-base* 16)) (= (read-from-string "18") 24))
+(let ((*read-base* 16)) (= (read-from-string "19") 25))
+(let ((*read-base* 16)) (= (read-from-string "1A") 26))
+(let ((*read-base* 16)) (= (read-from-string "1a") 26))
+(let ((*read-base* 16)) (= (read-from-string "1B") 27))
+(let ((*read-base* 16)) (= (read-from-string "1b") 27))
+(let ((*read-base* 16)) (= (read-from-string "1C") 28))
+(let ((*read-base* 16)) (= (read-from-string "1c") 28))
+(let ((*read-base* 16)) (= (read-from-string "1D") 29))
+(let ((*read-base* 16)) (= (read-from-string "1d") 29))
+(let ((*read-base* 16)) (= (read-from-string "1E") 30))
+(let ((*read-base* 16)) (= (read-from-string "1e") 30))
+(let ((*read-base* 16)) (= (read-from-string "1F") 31))
+(let ((*read-base* 16)) (= (read-from-string "1f") 31))
+(let ((*read-base* 16)) (= (read-from-string "20") 32))
+
+
+(= (read-from-string "0") 0)
+(= (read-from-string "+0") 0)
+(= (read-from-string "-0") 0)
+(integerp (read-from-string "0"))
+(integerp (read-from-string "+0"))
+(integerp (read-from-string "-0"))
+(= (read-from-string "1") 1)
+(= (read-from-string "+1") 1)
+(= (read-from-string "-1") -1)
+(integerp (read-from-string "1"))
+(integerp (read-from-string "+1"))
+(integerp (read-from-string "-1"))
+(= (read-from-string "12") 12)
+(= (read-from-string "+12") 12)
+(= (read-from-string "-12") -12)
+(integerp (read-from-string "12"))
+(integerp (read-from-string "+12"))
+(integerp (read-from-string "-12"))
+(= (read-from-string "123") 123)
+(= (read-from-string "+123") 123)
+(= (read-from-string "-123") -123)
+(integerp (read-from-string "123"))
+(integerp (read-from-string "+123"))
+(integerp (read-from-string "-123"))
+(= (read-from-string "1234") 1234)
+(= (read-from-string "+1234") 1234)
+(= (read-from-string "-1234") -1234)
+(integerp (read-from-string "1234"))
+(integerp (read-from-string "+1234"))
+(integerp (read-from-string "-1234"))
+(= (read-from-string "12345") 12345)
+(= (read-from-string "+12345") 12345)
+(= (read-from-string "-12345") -12345)
+(integerp (read-from-string "12345"))
+(integerp (read-from-string "+12345"))
+(integerp (read-from-string "-12345"))
+(integerp (read-from-string "48148148031244413808971345"))
+(integerp (read-from-string "+48148148031244413808971345"))
+(integerp (read-from-string "-48148148031244413808971345"))
+
+(= (read-from-string "0.") 0)
+(= (read-from-string "+0.") 0)
+(= (read-from-string "-0.") 0)
+(integerp (read-from-string "0."))
+(integerp (read-from-string "+0."))
+(integerp (read-from-string "-0."))
+(= (read-from-string "1.") 1)
+(= (read-from-string "+1.") 1)
+(= (read-from-string "-1.") -1)
+(integerp (read-from-string "1."))
+(integerp (read-from-string "+1."))
+(integerp (read-from-string "-1."))
+(= (read-from-string "12.") 12)
+(= (read-from-string "+12.") 12)
+(= (read-from-string "-12.") -12)
+(integerp (read-from-string "12."))
+(integerp (read-from-string "+12."))
+(integerp (read-from-string "-12."))
+(= (read-from-string "123.") 123)
+(= (read-from-string "+123.") 123)
+(= (read-from-string "-123.") -123)
+(integerp (read-from-string "123."))
+(integerp (read-from-string "+123."))
+(integerp (read-from-string "-123."))
+(= (read-from-string "1234.") 1234)
+(= (read-from-string "+1234.") 1234)
+(= (read-from-string "-1234.") -1234)
+(integerp (read-from-string "1234."))
+(integerp (read-from-string "+1234."))
+(integerp (read-from-string "-1234."))
+(= (read-from-string "12345.") 12345)
+(= (read-from-string "+12345.") 12345)
+(= (read-from-string "-12345.") -12345)
+(integerp (read-from-string "12345."))
+(integerp (read-from-string "+12345."))
+(integerp (read-from-string "-12345."))
+(integerp (read-from-string "48148148031244413808971345."))
+(integerp (read-from-string "+48148148031244413808971345."))
+(integerp (read-from-string "-48148148031244413808971345."))
+
+(zerop (let ((*read-base* 2)) (read-from-string "0")))
+(zerop (let ((*read-base* 2)) (read-from-string "+0")))
+(zerop (let ((*read-base* 2)) (read-from-string "-0")))
+(= 1 (let ((*read-base* 2)) (read-from-string "1")))
+(= 1 (let ((*read-base* 2)) (read-from-string "+1")))
+(= -1 (let ((*read-base* 2)) (read-from-string "-1")))
+(= 2 (let ((*read-base* 2)) (read-from-string "10")))
+(= 2 (let ((*read-base* 2)) (read-from-string "+10")))
+(= -2 (let ((*read-base* 2)) (read-from-string "-10")))
+(= 3 (let ((*read-base* 2)) (read-from-string "11")))
+(= 3 (let ((*read-base* 2)) (read-from-string "+11")))
+(= -3 (let ((*read-base* 2)) (read-from-string "-11")))
+(= -11 (let ((*read-base* 2)) (read-from-string "-11.")))
+(integerp (let ((*read-base* 2)) (read-from-string "-11.")))
+(= 21 (let ((*read-base* 2)) (read-from-string "10101")))
+(= 21 (let ((*read-base* 2)) (read-from-string "+10101")))
+(= -21 (let ((*read-base* 2)) (read-from-string "-10101")))
+(= -1.0101 (let ((*read-base* 2)) (read-from-string "-1.0101")))
+(= 1.0101 (let ((*read-base* 2)) (read-from-string "1.0101")))
+(= 123 (let ((*read-base* 2)) (read-from-string "123.")))
+
+(zerop (let ((*read-base* 3)) (read-from-string "0")))
+(zerop (let ((*read-base* 3)) (read-from-string "+0")))
+(zerop (let ((*read-base* 3)) (read-from-string "-0")))
+(= 1 (let ((*read-base* 3)) (read-from-string "1")))
+(= 1 (let ((*read-base* 3)) (read-from-string "+1")))
+(= -1 (let ((*read-base* 3)) (read-from-string "-1")))
+(= 2 (let ((*read-base* 3)) (read-from-string "2")))
+(= 2 (let ((*read-base* 3)) (read-from-string "+2")))
+(= -2 (let ((*read-base* 3)) (read-from-string "-2")))
+(= 3 (let ((*read-base* 3)) (read-from-string "10")))
+(= 3 (let ((*read-base* 3)) (read-from-string "+10")))
+(= -3 (let ((*read-base* 3)) (read-from-string "-10")))
+(= 4 (let ((*read-base* 3)) (read-from-string "11")))
+(= 4 (let ((*read-base* 3)) (read-from-string "+11")))
+(= -4 (let ((*read-base* 3)) (read-from-string "-11")))
+(= 5 (let ((*read-base* 3)) (read-from-string "12")))
+(= 5 (let ((*read-base* 3)) (read-from-string "+12")))
+(= -5 (let ((*read-base* 3)) (read-from-string "-12")))
+(= 6 (let ((*read-base* 3)) (read-from-string "20")))
+(= 6 (let ((*read-base* 3)) (read-from-string "+20")))
+(= -6 (let ((*read-base* 3)) (read-from-string "-20")))
+(= 7 (let ((*read-base* 3)) (read-from-string "21")))
+(= 7 (let ((*read-base* 3)) (read-from-string "+21")))
+(= -7 (let ((*read-base* 3)) (read-from-string "-21")))
+(= 8 (let ((*read-base* 3)) (read-from-string "22")))
+(= 8 (let ((*read-base* 3)) (read-from-string "+22")))
+(= -8 (let ((*read-base* 3)) (read-from-string "-22")))
+
+(= 391514 (let ((*read-base* 3)) (read-from-string "201220001112")))
+(= 391514 (let ((*read-base* 3)) (read-from-string "+201220001112")))
+(= -391514 (let ((*read-base* 3)) (read-from-string "-201220001112")))
+
+(zerop (let ((*read-base* 8)) (read-from-string "0")))
+(zerop (let ((*read-base* 8)) (read-from-string "+0")))
+(zerop (let ((*read-base* 8)) (read-from-string "-0")))
+(= 1 (let ((*read-base* 8)) (read-from-string "1")))
+(= 1 (let ((*read-base* 8)) (read-from-string "+1")))
+(= -1 (let ((*read-base* 8)) (read-from-string "-1")))
+(= 7 (let ((*read-base* 8)) (read-from-string "7")))
+(= 7 (let ((*read-base* 8)) (read-from-string "+7")))
+(= -7 (let ((*read-base* 8)) (read-from-string "-7")))
+
+
+(zerop (let ((*read-base* 16)) (read-from-string "0")))
+(zerop (let ((*read-base* 16)) (read-from-string "+0")))
+(zerop (let ((*read-base* 16)) (read-from-string "-0")))
+(= 1 (let ((*read-base* 16)) (read-from-string "1")))
+(= 1 (let ((*read-base* 16)) (read-from-string "+1")))
+(= -1 (let ((*read-base* 16)) (read-from-string "-1")))
+(= 9 (let ((*read-base* 16)) (read-from-string "9")))
+(= 9 (let ((*read-base* 16)) (read-from-string "+9")))
+(= -9 (let ((*read-base* 16)) (read-from-string "-9")))
+(= 15 (let ((*read-base* 16)) (read-from-string "F")))
+(= -15 (let ((*read-base* 16)) (read-from-string "-F")))
+(= 15 (let ((*read-base* 16)) (read-from-string "F")))
+(= 15 (let ((*read-base* 16)) (read-from-string "f")))
+(= -15 (let ((*read-base* 16)) (read-from-string "-f")))
+(= 15 (let ((*read-base* 16)) (read-from-string "f")))
+(= 31 (let ((*read-base* 16)) (read-from-string "1F")))
+(= 31 (let ((*read-base* 16)) (read-from-string "+1F")))
+(= -31 (let ((*read-base* 16)) (read-from-string "-1F")))
+(= #x3F (let ((*read-base* 16)) (read-from-string "3F")))
+(= #x3F (let ((*read-base* 16)) (read-from-string "+3F")))
+(= #x-3F (let ((*read-base* 16)) (read-from-string "-3F")))
+(= 9 (let ((*read-base* 16)) (read-from-string "9.")))
+(integerp (let ((*read-base* 16)) (read-from-string "9.")))
+(= 10 (let ((*read-base* 16)) (read-from-string "10.")))
+(integerp (let ((*read-base* 16)) (read-from-string "10.")))
+
+(equal (let (stack)
+ (dotimes (i 6 stack)
+ (let ((*read-base* (+ 10. i)))
+ (let ((object (read-from-string "(\\DAD DAD |BEE| BEE 123. 123)")))
+ (push (list *read-base* object) stack)))))
+ '((15 (DAD 3088 BEE 2699 123 258))
+ (14 (DAD 2701 BEE BEE 123 227))
+ (13 (DAD DAD BEE BEE 123 198))
+ (12 (DAD DAD BEE BEE 123 171))
+ (11 (DAD DAD BEE BEE 123 146))
+ (10 (DAD DAD BEE BEE 123 123))))
+
+(loop for i from 2 upto 32
+ always (zerop (let ((*read-base* i)) (read-from-string "0"))))
+(loop for i from 2 upto 32
+ always (zerop (let ((*read-base* i)) (read-from-string "+0"))))
+(loop for i from 2 upto 32
+ always (zerop (let ((*read-base* i)) (read-from-string "-0"))))
+(loop for i from 2 upto 32
+ always (= 1 (let ((*read-base* i)) (read-from-string "1"))))
+(loop for i from 2 upto 32
+ always (= 1 (let ((*read-base* i)) (read-from-string "+1"))))
+(loop for i from 2 upto 32
+ always (= -1 (let ((*read-base* i)) (read-from-string "-1"))))
+(loop for i from 2 upto 32
+ for n = (let ((*read-base* i)) (read-from-string "10."))
+ always (and (integerp n) (= 10 n)))
+(loop for i from 2 upto 32
+ for n = (let ((*read-base* i)) (read-from-string "+10."))
+ always (and (integerp n) (= 10 n)))
+(loop for i from 2 upto 32
+ for n = (let ((*read-base* i)) (read-from-string "-10."))
+ always (and (integerp n) (= -10 n)))
+(loop for i from 2 upto 32
+ for n = (let ((*read-base* i)) (read-from-string "1.1"))
+ always (= 1.1 n))
+(loop for i from 2 upto 32
+ for n = (let ((*read-base* i)) (read-from-string "+1.1"))
+ always (= 1.1 n))
+(loop for i from 2 upto 32
+ for n = (let ((*read-base* i)) (read-from-string "-1.1"))
+ always (= -1.1 n))
+
+(zerop (read-from-string "0/2"))
+(zerop (read-from-string "0/3"))
+(zerop (read-from-string "0/4"))
+(zerop (read-from-string "0/5"))
+(zerop (read-from-string "0/6"))
+(zerop (read-from-string "0/7"))
+(zerop (read-from-string "0/8"))
+(zerop (read-from-string "0/9"))
+(zerop (read-from-string "0/10"))
+(zerop (read-from-string "0/11"))
+(zerop (read-from-string "0/12"))
+(zerop (read-from-string "0/13"))
+(zerop (read-from-string "0/14"))
+(zerop (read-from-string "0/15"))
+(zerop (read-from-string "0/16"))
+(zerop (read-from-string "0/17"))
+(zerop (read-from-string "0/18"))
+(zerop (read-from-string "0/19"))
+(zerop (read-from-string "0/20"))
+
+(= 1/2 (read-from-string "1/2"))
+(= 1/3 (read-from-string "1/3"))
+(= 1/4 (read-from-string "1/4"))
+(= 1/5 (read-from-string "1/5"))
+(= 1/6 (read-from-string "1/6"))
+(= 1/7 (read-from-string "1/7"))
+(= 1/8 (read-from-string "1/8"))
+(= 1/9 (read-from-string "1/9"))
+(= 1/10 (read-from-string "1/10"))
+(= 1/11 (read-from-string "1/11"))
+(= 1/12 (read-from-string "1/12"))
+(= 1/13 (read-from-string "1/13"))
+(= 1/14 (read-from-string "1/14"))
+(= 1/15 (read-from-string "1/15"))
+(= 1/16 (read-from-string "1/16"))
+(= 1/17 (read-from-string "1/17"))
+(= 1/18 (read-from-string "1/18"))
+(= 1/19 (read-from-string "1/19"))
+(= 1/20 (read-from-string "1/20"))
+
+(= 2/2 (read-from-string "2/2"))
+(= 2/3 (read-from-string "2/3"))
+(= 2/4 (read-from-string "2/4"))
+(= 2/5 (read-from-string "2/5"))
+(= 2/6 (read-from-string "2/6"))
+(= 2/7 (read-from-string "2/7"))
+(= 2/8 (read-from-string "2/8"))
+(= 2/9 (read-from-string "2/9"))
+(= 2/10 (read-from-string "2/10"))
+(= 2/11 (read-from-string "2/11"))
+(= 2/12 (read-from-string "2/12"))
+(= 2/13 (read-from-string "2/13"))
+(= 2/14 (read-from-string "2/14"))
+(= 2/15 (read-from-string "2/15"))
+(= 2/16 (read-from-string "2/16"))
+(= 2/17 (read-from-string "2/17"))
+(= 2/18 (read-from-string "2/18"))
+(= 2/19 (read-from-string "2/19"))
+(= 2/20 (read-from-string "2/20"))
+
+(= 17/2 (read-from-string "17/2"))
+(= 17/3 (read-from-string "17/3"))
+(= 17/4 (read-from-string "17/4"))
+(= 17/5 (read-from-string "17/5"))
+(= 17/6 (read-from-string "17/6"))
+(= 17/7 (read-from-string "17/7"))
+(= 17/8 (read-from-string "17/8"))
+(= 17/9 (read-from-string "17/9"))
+(= 17/10 (read-from-string "17/10"))
+(= 17/11 (read-from-string "17/11"))
+(= 17/12 (read-from-string "17/12"))
+(= 17/13 (read-from-string "17/13"))
+(= 17/14 (read-from-string "17/14"))
+(= 17/15 (read-from-string "17/15"))
+(= 17/16 (read-from-string "17/16"))
+(= 17/17 (read-from-string "17/17"))
+(= 17/18 (read-from-string "17/18"))
+(= 17/19 (read-from-string "17/19"))
+(= 17/20 (read-from-string "17/20"))
+
+(= 0 (let ((*read-base* 2)) (read-from-string "0/1")))
+(= 1 (let ((*read-base* 2)) (read-from-string "1/1")))
+(= 1/2 (let ((*read-base* 2)) (read-from-string "1/10")))
+(= 1/3 (let ((*read-base* 2)) (read-from-string "1/11")))
+(= 1/4 (let ((*read-base* 2)) (read-from-string "1/100")))
+(= 1/5 (let ((*read-base* 2)) (read-from-string "1/101")))
+(= 1/6 (let ((*read-base* 2)) (read-from-string "1/110")))
+(= 1/7 (let ((*read-base* 2)) (read-from-string "1/111")))
+(= 1/8 (let ((*read-base* 2)) (read-from-string "1/1000")))
+(= 1/9 (let ((*read-base* 2)) (read-from-string "1/1001")))
+(= 1/10 (let ((*read-base* 2)) (read-from-string "1/1010")))
+(= 1/11 (let ((*read-base* 2)) (read-from-string "1/1011")))
+(= 1/12 (let ((*read-base* 2)) (read-from-string "1/1100")))
+(= 1/13 (let ((*read-base* 2)) (read-from-string "1/1101")))
+(= 1/14 (let ((*read-base* 2)) (read-from-string "1/1110")))
+(= 1/15 (let ((*read-base* 2)) (read-from-string "1/1111")))
+(= 1/16 (let ((*read-base* 2)) (read-from-string "1/10000")))
+(= 1/17 (let ((*read-base* 2)) (read-from-string "1/10001")))
+(= 1/18 (let ((*read-base* 2)) (read-from-string "1/10010")))
+(= 1/19 (let ((*read-base* 2)) (read-from-string "1/10011")))
+(= 1/20 (let ((*read-base* 2)) (read-from-string "1/10100")))
+(= 1/21 (let ((*read-base* 2)) (read-from-string "1/10101")))
+(= 1/22 (let ((*read-base* 2)) (read-from-string "1/10110")))
+(= 1/23 (let ((*read-base* 2)) (read-from-string "1/10111")))
+
+(= 2 (let ((*read-base* 2)) (read-from-string "10/1")))
+(= 2/2 (let ((*read-base* 2)) (read-from-string "10/10")))
+(= 2/3 (let ((*read-base* 2)) (read-from-string "10/11")))
+(= 2/4 (let ((*read-base* 2)) (read-from-string "10/100")))
+(= 2/5 (let ((*read-base* 2)) (read-from-string "10/101")))
+(= 2/6 (let ((*read-base* 2)) (read-from-string "10/110")))
+(= 2/7 (let ((*read-base* 2)) (read-from-string "10/111")))
+(= 2/8 (let ((*read-base* 2)) (read-from-string "10/1000")))
+(= 2/9 (let ((*read-base* 2)) (read-from-string "10/1001")))
+(= 2/10 (let ((*read-base* 2)) (read-from-string "10/1010")))
+(= 2/11 (let ((*read-base* 2)) (read-from-string "10/1011")))
+(= 2/12 (let ((*read-base* 2)) (read-from-string "10/1100")))
+(= 2/13 (let ((*read-base* 2)) (read-from-string "10/1101")))
+(= 2/14 (let ((*read-base* 2)) (read-from-string "10/1110")))
+(= 2/15 (let ((*read-base* 2)) (read-from-string "10/1111")))
+(= 2/16 (let ((*read-base* 2)) (read-from-string "10/10000")))
+(= 2/17 (let ((*read-base* 2)) (read-from-string "10/10001")))
+(= 2/18 (let ((*read-base* 2)) (read-from-string "10/10010")))
+(= 2/19 (let ((*read-base* 2)) (read-from-string "10/10011")))
+(= 2/20 (let ((*read-base* 2)) (read-from-string "10/10100")))
+(= 2/21 (let ((*read-base* 2)) (read-from-string "10/10101")))
+(= 2/22 (let ((*read-base* 2)) (read-from-string "10/10110")))
+(= 2/23 (let ((*read-base* 2)) (read-from-string "10/10111")))
+
+(= 3 (let ((*read-base* 2)) (read-from-string "11/1")))
+(= 3/2 (let ((*read-base* 2)) (read-from-string "11/10")))
+(= 3/3 (let ((*read-base* 2)) (read-from-string "11/11")))
+(= 3/4 (let ((*read-base* 2)) (read-from-string "11/100")))
+(= 3/5 (let ((*read-base* 2)) (read-from-string "11/101")))
+(= 3/6 (let ((*read-base* 2)) (read-from-string "11/110")))
+(= 3/7 (let ((*read-base* 2)) (read-from-string "11/111")))
+(= 3/8 (let ((*read-base* 2)) (read-from-string "11/1000")))
+(= 3/9 (let ((*read-base* 2)) (read-from-string "11/1001")))
+(= 3/10 (let ((*read-base* 2)) (read-from-string "11/1010")))
+(= 3/11 (let ((*read-base* 2)) (read-from-string "11/1011")))
+(= 3/12 (let ((*read-base* 2)) (read-from-string "11/1100")))
+(= 3/13 (let ((*read-base* 2)) (read-from-string "11/1101")))
+(= 3/14 (let ((*read-base* 2)) (read-from-string "11/1110")))
+(= 3/15 (let ((*read-base* 2)) (read-from-string "11/1111")))
+(= 3/16 (let ((*read-base* 2)) (read-from-string "11/10000")))
+(= 3/17 (let ((*read-base* 2)) (read-from-string "11/10001")))
+(= 3/18 (let ((*read-base* 2)) (read-from-string "11/10010")))
+(= 3/19 (let ((*read-base* 2)) (read-from-string "11/10011")))
+(= 3/20 (let ((*read-base* 2)) (read-from-string "11/10100")))
+(= 3/21 (let ((*read-base* 2)) (read-from-string "11/10101")))
+(= 3/22 (let ((*read-base* 2)) (read-from-string "11/10110")))
+(= 3/23 (let ((*read-base* 2)) (read-from-string "11/10111")))
+
+(= 0 (let ((*read-base* 8)) (read-from-string "0/1")))
+(= 1/2 (let ((*read-base* 8)) (read-from-string "1/2")))
+(= 1/3 (let ((*read-base* 8)) (read-from-string "1/3")))
+(= 1/4 (let ((*read-base* 8)) (read-from-string "1/4")))
+(= 1/5 (let ((*read-base* 8)) (read-from-string "1/5")))
+(= 1/6 (let ((*read-base* 8)) (read-from-string "1/6")))
+(= 1/7 (let ((*read-base* 8)) (read-from-string "1/7")))
+(= 1/8 (let ((*read-base* 8)) (read-from-string "1/10")))
+(= 1/9 (let ((*read-base* 8)) (read-from-string "1/11")))
+(= 1/10 (let ((*read-base* 8)) (read-from-string "1/12")))
+(= 1/11 (let ((*read-base* 8)) (read-from-string "1/13")))
+(= 1/12 (let ((*read-base* 8)) (read-from-string "1/14")))
+(= 1/13 (let ((*read-base* 8)) (read-from-string "1/15")))
+(= 1/14 (let ((*read-base* 8)) (read-from-string "1/16")))
+(= 1/15 (let ((*read-base* 8)) (read-from-string "1/17")))
+(= 1/16 (let ((*read-base* 8)) (read-from-string "1/20")))
+(= 1/17 (let ((*read-base* 8)) (read-from-string "1/21")))
+(= 1/18 (let ((*read-base* 8)) (read-from-string "1/22")))
+(= 1/19 (let ((*read-base* 8)) (read-from-string "1/23")))
+(= 1/20 (let ((*read-base* 8)) (read-from-string "1/24")))
+
+(= 3/2 (let ((*read-base* 8)) (read-from-string "3/2")))
+(= 3/3 (let ((*read-base* 8)) (read-from-string "3/3")))
+(= 3/4 (let ((*read-base* 8)) (read-from-string "3/4")))
+(= 3/5 (let ((*read-base* 8)) (read-from-string "3/5")))
+(= 3/6 (let ((*read-base* 8)) (read-from-string "3/6")))
+(= 3/7 (let ((*read-base* 8)) (read-from-string "3/7")))
+(= 3/8 (let ((*read-base* 8)) (read-from-string "3/10")))
+(= 3/9 (let ((*read-base* 8)) (read-from-string "3/11")))
+(= 3/10 (let ((*read-base* 8)) (read-from-string "3/12")))
+(= 3/11 (let ((*read-base* 8)) (read-from-string "3/13")))
+(= 3/12 (let ((*read-base* 8)) (read-from-string "3/14")))
+(= 3/13 (let ((*read-base* 8)) (read-from-string "3/15")))
+(= 3/14 (let ((*read-base* 8)) (read-from-string "3/16")))
+(= 3/15 (let ((*read-base* 8)) (read-from-string "3/17")))
+(= 3/16 (let ((*read-base* 8)) (read-from-string "3/20")))
+(= 3/17 (let ((*read-base* 8)) (read-from-string "3/21")))
+(= 3/18 (let ((*read-base* 8)) (read-from-string "3/22")))
+(= 3/19 (let ((*read-base* 8)) (read-from-string "3/23")))
+(= 3/20 (let ((*read-base* 8)) (read-from-string "3/24")))
+
+(= 13/2 (let ((*read-base* 8)) (read-from-string "15/2")))
+(= 13/3 (let ((*read-base* 8)) (read-from-string "15/3")))
+(= 13/4 (let ((*read-base* 8)) (read-from-string "15/4")))
+(= 13/5 (let ((*read-base* 8)) (read-from-string "15/5")))
+(= 13/6 (let ((*read-base* 8)) (read-from-string "15/6")))
+(= 13/7 (let ((*read-base* 8)) (read-from-string "15/7")))
+(= 13/8 (let ((*read-base* 8)) (read-from-string "15/10")))
+(= 13/9 (let ((*read-base* 8)) (read-from-string "15/11")))
+(= 13/10 (let ((*read-base* 8)) (read-from-string "15/12")))
+(= 13/11 (let ((*read-base* 8)) (read-from-string "15/13")))
+(= 13/12 (let ((*read-base* 8)) (read-from-string "15/14")))
+(= 13/13 (let ((*read-base* 8)) (read-from-string "15/15")))
+(= 13/14 (let ((*read-base* 8)) (read-from-string "15/16")))
+(= 13/15 (let ((*read-base* 8)) (read-from-string "15/17")))
+(= 13/16 (let ((*read-base* 8)) (read-from-string "15/20")))
+(= 13/17 (let ((*read-base* 8)) (read-from-string "15/21")))
+(= 13/18 (let ((*read-base* 8)) (read-from-string "15/22")))
+(= 13/19 (let ((*read-base* 8)) (read-from-string "15/23")))
+(= 13/20 (let ((*read-base* 8)) (read-from-string "15/24")))
+
+
+(= 0 (let ((*read-base* 16)) (read-from-string "0/1")))
+(= 1/2 (let ((*read-base* 16)) (read-from-string "1/2")))
+(= 1/3 (let ((*read-base* 16)) (read-from-string "1/3")))
+(= 1/4 (let ((*read-base* 16)) (read-from-string "1/4")))
+(= 1/5 (let ((*read-base* 16)) (read-from-string "1/5")))
+(= 1/6 (let ((*read-base* 16)) (read-from-string "1/6")))
+(= 1/7 (let ((*read-base* 16)) (read-from-string "1/7")))
+(= 1/8 (let ((*read-base* 16)) (read-from-string "1/8")))
+(= 1/9 (let ((*read-base* 16)) (read-from-string "1/9")))
+(= 1/10 (let ((*read-base* 16)) (read-from-string "1/A")))
+(= 1/11 (let ((*read-base* 16)) (read-from-string "1/B")))
+(= 1/12 (let ((*read-base* 16)) (read-from-string "1/C")))
+(= 1/13 (let ((*read-base* 16)) (read-from-string "1/D")))
+(= 1/14 (let ((*read-base* 16)) (read-from-string "1/E")))
+(= 1/15 (let ((*read-base* 16)) (read-from-string "1/F")))
+(= 1/10 (let ((*read-base* 16)) (read-from-string "1/a")))
+(= 1/11 (let ((*read-base* 16)) (read-from-string "1/b")))
+(= 1/12 (let ((*read-base* 16)) (read-from-string "1/c")))
+(= 1/13 (let ((*read-base* 16)) (read-from-string "1/d")))
+(= 1/14 (let ((*read-base* 16)) (read-from-string "1/e")))
+(= 1/15 (let ((*read-base* 16)) (read-from-string "1/f")))
+(= 1/16 (let ((*read-base* 16)) (read-from-string "1/10")))
+(= 1/17 (let ((*read-base* 16)) (read-from-string "1/11")))
+(= 1/18 (let ((*read-base* 16)) (read-from-string "1/12")))
+(= 1/19 (let ((*read-base* 16)) (read-from-string "1/13")))
+(= 1/20 (let ((*read-base* 16)) (read-from-string "1/14")))
+(= 1/21 (let ((*read-base* 16)) (read-from-string "1/15")))
+(= 1/22 (let ((*read-base* 16)) (read-from-string "1/16")))
+(= 1/23 (let ((*read-base* 16)) (read-from-string "1/17")))
+(= 1/24 (let ((*read-base* 16)) (read-from-string "1/18")))
+(= 1/25 (let ((*read-base* 16)) (read-from-string "1/19")))
+(= 1/26 (let ((*read-base* 16)) (read-from-string "1/1A")))
+(= 1/27 (let ((*read-base* 16)) (read-from-string "1/1B")))
+(= 1/28 (let ((*read-base* 16)) (read-from-string "1/1C")))
+(= 1/29 (let ((*read-base* 16)) (read-from-string "1/1D")))
+(= 1/30 (let ((*read-base* 16)) (read-from-string "1/1E")))
+(= 1/31 (let ((*read-base* 16)) (read-from-string "1/1F")))
+(= 1/32 (let ((*read-base* 16)) (read-from-string "1/20")))
+(= 1/33 (let ((*read-base* 16)) (read-from-string "1/21")))
+(= 1/34 (let ((*read-base* 16)) (read-from-string "1/22")))
+(= 1/35 (let ((*read-base* 16)) (read-from-string "1/23")))
+(= 1/36 (let ((*read-base* 16)) (read-from-string "1/24")))
+
+(= 2/2 (let ((*read-base* 16)) (read-from-string "2/2")))
+(= 2/3 (let ((*read-base* 16)) (read-from-string "2/3")))
+(= 2/4 (let ((*read-base* 16)) (read-from-string "2/4")))
+(= 2/5 (let ((*read-base* 16)) (read-from-string "2/5")))
+(= 2/6 (let ((*read-base* 16)) (read-from-string "2/6")))
+(= 2/7 (let ((*read-base* 16)) (read-from-string "2/7")))
+(= 2/8 (let ((*read-base* 16)) (read-from-string "2/8")))
+(= 2/9 (let ((*read-base* 16)) (read-from-string "2/9")))
+(= 2/10 (let ((*read-base* 16)) (read-from-string "2/A")))
+(= 2/11 (let ((*read-base* 16)) (read-from-string "2/B")))
+(= 2/12 (let ((*read-base* 16)) (read-from-string "2/C")))
+(= 2/13 (let ((*read-base* 16)) (read-from-string "2/D")))
+(= 2/14 (let ((*read-base* 16)) (read-from-string "2/E")))
+(= 2/15 (let ((*read-base* 16)) (read-from-string "2/F")))
+(= 2/10 (let ((*read-base* 16)) (read-from-string "2/a")))
+(= 2/11 (let ((*read-base* 16)) (read-from-string "2/b")))
+(= 2/12 (let ((*read-base* 16)) (read-from-string "2/c")))
+(= 2/13 (let ((*read-base* 16)) (read-from-string "2/d")))
+(= 2/14 (let ((*read-base* 16)) (read-from-string "2/e")))
+(= 2/15 (let ((*read-base* 16)) (read-from-string "2/f")))
+(= 2/16 (let ((*read-base* 16)) (read-from-string "2/10")))
+(= 2/17 (let ((*read-base* 16)) (read-from-string "2/11")))
+(= 2/18 (let ((*read-base* 16)) (read-from-string "2/12")))
+(= 2/19 (let ((*read-base* 16)) (read-from-string "2/13")))
+(= 2/20 (let ((*read-base* 16)) (read-from-string "2/14")))
+(= 2/21 (let ((*read-base* 16)) (read-from-string "2/15")))
+(= 2/22 (let ((*read-base* 16)) (read-from-string "2/16")))
+(= 2/23 (let ((*read-base* 16)) (read-from-string "2/17")))
+(= 2/24 (let ((*read-base* 16)) (read-from-string "2/18")))
+(= 2/25 (let ((*read-base* 16)) (read-from-string "2/19")))
+(= 2/26 (let ((*read-base* 16)) (read-from-string "2/1A")))
+(= 2/27 (let ((*read-base* 16)) (read-from-string "2/1B")))
+(= 2/28 (let ((*read-base* 16)) (read-from-string "2/1C")))
+(= 2/29 (let ((*read-base* 16)) (read-from-string "2/1D")))
+(= 2/30 (let ((*read-base* 16)) (read-from-string "2/1E")))
+(= 2/31 (let ((*read-base* 16)) (read-from-string "2/1F")))
+(= 2/32 (let ((*read-base* 16)) (read-from-string "2/20")))
+(= 2/33 (let ((*read-base* 16)) (read-from-string "2/21")))
+(= 2/34 (let ((*read-base* 16)) (read-from-string "2/22")))
+(= 2/35 (let ((*read-base* 16)) (read-from-string "2/23")))
+(= 2/36 (let ((*read-base* 16)) (read-from-string "2/24")))
+
+
+(= 10/2 (let ((*read-base* 16)) (read-from-string "a/2")))
+(= 10/3 (let ((*read-base* 16)) (read-from-string "a/3")))
+(= 10/4 (let ((*read-base* 16)) (read-from-string "a/4")))
+(= 10/5 (let ((*read-base* 16)) (read-from-string "a/5")))
+(= 10/6 (let ((*read-base* 16)) (read-from-string "a/6")))
+(= 10/7 (let ((*read-base* 16)) (read-from-string "a/7")))
+(= 10/8 (let ((*read-base* 16)) (read-from-string "a/8")))
+(= 10/9 (let ((*read-base* 16)) (read-from-string "a/9")))
+(= 10/10 (let ((*read-base* 16)) (read-from-string "a/A")))
+(= 10/11 (let ((*read-base* 16)) (read-from-string "a/B")))
+(= 10/12 (let ((*read-base* 16)) (read-from-string "a/C")))
+(= 10/13 (let ((*read-base* 16)) (read-from-string "a/D")))
+(= 10/14 (let ((*read-base* 16)) (read-from-string "a/E")))
+(= 10/15 (let ((*read-base* 16)) (read-from-string "a/F")))
+(= 10/10 (let ((*read-base* 16)) (read-from-string "a/a")))
+(= 10/11 (let ((*read-base* 16)) (read-from-string "a/b")))
+(= 10/12 (let ((*read-base* 16)) (read-from-string "a/c")))
+(= 10/13 (let ((*read-base* 16)) (read-from-string "a/d")))
+(= 10/14 (let ((*read-base* 16)) (read-from-string "a/e")))
+(= 10/15 (let ((*read-base* 16)) (read-from-string "a/f")))
+(= 10/16 (let ((*read-base* 16)) (read-from-string "a/10")))
+(= 10/17 (let ((*read-base* 16)) (read-from-string "a/11")))
+(= 10/18 (let ((*read-base* 16)) (read-from-string "a/12")))
+(= 10/19 (let ((*read-base* 16)) (read-from-string "a/13")))
+(= 10/20 (let ((*read-base* 16)) (read-from-string "a/14")))
+(= 10/21 (let ((*read-base* 16)) (read-from-string "a/15")))
+(= 10/22 (let ((*read-base* 16)) (read-from-string "a/16")))
+(= 10/23 (let ((*read-base* 16)) (read-from-string "a/17")))
+(= 10/24 (let ((*read-base* 16)) (read-from-string "a/18")))
+(= 10/25 (let ((*read-base* 16)) (read-from-string "a/19")))
+(= 10/26 (let ((*read-base* 16)) (read-from-string "a/1A")))
+(= 10/27 (let ((*read-base* 16)) (read-from-string "a/1B")))
+(= 10/28 (let ((*read-base* 16)) (read-from-string "a/1C")))
+(= 10/29 (let ((*read-base* 16)) (read-from-string "a/1D")))
+(= 10/30 (let ((*read-base* 16)) (read-from-string "a/1E")))
+(= 10/31 (let ((*read-base* 16)) (read-from-string "a/1F")))
+(= 10/32 (let ((*read-base* 16)) (read-from-string "a/20")))
+(= 10/33 (let ((*read-base* 16)) (read-from-string "a/21")))
+(= 10/34 (let ((*read-base* 16)) (read-from-string "a/22")))
+(= 10/35 (let ((*read-base* 16)) (read-from-string "a/23")))
+(= 10/36 (let ((*read-base* 16)) (read-from-string "a/24")))
+
+
+(= 35/2 (let ((*read-base* 16)) (read-from-string "23/2")))
+(= 35/3 (let ((*read-base* 16)) (read-from-string "23/3")))
+(= 35/4 (let ((*read-base* 16)) (read-from-string "23/4")))
+(= 35/5 (let ((*read-base* 16)) (read-from-string "23/5")))
+(= 35/6 (let ((*read-base* 16)) (read-from-string "23/6")))
+(= 35/7 (let ((*read-base* 16)) (read-from-string "23/7")))
+(= 35/8 (let ((*read-base* 16)) (read-from-string "23/8")))
+(= 35/9 (let ((*read-base* 16)) (read-from-string "23/9")))
+(= 35/10 (let ((*read-base* 16)) (read-from-string "23/A")))
+(= 35/11 (let ((*read-base* 16)) (read-from-string "23/B")))
+(= 35/12 (let ((*read-base* 16)) (read-from-string "23/C")))
+(= 35/13 (let ((*read-base* 16)) (read-from-string "23/D")))
+(= 35/14 (let ((*read-base* 16)) (read-from-string "23/E")))
+(= 35/15 (let ((*read-base* 16)) (read-from-string "23/F")))
+(= 35/10 (let ((*read-base* 16)) (read-from-string "23/a")))
+(= 35/11 (let ((*read-base* 16)) (read-from-string "23/b")))
+(= 35/12 (let ((*read-base* 16)) (read-from-string "23/c")))
+(= 35/13 (let ((*read-base* 16)) (read-from-string "23/d")))
+(= 35/14 (let ((*read-base* 16)) (read-from-string "23/e")))
+(= 35/15 (let ((*read-base* 16)) (read-from-string "23/f")))
+(= 35/16 (let ((*read-base* 16)) (read-from-string "23/10")))
+(= 35/17 (let ((*read-base* 16)) (read-from-string "23/11")))
+(= 35/18 (let ((*read-base* 16)) (read-from-string "23/12")))
+(= 35/19 (let ((*read-base* 16)) (read-from-string "23/13")))
+(= 35/20 (let ((*read-base* 16)) (read-from-string "23/14")))
+(= 35/21 (let ((*read-base* 16)) (read-from-string "23/15")))
+(= 35/22 (let ((*read-base* 16)) (read-from-string "23/16")))
+(= 35/23 (let ((*read-base* 16)) (read-from-string "23/17")))
+(= 35/24 (let ((*read-base* 16)) (read-from-string "23/18")))
+(= 35/25 (let ((*read-base* 16)) (read-from-string "23/19")))
+(= 35/26 (let ((*read-base* 16)) (read-from-string "23/1A")))
+(= 35/27 (let ((*read-base* 16)) (read-from-string "23/1B")))
+(= 35/28 (let ((*read-base* 16)) (read-from-string "23/1C")))
+(= 35/29 (let ((*read-base* 16)) (read-from-string "23/1D")))
+(= 35/30 (let ((*read-base* 16)) (read-from-string "23/1E")))
+(= 35/31 (let ((*read-base* 16)) (read-from-string "23/1F")))
+(= 35/32 (let ((*read-base* 16)) (read-from-string "23/20")))
+(= 35/33 (let ((*read-base* 16)) (read-from-string "23/21")))
+(= 35/34 (let ((*read-base* 16)) (read-from-string "23/22")))
+(= 35/35 (let ((*read-base* 16)) (read-from-string "23/23")))
+(= 35/36 (let ((*read-base* 16)) (read-from-string "23/24")))
+
+(= 110/2 (let ((*read-base* 16)) (read-from-string "6E/2")))
+(= 110/3 (let ((*read-base* 16)) (read-from-string "6E/3")))
+(= 110/4 (let ((*read-base* 16)) (read-from-string "6E/4")))
+(= 110/5 (let ((*read-base* 16)) (read-from-string "6E/5")))
+(= 110/6 (let ((*read-base* 16)) (read-from-string "6E/6")))
+(= 110/7 (let ((*read-base* 16)) (read-from-string "6E/7")))
+(= 110/8 (let ((*read-base* 16)) (read-from-string "6E/8")))
+(= 110/9 (let ((*read-base* 16)) (read-from-string "6E/9")))
+(= 110/10 (let ((*read-base* 16)) (read-from-string "6E/A")))
+(= 110/11 (let ((*read-base* 16)) (read-from-string "6E/B")))
+(= 110/12 (let ((*read-base* 16)) (read-from-string "6E/C")))
+(= 110/13 (let ((*read-base* 16)) (read-from-string "6E/D")))
+(= 110/14 (let ((*read-base* 16)) (read-from-string "6E/E")))
+(= 110/15 (let ((*read-base* 16)) (read-from-string "6E/F")))
+(= 110/10 (let ((*read-base* 16)) (read-from-string "6E/a")))
+(= 110/11 (let ((*read-base* 16)) (read-from-string "6E/b")))
+(= 110/12 (let ((*read-base* 16)) (read-from-string "6E/c")))
+(= 110/13 (let ((*read-base* 16)) (read-from-string "6E/d")))
+(= 110/14 (let ((*read-base* 16)) (read-from-string "6E/e")))
+(= 110/15 (let ((*read-base* 16)) (read-from-string "6E/f")))
+(= 110/16 (let ((*read-base* 16)) (read-from-string "6E/10")))
+(= 110/17 (let ((*read-base* 16)) (read-from-string "6E/11")))
+(= 110/18 (let ((*read-base* 16)) (read-from-string "6E/12")))
+(= 110/19 (let ((*read-base* 16)) (read-from-string "6E/13")))
+(= 110/20 (let ((*read-base* 16)) (read-from-string "6E/14")))
+(= 110/21 (let ((*read-base* 16)) (read-from-string "6E/15")))
+(= 110/22 (let ((*read-base* 16)) (read-from-string "6E/16")))
+(= 110/23 (let ((*read-base* 16)) (read-from-string "6E/17")))
+(= 110/24 (let ((*read-base* 16)) (read-from-string "6E/18")))
+(= 110/25 (let ((*read-base* 16)) (read-from-string "6E/19")))
+(= 110/26 (let ((*read-base* 16)) (read-from-string "6E/1A")))
+(= 110/27 (let ((*read-base* 16)) (read-from-string "6E/1B")))
+(= 110/28 (let ((*read-base* 16)) (read-from-string "6E/1C")))
+(= 110/29 (let ((*read-base* 16)) (read-from-string "6E/1D")))
+(= 110/30 (let ((*read-base* 16)) (read-from-string "6E/1E")))
+(= 110/31 (let ((*read-base* 16)) (read-from-string "6E/1F")))
+(= 110/32 (let ((*read-base* 16)) (read-from-string "6E/20")))
+(= 110/33 (let ((*read-base* 16)) (read-from-string "6E/21")))
+(= 110/34 (let ((*read-base* 16)) (read-from-string "6E/22")))
+(= 110/35 (let ((*read-base* 16)) (read-from-string "6E/23")))
+(= 110/36 (let ((*read-base* 16)) (read-from-string "6E/24")))
+
+(= 11/1111111111111111111111111111111111
+ (read-from-string "11/1111111111111111111111111111111111"))
+
+
+;; float ::= [sign] {decimal-digit}* decimal-point {decimal-digit}+ [exponent]
+;; | [sign] {decimal-digit}+ [decimal-point {decimal-digit}*] exponent
+(let ((f (read-from-string "0.0"))) (and (floatp f) (zerop f)))
+(let ((f (read-from-string "+0.0"))) (and (floatp f) (zerop f)))
+(let ((f (read-from-string "-0.0"))) (and (floatp f) (zerop f)))
+
+(let ((f (read-from-string ".0"))) (and (floatp f) (zerop f)))
+(let ((f (read-from-string "+.0"))) (and (floatp f) (zerop f)))
+(let ((f (read-from-string "-.0"))) (and (floatp f) (zerop f)))
+
+(let ((f (read-from-string "1.0"))) (and (floatp f) (= 1.0 f)))
+(let ((f (read-from-string "+1.0"))) (and (floatp f) (= 1.0 f)))
+(let ((f (read-from-string "-1.0"))) (and (floatp f) (= -1.0 f)))
+
+(let ((f (read-from-string "1d1"))) (and (floatp f) (= 1d1 f)))
+(let ((f (read-from-string "1e1"))) (and (floatp f) (= 1e1 f)))
+(let ((f (read-from-string "1f1"))) (and (floatp f) (= 1f1 f)))
+(let ((f (read-from-string "1l1"))) (and (floatp f) (= 1l1 f)))
+(let ((f (read-from-string "1s1"))) (and (floatp f) (= 1s1 f)))
+(LET ((F (READ-FROM-STRING "1D1"))) (AND (FLOATP F) (= 1D1 F)))
+(LET ((F (READ-FROM-STRING "1E1"))) (AND (FLOATP F) (= 1E1 F)))
+(LET ((F (READ-FROM-STRING "1F1"))) (AND (FLOATP F) (= 1F1 F)))
+(LET ((F (READ-FROM-STRING "1L1"))) (AND (FLOATP F) (= 1L1 F)))
+(LET ((F (READ-FROM-STRING "1S1"))) (AND (FLOATP F) (= 1S1 F)))
+
+(let ((f (read-from-string "1d+1"))) (and (floatp f) (= 1d1 f)))
+(let ((f (read-from-string "1e+1"))) (and (floatp f) (= 1e1 f)))
+(let ((f (read-from-string "1f+1"))) (and (floatp f) (= 1f1 f)))
+(let ((f (read-from-string "1l+1"))) (and (floatp f) (= 1l1 f)))
+(let ((f (read-from-string "1s+1"))) (and (floatp f) (= 1s1 f)))
+(LET ((F (READ-FROM-STRING "1D+1"))) (AND (FLOATP F) (= 1D1 F)))
+(LET ((F (READ-FROM-STRING "1E+1"))) (AND (FLOATP F) (= 1E1 F)))
+(LET ((F (READ-FROM-STRING "1F+1"))) (AND (FLOATP F) (= 1F1 F)))
+(LET ((F (READ-FROM-STRING "1L+1"))) (AND (FLOATP F) (= 1L1 F)))
+(LET ((F (READ-FROM-STRING "1S+1"))) (AND (FLOATP F) (= 1S1 F)))
+
+(let ((f (read-from-string "1d-1"))) (and (floatp f) (= 1d-1 f)))
+(let ((f (read-from-string "1e-1"))) (and (floatp f) (= 1e-1 f)))
+(let ((f (read-from-string "1f-1"))) (and (floatp f) (= 1f-1 f)))
+(let ((f (read-from-string "1l-1"))) (and (floatp f) (= 1l-1 f)))
+(let ((f (read-from-string "1s-1"))) (and (floatp f) (= 1s-1 f)))
+(LET ((F (READ-FROM-STRING "1D-1"))) (AND (FLOATP F) (= 1D-1 F)))
+(LET ((F (READ-FROM-STRING "1E-1"))) (AND (FLOATP F) (= 1E-1 F)))
+(LET ((F (READ-FROM-STRING "1F-1"))) (AND (FLOATP F) (= 1F-1 F)))
+(LET ((F (READ-FROM-STRING "1L-1"))) (AND (FLOATP F) (= 1L-1 F)))
+(LET ((F (READ-FROM-STRING "1S-1"))) (AND (FLOATP F) (= 1S-1 F)))
+
+
+(let ((f (read-from-string "+1d1"))) (and (floatp f) (= 1d1 f)))
+(let ((f (read-from-string "+1e1"))) (and (floatp f) (= 1e1 f)))
+(let ((f (read-from-string "+1f1"))) (and (floatp f) (= 1f1 f)))
+(let ((f (read-from-string "+1l1"))) (and (floatp f) (= 1l1 f)))
+(let ((f (read-from-string "+1s1"))) (and (floatp f) (= 1s1 f)))
+(LET ((F (READ-FROM-STRING "+1D1"))) (AND (FLOATP F) (= 1D1 F)))
+(LET ((F (READ-FROM-STRING "+1E1"))) (AND (FLOATP F) (= 1E1 F)))
+(LET ((F (READ-FROM-STRING "+1F1"))) (AND (FLOATP F) (= 1F1 F)))
+(LET ((F (READ-FROM-STRING "+1L1"))) (AND (FLOATP F) (= 1L1 F)))
+(LET ((F (READ-FROM-STRING "+1S1"))) (AND (FLOATP F) (= 1S1 F)))
+
+(let ((f (read-from-string "+1d+1"))) (and (floatp f) (= 1d1 f)))
+(let ((f (read-from-string "+1e+1"))) (and (floatp f) (= 1e1 f)))
+(let ((f (read-from-string "+1f+1"))) (and (floatp f) (= 1f1 f)))
+(let ((f (read-from-string "+1l+1"))) (and (floatp f) (= 1l1 f)))
+(let ((f (read-from-string "+1s+1"))) (and (floatp f) (= 1s1 f)))
+(LET ((F (READ-FROM-STRING "+1D+1"))) (AND (FLOATP F) (= 1D1 F)))
+(LET ((F (READ-FROM-STRING "+1E+1"))) (AND (FLOATP F) (= 1E1 F)))
+(LET ((F (READ-FROM-STRING "+1F+1"))) (AND (FLOATP F) (= 1F1 F)))
+(LET ((F (READ-FROM-STRING "+1L+1"))) (AND (FLOATP F) (= 1L1 F)))
+(LET ((F (READ-FROM-STRING "+1S+1"))) (AND (FLOATP F) (= 1S1 F)))
+
+(let ((f (read-from-string "+1d-1"))) (and (floatp f) (= 1d-1 f)))
+(let ((f (read-from-string "+1e-1"))) (and (floatp f) (= 1e-1 f)))
+(let ((f (read-from-string "+1f-1"))) (and (floatp f) (= 1f-1 f)))
+(let ((f (read-from-string "+1l-1"))) (and (floatp f) (= 1l-1 f)))
+(let ((f (read-from-string "+1s-1"))) (and (floatp f) (= 1s-1 f)))
+(LET ((F (READ-FROM-STRING "+1D-1"))) (AND (FLOATP F) (= 1D-1 F)))
+(LET ((F (READ-FROM-STRING "+1E-1"))) (AND (FLOATP F) (= 1E-1 F)))
+(LET ((F (READ-FROM-STRING "+1F-1"))) (AND (FLOATP F) (= 1F-1 F)))
+(LET ((F (READ-FROM-STRING "+1L-1"))) (AND (FLOATP F) (= 1L-1 F)))
+(LET ((F (READ-FROM-STRING "+1S-1"))) (AND (FLOATP F) (= 1S-1 F)))
+
+
+(let ((f (read-from-string "-1d1"))) (and (floatp f) (= -1d1 f)))
+(let ((f (read-from-string "-1e1"))) (and (floatp f) (= -1e1 f)))
+(let ((f (read-from-string "-1f1"))) (and (floatp f) (= -1f1 f)))
+(let ((f (read-from-string "-1l1"))) (and (floatp f) (= -1l1 f)))
+(let ((f (read-from-string "-1s1"))) (and (floatp f) (= -1s1 f)))
+(LET ((F (READ-FROM-STRING "-1D1"))) (AND (FLOATP F) (= -1D1 F)))
+(LET ((F (READ-FROM-STRING "-1E1"))) (AND (FLOATP F) (= -1E1 F)))
+(LET ((F (READ-FROM-STRING "-1F1"))) (AND (FLOATP F) (= -1F1 F)))
+(LET ((F (READ-FROM-STRING "-1L1"))) (AND (FLOATP F) (= -1L1 F)))
+(LET ((F (READ-FROM-STRING "-1S1"))) (AND (FLOATP F) (= -1S1 F)))
+
+(let ((f (read-from-string "-1d+1"))) (and (floatp f) (= -1d1 f)))
+(let ((f (read-from-string "-1e+1"))) (and (floatp f) (= -1e1 f)))
+(let ((f (read-from-string "-1f+1"))) (and (floatp f) (= -1f1 f)))
+(let ((f (read-from-string "-1l+1"))) (and (floatp f) (= -1l1 f)))
+(let ((f (read-from-string "-1s+1"))) (and (floatp f) (= -1s1 f)))
+(LET ((F (READ-FROM-STRING "-1D+1"))) (AND (FLOATP F) (= -1D1 F)))
+(LET ((F (READ-FROM-STRING "-1E+1"))) (AND (FLOATP F) (= -1E1 F)))
+(LET ((F (READ-FROM-STRING "-1F+1"))) (AND (FLOATP F) (= -1F1 F)))
+(LET ((F (READ-FROM-STRING "-1L+1"))) (AND (FLOATP F) (= -1L1 F)))
+(LET ((F (READ-FROM-STRING "-1S+1"))) (AND (FLOATP F) (= -1S1 F)))
+
+(let ((f (read-from-string "-1d-1"))) (and (floatp f) (= -1d-1 f)))
+(let ((f (read-from-string "-1e-1"))) (and (floatp f) (= -1e-1 f)))
+(let ((f (read-from-string "-1f-1"))) (and (floatp f) (= -1f-1 f)))
+(let ((f (read-from-string "-1l-1"))) (and (floatp f) (= -1l-1 f)))
+(let ((f (read-from-string "-1s-1"))) (and (floatp f) (= -1s-1 f)))
+(LET ((F (READ-FROM-STRING "-1D-1"))) (AND (FLOATP F) (= -1D-1 F)))
+(LET ((F (READ-FROM-STRING "-1E-1"))) (AND (FLOATP F) (= -1E-1 F)))
+(LET ((F (READ-FROM-STRING "-1F-1"))) (AND (FLOATP F) (= -1F-1 F)))
+(LET ((F (READ-FROM-STRING "-1L-1"))) (AND (FLOATP F) (= -1L-1 F)))
+(LET ((F (READ-FROM-STRING "-1S-1"))) (AND (FLOATP F) (= -1S-1 F)))
+
+
+(let ((f (read-from-string "1d10"))) (and (floatp f) (= 1d10 f)))
+(let ((f (read-from-string "1e10"))) (and (floatp f) (= 1e10 f)))
+(let ((f (read-from-string "1f10"))) (and (floatp f) (= 1f10 f)))
+(let ((f (read-from-string "1l10"))) (and (floatp f) (= 1l10 f)))
+(let ((f (read-from-string "1s10"))) (and (floatp f) (= 1s10 f)))
+(LET ((F (READ-FROM-STRING "1D10"))) (AND (FLOATP F) (= 1D10 F)))
+(LET ((F (READ-FROM-STRING "1E10"))) (AND (FLOATP F) (= 1E10 F)))
+(LET ((F (READ-FROM-STRING "1F10"))) (AND (FLOATP F) (= 1F10 F)))
+(LET ((F (READ-FROM-STRING "1L10"))) (AND (FLOATP F) (= 1L10 F)))
+(LET ((F (READ-FROM-STRING "1S10"))) (AND (FLOATP F) (= 1S10 F)))
+
+(let ((f (read-from-string "1d+10"))) (and (floatp f) (= 1d10 f)))
+(let ((f (read-from-string "1e+10"))) (and (floatp f) (= 1e10 f)))
+(let ((f (read-from-string "1f+10"))) (and (floatp f) (= 1f10 f)))
+(let ((f (read-from-string "1l+10"))) (and (floatp f) (= 1l10 f)))
+(let ((f (read-from-string "1s+10"))) (and (floatp f) (= 1s10 f)))
+(LET ((F (READ-FROM-STRING "1D+10"))) (AND (FLOATP F) (= 1D10 F)))
+(LET ((F (READ-FROM-STRING "1E+10"))) (AND (FLOATP F) (= 1E10 F)))
+(LET ((F (READ-FROM-STRING "1F+10"))) (AND (FLOATP F) (= 1F10 F)))
+(LET ((F (READ-FROM-STRING "1L+10"))) (AND (FLOATP F) (= 1L10 F)))
+(LET ((F (READ-FROM-STRING "1S+10"))) (AND (FLOATP F) (= 1S10 F)))
+
+(let ((f (read-from-string "1d-10"))) (and (floatp f) (= 1d-10 f)))
+(let ((f (read-from-string "1e-10"))) (and (floatp f) (= 1e-10 f)))
+(let ((f (read-from-string "1f-10"))) (and (floatp f) (= 1f-10 f)))
+(let ((f (read-from-string "1l-10"))) (and (floatp f) (= 1l-10 f)))
+(let ((f (read-from-string "1s-10"))) (and (floatp f) (= 1s-10 f)))
+(LET ((F (READ-FROM-STRING "1D-10"))) (AND (FLOATP F) (= 1D-10 F)))
+(LET ((F (READ-FROM-STRING "1E-10"))) (AND (FLOATP F) (= 1E-10 F)))
+(LET ((F (READ-FROM-STRING "1F-10"))) (AND (FLOATP F) (= 1F-10 F)))
+(LET ((F (READ-FROM-STRING "1L-10"))) (AND (FLOATP F) (= 1L-10 F)))
+(LET ((F (READ-FROM-STRING "1S-10"))) (AND (FLOATP F) (= 1S-10 F)))
+
+
+(let ((f (read-from-string "+1d10"))) (and (floatp f) (= 1d10 f)))
+(let ((f (read-from-string "+1e10"))) (and (floatp f) (= 1e10 f)))
+(let ((f (read-from-string "+1f10"))) (and (floatp f) (= 1f10 f)))
+(let ((f (read-from-string "+1l10"))) (and (floatp f) (= 1l10 f)))
+(let ((f (read-from-string "+1s10"))) (and (floatp f) (= 1s10 f)))
+(LET ((F (READ-FROM-STRING "+1D10"))) (AND (FLOATP F) (= 1D10 F)))
+(LET ((F (READ-FROM-STRING "+1E10"))) (AND (FLOATP F) (= 1E10 F)))
+(LET ((F (READ-FROM-STRING "+1F10"))) (AND (FLOATP F) (= 1F10 F)))
+(LET ((F (READ-FROM-STRING "+1L10"))) (AND (FLOATP F) (= 1L10 F)))
+(LET ((F (READ-FROM-STRING "+1S10"))) (AND (FLOATP F) (= 1S10 F)))
+
+(let ((f (read-from-string "+1d+10"))) (and (floatp f) (= 1d10 f)))
+(let ((f (read-from-string "+1e+10"))) (and (floatp f) (= 1e10 f)))
+(let ((f (read-from-string "+1f+10"))) (and (floatp f) (= 1f10 f)))
+(let ((f (read-from-string "+1l+10"))) (and (floatp f) (= 1l10 f)))
+(let ((f (read-from-string "+1s+10"))) (and (floatp f) (= 1s10 f)))
+(LET ((F (READ-FROM-STRING "+1D+10"))) (AND (FLOATP F) (= 1D10 F)))
+(LET ((F (READ-FROM-STRING "+1E+10"))) (AND (FLOATP F) (= 1E10 F)))
+(LET ((F (READ-FROM-STRING "+1F+10"))) (AND (FLOATP F) (= 1F10 F)))
+(LET ((F (READ-FROM-STRING "+1L+10"))) (AND (FLOATP F) (= 1L10 F)))
+(LET ((F (READ-FROM-STRING "+1S+10"))) (AND (FLOATP F) (= 1S10 F)))
+
+(let ((f (read-from-string "+1d-10"))) (and (floatp f) (= 1d-10 f)))
+(let ((f (read-from-string "+1e-10"))) (and (floatp f) (= 1e-10 f)))
+(let ((f (read-from-string "+1f-10"))) (and (floatp f) (= 1f-10 f)))
+(let ((f (read-from-string "+1l-10"))) (and (floatp f) (= 1l-10 f)))
+(let ((f (read-from-string "+1s-10"))) (and (floatp f) (= 1s-10 f)))
+(LET ((F (READ-FROM-STRING "+1D-10"))) (AND (FLOATP F) (= 1D-10 F)))
+(LET ((F (READ-FROM-STRING "+1E-10"))) (AND (FLOATP F) (= 1E-10 F)))
+(LET ((F (READ-FROM-STRING "+1F-10"))) (AND (FLOATP F) (= 1F-10 F)))
+(LET ((F (READ-FROM-STRING "+1L-10"))) (AND (FLOATP F) (= 1L-10 F)))
+(LET ((F (READ-FROM-STRING "+1S-10"))) (AND (FLOATP F) (= 1S-10 F)))
+
+
+(let ((f (read-from-string "-1d10"))) (and (floatp f) (= -1d10 f)))
+(let ((f (read-from-string "-1e10"))) (and (floatp f) (= -1e10 f)))
+(let ((f (read-from-string "-1f10"))) (and (floatp f) (= -1f10 f)))
+(let ((f (read-from-string "-1l10"))) (and (floatp f) (= -1l10 f)))
+(let ((f (read-from-string "-1s10"))) (and (floatp f) (= -1s10 f)))
+(LET ((F (READ-FROM-STRING "-1D10"))) (AND (FLOATP F) (= -1D10 F)))
+(LET ((F (READ-FROM-STRING "-1E10"))) (AND (FLOATP F) (= -1E10 F)))
+(LET ((F (READ-FROM-STRING "-1F10"))) (AND (FLOATP F) (= -1F10 F)))
+(LET ((F (READ-FROM-STRING "-1L10"))) (AND (FLOATP F) (= -1L10 F)))
+(LET ((F (READ-FROM-STRING "-1S10"))) (AND (FLOATP F) (= -1S10 F)))
+
+(let ((f (read-from-string "-1d+10"))) (and (floatp f) (= -1d10 f)))
+(let ((f (read-from-string "-1e+10"))) (and (floatp f) (= -1e10 f)))
+(let ((f (read-from-string "-1f+10"))) (and (floatp f) (= -1f10 f)))
+(let ((f (read-from-string "-1l+10"))) (and (floatp f) (= -1l10 f)))
+(let ((f (read-from-string "-1s+10"))) (and (floatp f) (= -1s10 f)))
+(LET ((F (READ-FROM-STRING "-1D+10"))) (AND (FLOATP F) (= -1D10 F)))
+(LET ((F (READ-FROM-STRING "-1E+10"))) (AND (FLOATP F) (= -1E10 F)))
+(LET ((F (READ-FROM-STRING "-1F+10"))) (AND (FLOATP F) (= -1F10 F)))
+(LET ((F (READ-FROM-STRING "-1L+10"))) (AND (FLOATP F) (= -1L10 F)))
+(LET ((F (READ-FROM-STRING "-1S+10"))) (AND (FLOATP F) (= -1S10 F)))
+
+(let ((f (read-from-string "-1d-10"))) (and (floatp f) (= -1d-10 f)))
+(let ((f (read-from-string "-1e-10"))) (and (floatp f) (= -1e-10 f)))
+(let ((f (read-from-string "-1f-10"))) (and (floatp f) (= -1f-10 f)))
+(let ((f (read-from-string "-1l-10"))) (and (floatp f) (= -1l-10 f)))
+(let ((f (read-from-string "-1s-10"))) (and (floatp f) (= -1s-10 f)))
+(LET ((F (READ-FROM-STRING "-1D-10"))) (AND (FLOATP F) (= -1D-10 F)))
+(LET ((F (READ-FROM-STRING "-1E-10"))) (AND (FLOATP F) (= -1E-10 F)))
+(LET ((F (READ-FROM-STRING "-1F-10"))) (AND (FLOATP F) (= -1F-10 F)))
+(LET ((F (READ-FROM-STRING "-1L-10"))) (AND (FLOATP F) (= -1L-10 F)))
+(LET ((F (READ-FROM-STRING "-1S-10"))) (AND (FLOATP F) (= -1S-10 F)))
+
+(floatp (read-from-string "-1.23"))
+(floatp (read-from-string "-823.0023D10"))
+(floatp (read-from-string "-324.0293E10"))
+(floatp (read-from-string "-12.0023F10"))
+(floatp (read-from-string "-911.823L10"))
+(floatp (read-from-string "-788.823S10"))
+
+(eq '|\256| (read-from-string "\\256"))
+(eq '|25\64| (read-from-string "25\\64"))
+(eq '|1.0\E6| (read-from-string "1.0\\E6"))
+(eq '|100| (read-from-string "|100|"))
+(eq '|3.14159| (read-from-string "3\\.14159"))
+(eq '|3/4| (read-from-string "|3/4|"))
+(eq '|3/4| (read-from-string "3\\/4"))
+(eq '|5| (read-from-string "5||"))
+(eq '|5| (read-from-string "||5"))
+(eq '|567| (read-from-string "||567"))
+(eq '|567| (read-from-string "5||67"))
+(eq '|567| (read-from-string "56||7"))
+(eq '|567| (read-from-string "567||"))
+(eq '|567| (read-from-string "||5||6||7||"))
+(eq '|567| (read-from-string "||||5||||6||||7||||"))
+(eq '|567| (read-from-string "567||||||"))
+
+
+(eq '|/| (read-from-string "/"))
+(eq '|/5| (read-from-string "/5"))
+(eq '|+| (read-from-string "+"))
+(eq '|1+| (read-from-string "1+"))
+(eq '|1-| (read-from-string "1-"))
+(eq '|FOO+| (read-from-string "foo+"))
+(eq '|AB.CD| (read-from-string "ab.cd"))
+(eq '|_| (read-from-string "_"))
+(eq '|^| (read-from-string "^"))
+(eq '|^/-| (read-from-string "^/-"))
+
+(eq :a (read-from-string ":a"))
+(eq :b (read-from-string ":b"))
+(eq :c (read-from-string ":c"))
+(eq :d (read-from-string ":d"))
+(eq :keyword-symbol (read-from-string ":keyword-symbol"))
+(eq 'cl::cdr (read-from-string "cl::cdr"))
+(eq 'cl:append (read-from-string "cl:append"))
+(eq 'cl-user::append (read-from-string "cl-user::append"))
+(progn
+ (when (find-package 'test-foo) (delete-package 'test-foo))
+ (make-package 'test-foo :use nil)
+ (handler-case (read-from-string "test-foo:no-such-symbol")
+ (error () t)
+ (:no-error (&rest rest) (declare (ignore rest)) nil)))
+(progn
+ (when (find-package 'test-foo) (delete-package 'test-foo))
+ (make-package 'test-foo :use nil)
+ (and (not (find-symbol "NEW-ONE" "TEST-FOO"))
+ (read-from-string "test-foo::new-one")
+ (find-symbol "NEW-ONE" "TEST-FOO")))
+(progn
+ (when (find-package 'test-foo) (delete-package 'test-foo))
+ (let ((*package* (make-package 'test-foo :use nil)))
+ (read-from-string "my-symbol")))
+(string= " " (symbol-name (read-from-string "cl-user::\\ ")))
+(progn
+ (when (find-package 'no-such-package) (delete-package 'no-such-package))
+ (handler-case (read-from-string "no-such-package::bar")
+ (error () t)
+ (:no-error (&rest rest) (declare (ignore rest)) nil)))
+(progn
+ (when (find-package 'no-such-package) (delete-package 'no-such-package))
+ (handler-case (read-from-string "no-such-package::no-such-symbol")
+ (error () t)
+ (:no-error (&rest rest) (declare (ignore rest)) nil)))
+
+
+(string= "FROBBOZ" (symbol-name (read-from-string "FROBBOZ")))
+(string= "FROBBOZ" (symbol-name (read-from-string "frobboz")))
+(string= "FROBBOZ" (symbol-name (read-from-string "fRObBoz")))
+(string= "UNWIND-PROTECT" (symbol-name (read-from-string "unwind-protect")))
+(string= "+$" (symbol-name (read-from-string "+$")))
+(string= "1+" (symbol-name (read-from-string "1+")))
+(= 1 (read-from-string "+1"))
+(string= "PASCAL_STYLE" (symbol-name (read-from-string "pascal_style")))
+(string= "FILE.REL.43" (symbol-name (read-from-string "file.rel.43")))
+(string= "\(" (symbol-name (read-from-string "\\(")))
+(string= "\+1" (symbol-name (read-from-string "\\+1")))
+(string= "+\1" (symbol-name (read-from-string "+\\1")))
+(string= "fROBBOZ" (symbol-name (read-from-string "\\frobboz")))
+(string= "3.14159265s0" (symbol-name (read-from-string "3.14159265\\s0")))
+(string= "3.14159265S0" (symbol-name (read-from-string "3.14159265\\S0")))
+(string= "FOo" (symbol-name (read-from-string "fo\\o")))
+
+(string= "APL\\360" (symbol-name (read-from-string "APL\\\\360")))
+(string= "APL\\360" (symbol-name (read-from-string "apl\\\\360")))
+(string= "(B^2)-4*A*C" (symbol-name (read-from-string "\\(b^2\\)\\-\\4*a*c")))
+(string= "(b^2)-4*a*c"
+ (symbol-name (read-from-string "\\(\\b^2\\)\\-\\4*\\a*\\c")))
+(string= "\"" (symbol-name (read-from-string "|\"|")))
+(string= "(b^2) - 4*a*c" (symbol-name (read-from-string "|(b^2) - 4*a*c|")))
+(string= "frobboz" (symbol-name (read-from-string "|frobboz|")))
+(string= "APL360" (symbol-name (read-from-string "|APL\\360|")))
+(string= "APL\\360" (symbol-name (read-from-string "|APL\\\\360|")))
+(string= "apl\\360" (symbol-name (read-from-string "|apl\\\\360|")))
+(string= "||" (symbol-name (read-from-string "|\\|\\||")))
+(string= "(B^2) - 4*A*C" (symbol-name (read-from-string "|(B^2) - 4*A*C|")))
+(string= "(b^2) - 4*a*c" (symbol-name (read-from-string "|(b^2) - 4*a*c|")))
+(string= "." (symbol-name (read-from-string "\\.")))
+(string= ".." (symbol-name (read-from-string "|..|")))
+
+
+(null (read-from-string "()"))
+(null (read-from-string "( )"))
+(null (read-from-string "( )"))
+(equal (read-from-string "(a)") '(a))
+(equal (read-from-string "( a)") '(a))
+(equal (read-from-string "(a )") '(a))
+(equal (read-from-string "( a )") '(a))
+(equal (read-from-string "(a b)") '(a b))
+(equal (read-from-string "( a b)") '(a b))
+(equal (read-from-string "( a b )") '(a b))
+(equal (read-from-string "( a b )") '(a b))
+(equal (read-from-string "( a b )") '(a b))
+(equal (read-from-string "(a #| |# b)") '(a b))
+(equal (read-from-string "(a #| |# b #| |# )") '(a b))
+(equal (read-from-string "(a #| |# b
+)") '(a b))
+(equal (read-from-string "(
+a
+b
+)") '(a b))
+(equal (read-from-string "(a . b)") '(a . b))
+(equal (read-from-string "(a . nil)") '(a))
+(equal (read-from-string "(a . (b))") '(a b))
+(equal (read-from-string "(a . (b . (c . (d))))") '(a b c d))
+(let ((x (read-from-string "(a .$b)")))
+ (and (= 2 (length x))
+ (eq (first x) 'a)
+ (eq (second x) '|.$B|)))
+(equal (read-from-string "(a b c . d)")
+ (cons 'a (cons 'b (cons 'c 'd))))
+(equal (read-from-string "(this-one . that-one)")
+ (cons 'this-one 'that-one))
+(equal (read-from-string "(a b c d . (e f . (g)))") '(a b c d e f g))
+(equal (read-from-string "(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30)")
+ '(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30))
+(handler-case (read-from-string ")")
+ (error () t)
+ (:no-error (&rest rest) (declare (ignore rest)) nil))
+
+(equal (read-from-string "(a (b (c d)))") '(a (b (c d))))
+(equal (read-from-string "'a") '(quote a))
+(equal (read-from-string "'(a b c)") '(quote (a b c)))
+(equal (read-from-string "'''(a b c)") '(quote (quote (quote (a b c)))))
+(equal (read-from-string "'(a 'b '('c))")
+ '(quote (a (quote b) (quote ((quote c))))))
+(equal (read-from-string "'('('a '('b 'c)))")
+ '(quote ((quote ((quote a) (quote ((quote b) (quote c))))))))
+(equal (read-from-string "''''''a")
+ '(quote (quote (quote (quote (quote (quote a)))))))
+(equal (read-from-string "' a") '(quote a))
+(eq 'quote (eval (read-from-string "(car ''foo)")))
+
+
+
+(eq (read-from-string "; comment
+a") 'a)
+(= 7 (eval (read-from-string "(+ 3 ; three
+4)")))
+(eq 'a (read-from-string ";;;;;;;
+a"))
+(equal (read-from-string "(a ;;;;;;;
+b ;;
+;;
+c;;;;;;;;;;;;;;;;;;;;;;;;;;;
+d)") '(a b c d))
+(equal (read-from-string "(a ; comment
+ ;
+ ;
+;
+b)") '(a b))
+(equal (read-from-string "(a\\;b c)") '(|A;B| c))
+
+(string= (read-from-string "\"hello\"") "hello")
+(string= (read-from-string "\"\\\"hello\\\"\"") "\"hello\"")
+(string= (read-from-string "\"|hello|\"") "|hello|")
+(string= "string" (read-from-string " \"string\""))
+(let ((x (read-from-string "\"\\\\\"")))
+ (and (= 1 (length x)) (char= #\\ (char x 0))))
+(string= " This is a sentence. " (read-from-string "\" This is a sentence. \""))
+(simple-string-p (read-from-string "\"a simple string\""))
+(let ((x (read-from-string "\"\\\"\"")))
+ (and (= 1 (length x)) (char= #\" (char x 0))))
+(let ((x (read-from-string "\"|\"")))
+ (and (= 1 (length x)) (char= #\| (char x 0))))
+
+
+(eq (eval (read-from-string "`a")) 'a)
+(equal (eval (read-from-string "(let ((x 1)) `(a ,x))")) '(a 1))
+(equal (eval (read-from-string "(let ((x 1)) `(a ,`(,x)))")) '(a (1)))
+(equal (eval (read-from-string "(let ((a 0) (c 2) (d '(3))) `((,a b) ,c ,@d))"))
+ '((0 b) 2 3))
+(equal
+ (eval (read-from-string "(let ((a 0) (c 2) (d '(3 4 5))) `((,a b) ,c ,@d))"))
+ '((0 b) 2 3 4 5))
+(equal
+ (eval (read-from-string "(let ((a '(0 1)) (c 2) (d '(3 4 5)))
+ `((,a b) ,c ,@d))"))
+ '(((0 1) b) 2 3 4 5))
+(equal
+ (eval (read-from-string "(let ((a '(0 1)) (c 2) (d '(3 4 5)))
+ `((,@a b) ,c ,@d))"))
+ '((0 1 b) 2 3 4 5))
+(equal (eval (read-from-string "`(a b ,`c)")) '(a b c))
+(equal (eval (read-from-string "`(a ,@(map 'list #'char-upcase \"bcd\") e f)"))
+ '(a #\B #\C #\D E F))
+(equal (eval (read-from-string "(let ((x 1)) `(a . ,x))")) '(a . 1))
+(equal (eval (read-from-string "(let ((x '(b c))) `(a . ,x))")) '(a b c))
+(equalp (eval (read-from-string "(let ((x #(b c))) `(a . ,x))")) '(a . #(b c)))
+(equalp (eval (read-from-string "(let ((x '(b c))) `#(a ,x))")) #(a (b c)))
+(equalp (eval (read-from-string "(let ((x 'b ) (y 'c)) `#(a ,x ,y))"))
+ #(a b c))
+(equalp (eval (read-from-string "(let ((x '(b c))) `#(a ,@x))")) #(a b c))
+(equalp (eval (read-from-string "`\"abc\"")) "abc")
+(equalp (eval (read-from-string "(let ((x '(b c)) (y '(d e)) (z '(f g))) `(a ,@x ,@y ,@z))")) '(a b c d e f g))
+(equalp (eval (read-from-string "(let ((x '(b c)) (y 'd) (z '(e f g h))) `(a ,@x ,y ,@z))")) '(a b c d e f g h))
+(equal (eval (read-from-string "`(a ,@(mapcar #'char-downcase `(,(char-upcase #\\b) ,(char-upcase #\\c) ,(char-upcase #\\d))) e f)"))
+ '(a #\b #\c #\d e f))
+(equal (eval (read-from-string "`(a ,@(map 'list #'char-downcase `#(,(char-upcase #\\b) ,(char-upcase #\\c) ,(char-upcase #\\d))) e f)"))
+ '(a #\b #\c #\d e f))
+(equal (eval (read-from-string "(let ((x 1)) `(a (,x)))")) '(a (1)))
+(equal (eval (read-from-string "(let ((x 1)) `(a ((,x))))")) '(a ((1))))
+(equal (eval (read-from-string "(let ((x 1)) `(a (((,x)))))")) '(a (((1)))))
+(equalp (eval (read-from-string "(let ((x 1)) `(a ((#(,x)))))")) '(a ((#(1)))))
+(equalp (eval (read-from-string "(let ((x 1)) `(a #((#(,x)))))")) '(a #((#(1)))))
+(equalp (eval (read-from-string "(let ((x 1)) `#(a #((#(,x)))))"))
+ '#(a #((#(1)))))
+(equal (eval (read-from-string "(let ((x 1) (y 2) (z 3)) `(,x (,y) ((,z))))"))
+ '(1 (2) ((3))))
+(equal (eval (read-from-string
+ "(let ((x 1) (y 2) (z 3)) `((,x) ((,y)) (((,z)))))"))
+ '((1) ((2)) (((3)))))
+(equal (eval (read-from-string
+ "(let ((x 1) (y 2) (z 3)) `(((,x)) (((,y))) ((((,z))))))"))
+ '(((1)) (((2))) ((((3))))))
+(equal (eval (read-from-string
+ "(let ((x 1) (y 2) (z 3)) `((((,x))) ((((,y)))) (((((,z)))))))"))
+ '((((1))) ((((2)))) (((((3)))))))
+(equalp (eval (read-from-string "(let ((x 1) (y 2) (z 3)) `#(,x (,y) ((,z))))"))
+ '#(1 (2) ((3))))
+(equalp (eval (read-from-string
+ "(let ((x 1) (y 2) (z 3)) `#((,x) ((,y)) (((,z)))))"))
+ '#((1) ((2)) (((3)))))
+(equalp (eval (read-from-string
+ "(let ((x 1) (y 2) (z 3)) `#(((,x)) (((,y))) ((((,z))))))"))
+ '#(((1)) (((2))) ((((3))))))
+(equalp (eval (read-from-string
+ "(let ((x 1) (y 2) (z 3)) `#((((,x))) ((((,y)))) (((((,z)))))))"))
+ '#((((1))) ((((2)))) (((((3)))))))
+(equal (eval (read-from-string "(let ((x 1)) `'(,x))")) ''(1))
+(equal (eval (read-from-string "(let ((x 1)) `'(',x))")) ''('1))
+(equal (eval (read-from-string "`'(','x))")) ''('x))
+(equal (eval (read-from-string "`(a . b)")) '(a . b))
+(equal (eval (read-from-string "(let ((x 1)) `(a . ,x))")) '(a . 1))
+(equal (eval (read-from-string "(let ((x 1)) `(a . (b . (,x))))")) '(a b 1))
+(equal (eval (read-from-string "(let ((x 1)) `(a ,x . z))")) '(a 1 . z))
+(equalp (eval (read-from-string "(let ((x 1)) `(a #(#(#(,x))) . z))"))
+ '(a #(#(#(1))) . z))
+
+(handler-case (read-from-string ",")
+ (error () t)
+ (:no-error (&rest rest) (declare (ignore rest)) nil))
+
+(handler-case (read-from-string "'(,x)")
+ (error () t)
+ (:no-error (&rest rest) (declare (ignore rest)) nil))
+
+(handler-case (read-from-string "`(,(append ,x y))")
+ (error () t)
+ (:no-error (&rest rest) (declare (ignore rest)) nil))
+
+(char= (read-from-string "#\\a") #\a)
+(char= (read-from-string "#\\b") #\b)
+(char= (read-from-string "#\\c") #\c)
+(char= (read-from-string "#\\d") #\d)
+(char= (read-from-string "#\\e") #\e)
+(char= (read-from-string "#\\f") #\f)
+(char= (read-from-string "#\\g") #\g)
+(char= (read-from-string "#\\h") #\h)
+(char= (read-from-string "#\\i") #\i)
+(char= (read-from-string "#\\j") #\j)
+(char= (read-from-string "#\\k") #\k)
+(char= (read-from-string "#\\l") #\l)
+(char= (read-from-string "#\\m") #\m)
+(char= (read-from-string "#\\n") #\n)
+(char= (read-from-string "#\\o") #\o)
+(char= (read-from-string "#\\p") #\p)
+(char= (read-from-string "#\\q") #\q)
+(char= (read-from-string "#\\r") #\r)
+(char= (read-from-string "#\\s") #\s)
+(char= (read-from-string "#\\t") #\t)
+(char= (read-from-string "#\\u") #\u)
+(char= (read-from-string "#\\v") #\v)
+(char= (read-from-string "#\\w") #\w)
+(char= (read-from-string "#\\x") #\x)
+(char= (read-from-string "#\\y") #\y)
+(char= (read-from-string "#\\z") #\z)
+(CHAR= (READ-FROM-STRING "#\\A") #\A)
+(CHAR= (READ-FROM-STRING "#\\B") #\B)
+(CHAR= (READ-FROM-STRING "#\\C") #\C)
+(CHAR= (READ-FROM-STRING "#\\D") #\D)
+(CHAR= (READ-FROM-STRING "#\\E") #\E)
+(CHAR= (READ-FROM-STRING "#\\F") #\F)
+(CHAR= (READ-FROM-STRING "#\\G") #\G)
+(CHAR= (READ-FROM-STRING "#\\H") #\H)
+(CHAR= (READ-FROM-STRING "#\\I") #\I)
+(CHAR= (READ-FROM-STRING "#\\J") #\J)
+(CHAR= (READ-FROM-STRING "#\\K") #\K)
+(CHAR= (READ-FROM-STRING "#\\L") #\L)
+(CHAR= (READ-FROM-STRING "#\\M") #\M)
+(CHAR= (READ-FROM-STRING "#\\N") #\N)
+(CHAR= (READ-FROM-STRING "#\\O") #\O)
+(CHAR= (READ-FROM-STRING "#\\P") #\P)
+(CHAR= (READ-FROM-STRING "#\\Q") #\Q)
+(CHAR= (READ-FROM-STRING "#\\R") #\R)
+(CHAR= (READ-FROM-STRING "#\\S") #\S)
+(CHAR= (READ-FROM-STRING "#\\T") #\T)
+(CHAR= (READ-FROM-STRING "#\\U") #\U)
+(CHAR= (READ-FROM-STRING "#\\V") #\V)
+(CHAR= (READ-FROM-STRING "#\\W") #\W)
+(CHAR= (READ-FROM-STRING "#\\X") #\X)
+(CHAR= (READ-FROM-STRING "#\\Y") #\Y)
+(CHAR= (READ-FROM-STRING "#\\Z") #\Z)
+(not (char= (read-from-string "#\\Z") (read-from-string "#\\z")))
+
+(char= (read-from-string "#\\0") #\0)
+(char= (read-from-string "#\\1") #\1)
+(char= (read-from-string "#\\2") #\2)
+(char= (read-from-string "#\\3") #\3)
+(char= (read-from-string "#\\4") #\4)
+(char= (read-from-string "#\\5") #\5)
+(char= (read-from-string "#\\6") #\6)
+(char= (read-from-string "#\\7") #\7)
+(char= (read-from-string "#\\8") #\8)
+(char= (read-from-string "#\\9") #\9)
+
+(char= (read-from-string "#\\!") #\!)
+(char= (read-from-string "#\\$") #\$)
+(char= (read-from-string "#\\\"") #\")
+(char= (read-from-string "#\\'") #\')
+(char= (read-from-string "#\\(") #\()
+(char= (read-from-string "#\\)") #\))
+(char= (read-from-string "#\\,") #\,)
+(char= (read-from-string "#\\_") #\_)
+(char= (read-from-string "#\\-") #\-)
+(char= (read-from-string "#\\.") #\.)
+(char= (read-from-string "#\\/") #\/)
+(char= (read-from-string "#\\:") #\:)
+(char= (read-from-string "#\\;") #\;)
+(char= (read-from-string "#\\?") #\?)
+(char= (read-from-string "#\\+") #\+)
+(char= (read-from-string "#\\<") #\<)
+(char= (read-from-string "#\\=") #\=)
+(char= (read-from-string "#\\>") #\>)
+(char= (read-from-string "#\\#") #\#)
+(char= (read-from-string "#\\%") #\%)
+(char= (read-from-string "#\\&") #\&)
+(char= (read-from-string "#\\*") #\*)
+(char= (read-from-string "#\\@") #\@)
+(char= (read-from-string "#\\[") #\[)
+(char= (read-from-string "#\\\\") #\\)
+(char= (read-from-string "#\\]") #\])
+(char= (read-from-string "#\\{") #\{)
+(char= (read-from-string "#\\|") #\|)
+(char= (read-from-string "#\\}") #\})
+(char= (read-from-string "#\\`") #\`)
+(char= (read-from-string "#\\^") #\^)
+(char= (read-from-string "#\\~") #\~)
+
+(char= (read-from-string "#\\newline") #\newline)
+(char= (read-from-string "#\\space") #\space)
+(char= (read-from-string "#\\Newline") #\newline)
+(char= (read-from-string "#\\Space") #\space)
+(char= (read-from-string "#\\NeWlInE") #\newline)
+(char= (read-from-string "#\\SpAcE") #\space)
+(char= (read-from-string "#\\NEWLINE") #\newline)
+(char= (read-from-string "#\\SPACE") #\space)
+
+
+(equal (read-from-string "#'car") '(function car))
+(eq (eval (read-from-string "#'car")) #'car)
+
+(simple-vector-p (read-from-string "#(a)"))
+(equalp (read-from-string "#(a)") #(a))
+(equalp (read-from-string "#()") #())
+(equalp (read-from-string "#(a b)") #(a b))
+(equalp (read-from-string "#(a b c)") #(a b c))
+(equalp (read-from-string "#(a b c d)") #(a b c d))
+(equalp (read-from-string "#(a b c d e)") #(a b c d e))
+(equalp (read-from-string "#(a b c d e f)") #(a b c d e f))
+(equalp (read-from-string "#(a b c d e f g)") #(a b c d e f g))
+(equalp (read-from-string "#(a b c c c c)") #(a b c c c c))
+(equalp (read-from-string "#6(a b c c c c)") #(a b c c c c))
+(equalp (read-from-string "#6(a b c)") #(a b c c c c))
+(equalp (read-from-string "#6(a b c c)") #(a b c c c c))
+(let ((x (read-from-string "#(a b c)"))) (= 3 (length x)))
+(let ((x (read-from-string "#()")))
+ (and (simple-vector-p x)
+ (zerop (length x))
+ (equalp x #0())))
+(let ((x (read-from-string "#0()")))
+ (and (simple-vector-p x)
+ (zerop (length x))
+ (equalp x #())))
+(equalp (read-from-string "#1(a)") #(a))
+(equalp (read-from-string "#2(a b)") #(a b))
+(equalp (read-from-string "#3(a b c)") #(a b c))
+(equalp (read-from-string "#4(a b c d)") #(a b c d))
+(equalp (read-from-string "#5(a b c d e)") #(a b c d e))
+(equalp (read-from-string "#6(a b c d e f)") #(a b c d e f))
+(equalp (read-from-string "#2(a)") #(a a))
+(equalp (read-from-string "#3(a)") #(a a a))
+(equalp (read-from-string "#4(a)") #(a a a a))
+(equalp (read-from-string "#5(a)") #(a a a a a))
+(equalp (read-from-string "#6(a)") #(a a a a a a))
+(equalp (read-from-string "#7(a)") #(a a a a a a a))
+(equalp (read-from-string "#8(a)") #(a a a a a a a a))
+(equalp (read-from-string "#9(a)") #(a a a a a a a a a))
+(equalp (read-from-string "#10(a)") #(a a a a a a a a a a))
+(let ((x (read-from-string "#100(a)")))
+ (and (simple-vector-p x)
+ (= 100 (length x))
+ (every #'symbolp x)
+ (every #'(lambda (s) (eq s 'a)) x)))
+(let ((x (read-from-string "#100(#\\z)")))
+ (and (simple-vector-p x)
+ (= 100 (length x))
+ (every #'characterp x)
+ (every #'(lambda (c) (char= c #\z)) x)))
+(let ((x (read-from-string "#100(#())")))
+ (and (simple-vector-p x)
+ (= 100 (length x))
+ (every #'simple-vector-p x)
+ (every #'(lambda (v) (zerop (length v))) x)))
+
+
+(equalp (read-from-string "#*0") #*0)
+(equalp (read-from-string "#*1") #*1)
+(equalp (read-from-string "#*01") #*01)
+(equalp (read-from-string "#*10") #*10)
+(equalp (read-from-string "#*11") #*11)
+(equalp (read-from-string "#0*") #*)
+(equalp (read-from-string "#*") #*)
+(equalp (read-from-string "#3*1") #*111)
+(equalp (read-from-string "#3*10") #*100)
+(equalp (read-from-string "#*101111") #*101111)
+(equalp (read-from-string "#6*101111") #*101111)
+(equalp (read-from-string "#6*101") #*101111)
+(equalp (read-from-string "#6*1011") #*101111)
+(let ((x (read-from-string "#*10")))
+ (and (simple-bit-vector-p x)
+ (= 2 (length x))
+ (= 1 (bit x 0))
+ (= 0 (bit x 1))))
+(let ((x (read-from-string "#*")))
+ (and (simple-bit-vector-p x)
+ (zerop (length x))))
+(let ((x (read-from-string "#100*0")))
+ (and (simple-bit-vector-p x)
+ (= 100 (length x))
+ (every #'zerop x)))
+(let ((x (read-from-string "#100*1")))
+ (and (simple-bit-vector-p x)
+ (= 100 (length x))
+ (every #'(lambda (n) (= 1 n)) x)))
+(handler-case (read-from-string "#3*1110")
+ (reader-error () t)
+ (error () nil)
+ (:no-error (&rest rest) (declare (ignore rest)) nil))
+(handler-case (read-from-string "#3*")
+ (reader-error () t)
+ (error () nil)
+ (:no-error (&rest rest) (declare (ignore rest)) nil))
+(handler-case (read-from-string "#3*abc")
+ (reader-error () t)
+ (error () nil)
+ (:no-error (&rest rest) (declare (ignore rest)) nil))
+
+(let ((symbol (read-from-string "#:ok")))
+ (and (null (symbol-package symbol)) (string= (symbol-name symbol) "OK")))
+(let ((symbol (read-from-string "#:g10")))
+ (and (null (symbol-package symbol)) (string= (symbol-name symbol) "G10")))
+(let ((symbol (read-from-string "#:10")))
+ (and (null (symbol-package symbol)) (string= (symbol-name symbol) "10")))
+(let ((symbol (read-from-string "#:0")))
+ (and (null (symbol-package symbol)) (string= (symbol-name symbol) "0")))
+(let ((symbol (read-from-string "#:-")))
+ (and (null (symbol-package symbol)) (string= (symbol-name symbol) "-")))
+(let ((symbol (read-from-string "#:\\-")))
+ (and (null (symbol-package symbol)) (string= (symbol-name symbol) "-")))
+(let ((symbol (read-from-string "#:$$-$$")))
+ (and (null (symbol-package symbol)) (string= (symbol-name symbol) "$$-$$")))
+
+(eq 'a (read-from-string "#.'a"))
+(packagep (read-from-string "#.*package*"))
+(= 11 (read-from-string "#.(let ((x 10)) (1+ x))"))
+(= 4 (read-from-string "#.(1+ 3)"))
+(handler-case (let ((*read-eval* nil)) (read-from-string "#.(1+ 3)"))
+ (reader-error () t)
+ (error () nil)
+ (:no-error (&rest rest) (declare (ignore rest)) nil))
+(equal '(a b . 3) (read-from-string "#.(let ((x 3)) `(a b . ,x))"))
+
+
+(= (read-from-string "#b0") 0)
+(= (read-from-string "#B0") 0)
+(= (read-from-string "#b01") 1)
+(= (read-from-string "#B01") 1)
+(= (read-from-string "#B1101") 13)
+(= (read-from-string "#b101/11") 5/3)
+(= 172236929 (read-from-string "#b1010010001000010000010000001"))
+
+(= (read-from-string "#o0") 0)
+(= (read-from-string "#O0") 0)
+(= (read-from-string "#o37/15") 31/13)
+(= (read-from-string "#o777") 511)
+(= (read-from-string "#o105") 69)
+(= (read-from-string "#O37/15") 31/13)
+(= (read-from-string "#O777") 511)
+(= (read-from-string "#O105") 69)
+(= 342391 (read-from-string "#o1234567"))
+
+(= (read-from-string "#x0") 0)
+(= (read-from-string "#xF00") 3840)
+(= (read-from-string "#x105") 261)
+(= (read-from-string "#X0") 0)
+(= (read-from-string "#XF00") 3840)
+(= (read-from-string "#Xf00") 3840)
+(= (read-from-string "#X105") 261)
+(= 81985529216486895 (read-from-string "#X0123456789ABCDEF"))
+
+(= (read-from-string "#3r0") 0)
+(= (read-from-string "#2r11010101") 213)
+(= (read-from-string "#b11010101") 213)
+(= (read-from-string "#b+11010101") 213)
+(= (read-from-string "#o325") 213)
+(= (read-from-string "#xD5") 213)
+(= (read-from-string "#16r+D5") 213)
+(= (read-from-string "#o-300") -192)
+(= (read-from-string "#3r-21010") -192)
+(= (read-from-string "#25R-7H") -192)
+(= (read-from-string "#xACCEDED") 181202413)
+
+
+
+
+
+(zerop (read-from-string "#c(0 0)"))
+(= (read-from-string "#c(1 0)") #c(1 0))
+(complexp (read-from-string "#c(1 10)"))
+(= (read-from-string "#c(1 0)") 1)
+(= (read-from-string "#c(0 1)") #c(0 1))
+(= (read-from-string "#c(1 1)") #c(1 1))
+(= (read-from-string "#C(3.0s1 2.0s-1)") #C(3.0s1 2.0s-1))
+(= (read-from-string "#C(5 -3)") #c(5 -3))
+(= (read-from-string "#C(5/3 7.0)") #c(5/3 7.0))
+(let ((x (read-from-string "#C(5/3 7.0)")))
+ (and (floatp (realpart x)) (floatp (imagpart x))))
+
+(= (read-from-string "#C(0 1)") #C(0 1))
+
+;; array
+(equalp (read-from-string "#1A(0 1)") #(0 1))
+(let ((x (read-from-string "#1A(0 1)")))
+ (and (vectorp x)
+ (= 2 (length x))
+ (= 0 (aref x 0))
+ (= 1 (aref x 1))))
+(equalp (read-from-string "#2A((0 1 5) (foo 2 (hot dog)))")
+ #2A((0 1 5) (foo 2 (hot dog))))
+(let ((x (read-from-string "#2A((0 1 5) (foo 2 (hot dog)))")))
+ (and (arrayp x)
+ (equal (array-dimensions x) '(2 3))
+ (zerop (aref x 0 0))
+ (= (aref x 0 1) 1)
+ (= (aref x 0 2) 5)
+ (eq (aref x 1 0) 'foo)
+ (= (aref x 1 1) 2)
+ (equal (aref x 1 2) '(hot dog))))
+(equal (aref (read-from-string "#0A((0 1 5) (foo 2 (hot dog)))"))
+ '((0 1 5) (foo 2 (hot dog))))
+(let ((x (read-from-string "#0A((0 1 5) (foo 2 (hot dog)))")))
+ (and (arrayp x)
+ (null (array-dimensions x))
+ (equal (aref x) '((0 1 5) (foo 2 (hot dog))))))
+(equalp (read-from-string "#0A foo") #0Afoo)
+(let ((x (read-from-string "#0A foo")))
+ (and (arrayp x)
+ (null (array-dimensions x))
+ (eq (aref x) 'foo)))
+
+(equal (array-dimensions (read-from-string "#3A((() ()) (() ()) (() ()))"))
+ '(3 2 0))
+(equal (array-dimensions (read-from-string "#10A(() ())"))
+ '(2 0 0 0 0 0 0 0 0 0))
+(let ((x (read-from-string "
+#4A((((0 1 2 3) (4 5 6 7) (8 9 10 11))
+ ((12 13 14 15) (16 17 18 19) (20 21 22 23))))")))
+ (and (arrayp x)
+ (equal (array-dimensions x) '(1 2 3 4))
+ (loop for i below 24 always (= i (row-major-aref x i)))))
+
+;; label
+(eq (read-from-string "#1=a") 'a)
+(equal (read-from-string "(#1=a #1#)") '(a a))
+(let ((x (read-from-string "#1=(a . #1#)"))) (eq x (cdr x)))
+(let ((x (read-from-string "((a b) . #1=(#2=(p q) foo #2# . #1#))")))
+ (and (eq (nthcdr 1 x) (nthcdr 4 x))
+ (eq (nthcdr 4 x) (nthcdr 7 x))
+ (eq (nthcdr 7 x) (nthcdr 10 x))
+ (eq (nth 1 x) (nth 3 x))
+ (eq (nth 3 x) (nth 6 x))
+ (eq (nth 6 x) (nth 9 x))
+ (eq (nth 9 x) (nth 12 x))))
+(let ((x (read-from-string "(#1=(a . #1#) #2=(#1# . #2#))")))
+ (and (eq (car x) (caadr x))
+ (eq (car x) (cdar x))
+ (eq (cadr x) (cdadr x))))
+(let ((x (read-from-string "#1=#2=#3=(0 . #1#)")))
+ (and (eq x (cdr x)) (zerop (car x))))
+(let ((x (read-from-string "#1=#2=#3=(0 . #2#)")))
+ (and (eq x (cdr x)) (zerop (car x))))
+(let ((x (read-from-string "#1=#2=#3=(0 . #3#)")))
+ (and (eq x (cdr x)) (zerop (car x))))
+(let ((x (read-from-string "#1=#2=#3=(0 #1# #2# #3#)")))
+ (and (= 4 (length x))
+ (zerop (first x))
+ (eq x (second x))
+ (eq x (third x))
+ (eq x (fourth x))))
+(equal (read-from-string "(#1000=a #1000#)") '(a a))
+(let ((x (read-from-string "(#1=#:g10 #1#)")))
+ (and (= 2 (length x))
+ (string= (symbol-name (first x)) "G10")
+ (eq (first x) (second x))))
+(let ((x (read-from-string "#1=(a (b #2=(x y z) . #1#) . #2#)")))
+ (and (eq (first x) 'a)
+ (eq x (cddr (second x)))
+ (eq (second (second x)) (cddr x))))
+(let ((x (read-from-string "(#1=(a (b #2=(x y z) . #1#) . #2#))")))
+ (and (eq (caar x) 'a)
+ (eq (car x) (cddr (second (first x))))
+ (eq (second (second (first x))) (cddr (first x)))))
+(let ((x (read-from-string "#1=(a #2=(b #3=(c . #3#) . #2#) . #1#)")))
+ (and (eq (first x) 'a)
+ (eq (first (second x)) 'b)
+ (eq (first (second (second x))) 'c)
+ (eq x (cddr x))
+ (eq (second x) (cddr (second x)))
+ (eq (second (second x)) (cdr (second (second x))))))
+(let ((x (read-from-string "#1=(a #2=(b #3=(c . #1#) . #2#) . #3#)")))
+ (and (eq (first x) 'a)
+ (eq (first (second x)) 'b)
+ (eq (first (second (second x))) 'c)
+ (eq x (cdr (second (second x))))
+ (eq (second x) (cddr (second x)))
+ (eq (second (second x)) (cddr x))))
+(let ((x (read-from-string "(#1=#(0 1 2) #1#)")))
+ (and (= 2 (length x))
+ (eq (first x) (second x))
+ (equalp (first x) #(0 1 2))))
+
+(let ((x (read-from-string "#1=#(#1# 1 2)")))
+ (and (= 3 (length x))
+ (eq (aref x 0) x)
+ (= (aref x 1) 1)
+ (= (aref x 2) 2)))
+(let ((x (read-from-string "#(#1=#:g00 a b #1#)")))
+ (and (= 4 (length x))
+ (string= (symbol-name (aref x 0)) "G00")
+ (eq (aref x 0) (aref x 3))
+ (eq (aref x 1) 'a)
+ (eq (aref x 2) 'b)))
+(let ((x (read-from-string "#1=#(#2=#:g00 a #2# #1#)")))
+ (and (= 4 (length x))
+ (string= (symbol-name (aref x 0)) "G00")
+ (eq x (aref x 3))
+ (eq (aref x 0) (aref x 2))
+ (eq (aref x 1) 'a)))
+(let ((x (read-from-string "#1=#(#1# #1# #1#)")))
+ (and (= 3 (length x))
+ (eq x (aref x 0))
+ (eq (aref x 0) (aref x 1))
+ (eq (aref x 1) (aref x 2))))
+(let ((x (read-from-string "#1=#(#(#1#))")))
+ (and (= 1 (length x))
+ (= 1 (length (aref x 0)))
+ (eq x (aref (aref x 0) 0))))
+(let ((x (read-from-string "#1=#(#2=#(#3=#(#3# #2# #1#))))")))
+ (and (= 1 (length x))
+ (= 1 (length (aref x 0)))
+ (= 3 (length (aref (aref x 0) 0)))
+ (eq x (aref (aref (aref x 0) 0) 2))
+ (eq (aref x 0) (aref (aref (aref x 0) 0) 1))
+ (eq (aref (aref x 0) 0) (aref (aref (aref x 0) 0) 0))))
+(let ((x (read-from-string "#1=#(#2=#(#3=#(#1# #2# #3#))))")))
+ (and (= 1 (length x))
+ (= 1 (length (aref x 0)))
+ (= 3 (length (aref (aref x 0) 0)))
+ (eq x (aref (aref (aref x 0) 0) 0))
+ (eq (aref x 0) (aref (aref (aref x 0) 0) 1))
+ (eq (aref (aref x 0) 0) (aref (aref (aref x 0) 0) 2))))
+(let ((x (read-from-string "(#1=#(0 #2=#:g100 2) #2# #1#)")))
+ (and (= 3 (length x))
+ (eq (first x) (third x))
+ (string= (symbol-name (aref (first x) 1)) "G100")
+ (null (symbol-package (aref (first x) 1)))
+ (eq (aref (first x) 1) (second x))))
+(let ((x (read-from-string "(a #1=#(0 (#1#) 2) c)")))
+ (and (= 3 (length x))
+ (eq (first x) 'a)
+ (eq (second x) (first (aref (second x) 1)))
+ (eq (third x) 'c)
+ (= 0 (aref (second x) 0))
+ (= 2 (aref (second x) 2))))
+(let ((x (read-from-string "#1=#2A((a b) (c #1#))")))
+ (and (= 4 (array-total-size x))
+ (eq (aref x 0 0) 'a)
+ (eq (aref x 0 1) 'b)
+ (eq (aref x 1 0) 'c)
+ (eq (aref x 1 1) x)))
+(let ((x (read-from-string "#2A((#1=#:G10 b) (#1# d))")))
+ (and (= 4 (array-total-size x))
+ (eq (aref x 0 0) (aref x 1 0))
+ (null (symbol-package (aref x 0 0)))
+ (string= (symbol-name (aref x 0 0)) "G10")
+ (eq (aref x 0 1) 'b)
+ (eq (aref x 1 1) 'd)))
+(let ((x (read-from-string "#1=#2A((#2=#:GG #1#) (#2# #1#))")))
+ (and (= 4 (array-total-size x))
+ (eq (aref x 0 0) (aref x 1 0))
+ (null (symbol-package (aref x 0 0)))
+ (string= "GG" (symbol-name (aref x 0 0)))
+ (eq x (aref x 0 1))
+ (eq x (aref x 1 1))))
+(let ((x (read-from-string "#1=#0A#1#")))
+ (and (arrayp x)
+ (eq x (aref x))))
+(let ((x (read-from-string "#1=#0A(#1#)")))
+ (and (arrayp x)
+ (consp (aref x))
+ (= 1 (length (aref x)))
+ (eq x (first (aref x)))))
+(let ((x (read-from-string "#1=#1A(#1#)")))
+ (and (vectorp x)
+ (= 1 (length x))
+ (eq x (aref x 0))))
+(let ((x (read-from-string "#1=#1A(#2=(a b c) #1# #2#)")))
+ (and (vectorp x)
+ (= 3 (length x))
+ (equal (aref x 0) '(a b c))
+ (eq (aref x 0) (aref x 2))
+ (eq x (aref x 1))))
+(let ((x (read-from-string
+ "#1=#3A(((0 a) (1 b) (2 c))
+ ((3 d) (4 #2A((41 #2=#(x y z)) (43 #1#))) (5 f))
+ ((6 g) (((#2#)) h) (9 i)))")))
+ (and (= 18 (array-total-size x))
+ (= 0 (aref x 0 0 0))
+ (eq 'a (aref x 0 0 1))
+ (= 1 (aref x 0 1 0))
+ (eq 'b (aref x 0 1 1))
+ (= 2 (aref x 0 2 0))
+ (eq 'c (aref x 0 2 1))
+ (= 3 (aref x 1 0 0))
+ (eq 'd (aref x 1 0 1))
+ (= 4 (aref x 1 1 0))
+ (= (array-total-size (aref x 1 1 1)) 4)
+ (= 41 (aref (aref x 1 1 1) 0 0))
+ (equalp (aref (aref x 1 1 1) 0 1) #(x y z))
+ (= 43 (aref (aref x 1 1 1) 1 0))
+ (eq x (aref (aref x 1 1 1) 1 1))
+ (= 5 (aref x 1 2 0))
+ (eq 'f (aref x 1 2 1))
+ (= 6 (aref x 2 0 0))
+ (eq 'g (aref x 2 0 1))
+ (eq (caar (aref x 2 1 0)) (aref (aref x 1 1 1) 0 1))
+ (eq 'h (aref x 2 1 1))
+ (= 9 (aref x 2 2 0))
+ (eq 'i (aref x 2 2 1))))
+
+
+(progn
+ #-CLISP ;Bruno: ANSI CL 2.2. refers to the spec of READ, which says that
+ ; an error of type end-of-file is signalled.
+ (handler-case (null (let ((*features* '())) (read-from-string "#+test1 a")))
+ (error () nil))
+ #+CLISP 'skipped)
+
+(let ((*features* '()))
+ (equal (with-input-from-string (stream "#+test1 a #-test1 b")
+ (loop
+ for x = (read stream nil 'end)
+ until (eq x 'end)
+ collecting x))
+ '(b)))
+(let ((*features* '(:test1)))
+ (equal (with-input-from-string (stream "#+test1 a #-test1 b")
+ (loop
+ for x = (read stream nil 'end)
+ until (eq x 'end)
+ collecting x))
+ '(a)))
+(let ((*features* '()))
+ (equal (with-input-from-string (stream "#+(not test1) eat-this")
+ (loop
+ for x = (read stream nil 'end)
+ until (eq x 'end)
+ collecting x))
+ '(eat-this)))
+(let ((*features* '(:test1)))
+ (equal (with-input-from-string (stream "#+(not test1) eat-this")
+ (loop
+ for x = (read stream nil 'end)
+ until (eq x 'end)
+ collecting x))
+ '()))
+(let ((*features* '(:test1)))
+ (equal (with-input-from-string (stream "#-(not test1) eat-this")
+ (loop
+ for x = (read stream nil 'end)
+ until (eq x 'end)
+ collecting x))
+ '(eat-this)))
+(let ((*features* '()))
+ (equal (with-input-from-string (stream "#-(not test1) eat-this")
+ (loop
+ for x = (read stream nil 'end)
+ until (eq x 'end)
+ collecting x))
+ '()))
+
+(let ((*features* '(:test1 :test2)))
+ (equal (with-input-from-string (stream "#+(and test1 test2) eat-this")
+ (loop
+ for x = (read stream nil 'end)
+ until (eq x 'end)
+ collecting x))
+ '(eat-this)))
+(let ((*features* '(:test1)))
+ (equal (with-input-from-string (stream "#+(and test1 test2) eat-this")
+ (loop
+ for x = (read stream nil 'end)
+ until (eq x 'end)
+ collecting x))
+ '()))
+(let ((*features* '()))
+ (equal (with-input-from-string (stream "#+(and test1 test2) eat-this")
+ (loop
+ for x = (read stream nil 'end)
+ until (eq x 'end)
+ collecting x))
+ '()))
+(let ((*features* '()))
+ (equal (with-input-from-string (stream "#+(or test1 test2) eat-this")
+ (loop
+ for x = (read stream nil 'end)
+ until (eq x 'end)
+ collecting x))
+ '()))
+(let ((*features* '(:test1)))
+ (equal (with-input-from-string (stream "#+(or test1 test2) eat-this")
+ (loop
+ for x = (read stream nil 'end)
+ until (eq x 'end)
+ collecting x))
+ '(eat-this)))
+(let ((*features* '(:test2)))
+ (equal (with-input-from-string (stream "#+(or test1 test2) eat-this")
+ (loop
+ for x = (read stream nil 'end)
+ until (eq x 'end)
+ collecting x))
+ '(eat-this)))
+(let ((*features* '(:test1 :test2)))
+ (equal (with-input-from-string (stream "#+(or test1 test2) eat-this")
+ (loop
+ for x = (read stream nil 'end)
+ until (eq x 'end)
+ collecting x))
+ '(eat-this)))
+(let ((*features* '(:test1 :test2 :test3)))
+ (equal (with-input-from-string (stream "#+(or test1 test2) eat-this")
+ (loop
+ for x = (read stream nil 'end)
+ until (eq x 'end)
+ collecting x))
+ '(eat-this)))
+
+(let ((*features* '(:test1 :test2)))
+ (equal (with-input-from-string (stream "#+(and test1 (not test2)) eat-this")
+ (loop
+ for x = (read stream nil 'end)
+ until (eq x 'end)
+ collecting x))
+ '()))
+(let ((*features* '()))
+ (equal (with-input-from-string (stream "#+(and test1 (not test2)) eat-this")
+ (loop
+ for x = (read stream nil 'end)
+ until (eq x 'end)
+ collecting x))
+ '()))
+(let ((*features* '(:test1)))
+ (equal (with-input-from-string (stream "#+(and test1 (not test2)) eat-this")
+ (loop
+ for x = (read stream nil 'end)
+ until (eq x 'end)
+ collecting x))
+ '(eat-this)))
+(let ((*features* '()))
+ (equal (with-input-from-string
+ (stream "#+(or (and test1 (not test2)) test3) eat-this")
+ (loop
+ for x = (read stream nil 'end)
+ until (eq x 'end)
+ collecting x))
+ '()))
+(let ((*features* '(:test1)))
+ (equal (with-input-from-string
+ (stream "#+(or (and test1 (not test2)) test3) eat-this")
+ (loop
+ for x = (read stream nil 'end)
+ until (eq x 'end)
+ collecting x))
+ '(eat-this)))
+(let ((*features* '(:test1 :test2)))
+ (equal (with-input-from-string
+ (stream "#+(or (and test1 (not test2)) test3) eat-this")
+ (loop
+ for x = (read stream nil 'end)
+ until (eq x 'end)
+ collecting x))
+ '()))
+(let ((*features* '(:test1 :test2 :test3)))
+ (equal (with-input-from-string
+ (stream "#+(or (and test1 (not test2)) test3) eat-this")
+ (loop
+ for x = (read stream nil 'end)
+ until (eq x 'end)
+ collecting x))
+ '(eat-this)))
+(let ((*features* '(:test1 :test3)))
+ (equal (with-input-from-string
+ (stream "#+(or (and test1 (not test2)) test3) eat-this")
+ (loop
+ for x = (read stream nil 'end)
+ until (eq x 'end)
+ collecting x))
+ '(eat-this)))
+(let ((*features* '(:test2 :test3)))
+ (equal (with-input-from-string
+ (stream "#+(or (and test1 (not test2)) test3) eat-this")
+ (loop
+ for x = (read stream nil 'end)
+ until (eq x 'end)
+ collecting x))
+ '(eat-this)))
+
+(let ((*features* '()))
+ (equal (with-input-from-string
+ (stream "#+(and test1 (not test2) (or test3 test4)) eat-this")
+ (loop
+ for x = (read stream nil 'end)
+ until (eq x 'end)
+ collecting x))
+ '()))
+(let ((*features* '(:test1)))
+ (equal (with-input-from-string
+ (stream "#+(and test1 (not test2) (or test3 test4)) eat-this")
+ (loop
+ for x = (read stream nil 'end)
+ until (eq x 'end)
+ collecting x))
+ '()))
+(let ((*features* '(:test1 :test3)))
+ (equal (with-input-from-string
+ (stream "#+(and test1 (not test2) (or test3 test4)) eat-this")
+ (loop
+ for x = (read stream nil 'end)
+ until (eq x 'end)
+ collecting x))
+ '(eat-this)))
+(let ((*features* '(:test1 :test4)))
+ (equal (with-input-from-string
+ (stream "#+(and test1 (not test2) (or test3 test4)) eat-this")
+ (loop
+ for x = (read stream nil 'end)
+ until (eq x 'end)
+ collecting x))
+ '(eat-this)))
+(let ((*features* '(:test1 :test2)))
+ (equal (with-input-from-string
+ (stream "#+(and test1 (not test2) (or test3 test4)) eat-this")
+ (loop
+ for x = (read stream nil 'end)
+ until (eq x 'end)
+ collecting x))
+ '()))
+(let ((*features* '(:test1 :test2 :test3)))
+ (equal (with-input-from-string
+ (stream "#+(and test1 (not test2) (or test3 test4)) eat-this")
+ (loop
+ for x = (read stream nil 'end)
+ until (eq x 'end)
+ collecting x))
+ '()))
+(let ((*features* '(:test1 :test2 :test3 :test4)))
+ (equal (with-input-from-string
+ (stream "#+(and test1 (not test2) (or test3 test4)) eat-this")
+ (loop
+ for x = (read stream nil 'end)
+ until (eq x 'end)
+ collecting x))
+ '()))
+(let ((*features* '(:test1 :test3 :test4)))
+ (equal (with-input-from-string
+ (stream "#+(and test1 (not test2) (or test3 test4)) eat-this")
+ (loop
+ for x = (read stream nil 'end)
+ until (eq x 'end)
+ collecting x))
+ '(eat-this)))
+
+(let ((*features* '()))
+ (equal (with-input-from-string
+ (stream "#-(not (and test1 (not test2) (or test3 test4))) eat-this")
+ (loop
+ for x = (read stream nil 'end)
+ until (eq x 'end)
+ collecting x))
+ '()))
+(let ((*features* '(:test1)))
+ (equal (with-input-from-string
+ (stream "#-(not (and test1 (not test2) (or test3 test4))) eat-this")
+ (loop
+ for x = (read stream nil 'end)
+ until (eq x 'end)
+ collecting x))
+ '()))
+(let ((*features* '(:test1 :test3)))
+ (equal (with-input-from-string
+ (stream "#-(not (and test1 (not test2) (or test3 test4))) eat-this")
+ (loop
+ for x = (read stream nil 'end)
+ until (eq x 'end)
+ collecting x))
+ '(eat-this)))
+(let ((*features* '(:test1 :test4)))
+ (equal (with-input-from-string
+ (stream "#-(not (and test1 (not test2) (or test3 test4))) eat-this")
+ (loop
+ for x = (read stream nil 'end)
+ until (eq x 'end)
+ collecting x))
+ '(eat-this)))
+(let ((*features* '(:test1 :test2)))
+ (equal (with-input-from-string
+ (stream "#-(not (and test1 (not test2) (or test3 test4))) eat-this")
+ (loop
+ for x = (read stream nil 'end)
+ until (eq x 'end)
+ collecting x))
+ '()))
+(let ((*features* '(:test1 :test2 :test3)))
+ (equal (with-input-from-string
+ (stream "#-(not (and test1 (not test2) (or test3 test4))) eat-this")
+ (loop
+ for x = (read stream nil 'end)
+ until (eq x 'end)
+ collecting x))
+ '()))
+(let ((*features* '(:test1 :test2 :test3 :test4)))
+ (equal (with-input-from-string
+ (stream "#-(not (and test1 (not test2) (or test3 test4))) eat-this")
+ (loop
+ for x = (read stream nil 'end)
+ until (eq x 'end)
+ collecting x))
+ '()))
+(let ((*features* '(:test1 :test3 :test4)))
+ (equal (with-input-from-string
+ (stream "#-(not (and test1 (not test2) (or test3 test4))) eat-this")
+ (loop
+ for x = (read stream nil 'end)
+ until (eq x 'end)
+ collecting x))
+ '(eat-this)))
+
+
+(eq (read-from-string "#| comment |# a") 'a)
+(eq (read-from-string "#| #| nested comment |# |# a") 'a)
+(eq (read-from-string "#| comment
+comment
+ still comment
+|# a") 'a)
+
+(handler-case (read-from-string "#<invalid-token>")
+ (reader-error () t)
+ (error () nil)
+ (:no-error (&rest rest) (declare (ignore rest)) nil))
+(handler-case (read-from-string "# ")
+ (reader-error () t)
+ (error () nil)
+ (:no-error (&rest rest) (declare (ignore rest)) nil))
+(handler-case (read-from-string "#
+")
+ (reader-error () t)
+ (error () nil)
+ (:no-error (&rest rest) (declare (ignore rest)) nil))
+(handler-case (read-from-string "#)")
+ (reader-error () t)
+ (error () nil)
+ (:no-error (&rest rest) (declare (ignore rest)) nil))
+
+(let ((*readtable* (copy-readtable nil)))
+ (setf (readtable-case *readtable*) :upcase)
+ (string= "ZEBRA" (symbol-name (read-from-string "ZEBRA"))))
+(let ((*readtable* (copy-readtable nil)))
+ (setf (readtable-case *readtable*) :upcase)
+ (string= "ZEBRA" (symbol-name (read-from-string "Zebra"))))
+(let ((*readtable* (copy-readtable nil)))
+ (setf (readtable-case *readtable*) :upcase)
+ (string= "ZEBRA" (symbol-name (read-from-string "zebra"))))
+
+(let ((*readtable* (copy-readtable nil)))
+ (setf (readtable-case *readtable*) :downcase)
+ (string= "zebra" (symbol-name (read-from-string "ZEBRA"))))
+(let ((*readtable* (copy-readtable nil)))
+ (setf (readtable-case *readtable*) :downcase)
+ (string= "zebra" (symbol-name (read-from-string "Zebra"))))
+(let ((*readtable* (copy-readtable nil)))
+ (setf (readtable-case *readtable*) :downcase)
+ (string= "zebra" (symbol-name (read-from-string "zebra"))))
+
+(let ((*readtable* (copy-readtable nil)))
+ (setf (readtable-case *readtable*) :preserve)
+ (string= "ZEBRA" (symbol-name (read-from-string "ZEBRA"))))
+(let ((*readtable* (copy-readtable nil)))
+ (setf (readtable-case *readtable*) :preserve)
+ (string= "Zebra" (symbol-name (read-from-string "Zebra"))))
+(let ((*readtable* (copy-readtable nil)))
+ (setf (readtable-case *readtable*) :preserve)
+ (string= "zebra" (symbol-name (read-from-string "zebra"))))
+
+(let ((*readtable* (copy-readtable nil)))
+ (setf (readtable-case *readtable*) :invert)
+ (string= "zebra" (symbol-name (read-from-string "ZEBRA"))))
+(let ((*readtable* (copy-readtable nil)))
+ (setf (readtable-case *readtable*) :invert)
+ (string= "Zebra" (symbol-name (read-from-string "Zebra"))))
+(let ((*readtable* (copy-readtable nil)))
+ (setf (readtable-case *readtable*) :invert)
+ (string= "ZEBRA" (symbol-name (read-from-string "zebra"))))
+
+(let ((*readtable* (copy-readtable nil)))
+ (setf (readtable-case *readtable*) :upcase)
+ (string= "CAT-AND-MOUSE" (symbol-name (read-from-string "cat-and-mouse"))))
+(let ((*readtable* (copy-readtable nil)))
+ (setf (readtable-case *readtable*) :upcase)
+ (string= "CAT-AND-MOUSE" (symbol-name (read-from-string "Cat-And-Mouse"))))
+(let ((*readtable* (copy-readtable nil)))
+ (setf (readtable-case *readtable*) :upcase)
+ (string= "CAT-AND-MOUSE" (symbol-name (read-from-string "CAT-AND-MOUSE"))))
+(let ((*readtable* (copy-readtable nil)))
+ (setf (readtable-case *readtable*) :downcase)
+ (string= "cat-and-mouse" (symbol-name (read-from-string "cat-and-mouse"))))
+(let ((*readtable* (copy-readtable nil)))
+ (setf (readtable-case *readtable*) :downcase)
+ (string= "cat-and-mouse" (symbol-name (read-from-string "Cat-And-Mouse"))))
+(let ((*readtable* (copy-readtable nil)))
+ (setf (readtable-case *readtable*) :downcase)
+ (string= "cat-and-mouse" (symbol-name (read-from-string "CAT-AND-MOUSE"))))
+(let ((*readtable* (copy-readtable nil)))
+ (setf (readtable-case *readtable*) :preserve)
+ (string= "cat-and-mouse" (symbol-name (read-from-string "cat-and-mouse"))))
+(let ((*readtable* (copy-readtable nil)))
+ (setf (readtable-case *readtable*) :preserve)
+ (string= "Cat-And-Mouse" (symbol-name (read-from-string "Cat-And-Mouse"))))
+(let ((*readtable* (copy-readtable nil)))
+ (setf (readtable-case *readtable*) :preserve)
+ (string= "CAT-AND-MOUSE" (symbol-name (read-from-string "CAT-AND-MOUSE"))))
+(let ((*readtable* (copy-readtable nil)))
+ (setf (readtable-case *readtable*) :invert)
+ (string= "CAT-AND-MOUSE" (symbol-name (read-from-string "cat-and-mouse"))))
+(let ((*readtable* (copy-readtable nil)))
+ (setf (readtable-case *readtable*) :invert)
+ (string= "Cat-And-Mouse" (symbol-name (read-from-string "Cat-And-Mouse"))))
+(let ((*readtable* (copy-readtable nil)))
+ (setf (readtable-case *readtable*) :invert)
+ (string= "cat-and-mouse" (symbol-name (read-from-string "CAT-AND-MOUSE"))))
+
+(let ((*readtable* (copy-readtable nil)))
+ (setf (readtable-case *readtable*) :upcase)
+ (string= "CAT*AND*MOUSE" (symbol-name (read-from-string "cat*and*mouse"))))
+(let ((*readtable* (copy-readtable nil)))
+ (setf (readtable-case *readtable*) :upcase)
+ (string= "CAT*AND*MOUSE" (symbol-name (read-from-string "Cat*And*Mouse"))))
+(let ((*readtable* (copy-readtable nil)))
+ (setf (readtable-case *readtable*) :upcase)
+ (string= "CAT*AND*MOUSE" (symbol-name (read-from-string "CAT*AND*MOUSE"))))
+(let ((*readtable* (copy-readtable nil)))
+ (setf (readtable-case *readtable*) :downcase)
+ (string= "cat*and*mouse" (symbol-name (read-from-string "cat*and*mouse"))))
+(let ((*readtable* (copy-readtable nil)))
+ (setf (readtable-case *readtable*) :downcase)
+ (string= "cat*and*mouse" (symbol-name (read-from-string "Cat*And*Mouse"))))
+(let ((*readtable* (copy-readtable nil)))
+ (setf (readtable-case *readtable*) :downcase)
+ (string= "cat*and*mouse" (symbol-name (read-from-string "CAT*AND*MOUSE"))))
+(let ((*readtable* (copy-readtable nil)))
+ (setf (readtable-case *readtable*) :preserve)
+ (string= "cat*and*mouse" (symbol-name (read-from-string "cat*and*mouse"))))
+(let ((*readtable* (copy-readtable nil)))
+ (setf (readtable-case *readtable*) :preserve)
+ (string= "Cat*And*Mouse" (symbol-name (read-from-string "Cat*And*Mouse"))))
+(let ((*readtable* (copy-readtable nil)))
+ (setf (readtable-case *readtable*) :preserve)
+ (string= "CAT*AND*MOUSE" (symbol-name (read-from-string "CAT*AND*MOUSE"))))
+(let ((*readtable* (copy-readtable nil)))
+ (setf (readtable-case *readtable*) :invert)
+ (string= "CAT*AND*MOUSE" (symbol-name (read-from-string "cat*and*mouse"))))
+(let ((*readtable* (copy-readtable nil)))
+ (setf (readtable-case *readtable*) :invert)
+ (string= "Cat*And*Mouse" (symbol-name (read-from-string "Cat*And*Mouse"))))
+(let ((*readtable* (copy-readtable nil)))
+ (setf (readtable-case *readtable*) :invert)
+ (string= "cat*and*mouse" (symbol-name (read-from-string "CAT*AND*MOUSE"))))
+
+
+(with-input-from-string (stream "a b")
+ (and (eq 'a (read-preserving-whitespace stream))
+ (eq #\Space (read-char stream))
+ (eq #\b (read-char stream))))
+
+(handler-case (with-input-from-string (stream " ") (read stream))
+ (end-of-file () t)
+ (error () nil)
+ (:no-error (&rest rest) (declare (ignore rest)) nil))
+
+(let ((x nil))
+ (and (eq t (handler-case (with-input-from-string (stream "a")
+ (setq x (read stream))
+ (read stream))
+ (end-of-file () t)
+ (error () nil)
+ (:no-error (&rest rest) (declare (ignore rest)) nil)))
+ (eq x 'a)))
+
+(progn
+ (let ((*readtable* (copy-readtable nil)))
+ (set-macro-character
+ #\/
+ #'(lambda (stream char)
+ (declare (ignore char))
+ `(path . ,(loop for dir = (read-preserving-whitespace stream t)
+ then (progn (read-char stream t nil t)
+ (read-preserving-whitespace stream t))
+ collect dir
+ while (eql (peek-char nil stream nil nil t) #\/)))))
+ (equal (read-from-string "(zyedh /usr/games/zork /usr/games/boggle)")
+ '(zyedh (path usr games zork) (path usr games boggle)))))
+
+(progn
+ (let ((*readtable* (copy-readtable nil)))
+ (set-macro-character
+ #\/
+ #'(lambda (stream char)
+ (declare (ignore char))
+ `(path . ,(loop for dir = (read stream t)
+ then (progn (read-char stream t nil t)
+ (read stream t))
+ collect dir
+ while (eql (peek-char nil stream nil nil t) #\/)))))
+ (equal (read-from-string "(zyedh /usr/games/zork /usr/games/boggle)")
+ '(zyedh (path usr games zork usr games boggle)))))
+
+
+(let ((*readtable* (copy-readtable nil)))
+ (and (eq t (set-syntax-from-char #\7 #\;))
+ (= 1235 (read-from-string "123579"))))
+
+
+
+
+
+(readtablep *readtable*)
+
+(readtablep (copy-readtable))
+(readtablep (copy-readtable nil))
+(readtablep (copy-readtable nil (copy-readtable)))
+(let ((to (copy-readtable)))
+ (eq to (copy-readtable nil to)))
+
+(let ((zvar 123)
+ (table2 (copy-readtable)))
+ (declare (special zvar))
+ (and (= zvar 123)
+ (set-syntax-from-char #\z #\' table2)
+ (= zvar 123)
+ (let ((*readtable* table2))
+ (and (equal '(quote var) (read-from-string "zvar"))
+ (setq *readtable* (copy-readtable))
+ (equal '(quote var) (read-from-string "zvar"))
+ (setq *readtable* (copy-readtable nil))
+ (= 123 (eval (read-from-string "zvar")))))))
+
+(not (eq (copy-readtable) *readtable*))
+(not (eq (copy-readtable) (copy-readtable)))
+(not (eq (copy-readtable nil) *readtable*))
+(not (eq (copy-readtable nil) (copy-readtable nil)))
+
+(let ((*readtable* (copy-readtable nil)))
+ (and (handler-case (read-from-string "#<abc")
+ (reader-error () t)
+ (error () nil)
+ (:no-error (&rest rest) (declare (ignore rest)) nil))
+ (set-dispatch-macro-character #\# #\<
+ #'(lambda (s c n)
+ (declare (ignore c n))
+ (read-char s t nil t)
+ (read s t nil t)))
+ (eq 'bc (read-from-string "#<abc"))
+ (setq *readtable* (copy-readtable))
+ (eq 'bc (read-from-string "#<abc"))
+ (setq *readtable* (copy-readtable nil))
+ (handler-case (read-from-string "#<abc")
+ (reader-error () t)
+ (error () nil)
+ (:no-error (&rest rest) (declare (ignore rest)) nil))))
+
+(let ((*readtable* (copy-readtable nil)))
+ (and (handler-case (read-from-string "#<abc")
+ (reader-error () t)
+ (error () nil)
+ (:no-error (&rest rest) (declare (ignore rest)) nil))
+ (set-dispatch-macro-character #\# #\<
+ #'(lambda (s c n)
+ (declare (ignore c n))
+ (read-char s t nil t)
+ (read s t nil t)))
+ (eq 'bc (read-from-string "#<abc"))
+ (setq *readtable* (copy-readtable))
+ (eq 'bc (read-from-string "#<abc"))
+ (set-dispatch-macro-character #\# #\<
+ #'(lambda (s c n)
+ (declare (ignore c n))
+ (read-char s t nil t)
+ (read-char s t nil t)
+ (read s t nil t)))
+ (eq 'c (read-from-string "#<abc"))
+ (setq *readtable* (copy-readtable nil))
+ (handler-case (read-from-string "#<abc")
+ (reader-error () t)
+ (error () nil)
+ (:no-error (&rest rest) (declare (ignore rest)) nil))))
+
+
+(let ((table (copy-readtable nil)))
+ (and (eq :upcase (readtable-case table))
+ (setf (readtable-case table) :invert)
+ (let ((copy (copy-readtable table)))
+ (and (not (eq table copy)) (eq (readtable-case copy) :invert)))))
+
+(let ((table (copy-readtable nil))
+ copy)
+ (and (eq :upcase (readtable-case table))
+ (setf (readtable-case table) :invert)
+ (eq (readtable-case table) :invert)
+ (setq copy (copy-readtable table))
+ (eq (readtable-case copy) :invert)
+ (setf (readtable-case copy) :preserve)
+ (eq (readtable-case table) :invert)))
+
+(eq :upcase (let ((x (copy-readtable nil))) (readtable-case x)))
+(let ((x (copy-readtable nil)))
+ (and (eq (setf (readtable-case x) :upcase) (readtable-case x))
+ (eq (setf (readtable-case x) :downcase) (readtable-case x))
+ (eq (setf (readtable-case x) :preserve) (readtable-case x))
+ (eq (setf (readtable-case x) :invert) (readtable-case x))))
+
+(handler-case (readtable-case 'not-a-readtable)
+ (type-error () t)
+ (error () nil)
+ (:no-error (&rest rest) (declare (ignore rest)) nil))
+
+(handler-case (setf (readtable-case (copy-readtable nil)) :no-such-mode)
+ (type-error () t)
+ (error () nil)
+ (:no-error (&rest rest) (declare (ignore rest)) nil))
+
+(let ((table (copy-readtable nil)))
+ (and (eq :upcase (readtable-case table))
+ (setf (readtable-case table) :downcase)
+ (eq :downcase (readtable-case (copy-readtable table)))))
+
+(not (readtablep nil))
+(not (readtablep 'readtable))
+(readtablep *readtable*)
+(readtablep (copy-readtable))
+(not (readtablep '*readtable*))
+
+(null (get-dispatch-macro-character #\# #\0))
+(null (get-dispatch-macro-character #\# #\1))
+(null (get-dispatch-macro-character #\# #\2))
+(null (get-dispatch-macro-character #\# #\3))
+(null (get-dispatch-macro-character #\# #\4))
+(null (get-dispatch-macro-character #\# #\5))
+(null (get-dispatch-macro-character #\# #\6))
+(null (get-dispatch-macro-character #\# #\7))
+(null (get-dispatch-macro-character #\# #\8))
+(null (get-dispatch-macro-character #\# #\9))
+
+(get-dispatch-macro-character #\# #\\)
+(get-dispatch-macro-character #\# #\')
+(get-dispatch-macro-character #\# #\()
+(get-dispatch-macro-character #\# #\*)
+(get-dispatch-macro-character #\# #\:)
+(get-dispatch-macro-character #\# #\.)
+(get-dispatch-macro-character #\# #\b)
+(get-dispatch-macro-character #\# #\o)
+(get-dispatch-macro-character #\# #\x)
+(get-dispatch-macro-character #\# #\r)
+(get-dispatch-macro-character #\# #\c)
+(get-dispatch-macro-character #\# #\a)
+(get-dispatch-macro-character #\# #\s)
+(get-dispatch-macro-character #\# #\p)
+(get-dispatch-macro-character #\# #\=)
+(get-dispatch-macro-character #\# #\#)
+(get-dispatch-macro-character #\# #\+)
+(get-dispatch-macro-character #\# #\-)
+(get-dispatch-macro-character #\# #\|)
+
+(get-dispatch-macro-character #\# #\newline)
+(get-dispatch-macro-character #\# #\space)
+
+(handler-case (get-dispatch-macro-character #\a #\b)
+ (error () t)
+ (:no-error (&rest rest) (declare (ignore rest)) nil))
+
+(handler-case (get-dispatch-macro-character #\a #\b nil)
+ (error () t)
+ (:no-error (&rest rest) (declare (ignore rest)) nil))
+
+(handler-case (get-dispatch-macro-character #\a #\b *readtable*)
+ (error () t)
+ (:no-error (&rest rest) (declare (ignore rest)) nil))
+
+(handler-case (set-dispatch-macro-character #\a #\b #'identity)
+ (error () t)
+ (:no-error (&rest rest) (declare (ignore rest)) nil))
+
+(handler-case (set-dispatch-macro-character #\a #\b #'identity *readtable*)
+ (error () t)
+ (:no-error (&rest rest) (declare (ignore rest)) nil))
+
+
+
+(let ((*readtable* (copy-readtable nil)))
+ (and (eq t (set-dispatch-macro-character
+ #\# #\{ ;dispatch on #{
+ #'(lambda(s c n)
+ (declare (ignore c))
+ (let ((list (read s nil (values) t))) ;list is object after #n{
+ (when (consp list) ;return nth element of list
+ (unless (and n (< 0 n (length list))) (setq n 0))
+ (setq list (nth n list)))
+ list))))
+ (= 1 (read-from-string "#{(1 2 3 4)"))
+ (= 3 (read-from-string "#3{(0 1 2 3)"))
+ (= 123 (read-from-string "#{123"))))
+
+(let ((*readtable* (copy-readtable))
+ (dollar #'(lambda (stream subchar arg)
+ (declare (ignore subchar arg))
+ (list 'dollars (read stream t nil t)))))
+ (and (eq t (set-dispatch-macro-character #\# #\$ dollar))
+ (equal '(dollars foo) (read-from-string "#$foo"))))
+
+
+
+
+(and (let ((*readtable* (copy-readtable)))
+ (and (setf (readtable-case *readtable*) :invert)
+ (string= "ABC" (symbol-name (read-from-string "abc")))
+ (string= "abc" (symbol-name (read-from-string "ABC")))
+ (string= "AbC" (symbol-name (read-from-string "AbC")))
+ (setf (readtable-case *readtable*) :preserve)
+ (string= "abc" (symbol-name (read-from-string "abc")))
+ (string= "ABC" (symbol-name (read-from-string "ABC")))
+ (string= "AbC" (symbol-name (read-from-string "AbC")))))
+ (eq (readtable-case *readtable*) :upcase)
+ (string= "ABC" (symbol-name (read-from-string "abc")))
+ (string= "ABC" (symbol-name (read-from-string "ABC")))
+ (string= "ABC" (symbol-name (read-from-string "AbC"))))
+
+
+(let ((*readtable* (copy-readtable)))
+ (and (setf (readtable-case *readtable*) :invert)
+ (set-macro-character #\< #'(lambda (stream c)
+ (declare (ignore c))
+ (read-delimited-list #\> stream t))
+ t)
+ (set-macro-character #\> (get-macro-character #\)))
+ (equal '(a b) (read-from-string "<a b>"))))
+
+(let ((*readtable* (copy-readtable)))
+ (and (setf (readtable-case *readtable*) :invert)
+ (set-macro-character #\< #'(lambda (stream c)
+ (declare (ignore c))
+ (read-delimited-list #\> stream t)))
+ (set-macro-character #\> (get-macro-character #\)))
+ (with-input-from-string (stream "xyz<A b>jKl")
+ (and (eq 'xyz (read stream))
+ (equal '(|a| b) (read stream))
+ (eq '|jKl| (read stream))
+ (eq 'end (read stream nil 'end))))))
+
+(let ((*readtable* (copy-readtable nil)))
+ (and (equal (multiple-value-list (get-macro-character #\{)) '(nil nil))
+ (eq t (make-dispatch-macro-character #\{))
+ (get-macro-character #\{)))
+
+(let ((*readtable* (copy-readtable nil)))
+ (and (eq t (make-dispatch-macro-character #\{))
+ (handler-case (read-from-string "{$a")
+ (reader-error () t)
+ (error () nil)
+ (:no-error (&rest rest) (declare (ignore rest)) nil))))
+
+
+(let ((*readtable* (copy-readtable nil)))
+ (and (eq t (make-dispatch-macro-character #\{))
+ #-clisp (handler-case (read-from-string "{$a")
+ (reader-error () t)
+ (error () nil)
+ (:no-error (&rest rest) (declare (ignore rest)) nil))
+ (set-dispatch-macro-character #\{ #\$
+ #'(lambda (s c n)
+ (declare (ignore c n))
+ (read s t nil t)))
+ (eq 'a (read-from-string "{$a"))))
+
+
+(let ((*readtable* (copy-readtable nil)))
+ (and (eq t (make-dispatch-macro-character #\{))
+ #-clisp (handler-case (read-from-string "{$a")
+ (reader-error () t)
+ (error () nil)
+ (:no-error (&rest rest) (declare (ignore rest)) nil))
+ (set-dispatch-macro-character #\{ #\$
+ #'(lambda (s c n)
+ (declare (ignore c n))
+ (read s t nil t)))
+ (with-input-from-string (stream "xyz{$a")
+ (and (eq 'xyz (read stream))
+ (eq 'a (read stream))
+ (eq 'end (read stream nil 'end))))))
+
+(let ((*readtable* (copy-readtable nil)))
+ (and (eq t (make-dispatch-macro-character #\{ t))
+ #-clisp (handler-case (read-from-string "{$a")
+ (reader-error () t)
+ (error () nil)
+ (:no-error (&rest rest) (declare (ignore rest)) nil))
+ (set-dispatch-macro-character #\{ #\$
+ #'(lambda (s c n)
+ (declare (ignore c n))
+ (read s t nil t)))
+ (with-input-from-string (stream "xyz{$a")
+ (and (eq '|XYZ{$A| (read stream))
+ (eq 'end (read stream nil 'end))))))
+
+
+(let ((table (copy-readtable nil)))
+ (and (eq t (make-dispatch-macro-character #\{ nil table))
+ #-clisp (let ((*readtable* table))
+ (handler-case (read-from-string "{$a")
+ (reader-error () t)
+ (error () nil)
+ (:no-error (&rest rest) (declare (ignore rest)) nil)))
+ (set-dispatch-macro-character #\{ #\$
+ #'(lambda (s c n)
+ (declare (ignore c n))
+ (read s t nil t))
+ table)
+ (let ((*readtable* table))
+ (with-input-from-string (stream "xyz{$a")
+ (and (eq 'xyz (read stream))
+ (eq 'a (read stream))
+ (eq 'end (read stream nil 'end)))))))
+
+
+(let ((table (copy-readtable nil)))
+ (and (eq t (make-dispatch-macro-character #\{ t table))
+ #-clisp (let ((*readtable* table))
+ (handler-case (read-from-string "{$a")
+ (reader-error () t)
+ (error () nil)
+ (:no-error (&rest rest) (declare (ignore rest)) nil)))
+ (set-dispatch-macro-character #\{ #\$
+ #'(lambda (s c n)
+ (declare (ignore c n))
+ (read s t nil t))
+ table)
+ (let ((*readtable* table))
+ (with-input-from-string (stream "xyz{$a")
+ (and (eq '|XYZ{$A| (read stream))
+ (eq 'end (read stream nil 'end)))))))
+
+
+(with-input-from-string (stream "")
+ (handler-case (read stream t)
+ (end-of-file () t)
+ (error () nil)
+ (:no-error (&rest rest) (declare (ignore rest)) nil)))
+
+(with-input-from-string (stream "")
+ (handler-case (read-preserving-whitespace stream t)
+ (end-of-file () t)
+ (error () nil)
+ (:no-error (&rest rest) (declare (ignore rest)) nil)))
+
+(with-input-from-string (stream "")
+ (handler-case (read stream t 'ignored)
+ (end-of-file () t)
+ (error () nil)
+ (:no-error (&rest rest) (declare (ignore rest)) nil)))
+
+(with-input-from-string (stream "")
+ (handler-case (read-preserving-whitespace stream t 'ignored)
+ (end-of-file () t)
+ (error () nil)
+ (:no-error (&rest rest) (declare (ignore rest)) nil)))
+
+
+(with-input-from-string (stream "")
+ (eq 'end (read stream nil 'end)))
+
+(with-input-from-string (stream "")
+ (eq 'end (read-preserving-whitespace stream nil 'end)))
+
+(with-input-from-string (stream "a b")
+ (and (eq 'a (read-preserving-whitespace stream t nil nil))
+ (equal (loop for c = (read-char stream nil nil)
+ while c collecting c)
+ '(#\space #\space #\b))))
+
+(with-input-from-string (stream "a b")
+ (and (eq 'a (read-preserving-whitespace stream t nil))
+ (equal (loop for c = (read-char stream nil nil)
+ while c collecting c)
+ '(#\space #\space #\b))))
+
+
+(with-input-from-string (stream "ok")
+ (let ((*standard-input* stream))
+ (eq 'ok (read))))
+
+(with-input-from-string (stream "ok")
+ (let ((*standard-input* stream))
+ (eq 'ok (read-preserving-whitespace))))
+
+
+(with-input-from-string (stream "")
+ (let ((*standard-input* stream))
+ (handler-case (read)
+ (end-of-file () t)
+ (error () nil)
+ (:no-error (&rest rest) (declare (ignore rest)) nil))))
+
+(with-input-from-string (stream "")
+ (let ((*standard-input* stream))
+ (handler-case (read-preserving-whitespace)
+ (end-of-file () t)
+ (error () nil)
+ (:no-error (&rest rest) (declare (ignore rest)) nil))))
+
+
+(with-input-from-string (stream "")
+ (let ((*standard-input* stream))
+ (null (read nil nil))))
+
+(with-input-from-string (stream "")
+ (let ((*standard-input* stream))
+ (null (read-preserving-whitespace nil nil))))
+
+
+(with-input-from-string (*standard-input* "(a b")
+ (handler-case (read)
+ (end-of-file () t)
+ (error () nil)
+ (:no-error (&rest rest) (declare (ignore rest)) nil)))
+
+(with-input-from-string (*standard-input* "(a b")
+ (handler-case (read-preserving-whitespace)
+ (end-of-file () t)
+ (error () nil)
+ (:no-error (&rest rest) (declare (ignore rest)) nil)))
+
+(with-input-from-string (*standard-input* "(a (b")
+ (handler-case (read)
+ (end-of-file () t)
+ (error () nil)
+ (:no-error (&rest rest) (declare (ignore rest)) nil)))
+
+(with-input-from-string (*standard-input* "(a (b")
+ (handler-case (read-preserving-whitespace)
+ (end-of-file () t)
+ (error () nil)
+ (:no-error (&rest rest) (declare (ignore rest)) nil)))
+
+;; read-delimited-list
+(with-input-from-string (*standard-input* "a b)")
+ (equal '(a b) (read-delimited-list #\))))
+(with-input-from-string (*standard-input* ")")
+ (null (read-delimited-list #\))))
+(with-input-from-string (*standard-input* "a b )")
+ (equal '(a b) (read-delimited-list #\))))
+(with-input-from-string (*standard-input* " a b )")
+ (equal '(a b) (read-delimited-list #\))))
+(with-input-from-string (*standard-input* " a b ) ")
+ (equal '(a b) (read-delimited-list #\))))
+(with-input-from-string (*standard-input* "a b c d e f g h i j k l m n o p q r)")
+ (equal '(a b c d e f g h i j k l m n o p q r) (read-delimited-list #\))))
+
+(with-input-from-string
+ (*standard-input* "a (b) c (d) e f g h i j (k l m ) n o p q r)")
+ (equal '(a (b) c (d) e f g h i j (k l m) n o p q r) (read-delimited-list #\))))
+(with-input-from-string (*standard-input* "a x\\)x b)")
+ (equal '(a |X)X| b) (read-delimited-list #\))))
+
+(with-input-from-string (*standard-input* "a b) xyz")
+ (and (equal '(a b) (read-delimited-list #\)))
+ (eq 'xyz (read))))
+
+(with-input-from-string (*standard-input* "a #'car)")
+ (equal '(a #'car) (read-delimited-list #\))))
+
+(with-input-from-string (*standard-input* "a #'car ;;
+d #| e f |# g
+z)")
+ (equal '(a #'car d g z) (read-delimited-list #\))))
+
+(with-input-from-string (*standard-input* "a #'car ;;
+d #| e f |# g
+z)
+xyz")
+ (and (equal '(a #'car d g z) (read-delimited-list #\)))
+ (eq 'xyz (read))))
+
+(with-input-from-string (*standard-input* "1 2 3 4 5 6 ]")
+ (equal (read-delimited-list #\])
+ '(1 2 3 4 5 6)))
+
+(get-macro-character #\) nil)
+
+(let ((*readtable* (copy-readtable nil))
+ (f #'(lambda (stream char arg)
+ (declare (ignore char arg))
+ (mapcon #'(lambda (x)
+ (mapcar #'(lambda (y) (list (car x) y)) (cdr x)))
+ (read-delimited-list #\} stream t)))))
+ (set-dispatch-macro-character #\# #\{ f)
+ (get-macro-character #\) nil)
+ (set-macro-character #\} (get-macro-character #\) nil))
+ (with-input-from-string (*standard-input* "#{ p q z a}")
+ (equal (read) '((p q) (p z) (p a) (q z) (q a) (z a)))))
+(handler-case (with-input-from-string (stream "1 2 3 . 4)")
+ (read-delimited-list #\) stream t))
+ (error () t)
+ (:no-error (&rest rest) (declare (ignore rest)) nil))
+
+
+(get-dispatch-macro-character #\# #\( nil)
+(set-syntax-from-char #\z #\' (copy-readtable nil) nil)
+
+
+(equal '(abc 3) (multiple-value-list (read-from-string "abc")))
+
+(handler-case (read-from-string "")
+ (end-of-file () t)
+ (error () nil)
+ (:no-error (&rest rest) (declare (ignore rest)) nil))
+
+(handler-case (read-from-string "" t 'ignored)
+ (end-of-file () t)
+ (error () nil)
+ (:no-error (&rest rest) (declare (ignore rest)) nil))
+
+(eq 'end (read-from-string "" nil 'end))
+
+(equal '(b 5) (multiple-value-list (read-from-string "(a b c)" t nil
+ :start 2 :end 6)))
+
+(equal '(b 4) (multiple-value-list (read-from-string "(a b c)" t nil
+ :start 2
+ :preserve-whitespace t)))
+
+(null (read-from-string "" nil))
+
+(multiple-value-bind (thing pos) (read-from-string " a b" t nil :start 3)
+ (and (eq thing 'b)
+ (or (= pos 4) (= pos 5))))
+
+(multiple-value-bind (thing pos) (read-from-string "abcdefg" t nil :end 2)
+ (and (eq thing 'ab)
+ (or (= pos 2) (= pos 3))))
+
+(equal '(ijk 3)
+ (multiple-value-list (read-from-string "ijk xyz" t nil
+ :preserve-whitespace t)))
+
+(equal '(def 7)
+ (multiple-value-list (read-from-string "abc def ghi" t nil
+ :start 4 :end 9
+ :preserve-whitespace t)))
+
+(= 3 (read-from-string " 1 3 5" t nil :start 2))
+(multiple-value-bind (thing pos) (read-from-string "(a b c)")
+ (and (equal thing '(A B C))
+ (or (= pos 7) (= pos 8))))
+
+(handler-case (read-from-string "(a b")
+ (error () t)
+ (:no-error (&rest rest) (declare (ignore rest)) nil))
+
+
+(let ((*readtable* (copy-readtable)))
+ (and (progn
+ #-clisp (handler-case (read-from-string "#<abc")
+ (reader-error () t)
+ (error () nil)
+ (:no-error (&rest rest) (declare (ignore rest)) nil))
+ #+clisp t)
+ (set-dispatch-macro-character #\# #\<
+ #'(lambda (s c n)
+ (declare (ignore c n))
+ (read-char s t nil t)
+ (read s t nil t)))
+ (eq 'bc (read-from-string "#<abc"))
+ (setq *readtable* (copy-readtable))
+ (eq 'bc (read-from-string "#<abc"))
+ (set-dispatch-macro-character #\# #\<
+ #'(lambda (s c n)
+ (declare (ignore c n))
+ (read-char s t nil t)
+ (read-char s t nil t)
+ (read s t nil t)))
+ (eq 'c (read-from-string "#<abc"))
+ (setq *readtable* (copy-readtable nil))
+ (progn
+ #-clisp
+ (handler-case (read-from-string "#<abc")
+ (reader-error () t)
+ (error () nil)
+ (:no-error (&rest rest) (declare (ignore rest)) nil))
+ #+clisp t)))
+
+
+(let ((*readtable* (copy-readtable)))
+ (and (eq t (make-dispatch-macro-character #\{))
+ (eq t (set-dispatch-macro-character
+ #\{ #\s #'(lambda (s c n)
+ (declare (ignore c n))
+ `(section ,(read s t nil t)))))
+ (equal '(section (x y z)) (read-from-string "{s (x y z)"))
+ (equal '(section (x y z)) (read-from-string "{S (x y z)"))))
+
+
+(multiple-value-bind (function non-terminating-p) (get-macro-character #\")
+ (and function (not non-terminating-p)))
+(multiple-value-bind (function non-terminating-p) (get-macro-character #\#)
+ (and function non-terminating-p))
+(multiple-value-bind (function non-terminating-p) (get-macro-character #\')
+ (and function (not non-terminating-p)))
+(multiple-value-bind (function non-terminating-p) (get-macro-character #\()
+ (and function (not non-terminating-p)))
+(multiple-value-bind (function non-terminating-p) (get-macro-character #\))
+ (and function (not non-terminating-p)))
+(multiple-value-bind (function non-terminating-p) (get-macro-character #\,)
+ (and function (not non-terminating-p)))
+(multiple-value-bind (function non-terminating-p) (get-macro-character #\;)
+ (and function (not non-terminating-p)))
+(multiple-value-bind (function non-terminating-p) (get-macro-character #\`)
+ (and function (not non-terminating-p)))
+
+(multiple-value-bind (function non-terminating-p) (get-macro-character #\a)
+ (and (null function) (not non-terminating-p)))
+(multiple-value-bind (function non-terminating-p) (get-macro-character #\z)
+ (and (null function) (not non-terminating-p)))
+(multiple-value-bind (function non-terminating-p) (get-macro-character #\Space)
+ (and (null function) (not non-terminating-p)))
+(multiple-value-bind (function non-terminating-p) (get-macro-character #\Tab)
+ (and (null function) (not non-terminating-p)))
+
+(multiple-value-bind (function non-terminating-p) (get-macro-character #\" nil)
+ (and function (not non-terminating-p)))
+(multiple-value-bind (function non-terminating-p) (get-macro-character #\# nil)
+ (and function non-terminating-p))
+(multiple-value-bind (function non-terminating-p) (get-macro-character #\' nil)
+ (and function (not non-terminating-p)))
+(multiple-value-bind (function non-terminating-p) (get-macro-character #\( nil)
+ (and function (not non-terminating-p)))
+(multiple-value-bind (function non-terminating-p) (get-macro-character #\) nil)
+ (and function (not non-terminating-p)))
+(multiple-value-bind (function non-terminating-p) (get-macro-character #\, nil)
+ (and function (not non-terminating-p)))
+(multiple-value-bind (function non-terminating-p) (get-macro-character #\; nil)
+ (and function (not non-terminating-p)))
+(multiple-value-bind (function non-terminating-p) (get-macro-character #\` nil)
+ (and function (not non-terminating-p)))
+
+(multiple-value-bind (function non-terminating-p) (get-macro-character #\a nil)
+ (and (null function) (not non-terminating-p)))
+(multiple-value-bind (function non-terminating-p) (get-macro-character #\z nil)
+ (and (null function) (not non-terminating-p)))
+(multiple-value-bind (function non-terminating-p)
+ (get-macro-character #\Space nil)
+ (and (null function) (not non-terminating-p)))
+(multiple-value-bind (function non-terminating-p) (get-macro-character #\Tab nil)
+ (and (null function) (not non-terminating-p)))
+
+(and (let ((*readtable* (copy-readtable)))
+ (and (eq t (set-macro-character #\$
+ #'(lambda (s c)
+ (declare (ignore c))
+ `(dollars ,(read s t nil t)))))
+ (equal '(dollars 100) (read-from-string "$100"))
+ (eq '|$100| (read-from-string "\\$100"))
+ (eq '|$100| (read-from-string "|$|100"))))
+ (null (get-macro-character #\$))
+ (eq '|$100| (read-from-string "$100")))
+
+
+(let ((*readtable* (copy-readtable)))
+ (and (eq t (set-syntax-from-char #\[ #\())
+ (equal '(0 1 2 3) (read-from-string "[0 1 2 3)"))))
+
+(let ((table1 (copy-readtable nil))
+ (table2 (copy-readtable nil)))
+ (and (eq t (set-syntax-from-char #\[ #\( table1 table1))
+ (equal '(0 1 2 3) (let ((*readtable* table1))
+ (read-from-string "[0 1 2 3)")))
+ (eq t (set-syntax-from-char #\{ #\[ table2 table1))
+ (equal '(0 1 2 3) (let ((*readtable* table2))
+ (read-from-string "{0 1 2 3)")))))
+
+(let ((*readtable* (copy-readtable)))
+ (and (eq t (set-syntax-from-char #\[ #\.))
+ (eq '|3[0| (read-from-string "3[0"))))
+
+(let* ((str (concatenate 'string
+ (loop repeat 100 collecting #\()
+ "kernel"
+ (loop repeat 100 collecting #\))))
+ (thing (read-from-string str)))
+ (and (= 1 (length thing))
+ (eq 'kernel (loop repeat 101
+ for x = thing then (car x)
+ finally (return x)))))
+
+
+
+
+(null (let ((*read-suppress* t)) (read-from-string "abc")))
+(null (let ((*read-suppress* t))
+ (with-input-from-string (stream "abc")
+ (read stream))))
+(null (let ((*read-suppress* t))
+ (with-input-from-string (stream "abc")
+ (read-preserving-whitespace stream))))
+(null (let ((*read-suppress* t))
+ ;; http://www.lispworks.com/reference/HyperSpec/Body/v_rd_sup.htm
+ ;; If the value of *read-suppress* is true, read,
+ ;; read-preserving-whitespace, read-delimited-list,
+ ;; and read-from-string all return a primary value of nil
+ ;; when they complete successfully;
+ (with-input-from-string (stream "abc xyz)")
+ (read-delimited-list #\) stream))))
+
+(flet ((num2str (n base)
+ (let* ((base-digits "0123456789ABCDEFGHIJKLMNOPQRSTUV")
+ (minus-p (< n 0))
+ (n (if minus-p (- n) n))
+ digits)
+ (loop with x = n
+ do (multiple-value-bind (q r) (floor x base)
+ (push (aref base-digits r) digits)
+ (setq x q)
+ (when (zerop q) (return))))
+ (when minus-p (push #\- digits))
+ (make-array (length digits)
+ :element-type 'character :initial-contents digits))))
+ (loop for base from 2 upto 32
+ always (loop for n from -100 upto 100
+ always (= n (let ((*read-base* base))
+ (read-from-string (num2str n base)))))))
+
+(labels ((int2str (n base)
+ (let* ((base-digits "0123456789ABCDEFGHIJKLMNOPQRSTUV")
+ (minus-p (< n 0))
+ (n (if minus-p (- n) n))
+ digits)
+ (loop with x = n
+ do (multiple-value-bind (q r) (floor x base)
+ (push (aref base-digits r) digits)
+ (setq x q)
+ (when (zerop q) (return))))
+ (when minus-p (push #\- digits))
+ (make-array (length digits)
+ :element-type 'character :initial-contents digits)))
+ (ratio2str (r base)
+ (concatenate 'string
+ (int2str (numerator r) base)
+ "/"
+ (int2str (denominator r) base))))
+ (loop for base from 2 upto 32
+ always (loop for numerator from -100 upto 100 by 23
+ always (loop for denominator from 1 upto 300 by 51
+ always (= (/ numerator denominator)
+ (let ((*read-base* base))
+ (read-from-string
+ (ratio2str (/ numerator
+ denominator)
+ base))))))))
diff --git a/Sacla/tests/must-reader.patch b/Sacla/tests/must-reader.patch
new file mode 100644
index 0000000..a2db10f
--- /dev/null
+++ b/Sacla/tests/must-reader.patch
@@ -0,0 +1,26 @@
+*** sacla/lisp/test/must-reader.lisp 2004-08-03 08:34:55.000000000 +0200
+--- CLISP/clisp-20040712/sacla-tests/must-reader.lisp 2004-08-07 02:10:05.000000000 +0200
+***************
+*** 1828,1837 ****
+
+
+ (progn
+! #-clisp
+ (handler-case (null (let ((*features* '())) (read-from-string "#+test1 a")))
+ (error () nil))
+! #+clisp 'skipped)
+
+ (let ((*features* '()))
+ (equal (with-input-from-string (stream "#+test1 a #-test1 b")
+--- 1828,1838 ----
+
+
+ (progn
+! #-CLISP ; ANSI CL 2.2. refers to the spec of READ, which says that an error
+! ; of type end-of-file is signalled.
+ (handler-case (null (let ((*features* '())) (read-from-string "#+test1 a")))
+ (error () nil))
+! #+CLISP 'skipped)
+
+ (let ((*features* '()))
+ (equal (with-input-from-string (stream "#+test1 a #-test1 b")
diff --git a/Sacla/tests/must-sequence.lisp b/Sacla/tests/must-sequence.lisp
new file mode 100644
index 0000000..6871d31
--- /dev/null
+++ b/Sacla/tests/must-sequence.lisp
@@ -0,0 +1,10165 @@
+;; Copyright (C) 2002-2004, Yuji Minejima <ggb01164@nifty.ne.jp>
+;; ALL RIGHTS RESERVED.
+;;
+;; $Id: must-sequence.lisp,v 1.31 2004/08/09 02:49:54 yuji Exp $
+;;
+;; Redistribution and use in source and binary forms, with or without
+;; modification, are permitted provided that the following conditions
+;; are met:
+;;
+;; * Redistributions of source code must retain the above copyright
+;; notice, this list of conditions and the following disclaimer.
+;; * 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.
+;;
+;; 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
+;; OWNER 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.
+
+(eql (length "abc") 3)
+(let ((str (make-array '(3) :element-type 'character
+ :initial-contents "abc"
+ :fill-pointer t)))
+ (and (eql (length str) 3)
+ (eql (setf (fill-pointer str) 2) 2)
+ (eql (length str) 2)))
+(zerop (length #*))
+(zerop (length ""))
+(zerop (length #()))
+(zerop (length ()))
+(eql (length '(0)) 1)
+(eql (length '(0 1)) 2)
+(eql (length '(0 1 2)) 3)
+(eql (length '(0 1 2 3)) 4)
+(eql (length '(0 1 2 3 4)) 5)
+(eql (length '(0 1 2 3 4 5)) 6)
+(eql (length '(0 1 2 3 4 5 6)) 7)
+(eql (length #(0)) 1)
+(eql (length #(0 1)) 2)
+(eql (length #(0 1 2)) 3)
+(eql (length #(0 1 2 3)) 4)
+(eql (length #(0 1 2 3 4)) 5)
+(eql (length #(0 1 2 3 4 5)) 6)
+(eql (length #(0 1 2 3 4 5 6)) 7)
+(eql (length (make-array 100)) 100)
+(eql (length (make-sequence 'list 20)) 20)
+(eql (length (make-sequence 'string 10)) 10)
+(eql (length (make-sequence 'bit-vector 3)) 3)
+(eql (length (make-sequence 'bit-vector 64)) 64)
+(eql (length (make-sequence 'simple-vector 64)) 64)
+
+
+
+(string= (copy-seq "love") "love")
+(equalp (copy-seq '#(a b c d)) '#(a b c d))
+(equalp (copy-seq '#*01010101) '#*01010101)
+(equal (copy-seq '(love)) '(love))
+(equal (copy-seq '(love hate war peace)) '(love hate war peace))
+(null (copy-seq nil))
+(string= (copy-seq "") "")
+(let* ((seq0 "love&peace")
+ (seq (copy-seq seq0)))
+ (and (not (eq seq0 seq))
+ (string= seq0 seq)))
+(let* ((seq0 (list 'love 'and 'peace))
+ (seq (copy-seq seq0)))
+ (and (not (eq seq0 seq))
+ (equal seq0 seq)))
+(let* ((c0 (list 'love))
+ (c1 (list 'peace))
+ (seq (copy-seq (list c0 c1))))
+ (and (equal seq '((love) (peace)))
+ (eq (car seq) c0)
+ (eq (cadr seq) c1)))
+(let* ((seq0 '#(t nil t nil))
+ (seq (copy-seq seq0)))
+ (and (not (eq seq0 seq))
+ (equalp seq seq0)))
+(vectorp (copy-seq (vector)))
+(simple-bit-vector-p (copy-seq #*))
+(simple-vector-p (copy-seq (vector)))
+(simple-vector-p (copy-seq (make-array 10
+ :fill-pointer 3
+ :initial-element nil)))
+(simple-vector-p (copy-seq (vector 0 1)))
+(simple-string-p (copy-seq "xyz"))
+(simple-string-p (copy-seq (make-array 3
+ :displaced-to "0123456789"
+ :displaced-index-offset 3
+ :element-type 'base-char)))
+(simple-string-p (copy-seq (make-array 20
+ :fill-pointer t
+ :element-type 'base-char
+ :initial-element #\Space)))
+(simple-bit-vector-p (copy-seq #*0101))
+(simple-bit-vector-p (copy-seq (make-array 30
+ :fill-pointer 3
+ :element-type 'bit
+ :initial-element 0)))
+(let* ((vec0 (make-array 10 :fill-pointer 3 :initial-contents "0123456789"))
+ (vec (copy-seq vec0)))
+ (and (simple-vector-p vec)
+ (= (length vec) 3)
+ (equalp vec #(#\0 #\1 #\2))))
+
+
+(char= (elt "0123456789" 6) #\6)
+(eq (elt #(a b c d e f g) 0) 'a)
+(eq (elt '(a b c d e f g) 4) 'e)
+(zerop (elt #*0101010 0))
+
+(dotimes (i 10 t)
+ (unless (char= (elt "0123456789" i) (digit-char i))
+ (return nil)))
+
+(let ((str (copy-seq "0123456789")))
+ (and (char= (elt str 6) #\6)
+ (setf (elt str 0) #\#)
+ (string= str "#123456789")))
+
+(let ((list (list 0 1 2 3)))
+ (and (= (elt list 2) 2)
+ (setf (elt list 1) 9)
+ (= (elt list 1) 9)
+ (equal list '(0 9 2 3))))
+
+(let ((bv #*0101010101))
+ (dotimes (i 10 t)
+ (unless (= (elt bv i) (if (evenp i) 0 1))
+ (return nil))))
+
+(let ((vec (vector 'a 'b 'c)))
+ (and (eq (elt vec 0) 'a)
+ (eq (elt vec 1) 'b)
+ (eq (elt vec 2) 'c)))
+
+
+(let ((list (list 0 1 2 3)))
+ (and (eq (fill list 'nil) list)
+ (every 'null list)))
+
+(let ((vector (vector 'x 'y 'z)))
+ (and (eq (fill vector 'a) vector)
+ (every #'(lambda (arg) (eq arg 'a)) vector)))
+
+(let ((list (list 0 1 2 3)))
+ (and (eq (fill list '9 :start 2) list)
+ (equal list '(0 1 9 9))))
+
+(let ((list (list 0 1 2 3)))
+ (and (eq (fill list '9 :start 1 :end 3) list)
+ (equal list '(0 9 9 3))))
+
+(let ((list (list 0 1 2 3)))
+ (and (eq (fill list '9 :start 1 :end nil) list)
+ (equal list '(0 9 9 9))))
+
+(let ((list (list 0 1 2 3)))
+ (and (eq (fill list '9 :end 1) list)
+ (equal list '(9 1 2 3))))
+
+(let ((vector (vector 0 1 2 3)))
+ (and (eq (fill vector 't :start 3) vector)
+ (equalp vector '#(0 1 2 t))))
+
+(let ((vector (vector 0 1 2 3)))
+ (and (eq (fill vector 't :start 2 :end 4) vector)
+ (equalp vector '#(0 1 t t))))
+
+(let ((vector (vector 0 1 2 3)))
+ (and (eq (fill vector 't :start 2 :end nil) vector)
+ (equalp vector '#(0 1 t t))))
+
+(let ((vector (vector 0 1 2 3)))
+ (and (eq (fill vector 't :end 3) vector)
+ (equalp vector '#(t t t 3))))
+
+
+
+(null (make-sequence 'list 0))
+(string= (make-sequence 'string 26 :initial-element #\.)
+ "..........................")
+(equalp (make-sequence '(vector double-float) 2
+ :initial-element 1d0)
+ #(1.0d0 1.0d0))
+
+
+(equal (make-sequence 'list 3 :initial-element 'a)
+ '(a a a))
+
+(equal (make-sequence 'cons 3 :initial-element 'a)
+ '(a a a))
+
+(null (make-sequence 'null 0 :initial-element 'a))
+
+(equalp (make-sequence 'vector 3 :initial-element 'z)
+ '#(z z z))
+
+(equalp (make-sequence '(vector * *) 3 :initial-element 'z)
+ '#(z z z))
+
+(equalp (make-sequence '(vector t *) 3 :initial-element 'z)
+ '#(z z z))
+
+(string= (make-sequence '(string 3) 3 :initial-element '#\a)
+ "aaa")
+
+(string= (make-sequence 'string 4 :initial-element '#\z)
+ "zzzz")
+
+(string= (make-sequence '(vector character 3) 3 :initial-element '#\a)
+ "aaa")
+
+(equalp (make-sequence '(array t 1) 3 :initial-element 'z)
+ '#(z z z))
+
+(equalp (make-sequence '(array t (3)) 3 :initial-element 'z)
+ '#(z z z))
+
+(vectorp (make-sequence 'vector 10))
+
+
+(string= (subseq "012345" 2) "2345")
+(string= (subseq "012345" 3 5) "34")
+(let ((str (copy-seq "012345")))
+ (and (setf (subseq str 4) "abc")
+ (string= str "0123ab")))
+(let ((str (copy-seq "012345")))
+ (setf (subseq str 0 2) "A")
+ (string= str "A12345"))
+
+(equal (subseq '(0 1 2 3) 0) '(0 1 2 3))
+(equal (subseq '(0 1 2 3) 1) '(1 2 3))
+(equal (subseq '(0 1 2 3) 2) '(2 3))
+(equal (subseq '(0 1 2 3) 3) '(3))
+(equal (subseq '(0 1 2 3) 4) '())
+(equalp (subseq #(a b c d) 0) #(a b c d))
+(equalp (subseq #(a b c d) 1) #(b c d))
+(equalp (subseq #(a b c d) 2) #(c d))
+(equalp (subseq #(a b c d) 3) #(d))
+(equalp (subseq #(a b c d) 4) #())
+(string= (subseq "0123" 0) "0123")
+(string= (subseq "0123" 1) "123")
+(string= (subseq "0123" 2) "23")
+(string= (subseq "0123" 3) "3")
+(string= (subseq "0123" 4) "")
+(equalp (subseq #*1010 0) #*1010)
+(equalp (subseq #*1010 1) #*010)
+(equalp (subseq #*1010 2) #*10)
+(equalp (subseq #*1010 3) #*0)
+(equalp (subseq #*1010 4) #*)
+
+(equal (subseq '(0 1 2 3) 0 4) '(0 1 2 3))
+(equal (subseq '(0 1 2 3) 0 nil) '(0 1 2 3))
+(let* ((list0 '(0 1 2 3))
+ (list (subseq list0 0 4)))
+ (and (not (eq list0 list))
+ (equal list0 list)))
+(let* ((list0 '(0 1 2 3))
+ (list (subseq list0 0 nil)))
+ (and (not (eq list0 list))
+ (equal list0 list)))
+(equal (subseq '(0 1 2 3) 1 3) '(1 2))
+(equal (subseq '(0 1 2 3) 2 2) '())
+(equal (subseq '(0 1 2 3) 0 0) '())
+(equal (subseq '(0 1 2 3) 1 1) '())
+(equal (subseq '(0 1 2 3) 2 2) '())
+(equal (subseq '(0 1 2 3) 3 3) '())
+(equal (subseq '(0 1 2 3) 4 4) '())
+
+(let ((list (list 0 1 2 3 4 5 6 7)))
+ (setf (subseq list 0) '(a b c d))
+ (equal list '(a b c d 4 5 6 7)))
+
+(let ((list (list 0 1 2 3)))
+ (setf (subseq list 0) '(a b c d))
+ (equal list '(a b c d)))
+
+(let ((list (list 0 1 2 3)))
+ (setf (subseq list 2) '(a b c d))
+ (equal list '(0 1 a b)))
+
+(let ((list (list 0 1 2 3)))
+ (setf (subseq list 2 nil) '(a b c d))
+ (equal list '(0 1 a b)))
+
+(let ((list (list 0 1 2 3)))
+ (setf (subseq list 1 3) '(a b c d))
+ (equal list '(0 a b 3)))
+
+(let ((list (list 0 1 2 3)))
+ (setf (subseq list 0) '())
+ (equal list '(0 1 2 3)))
+
+(let ((list '()))
+ (setf (subseq list 0) '(a b c d e))
+ (null list))
+
+(let ((list '(0 1 2 3)))
+ (setf (subseq list 0 0) '(a b c d e))
+ (equal list '(0 1 2 3)))
+
+(let ((list '(0 1 2 3)))
+ (setf (subseq list 1 1) '(a b c d e))
+ (equal list '(0 1 2 3)))
+
+(let ((list '(0 1 2 3)))
+ (setf (subseq list 2 2) '(a b c d e))
+ (equal list '(0 1 2 3)))
+
+(let ((list '(0 1 2 3)))
+ (setf (subseq list 3 3) '(a b c d e))
+ (equal list '(0 1 2 3)))
+
+(let ((list '(0 1 2 3)))
+ (setf (subseq list 4 4) '(a b c d e))
+ (equal list '(0 1 2 3)))
+
+
+
+(let ((list (list 0 1 2 3 4 5 6 7)))
+ (setf (subseq list 0) #(a b c d))
+ (equal list '(a b c d 4 5 6 7)))
+
+(let ((list (list 0 1 2 3)))
+ (setf (subseq list 0) #(a b c d))
+ (equal list '(a b c d)))
+
+(let ((list (list 0 1 2 3)))
+ (setf (subseq list 2) #(a b c d))
+ (equal list '(0 1 a b)))
+
+(let ((list (list 0 1 2 3)))
+ (setf (subseq list 2 nil) #(a b c d))
+ (equal list '(0 1 a b)))
+
+(let ((list (list 0 1 2 3)))
+ (setf (subseq list 1 3) #(a b c d))
+ (equal list '(0 a b 3)))
+
+(let ((list (list 0 1 2 3)))
+ (setf (subseq list 0) #())
+ (equal list '(0 1 2 3)))
+
+(let ((list (list 0 1 2 3 4 5 6 7)))
+ (setf (subseq list 0) "abcd")
+ (equal list '(#\a #\b #\c #\d 4 5 6 7)))
+
+(let ((list (list 0 1 2 3)))
+ (setf (subseq list 0) "abcd")
+ (equal list '(#\a #\b #\c #\d)))
+
+(let ((list (list 0 1 2 3)))
+ (setf (subseq list 2) "abcd")
+ (equal list '(0 1 #\a #\b)))
+
+(let ((list (list 0 1 2 3)))
+ (setf (subseq list 2 nil) "abcd")
+ (equal list '(0 1 #\a #\b)))
+
+(let ((list (list 0 1 2 3)))
+ (setf (subseq list 1 3) "abcd")
+ (equal list '(0 #\a #\b 3)))
+
+(let ((list (list 0 1 2 3)))
+ (setf (subseq list 0) "")
+ (equal list '(0 1 2 3)))
+
+
+(equalp (subseq #(0 1 2 3) 0 4) #(0 1 2 3))
+(equalp (subseq #(0 1 2 3) 0 nil) #(0 1 2 3))
+(let* ((vec0 #(0 1 2 3))
+ (vec (subseq vec0 0 4)))
+ (and (not (eq vec0 vec))
+ (equalp vec0 vec)))
+(let* ((vec0 #(0 1 2 3))
+ (vec (subseq vec0 0 nil)))
+ (and (not (eq vec0 vec))
+ (equalp vec0 vec)))
+(equalp (subseq #(0 1 2 3) 1 3) #(1 2))
+(equalp (subseq #(0 1 2 3) 2 2) #())
+(equalp (subseq #(0 1 2 3) 0 0) #())
+(equalp (subseq #(0 1 2 3) 1 1) #())
+(equalp (subseq #(0 1 2 3) 2 2) #())
+(equalp (subseq #(0 1 2 3) 3 3) #())
+(equalp (subseq #(0 1 2 3) 4 4) #())
+
+(let ((vec (vector 0 1 2 3 4 5 6 7)))
+ (setf (subseq vec 0) #(a b c d))
+ (equalp vec #(a b c d 4 5 6 7)))
+
+(let ((vec (vector 0 1 2 3)))
+ (setf (subseq vec 0) #(a b c d))
+ (equalp vec #(a b c d)))
+
+(let ((vec (vector 0 1 2 3)))
+ (setf (subseq vec 2) #(a b c d))
+ (equalp vec #(0 1 a b)))
+
+(let ((vec (vector 0 1 2 3)))
+ (setf (subseq vec 1 3) #(a b c d))
+ (equalp vec #(0 a b 3)))
+
+(let ((vec (vector 0 1 2 3)))
+ (setf (subseq vec 0) #())
+ (equalp vec #(0 1 2 3)))
+
+(let ((vec (vector)))
+ (setf (subseq vec 0) #(a b c d e))
+ (equalp vec #()))
+
+(let ((vec (vector 0 1 2 3)))
+ (setf (subseq vec 0 0) #(a b c d e))
+ (equalp vec #(0 1 2 3)))
+
+(let ((vec (vector 0 1 2 3)))
+ (setf (subseq vec 1 1) #(a b c d e))
+ (equalp vec #(0 1 2 3)))
+
+(let ((vec (vector 0 1 2 3)))
+ (setf (subseq vec 2 2) #(a b c d e))
+ (equalp vec #(0 1 2 3)))
+
+(let ((vec (vector 0 1 2 3)))
+ (setf (subseq vec 3 3) #(a b c d e))
+ (equalp vec #(0 1 2 3)))
+
+(let ((vec (vector 0 1 2 3)))
+ (setf (subseq vec 4 4) #(a b c d e))
+ (equalp vec #(0 1 2 3)))
+
+
+(let ((vec (vector 0 1 2 3 4 5 6 7)))
+ (setf (subseq vec 0) #(a b c d))
+ (equalp vec #(a b c d 4 5 6 7)))
+
+(let ((vec (vector 0 1 2 3)))
+ (setf (subseq vec 0) #(a b c d))
+ (equalp vec #(a b c d)))
+
+(let ((vec (vector 0 1 2 3)))
+ (setf (subseq vec 2) #(a b c d))
+ (equalp vec #(0 1 a b)))
+
+(let ((vec (vector 0 1 2 3)))
+ (setf (subseq vec 2 nil) #(a b c d))
+ (equalp vec #(0 1 a b)))
+
+(let ((vec (vector 0 1 2 3)))
+ (setf (subseq vec 1 3) #(a b c d))
+ (equalp vec #(0 a b 3)))
+
+(let ((vec (vector 0 1 2 3)))
+ (setf (subseq vec 0) #())
+ (equalp vec #(0 1 2 3)))
+
+(HANDLER-CASE (PROGN (MAP 'SYMBOL #'+ '(0 1) '(1 0)))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (MAP 'HASH-TABLE #'+ '(0 1) '(1 0)))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+
+
+(string= (map 'string #'(lambda (x y)
+ (char "01234567890ABCDEF" (mod (+ x y) 16)))
+ '(1 2 3 4)
+ '(10 9 8 7))
+ "AAAA")
+
+(let ((seq (list "lower" "UPPER" "" "123")))
+ (and (null (map nil #'nstring-upcase seq))
+ (equal seq '("LOWER" "UPPER" "" "123"))))
+
+(equal (map 'list #'- '(1 2 3 4)) '(-1 -2 -3 -4))
+
+(string= (map 'string
+ #'(lambda (x) (if (oddp x) #\1 #\0))
+ '(1 2 3 4))
+ "1010")
+
+
+
+(equal (map 'list '+ '(0 1) '(1 0)) '(1 1))
+(equal (map 'list '- '(0 1) '(1 0)) '(-1 1))
+
+(every 'null (list (map 'list #'+ '())
+ (map 'list #'+ '() '())
+ (map 'list #'+ '() '() '())
+ (map 'list #'+ '() '() '() '())
+ (map 'list #'+ '() '() '() '() '())))
+(every 'null (list (map 'list #'+ '())
+ (map 'list #'+ #() '())
+ (map 'list #'+ '() #() '())
+ (map 'list #'+ #() '() #() '())
+ (map 'list #'+ '() #() '() #() '())))
+
+(equal (map 'list #'+ '(0 1 2)) '(0 1 2))
+(equal (map 'list #'+ '(0 1 2) '(1 2 3)) '(1 3 5))
+(equal (map 'list #'+ '(0 1 2) '(1 2 3) '(2 3 4)) '(3 6 9))
+(equal (map 'list #'+ '(0 1 2) '(1 2 3) '(2 3 4) '(3 4 5)) '(6 10 14))
+
+(equal (map 'list #'+ '(1 2) '(1 2 3)) '(2 4))
+(equal (map 'list #'+ '(0 1 2) '(2 3) '(2 3 4)) '(4 7))
+(equal (map 'list #'+ '(0 1 2) '(1 2 3) '(2) '(3 4 5)) '(6))
+(equal (map 'list #'+ '(0 1 2) '(1 2 3) '(2 3 4) '(3 4 5) '()) '())
+
+(equal (map 'cons #'+ '(0 1 2) '(2 1 0)) '(2 2 2))
+(equal (map '(cons number cons) #'+ '(0 1 2) '(2 1 0)) '(2 2 2))
+(equal (map '(cons number (cons number *)) #'+ '(0 1 2) '(2 1 0)) '(2 2 2))
+(null (map 'null #'+ '()))
+
+
+(equalp (map 'vector #'+ #()) #())
+(equalp (map 'vector #'+ #() #()) #())
+(equalp (map 'vector #'+ #() #() #()) #())
+(equalp (map 'vector #'+ #() #() #() #()) #())
+(equalp (map 'vector #'+ #() #() #() #() #()) #())
+(equalp (map 'vector #'+ '() #()) #())
+(equalp (map 'vector #'+ '() #() "") #())
+
+(equalp (map 'vector #'+ '(0 1 2)) #(0 1 2))
+(equalp (map 'vector #'+ '(0 1 2) #(1 2 3)) #(1 3 5))
+(equalp (map 'vector #'+ #(0 1 2) '(1 2 3) #(2 3 4)) #(3 6 9))
+(equalp (map 'vector #'+ '(0 1 2) #(1 2 3) '(2 3 4) #(3 4 5)) #(6 10 14))
+
+(equalp (map 'vector #'+ '(1 2) '(1 2 3)) #(2 4))
+(equalp (map 'vector #'+ '(0 1 2) '(2 3) '(2 3 4)) #(4 7))
+(equalp (map 'vector #'+ '(0 1 2) '(1 2 3) '(2) '(3 4 5)) #(6))
+(equalp (map 'vector #'+ '(0 1 2) '(1 2 3) '(2 3 4) '(3 4 5) '()) #())
+
+(equalp (map 'vector #'+ #(1 2) #(1 2 3)) #(2 4))
+(equalp (map 'vector #'+ #(0 1 2) #(2 3) #(2 3 4)) #(4 7))
+(equalp (map 'vector #'+ #(0 1 2) '(1 2 3) #(2) '(3 4 5)) #(6))
+(equalp (map 'vector #'+ '(0 1 2) #(1 2 3) '(2 3 4) '(3 4 5) '()) #())
+
+(string= (map 'string #'(lambda (&rest rest) (char-upcase (car rest))) "") "")
+(string= (map 'string #'(lambda (&rest rest) (char-upcase (car rest))) "" "")
+ "")
+(string= (map 'string
+ #'(lambda (&rest rest) (char-upcase (car rest)))
+ "" "" "")
+ "")
+(string= (map 'string
+ #'(lambda (&rest rest) (char-upcase (car rest)))
+ "" "" "" "")
+ "")
+(string= (map 'string
+ #'(lambda (&rest rest) (char-upcase (car rest)))
+ "" "" "" "" "")
+ "")
+
+(string= (map 'string #'(lambda (&rest rest) (char-upcase (car rest))) "") "")
+(string= (map 'string #'(lambda (&rest rest) (char-upcase (car rest))) "" '())
+ "")
+(string= (map 'string #'(lambda (&rest rest) (char-upcase (car rest)))
+ "" #() '()) "")
+(string= (map 'string #'(lambda (&rest rest) (char-upcase (car rest)))
+ '() '() "" "") "")
+(string= (map 'string #'(lambda (&rest rest) (char-upcase (car rest)))
+ #() #() #() #() #()) "")
+
+
+(string= (map 'string
+ #'(lambda (a b) (if (char< a b) b a))
+ "axbycz"
+ "xaybzc")
+ "xxyyzz")
+
+(string= (map 'string
+ #'(lambda (a b) (if (char< a b) b a))
+ "axbycz"
+ "xayb")
+ "xxyy")
+
+(string= (map 'string
+ #'(lambda (&rest rest) (if (zerop (apply #'logand rest)) #\0 #\1))
+ '(0 1 0 1)
+ #*1010101)
+ "0000")
+
+(string= (map 'string
+ #'(lambda (&rest rest) (if (zerop (apply #'logand rest)) #\0 #\1))
+ #*1111
+ #*1010101
+ #*001)
+ "001")
+
+(string= (map 'string
+ #'(lambda (&rest rest) (if (zerop (apply #'logand rest)) #\0 #\1))
+ #*1111
+ #*1010101
+ #*0)
+ "0")
+
+(string= (map 'string
+ #'(lambda (&rest rest) (if (zerop (apply #'logand rest)) #\0 #\1))
+ #*1111
+ #*1000
+ #*1011)
+ "1000")
+
+
+(let ((list ()))
+ (and (null (map nil
+ #'(lambda (&rest rest)
+ (setq list (cons (apply #'+ rest) list)))
+ '(0 1 2 3)
+ '(1 2 3 4)))
+ (equal list '(7 5 3 1))))
+
+(let ((list ()))
+ (and (null (map nil
+ #'(lambda (&rest rest)
+ (setq list (cons (apply #'+ rest) list)))
+ '(0 1 2 3)
+ '(1 2 3 4)
+ '(2 3 4 5)))
+ (equal list (reverse '(3 6 9 12)))))
+
+(let ((list ()))
+ (and (null (map nil
+ #'(lambda (&rest rest)
+ (setq list (cons (apply #'+ rest) list)))
+ '(0 1 2 3)
+ '(1)
+ '(2 3 4 5)))
+ (equal list '(3))))
+
+
+
+(equalp (map '(vector * 2) #'+ #*01 #*10) #(1 1))
+(equalp (map '(simple-vector 2) #'+ #*01 #*10) #(1 1))
+(equalp (map '(array * 1) #'+ #*01 #*10) #(1 1))
+(equalp (map '(simple-array * 1) #'+ #*01 #*10) #(1 1))
+(equalp (map '(array * (2)) #'+ #*01 #*10) #(1 1))
+(equalp (map '(simple-array * (2)) #'+ #*01 #*10) #(1 1))
+(string= (map 'string #'char-upcase "abc") "ABC")
+(string= (map 'base-string #'char-upcase "abc") "ABC")
+(string= (map 'simple-string #'char-upcase "abc") "ABC")
+(string= (map '(string 3) #'char-upcase "abc") "ABC")
+(string= (map '(base-string 3) #'char-upcase "abc") "ABC")
+(string= (map '(simple-string 3) #'char-upcase "abc") "ABC")
+(string= (map '(vector character) #'char-upcase "abc") "ABC")
+(string= (map '(vector character 3) #'char-upcase "abc") "ABC")
+(string= (map '(vector base-char) #'char-upcase "abc") "ABC")
+(string= (map '(vector base-char 3) #'char-upcase "abc") "ABC")
+(string= (map '(vector standard-char) #'char-upcase "abc") "ABC")
+(string= (map '(vector standard-char 3) #'char-upcase "abc") "ABC")
+(string= (map '(array character 1) #'char-upcase "abc") "ABC")
+(string= (map '(array character (3)) #'char-upcase "abc") "ABC")
+(string= (map '(array base-char 1) #'char-upcase "abc") "ABC")
+(string= (map '(array base-char (3)) #'char-upcase "abc") "ABC")
+(string= (map '(array standard-char 1) #'char-upcase "abc") "ABC")
+(string= (map '(array standard-char (3)) #'char-upcase "abc") "ABC")
+(equalp (map 'bit-vector #'logand '(0 1 0 1) #*1010) #*0000)
+(equalp (map 'simple-bit-vector #'logand '(0 1 0 1) #*1010) #*0000)
+(equalp (map '(bit-vector 4) #'logand '(0 1 0 1) #*1010) #*0000)
+(equalp (map '(simple-bit-vector 4) #'logand '(0 1 0 1) #*1010) #*0000)
+(equalp (map '(array bit 1) #'logand '(0 1 0 1) #*1010) #*0000)
+(equalp (map '(array bit (4)) #'logand '(0 1 0 1) #*1010) #*0000)
+(equalp (map '(simple-array bit 1) #'logand '(0 1 0 1) #*1010) #*0000)
+(equalp (map '(simple-array bit (4)) #'logand '(0 1 0 1) #*1010) #*0000)
+(equalp (map '(vector bit) #'logand '(0 1 0 1) #*1010) #*0000)
+(equalp (map '(vector bit 4) #'logand '(0 1 0 1) #*1010) #*0000)
+
+(equal (map 'list #'+ '(0 1 2 3) #(3 2 1 0) #*0101) '(3 4 3 4))
+(equalp (map 'vector #'+ '(0 1 2 3) #(3 2 1 0) #*0101) #(3 4 3 4))
+
+
+
+(let ((a (list 1 2 3 4))
+ (b (list 10 10 10 10)))
+ (and (equal (map-into a #'+ a b) '(11 12 13 14))
+ (equal a '(11 12 13 14))
+ (equal b '(10 10 10 10))))
+(let ((a '(11 12 13 14))
+ (k '(one two three)))
+ (equal (map-into a #'cons k a) '((ONE . 11) (TWO . 12) (THREE . 13) 14)))
+
+
+(null (map-into nil 'identity))
+(null (map-into nil #'identity))
+(null (map-into nil #'identity '()))
+(null (map-into nil #'identity '(0 1 2) '(9 8 7)))
+
+
+(let ((list (list 0 1 2)))
+ (and (eq (map-into list 'identity) list)
+ (equal list '(0 1 2))))
+(let ((list (list 0 1 2)))
+ (and (eq (map-into list 'identity '()) list)
+ (equal list '(0 1 2))))
+
+(let ((vec (vector 0 1 2)))
+ (and (eq (map-into vec 'identity) vec)
+ (equalp vec #(0 1 2))))
+(let ((vec (vector 0 1 2)))
+ (and (eq (map-into vec 'identity #()) vec)
+ (equalp vec #(0 1 2))))
+(let ((vec (vector 0 1 2)))
+ (and (eq (map-into vec #'+ #() '() #()) vec)
+ (equalp vec #(0 1 2))))
+
+
+(equal (map-into (list nil nil) '+ '(0 1) '(1 0)) '(1 1))
+(equal (map-into (list nil nil) '- '(0 1) '(1 0)) '(-1 1))
+(let ((list (make-list 3 :initial-element nil)))
+ (and (eq (map-into list #'+ '(0 1 2)) list)
+ (equal list '(0 1 2))))
+(let ((list (make-list 3 :initial-element nil)))
+ (and (eq (map-into list #'+ '(0 1 2) '(1 2 3)) list)
+ (equal list '(1 3 5))))
+(let ((list (make-list 3 :initial-element nil)))
+ (and (eq (map-into list #'+ '(0 1 2) '(1 2 3) '(2 3 4)) list)
+ (equal list '(3 6 9))))
+
+(let ((list (make-list 3 :initial-element nil)))
+ (and (eq (map-into list #'+ '(1 2) '(1 2 3)) list)
+ (equal list '(2 4 nil))))
+(let ((list (make-list 1 :initial-element nil)))
+ (and (eq (map-into list #'+ '(1 2 3) '(1 2 3)) list)
+ (equal list '(2))))
+(let ((list (make-list 3 :initial-element nil)))
+ (and (eq (map-into list #'+ '(1 2 3 4) '(1 2 3) '(0)) list)
+ (equal list '(2 nil nil))))
+
+
+(let ((vec (make-sequence 'vector 3 :initial-element nil)))
+ (and (eq (map-into vec #'+ '(0 1 2)) vec)
+ (equalp vec #(0 1 2))))
+(let ((vec (make-sequence 'vector 3 :initial-element nil)))
+ (and (eq (map-into vec #'+ '(0 1 2) #(1 2 3)) vec)
+ (equalp vec #(1 3 5))))
+(let ((vec (make-sequence 'vector 3 :initial-element nil)))
+ (and (eq (map-into vec #'+ '(0 1 2) '(1 2 3) #(2 3 4)) vec)
+ (equalp vec #(3 6 9))))
+
+(let ((vec (make-sequence 'vector 3 :initial-element nil)))
+ (and (eq (map-into vec #'+ '(1 2) #(1 2 3)) vec)
+ (equalp vec #(2 4 nil))))
+(let ((vec (make-sequence 'vector 1 :initial-element nil)))
+ (and (eq (map-into vec #'+ '(1 2) #(1 2 3)) vec)
+ (equalp vec #(2))))
+(let ((vec (make-sequence 'vector 3 :initial-element nil)))
+ (and (eq (map-into vec #'+ '(1 2 3 4) #(1 2 3) '(0)) vec)
+ (equalp vec #(2 nil nil))))
+
+
+(let ((str (make-array 10
+ :element-type 'character
+ :initial-contents "0123456789"
+ :fill-pointer 3)))
+ (and (eq (map-into str #'char-upcase "abcde") str)
+ (string= str "ABCDE")
+ (= (fill-pointer str) 5)))
+
+(let ((vec (make-array 5
+ :initial-contents #(0 1 2 3 4)
+ :fill-pointer 3)))
+ (and (eq (map-into vec #'+ '(0 1 2 3 4 5 6 7 8 9) '(9 8 7 6 5 4 3 2 1 0)) vec)
+ (equalp vec #(9 9 9 9 9))))
+
+(let ((vec (make-array 5
+ :initial-contents #(0 1 2 3 4)
+ :fill-pointer 3)))
+ (and (eq (map-into vec #'+ '(0 1) '(9 8 7 6 5 4 3 2 1 0)) vec)
+ (equalp vec #(9 9))))
+
+
+(let ((vec (make-array 5
+ :element-type 'bit
+ :initial-contents #(1 1 1 1 1)
+ :fill-pointer 3)))
+ (and (eq (map-into vec #'logand '(0 1) '(1 0 1 0 1 0)) vec)
+ (equalp vec #*00)))
+
+
+(eql (reduce #'* '(1 2 3 4 5)) 120)
+(equal (reduce #'append '((1) (2)) :initial-value '(i n i t)) '(I N I T 1 2))
+(equal (reduce #'append '((1) (2))
+ :from-end t
+ :initial-value '(i n i t))
+ '(1 2 I N I T))
+(eql (reduce #'- '(1 2 3 4)) -8)
+(eql (reduce #'- '(1 2 3 4) :from-end t) -2)
+(eql (reduce #'+ '()) 0)
+(eql (reduce #'+ '(3)) 3)
+(eq (reduce #'+ '(foo)) 'foo)
+(equal (reduce #'list '(1 2 3 4)) '(((1 2) 3) 4))
+(equal (reduce #'list '(1 2 3 4) :from-end t) '(1 (2 (3 4))))
+(equal (reduce #'list '(1 2 3 4) :initial-value 'foo) '((((foo 1) 2) 3) 4))
+(equal (reduce #'list '(1 2 3 4) :from-end t :initial-value 'foo)
+ '(1 (2 (3 (4 foo)))))
+
+
+(equal (reduce #'list '(0 1 2 3)) '(((0 1) 2) 3))
+(equal (reduce #'list '(0 1 2 3) :start 1) '((1 2) 3))
+(equal (reduce #'list '(0 1 2 3) :start 1 :end nil) '((1 2) 3))
+(equal (reduce #'list '(0 1 2 3) :start 2) '(2 3))
+(eq (reduce #'list '(0 1 2 3) :start 0 :end 0) '())
+(eq (reduce #'list '(0 1 2 3) :start 0 :end 0 :initial-value 'initial-value)
+ 'initial-value)
+(eq (reduce #'list '(0 1 2 3) :start 2 :end 2) '())
+(eq (reduce #'list '(0 1 2 3) :start 2 :end 2 :initial-value 'initial-value)
+ 'initial-value)
+(eq (reduce #'list '(0 1 2 3) :start 4 :end 4) '())
+(eq (reduce #'list '(0 1 2 3) :start 4 :end 4 :initial-value 'initial-value)
+ 'initial-value)
+(eql (reduce #'list '(0 1 2 3) :start 2 :end 3) 2)
+(equal (reduce #'list '(0 1 2 3) :start 2 :end 3 :initial-value 'initial-value)
+ '(initial-value 2))
+(eql (reduce #'+ '(0 1 2 3 4 5 6 7 8 9)) 45)
+(eql (reduce #'- '(0 1 2 3 4 5 6 7 8 9)) -45)
+(eql (reduce #'- '(0 1 2 3 4 5 6 7 8 9) :from-end t) -5)
+(equal (reduce #'list '(0 1 2 3) :initial-value 'initial-value)
+ '((((initial-value 0) 1) 2) 3))
+(equal (reduce #'list '(0 1 2 3) :from-end t) '(0 (1 (2 3))))
+(equal (reduce #'list '((1) (2) (3) (4)) :key #'car) '(((1 2) 3) 4))
+(equal (reduce #'list '((1) (2) (3) (4)) :key #'car :from-end nil)
+ '(((1 2) 3) 4))
+(equal (reduce #'list '((1) (2) (3) (4)) :key #'car :initial-value 0)
+ '((((0 1) 2) 3) 4))
+(equal (reduce #'list '((1) (2) (3) (4)) :key #'car :from-end t)
+ '(1 (2 (3 4))))
+(equal (reduce #'list '((1) (2) (3) (4))
+ :key #'car :from-end t :initial-value 5)
+ '(1 (2 (3 (4 5)))))
+
+
+
+
+(equal (reduce #'list #(0 1 2 3)) '(((0 1) 2) 3))
+(equal (reduce #'list #(0 1 2 3) :start 1) '((1 2) 3))
+(equal (reduce #'list #(0 1 2 3) :start 1 :end nil) '((1 2) 3))
+(equal (reduce #'list #(0 1 2 3) :start 2) '(2 3))
+(eq (reduce #'list #(0 1 2 3) :start 0 :end 0) '())
+(eq (reduce #'list #(0 1 2 3) :start 0 :end 0 :initial-value 'initial-value)
+ 'initial-value)
+(eq (reduce #'list #(0 1 2 3) :start 2 :end 2) '())
+(eq (reduce #'list #(0 1 2 3) :start 2 :end 2 :initial-value 'initial-value)
+ 'initial-value)
+(eq (reduce #'list #(0 1 2 3) :start 4 :end 4) '())
+(eq (reduce #'list #(0 1 2 3) :start 4 :end 4 :initial-value 'initial-value)
+ 'initial-value)
+(eql (reduce #'list #(0 1 2 3) :start 2 :end 3) 2)
+(equal (reduce #'list #(0 1 2 3) :start 2 :end 3 :initial-value 'initial-value)
+ '(initial-value 2))
+(eql (reduce #'+ #(0 1 2 3 4 5 6 7 8 9)) 45)
+(eql (reduce #'- #(0 1 2 3 4 5 6 7 8 9)) -45)
+(eql (reduce #'- #(0 1 2 3 4 5 6 7 8 9) :from-end t) -5)
+(equal (reduce #'list #(0 1 2 3) :initial-value 'initial-value)
+ '((((initial-value 0) 1) 2) 3))
+(equal (reduce #'list #(0 1 2 3) :from-end t) '(0 (1 (2 3))))
+(equal (reduce #'list #((1) (2) (3) (4)) :key #'car) '(((1 2) 3) 4))
+(equal (reduce #'list #((1) (2) (3) (4)) :key #'car :from-end nil)
+ '(((1 2) 3) 4))
+(equal (reduce #'list #((1) (2) (3) (4)) :key #'car :initial-value 0)
+ '((((0 1) 2) 3) 4))
+(equal (reduce #'list #((1) (2) (3) (4)) :key #'car :from-end t)
+ '(1 (2 (3 4))))
+(equal (reduce #'list #((1) (2) (3) (4))
+ :key #'car :from-end t :initial-value 5)
+ '(1 (2 (3 (4 5)))))
+
+(string= (reduce #'(lambda (&rest rest)
+ (concatenate 'string
+ (string (car rest))
+ (string (char-upcase (cadr rest)))))
+ "abcdefg"
+ :initial-value #\Z)
+ "ZABCDEFG")
+
+
+(eql (count #\a "how many A's are there in here?") 2)
+(eql (count-if-not #'oddp '((1) (2) (3) (4)) :key #'car) 2)
+(eql (count-if #'upper-case-p "The Crying of Lot 49" :start 4) 2)
+(eql (count #\a (concatenate 'list "how many A's are there in here?")) 2)
+(eql (count-if #'alpha-char-p "-a-b-c-0-1-2-3-4-") 3)
+(eql (count-if #'alphanumericp "-a-b-c-0-1-2-3-4-") 8)
+
+(eql (count 'nil '(t nil t nil t nil)) 3)
+(eql (count 'nil #(t nil t nil t nil)) 3)
+(zerop (count 9 '(0 1 2 3 4)))
+(zerop (count 'a '(0 1 2 3 4)))
+(eql (count 0 '(0 0 0 0 0) :start 1) 4)
+(eql (count 0 '(0 0 0 0 0) :start 1 :end nil) 4)
+(eql (count 0 '(0 0 0 0 0) :start 2) 3)
+(zerop (count 0 '(0 0 0 0) :start 0 :end 0))
+(zerop (count 0 '(0 0 0 0) :start 2 :end 2))
+(zerop (count 0 '(0 0 0 0) :start 4 :end 4))
+(eql (count 0 '(0 0 0 0) :start 2 :end 3) 1)
+(eql (count #\a "abcABC" :test #'equalp) 2)
+(eql (count #\a "abcABC" :test #'char-equal) 2)
+(eql (count '(a) '((x) (y) (z) (a) (b) (c)) :test #'equalp) 1)
+(eql (count #\a "abcABC" :test-not (complement #'equalp)) 2)
+(eql (count #\a "abcABC" :test-not (complement #'char-equal)) 2)
+(eql (count '(a) '((x) (y) (z) (a) (b) (c)) :test-not (complement #'equalp)) 1)
+(eql (count 'a '((x) (y) (z) (a) (b) (c)) :key #'car :test #'eq) 1)
+(eql (count 'nil '((x . x) (y) (z . z) (a) (b . b) (c)) :key #'cdr :test #'eq)
+ 3)
+(let ((list nil))
+ (and (eql (count 'a '(a b c d)
+ :test #'(lambda (a b) (setq list (cons b list)) (eq a b)))
+ 1)
+ (equal list '(d c b a))))
+
+(let ((list nil))
+ (and (eql (count 'a '(a b c d)
+ :test #'(lambda (a b) (setq list (cons b list)) (eq a b))
+ :from-end t)
+ 1)
+ (equal list '(a b c d))))
+
+
+(zerop (count 9 #(0 1 2 3 4)))
+(zerop (count 'a #(0 1 2 3 4)))
+(eql (count 0 #(0 0 0 0 0) :start 1) 4)
+(eql (count 0 #(0 0 0 0 0) :start 1 :end nil) 4)
+(eql (count 0 #(0 0 0 0 0) :start 2) 3)
+(zerop (count 0 #(0 0 0 0) :start 0 :end 0))
+(zerop (count 0 #(0 0 0 0) :start 2 :end 2))
+(zerop (count 0 #(0 0 0 0) :start 4 :end 4))
+(eql (count 0 #(0 0 0 0) :start 2 :end 3) 1)
+(eql (count '(a) #((x) (y) (z) (a) (b) (c)) :test #'equalp) 1)
+(eql (count '(a) #((x) (y) (z) (a) (b) (c)) :test-not (complement #'equalp)) 1)
+(eql (count 'a #((x) (y) (z) (a) (b) (c)) :key #'car :test #'eq) 1)
+(eql (count 'nil #((x . x) (y) (z . z) (a) (b . b) (c)) :key #'cdr :test #'eq)
+ 3)
+(let ((list nil))
+ (and (eql (count 'a #(a b c d)
+ :test #'(lambda (a b) (setq list (cons b list)) (eq a b)))
+ 1)
+ (equal list '(d c b a))))
+
+(let ((list nil))
+ (and (eql (count 'a #(a b c d)
+ :test #'(lambda (a b) (setq list (cons b list)) (eq a b))
+ :from-end t)
+ 1)
+ (equal list '(a b c d))))
+
+
+(eql (count-if #'null '(t nil t nil t nil)) 3)
+(zerop (count-if #'(lambda (x) (eql x 9)) #(0 1 2 3 4)))
+(zerop (count-if #'(lambda (a) (eq 'x a)) #(0 1 2 3 4)))
+(eql (count-if #'zerop '(0 0 0 0 0) :start 1) 4)
+(eql (count-if #'zerop '(0 0 0 0 0) :start 1 :end nil) 4)
+(eql (count-if #'zerop '(0 0 0 0 0) :start 2) 3)
+(zerop (count-if #'zerop '(0 0 0 0) :start 0 :end 0))
+(zerop (count-if #'zerop '(0 0 0 0) :start 2 :end 2))
+(zerop (count-if #'zerop '(0 0 0 0) :start 4 :end 4))
+(eql (count-if #'zerop '(0 0 0 0) :start 2 :end 3) 1)
+(eql (count-if #'(lambda (x) (equalp #\a x)) "abcABC") 2)
+(eql (count-if #'(lambda (x) (char-equal #\a x)) "abcABC") 2)
+(eql (count-if #'(lambda (x) (equal x '(a)))
+ '((x) (y) (z) (a) (b) (c))) 1)
+(eql (count-if #'(lambda (x) (eq x 'a))
+ '((x) (y) (z) (a) (b) (c)) :key #'car)
+ 1)
+(eql (count-if 'null '((x . x) (y) (z . z) (a) (b . b) (c)) :key #'cdr)
+ 3)
+(eql (count-if #'(lambda (x) (equal x '(a)))
+ '((x) (y) (z) (a) (b) (c)))
+ 1)
+(eql (count-if #'(lambda (x) (eq x 'a)) '((x) (y) (z) (a) (b) (c)) :key #'car)
+ 1)
+(eql (count-if #'null '((x . x) (y) (z . z) (a) (b . b) (c)) :key #'cdr)
+ 3)
+(let ((list nil))
+ (and (eql (count-if #'(lambda (x) (setq list (cons x list)) (eq x 'a))
+ '(a b c d))
+ 1)
+ (equal list '(d c b a))))
+(let ((list nil))
+ (and (eql (count-if #'(lambda (x) (setq list (cons x list)) (eq x 'a))
+ '(a b c d)
+ :from-end t)
+ 1)
+ (equal list '(a b c d))))
+(eql (count-if #'null #(t nil t nil t nil)) 3)
+(eql (count-if #'zerop #(0 0 0 0 0) :start 1) 4)
+(eql (count-if #'zerop #(0 0 0 0 0) :start 1 :end nil) 4)
+(eql (count-if #'zerop #(0 0 0 0 0) :start 2) 3)
+(zerop (count-if #'zerop #(0 0 0 0) :start 0 :end 0))
+(zerop (count-if #'zerop #(0 0 0 0) :start 2 :end 2))
+(zerop (count-if #'zerop #(0 0 0 0) :start 4 :end 4))
+(eql (count-if #'zerop #(0 0 0 0) :start 2 :end 3) 1)
+(eql (count-if #'(lambda (x) (equal x '(a)))
+ #((x) (y) (z) (a) (b) (c))) 1)
+(eql (count-if #'(lambda (x) (eq x 'a))
+ #((x) (y) (z) (a) (b) (c)) :key #'car)
+ 1)
+(eql (count-if #'null #((x . x) (y) (z . z) (a) (b . b) (c)) :key #'cdr)
+ 3)
+(eql (count-if #'(lambda (x) (equal x '(a)))
+ #((x) (y) (z) (a) (b) (c)))
+ 1)
+(eql (count-if #'(lambda (x) (eq x 'a)) #((x) (y) (z) (a) (b) (c)) :key #'car)
+ 1)
+(eql (count-if #'null #((x . x) (y) (z . z) (a) (b . b) (c)) :key #'cdr)
+ 3)
+(let ((list nil))
+ (and (eql (count-if #'(lambda (x) (setq list (cons x list)) (eq x 'a))
+ #(a b c d))
+ 1)
+ (equal list '(d c b a))))
+(let ((list nil))
+ (and (eql (count-if #'(lambda (x) (setq list (cons x list)) (eq x 'a))
+ #(a b c d)
+ :from-end t)
+ 1)
+ (equal list '(a b c d))))
+
+
+
+(eql (count-if-not (complement #'null) '(t nil t nil t nil)) 3)
+(zerop (count-if-not #'(lambda (x) (not (eql x 9))) #(0 1 2 3 4)))
+(zerop (count-if-not #'(lambda (a) (not (eq 'x a))) #(0 1 2 3 4)))
+(eql (count-if-not (complement #'zerop) '(0 0 0 0 0) :start 1) 4)
+(eql (count-if-not (complement #'zerop) '(0 0 0 0 0) :start 1 :end nil) 4)
+(eql (count-if-not (complement #'zerop) '(0 0 0 0 0) :start 2) 3)
+(zerop (count-if-not (complement #'zerop) '(0 0 0 0) :start 0 :end 0))
+(zerop (count-if-not (complement #'zerop) '(0 0 0 0) :start 2 :end 2))
+(zerop (count-if-not (complement #'zerop) '(0 0 0 0) :start 4 :end 4))
+(eql (count-if-not (complement #'zerop) '(0 0 0 0) :start 2 :end 3) 1)
+(eql (count-if-not #'(lambda (x) (not (equalp #\a x))) "abcABC") 2)
+(eql (count-if-not #'(lambda (x) (not (char-equal #\a x))) "abcABC") 2)
+(eql (count-if-not #'(lambda (x) (not (equal x '(a))))
+ '((x) (y) (z) (a) (b) (c))) 1)
+(eql (count-if-not #'(lambda (x) (not (eq x 'a)))
+ '((x) (y) (z) (a) (b) (c)) :key #'car)
+ 1)
+(eql (count-if-not (complement #'null)
+ '((x . x) (y) (z . z) (a) (b . b) (c)) :key #'cdr)
+ 3)
+(eql (count-if-not #'(lambda (x) (not (equal x '(a))))
+ '((x) (y) (z) (a) (b) (c)))
+ 1)
+(eql (count-if-not #'(lambda (x) (not (eq x 'a)))
+ '((x) (y) (z) (a) (b) (c)) :key #'car)
+ 1)
+(eql (count-if-not (complement #'null)
+ '((x . x) (y) (z . z) (a) (b . b) (c)) :key #'cdr)
+ 3)
+(let ((list nil))
+ (and (eql (count-if-not #'(lambda (x)
+ (setq list (cons x list))
+ (not (eq x 'a)))
+ '(a b c d))
+ 1)
+ (equal list '(d c b a))))
+(let ((list nil))
+ (and (eql (count-if-not #'(lambda (x)
+ (setq list (cons x list))
+ (not (eq x 'a)))
+ '(a b c d)
+ :from-end t)
+ 1)
+ (equal list '(a b c d))))
+(eql (count-if-not (complement #'null) #(t nil t nil t nil)) 3)
+(eql (count-if-not (complement #'zerop) #(0 0 0 0 0) :start 1) 4)
+(eql (count-if-not (complement #'zerop) #(0 0 0 0 0) :start 1 :end nil) 4)
+(eql (count-if-not (complement #'zerop) #(0 0 0 0 0) :start 2) 3)
+(zerop (count-if-not (complement #'zerop) #(0 0 0 0) :start 0 :end 0))
+(zerop (count-if-not (complement #'zerop) #(0 0 0 0) :start 2 :end 2))
+(zerop (count-if-not (complement #'zerop) #(0 0 0 0) :start 4 :end 4))
+(eql (count-if-not (complement #'zerop) #(0 0 0 0) :start 2 :end 3) 1)
+(eql (count-if-not #'(lambda (x) (not (equal x '(a))))
+ #((x) (y) (z) (a) (b) (c))) 1)
+(eql (count-if-not #'(lambda (x) (not (eq x 'a)))
+ #((x) (y) (z) (a) (b) (c)) :key #'car)
+ 1)
+(eql (count-if-not (complement #'null)
+ #((x . x) (y) (z . z) (a) (b . b) (c)) :key #'cdr)
+ 3)
+(eql (count-if-not #'(lambda (x) (not (equal x '(a))))
+ #((x) (y) (z) (a) (b) (c)))
+ 1)
+(eql (count-if-not #'(lambda (x) (not (eq x 'a)))
+ #((x) (y) (z) (a) (b) (c)) :key #'car)
+ 1)
+(eql (count-if-not (complement #'null)
+ #((x . x) (y) (z . z) (a) (b . b) (c)) :key #'cdr)
+ 3)
+(let ((list nil))
+ (and (eql (count-if-not #'(lambda (x)
+ (setq list (cons x list))
+ (not (eq x 'a)))
+ #(a b c d))
+ 1)
+ (equal list '(d c b a))))
+(let ((list nil))
+ (and (eql (count-if-not #'(lambda (x)
+ (setq list (cons x list))
+ (not (eq x 'a)))
+ #(a b c d)
+ :from-end t)
+ 1)
+ (equal list '(a b c d))))
+
+
+(null (reverse nil))
+(string= (reverse "") "")
+(equalp (reverse #*) #*)
+(equalp (reverse #()) #())
+(equal (reverse '(0 1 2 3)) '(3 2 1 0))
+(string= (reverse "0123") "3210")
+(equalp (reverse #*1100) #*0011)
+(equalp (reverse #(a b c d)) #(d c b a))
+
+(null (nreverse nil))
+(string= (nreverse (copy-seq "")) "")
+(equalp (nreverse (copy-seq #*)) #*)
+(equalp (nreverse (copy-seq #())) #())
+(equal (nreverse (list 0 1 2 3)) '(3 2 1 0))
+(string= (nreverse (copy-seq "0123")) "3210")
+(equalp (reverse (copy-seq #*1100)) #*0011)
+(equalp (reverse (copy-seq #(a b c d))) #(d c b a))
+
+
+
+(char= (find #\d "edcba" :test #'char>) #\c)
+(eql (find-if #'oddp '(1 2 3 4 5) :end 3 :from-end t) 3)
+(null (find-if-not #'complexp
+ '#(3.5 2 #C(1.0 0.0) #C(0.0 1.0))
+ :start 2))
+
+
+(eq (find 'a '(a b c)) 'a)
+(eq (find 'b '(a b c)) 'b)
+(eq (find 'c '(a b c)) 'c)
+(null (find 'x '(a b c)))
+(null (find 'a '(a b c) :start 1))
+(null (find 'b '(a b c) :start 2))
+(null (find 'c '(a b c) :start 3))
+(null (find 'a '(a b c) :start 0 :end 0))
+(null (find 'a '(a b c) :start 0 :end 0 :from-end t))
+(null (find 'a '(a b c) :start 1 :end 1))
+(null (find 'a '(a b c) :start 1 :end 1 :from-end t))
+(null (find 'a '(a b c) :start 2 :end 2))
+(null (find 'a '(a b c) :start 2 :end 2 :from-end t))
+(null (find 'a '(a b c) :start 3 :end 3))
+(null (find 'a '(a b c) :start 3 :end 3 :from-end t))
+(eq (find 'a '(a b c) :end nil) 'a)
+(eq (find 'b '(a b c) :end nil) 'b)
+(eq (find 'c '(a b c) :end nil) 'c)
+(eq (find 'a '(a b c) :end 1) 'a)
+(eq (find 'b '(a b c) :end 2) 'b)
+(eq (find 'c '(a b c) :end 3) 'c)
+(null (find 'a '(a b c) :end 0))
+(null (find 'b '(a b c) :end 1))
+(null (find 'c '(a b c) :end 2))
+
+(null (find 'a '((a) (b) (c))))
+(equal (find 'a '((a) (b) (c)) :key #'car) '(a))
+(equal (find 'b '((a) (b) (c)) :key #'car) '(b))
+(equal (find 'c '((a) (b) (c)) :key #'car) '(c))
+(null (find 'z '((a) (b) (c)) :key #'car))
+(let ((list '((a) (b) (c))))
+ (and (eq (find 'a list :key #'car) (car list))
+ (eq (find 'b list :key #'car) (cadr list))
+ (eq (find 'c list :key #'car) (caddr list))
+ (null (find 'z list :key #'car))))
+(null (find '(a) '((a) (b) (c))))
+(equal (find '(a) '((a) (b) (c)) :test #'equal) '(a))
+(null (find '("a") '(("a") ("b") ("c"))))
+(null (find '("a") '(("A") ("B") ("c")) :test #'equal))
+(equal (find '("a") '(("A") ("B") ("c")) :test #'equalp) '("A"))
+(eq (find 'nil '(first second third) :test (constantly t)) 'first)
+(eql (find 3 '(0 1 2 3 4 5)) 3)
+(eql (find 3 '(0 1 2 3 4 5) :test #'<) 4)
+(eql (find 3 '(0 1 2 3 4 5) :test #'>) 0)
+
+(equal (find '(a) '((a) (b) (c)) :test-not (complement #'equal)) '(a))
+(null (find '("a") '(("A") ("B") ("c")) :test-not (complement #'equal)))
+(equal (find '("a") '(("A") ("B") ("c")) :test-not (complement #'equalp))
+ '("A"))
+(eq (find 'nil '(first second third) :test-not (constantly nil)) 'first)
+(eql (find 3 '(0 1 2 3 4 5) :test-not #'>=) 4)
+(eql (find 3 '(0 1 2 3 4 5) :test-not #'<=) 0)
+
+(equal (find 'a '((a) (b) (c) (a a) (b b) (c c)) :key #'car)
+ '(a))
+(equal (find 'a '((a) (b) (c) (a a) (b b) (c c)) :key #'car :from-end t)
+ '(a a))
+(equal (find 'b '((a) (b) (c) (a a) (b b) (c c)) :key #'car)
+ '(b))
+(equal (find 'b '((a) (b) (c) (a a) (b b) (c c)) :key #'car :from-end t)
+ '(b b))
+(equal (find 'c '((a) (b) (c) (a a) (b b) (c c)) :key #'car)
+ '(c))
+(equal (find 'c '((a) (b) (c) (a a) (b b) (c c)) :key #'car :from-end t)
+ '(c c))
+(null (find 'z '((a) (b) (c) (a a) (b b) (c c)) :key #'car))
+(null (find 'z '((a) (b) (c) (a a) (b b) (c c)) :key #'car :from-end t))
+
+(equal (find 'a '((a) (b) (c) (a a) (b b) (c c) (a a a))
+ :key #'car
+ :from-end t)
+ '(a a a))
+(equal (find 'a '((a) (b) (c) (a a) (b b) (c c) (a a a))
+ :key #'car
+ :from-end t
+ :end nil)
+ '(a a a))
+(equal (find 'a '((a) (b) (c) (a a) (b b) (c c) (a a a))
+ :key #'car
+ :from-end t
+ :end 6)
+ '(a a))
+(null (find 'a '((a) (b) (c) (a a) (b b) (c c) (a a a))
+ :key #'car
+ :from-end t
+ :start 1
+ :end 3))
+(null (find #\c '("abc" "bcd" "cde")))
+(string= (find #\c '("abc" "bcd" "cde")
+ :key #'(lambda (arg) (char arg 0))
+ :test #'char=)
+ "cde")
+(string= (find #\c '("abc" "bcd" "cde")
+ :key #'(lambda (arg) (char arg 0))
+ :test #'char>)
+ "abc")
+(string= (find #\c '("abc" "bcd" "cde")
+ :start 1
+ :key #'(lambda (arg) (char arg 0))
+ :test #'char>)
+ "bcd")
+
+
+(eq (find 'a #(a b c)) 'a)
+(eq (find 'b #(a b c)) 'b)
+(eq (find 'c #(a b c)) 'c)
+(null (find 'x #(a b c)))
+(null (find 'a #(a b c) :start 1))
+(null (find 'b #(a b c) :start 2))
+(null (find 'c #(a b c) :start 3))
+(null (find 'a #(a b c) :start 0 :end 0))
+(null (find 'a #(a b c) :start 0 :end 0 :from-end t))
+(null (find 'a #(a b c) :start 1 :end 1))
+(null (find 'a #(a b c) :start 1 :end 1 :from-end t))
+(null (find 'a #(a b c) :start 2 :end 2))
+(null (find 'a #(a b c) :start 2 :end 2 :from-end t))
+(null (find 'a #(a b c) :start 3 :end 3))
+(null (find 'a #(a b c) :start 3 :end 3 :from-end t))
+(eq (find 'a #(a b c) :end nil) 'a)
+(eq (find 'b #(a b c) :end nil) 'b)
+(eq (find 'c #(a b c) :end nil) 'c)
+(eq (find 'a #(a b c) :end 1) 'a)
+(eq (find 'b #(a b c) :end 2) 'b)
+(eq (find 'c #(a b c) :end 3) 'c)
+(null (find 'a #(a b c) :end 0))
+(null (find 'b #(a b c) :end 1))
+(null (find 'c #(a b c) :end 2))
+(null (find 'a #((a) (b) (c))))
+(equal (find 'a #((a) (b) (c)) :key #'car) '(a))
+(equal (find 'b #((a) (b) (c)) :key #'car) '(b))
+(equal (find 'c #((a) (b) (c)) :key #'car) '(c))
+(null (find 'z #((a) (b) (c)) :key #'car))
+(let ((vector #((a) (b) (c))))
+ (and (eq (find 'a vector :key #'car) (aref vector 0))
+ (eq (find 'b vector :key #'car) (aref vector 1))
+ (eq (find 'c vector :key #'car) (aref vector 2))
+ (null (find 'z vector :key #'car))))
+(null (find '(a) #((a) (b) (c))))
+(equal (find '(a) #((a) (b) (c)) :test #'equal) '(a))
+(null (find '("a") #(("a") ("b") ("c"))))
+(null (find '("a") #(("A") ("B") ("c")) :test #'equal))
+(equal (find '("a") #(("A") ("B") ("c")) :test #'equalp) '("A"))
+(eq (find 'nil #(first second third) :test (constantly t)) 'first)
+(eql (find 3 #(0 1 2 3 4 5)) 3)
+(eql (find 3 #(0 1 2 3 4 5) :test #'<) 4)
+(eql (find 3 #(0 1 2 3 4 5) :test #'>) 0)
+(equal (find '(a) #((a) (b) (c)) :test-not (complement #'equal)) '(a))
+(null (find '("a") #(("A") ("B") ("c")) :test-not (complement #'equal)))
+(equal (find '("a") #(("A") ("B") ("c")) :test-not (complement #'equalp))
+ '("A"))
+(eq (find 'nil #(first second third) :test-not (constantly nil)) 'first)
+(eql (find 3 #(0 1 2 3 4 5) :test-not #'>=) 4)
+(eql (find 3 #(0 1 2 3 4 5) :test-not #'<=) 0)
+(equal (find 'a #((a) (b) (c) (a a) (b b) (c c)) :key #'car)
+ '(a))
+(equal (find 'a #((a) (b) (c) (a a) (b b) (c c)) :key #'car :from-end t)
+ '(a a))
+(equal (find 'b #((a) (b) (c) (a a) (b b) (c c)) :key #'car)
+ '(b))
+(equal (find 'b #((a) (b) (c) (a a) (b b) (c c)) :key #'car :from-end t)
+ '(b b))
+(equal (find 'c #((a) (b) (c) (a a) (b b) (c c)) :key #'car)
+ '(c))
+(equal (find 'c #((a) (b) (c) (a a) (b b) (c c)) :key #'car :from-end t)
+ '(c c))
+(null (find 'z #((a) (b) (c) (a a) (b b) (c c)) :key #'car))
+(null (find 'z #((a) (b) (c) (a a) (b b) (c c)) :key #'car :from-end t))
+
+(equal (find 'a #((a) (b) (c) (a a) (b b) (c c) (a a a))
+ :key #'car
+ :from-end t)
+ '(a a a))
+(equal (find 'a #((a) (b) (c) (a a) (b b) (c c) (a a a))
+ :key #'car
+ :from-end t
+ :end nil)
+ '(a a a))
+(equal (find 'a #((a) (b) (c) (a a) (b b) (c c) (a a a))
+ :key #'car
+ :from-end t
+ :end 6)
+ '(a a))
+(null (find 'a #((a) (b) (c) (a a) (b b) (c c) (a a a))
+ :key #'car
+ :from-end t
+ :start 1
+ :end 3))
+(null (find #\c #("abc" "bcd" "cde")))
+(string= (find #\c #("abc" "bcd" "cde")
+ :key #'(lambda (arg) (char arg 0))
+ :test #'char=)
+ "cde")
+(string= (find #\c #("abc" "bcd" "cde")
+ :key #'(lambda (arg) (char arg 0))
+ :test #'char>)
+ "abc")
+(string= (find #\c #("abc" "bcd" "cde")
+ :start 1
+ :key #'(lambda (arg) (char arg 0))
+ :test #'char>)
+ "bcd")
+(null (find #\z "abcABC"))
+(eql (find #\a "abcABC") #\a)
+(eql (find #\A "abcABC") #\A)
+(eql (find #\A "abcABC" :test #'char-equal) #\a)
+(eql (find #\A "abcABC" :test #'char-equal :from-end t) #\A)
+(eql (find #\a "abcABC" :test #'char-equal :from-end t) #\A)
+(eql (find #\a "abcABC" :test #'char-equal :from-end t :end 4) #\A)
+(eql (find #\a "abcABC" :test #'char-equal :from-end t :end 3) #\a)
+(zerop (find 0 #*01))
+(eql (find 1 #*01) 1)
+(null (find 0 #*01 :start 1))
+(null (find 1 #*01 :end 0))
+(null (find 0 #*000001 :start 5))
+
+
+
+(eq (find-if #'(lambda (x) (eq x 'a)) '(a b c)) 'a)
+(eq (find-if #'(lambda (x) (eq x 'b)) '(a b c)) 'b)
+(eq (find-if #'(lambda (x) (eq x 'c)) '(a b c)) 'c)
+(null (find-if #'(lambda (arg) (eq arg 'x)) '(a b c)))
+(null (find-if #'(lambda (x) (eq x 'a)) '(a b c) :start 1))
+(null (find-if #'(lambda (x) (eq x 'b)) '(a b c) :start 2))
+(null (find-if #'(lambda (x) (eq x 'c)) '(a b c) :start 3))
+(null (find-if #'(lambda (x) (eq x 'a)) '(a b c) :start 0 :end 0))
+(null (find-if #'(lambda (x) (eq x 'a)) '(a b c) :start 0 :end 0 :from-end t))
+(null (find-if #'(lambda (x) (eq x 'a)) '(a b c) :start 1 :end 1))
+(null (find-if #'(lambda (x) (eq x 'a)) '(a b c) :start 1 :end 1 :from-end t))
+(null (find-if #'(lambda (x) (eq x 'a)) '(a b c) :start 2 :end 2))
+(null (find-if #'(lambda (x) (eq x 'a)) '(a b c) :start 2 :end 2 :from-end t))
+(null (find-if #'(lambda (x) (eq x 'a)) '(a b c) :start 3 :end 3))
+(null (find-if #'(lambda (x) (eq x 'a)) '(a b c) :start 3 :end 3 :from-end t))
+(eq (find-if #'(lambda (x) (eq x 'a)) '(a b c) :end nil) 'a)
+(eq (find-if #'(lambda (x) (eq x 'b)) '(a b c) :end nil) 'b)
+(eq (find-if #'(lambda (x) (eq x 'c)) '(a b c) :end nil) 'c)
+(eq (find-if #'(lambda (x) (eq x 'a)) '(a b c) :end 1) 'a)
+(eq (find-if #'(lambda (x) (eq x 'b)) '(a b c) :end 2) 'b)
+(eq (find-if #'(lambda (x) (eq x 'c)) '(a b c) :end 3) 'c)
+(null (find-if #'(lambda (x) (eq x 'a)) '(a b c) :end 0))
+(null (find-if #'(lambda (x) (eq x 'b)) '(a b c) :end 1))
+(null (find-if #'(lambda (x) (eq x 'c)) '(a b c) :end 2))
+(null (find-if #'(lambda (x) (eq x 'a)) '((a) (b) (c))))
+(equal (find-if #'(lambda (x) (eq x 'a)) '((a) (b) (c)) :key #'car) '(a))
+(equal (find-if #'(lambda (x) (eq x 'b)) '((a) (b) (c)) :key #'car) '(b))
+(equal (find-if #'(lambda (x) (eq x 'c)) '((a) (b) (c)) :key #'car) '(c))
+(null (find-if #'(lambda (x) (eq x 'z)) '((a) (b) (c)) :key #'car))
+(let ((list '((a) (b) (c))))
+ (and (eq (find-if #'(lambda (x) (eq x 'a)) list :key #'car) (car list))
+ (eq (find-if #'(lambda (x) (eq x 'b)) list :key #'car) (cadr list))
+ (eq (find-if #'(lambda (x) (eq x 'c)) list :key #'car) (caddr list))
+ (null (find-if #'(lambda (x) (eq x 'z)) list :key #'car))))
+(equal (find-if #'(lambda (x) (eq x 'a))
+ '((a) (b) (c) (a a) (b b) (c c)) :key #'car)
+ '(a))
+(equal (find-if #'(lambda (x) (eq x 'a))
+ '((a) (b) (c) (a a) (b b) (c c)) :key #'car :from-end t)
+ '(a a))
+(equal (find-if #'(lambda (x) (eq x 'b))
+ '((a) (b) (c) (a a) (b b) (c c)) :key #'car)
+ '(b))
+(equal (find-if #'(lambda (x) (eq x 'b))
+ '((a) (b) (c) (a a) (b b) (c c)) :key #'car :from-end t)
+ '(b b))
+(equal (find-if #'(lambda (x) (eq x 'c))
+ '((a) (b) (c) (a a) (b b) (c c)) :key #'car)
+ '(c))
+(equal (find-if #'(lambda (x) (eq x 'c))
+ '((a) (b) (c) (a a) (b b) (c c)) :key #'car :from-end t)
+ '(c c))
+(null (find-if #'(lambda (x) (eq x 'z))
+ '((a) (b) (c) (a a) (b b) (c c)) :key #'car))
+(null (find-if #'(lambda (x) (eq x 'z))
+ '((a) (b) (c) (a a) (b b) (c c)) :key #'car :from-end t))
+(equal (find-if #'(lambda (x) (eq x 'a))
+ '((a) (b) (c) (a a) (b b) (c c) (a a a))
+ :key #'car
+ :from-end t)
+ '(a a a))
+(equal (find-if #'(lambda (x) (eq x 'a))
+ '((a) (b) (c) (a a) (b b) (c c) (a a a))
+ :key #'car
+ :from-end t
+ :end nil)
+ '(a a a))
+(equal (find-if #'(lambda (x) (eq x 'a))
+ '((a) (b) (c) (a a) (b b) (c c) (a a a))
+ :key #'car
+ :from-end t
+ :end 6)
+ '(a a))
+(null (find-if #'(lambda (x) (eq x 'a))
+ '((a) (b) (c) (a a) (b b) (c c) (a a a))
+ :key #'car
+ :from-end t
+ :start 1
+ :end 3))
+(null (find-if #'(lambda (x) (eql x #\c)) '("abc" "bcd" "cde")))
+(string= (find-if #'(lambda (x) (eql x #\c)) '("abc" "bcd" "cde")
+ :key #'(lambda (arg) (char arg 0)))
+ "cde")
+(string= (find-if #'(lambda (x) (char> #\c x)) '("abc" "bcd" "cde")
+ :key #'(lambda (arg) (char arg 0)))
+ "abc")
+(string= (find-if #'(lambda (x) (char> #\c x)) '("abc" "bcd" "cde")
+ :start 1
+ :key #'(lambda (arg) (char arg 0)))
+ "bcd")
+
+
+(eq (find-if #'(lambda (x) (eq x 'a)) #(a b c)) 'a)
+(eq (find-if #'(lambda (x) (eq x 'b)) #(a b c)) 'b)
+(eq (find-if #'(lambda (x) (eq x 'c)) #(a b c)) 'c)
+(null (find-if #'(lambda (arg) (eq arg 'x)) #(a b c)))
+(null (find-if #'(lambda (x) (eq x 'a)) #(a b c) :start 1))
+(null (find-if #'(lambda (x) (eq x 'b)) #(a b c) :start 2))
+(null (find-if #'(lambda (x) (eq x 'c)) #(a b c) :start 3))
+(null (find-if #'(lambda (x) (eq x 'a)) #(a b c) :start 0 :end 0))
+(null (find-if #'(lambda (x) (eq x 'a)) #(a b c) :start 0 :end 0 :from-end t))
+(null (find-if #'(lambda (x) (eq x 'a)) #(a b c) :start 1 :end 1))
+(null (find-if #'(lambda (x) (eq x 'a)) #(a b c) :start 1 :end 1 :from-end t))
+(null (find-if #'(lambda (x) (eq x 'a)) #(a b c) :start 2 :end 2))
+(null (find-if #'(lambda (x) (eq x 'a)) #(a b c) :start 2 :end 2 :from-end t))
+(null (find-if #'(lambda (x) (eq x 'a)) #(a b c) :start 3 :end 3))
+(null (find-if #'(lambda (x) (eq x 'a)) #(a b c) :start 3 :end 3 :from-end t))
+(eq (find-if #'(lambda (x) (eq x 'a)) #(a b c) :end nil) 'a)
+(eq (find-if #'(lambda (x) (eq x 'b)) #(a b c) :end nil) 'b)
+(eq (find-if #'(lambda (x) (eq x 'c)) #(a b c) :end nil) 'c)
+(eq (find-if #'(lambda (x) (eq x 'a)) #(a b c) :end 1) 'a)
+(eq (find-if #'(lambda (x) (eq x 'b)) #(a b c) :end 2) 'b)
+(eq (find-if #'(lambda (x) (eq x 'c)) #(a b c) :end 3) 'c)
+(null (find-if #'(lambda (x) (eq x 'a)) #(a b c) :end 0))
+(null (find-if #'(lambda (x) (eq x 'b)) #(a b c) :end 1))
+(null (find-if #'(lambda (x) (eq x 'c)) #(a b c) :end 2))
+(null (find-if #'(lambda (x) (eq x 'a)) #((a) (b) (c))))
+(equal (find-if #'(lambda (x) (eq x 'a)) #((a) (b) (c)) :key #'car) '(a))
+(equal (find-if #'(lambda (x) (eq x 'b)) #((a) (b) (c)) :key #'car) '(b))
+(equal (find-if #'(lambda (x) (eq x 'c)) #((a) (b) (c)) :key #'car) '(c))
+(null (find-if #'(lambda (x) (eq x 'z)) #((a) (b) (c)) :key #'car))
+(let ((vector #((a) (b) (c))))
+ (and (eq (find-if #'(lambda (x) (eq x 'a)) vector :key #'car) (aref vector 0))
+ (eq (find-if #'(lambda (x) (eq x 'b)) vector :key #'car) (aref vector 1))
+ (eq (find-if #'(lambda (x) (eq x 'c)) vector :key #'car) (aref vector 2))
+ (null (find-if #'(lambda (x) (eq x 'z)) vector :key #'car))))
+(equal (find-if #'(lambda (x) (eq x 'a))
+ #((a) (b) (c) (a a) (b b) (c c)) :key #'car)
+ '(a))
+(equal (find-if #'(lambda (x) (eq x 'a))
+ #((a) (b) (c) (a a) (b b) (c c)) :key #'car :from-end t)
+ '(a a))
+(equal (find-if #'(lambda (x) (eq x 'b))
+ #((a) (b) (c) (a a) (b b) (c c)) :key #'car)
+ '(b))
+(equal (find-if #'(lambda (x) (eq x 'b))
+ #((a) (b) (c) (a a) (b b) (c c)) :key #'car :from-end t)
+ '(b b))
+(equal (find-if #'(lambda (x) (eq x 'c))
+ #((a) (b) (c) (a a) (b b) (c c)) :key #'car)
+ '(c))
+(equal (find-if #'(lambda (x) (eq x 'c))
+ #((a) (b) (c) (a a) (b b) (c c)) :key #'car :from-end t)
+ '(c c))
+(null (find-if #'(lambda (x) (eq x 'z))
+ #((a) (b) (c) (a a) (b b) (c c)) :key #'car))
+(null (find-if #'(lambda (x) (eq x 'z))
+ #((a) (b) (c) (a a) (b b) (c c)) :key #'car :from-end t))
+(equal (find-if #'(lambda (x) (eq x 'a))
+ #((a) (b) (c) (a a) (b b) (c c) (a a a))
+ :key #'car
+ :from-end t)
+ '(a a a))
+(equal (find-if #'(lambda (x) (eq x 'a))
+ #((a) (b) (c) (a a) (b b) (c c) (a a a))
+ :key #'car
+ :from-end t
+ :end nil)
+ '(a a a))
+(equal (find-if #'(lambda (x) (eq x 'a))
+ #((a) (b) (c) (a a) (b b) (c c) (a a a))
+ :key #'car
+ :from-end t
+ :end 6)
+ '(a a))
+(null (find-if #'(lambda (x) (eq x 'a))
+ #((a) (b) (c) (a a) (b b) (c c) (a a a))
+ :key #'car
+ :from-end t
+ :start 1
+ :end 3))
+(null (find-if #'(lambda (x) (eql x #\c)) #("abc" "bcd" "cde")))
+(string= (find-if #'(lambda (x) (eql x #\c)) #("abc" "bcd" "cde")
+ :key #'(lambda (arg) (char arg 0)))
+ "cde")
+(string= (find-if #'(lambda (x) (char> #\c x)) #("abc" "bcd" "cde")
+ :key #'(lambda (arg) (char arg 0)))
+ "abc")
+(string= (find-if #'(lambda (x) (char> #\c x)) #("abc" "bcd" "cde")
+ :start 1
+ :key #'(lambda (arg) (char arg 0)))
+ "bcd")
+
+
+(eq (find-if-not #'(lambda (x) (not (eq x 'a))) '(a b c)) 'a)
+(eq (find-if-not #'(lambda (x) (not (eq x 'b))) '(a b c)) 'b)
+(eq (find-if-not #'(lambda (x) (not (eq x 'c))) '(a b c)) 'c)
+(null (find-if-not #'(lambda (arg) (not (eq arg 'x))) '(a b c)))
+(null (find-if-not #'(lambda (x) (not (eq x 'a))) '(a b c) :start 1))
+(null (find-if-not #'(lambda (x) (not (eq x 'b))) '(a b c) :start 2))
+(null (find-if-not #'(lambda (x) (not (eq x 'c))) '(a b c) :start 3))
+(null (find-if-not #'(lambda (x) (not (eq x 'a))) '(a b c) :start 0 :end 0))
+(null (find-if-not #'(lambda (x) (not (eq x 'a))) '(a b c)
+ :start 0 :end 0 :from-end t))
+(null (find-if-not #'(lambda (x) (not (eq x 'a))) '(a b c) :start 1 :end 1))
+(null (find-if-not #'(lambda (x) (not (eq x 'a))) '(a b c)
+ :start 1 :end 1 :from-end t))
+(null (find-if-not #'(lambda (x) (not (eq x 'a))) '(a b c) :start 2 :end 2))
+(null (find-if-not #'(lambda (x) (not (eq x 'a))) '(a b c)
+ :start 2 :end 2 :from-end t))
+(null (find-if-not #'(lambda (x) (not (eq x 'a))) '(a b c) :start 3 :end 3))
+(null (find-if-not #'(lambda (x) (not (eq x 'a))) '(a b c)
+ :start 3 :end 3 :from-end t))
+(eq (find-if-not #'(lambda (x) (not (eq x 'a))) '(a b c) :end nil) 'a)
+(eq (find-if-not #'(lambda (x) (not (eq x 'b))) '(a b c) :end nil) 'b)
+(eq (find-if-not #'(lambda (x) (not (eq x 'c))) '(a b c) :end nil) 'c)
+(eq (find-if-not #'(lambda (x) (not (eq x 'a))) '(a b c) :end 1) 'a)
+(eq (find-if-not #'(lambda (x) (not (eq x 'b))) '(a b c) :end 2) 'b)
+(eq (find-if-not #'(lambda (x) (not (eq x 'c))) '(a b c) :end 3) 'c)
+(null (find-if-not #'(lambda (x) (not (eq x 'a))) '(a b c) :end 0))
+(null (find-if-not #'(lambda (x) (not (eq x 'b))) '(a b c) :end 1))
+(null (find-if-not #'(lambda (x) (not (eq x 'c))) '(a b c) :end 2))
+(null (find-if-not #'(lambda (x) (not (eq x 'a))) '((a) (b) (c))))
+(equal (find-if-not #'(lambda (x) (not (eq x 'a))) '((a) (b) (c)) :key #'car)
+ '(a))
+(equal (find-if-not #'(lambda (x) (not (eq x 'b))) '((a) (b) (c)) :key #'car)
+ '(b))
+(equal (find-if-not #'(lambda (x) (not (eq x 'c))) '((a) (b) (c)) :key #'car)
+ '(c))
+(null (find-if-not #'(lambda (x) (not (eq x 'z))) '((a) (b) (c)) :key #'car))
+(let ((list '((a) (b) (c))))
+ (and (eq (find-if-not #'(lambda (x) (not (eq x 'a))) list :key #'car)
+ (car list))
+ (eq (find-if-not #'(lambda (x) (not (eq x 'b))) list :key #'car)
+ (cadr list))
+ (eq (find-if-not #'(lambda (x) (not (eq x 'c))) list :key #'car)
+ (caddr list))
+ (null (find-if-not #'(lambda (x) (not (eq x 'z))) list :key #'car))))
+(equal (find-if-not #'(lambda (x) (not (eq x 'a)))
+ '((a) (b) (c) (a a) (b b) (c c)) :key #'car)
+ '(a))
+(equal (find-if-not #'(lambda (x) (not (eq x 'a)))
+ '((a) (b) (c) (a a) (b b) (c c)) :key #'car :from-end t)
+ '(a a))
+(equal (find-if-not #'(lambda (x) (not (eq x 'b)))
+ '((a) (b) (c) (a a) (b b) (c c)) :key #'car)
+ '(b))
+(equal (find-if-not #'(lambda (x) (not (eq x 'b)))
+ '((a) (b) (c) (a a) (b b) (c c)) :key #'car :from-end t)
+ '(b b))
+(equal (find-if-not #'(lambda (x) (not (eq x 'c)))
+ '((a) (b) (c) (a a) (b b) (c c)) :key #'car)
+ '(c))
+(equal (find-if-not #'(lambda (x) (not (eq x 'c)))
+ '((a) (b) (c) (a a) (b b) (c c)) :key #'car :from-end t)
+ '(c c))
+(null (find-if-not #'(lambda (x) (not (eq x 'z)))
+ '((a) (b) (c) (a a) (b b) (c c)) :key #'car))
+(null (find-if-not #'(lambda (x) (not (eq x 'z)))
+ '((a) (b) (c) (a a) (b b) (c c)) :key #'car :from-end t))
+(equal (find-if-not #'(lambda (x) (not (eq x 'a)))
+ '((a) (b) (c) (a a) (b b) (c c) (a a a))
+ :key #'car
+ :from-end t)
+ '(a a a))
+(equal (find-if-not #'(lambda (x) (not (eq x 'a)))
+ '((a) (b) (c) (a a) (b b) (c c) (a a a))
+ :key #'car
+ :from-end t
+ :end nil)
+ '(a a a))
+(equal (find-if-not #'(lambda (x) (not (eq x 'a)))
+ '((a) (b) (c) (a a) (b b) (c c) (a a a))
+ :key #'car
+ :from-end t
+ :end 6)
+ '(a a))
+(null (find-if-not #'(lambda (x) (not (eq x 'a)))
+ '((a) (b) (c) (a a) (b b) (c c) (a a a))
+ :key #'car
+ :from-end t
+ :start 1
+ :end 3))
+(null (find-if-not #'(lambda (x) (not (eql x #\c))) '("abc" "bcd" "cde")))
+(string= (find-if-not #'(lambda (x) (not (eql x #\c))) '("abc" "bcd" "cde")
+ :key #'(lambda (arg) (char arg 0)))
+ "cde")
+(string= (find-if-not #'(lambda (x) (not (char> #\c x))) '("abc" "bcd" "cde")
+ :key #'(lambda (arg) (char arg 0)))
+ "abc")
+(string= (find-if-not #'(lambda (x) (not (char> #\c x))) '("abc" "bcd" "cde")
+ :start 1
+ :key #'(lambda (arg) (char arg 0)))
+ "bcd")
+
+(eq (find-if-not #'(lambda (x) (not (eq x 'a))) #(a b c)) 'a)
+(eq (find-if-not #'(lambda (x) (not (eq x 'b))) #(a b c)) 'b)
+(eq (find-if-not #'(lambda (x) (not (eq x 'c))) #(a b c)) 'c)
+(null (find-if-not #'(lambda (arg) (not (eq arg 'x))) #(a b c)))
+(null (find-if-not #'(lambda (x) (not (eq x 'a))) #(a b c) :start 1))
+(null (find-if-not #'(lambda (x) (not (eq x 'b))) #(a b c) :start 2))
+(null (find-if-not #'(lambda (x) (not (eq x 'c))) #(a b c) :start 3))
+(null (find-if-not #'(lambda (x) (not (eq x 'a))) #(a b c) :start 0 :end 0))
+(null (find-if-not #'(lambda (x) (not (eq x 'a))) #(a b c) :start 0 :end 0
+ :from-end t))
+(null (find-if-not #'(lambda (x) (not (eq x 'a))) #(a b c) :start 1 :end 1))
+(null (find-if-not #'(lambda (x) (not (eq x 'a))) #(a b c) :start 1 :end 1
+ :from-end t))
+(null (find-if-not #'(lambda (x) (not (eq x 'a))) #(a b c) :start 2 :end 2))
+(null (find-if-not #'(lambda (x) (not (eq x 'a))) #(a b c) :start 2 :end 2
+ :from-end t))
+(null (find-if-not #'(lambda (x) (not (eq x 'a))) #(a b c) :start 3 :end 3))
+(null (find-if-not #'(lambda (x) (not (eq x 'a))) #(a b c) :start 3 :end 3
+ :from-end t))
+(eq (find-if-not #'(lambda (x) (not (eq x 'a))) #(a b c) :end nil) 'a)
+(eq (find-if-not #'(lambda (x) (not (eq x 'b))) #(a b c) :end nil) 'b)
+(eq (find-if-not #'(lambda (x) (not (eq x 'c))) #(a b c) :end nil) 'c)
+(eq (find-if-not #'(lambda (x) (not (eq x 'a))) #(a b c) :end 1) 'a)
+(eq (find-if-not #'(lambda (x) (not (eq x 'b))) #(a b c) :end 2) 'b)
+(eq (find-if-not #'(lambda (x) (not (eq x 'c))) #(a b c) :end 3) 'c)
+(null (find-if-not #'(lambda (x) (not (eq x 'a))) #(a b c) :end 0))
+(null (find-if-not #'(lambda (x) (not (eq x 'b))) #(a b c) :end 1))
+(null (find-if-not #'(lambda (x) (not (eq x 'c))) #(a b c) :end 2))
+(null (find-if-not #'(lambda (x) (not (eq x 'a))) #((a) (b) (c))))
+(equal (find-if-not #'(lambda (x) (not (eq x 'a))) #((a) (b) (c)) :key #'car)
+ '(a))
+(equal (find-if-not #'(lambda (x) (not (eq x 'b))) #((a) (b) (c)) :key #'car)
+ '(b))
+(equal (find-if-not #'(lambda (x) (not (eq x 'c))) #((a) (b) (c)) :key #'car)
+ '(c))
+(null (find-if-not #'(lambda (x) (not (eq x 'z))) #((a) (b) (c)) :key #'car))
+(let ((vector #((a) (b) (c))))
+ (and (eq (find-if-not #'(lambda (x) (not (eq x 'a))) vector :key #'car)
+ (aref vector 0))
+ (eq (find-if-not #'(lambda (x) (not (eq x 'b))) vector :key #'car)
+ (aref vector 1))
+ (eq (find-if-not #'(lambda (x) (not (eq x 'c))) vector :key #'car)
+ (aref vector 2))
+ (null (find-if-not #'(lambda (x) (not (eq x 'z))) vector :key #'car))))
+(equal (find-if-not #'(lambda (x) (not (eq x 'a)))
+ #((a) (b) (c) (a a) (b b) (c c)) :key #'car)
+ '(a))
+(equal (find-if-not #'(lambda (x) (not (eq x 'a)))
+ #((a) (b) (c) (a a) (b b) (c c)) :key #'car :from-end t)
+ '(a a))
+(equal (find-if-not #'(lambda (x) (not (eq x 'b)))
+ #((a) (b) (c) (a a) (b b) (c c)) :key #'car)
+ '(b))
+(equal (find-if-not #'(lambda (x) (not (eq x 'b)))
+ #((a) (b) (c) (a a) (b b) (c c)) :key #'car :from-end t)
+ '(b b))
+(equal (find-if-not #'(lambda (x) (not (eq x 'c)))
+ #((a) (b) (c) (a a) (b b) (c c)) :key #'car)
+ '(c))
+(equal (find-if-not #'(lambda (x) (not (eq x 'c)))
+ #((a) (b) (c) (a a) (b b) (c c)) :key #'car :from-end t)
+ '(c c))
+(null (find-if-not #'(lambda (x) (not (eq x 'z)))
+ #((a) (b) (c) (a a) (b b) (c c)) :key #'car))
+(null (find-if-not #'(lambda (x) (not (eq x 'z)))
+ #((a) (b) (c) (a a) (b b) (c c)) :key #'car :from-end t))
+(equal (find-if-not #'(lambda (x) (not (eq x 'a)))
+ #((a) (b) (c) (a a) (b b) (c c) (a a a))
+ :key #'car
+ :from-end t)
+ '(a a a))
+(equal (find-if-not #'(lambda (x) (not (eq x 'a)))
+ #((a) (b) (c) (a a) (b b) (c c) (a a a))
+ :key #'car
+ :from-end t
+ :end nil)
+ '(a a a))
+(equal (find-if-not #'(lambda (x) (not (eq x 'a)))
+ #((a) (b) (c) (a a) (b b) (c c) (a a a))
+ :key #'car
+ :from-end t
+ :end 6)
+ '(a a))
+(null (find-if-not #'(lambda (x) (not (eq x 'a)))
+ #((a) (b) (c) (a a) (b b) (c c) (a a a))
+ :key #'car
+ :from-end t
+ :start 1
+ :end 3))
+(string= (find-if-not #'(lambda (x) (not (eql x #\c))) #("abc" "bcd" "cde")
+ :key #'(lambda (arg) (char arg 0)))
+ "cde")
+(string= (find-if-not #'(lambda (x) (not (char> #\c x))) #("abc" "bcd" "cde")
+ :key #'(lambda (arg) (char arg 0)))
+ "abc")
+(string= (find-if-not #'(lambda (x) (not (char> #\c x))) #("abc" "bcd" "cde")
+ :start 1
+ :key #'(lambda (arg) (char arg 0)))
+ "bcd")
+
+
+
+
+(eql (position #\a "baobab" :from-end t) 4)
+(eql (position-if #'oddp '((1) (2) (3) (4)) :start 1 :key #'car) 2)
+(null (position 595 '()))
+(eql (position-if-not #'integerp '(1 2 3 4 5.0)) 4)
+
+(eql (position 'a '(a b c)) 0)
+(eql (position 'b '(a b c)) 1)
+(eql (position 'c '(a b c)) 2)
+(null (position 'x '(a b c)))
+(null (position 'a '(a b c) :start 1))
+(null (position 'b '(a b c) :start 2))
+(null (position 'c '(a b c) :start 3))
+(null (position 'a '(a b c) :start 0 :end 0))
+(null (position 'a '(a b c) :start 0 :end 0 :from-end t))
+(null (position 'a '(a b c) :start 1 :end 1))
+(null (position 'a '(a b c) :start 1 :end 1 :from-end t))
+(null (position 'a '(a b c) :start 2 :end 2))
+(null (position 'a '(a b c) :start 2 :end 2 :from-end t))
+(null (position 'a '(a b c) :start 3 :end 3))
+(null (position 'a '(a b c) :start 3 :end 3 :from-end t))
+(eql (position 'a '(a b c) :end nil) '0)
+(eql (position 'b '(a b c) :end nil) '1)
+(eql (position 'c '(a b c) :end nil) '2)
+(eql (position 'a '(a b c) :end 1) '0)
+(eql (position 'b '(a b c) :end 2) '1)
+(eql (position 'c '(a b c) :end 3) '2)
+(null (position 'a '(a b c) :end 0))
+(null (position 'b '(a b c) :end 1))
+(null (position 'c '(a b c) :end 2))
+(null (position 'a '((a) (b) (c))))
+(eql (position 'a '((a) (b) (c)) :key #'car) 0)
+(eql (position 'b '((a) (b) (c)) :key #'car) 1)
+(eql (position 'c '((a) (b) (c)) :key #'car) 2)
+(null (position 'z '((a) (b) (c)) :key #'car))
+(null (position '(a) '((a) (b) (c))))
+(eql (position '(a) '((a) (b) (c)) :test #'equal) 0)
+(null (position '("a") '(("a") ("b") ("c"))))
+(null (position '("a") '(("A") ("B") ("c")) :test #'equal))
+(eql (position '("a") '(("A") ("B") ("c")) :test #'equalp) 0)
+(eql (position 'nil '(first second third) :test (constantly t)) 0)
+(eql (position 3 '(0 1 2 3 4 5)) 3)
+(eql (position 3 '(0 1 2 3 4 5) :test #'<) 4)
+(eql (position 3 '(0 1 2 3 4 5) :test #'>) 0)
+(eql (position '(a) '((a) (b) (c)) :test-not (complement #'equal)) 0)
+(null (position '("a") '(("A") ("B") ("c")) :test-not (complement #'equal)))
+(eql (position '("a") '(("A") ("B") ("c")) :test-not (complement #'equalp))
+ 0)
+(eql (position 'nil '(first second third) :test-not (constantly nil)) 0)
+(eql (position 3 '(0 1 2 3 4 5) :test-not #'>=) 4)
+(eql (position 3 '(0 1 2 3 4 5) :test-not #'<=) 0)
+(eql (position 'a '((a) (b) (c) (a a) (b b) (c c)) :key #'car) 0)
+(eql (position 'a '((a) (b) (c) (a a) (b b) (c c)) :key #'car :from-end t) 3)
+(eql (position 'b '((a) (b) (c) (a a) (b b) (c c)) :key #'car) 1)
+(eql (position 'b '((a) (b) (c) (a a) (b b) (c c)) :key #'car :from-end t) 4)
+(eql (position 'c '((a) (b) (c) (a a) (b b) (c c)) :key #'car) 2)
+(eql (position 'c '((a) (b) (c) (a a) (b b) (c c)) :key #'car :from-end t) 5)
+(null (position 'z '((a) (b) (c) (a a) (b b) (c c)) :key #'car))
+(null (position 'z '((a) (b) (c) (a a) (b b) (c c)) :key #'car :from-end t))
+(eql (position 'a '((a) (b) (c) (a a) (b b) (c c) (a a a))
+ :key #'car
+ :from-end t)
+ 6)
+(eql (position 'a '((a) (b) (c) (a a) (b b) (c c) (a a a))
+ :key #'car
+ :from-end t
+ :end nil)
+ 6)
+(eql (position 'a '((a) (b) (c) (a a) (b b) (c c) (a a a))
+ :key #'car
+ :from-end t
+ :end 6)
+ 3)
+(null (position 'a '((a) (b) (c) (a a) (b b) (c c) (a a a))
+ :key #'car
+ :from-end t
+ :start 1
+ :end 3))
+(null (position #\c '("abc" "bcd" "cde")))
+(eql (position #\c '("abc" "bcd" "cde")
+ :key #'(lambda (arg) (char arg 0))
+ :test #'char=)
+ 2)
+(eql (position #\c '("abc" "bcd" "cde")
+ :key #'(lambda (arg) (char arg 0))
+ :test #'char>)
+ 0)
+(eql (position #\c '("abc" "bcd" "cde")
+ :start 1
+ :key #'(lambda (arg) (char arg 0))
+ :test #'char>)
+ 1)
+(eql (position 'a #(a b c)) 0)
+(eql (position 'b #(a b c)) 1)
+(eql (position 'c #(a b c)) 2)
+(null (position 'x #(a b c)))
+(null (position 'a #(a b c) :start 1))
+(null (position 'b #(a b c) :start 2))
+(null (position 'c #(a b c) :start 3))
+(null (position 'a #(a b c) :start 0 :end 0))
+(null (position 'a #(a b c) :start 0 :end 0 :from-end t))
+(null (position 'a #(a b c) :start 1 :end 1))
+(null (position 'a #(a b c) :start 1 :end 1 :from-end t))
+(null (position 'a #(a b c) :start 2 :end 2))
+(null (position 'a #(a b c) :start 2 :end 2 :from-end t))
+(null (position 'a #(a b c) :start 3 :end 3))
+(null (position 'a #(a b c) :start 3 :end 3 :from-end t))
+(eql (position 'a #(a b c) :end nil) 0)
+(eql (position 'b #(a b c) :end nil) 1)
+(eql (position 'c #(a b c) :end nil) 2)
+(eql (position 'a #(a b c) :end 1) 0)
+(eql (position 'b #(a b c) :end 2) 1)
+(eql (position 'c #(a b c) :end 3) 2)
+(null (position 'a #(a b c) :end 0))
+(null (position 'b #(a b c) :end 1))
+(null (position 'c #(a b c) :end 2))
+(null (position 'a #((a) (b) (c))))
+(eql (position 'a #((a) (b) (c)) :key #'car) 0)
+(eql (position 'b #((a) (b) (c)) :key #'car) 1)
+(eql (position 'c #((a) (b) (c)) :key #'car) 2)
+(null (position 'z #((a) (b) (c)) :key #'car))
+(null (position '(a) #((a) (b) (c))))
+(eql (position '(a) #((a) (b) (c)) :test #'equal) 0)
+(null (position '("a") #(("a") ("b") ("c"))))
+(null (position '("a") #(("A") ("B") ("c")) :test #'equal))
+(eql (position '("a") #(("A") ("B") ("c")) :test #'equalp) 0)
+(eql (position 'nil #(first second third) :test (constantly t)) 0)
+(eql (position 'nil #(first second third) :test (constantly t) :from-end t) 2)
+(eql (position 3 #(0 1 2 3 4 5)) 3)
+(eql (position 3 #(0 1 2 3 4 5) :test #'<) 4)
+(eql (position 3 #(0 1 2 3 4 5) :test #'>) 0)
+(eql (position '(a) #((a) (b) (c)) :test-not (complement #'equal)) 0)
+(null (position '("a") #(("A") ("B") ("c")) :test-not (complement #'equal)))
+(eql (position '("a") #(("A") ("B") ("c")) :test-not (complement #'equalp))
+ 0)
+(eql (position 'nil #(first second third) :test-not (constantly nil)) 0)
+(eql (position 3 #(0 1 2 3 4 5) :test-not #'>=) 4)
+(eql (position 3 #(0 1 2 3 4 5) :test-not #'<=) 0)
+(eql (position 'a #((a) (b) (c) (a a) (b b) (c c)) :key #'car) 0)
+(eql (position 'a #((a) (b) (c) (a a) (b b) (c c)) :key #'car :from-end t) 3)
+(eql (position 'b #((a) (b) (c) (a a) (b b) (c c)) :key #'car) 1)
+(eql (position 'b #((a) (b) (c) (a a) (b b) (c c)) :key #'car :from-end t) 4)
+(eql (position 'c #((a) (b) (c) (a a) (b b) (c c)) :key #'car) 2)
+(eql (position 'c #((a) (b) (c) (a a) (b b) (c c)) :key #'car :from-end t) 5)
+(null (position 'z #((a) (b) (c) (a a) (b b) (c c)) :key #'car))
+(null (position 'z #((a) (b) (c) (a a) (b b) (c c)) :key #'car :from-end t))
+(eql (position 'a #((a) (b) (c) (a a) (b b) (c c) (a a a))
+ :key #'car
+ :from-end t)
+ 6)
+(eql (position 'a #((a) (b) (c) (a a) (b b) (c c) (a a a))
+ :key #'car
+ :from-end t
+ :end nil)
+ 6)
+(eql (position 'a #((a) (b) (c) (a a) (b b) (c c) (a a a))
+ :key #'car
+ :from-end t
+ :end 6)
+ 3)
+(null (position 'a #((a) (b) (c) (a a) (b b) (c c) (a a a))
+ :key #'car
+ :from-end t
+ :start 1
+ :end 3))
+(null (position #\c #("abc" "bcd" "cde")))
+(eql (position #\c #("abc" "bcd" "cde")
+ :key #'(lambda (arg) (char arg 0))
+ :test #'char=)
+ 2)
+(eql (position #\c #("abc" "bcd" "cde")
+ :key #'(lambda (arg) (char arg 0))
+ :test #'char>)
+ 0)
+(eql (position #\c #("abc" "bcd" "cde")
+ :start 1
+ :key #'(lambda (arg) (char arg 0))
+ :test #'char>)
+ 1)
+(null (position #\z "abcABC"))
+(eql (position #\a "abcABC") 0)
+(eql (position #\A "abcABC") 3)
+(eql (position #\A "abcABC" :test #'char-equal) 0)
+(eql (position #\A "abcABC" :test #'char-equal :from-end t) 3)
+(eql (position #\a "abcABC" :test #'char-equal :from-end t) 3)
+(eql (position #\a "abcABC" :test #'char-equal :from-end t :end 4) 3)
+(eql (position #\a "abcABC" :test #'char-equal :from-end t :end 3) 0)
+(zerop (position 0 #*01))
+(eql (position 1 #*01) 1)
+(null (position 0 #*01 :start 1))
+(null (position 1 #*01 :end 0))
+(null (position 0 #*000001 :start 5))
+
+
+(eql (position-if #'(lambda (x) (eq x 'a)) '(a b c)) 0)
+(eql (position-if #'(lambda (x) (eq x 'b)) '(a b c)) 1)
+(eql (position-if #'(lambda (x) (eq x 'c)) '(a b c)) 2)
+(null (position-if #'(lambda (arg) (eq arg 'x)) '(a b c)))
+(null (position-if #'(lambda (x) (eq x 'a)) '(a b c) :start 1))
+(null (position-if #'(lambda (x) (eq x 'b)) '(a b c) :start 2))
+(null (position-if #'(lambda (x) (eq x 'c)) '(a b c) :start 3))
+(null (position-if #'(lambda (x) (eq x 'a)) '(a b c) :start 0 :end 0))
+(null (position-if #'(lambda (x) (eq x 'a)) '(a b c) :start 0 :end 0
+ :from-end t))
+(null (position-if #'(lambda (x) (eq x 'a)) '(a b c) :start 1 :end 1))
+(null (position-if #'(lambda (x) (eq x 'a)) '(a b c) :start 1 :end 1
+ :from-end t))
+(null (position-if #'(lambda (x) (eq x 'a)) '(a b c) :start 2 :end 2))
+(null (position-if #'(lambda (x) (eq x 'a)) '(a b c) :start 2 :end 2
+ :from-end t))
+(null (position-if #'(lambda (x) (eq x 'a)) '(a b c) :start 3 :end 3))
+(null (position-if #'(lambda (x) (eq x 'a)) '(a b c) :start 3 :end 3
+ :from-end t))
+(eql (position-if #'(lambda (x) (eq x 'a)) '(a b c) :end nil) 0)
+(eql (position-if #'(lambda (x) (eq x 'b)) '(a b c) :end nil) 1)
+(eql (position-if #'(lambda (x) (eq x 'c)) '(a b c) :end nil) 2)
+(eql (position-if #'(lambda (x) (eq x 'a)) '(a b c) :end 1) 0)
+(eql (position-if #'(lambda (x) (eq x 'b)) '(a b c) :end 2) 1)
+(eql (position-if #'(lambda (x) (eq x 'c)) '(a b c) :end 3) 2)
+(null (position-if #'(lambda (x) (eq x 'a)) '(a b c) :end 0))
+(null (position-if #'(lambda (x) (eq x 'b)) '(a b c) :end 1))
+(null (position-if #'(lambda (x) (eq x 'c)) '(a b c) :end 2))
+(null (position-if #'(lambda (x) (eq x 'a)) '((a) (b) (c))))
+(eql (position-if #'(lambda (x) (eq x 'a)) '((a) (b) (c)) :key #'car) 0)
+(eql (position-if #'(lambda (x) (eq x 'b)) '((a) (b) (c)) :key #'car) 1)
+(eql (position-if #'(lambda (x) (eq x 'c)) '((a) (b) (c)) :key #'car) 2)
+(null (position-if #'(lambda (x) (eq x 'z)) '((a) (b) (c)) :key #'car))
+(eql (position-if #'(lambda (x) (eq x 'a))
+ '((a) (b) (c) (a a) (b b) (c c)) :key #'car)
+ 0)
+(eql (position-if #'(lambda (x) (eq x 'a))
+ '((a) (b) (c) (a a) (b b) (c c)) :key #'car :from-end t)
+ 3)
+(eql (position-if #'(lambda (x) (eq x 'b))
+ '((a) (b) (c) (a a) (b b) (c c)) :key #'car)
+ 1)
+(eql (position-if #'(lambda (x) (eq x 'b))
+ '((a) (b) (c) (a a) (b b) (c c)) :key #'car :from-end t)
+ 4)
+(eql (position-if #'(lambda (x) (eq x 'c))
+ '((a) (b) (c) (a a) (b b) (c c)) :key #'car)
+ 2)
+(eql (position-if #'(lambda (x) (eq x 'c))
+ '((a) (b) (c) (a a) (b b) (c c)) :key #'car :from-end t)
+ 5)
+(null (position-if #'(lambda (x) (eq x 'z))
+ '((a) (b) (c) (a a) (b b) (c c)) :key #'car))
+(null (position-if #'(lambda (x) (eq x 'z))
+ '((a) (b) (c) (a a) (b b) (c c)) :key #'car :from-end t))
+(eql (position-if #'(lambda (x) (eq x 'a))
+ '((a) (b) (c) (a a) (b b) (c c) (a a a))
+ :key #'car
+ :from-end t)
+ 6)
+(eql (position-if #'(lambda (x) (eq x 'a))
+ '((a) (b) (c) (a a) (b b) (c c) (a a a))
+ :key #'car
+ :from-end t
+ :end nil)
+ 6)
+(eql (position-if #'(lambda (x) (eq x 'a))
+ '((a) (b) (c) (a a) (b b) (c c) (a a a))
+ :key #'car
+ :from-end t
+ :end 6)
+ 3)
+(null (position-if #'(lambda (x) (eq x 'a))
+ '((a) (b) (c) (a a) (b b) (c c) (a a a))
+ :key #'car
+ :from-end t
+ :start 1
+ :end 3))
+(null (position-if #'(lambda (x) (eql x #\c)) '("abc" "bcd" "cde")))
+(eql (position-if #'(lambda (x) (eql x #\c)) '("abc" "bcd" "cde")
+ :key #'(lambda (arg) (char arg 0)))
+ 2)
+(eql (position-if #'(lambda (x) (char> #\c x)) '("abc" "bcd" "cde")
+ :key #'(lambda (arg) (char arg 0)))
+ 0)
+(eql (position-if #'(lambda (x) (char> #\c x)) '("abc" "bcd" "cde")
+ :start 1
+ :key #'(lambda (arg) (char arg 0)))
+ 1)
+(eql (position-if #'(lambda (x) (eq x 'a)) #(a b c)) 0)
+(eql (position-if #'(lambda (x) (eq x 'b)) #(a b c)) 1)
+(eql (position-if #'(lambda (x) (eq x 'c)) #(a b c)) 2)
+(null (position-if #'(lambda (arg) (eq arg 'x)) #(a b c)))
+(null (position-if #'(lambda (x) (eq x 'a)) #(a b c) :start 1))
+(null (position-if #'(lambda (x) (eq x 'b)) #(a b c) :start 2))
+(null (position-if #'(lambda (x) (eq x 'c)) #(a b c) :start 3))
+(null (position-if #'(lambda (x) (eq x 'a)) #(a b c) :start 0 :end 0))
+(null (position-if #'(lambda (x) (eq x 'a)) #(a b c) :start 0 :end 0
+ :from-end t))
+(null (position-if #'(lambda (x) (eq x 'a)) #(a b c) :start 1 :end 1))
+(null (position-if #'(lambda (x) (eq x 'a)) #(a b c) :start 1 :end 1
+ :from-end t))
+(null (position-if #'(lambda (x) (eq x 'a)) #(a b c) :start 2 :end 2))
+(null (position-if #'(lambda (x) (eq x 'a)) #(a b c) :start 2 :end 2
+ :from-end t))
+(null (position-if #'(lambda (x) (eq x 'a)) #(a b c) :start 3 :end 3))
+(null (position-if #'(lambda (x) (eq x 'a)) #(a b c) :start 3 :end 3
+ :from-end t))
+(eql (position-if #'(lambda (x) (eq x 'a)) #(a b c) :end nil) 0)
+(eql (position-if #'(lambda (x) (eq x 'b)) #(a b c) :end nil) 1)
+(eql (position-if #'(lambda (x) (eq x 'c)) #(a b c) :end nil) 2)
+(eql (position-if #'(lambda (x) (eq x 'a)) #(a b c) :end 1) 0)
+(eql (position-if #'(lambda (x) (eq x 'b)) #(a b c) :end 2) 1)
+(eql (position-if #'(lambda (x) (eq x 'c)) #(a b c) :end 3) 2)
+(null (position-if #'(lambda (x) (eq x 'a)) #(a b c) :end 0))
+(null (position-if #'(lambda (x) (eq x 'b)) #(a b c) :end 1))
+(null (position-if #'(lambda (x) (eq x 'c)) #(a b c) :end 2))
+(null (position-if #'(lambda (x) (eq x 'a)) #((a) (b) (c))))
+(eql (position-if #'(lambda (x) (eq x 'a)) #((a) (b) (c)) :key #'car) 0)
+(eql (position-if #'(lambda (x) (eq x 'b)) #((a) (b) (c)) :key #'car) 1)
+(eql (position-if #'(lambda (x) (eq x 'c)) #((a) (b) (c)) :key #'car) 2)
+(null (position-if #'(lambda (x) (eq x 'z)) #((a) (b) (c)) :key #'car))
+(eql (position-if #'(lambda (x) (eq x 'a))
+ #((a) (b) (c) (a a) (b b) (c c)) :key #'car)
+ 0)
+(eql (position-if #'(lambda (x) (eq x 'a))
+ #((a) (b) (c) (a a) (b b) (c c)) :key #'car :from-end t)
+ 3)
+(eql (position-if #'(lambda (x) (eq x 'b))
+ #((a) (b) (c) (a a) (b b) (c c)) :key #'car)
+ 1)
+(eql (position-if #'(lambda (x) (eq x 'b))
+ #((a) (b) (c) (a a) (b b) (c c)) :key #'car :from-end t)
+ 4)
+(eql (position-if #'(lambda (x) (eq x 'c))
+ #((a) (b) (c) (a a) (b b) (c c)) :key #'car)
+ 2)
+(eql (position-if #'(lambda (x) (eq x 'c))
+ #((a) (b) (c) (a a) (b b) (c c)) :key #'car :from-end t)
+ 5)
+(null (position-if #'(lambda (x) (eq x 'z))
+ #((a) (b) (c) (a a) (b b) (c c)) :key #'car))
+(null (position-if #'(lambda (x) (eq x 'z))
+ #((a) (b) (c) (a a) (b b) (c c)) :key #'car :from-end t))
+(eql (position-if #'(lambda (x) (eq x 'a))
+ #((a) (b) (c) (a a) (b b) (c c) (a a a))
+ :key #'car
+ :from-end t)
+ 6)
+(eql (position-if #'(lambda (x) (eq x 'a))
+ #((a) (b) (c) (a a) (b b) (c c) (a a a))
+ :key #'car
+ :from-end t
+ :end nil)
+ 6)
+(eql (position-if #'(lambda (x) (eq x 'a))
+ #((a) (b) (c) (a a) (b b) (c c) (a a a))
+ :key #'car
+ :from-end t
+ :end 6)
+ 3)
+(null (position-if #'(lambda (x) (eq x 'a))
+ #((a) (b) (c) (a a) (b b) (c c) (a a a))
+ :key #'car
+ :from-end t
+ :start 1
+ :end 3))
+(null (position-if #'(lambda (x) (eql x #\c)) #("abc" "bcd" "cde")))
+(eql (position-if #'(lambda (x) (eql x #\c)) #("abc" "bcd" "cde")
+ :key #'(lambda (arg) (char arg 0)))
+ 2)
+(eql (position-if #'(lambda (x) (char> #\c x)) #("abc" "bcd" "cde")
+ :key #'(lambda (arg) (char arg 0)))
+ 0)
+(eql (position-if #'(lambda (x) (char> #\c x)) #("abc" "bcd" "cde")
+ :start 1
+ :key #'(lambda (arg) (char arg 0)))
+ 1)
+
+
+(eql (position-if-not #'(lambda (x) (not (eq x 'a))) '(a b c)) 0)
+(eql (position-if-not #'(lambda (x) (not (eq x 'b))) '(a b c)) 1)
+(eql (position-if-not #'(lambda (x) (not (eq x 'c))) '(a b c)) 2)
+(null (position-if-not #'(lambda (arg) (not (eq arg 'x))) '(a b c)))
+(null (position-if-not #'(lambda (x) (not (eq x 'a))) '(a b c) :start 1))
+(null (position-if-not #'(lambda (x) (not (eq x 'b))) '(a b c) :start 2))
+(null (position-if-not #'(lambda (x) (not (eq x 'c))) '(a b c) :start 3))
+(null (position-if-not #'(lambda (x) (not (eq x 'a))) '(a b c) :start 0 :end 0))
+(null (position-if-not #'(lambda (x) (not (eq x 'a))) '(a b c)
+ :start 0 :end 0 :from-end t))
+(null (position-if-not #'(lambda (x) (not (eq x 'a))) '(a b c) :start 1 :end 1))
+(null (position-if-not #'(lambda (x) (not (eq x 'a))) '(a b c)
+ :start 1 :end 1 :from-end t))
+(null (position-if-not #'(lambda (x) (not (eq x 'a))) '(a b c) :start 2 :end 2))
+(null (position-if-not #'(lambda (x) (not (eq x 'a))) '(a b c)
+ :start 2 :end 2 :from-end t))
+(null (position-if-not #'(lambda (x) (not (eq x 'a))) '(a b c) :start 3 :end 3))
+(null (position-if-not #'(lambda (x) (not (eq x 'a))) '(a b c)
+ :start 3 :end 3 :from-end t))
+(eql (position-if-not #'(lambda (x) (not (eq x 'a))) '(a b c) :end nil) 0)
+(eql (position-if-not #'(lambda (x) (not (eq x 'b))) '(a b c) :end nil) 1)
+(eql (position-if-not #'(lambda (x) (not (eq x 'c))) '(a b c) :end nil) 2)
+(eql (position-if-not #'(lambda (x) (not (eq x 'a))) '(a b c) :end 1) 0)
+(eql (position-if-not #'(lambda (x) (not (eq x 'b))) '(a b c) :end 2) 1)
+(eql (position-if-not #'(lambda (x) (not (eq x 'c))) '(a b c) :end 3) 2)
+(null (position-if-not #'(lambda (x) (not (eq x 'a))) '(a b c) :end 0))
+(null (position-if-not #'(lambda (x) (not (eq x 'b))) '(a b c) :end 1))
+(null (position-if-not #'(lambda (x) (not (eq x 'c))) '(a b c) :end 2))
+(null (position-if-not #'(lambda (x) (not (eq x 'a))) '((a) (b) (c))))
+(eql (position-if-not #'(lambda (x) (not (eq x 'a))) '((a) (b) (c)) :key #'car)
+ 0)
+(eql (position-if-not #'(lambda (x) (not (eq x 'b))) '((a) (b) (c)) :key #'car)
+ 1)
+(eql (position-if-not #'(lambda (x) (not (eq x 'c))) '((a) (b) (c)) :key #'car)
+ 2)
+(null (position-if-not #'(lambda (x) (not (eq x 'z))) '((a) (b) (c))
+ :key #'car))
+(eql (position-if-not #'(lambda (x) (not (eq x 'a)))
+ '((a) (b) (c) (a a) (b b) (c c)) :key #'car)
+ 0)
+(eql (position-if-not #'(lambda (x) (not (eq x 'a)))
+ '((a) (b) (c) (a a) (b b) (c c)) :key #'car :from-end t)
+ 3)
+(eql (position-if-not #'(lambda (x) (not (eq x 'b)))
+ '((a) (b) (c) (a a) (b b) (c c)) :key #'car)
+ 1)
+(eql (position-if-not #'(lambda (x) (not (eq x 'b)))
+ '((a) (b) (c) (a a) (b b) (c c)) :key #'car :from-end t)
+ 4)
+(eql (position-if-not #'(lambda (x) (not (eq x 'c)))
+ '((a) (b) (c) (a a) (b b) (c c)) :key #'car)
+ 2)
+(eql (position-if-not #'(lambda (x) (not (eq x 'c)))
+ '((a) (b) (c) (a a) (b b) (c c)) :key #'car :from-end t)
+ 5)
+(null (position-if-not #'(lambda (x) (not (eq x 'z)))
+ '((a) (b) (c) (a a) (b b) (c c)) :key #'car))
+(null (position-if-not #'(lambda (x) (not (eq x 'z)))
+ '((a) (b) (c) (a a) (b b) (c c)) :key #'car :from-end t))
+(eql (position-if-not #'(lambda (x) (not (eq x 'a)))
+ '((a) (b) (c) (a a) (b b) (c c) (a a a))
+ :key #'car
+ :from-end t)
+ 6)
+(eql (position-if-not #'(lambda (x) (not (eq x 'a)))
+ '((a) (b) (c) (a a) (b b) (c c) (a a a))
+ :key #'car
+ :from-end t
+ :end nil)
+ 6)
+(eql (position-if-not #'(lambda (x) (not (eq x 'a)))
+ '((a) (b) (c) (a a) (b b) (c c) (a a a))
+ :key #'car
+ :from-end t
+ :end 6)
+ 3)
+(null (position-if-not #'(lambda (x) (not (eq x 'a)))
+ '((a) (b) (c) (a a) (b b) (c c) (a a a))
+ :key #'car
+ :from-end t
+ :start 1
+ :end 3))
+(null (position-if-not #'(lambda (x) (not (eql x #\c))) '("abc" "bcd" "cde")))
+(eql (position-if-not #'(lambda (x) (not (eql x #\c))) '("abc" "bcd" "cde")
+ :key #'(lambda (arg) (char arg 0)))
+ 2)
+(eql (position-if-not #'(lambda (x) (not (char> #\c x))) '("abc" "bcd" "cde")
+ :key #'(lambda (arg) (char arg 0)))
+ 0)
+(eql (position-if-not #'(lambda (x) (not (char> #\c x))) '("abc" "bcd" "cde")
+ :start 1
+ :key #'(lambda (arg) (char arg 0)))
+ 1)
+
+(eql (position-if-not #'(lambda (x) (not (eq x 'a))) #(a b c)) 0)
+(eql (position-if-not #'(lambda (x) (not (eq x 'b))) #(a b c)) 1)
+(eql (position-if-not #'(lambda (x) (not (eq x 'c))) #(a b c)) 2)
+(null (position-if-not #'(lambda (arg) (not (eq arg 'x))) #(a b c)))
+(null (position-if-not #'(lambda (x) (not (eq x 'a))) #(a b c) :start 1))
+(null (position-if-not #'(lambda (x) (not (eq x 'b))) #(a b c) :start 2))
+(null (position-if-not #'(lambda (x) (not (eq x 'c))) #(a b c) :start 3))
+(null (position-if-not #'(lambda (x) (not (eq x 'a))) #(a b c) :start 0 :end 0))
+(null (position-if-not #'(lambda (x) (not (eq x 'a))) #(a b c) :start 0 :end 0
+ :from-end t))
+(null (position-if-not #'(lambda (x) (not (eq x 'a))) #(a b c) :start 1 :end 1))
+(null (position-if-not #'(lambda (x) (not (eq x 'a))) #(a b c) :start 1 :end 1
+ :from-end t))
+(null (position-if-not #'(lambda (x) (not (eq x 'a))) #(a b c) :start 2 :end 2))
+(null (position-if-not #'(lambda (x) (not (eq x 'a))) #(a b c) :start 2 :end 2
+ :from-end t))
+(null (position-if-not #'(lambda (x) (not (eq x 'a))) #(a b c) :start 3 :end 3))
+(null (position-if-not #'(lambda (x) (not (eq x 'a))) #(a b c) :start 3 :end 3
+ :from-end t))
+(eql (position-if-not #'(lambda (x) (not (eq x 'a))) #(a b c) :end nil) 0)
+(eql (position-if-not #'(lambda (x) (not (eq x 'b))) #(a b c) :end nil) 1)
+(eql (position-if-not #'(lambda (x) (not (eq x 'c))) #(a b c) :end nil) 2)
+(eql (position-if-not #'(lambda (x) (not (eq x 'a))) #(a b c) :end 1) 0)
+(eql (position-if-not #'(lambda (x) (not (eq x 'b))) #(a b c) :end 2) 1)
+(eql (position-if-not #'(lambda (x) (not (eq x 'c))) #(a b c) :end 3) 2)
+(null (position-if-not #'(lambda (x) (not (eq x 'a))) #(a b c) :end 0))
+(null (position-if-not #'(lambda (x) (not (eq x 'b))) #(a b c) :end 1))
+(null (position-if-not #'(lambda (x) (not (eq x 'c))) #(a b c) :end 2))
+(null (position-if-not #'(lambda (x) (not (eq x 'a))) #((a) (b) (c))))
+(eql (position-if-not #'(lambda (x) (not (eq x 'a))) #((a) (b) (c)) :key #'car)
+ 0)
+(eql (position-if-not #'(lambda (x) (not (eq x 'b))) #((a) (b) (c)) :key #'car)
+ 1)
+(eql (position-if-not #'(lambda (x) (not (eq x 'c))) #((a) (b) (c)) :key #'car)
+ 2)
+(null (position-if-not #'(lambda (x) (not (eq x 'z))) #((a) (b) (c))
+ :key #'car))
+(eql (position-if-not #'(lambda (x) (not (eq x 'a)))
+ #((a) (b) (c) (a a) (b b) (c c)) :key #'car)
+ 0)
+(eql (position-if-not #'(lambda (x) (not (eq x 'a)))
+ #((a) (b) (c) (a a) (b b) (c c)) :key #'car :from-end t)
+ 3)
+(eql (position-if-not #'(lambda (x) (not (eq x 'b)))
+ #((a) (b) (c) (a a) (b b) (c c)) :key #'car)
+ 1)
+(eql (position-if-not #'(lambda (x) (not (eq x 'b)))
+ #((a) (b) (c) (a a) (b b) (c c)) :key #'car :from-end t)
+ 4)
+(eql (position-if-not #'(lambda (x) (not (eq x 'c)))
+ #((a) (b) (c) (a a) (b b) (c c)) :key #'car)
+ 2)
+(eql (position-if-not #'(lambda (x) (not (eq x 'c)))
+ #((a) (b) (c) (a a) (b b) (c c)) :key #'car :from-end t)
+ 5)
+(null (position-if-not #'(lambda (x) (not (eq x 'z)))
+ #((a) (b) (c) (a a) (b b) (c c)) :key #'car))
+(null (position-if-not #'(lambda (x) (not (eq x 'z)))
+ #((a) (b) (c) (a a) (b b) (c c)) :key #'car :from-end t))
+(eql (position-if-not #'(lambda (x) (not (eq x 'a)))
+ #((a) (b) (c) (a a) (b b) (c c) (a a a))
+ :key #'car
+ :from-end t)
+ 6)
+(eql (position-if-not #'(lambda (x) (not (eq x 'a)))
+ #((a) (b) (c) (a a) (b b) (c c) (a a a))
+ :key #'car
+ :from-end t
+ :end nil)
+ 6)
+(eql (position-if-not #'(lambda (x) (not (eq x 'a)))
+ #((a) (b) (c) (a a) (b b) (c c) (a a a))
+ :key #'car
+ :from-end t
+ :end 6)
+ 3)
+(null (position-if-not #'(lambda (x) (not (eq x 'a)))
+ #((a) (b) (c) (a a) (b b) (c c) (a a a))
+ :key #'car
+ :from-end t
+ :start 1
+ :end 3))
+(eql (position-if-not #'(lambda (x) (not (eql x #\c))) #("abc" "bcd" "cde")
+ :key #'(lambda (arg) (char arg 0)))
+ 2)
+(eql (position-if-not #'(lambda (x) (not (char> #\c x))) #("abc" "bcd" "cde")
+ :key #'(lambda (arg) (char arg 0)))
+ 0)
+(eql (position-if-not #'(lambda (x) (not (char> #\c x))) #("abc" "bcd" "cde")
+ :start 1
+ :key #'(lambda (arg) (char arg 0)))
+ 1)
+
+
+
+(eql (search "dog" "it's a dog's life") 7)
+(eql (search '(0 1) '(2 4 6 1 3 5) :key #'oddp) 2)
+
+
+(eql (search '() '()) 0)
+(null (search '(a b c) '(x y z)))
+(eql (search '() '(x y z)) 0)
+(eql (search '(a) '(a)) 0)
+(eql (search '(a b c) '(a b c x y z)) 0)
+(eql (search '(a b c) '(x a b c y z)) 1)
+(eql (search '(a b c) '(x y a b c z)) 2)
+(eql (search '(a b c) '(x y z a b c)) 3)
+(eql (search '(a b c) '(a b c a b c) :start2 1) 3)
+(eql (search '(a b c) '(a b c a b c) :start2 1 :end2 nil) 3)
+(eql (search '(a b c) '(a b c a b c) :start1 1 :start2 1 :end2 nil) 1)
+(eql (search '(a b c) '(a b c a b c) :start1 1 :end1 nil :start2 1 :end2 nil) 1)
+(null (search '(a b c) '(a b c a b c) :start2 0 :end2 0))
+(null (search '(a b c) '(a b c a b c) :start2 1 :end2 1))
+(null (search '(a b c) '(a b c a b c) :start2 2 :end2 2))
+(null (search '(a b c) '(a b c a b c) :start2 3 :end2 3))
+(null (search '(a b c) '(a b c a b c) :start2 4 :end2 4))
+(null (search '(a b c) '(a b c a b c) :start2 5 :end2 5))
+(null (search '(a b c) '(a b c a b c) :start2 6 :end2 6))
+(eql (search '(a b c) '(a b c a b c)) 0)
+(eql (search '(a b c) '(a b c a b c) :from-end t) 3)
+(eql (search '(a b c) '(a b c a b c) :start2 3 :end2 6) 3)
+(eql (search '(a b c) '(a b c a b c) :start2 3 :end2 6 :from-end t) 3)
+(eql (search '(a b c) '(a b c a b c)
+ :start1 0 :end1 2 :start2 0 :end2 6)
+ 0)
+(eql (search '(a b c) '(a b c a b c)
+ :start1 0 :end1 2 :start2 0 :end2 6 :from-end t)
+ 3)
+(eql (search '(a b c) '(a b c a b c) :start1 0 :end1 0 :start2 0 :end2 0) 0)
+(eql (search '(a b c) '(a b c a b c) :start1 1 :end1 1 :start2 0 :end2 0) 0)
+(eql (search '(a b c) '(a b c a b c) :start1 2 :end1 2 :start2 0 :end2 0) 0)
+(eql (search '(a b c) '(a b c a b c) :start1 3 :end1 3 :start2 0 :end2 0) 0)
+(eql (search '(a b c) '(a b c a b c) :start1 0 :end1 0 :start2 1 :end2 1) 1)
+(eql (search '(a b c) '(a b c a b c) :start1 1 :end1 1 :start2 1 :end2 1) 1)
+(eql (search '(a b c) '(a b c a b c) :start1 2 :end1 2 :start2 1 :end2 1) 1)
+(eql (search '(a b c) '(a b c a b c) :start1 3 :end1 3 :start2 1 :end2 1) 1)
+(eql (search '(a b c) '(a b c a b c) :start1 0 :end1 0 :start2 6 :end2 6) 6)
+(eql (search '(a b c) '(a b c a b c) :start1 1 :end1 1 :start2 6 :end2 6) 6)
+(eql (search '(a b c) '(a b c a b c) :start1 2 :end1 2 :start2 6 :end2 6) 6)
+(eql (search '(a b c) '(a b c a b c) :start1 3 :end1 3 :start2 6 :end2 6) 6)
+
+(eql (search '(a b c) '(a b c a b c) :start1 0 :end1 0 :start2 0 :end2 0
+ :from-end t) 0)
+(eql (search '(a b c) '(a b c a b c) :start1 1 :end1 1 :start2 0 :end2 0
+ :from-end t) 0)
+(eql (search '(a b c) '(a b c a b c) :start1 2 :end1 2 :start2 0 :end2 0
+ :from-end t) 0)
+(eql (search '(a b c) '(a b c a b c) :start1 3 :end1 3 :start2 0 :end2 0
+ :from-end t) 0)
+(eql (search '(a b c) '(a b c a b c) :start1 0 :end1 0 :start2 1 :end2 1
+ :from-end t) 1)
+(eql (search '(a b c) '(a b c a b c) :start1 1 :end1 1 :start2 1 :end2 1
+ :from-end t) 1)
+(eql (search '(a b c) '(a b c a b c) :start1 2 :end1 2 :start2 1 :end2 1
+ :from-end t) 1)
+(eql (search '(a b c) '(a b c a b c) :start1 3 :end1 3 :start2 1 :end2 1
+ :from-end t) 1)
+(eql (search '(a b c) '(a b c a b c) :start1 0 :end1 0 :start2 6 :end2 6
+ :from-end t) 6)
+(eql (search '(a b c) '(a b c a b c) :start1 1 :end1 1 :start2 6 :end2 6
+ :from-end t) 6)
+(eql (search '(a b c) '(a b c a b c) :start1 2 :end1 2 :start2 6 :end2 6
+ :from-end t) 6)
+(eql (search '(a b c) '(a b c a b c) :start1 3 :end1 3 :start2 6 :end2 6
+ :from-end t) 6)
+
+(null (search '(#\a #\b #\c) '(#\A #\B #\C)))
+(eql (search '(#\a #\b #\c) '(#\A #\B #\C) :test #'char-equal) 0)
+(eql (search '(#\a #\b #\c) '(#\A #\B #\C) :test-not (complement #'char-equal))
+ 0)
+(eql (search '(#\a #\b) '(#\a #\b #\x #\y #\z)) 0)
+(eql (search '(#\a #\b) '(#\a #\b #\x #\y #\z) :test #'char<) 1)
+(eql (search '(#\a #\b) '(#\a #\b #\x #\y #\z) :test-not (complement #'char<))
+ 1)
+(eql (search '(#\a #\b) '(#\a #\b #\x #\y #\z)
+ :test-not (complement #'char<)
+ :from-end t)
+ 3)
+
+(null (search '((a) (b)) '((x) (y) (z) (a) (b) (c))))
+(eql (search '((a) (b)) '((x) (y) (z) (a) (b) (c)) :key #'car) 3)
+(eql (search '((a) (b)) '((a) (b) (c) (x) (y) (z) (a) (b) (c)) :key #'car)
+ 0)
+(eql (search '((a) (b)) '((a) (b) (c) (x) (y) (z) (a) (b) (c))
+ :key #'car
+ :from-end t)
+ 6)
+
+(eql (search '((a a) (b b)) '((a) (b) (c) (x) (y) (z) (a) (b) (c)) :key #'car)
+ 0)
+(eql (search '((a a) (b b))
+ '((a nil) (b t) (c nil) (x) (y) (z) (a 0) (b 1) (c 2))
+ :key #'car
+ :from-end t)
+ 6)
+
+(eql (search '(("a" a) ("b" b))
+ '(("a" nil) ("b" t) ("c" nil) ("x") ("y") ("z")
+ ("A" 0) ("B" 1) ("C" 2))
+ :start1 1
+ :end1 2
+ :start2 3
+ :end2 nil
+ :key #'car
+ :test #'string-equal
+ :from-end t)
+ 7)
+
+
+(eql (search #() '()) 0)
+(null (search #(a b c) '(x y z)))
+(eql (search #() '(x y z)) 0)
+(eql (search #(a) '(a)) 0)
+(eql (search #(a b c) '(a b c x y z)) 0)
+(eql (search #(a b c) '(x a b c y z)) 1)
+(eql (search #(a b c) '(x y a b c z)) 2)
+(eql (search #(a b c) '(x y z a b c)) 3)
+(eql (search #(a b c) '(a b c a b c) :start2 1) 3)
+(eql (search #(a b c) '(a b c a b c) :start2 1 :end2 nil) 3)
+(eql (search #(a b c) '(a b c a b c) :start1 1 :start2 1 :end2 nil) 1)
+(eql (search #(a b c) '(a b c a b c) :start1 1 :end1 nil :start2 1 :end2 nil) 1)
+(null (search #(a b c) '(a b c a b c) :start2 0 :end2 0))
+(null (search #(a b c) '(a b c a b c) :start2 1 :end2 1))
+(null (search #(a b c) '(a b c a b c) :start2 2 :end2 2))
+(null (search #(a b c) '(a b c a b c) :start2 3 :end2 3))
+(null (search #(a b c) '(a b c a b c) :start2 4 :end2 4))
+(null (search #(a b c) '(a b c a b c) :start2 5 :end2 5))
+(null (search #(a b c) '(a b c a b c) :start2 6 :end2 6))
+(eql (search #(a b c) '(a b c a b c)) 0)
+(eql (search #(a b c) '(a b c a b c) :from-end t) 3)
+(eql (search #(a b c) '(a b c a b c) :start2 3 :end2 6) 3)
+(eql (search #(a b c) '(a b c a b c) :start2 3 :end2 6 :from-end t) 3)
+(eql (search #(a b c) '(a b c a b c)
+ :start1 0 :end1 2 :start2 0 :end2 6)
+ 0)
+(eql (search #(a b c) '(a b c a b c)
+ :start1 0 :end1 2 :start2 0 :end2 6 :from-end t)
+ 3)
+(eql (search #(a b c) '(a b c a b c) :start1 0 :end1 0 :start2 0 :end2 0) 0)
+(eql (search #(a b c) '(a b c a b c) :start1 1 :end1 1 :start2 0 :end2 0) 0)
+(eql (search #(a b c) '(a b c a b c) :start1 2 :end1 2 :start2 0 :end2 0) 0)
+(eql (search #(a b c) '(a b c a b c) :start1 3 :end1 3 :start2 0 :end2 0) 0)
+(eql (search #(a b c) '(a b c a b c) :start1 0 :end1 0 :start2 1 :end2 1) 1)
+(eql (search #(a b c) '(a b c a b c) :start1 1 :end1 1 :start2 1 :end2 1) 1)
+(eql (search #(a b c) '(a b c a b c) :start1 2 :end1 2 :start2 1 :end2 1) 1)
+(eql (search #(a b c) '(a b c a b c) :start1 3 :end1 3 :start2 1 :end2 1) 1)
+(eql (search #(a b c) '(a b c a b c) :start1 0 :end1 0 :start2 6 :end2 6) 6)
+(eql (search #(a b c) '(a b c a b c) :start1 1 :end1 1 :start2 6 :end2 6) 6)
+(eql (search #(a b c) '(a b c a b c) :start1 2 :end1 2 :start2 6 :end2 6) 6)
+(eql (search #(a b c) '(a b c a b c) :start1 3 :end1 3 :start2 6 :end2 6) 6)
+
+(eql (search #(a b c) '(a b c a b c) :start1 0 :end1 0 :start2 0 :end2 0
+ :from-end t) 0)
+(eql (search #(a b c) '(a b c a b c) :start1 1 :end1 1 :start2 0 :end2 0
+ :from-end t) 0)
+(eql (search #(a b c) '(a b c a b c) :start1 2 :end1 2 :start2 0 :end2 0
+ :from-end t) 0)
+(eql (search #(a b c) '(a b c a b c) :start1 3 :end1 3 :start2 0 :end2 0
+ :from-end t) 0)
+(eql (search #(a b c) '(a b c a b c) :start1 0 :end1 0 :start2 1 :end2 1
+ :from-end t) 1)
+(eql (search #(a b c) '(a b c a b c) :start1 1 :end1 1 :start2 1 :end2 1
+ :from-end t) 1)
+(eql (search #(a b c) '(a b c a b c) :start1 2 :end1 2 :start2 1 :end2 1
+ :from-end t) 1)
+(eql (search #(a b c) '(a b c a b c) :start1 3 :end1 3 :start2 1 :end2 1
+ :from-end t) 1)
+(eql (search #(a b c) '(a b c a b c) :start1 0 :end1 0 :start2 6 :end2 6
+ :from-end t) 6)
+(eql (search #(a b c) '(a b c a b c) :start1 1 :end1 1 :start2 6 :end2 6
+ :from-end t) 6)
+(eql (search #(a b c) '(a b c a b c) :start1 2 :end1 2 :start2 6 :end2 6
+ :from-end t) 6)
+(eql (search #(a b c) '(a b c a b c) :start1 3 :end1 3 :start2 6 :end2 6
+ :from-end t) 6)
+
+(null (search #(#\a #\b #\c) '(#\A #\B #\C)))
+(eql (search #(#\a #\b #\c) '(#\A #\B #\C) :test #'char-equal) 0)
+(eql (search #(#\a #\b #\c) '(#\A #\B #\C) :test-not (complement #'char-equal))
+ 0)
+(eql (search #(#\a #\b) '(#\a #\b #\x #\y #\z)) 0)
+(eql (search #(#\a #\b) '(#\a #\b #\x #\y #\z) :test #'char<) 1)
+(eql (search #(#\a #\b) '(#\a #\b #\x #\y #\z) :test-not (complement #'char<))
+ 1)
+(eql (search #(#\a #\b) '(#\a #\b #\x #\y #\z)
+ :test-not (complement #'char<)
+ :from-end t)
+ 3)
+
+(null (search #((a) (b)) '((x) (y) (z) (a) (b) (c))))
+(eql (search #((a) (b)) '((x) (y) (z) (a) (b) (c)) :key #'car) 3)
+(eql (search #((a) (b)) '((a) (b) (c) (x) (y) (z) (a) (b) (c)) :key #'car)
+ 0)
+(eql (search #((a) (b)) '((a) (b) (c) (x) (y) (z) (a) (b) (c))
+ :key #'car
+ :from-end t)
+ 6)
+
+(eql (search #((a a) (b b)) '((a) (b) (c) (x) (y) (z) (a) (b) (c)) :key #'car)
+ 0)
+(eql (search #((a a) (b b))
+ '((a nil) (b t) (c nil) (x) (y) (z) (a 0) (b 1) (c 2))
+ :key #'car
+ :from-end t)
+ 6)
+
+(eql (search #(("a" a) ("b" b))
+ '(("a" nil) ("b" t) ("c" nil) ("x") ("y") ("z")
+ ("A" 0) ("B" 1) ("C" 2))
+ :start1 1
+ :end1 2
+ :start2 3
+ :end2 nil
+ :key #'car
+ :test #'string-equal
+ :from-end t)
+ 7)
+
+
+(eql (search '() #()) 0)
+(null (search '(a b c) #(x y z)))
+(eql (search '() #(x y z)) 0)
+(eql (search '(a) #(a)) 0)
+(eql (search '(a b c) #(a b c x y z)) 0)
+(eql (search '(a b c) #(x a b c y z)) 1)
+(eql (search '(a b c) #(x y a b c z)) 2)
+(eql (search '(a b c) #(x y z a b c)) 3)
+(eql (search '(a b c) #(a b c a b c) :start2 1) 3)
+(eql (search '(a b c) #(a b c a b c) :start2 1 :end2 nil) 3)
+(eql (search '(a b c) #(a b c a b c) :start1 1 :start2 1 :end2 nil) 1)
+(eql (search '(a b c) #(a b c a b c) :start1 1 :end1 nil :start2 1 :end2 nil) 1)
+(null (search '(a b c) #(a b c a b c) :start2 0 :end2 0))
+(null (search '(a b c) #(a b c a b c) :start2 1 :end2 1))
+(null (search '(a b c) #(a b c a b c) :start2 2 :end2 2))
+(null (search '(a b c) #(a b c a b c) :start2 3 :end2 3))
+(null (search '(a b c) #(a b c a b c) :start2 4 :end2 4))
+(null (search '(a b c) #(a b c a b c) :start2 5 :end2 5))
+(null (search '(a b c) #(a b c a b c) :start2 6 :end2 6))
+(eql (search '(a b c) #(a b c a b c)) 0)
+(eql (search '(a b c) #(a b c a b c) :from-end t) 3)
+(eql (search '(a b c) #(a b c a b c) :start2 3 :end2 6) 3)
+(eql (search '(a b c) #(a b c a b c) :start2 3 :end2 6 :from-end t) 3)
+(eql (search '(a b c) #(a b c a b c)
+ :start1 0 :end1 2 :start2 0 :end2 6)
+ 0)
+(eql (search '(a b c) #(a b c a b c)
+ :start1 0 :end1 2 :start2 0 :end2 6 :from-end t)
+ 3)
+(eql (search '(a b c) #(a b c a b c) :start1 0 :end1 0 :start2 0 :end2 0) 0)
+(eql (search '(a b c) #(a b c a b c) :start1 1 :end1 1 :start2 0 :end2 0) 0)
+(eql (search '(a b c) #(a b c a b c) :start1 2 :end1 2 :start2 0 :end2 0) 0)
+(eql (search '(a b c) #(a b c a b c) :start1 3 :end1 3 :start2 0 :end2 0) 0)
+(eql (search '(a b c) #(a b c a b c) :start1 0 :end1 0 :start2 1 :end2 1) 1)
+(eql (search '(a b c) #(a b c a b c) :start1 1 :end1 1 :start2 1 :end2 1) 1)
+(eql (search '(a b c) #(a b c a b c) :start1 2 :end1 2 :start2 1 :end2 1) 1)
+(eql (search '(a b c) #(a b c a b c) :start1 3 :end1 3 :start2 1 :end2 1) 1)
+(eql (search '(a b c) #(a b c a b c) :start1 0 :end1 0 :start2 6 :end2 6) 6)
+(eql (search '(a b c) #(a b c a b c) :start1 1 :end1 1 :start2 6 :end2 6) 6)
+(eql (search '(a b c) #(a b c a b c) :start1 2 :end1 2 :start2 6 :end2 6) 6)
+(eql (search '(a b c) #(a b c a b c) :start1 3 :end1 3 :start2 6 :end2 6) 6)
+
+(eql (search '(a b c) #(a b c a b c) :start1 0 :end1 0 :start2 0 :end2 0
+ :from-end t) 0)
+(eql (search '(a b c) #(a b c a b c) :start1 1 :end1 1 :start2 0 :end2 0
+ :from-end t) 0)
+(eql (search '(a b c) #(a b c a b c) :start1 2 :end1 2 :start2 0 :end2 0
+ :from-end t) 0)
+(eql (search '(a b c) #(a b c a b c) :start1 3 :end1 3 :start2 0 :end2 0
+ :from-end t) 0)
+(eql (search '(a b c) #(a b c a b c) :start1 0 :end1 0 :start2 1 :end2 1
+ :from-end t) 1)
+(eql (search '(a b c) #(a b c a b c) :start1 1 :end1 1 :start2 1 :end2 1
+ :from-end t) 1)
+(eql (search '(a b c) #(a b c a b c) :start1 2 :end1 2 :start2 1 :end2 1
+ :from-end t) 1)
+(eql (search '(a b c) #(a b c a b c) :start1 3 :end1 3 :start2 1 :end2 1
+ :from-end t) 1)
+(eql (search '(a b c) #(a b c a b c) :start1 0 :end1 0 :start2 6 :end2 6
+ :from-end t) 6)
+(eql (search '(a b c) #(a b c a b c) :start1 1 :end1 1 :start2 6 :end2 6
+ :from-end t) 6)
+(eql (search '(a b c) #(a b c a b c) :start1 2 :end1 2 :start2 6 :end2 6
+ :from-end t) 6)
+(eql (search '(a b c) #(a b c a b c) :start1 3 :end1 3 :start2 6 :end2 6
+ :from-end t) 6)
+
+(null (search '(#\a #\b #\c) #(#\A #\B #\C)))
+(eql (search '(#\a #\b #\c) #(#\A #\B #\C) :test #'char-equal) 0)
+(eql (search '(#\a #\b #\c) #(#\A #\B #\C) :test-not (complement #'char-equal))
+ 0)
+(eql (search '(#\a #\b) #(#\a #\b #\x #\y #\z)) 0)
+(eql (search '(#\a #\b) #(#\a #\b #\x #\y #\z) :test #'char<) 1)
+(eql (search '(#\a #\b) #(#\a #\b #\x #\y #\z) :test-not (complement #'char<))
+ 1)
+(eql (search '(#\a #\b) #(#\a #\b #\x #\y #\z)
+ :test-not (complement #'char<)
+ :from-end t)
+ 3)
+
+(null (search '((a) (b)) #((x) (y) (z) (a) (b) (c))))
+(eql (search '((a) (b)) #((x) (y) (z) (a) (b) (c)) :key #'car) 3)
+(eql (search '((a) (b)) #((a) (b) (c) (x) (y) (z) (a) (b) (c)) :key #'car)
+ 0)
+(eql (search '((a) (b)) #((a) (b) (c) (x) (y) (z) (a) (b) (c))
+ :key #'car
+ :from-end t)
+ 6)
+
+(eql (search '((a a) (b b)) #((a) (b) (c) (x) (y) (z) (a) (b) (c)) :key #'car)
+ 0)
+(eql (search '((a a) (b b))
+ #((a nil) (b t) (c nil) (x) (y) (z) (a 0) (b 1) (c 2))
+ :key #'car
+ :from-end t)
+ 6)
+
+(eql (search '(("a" a) ("b" b))
+ #(("a" nil) ("b" t) ("c" nil) ("x") ("y") ("z")
+ ("A" 0) ("B" 1) ("C" 2))
+ :start1 1
+ :end1 2
+ :start2 3
+ :end2 nil
+ :key #'car
+ :test #'string-equal
+ :from-end t)
+ 7)
+
+
+(eql (search #() #()) 0)
+(null (search #(a b c) #(x y z)))
+(eql (search #() #(x y z)) 0)
+(eql (search #(a) #(a)) 0)
+(eql (search #(a b c) #(a b c x y z)) 0)
+(eql (search #(a b c) #(x a b c y z)) 1)
+(eql (search #(a b c) #(x y a b c z)) 2)
+(eql (search #(a b c) #(x y z a b c)) 3)
+(eql (search #(a b c) #(a b c a b c) :start2 1) 3)
+(eql (search #(a b c) #(a b c a b c) :start2 1 :end2 nil) 3)
+(eql (search #(a b c) #(a b c a b c) :start1 1 :start2 1 :end2 nil) 1)
+(eql (search #(a b c) #(a b c a b c) :start1 1 :end1 nil :start2 1 :end2 nil) 1)
+(null (search #(a b c) #(a b c a b c) :start2 0 :end2 0))
+(null (search #(a b c) #(a b c a b c) :start2 1 :end2 1))
+(null (search #(a b c) #(a b c a b c) :start2 2 :end2 2))
+(null (search #(a b c) #(a b c a b c) :start2 3 :end2 3))
+(null (search #(a b c) #(a b c a b c) :start2 4 :end2 4))
+(null (search #(a b c) #(a b c a b c) :start2 5 :end2 5))
+(null (search #(a b c) #(a b c a b c) :start2 6 :end2 6))
+(eql (search #(a b c) #(a b c a b c)) 0)
+(eql (search #(a b c) #(a b c a b c) :from-end t) 3)
+(eql (search #(a b c) #(a b c a b c) :start2 3 :end2 6) 3)
+(eql (search #(a b c) #(a b c a b c) :start2 3 :end2 6 :from-end t) 3)
+(eql (search #(a b c) #(a b c a b c)
+ :start1 0 :end1 2 :start2 0 :end2 6)
+ 0)
+(eql (search #(a b c) #(a b c a b c)
+ :start1 0 :end1 2 :start2 0 :end2 6 :from-end t)
+ 3)
+(eql (search #(a b c) #(a b c a b c) :start1 0 :end1 0 :start2 0 :end2 0) 0)
+(eql (search #(a b c) #(a b c a b c) :start1 1 :end1 1 :start2 0 :end2 0) 0)
+(eql (search #(a b c) #(a b c a b c) :start1 2 :end1 2 :start2 0 :end2 0) 0)
+(eql (search #(a b c) #(a b c a b c) :start1 3 :end1 3 :start2 0 :end2 0) 0)
+(eql (search #(a b c) #(a b c a b c) :start1 0 :end1 0 :start2 1 :end2 1) 1)
+(eql (search #(a b c) #(a b c a b c) :start1 1 :end1 1 :start2 1 :end2 1) 1)
+(eql (search #(a b c) #(a b c a b c) :start1 2 :end1 2 :start2 1 :end2 1) 1)
+(eql (search #(a b c) #(a b c a b c) :start1 3 :end1 3 :start2 1 :end2 1) 1)
+(eql (search #(a b c) #(a b c a b c) :start1 0 :end1 0 :start2 6 :end2 6) 6)
+(eql (search #(a b c) #(a b c a b c) :start1 1 :end1 1 :start2 6 :end2 6) 6)
+(eql (search #(a b c) #(a b c a b c) :start1 2 :end1 2 :start2 6 :end2 6) 6)
+(eql (search #(a b c) #(a b c a b c) :start1 3 :end1 3 :start2 6 :end2 6) 6)
+
+(eql (search #(a b c) #(a b c a b c) :start1 0 :end1 0 :start2 0 :end2 0
+ :from-end t) 0)
+(eql (search #(a b c) #(a b c a b c) :start1 1 :end1 1 :start2 0 :end2 0
+ :from-end t) 0)
+(eql (search #(a b c) #(a b c a b c) :start1 2 :end1 2 :start2 0 :end2 0
+ :from-end t) 0)
+(eql (search #(a b c) #(a b c a b c) :start1 3 :end1 3 :start2 0 :end2 0
+ :from-end t) 0)
+(eql (search #(a b c) #(a b c a b c) :start1 0 :end1 0 :start2 1 :end2 1
+ :from-end t) 1)
+(eql (search #(a b c) #(a b c a b c) :start1 1 :end1 1 :start2 1 :end2 1
+ :from-end t) 1)
+(eql (search #(a b c) #(a b c a b c) :start1 2 :end1 2 :start2 1 :end2 1
+ :from-end t) 1)
+(eql (search #(a b c) #(a b c a b c) :start1 3 :end1 3 :start2 1 :end2 1
+ :from-end t) 1)
+(eql (search #(a b c) #(a b c a b c) :start1 0 :end1 0 :start2 6 :end2 6
+ :from-end t) 6)
+(eql (search #(a b c) #(a b c a b c) :start1 1 :end1 1 :start2 6 :end2 6
+ :from-end t) 6)
+(eql (search #(a b c) #(a b c a b c) :start1 2 :end1 2 :start2 6 :end2 6
+ :from-end t) 6)
+(eql (search #(a b c) #(a b c a b c) :start1 3 :end1 3 :start2 6 :end2 6
+ :from-end t) 6)
+
+(null (search #(#\a #\b #\c) #(#\A #\B #\C)))
+(eql (search #(#\a #\b #\c) #(#\A #\B #\C) :test #'char-equal) 0)
+(eql (search #(#\a #\b #\c) #(#\A #\B #\C) :test-not (complement #'char-equal))
+ 0)
+(eql (search #(#\a #\b) #(#\a #\b #\x #\y #\z)) 0)
+(eql (search #(#\a #\b) #(#\a #\b #\x #\y #\z) :test #'char<) 1)
+(eql (search #(#\a #\b) #(#\a #\b #\x #\y #\z) :test-not (complement #'char<))
+ 1)
+(eql (search #(#\a #\b) #(#\a #\b #\x #\y #\z)
+ :test-not (complement #'char<)
+ :from-end t)
+ 3)
+
+(null (search #((a) (b)) #((x) (y) (z) (a) (b) (c))))
+(eql (search #((a) (b)) #((x) (y) (z) (a) (b) (c)) :key #'car) 3)
+(eql (search #((a) (b)) #((a) (b) (c) (x) (y) (z) (a) (b) (c)) :key #'car)
+ 0)
+(eql (search #((a) (b)) #((a) (b) (c) (x) (y) (z) (a) (b) (c))
+ :key #'car
+ :from-end t)
+ 6)
+
+(eql (search #((a a) (b b)) #((a) (b) (c) (x) (y) (z) (a) (b) (c)) :key #'car)
+ 0)
+(eql (search #((a a) (b b))
+ #((a nil) (b t) (c nil) (x) (y) (z) (a 0) (b 1) (c 2))
+ :key #'car
+ :from-end t)
+ 6)
+
+(eql (search #(("a" a) ("b" b))
+ #(("a" nil) ("b" t) ("c" nil) ("x") ("y") ("z")
+ ("A" 0) ("B" 1) ("C" 2))
+ :start1 1
+ :end1 2
+ :start2 3
+ :end2 nil
+ :key #'car
+ :test #'string-equal
+ :from-end t)
+ 7)
+
+
+(null (search "peace" "LOVE&PEACE"))
+(eql (search "peace" "LOVE&PEACE" :test #'char-equal) 5)
+(eql (search (concatenate 'simple-vector "peace")
+ (concatenate 'list "LOVE&PEACE") :test #'char-equal)
+ 5)
+(eql (search (concatenate 'list "peace")
+ (concatenate 'vector "LOVE&PEACE") :test #'char-equal)
+ 5)
+(eql (search (concatenate 'vector "peace")
+ (concatenate 'vector "LOVE&PEACE") :test #'char-equal)
+ 5)
+
+(eql (search #*10 #*010101) 1)
+(eql (search #*10 #*010101 :from-end t) 3)
+
+
+(null (search "PeAcE" "LoVe&pEaCe"))
+(eql (search "PeAcE" "LoVe&pEaCe" :key #'char-upcase) 5)
+(eql (search "abc" "abc xyz abc" :from-end t) 8)
+(eql (search "abc" "abc xyz abc xyz abc xyz abc"
+ :start2 8
+ :end2 19)
+ 8)
+(eql (search "abc" "abc xyz abc xyz abc xyz abc"
+ :from-end t
+ :start2 8
+ :end2 19)
+ 16)
+
+
+
+(eql (mismatch "abcd" "ABCDE" :test #'char-equal) 4)
+(eql (mismatch '(3 2 1 1 2 3) '(1 2 3) :from-end t) 3)
+(null (mismatch '(1 2 3) '(2 3 4) :test-not #'eq :key #'oddp))
+(null (mismatch '(1 2 3 4 5 6) '(3 4 5 6 7) :start1 2 :end2 4))
+
+
+(null (mismatch '() '()))
+(eql (mismatch '(a b c) '(x y z)) 0)
+(eql (mismatch '() '(x y z)) 0)
+(eql (mismatch '(x y z) '()) 0)
+(null (mismatch '(a) '(a)))
+(eql (mismatch '(a b c x y z) '(a b c)) 3)
+(null (mismatch '(a b c) '(a b c)))
+(eql (mismatch '(a b c d e f) '(a b c)) 3)
+(eql (mismatch '(a b c) '(a b c d e f)) 3)
+(eql (mismatch '(a b c) '(a b x)) 2)
+(eql (mismatch '(a b c) '(a x c)) 1)
+(eql (mismatch '(a b c) '(x b c)) 0)
+(eql (mismatch '(x y z a b c x y z) '(a b c) :start1 3) 6)
+(eql (mismatch '(x y z a b c x y z) '(a b c) :start1 3 :end1 nil) 6)
+(eql (mismatch '(x y z a b c x y z) '(a b c) :start1 3 :end1 4) 4)
+(eql (mismatch '(x y z a b c x y z) '(a b c) :start1 3 :end1 3) 3)
+(null (mismatch '(x y z) '() :start1 0 :end1 0))
+(null (mismatch '(x y z) '() :start1 1 :end1 1))
+(null (mismatch '(x y z) '() :start1 2 :end1 2))
+(null (mismatch '(x y z) '() :start1 3 :end1 3))
+(null (mismatch '(x y z) '() :start1 0 :end1 0 :start2 0 :end2 0))
+(null (mismatch '(x y z) '() :start1 1 :end1 1 :start2 1 :end2 1))
+(null (mismatch '(x y z) '() :start1 2 :end1 2 :start2 2 :end2 2))
+(null (mismatch '(x y z) '() :start1 3 :end1 3 :start2 3 :end2 3))
+(null (mismatch '(x y z) '() :start1 0 :end1 0 :start2 3 :end2 3))
+(null (mismatch '(x y z) '() :start1 1 :end1 1 :start2 2 :end2 2))
+(null (mismatch '(x y z) '() :start1 2 :end1 2 :start2 1 :end2 1))
+(null (mismatch '(x y z) '() :start1 3 :end1 3 :start2 0 :end2 0))
+(eql (mismatch '(x y z) '(a b c) :start1 0 :end1 0) 0)
+(eql (mismatch '(x y z) '(a b c) :start1 1 :end1 1) 1)
+(eql (mismatch '(x y z) '(a b c) :start1 2 :end1 2) 2)
+(eql (mismatch '(x y z) '(a b c) :start1 3 :end1 3) 3)
+(eql (mismatch '(x y z) '(x y z) :start1 0 :end1 1) 1)
+(eql (mismatch '(x y z) '(x y z) :start1 0 :end1 2) 2)
+(eql (mismatch '(x y z) '(x y z Z) :start1 0 :end1 3) 3)
+(null (mismatch '(x y z) '(x y z) :start1 0 :end1 3))
+(eql (mismatch '(a b c x y z) '(x y z a b c)) 0)
+(eql (mismatch '(a b c x y z) '(x y z a b c) :start1 3) 6)
+(eql (mismatch '(a b c x y z a b c) '(x y z a b c x y z) :start1 3) 9)
+(eql (mismatch '(a b c x y z a b c) '(x y z a b c x y z) :start1 6) 6)
+(eql (mismatch '(a b c x y z a b c) '(x y z a b c x y z) :start1 6 :start2 3)
+ 9)
+(eql (mismatch '(a b c x y z a b c) '(x y z a b c x y z) :start1 0 :start2 3)
+ 6)
+(eql (mismatch '(a b c) '(a b c x y z)) 3)
+(eql (mismatch '(a b c) '(x a b c y z)) 0)
+(eql (mismatch '(a b c) '(x a b c y z) :start2 1) 3)
+(eql (mismatch '(a b c) '(x a b c y z) :start2 1 :end2 nil) 3)
+(null (mismatch '(a b c) '(x a b c y z) :start2 1 :end2 4))
+
+(eql (mismatch '(a b c d e) '(c d)) 0)
+(eql (mismatch '(a b c d e) '(c d) :start1 2) 4)
+(eql (mismatch '(a b c d e) '(c d) :start1 2 :end1 3) 3)
+(eql (mismatch '(a b c d e) '(c d) :start1 2 :start2 1) 2)
+(eql (mismatch '(a b c d e) '(c d) :start1 3 :start2 1) 4)
+(eql (mismatch '(a b c d e) '(c d) :start1 2 :end2 1) 3)
+(null (mismatch '(a b c d) '(a b c d) :start1 1 :end1 2 :start2 1 :end2 2))
+(null (mismatch '(a b c d) '(a b c d) :start1 1 :end1 3 :start2 1 :end2 3))
+(null (mismatch '(a b c d) '(a b c d) :start1 1 :end1 4 :start2 1 :end2 4))
+(eql (mismatch '(a b c d) '(a b c d) :start1 1 :end1 nil :start2 1 :end2 1) 1)
+(eql (mismatch '(a b c d) '(a b c d) :start1 1 :end1 nil :start2 1 :end2 2) 2)
+(eql (mismatch '(a b c d) '(a b c d) :start1 1 :end1 nil :start2 1 :end2 3) 3)
+(null (mismatch '(a b c d) '(a b c d) :start1 1 :end1 nil :start2 1 :end2 4))
+(eql (mismatch '(a b c d) '(a b c d) :start1 1 :end1 1 :start2 1) 1)
+(eql (mismatch '(a b c d) '(a b c d) :start1 1 :end1 2 :start2 1) 2)
+(eql (mismatch '(a b c d) '(a b c d) :start1 1 :end1 3 :start2 1) 3)
+(null (mismatch '(a b c d) '(a b c d) :start1 1 :end1 4 :start2 1))
+
+(null (mismatch '(a b c) '(a b c) :from-end t))
+(eql (mismatch '(a b c d) '(a b c) :from-end t) 4)
+(eql (mismatch '(a b c) '(c) :from-end t) 2)
+(eql (mismatch '(a b c) '(z a b c) :from-end t) 0)
+(eql (mismatch '(a b c) '(x y z a b c) :from-end t) 0)
+(eql (mismatch '(x y z a b c) '(a b c) :from-end t) 3)
+(eql (mismatch '(x y z a b c) '(a b c) :end1 3 :from-end t) 3)
+(eql (mismatch '(x y z a b c) '(a b c) :end1 5 :from-end t) 5)
+(eql (mismatch '(x y z a b c x y z) '(a b c) :end1 6 :from-end t) 3)
+(eql (mismatch '(x y z a b c x y z) '(a b c) :start1 2 :end1 6 :from-end t) 3)
+(eql (mismatch '(x y z a b c x y z) '(a b c)
+ :from-end t
+ :start1 2 :end1 5
+ :start2 1 :end2 2
+ ) 4)
+(eql (mismatch '(x y z a b c x y z) '(a b c)
+ :start1 2 :end1 5
+ :start2 1 :end2 2
+ ) 2)
+(eql (mismatch '((a) (b) (c)) '((a) (b) (c))) 0)
+(null (mismatch '((a) (b) (c)) '((a) (b) (c)) :key #'car))
+(null (mismatch '((a) (b) (c)) '((a) (b) (c)) :test #'equal))
+(eql (mismatch '(#(a) #(b) #(c)) '(#(a) #(b) #(c))) 0)
+(null (mismatch '(#(a) #(b) #(c)) '(#(a) #(b) #(c)) :test #'equalp))
+(eql (mismatch '((a) (b) (c) (d)) '((a) (b) (c)) :key #'car) 3)
+(eql (mismatch '((a) (b) (c)) '((a) (b) (c) (d)) :key #'car) 3)
+(eql (mismatch '(#\a #\b #\c) '(#\A #\B #\C)) 0)
+(null (mismatch '(#\a #\b #\c) '(#\A #\B #\C) :key #'char-upcase))
+(null (mismatch '(#\a #\b #\c) '(#\A #\B #\C) :key #'char-downcase))
+(null (mismatch '(#\a #\b #\c) '(#\A #\B #\C)
+ :key #'char-upcase
+ :start1 1 :end1 2
+ :start2 1 :end2 2))
+(null (mismatch '(#\a #\b #\c) '(#\A #\B #\C)
+ :key #'char-upcase
+ :start1 2
+ :start2 2))
+(eql (mismatch '((a b c) (b c d) (d e f))
+ '((b b c) (c c d) (e e f)))
+ 0)
+(eql (mismatch '((a b c) (b c d) (d e f))
+ '((b b c) (c c d) (e e f))
+ :key #'cdr)
+ 0)
+(null (mismatch '((a b c) (b c d) (d e f))
+ '((b b c) (c c d) (e e f))
+ :key #'cdr
+ :test #'equal))
+(eql (mismatch '((a b c) (b c d) (d e f) (e f g))
+ '((b b c) (c c d) (e e f))
+ :key #'cdr
+ :test #'equal)
+ 3)
+(eql (mismatch '((a b c) (b c d) (d e f) (e f g))
+ '((b b c) (c c d) (e e f))
+ :key #'cdr
+ :test #'equal
+ :from-end t)
+ 4)
+(eql (mismatch '((a a a) (a b c) (b c d) (d e f))
+ '((b b c) (c c d) (e e f))
+ :key #'cdr
+ :test #'equal
+ :from-end t)
+ 1)
+(null (mismatch '((a a a) (a b c) (b c d) (d e f) (e f g))
+ '((b b c) (c c d) (e e f))
+ :key #'cdr
+ :test #'equal
+ :from-end t
+ :start1 1
+ :end1 4))
+(eql (mismatch '((a a a) (a b c) (b c d) (d e f) (e f g))
+ '((b b c) (c c d) (e e f))
+ :key #'cdr
+ :test #'equal
+ :from-end t
+ :start1 1)
+ 5)
+(eql (mismatch '((a a a) (a b c) (b c d) (d e f) (e f g))
+ '((b b c) (c c d) (e e f))
+ :key #'cdr
+ :test #'equal
+ :from-end t
+ :end1 3
+ :start2 1
+ :end2 2)
+
+ 2)
+
+
+(null (mismatch #() '()))
+(eql (mismatch #(a b c) '(x y z)) 0)
+(eql (mismatch #() '(x y z)) 0)
+(eql (mismatch #(x y z) '()) 0)
+(null (mismatch #(a) '(a)))
+(eql (mismatch #(a b c x y z) '(a b c)) 3)
+(null (mismatch #(a b c) '(a b c)))
+(eql (mismatch #(a b c d e f) '(a b c)) 3)
+(eql (mismatch #(a b c) '(a b c d e f)) 3)
+(eql (mismatch #(a b c) '(a b x)) 2)
+(eql (mismatch #(a b c) '(a x c)) 1)
+(eql (mismatch #(a b c) '(x b c)) 0)
+(eql (mismatch #(x y z a b c x y z) '(a b c) :start1 3) 6)
+(eql (mismatch #(x y z a b c x y z) '(a b c) :start1 3 :end1 nil) 6)
+(eql (mismatch #(x y z a b c x y z) '(a b c) :start1 3 :end1 4) 4)
+(eql (mismatch #(x y z a b c x y z) '(a b c) :start1 3 :end1 3) 3)
+(null (mismatch #(x y z) '() :start1 0 :end1 0))
+(null (mismatch #(x y z) '() :start1 1 :end1 1))
+(null (mismatch #(x y z) '() :start1 2 :end1 2))
+(null (mismatch #(x y z) '() :start1 3 :end1 3))
+(null (mismatch #(x y z) '() :start1 0 :end1 0 :start2 0 :end2 0))
+(null (mismatch #(x y z) '() :start1 1 :end1 1 :start2 1 :end2 1))
+(null (mismatch #(x y z) '() :start1 2 :end1 2 :start2 2 :end2 2))
+(null (mismatch #(x y z) '() :start1 3 :end1 3 :start2 3 :end2 3))
+(null (mismatch #(x y z) '() :start1 0 :end1 0 :start2 3 :end2 3))
+(null (mismatch #(x y z) '() :start1 1 :end1 1 :start2 2 :end2 2))
+(null (mismatch #(x y z) '() :start1 2 :end1 2 :start2 1 :end2 1))
+(null (mismatch #(x y z) '() :start1 3 :end1 3 :start2 0 :end2 0))
+(eql (mismatch #(x y z) '(a b c) :start1 0 :end1 0) 0)
+(eql (mismatch #(x y z) '(a b c) :start1 1 :end1 1) 1)
+(eql (mismatch #(x y z) '(a b c) :start1 2 :end1 2) 2)
+(eql (mismatch #(x y z) '(a b c) :start1 3 :end1 3) 3)
+(eql (mismatch #(x y z) '(x y z) :start1 0 :end1 1) 1)
+(eql (mismatch #(x y z) '(x y z) :start1 0 :end1 2) 2)
+(eql (mismatch #(x y z) '(x y z Z) :start1 0 :end1 3) 3)
+(null (mismatch #(x y z) '(x y z) :start1 0 :end1 3))
+(eql (mismatch #(a b c x y z) '(x y z a b c)) 0)
+(eql (mismatch #(a b c x y z) '(x y z a b c) :start1 3) 6)
+(eql (mismatch #(a b c x y z a b c) '(x y z a b c x y z) :start1 3) 9)
+(eql (mismatch #(a b c x y z a b c) '(x y z a b c x y z) :start1 6) 6)
+(eql (mismatch #(a b c x y z a b c) '(x y z a b c x y z) :start1 6 :start2 3)
+ 9)
+(eql (mismatch #(a b c x y z a b c) '(x y z a b c x y z) :start1 0 :start2 3)
+ 6)
+(eql (mismatch #(a b c) '(a b c x y z)) 3)
+(eql (mismatch #(a b c) '(x a b c y z)) 0)
+(eql (mismatch #(a b c) '(x a b c y z) :start2 1) 3)
+(eql (mismatch #(a b c) '(x a b c y z) :start2 1 :end2 nil) 3)
+(null (mismatch #(a b c) '(x a b c y z) :start2 1 :end2 4))
+(eql (mismatch #(a b c d e) '(c d)) 0)
+(eql (mismatch #(a b c d e) '(c d) :start1 2) 4)
+(eql (mismatch #(a b c d e) '(c d) :start1 2 :end1 3) 3)
+(eql (mismatch #(a b c d e) '(c d) :start1 2 :start2 1) 2)
+(eql (mismatch #(a b c d e) '(c d) :start1 3 :start2 1) 4)
+(eql (mismatch #(a b c d e) '(c d) :start1 2 :end2 1) 3)
+(null (mismatch #(a b c d) '(a b c d) :start1 1 :end1 2 :start2 1 :end2 2))
+(null (mismatch #(a b c d) '(a b c d) :start1 1 :end1 3 :start2 1 :end2 3))
+(null (mismatch #(a b c d) '(a b c d) :start1 1 :end1 4 :start2 1 :end2 4))
+(eql (mismatch #(a b c d) '(a b c d) :start1 1 :end1 nil :start2 1 :end2 1) 1)
+(eql (mismatch #(a b c d) '(a b c d) :start1 1 :end1 nil :start2 1 :end2 2) 2)
+(eql (mismatch #(a b c d) '(a b c d) :start1 1 :end1 nil :start2 1 :end2 3) 3)
+(null (mismatch #(a b c d) '(a b c d) :start1 1 :end1 nil :start2 1 :end2 4))
+(eql (mismatch #(a b c d) '(a b c d) :start1 1 :end1 1 :start2 1) 1)
+(eql (mismatch #(a b c d) '(a b c d) :start1 1 :end1 2 :start2 1) 2)
+(eql (mismatch #(a b c d) '(a b c d) :start1 1 :end1 3 :start2 1) 3)
+(null (mismatch #(a b c d) '(a b c d) :start1 1 :end1 4 :start2 1))
+(null (mismatch #(a b c) '(a b c) :from-end t))
+(eql (mismatch #(a b c d) '(a b c) :from-end t) 4)
+(eql (mismatch #(a b c) '(c) :from-end t) 2)
+(eql (mismatch #(a b c) '(z a b c) :from-end t) 0)
+(eql (mismatch #(a b c) '(x y z a b c) :from-end t) 0)
+(eql (mismatch #(x y z a b c) '(a b c) :from-end t) 3)
+(eql (mismatch #(x y z a b c) '(a b c) :end1 3 :from-end t) 3)
+(eql (mismatch #(x y z a b c) '(a b c) :end1 5 :from-end t) 5)
+(eql (mismatch #(x y z a b c x y z) '(a b c) :end1 6 :from-end t) 3)
+(eql (mismatch #(x y z a b c x y z) '(a b c) :start1 2 :end1 6 :from-end t) 3)
+(eql (mismatch #(x y z a b c x y z) '(a b c)
+ :from-end t
+ :start1 2 :end1 5
+ :start2 1 :end2 2
+ ) 4)
+(eql (mismatch #(x y z a b c x y z) '(a b c)
+ :start1 2 :end1 5
+ :start2 1 :end2 2
+ ) 2)
+(eql (mismatch #((a) (b) (c)) '((a) (b) (c))) 0)
+(null (mismatch #((a) (b) (c)) '((a) (b) (c)) :key #'car))
+(null (mismatch #((a) (b) (c)) '((a) (b) (c)) :test #'equal))
+(eql (mismatch #(#(a) #(b) #(c)) '(#(a) #(b) #(c))) 0)
+(null (mismatch #(#(a) #(b) #(c)) '(#(a) #(b) #(c)) :test #'equalp))
+(eql (mismatch #((a) (b) (c) (d)) '((a) (b) (c)) :key #'car) 3)
+(eql (mismatch #((a) (b) (c)) '((a) (b) (c) (d)) :key #'car) 3)
+(eql (mismatch #(#\a #\b #\c) '(#\A #\B #\C)) 0)
+(null (mismatch #(#\a #\b #\c) '(#\A #\B #\C) :key #'char-upcase))
+(null (mismatch #(#\a #\b #\c) '(#\A #\B #\C) :key #'char-downcase))
+(null (mismatch #(#\a #\b #\c) '(#\A #\B #\C)
+ :key #'char-upcase
+ :start1 1 :end1 2
+ :start2 1 :end2 2))
+(null (mismatch #(#\a #\b #\c) '(#\A #\B #\C)
+ :key #'char-upcase
+ :start1 2
+ :start2 2))
+(eql (mismatch #((a b c) (b c d) (d e f))
+ '((b b c) (c c d) (e e f)))
+ 0)
+(eql (mismatch #((a b c) (b c d) (d e f))
+ '((b b c) (c c d) (e e f))
+ :key #'cdr)
+ 0)
+(null (mismatch #((a b c) (b c d) (d e f))
+ '((b b c) (c c d) (e e f))
+ :key #'cdr
+ :test #'equal))
+(eql (mismatch #((a b c) (b c d) (d e f) (e f g))
+ '((b b c) (c c d) (e e f))
+ :key #'cdr
+ :test #'equal)
+ 3)
+(eql (mismatch #((a b c) (b c d) (d e f) (e f g))
+ '((b b c) (c c d) (e e f))
+ :key #'cdr
+ :test #'equal
+ :from-end t)
+ 4)
+(eql (mismatch #((a a a) (a b c) (b c d) (d e f))
+ '((b b c) (c c d) (e e f))
+ :key #'cdr
+ :test #'equal
+ :from-end t)
+ 1)
+(null (mismatch #((a a a) (a b c) (b c d) (d e f) (e f g))
+ '((b b c) (c c d) (e e f))
+ :key #'cdr
+ :test #'equal
+ :from-end t
+ :start1 1
+ :end1 4))
+(eql (mismatch #((a a a) (a b c) (b c d) (d e f) (e f g))
+ '((b b c) (c c d) (e e f))
+ :key #'cdr
+ :test #'equal
+ :from-end t
+ :start1 1)
+ 5)
+(eql (mismatch #((a a a) (a b c) (b c d) (d e f) (e f g))
+ '((b b c) (c c d) (e e f))
+ :key #'cdr
+ :test #'equal
+ :from-end t
+ :end1 3
+ :start2 1
+ :end2 2)
+
+ 2)
+
+
+(null (mismatch '() #()))
+(eql (mismatch '(a b c) #(x y z)) 0)
+(eql (mismatch '() #(x y z)) 0)
+(eql (mismatch '(x y z) #()) 0)
+(null (mismatch '(a) #(a)))
+(eql (mismatch '(a b c x y z) #(a b c)) 3)
+(null (mismatch '(a b c) #(a b c)))
+(eql (mismatch '(a b c d e f) #(a b c)) 3)
+(eql (mismatch '(a b c) #(a b c d e f)) 3)
+(eql (mismatch '(a b c) #(a b x)) 2)
+(eql (mismatch '(a b c) #(a x c)) 1)
+(eql (mismatch '(a b c) #(x b c)) 0)
+(eql (mismatch '(x y z a b c x y z) #(a b c) :start1 3) 6)
+(eql (mismatch '(x y z a b c x y z) #(a b c) :start1 3 :end1 nil) 6)
+(eql (mismatch '(x y z a b c x y z) #(a b c) :start1 3 :end1 4) 4)
+(eql (mismatch '(x y z a b c x y z) #(a b c) :start1 3 :end1 3) 3)
+(null (mismatch '(x y z) #() :start1 0 :end1 0))
+(null (mismatch '(x y z) #() :start1 1 :end1 1))
+(null (mismatch '(x y z) #() :start1 2 :end1 2))
+(null (mismatch '(x y z) #() :start1 3 :end1 3))
+(null (mismatch '(x y z) #() :start1 0 :end1 0 :start2 0 :end2 0))
+(null (mismatch '(x y z) #() :start1 1 :end1 1 :start2 1 :end2 1))
+(null (mismatch '(x y z) #() :start1 2 :end1 2 :start2 2 :end2 2))
+(null (mismatch '(x y z) #() :start1 3 :end1 3 :start2 3 :end2 3))
+(null (mismatch '(x y z) #() :start1 0 :end1 0 :start2 3 :end2 3))
+(null (mismatch '(x y z) #() :start1 1 :end1 1 :start2 2 :end2 2))
+(null (mismatch '(x y z) #() :start1 2 :end1 2 :start2 1 :end2 1))
+(null (mismatch '(x y z) #() :start1 3 :end1 3 :start2 0 :end2 0))
+(eql (mismatch '(x y z) #(a b c) :start1 0 :end1 0) 0)
+(eql (mismatch '(x y z) #(a b c) :start1 1 :end1 1) 1)
+(eql (mismatch '(x y z) #(a b c) :start1 2 :end1 2) 2)
+(eql (mismatch '(x y z) #(a b c) :start1 3 :end1 3) 3)
+(eql (mismatch '(x y z) #(x y z) :start1 0 :end1 1) 1)
+(eql (mismatch '(x y z) #(x y z) :start1 0 :end1 2) 2)
+(eql (mismatch '(x y z) #(x y z Z) :start1 0 :end1 3) 3)
+(null (mismatch '(x y z) #(x y z) :start1 0 :end1 3))
+(eql (mismatch '(a b c x y z) #(x y z a b c)) 0)
+(eql (mismatch '(a b c x y z) #(x y z a b c) :start1 3) 6)
+(eql (mismatch '(a b c x y z a b c) #(x y z a b c x y z) :start1 3) 9)
+(eql (mismatch '(a b c x y z a b c) #(x y z a b c x y z) :start1 6) 6)
+(eql (mismatch '(a b c x y z a b c) #(x y z a b c x y z) :start1 6 :start2 3)
+ 9)
+(eql (mismatch '(a b c x y z a b c) #(x y z a b c x y z) :start1 0 :start2 3)
+ 6)
+(eql (mismatch '(a b c) #(a b c x y z)) 3)
+(eql (mismatch '(a b c) #(x a b c y z)) 0)
+(eql (mismatch '(a b c) #(x a b c y z) :start2 1) 3)
+(eql (mismatch '(a b c) #(x a b c y z) :start2 1 :end2 nil) 3)
+(null (mismatch '(a b c) #(x a b c y z) :start2 1 :end2 4))
+(eql (mismatch '(a b c d e) #(c d)) 0)
+(eql (mismatch '(a b c d e) #(c d) :start1 2) 4)
+(eql (mismatch '(a b c d e) #(c d) :start1 2 :end1 3) 3)
+(eql (mismatch '(a b c d e) #(c d) :start1 2 :start2 1) 2)
+(eql (mismatch '(a b c d e) #(c d) :start1 3 :start2 1) 4)
+(eql (mismatch '(a b c d e) #(c d) :start1 2 :end2 1) 3)
+(null (mismatch '(a b c d) #(a b c d) :start1 1 :end1 2 :start2 1 :end2 2))
+(null (mismatch '(a b c d) #(a b c d) :start1 1 :end1 3 :start2 1 :end2 3))
+(null (mismatch '(a b c d) #(a b c d) :start1 1 :end1 4 :start2 1 :end2 4))
+(eql (mismatch '(a b c d) #(a b c d) :start1 1 :end1 nil :start2 1 :end2 1) 1)
+(eql (mismatch '(a b c d) #(a b c d) :start1 1 :end1 nil :start2 1 :end2 2) 2)
+(eql (mismatch '(a b c d) #(a b c d) :start1 1 :end1 nil :start2 1 :end2 3) 3)
+(null (mismatch '(a b c d) #(a b c d) :start1 1 :end1 nil :start2 1 :end2 4))
+(eql (mismatch '(a b c d) #(a b c d) :start1 1 :end1 1 :start2 1) 1)
+(eql (mismatch '(a b c d) #(a b c d) :start1 1 :end1 2 :start2 1) 2)
+(eql (mismatch '(a b c d) #(a b c d) :start1 1 :end1 3 :start2 1) 3)
+(null (mismatch '(a b c d) #(a b c d) :start1 1 :end1 4 :start2 1))
+(null (mismatch '(a b c) #(a b c) :from-end t))
+(eql (mismatch '(a b c d) #(a b c) :from-end t) 4)
+(eql (mismatch '(a b c) #(c) :from-end t) 2)
+(eql (mismatch '(a b c) #(z a b c) :from-end t) 0)
+(eql (mismatch '(a b c) #(x y z a b c) :from-end t) 0)
+(eql (mismatch '(x y z a b c) #(a b c) :from-end t) 3)
+(eql (mismatch '(x y z a b c) #(a b c) :end1 3 :from-end t) 3)
+(eql (mismatch '(x y z a b c) #(a b c) :end1 5 :from-end t) 5)
+(eql (mismatch '(x y z a b c x y z) #(a b c) :end1 6 :from-end t) 3)
+(eql (mismatch '(x y z a b c x y z) #(a b c) :start1 2 :end1 6 :from-end t) 3)
+(eql (mismatch '(x y z a b c x y z) #(a b c)
+ :from-end t
+ :start1 2 :end1 5
+ :start2 1 :end2 2
+ ) 4)
+(eql (mismatch '(x y z a b c x y z) #(a b c)
+ :start1 2 :end1 5
+ :start2 1 :end2 2
+ ) 2)
+(eql (mismatch '((a) (b) (c)) #((a) (b) (c))) 0)
+(null (mismatch '((a) (b) (c)) #((a) (b) (c)) :key #'car))
+(null (mismatch '((a) (b) (c)) #((a) (b) (c)) :test #'equal))
+(eql (mismatch '(#(a) #(b) #(c)) #(#(a) #(b) #(c))) 0)
+(null (mismatch '(#(a) #(b) #(c)) #(#(a) #(b) #(c)) :test #'equalp))
+(eql (mismatch '((a) (b) (c) (d)) #((a) (b) (c)) :key #'car) 3)
+(eql (mismatch '((a) (b) (c)) #((a) (b) (c) (d)) :key #'car) 3)
+(eql (mismatch '(#\a #\b #\c) #(#\A #\B #\C)) 0)
+(null (mismatch '(#\a #\b #\c) #(#\A #\B #\C) :key #'char-upcase))
+(null (mismatch '(#\a #\b #\c) #(#\A #\B #\C) :key #'char-downcase))
+(null (mismatch '(#\a #\b #\c) #(#\A #\B #\C)
+ :key #'char-upcase
+ :start1 1 :end1 2
+ :start2 1 :end2 2))
+(null (mismatch '(#\a #\b #\c) #(#\A #\B #\C)
+ :key #'char-upcase
+ :start1 2
+ :start2 2))
+(eql (mismatch '((a b c) (b c d) (d e f))
+ #((b b c) (c c d) (e e f)))
+ 0)
+(eql (mismatch '((a b c) (b c d) (d e f))
+ #((b b c) (c c d) (e e f))
+ :key #'cdr)
+ 0)
+(null (mismatch '((a b c) (b c d) (d e f))
+ #((b b c) (c c d) (e e f))
+ :key #'cdr
+ :test #'equal))
+(eql (mismatch '((a b c) (b c d) (d e f) (e f g))
+ #((b b c) (c c d) (e e f))
+ :key #'cdr
+ :test #'equal)
+ 3)
+(eql (mismatch '((a b c) (b c d) (d e f) (e f g))
+ #((b b c) (c c d) (e e f))
+ :key #'cdr
+ :test #'equal
+ :from-end t)
+ 4)
+(eql (mismatch '((a a a) (a b c) (b c d) (d e f))
+ #((b b c) (c c d) (e e f))
+ :key #'cdr
+ :test #'equal
+ :from-end t)
+ 1)
+(null (mismatch '((a a a) (a b c) (b c d) (d e f) (e f g))
+ #((b b c) (c c d) (e e f))
+ :key #'cdr
+ :test #'equal
+ :from-end t
+ :start1 1
+ :end1 4))
+(eql (mismatch '((a a a) (a b c) (b c d) (d e f) (e f g))
+ #((b b c) (c c d) (e e f))
+ :key #'cdr
+ :test #'equal
+ :from-end t
+ :start1 1)
+ 5)
+(eql (mismatch '((a a a) (a b c) (b c d) (d e f) (e f g))
+ #((b b c) (c c d) (e e f))
+ :key #'cdr
+ :test #'equal
+ :from-end t
+ :end1 3
+ :start2 1
+ :end2 2)
+
+ 2)
+
+
+(null (mismatch #() #()))
+(eql (mismatch #(a b c) #(x y z)) 0)
+(eql (mismatch #() #(x y z)) 0)
+(eql (mismatch #(x y z) #()) 0)
+(null (mismatch #(a) #(a)))
+(eql (mismatch #(a b c x y z) #(a b c)) 3)
+(null (mismatch #(a b c) #(a b c)))
+(eql (mismatch #(a b c d e f) #(a b c)) 3)
+(eql (mismatch #(a b c) #(a b c d e f)) 3)
+(eql (mismatch #(a b c) #(a b x)) 2)
+(eql (mismatch #(a b c) #(a x c)) 1)
+(eql (mismatch #(a b c) #(x b c)) 0)
+(eql (mismatch #(x y z a b c x y z) #(a b c) :start1 3) 6)
+(eql (mismatch #(x y z a b c x y z) #(a b c) :start1 3 :end1 nil) 6)
+(eql (mismatch #(x y z a b c x y z) #(a b c) :start1 3 :end1 4) 4)
+(eql (mismatch #(x y z a b c x y z) #(a b c) :start1 3 :end1 3) 3)
+(null (mismatch #(x y z) #() :start1 0 :end1 0))
+(null (mismatch #(x y z) #() :start1 1 :end1 1))
+(null (mismatch #(x y z) #() :start1 2 :end1 2))
+(null (mismatch #(x y z) #() :start1 3 :end1 3))
+(null (mismatch #(x y z) #() :start1 0 :end1 0 :start2 0 :end2 0))
+(null (mismatch #(x y z) #() :start1 1 :end1 1 :start2 1 :end2 1))
+(null (mismatch #(x y z) #() :start1 2 :end1 2 :start2 2 :end2 2))
+(null (mismatch #(x y z) #() :start1 3 :end1 3 :start2 3 :end2 3))
+(null (mismatch #(x y z) #() :start1 0 :end1 0 :start2 3 :end2 3))
+(null (mismatch #(x y z) #() :start1 1 :end1 1 :start2 2 :end2 2))
+(null (mismatch #(x y z) #() :start1 2 :end1 2 :start2 1 :end2 1))
+(null (mismatch #(x y z) #() :start1 3 :end1 3 :start2 0 :end2 0))
+(eql (mismatch #(x y z) #(a b c) :start1 0 :end1 0) 0)
+(eql (mismatch #(x y z) #(a b c) :start1 1 :end1 1) 1)
+(eql (mismatch #(x y z) #(a b c) :start1 2 :end1 2) 2)
+(eql (mismatch #(x y z) #(a b c) :start1 3 :end1 3) 3)
+(eql (mismatch #(x y z) #(x y z) :start1 0 :end1 1) 1)
+(eql (mismatch #(x y z) #(x y z) :start1 0 :end1 2) 2)
+(eql (mismatch #(x y z) #(x y z Z) :start1 0 :end1 3) 3)
+(null (mismatch #(x y z) #(x y z) :start1 0 :end1 3))
+(eql (mismatch #(a b c x y z) #(x y z a b c)) 0)
+(eql (mismatch #(a b c x y z) #(x y z a b c) :start1 3) 6)
+(eql (mismatch #(a b c x y z a b c) #(x y z a b c x y z) :start1 3) 9)
+(eql (mismatch #(a b c x y z a b c) #(x y z a b c x y z) :start1 6) 6)
+(eql (mismatch #(a b c x y z a b c) #(x y z a b c x y z) :start1 6 :start2 3)
+ 9)
+(eql (mismatch #(a b c x y z a b c) #(x y z a b c x y z) :start1 0 :start2 3)
+ 6)
+(eql (mismatch #(a b c) #(a b c x y z)) 3)
+(eql (mismatch #(a b c) #(x a b c y z)) 0)
+(eql (mismatch #(a b c) #(x a b c y z) :start2 1) 3)
+(eql (mismatch #(a b c) #(x a b c y z) :start2 1 :end2 nil) 3)
+(null (mismatch #(a b c) #(x a b c y z) :start2 1 :end2 4))
+(eql (mismatch #(a b c d e) #(c d)) 0)
+(eql (mismatch #(a b c d e) #(c d) :start1 2) 4)
+(eql (mismatch #(a b c d e) #(c d) :start1 2 :end1 3) 3)
+(eql (mismatch #(a b c d e) #(c d) :start1 2 :start2 1) 2)
+(eql (mismatch #(a b c d e) #(c d) :start1 3 :start2 1) 4)
+(eql (mismatch #(a b c d e) #(c d) :start1 2 :end2 1) 3)
+(null (mismatch #(a b c d) #(a b c d) :start1 1 :end1 2 :start2 1 :end2 2))
+(null (mismatch #(a b c d) #(a b c d) :start1 1 :end1 3 :start2 1 :end2 3))
+(null (mismatch #(a b c d) #(a b c d) :start1 1 :end1 4 :start2 1 :end2 4))
+(eql (mismatch #(a b c d) #(a b c d) :start1 1 :end1 nil :start2 1 :end2 1) 1)
+(eql (mismatch #(a b c d) #(a b c d) :start1 1 :end1 nil :start2 1 :end2 2) 2)
+(eql (mismatch #(a b c d) #(a b c d) :start1 1 :end1 nil :start2 1 :end2 3) 3)
+(null (mismatch #(a b c d) #(a b c d) :start1 1 :end1 nil :start2 1 :end2 4))
+(eql (mismatch #(a b c d) #(a b c d) :start1 1 :end1 1 :start2 1) 1)
+(eql (mismatch #(a b c d) #(a b c d) :start1 1 :end1 2 :start2 1) 2)
+(eql (mismatch #(a b c d) #(a b c d) :start1 1 :end1 3 :start2 1) 3)
+(null (mismatch #(a b c d) #(a b c d) :start1 1 :end1 4 :start2 1))
+(null (mismatch #(a b c) #(a b c) :from-end t))
+(eql (mismatch #(a b c d) #(a b c) :from-end t) 4)
+(eql (mismatch #(a b c) #(c) :from-end t) 2)
+(eql (mismatch #(a b c) #(z a b c) :from-end t) 0)
+(eql (mismatch #(a b c) #(x y z a b c) :from-end t) 0)
+(eql (mismatch #(x y z a b c) #(a b c) :from-end t) 3)
+(eql (mismatch #(x y z a b c) #(a b c) :end1 3 :from-end t) 3)
+(eql (mismatch #(x y z a b c) #(a b c) :end1 5 :from-end t) 5)
+(eql (mismatch #(x y z a b c x y z) #(a b c) :end1 6 :from-end t) 3)
+(eql (mismatch #(x y z a b c x y z) #(a b c) :start1 2 :end1 6 :from-end t) 3)
+(eql (mismatch #(x y z a b c x y z) #(a b c)
+ :from-end t
+ :start1 2 :end1 5
+ :start2 1 :end2 2
+ ) 4)
+(eql (mismatch #(x y z a b c x y z) #(a b c)
+ :start1 2 :end1 5
+ :start2 1 :end2 2
+ ) 2)
+(eql (mismatch #((a) (b) (c)) #((a) (b) (c))) 0)
+(null (mismatch #((a) (b) (c)) #((a) (b) (c)) :key #'car))
+(null (mismatch #((a) (b) (c)) #((a) (b) (c)) :test #'equal))
+(eql (mismatch #(#(a) #(b) #(c)) #(#(a) #(b) #(c))) 0)
+(null (mismatch #(#(a) #(b) #(c)) #(#(a) #(b) #(c)) :test #'equalp))
+(eql (mismatch #((a) (b) (c) (d)) #((a) (b) (c)) :key #'car) 3)
+(eql (mismatch #((a) (b) (c)) #((a) (b) (c) (d)) :key #'car) 3)
+(eql (mismatch #(#\a #\b #\c) #(#\A #\B #\C)) 0)
+(null (mismatch #(#\a #\b #\c) #(#\A #\B #\C) :key #'char-upcase))
+(null (mismatch #(#\a #\b #\c) #(#\A #\B #\C) :key #'char-downcase))
+(null (mismatch #(#\a #\b #\c) #(#\A #\B #\C)
+ :key #'char-upcase
+ :start1 1 :end1 2
+ :start2 1 :end2 2))
+(null (mismatch #(#\a #\b #\c) #(#\A #\B #\C)
+ :key #'char-upcase
+ :start1 2
+ :start2 2))
+(eql (mismatch #((a b c) (b c d) (d e f))
+ #((b b c) (c c d) (e e f)))
+ 0)
+(eql (mismatch #((a b c) (b c d) (d e f))
+ #((b b c) (c c d) (e e f))
+ :key #'cdr)
+ 0)
+(null (mismatch #((a b c) (b c d) (d e f))
+ #((b b c) (c c d) (e e f))
+ :key #'cdr
+ :test #'equal))
+(eql (mismatch #((a b c) (b c d) (d e f) (e f g))
+ #((b b c) (c c d) (e e f))
+ :key #'cdr
+ :test #'equal)
+ 3)
+(eql (mismatch #((a b c) (b c d) (d e f) (e f g))
+ #((b b c) (c c d) (e e f))
+ :key #'cdr
+ :test #'equal
+ :from-end t)
+ 4)
+(eql (mismatch #((a a a) (a b c) (b c d) (d e f))
+ #((b b c) (c c d) (e e f))
+ :key #'cdr
+ :test #'equal
+ :from-end t)
+ 1)
+(null (mismatch #((a a a) (a b c) (b c d) (d e f) (e f g))
+ #((b b c) (c c d) (e e f))
+ :key #'cdr
+ :test #'equal
+ :from-end t
+ :start1 1
+ :end1 4))
+(eql (mismatch #((a a a) (a b c) (b c d) (d e f) (e f g))
+ #((b b c) (c c d) (e e f))
+ :key #'cdr
+ :test #'equal
+ :from-end t
+ :start1 1)
+ 5)
+(eql (mismatch #((a a a) (a b c) (b c d) (d e f) (e f g))
+ #((b b c) (c c d) (e e f))
+ :key #'cdr
+ :test #'equal
+ :from-end t
+ :end1 3
+ :start2 1
+ :end2 2)
+
+ 2)
+
+
+(eql (mismatch "abc" "xyz") 0)
+(null (mismatch "" ""))
+(null (mismatch "a" "a"))
+(null (mismatch "abc" "abc"))
+(null (mismatch "abc" "ABC" :key #'char-downcase))
+(null (mismatch "abc" "ABC" :test #'char-equal))
+(eql (mismatch "abcde" "abc") 3)
+(eql (mismatch "abc" "abcde") 3)
+(eql (mismatch "abc" "abxyz") 2)
+(eql (mismatch "abcde" "abx") 2)
+(null (mismatch "abc" "abc" :from-end t))
+(eql (mismatch "abcxyz" "xyzxyz" :from-end t) 3)
+(eql (mismatch "abcxyz" "xyz" :from-end t) 3)
+(eql (mismatch "xyz" "abcxyz" :from-end t) 0)
+(eql (mismatch "ayz" "abcxyz" :from-end t) 1)
+(null (mismatch "abc" "xyz" :test #'char<))
+(eql (mismatch "abc" "xyz" :test #'char>) 0)
+(eql (mismatch "abcxyz" "abcdefg") 3)
+(eql (mismatch "1xyz" "22xyz" :from-end t) 1)
+
+(null (mismatch #*010101 #*010101))
+(eql (mismatch #*010 #*101) 0)
+(eql (mismatch #*010 #*101 :from-end t) 3)
+(eql (mismatch #*0101 #*010101) 4)
+(eql (mismatch #*010101 #*0101) 4)
+(eql (mismatch #*010100 #*010111) 4)
+(null (mismatch #*0101 #*0101 :from-end t))
+(eql (mismatch #*00101 #*0101 :from-end t) 1)
+(eql (mismatch #*0101 #*00101 :from-end t) 0)
+(eql (mismatch #*00101 #*10101 :from-end t) 1)
+
+
+
+(equal (replace "abcdefghij" "0123456789" :start1 4 :end1 7 :start2 4)
+ "abcd456hij")
+(let ((lst (copy-seq "012345678")))
+ (and (equal (replace lst lst :start1 2 :start2 0) "010123456")
+ (equal lst "010123456")))
+
+
+(let* ((list0 (list 'a 'b 'c 'd 'e))
+ (list (replace list0 '(x y z))))
+ (and (eq list0 list)
+ (equal list0 '(x y z d e))))
+
+(let* ((list0 (list 'a 'b 'c 'd 'e))
+ (list (replace list0 '(x y z) :start1 1)))
+ (and (eq list0 list)
+ (equal list0 '(a x y z e))))
+
+(let* ((list0 (list 'a 'b 'c 'd 'e))
+ (list (replace list0 '(x y z) :start1 1 :end1 nil)))
+ (and (eq list0 list)
+ (equal list0 '(a x y z e))))
+
+(let* ((list0 (list 'a 'b 'c 'd 'e))
+ (list (replace list0 '(x y z) :start1 1 :start2 1)))
+ (and (eq list0 list)
+ (equal list0 '(a y z d e))))
+
+(let* ((list0 (list 'a 'b 'c 'd 'e))
+ (list (replace list0 '(x y z) :start1 1 :start2 1 :end2 nil)))
+ (and (eq list0 list)
+ (equal list0 '(a y z d e))))
+
+(let* ((list0 (list 'a 'b 'c 'd 'e))
+ (list (replace list0 '(x y z) :start1 1 :end1 nil :start2 1 :end2 nil)))
+ (and (eq list0 list)
+ (equal list0 '(a y z d e))))
+
+(let* ((list0 (list 'a 'b 'c 'd 'e))
+ (list (replace list0 '(x y z) :start1 1 :end1 2 :start2 1)))
+ (and (eq list0 list)
+ (equal list0 '(a y c d e))))
+
+(let* ((list0 (list 'a 'b 'c 'd 'e))
+ (list (replace list0 '(x y z) :start1 1 :end1 1)))
+ (and (eq list0 list)
+ (equal list0 '(a b c d e))))
+
+(let* ((list0 (list 'a 'b 'c 'd 'e))
+ (list (replace list0 '(x y z) :start1 2 :end1 2)))
+ (and (eq list0 list)
+ (equal list0 '(a b c d e))))
+
+(let* ((list0 (list 'a 'b 'c 'd 'e))
+ (list (replace list0 '(x y z) :start1 3 :end1 3)))
+ (and (eq list0 list)
+ (equal list0 '(a b c d e))))
+
+(let* ((list0 (list 'a 'b 'c 'd 'e))
+ (list (replace list0 '(x y z) :start1 4 :end1 4)))
+ (and (eq list0 list)
+ (equal list0 '(a b c d e))))
+
+(let* ((list0 (list 'a 'b 'c 'd 'e))
+ (list (replace list0 '(x y z) :start1 5 :end1 5)))
+ (and (eq list0 list)
+ (equal list0 '(a b c d e))))
+
+(null (replace nil nil))
+(null (replace nil '(a b c)))
+
+(let* ((list0 (list 'a 'b 'c))
+ (list (replace list0 '())))
+ (and (eq list0 list)
+ (equal list0 '(a b c))))
+
+(let* ((list0 (list 'a 'b 'c 'd 'e))
+ (list (replace list0 list0)))
+ (and (eq list0 list)
+ (equal list0 '(a b c d e))))
+
+(let* ((list0 (list 'a 'b 'c 'd 'e))
+ (list (replace list0 list0 :start1 3)))
+ (and (eq list0 list)
+ (equal list0 '(a b c a b))))
+
+(let* ((list0 (list 'a 'b 'c 'd 'e))
+ (list (replace list0 list0 :start1 1)))
+ (and (eq list0 list)
+ (equal list0 '(a a b c d))))
+
+(let* ((list0 (list 'a 'b 'c 'd 'e))
+ (list (replace list0 list0 :start1 1 :end1 3)))
+ (and (eq list0 list)
+ (equal list0 '(a a b d e))))
+
+(let* ((list0 (list 'a 'b 'c))
+ (list (replace list0 '(x y z))))
+ (and (eq list0 list)
+ (equal list0 '(x y z))))
+
+
+(let* ((vector0 (vector 'a 'b 'c 'd 'e))
+ (vector (replace vector0 '(x y z))))
+ (and (eq vector0 vector)
+ (equalp vector0 #(x y z d e))))
+
+(let* ((vector0 (vector 'a 'b 'c 'd 'e))
+ (vector (replace vector0 '(x y z) :start1 1)))
+ (and (eq vector0 vector)
+ (equalp vector0 #(a x y z e))))
+
+(let* ((vector0 (vector 'a 'b 'c 'd 'e))
+ (vector (replace vector0 '(x y z) :start1 1 :end1 nil)))
+ (and (eq vector0 vector)
+ (equalp vector0 #(a x y z e))))
+
+(let* ((vector0 (vector 'a 'b 'c 'd 'e))
+ (vector (replace vector0 '(x y z) :start1 1 :start2 1)))
+ (and (eq vector0 vector)
+ (equalp vector0 #(a y z d e))))
+
+(let* ((vector0 (vector 'a 'b 'c 'd 'e))
+ (vector (replace vector0 '(x y z) :start1 1 :start2 1 :end2 nil)))
+ (and (eq vector0 vector)
+ (equalp vector0 #(a y z d e))))
+
+(let* ((vector0 (vector 'a 'b 'c 'd 'e))
+ (vector (replace vector0 '(x y z) :start1 1 :end1 nil :start2 1 :end2 nil)))
+ (and (eq vector0 vector)
+ (equalp vector0 #(a y z d e))))
+
+(let* ((vector0 (vector 'a 'b 'c 'd 'e))
+ (vector (replace vector0 '(x y z) :start1 1 :end1 2 :start2 1)))
+ (and (eq vector0 vector)
+ (equalp vector0 #(a y c d e))))
+
+(let* ((vector0 (vector 'a 'b 'c 'd 'e))
+ (vector (replace vector0 '(x y z) :start1 1 :end1 1)))
+ (and (eq vector0 vector)
+ (equalp vector0 #(a b c d e))))
+
+(let* ((vector0 (vector 'a 'b 'c 'd 'e))
+ (vector (replace vector0 '(x y z) :start1 2 :end1 2)))
+ (and (eq vector0 vector)
+ (equalp vector0 #(a b c d e))))
+
+(let* ((vector0 (vector 'a 'b 'c 'd 'e))
+ (vector (replace vector0 '(x y z) :start1 3 :end1 3)))
+ (and (eq vector0 vector)
+ (equalp vector0 #(a b c d e))))
+
+(let* ((vector0 (vector 'a 'b 'c 'd 'e))
+ (vector (replace vector0 '(x y z) :start1 4 :end1 4)))
+ (and (eq vector0 vector)
+ (equalp vector0 #(a b c d e))))
+
+(let* ((vector0 (vector 'a 'b 'c 'd 'e))
+ (vector (replace vector0 '(x y z) :start1 5 :end1 5)))
+ (and (eq vector0 vector)
+ (equalp vector0 #(a b c d e))))
+
+(null (replace nil #()))
+(null (replace nil #(a b c)))
+
+(let* ((vector0 (vector 'a 'b 'c))
+ (vector (replace vector0 '())))
+ (and (eq vector0 vector)
+ (equalp vector0 #(a b c))))
+
+(let* ((vector0 (vector 'a 'b 'c 'd 'e))
+ (vector (replace vector0 vector0)))
+ (and (eq vector0 vector)
+ (equalp vector0 #(a b c d e))))
+
+(let* ((vector0 (vector 'a 'b 'c 'd 'e))
+ (vector (replace vector0 vector0 :start1 3)))
+ (and (eq vector0 vector)
+ (equalp vector0 #(a b c a b))))
+
+(let* ((vector0 (vector 'a 'b 'c 'd 'e))
+ (vector (replace vector0 vector0 :start1 1)))
+ (and (eq vector0 vector)
+ (equalp vector0 #(a a b c d))))
+
+(let* ((vector0 (vector 'a 'b 'c 'd 'e))
+ (vector (replace vector0 vector0 :start1 1 :end1 3)))
+ (and (eq vector0 vector)
+ (equalp vector0 #(a a b d e))))
+
+(let* ((vector0 (vector 'a 'b 'c))
+ (vector (replace vector0 '(x y z))))
+ (and (eq vector0 vector)
+ (equalp vector0 #(x y z))))
+
+
+(let* ((vector0 (vector 'a 'b 'c 'd 'e))
+ (vector (replace vector0 #(x y z))))
+ (and (eq vector0 vector)
+ (equalp vector0 #(x y z d e))))
+
+(let* ((vector0 (vector 'a 'b 'c 'd 'e))
+ (vector (replace vector0 #(x y z) :start1 1)))
+ (and (eq vector0 vector)
+ (equalp vector0 #(a x y z e))))
+
+(let* ((vector0 (vector 'a 'b 'c 'd 'e))
+ (vector (replace vector0 #(x y z) :start1 1 :end1 nil)))
+ (and (eq vector0 vector)
+ (equalp vector0 #(a x y z e))))
+
+(let* ((vector0 (vector 'a 'b 'c 'd 'e))
+ (vector (replace vector0 #(x y z) :start1 1 :start2 1)))
+ (and (eq vector0 vector)
+ (equalp vector0 #(a y z d e))))
+
+(let* ((vector0 (vector 'a 'b 'c 'd 'e))
+ (vector (replace vector0 #(x y z) :start1 1 :start2 1 :end2 nil)))
+ (and (eq vector0 vector)
+ (equalp vector0 #(a y z d e))))
+
+(let* ((vector0 (vector 'a 'b 'c 'd 'e))
+ (vector (replace vector0 #(x y z) :start1 1 :end1 nil :start2 1 :end2 nil)))
+ (and (eq vector0 vector)
+ (equalp vector0 #(a y z d e))))
+
+(let* ((vector0 (vector 'a 'b 'c 'd 'e))
+ (vector (replace vector0 #(x y z) :start1 1 :end1 2 :start2 1)))
+ (and (eq vector0 vector)
+ (equalp vector0 #(a y c d e))))
+
+(let* ((vector0 (vector 'a 'b 'c 'd 'e))
+ (vector (replace vector0 #(x y z) :start1 1 :end1 1)))
+ (and (eq vector0 vector)
+ (equalp vector0 #(a b c d e))))
+
+(let* ((vector0 (vector 'a 'b 'c 'd 'e))
+ (vector (replace vector0 #(x y z) :start1 2 :end1 2)))
+ (and (eq vector0 vector)
+ (equalp vector0 #(a b c d e))))
+
+(let* ((vector0 (vector 'a 'b 'c 'd 'e))
+ (vector (replace vector0 #(x y z) :start1 3 :end1 3)))
+ (and (eq vector0 vector)
+ (equalp vector0 #(a b c d e))))
+
+(let* ((vector0 (vector 'a 'b 'c 'd 'e))
+ (vector (replace vector0 #(x y z) :start1 4 :end1 4)))
+ (and (eq vector0 vector)
+ (equalp vector0 #(a b c d e))))
+
+(let* ((vector0 (vector 'a 'b 'c 'd 'e))
+ (vector (replace vector0 #(x y z) :start1 5 :end1 5)))
+ (and (eq vector0 vector)
+ (equalp vector0 #(a b c d e))))
+
+(null (replace nil #()))
+(null (replace nil #(a b c)))
+
+(let* ((vector0 (vector 'a 'b 'c))
+ (vector (replace vector0 #())))
+ (and (eq vector0 vector)
+ (equalp vector0 #(a b c))))
+
+(let* ((vector0 (vector 'a 'b 'c 'd 'e))
+ (vector (replace vector0 vector0)))
+ (and (eq vector0 vector)
+ (equalp vector0 #(a b c d e))))
+
+(let* ((vector0 (vector 'a 'b 'c 'd 'e))
+ (vector (replace vector0 vector0 :start1 3)))
+ (and (eq vector0 vector)
+ (equalp vector0 #(a b c a b))))
+
+(let* ((vector0 (vector 'a 'b 'c 'd 'e))
+ (vector (replace vector0 vector0 :start1 1)))
+ (and (eq vector0 vector)
+ (equalp vector0 #(a a b c d))))
+
+(let* ((vector0 (vector 'a 'b 'c 'd 'e))
+ (vector (replace vector0 vector0 :start1 1 :end1 3)))
+ (and (eq vector0 vector)
+ (equalp vector0 #(a a b d e))))
+
+(let* ((vector0 (vector 'a 'b 'c))
+ (vector (replace vector0 #(x y z))))
+ (and (eq vector0 vector)
+ (equalp vector0 #(x y z))))
+
+(let* ((str0 (copy-seq "abc"))
+ (str (replace str0 "xyz")))
+ (and (eq str0 str)
+ (equalp str0 "xyz")))
+
+(let* ((str0 (copy-seq ""))
+ (str (replace str0 "")))
+ (and (eq str0 str)
+ (equalp str0 "")))
+
+(let* ((str0 (copy-seq ""))
+ (str (replace str0 "xyz")))
+ (and (eq str0 str)
+ (equalp str0 "")))
+
+(let* ((str0 (copy-seq "abc"))
+ (str (replace str0 "")))
+ (and (eq str0 str)
+ (equalp str0 "abc")))
+
+(let* ((str0 (copy-seq "abcdef"))
+ (str (replace str0 "xyz" :start1 3)))
+ (and (eq str0 str)
+ (equalp str0 "abcxyz")))
+
+(let* ((str0 (copy-seq "abcdef"))
+ (str (replace str0 "xyz" :start1 4 :start2 1)))
+ (and (eq str0 str)
+ (equalp str0 "abcdyz")))
+
+(let* ((str0 (copy-seq "abcdef"))
+ (str (replace str0 "xyz" :start1 1 :end1 2 :start2 1)))
+ (and (eq str0 str)
+ (equalp str0 "aycdef")))
+
+(let* ((str0 (copy-seq "abcdef"))
+ (str (replace str0 "xyz" :start1 1 :start2 1 :end2 2)))
+ (and (eq str0 str)
+ (equalp str0 "aycdef")))
+
+(let* ((str0 (copy-seq "abcdef"))
+ (str (replace str0 str0 :start1 1)))
+ (and (eq str0 str)
+ (equalp str0 "aabcde")))
+
+
+(let* ((bv0 (copy-seq #*0000))
+ (bv (replace bv0 #*1010)))
+ (and (eq bv0 bv)
+ (equalp bv0 #*1010)))
+
+(let* ((bv0 (copy-seq #*))
+ (bv (replace bv0 #*1010)))
+ (and (eq bv0 bv)
+ (equalp bv0 #*)))
+
+(let* ((bv0 (copy-seq #*0000))
+ (bv (replace bv0 #*)))
+ (and (eq bv0 bv)
+ (equalp bv0 #*0000)))
+
+(let* ((bv0 (copy-seq #*0000))
+ (bv (replace bv0 #*1111 :start1 2)))
+ (and (eq bv0 bv)
+ (equalp bv0 #*0011)))
+
+(let* ((bv0 (copy-seq #*1001))
+ (bv (replace bv0 #*0110 :start1 1 :end1 3 :start2 1 :end2 3)))
+ (and (eq bv0 bv)
+ (equalp bv0 #*1111)))
+
+(let* ((bv0 (copy-seq #*1010))
+ (bv (replace bv0 bv0 :start1 1)))
+ (and (eq bv0 bv)
+ (equalp bv0 #*1101)))
+
+
+
+(equal (substitute #\. #\SPACE "0 2 4 6") "0.2.4.6")
+(equal (substitute 9 4 '(1 2 4 1 3 4 5)) '(1 2 9 1 3 9 5))
+(equal (substitute 9 4 '(1 2 4 1 3 4 5) :count 1) '(1 2 9 1 3 4 5))
+(equal (substitute 9 4 '(1 2 4 1 3 4 5) :count 1 :from-end t) '(1 2 4 1 3 9 5))
+(equal (substitute 9 3 '(1 2 4 1 3 4 5) :test #'>) '(9 9 4 9 3 4 5))
+(equal (substitute-if 0 #'evenp '((1) (2) (3) (4)) :start 2 :key #'car)
+ '((1) (2) (3) 0))
+(equal (substitute-if 9 #'oddp '(1 2 4 1 3 4 5)) '(9 2 4 9 9 4 9))
+(equal (substitute-if 9 #'evenp '(1 2 4 1 3 4 5) :count 1 :from-end t)
+ '(1 2 4 1 3 9 5))
+(let ((some-things (list 'a 'car 'b 'cdr 'c)))
+ (and (equal (nsubstitute-if "function was here" #'fboundp some-things
+ :count 1 :from-end t)
+ '(A CAR B "function was here" C))
+ (equal some-things '(A CAR B "function was here" C))))
+(let ((alpha-tester (copy-seq "ab ")))
+ (and (equal (nsubstitute-if-not #\z #'alpha-char-p alpha-tester) "abz")
+ (equal alpha-tester "abz")))
+
+
+(equal (substitute 'a 'x '(x y z)) '(a y z))
+(equal (substitute 'b 'y '(x y z)) '(x b z))
+(equal (substitute 'c 'z '(x y z)) '(x y c))
+(equal (substitute 'a 'p '(x y z)) '(x y z))
+(equal (substitute 'a 'x '()) '())
+(equal (substitute #\x #\b '(#\a #\b #\c #\d #\e) :test #'char<)
+ '(#\a #\b #\x #\x #\x))
+(equal (substitute #\x #\b '(#\a #\b #\c #\d #\e)
+ :test-not (complement #'char<))
+ '(#\a #\b #\x #\x #\x))
+(equal (substitute '(a) 'x '((x) (y) (z)) :key #'car)
+ '((a) (y) (z)))
+(equal (substitute 'c 'b '(a b a b a b a b)) '(a c a c a c a c))
+(equal (substitute 'a 'b '(b b b)) '(a a a))
+(equal (substitute 'z 'x '(a x b x c x d x e x f))
+ '(a z b z c z d z e z f))
+(equal (substitute 'z 'x '(a x b x c x d x e x f) :count nil)
+ '(a z b z c z d z e z f))
+(equal (substitute 'z 'x '(a x b x c x d x e x f) :count 0)
+ '(a x b x c x d x e x f))
+(equal (substitute 'z 'x '(a x b x c x d x e x f) :count -100)
+ '(a x b x c x d x e x f))
+(equal (substitute 'z 'x '(a x b x c x d x e x f) :count 1)
+ '(a z b x c x d x e x f))
+(equal (substitute 'z 'x '(a x b x c x d x e x f) :count 2)
+ '(a z b z c x d x e x f))
+(equal (substitute 'z 'x '(a x b x c x d x e x f) :count 3)
+ '(a z b z c z d x e x f))
+(equal (substitute 'z 'x '(a x b x c x d x e x f) :count 4)
+ '(a z b z c z d z e x f))
+(equal (substitute 'z 'x '(a x b x c x d x e x f) :count 5)
+ '(a z b z c z d z e z f))
+(equal (substitute 'z 'x '(a x b x c x d x e x f) :count 6)
+ '(a z b z c z d z e z f))
+(equal (substitute 'z 'x '(a x b x c x d x e x f) :count 7)
+ '(a z b z c z d z e z f))
+(equal (substitute 'z 'x '(a x b x c x d x e x f) :count nil :from-end t)
+ '(a z b z c z d z e z f))
+(equal (substitute 'z 'x '(a x b x c x d x e x f) :count 0 :from-end t)
+ '(a x b x c x d x e x f))
+(equal (substitute 'z 'x '(a x b x c x d x e x f) :count -100 :from-end t)
+ '(a x b x c x d x e x f))
+(equal (substitute 'z 'x '(a x b x c x d x e x f) :count 1 :from-end t)
+ '(a x b x c x d x e z f))
+(equal (substitute 'z 'x '(a x b x c x d x e x f) :count 2 :from-end t)
+ '(a x b x c x d z e z f))
+(equal (substitute 'z 'x '(a x b x c x d x e x f) :count 3 :from-end t)
+ '(a x b x c z d z e z f))
+(equal (substitute 'z 'x '(a x b x c x d x e x f) :count 4 :from-end t)
+ '(a x b z c z d z e z f))
+(equal (substitute 'z 'x '(a x b x c x d x e x f) :count 5 :from-end t)
+ '(a z b z c z d z e z f))
+(equal (substitute 'z 'x '(a x b x c x d x e x f) :count 6 :from-end t)
+ '(a z b z c z d z e z f))
+(equal (substitute 'z 'x '(a x b x c x d x e x f) :count 7 :from-end t)
+ '(a z b z c z d z e z f))
+(equal (substitute 'z 'x '(a x b x c x d x e x f) :start 2 :count 1)
+ '(a x b z c x d x e x f))
+(equal (substitute 'z 'x '(a x b x c x d x e x f) :start 2 :end nil :count 1)
+ '(a x b z c x d x e x f))
+(equal (substitute 'z 'x '(a x b x c x d x e x f) :start 2 :end 6 :count 100)
+ '(a x b z c z d x e x f))
+(equal (substitute 'z 'x '(a x b x c x d x e x f) :start 2 :end 11 :count 100)
+ '(a x b z c z d z e z f))
+(equal (substitute 'z 'x '(a x b x c x d x e x f) :start 2 :end 8 :count 10)
+ '(a x b z c z d z e x f))
+(equal (substitute 'z 'x '(a x b x c x d x e x f)
+ :start 2 :end 8 :count 2 :from-end t)
+ '(a x b x c z d z e x f))
+(equal (substitute #\z #\c '(#\a #\b #\c #\d #\e #\f) :test #'char<)
+ '(#\a #\b #\c #\z #\z #\z))
+(equal (substitute #\z #\c '(#\a #\b #\c #\d #\e #\f)
+ :test-not (complement #'char<))
+ '(#\a #\b #\c #\z #\z #\z))
+(equal (substitute "peace" "war" '("love" "hate" "war" "peace") :test #'equal)
+ '("love" "hate" "peace" "peace"))
+(equal (substitute "peace" "war" '("love" "hate" "war" "peace")
+ :test-not (complement #'equal))
+ '("love" "hate" "peace" "peace"))
+(equal (substitute "peace" "war" '("war" "War" "WAr" "WAR")
+ :test #'string-equal)
+ '("peace" "peace" "peace" "peace"))
+(equal (substitute "peace" "war" '("war" "War" "WAr" "WAR")
+ :test-not (complement #'string-equal))
+ '("peace" "peace" "peace" "peace"))
+(equal (substitute "peace" "WAR" '("war" "War" "WAr" "WAR")
+ :test #'string=)
+ '("war" "War" "WAr" "peace"))
+(equal (substitute "peace" "WAR" '("war" "War" "WAr" "WAR")
+ :test-not (complement #'string=))
+ '("war" "War" "WAr" "peace"))
+(equal (substitute "peace" "WAR" '("war" "War" "WAr" "WAR")
+ :test #'string=
+ :key #'string-upcase)
+ '("peace" "peace" "peace" "peace"))
+(equal (substitute "peace" "WAR" '("war" "War" "WAr" "WAR")
+ :test-not (complement #'string=)
+ :key #'string-upcase)
+ '("peace" "peace" "peace" "peace"))
+(equal (substitute "peace" "WAR" '("war" "War" "WAr" "WAR")
+ :start 1
+ :end 2
+ :test #'string=
+ :key #'string-upcase)
+ '("war" "peace" "WAr" "WAR"))
+(equal (substitute "peace" "WAR" '("war" "War" "WAr" "WAR")
+ :start 1
+ :end 2
+ :test-not (complement #'string=)
+ :key #'string-upcase)
+ '("war" "peace" "WAr" "WAR"))
+(equal (substitute "peace" "WAR" '("war" "War" "WAr" "WAR")
+ :start 1
+ :end nil
+ :test #'string=
+ :key #'string-upcase)
+ '("war" "peace" "peace" "peace"))
+(equal (substitute "peace" "WAR" '("war" "War" "WAr" "WAR")
+ :start 1
+ :end nil
+ :test-not (complement #'string=)
+ :key #'string-upcase)
+ '("war" "peace" "peace" "peace"))
+(equal (substitute "peace" "war" '("war" "War" "WAr" "WAR")
+ :test #'string=
+ :key #'string-upcase)
+ '("war" "War" "WAr" "WAR"))
+(equal (substitute "peace" "war" '("war" "War" "WAr" "WAR")
+ :test-not (complement #'string=)
+ :key #'string-upcase)
+ '("war" "War" "WAr" "WAR"))
+(equal (substitute "peace" "WAR"
+ '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR")
+ :start 1
+ :end 7
+ :count 1
+ :test-not (complement #'string=)
+ :key #'string-upcase)
+ '("war" "peace" "WAr" "WAR" "war" "War" "WAr" "WAR"))
+(equal (substitute "peace" "WAR"
+ '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR")
+ :start 1
+ :end 7
+ :count 2
+ :test-not (complement #'string=)
+ :key #'string-upcase)
+ '("war" "peace" "peace" "WAR" "war" "War" "WAr" "WAR"))
+(equal (substitute "peace" "WAR"
+ '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR")
+ :start 1
+ :end 7
+ :count 2
+ :from-end t
+ :test-not (complement #'string=)
+ :key #'string-upcase)
+ '("war" "War" "WAr" "WAR" "war" "peace" "peace" "WAR"))
+(equal (substitute "peace" "WAR"
+ '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR")
+ :start 1
+ :end 7
+ :count 0
+ :from-end t
+ :test-not (complement #'string=)
+ :key #'string-upcase)
+ '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR"))
+(equal (substitute "peace" "WAR"
+ '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR")
+ :start 1
+ :end 7
+ :count -2
+ :from-end t
+ :test-not (complement #'string=)
+ :key #'string-upcase)
+ '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR"))
+(equal (substitute "peace" "WAR"
+ '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR")
+ :start 1
+ :end 7
+ :count nil
+ :from-end t
+ :test-not (complement #'string=)
+ :key #'string-upcase)
+ '("war" "peace" "peace" "peace" "peace" "peace" "peace" "WAR"))
+(equal (substitute "peace" "WAR"
+ '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR")
+ :start 1
+ :end 7
+ :count 6
+ :from-end t
+ :test-not (complement #'string=)
+ :key #'string-upcase)
+ '("war" "peace" "peace" "peace" "peace" "peace" "peace" "WAR"))
+(equal (substitute "peace" "WAR"
+ '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR")
+ :start 1
+ :end 7
+ :count 7
+ :from-end t
+ :test-not (complement #'string=)
+ :key #'string-upcase)
+ '("war" "peace" "peace" "peace" "peace" "peace" "peace" "WAR"))
+(equal (substitute "peace" "WAR"
+ '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR")
+ :start 1
+ :end 7
+ :count 100
+ :from-end t
+ :test-not (complement #'string=)
+ :key #'string-upcase)
+ '("war" "peace" "peace" "peace" "peace" "peace" "peace" "WAR"))
+
+
+(equalp (substitute 'a 'x #(x y z)) #(a y z))
+(equalp (substitute 'b 'y #(x y z)) #(x b z))
+(equalp (substitute 'c 'z #(x y z)) #(x y c))
+(equalp (substitute 'a 'p #(x y z)) #(x y z))
+(equalp (substitute 'a 'x #()) #())
+(equalp (substitute #\x #\b #(#\a #\b #\c #\d #\e) :test #'char<)
+ #(#\a #\b #\x #\x #\x))
+(equalp (substitute #\x #\b #(#\a #\b #\c #\d #\e)
+ :test-not (complement #'char<))
+ #(#\a #\b #\x #\x #\x))
+(equalp (substitute '(a) 'x #((x) (y) (z)) :key #'car)
+ #((a) (y) (z)))
+(equalp (substitute 'c 'b #(a b a b a b a b)) #(a c a c a c a c))
+(equalp (substitute 'a 'b #(b b b)) #(a a a))
+(equalp (substitute 'z 'x #(a x b x c x d x e x f))
+ #(a z b z c z d z e z f))
+(equalp (substitute 'z 'x #(a x b x c x d x e x f) :count nil)
+ #(a z b z c z d z e z f))
+(equalp (substitute 'z 'x #(a x b x c x d x e x f) :count 0)
+ #(a x b x c x d x e x f))
+(equalp (substitute 'z 'x #(a x b x c x d x e x f) :count -100)
+ #(a x b x c x d x e x f))
+(equalp (substitute 'z 'x #(a x b x c x d x e x f) :count 1)
+ #(a z b x c x d x e x f))
+(equalp (substitute 'z 'x #(a x b x c x d x e x f) :count 2)
+ #(a z b z c x d x e x f))
+(equalp (substitute 'z 'x #(a x b x c x d x e x f) :count 3)
+ #(a z b z c z d x e x f))
+(equalp (substitute 'z 'x #(a x b x c x d x e x f) :count 4)
+ #(a z b z c z d z e x f))
+(equalp (substitute 'z 'x #(a x b x c x d x e x f) :count 5)
+ #(a z b z c z d z e z f))
+(equalp (substitute 'z 'x #(a x b x c x d x e x f) :count 6)
+ #(a z b z c z d z e z f))
+(equalp (substitute 'z 'x #(a x b x c x d x e x f) :count 7)
+ #(a z b z c z d z e z f))
+(equalp (substitute 'z 'x #(a x b x c x d x e x f) :count nil :from-end t)
+ #(a z b z c z d z e z f))
+(equalp (substitute 'z 'x #(a x b x c x d x e x f) :count 0 :from-end t)
+ #(a x b x c x d x e x f))
+(equalp (substitute 'z 'x #(a x b x c x d x e x f) :count -100 :from-end t)
+ #(a x b x c x d x e x f))
+(equalp (substitute 'z 'x #(a x b x c x d x e x f) :count 1 :from-end t)
+ #(a x b x c x d x e z f))
+(equalp (substitute 'z 'x #(a x b x c x d x e x f) :count 2 :from-end t)
+ #(a x b x c x d z e z f))
+(equalp (substitute 'z 'x #(a x b x c x d x e x f) :count 3 :from-end t)
+ #(a x b x c z d z e z f))
+(equalp (substitute 'z 'x #(a x b x c x d x e x f) :count 4 :from-end t)
+ #(a x b z c z d z e z f))
+(equalp (substitute 'z 'x #(a x b x c x d x e x f) :count 5 :from-end t)
+ #(a z b z c z d z e z f))
+(equalp (substitute 'z 'x #(a x b x c x d x e x f) :count 6 :from-end t)
+ #(a z b z c z d z e z f))
+(equalp (substitute 'z 'x #(a x b x c x d x e x f) :count 7 :from-end t)
+ #(a z b z c z d z e z f))
+(equalp (substitute 'z 'x #(a x b x c x d x e x f) :start 2 :count 1)
+ #(a x b z c x d x e x f))
+(equalp (substitute 'z 'x #(a x b x c x d x e x f) :start 2 :end nil :count 1)
+ #(a x b z c x d x e x f))
+(equalp (substitute 'z 'x #(a x b x c x d x e x f) :start 2 :end 6 :count 100)
+ #(a x b z c z d x e x f))
+(equalp (substitute 'z 'x #(a x b x c x d x e x f) :start 2 :end 11 :count 100)
+ #(a x b z c z d z e z f))
+(equalp (substitute 'z 'x #(a x b x c x d x e x f) :start 2 :end 8 :count 10)
+ #(a x b z c z d z e x f))
+(equalp (substitute 'z 'x #(a x b x c x d x e x f)
+ :start 2 :end 8 :count 2 :from-end t)
+ #(a x b x c z d z e x f))
+(equalp (substitute #\z #\c #(#\a #\b #\c #\d #\e #\f) :test #'char<)
+ #(#\a #\b #\c #\z #\z #\z))
+(equalp (substitute #\z #\c #(#\a #\b #\c #\d #\e #\f)
+ :test-not (complement #'char<))
+ #(#\a #\b #\c #\z #\z #\z))
+(equalp (substitute "peace" "war" #("love" "hate" "war" "peace") :test #'equal)
+ #("love" "hate" "peace" "peace"))
+(equalp (substitute "peace" "war" #("love" "hate" "war" "peace")
+ :test-not (complement #'equal))
+ #("love" "hate" "peace" "peace"))
+(equalp (substitute "peace" "war" #("war" "War" "WAr" "WAR")
+ :test #'string-equal)
+ #("peace" "peace" "peace" "peace"))
+(equalp (substitute "peace" "war" #("war" "War" "WAr" "WAR")
+ :test-not (complement #'string-equal))
+ #("peace" "peace" "peace" "peace"))
+(equalp (substitute "peace" "WAR" #("war" "War" "WAr" "WAR")
+ :test #'string=)
+ #("war" "War" "WAr" "peace"))
+(equalp (substitute "peace" "WAR" #("war" "War" "WAr" "WAR")
+ :test-not (complement #'string=))
+ #("war" "War" "WAr" "peace"))
+(equalp (substitute "peace" "WAR" #("war" "War" "WAr" "WAR")
+ :test #'string=
+ :key #'string-upcase)
+ #("peace" "peace" "peace" "peace"))
+(equalp (substitute "peace" "WAR" #("war" "War" "WAr" "WAR")
+ :test-not (complement #'string=)
+ :key #'string-upcase)
+ #("peace" "peace" "peace" "peace"))
+(equalp (substitute "peace" "WAR" #("war" "War" "WAr" "WAR")
+ :start 1
+ :end 2
+ :test #'string=
+ :key #'string-upcase)
+ #("war" "peace" "WAr" "WAR"))
+(equalp (substitute "peace" "WAR" #("war" "War" "WAr" "WAR")
+ :start 1
+ :end 2
+ :test-not (complement #'string=)
+ :key #'string-upcase)
+ #("war" "peace" "WAr" "WAR"))
+(equalp (substitute "peace" "WAR" #("war" "War" "WAr" "WAR")
+ :start 1
+ :end nil
+ :test #'string=
+ :key #'string-upcase)
+ #("war" "peace" "peace" "peace"))
+(equalp (substitute "peace" "WAR" #("war" "War" "WAr" "WAR")
+ :start 1
+ :end nil
+ :test-not (complement #'string=)
+ :key #'string-upcase)
+ #("war" "peace" "peace" "peace"))
+(equalp (substitute "peace" "war" #("war" "War" "WAr" "WAR")
+ :test #'string=
+ :key #'string-upcase)
+ #("war" "War" "WAr" "WAR"))
+(equalp (substitute "peace" "war" #("war" "War" "WAr" "WAR")
+ :test-not (complement #'string=)
+ :key #'string-upcase)
+ #("war" "War" "WAr" "WAR"))
+(equalp (substitute "peace" "WAR"
+ #("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR")
+ :start 1
+ :end 7
+ :count 1
+ :test-not (complement #'string=)
+ :key #'string-upcase)
+ #("war" "peace" "WAr" "WAR" "war" "War" "WAr" "WAR"))
+(equalp (substitute "peace" "WAR"
+ #("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR")
+ :start 1
+ :end 7
+ :count 2
+ :test-not (complement #'string=)
+ :key #'string-upcase)
+ #("war" "peace" "peace" "WAR" "war" "War" "WAr" "WAR"))
+(equalp (substitute "peace" "WAR"
+ #("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR")
+ :start 1
+ :end 7
+ :count 2
+ :from-end t
+ :test-not (complement #'string=)
+ :key #'string-upcase)
+ #("war" "War" "WAr" "WAR" "war" "peace" "peace" "WAR"))
+(equalp (substitute "peace" "WAR"
+ #("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR")
+ :start 1
+ :end 7
+ :count 0
+ :from-end t
+ :test-not (complement #'string=)
+ :key #'string-upcase)
+ #("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR"))
+(equalp (substitute "peace" "WAR"
+ #("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR")
+ :start 1
+ :end 7
+ :count -2
+ :from-end t
+ :test-not (complement #'string=)
+ :key #'string-upcase)
+ #("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR"))
+(equalp (substitute "peace" "WAR"
+ #("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR")
+ :start 1
+ :end 7
+ :count nil
+ :from-end t
+ :test-not (complement #'string=)
+ :key #'string-upcase)
+ #("war" "peace" "peace" "peace" "peace" "peace" "peace" "WAR"))
+(equalp (substitute "peace" "WAR"
+ #("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR")
+ :start 1
+ :end 7
+ :count 6
+ :from-end t
+ :test-not (complement #'string=)
+ :key #'string-upcase)
+ #("war" "peace" "peace" "peace" "peace" "peace" "peace" "WAR"))
+(equalp (substitute "peace" "WAR"
+ #("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR")
+ :start 1
+ :end 7
+ :count 7
+ :from-end t
+ :test-not (complement #'string=)
+ :key #'string-upcase)
+ #("war" "peace" "peace" "peace" "peace" "peace" "peace" "WAR"))
+(equalp (substitute "peace" "WAR"
+ #("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR")
+ :start 1
+ :end 7
+ :count 100
+ :from-end t
+ :test-not (complement #'string=)
+ :key #'string-upcase)
+ #("war" "peace" "peace" "peace" "peace" "peace" "peace" "WAR"))
+(string= (substitute #\A #\a "abcabc") "AbcAbc")
+(string= (substitute #\A #\a "") "")
+(string= (substitute #\A #\a "xyz") "xyz")
+(string= (substitute #\A #\a "aaaaaaaaaa" :start 5 :end nil) "aaaaaAAAAA")
+(string= (substitute #\x #\5 "0123456789" :test #'char<) "012345xxxx")
+(string= (substitute #\x #\5 "0123456789" :test #'char>) "xxxxx56789")
+(string= (substitute #\x #\D "abcdefg"
+ :key #'char-upcase
+ :test #'char>)
+ "xxxdefg")
+(string= (substitute #\x #\D "abcdefg"
+ :start 1
+ :end 2
+ :key #'char-upcase
+ :test #'char>)
+ "axcdefg")
+(string= (substitute #\A #\a "aaaaaaaaaa" :count 2) "AAaaaaaaaa")
+(string= (substitute #\A #\a "aaaaaaaaaa" :count -1) "aaaaaaaaaa")
+(string= (substitute #\A #\a "aaaaaaaaaa" :count 0) "aaaaaaaaaa")
+(string= (substitute #\A #\a "aaaaaaaaaa" :count nil) "AAAAAAAAAA")
+(string= (substitute #\A #\a "aaaaaaaaaa" :count 100) "AAAAAAAAAA")
+(string= (substitute #\A #\a "aaaaaaaaaa" :count 9) "AAAAAAAAAa")
+(string= (substitute #\A #\a "aaaaaaaaaa" :count 9 :from-end t) "aAAAAAAAAA")
+(string= (substitute #\A #\a "aaaaaaaaaa"
+ :start 2
+ :end 8
+ :count 3)
+ "aaAAAaaaaa")
+(string= (substitute #\A #\a "aaaaaaaaaa"
+ :start 2
+ :end 8
+ :from-end t
+ :count 3)
+ "aaaaaAAAaa")
+(string= (substitute #\x #\A "aaaaaaaaaa"
+ :start 2
+ :end 8
+ :from-end t
+ :count 3)
+ "aaaaaaaaaa")
+(string= (substitute #\X #\A "aaaaaaaaaa"
+ :start 2
+ :end 8
+ :from-end t
+ :key #'char-upcase
+ :count 3)
+ "aaaaaXXXaa")
+(string= (substitute #\X #\D "abcdefghij"
+ :start 2
+ :end 8
+ :from-end t
+ :key #'char-upcase
+ :test #'char<
+ :count 3)
+ "abcdeXXXij")
+(equalp (substitute 0 1 #*1111) #*0000)
+(equalp (substitute 0 1 #*1111 :start 1 :end nil) #*1000)
+(equalp (substitute 0 1 #*1111 :start 1 :end 3) #*1001)
+(equalp (substitute 0 1 #*11111111 :start 1 :end 7) #*10000001)
+(equalp (substitute 0 1 #*11111111 :start 1 :end 7 :count 3) #*10001111)
+(equalp (substitute 0 1 #*11111111 :start 1 :end 7 :count 3 :from-end t)
+ #*11110001)
+(equalp (substitute 1 1 #*10101010
+ :start 1 :end 7 :count 3 :from-end t
+ :key #'(lambda (x) (if (zerop x) 1 0)))
+ #*11111110)
+(equalp (substitute 1 1 #*10101010
+ :start 1 :end 7 :count 3 :from-end t
+ :key #'(lambda (x) (if (zerop x) 1 0))
+ :test #'>=)
+ #*10101110)
+
+
+
+(equal (substitute-if 'a #'(lambda (arg) (eq arg 'x)) '(x y z)) '(a y z))
+(equal (substitute-if 'b #'(lambda (arg) (eq arg 'y)) '(x y z)) '(x b z))
+(equal (substitute-if 'c #'(lambda (arg) (eq arg 'z)) '(x y z)) '(x y c))
+(equal (substitute-if 'a #'(lambda (arg) (eq arg 'p)) '(x y z)) '(x y z))
+(equal (substitute-if 'a #'(lambda (arg) (eq arg 'x)) '()) '())
+(equal (substitute-if #\x #'(lambda (arg) (char< #\b arg))
+ '(#\a #\b #\c #\d #\e))
+ '(#\a #\b #\x #\x #\x))
+(equal (substitute-if '(a) #'(lambda (arg) (eq arg 'x))
+ '((x) (y) (z)) :key #'car)
+ '((a) (y) (z)))
+(equal (substitute-if 'c #'(lambda (arg) (eq arg 'b))
+ '(a b a b a b a b)) '(a c a c a c a c))
+(equal (substitute-if 'a #'(lambda (arg) (eq arg 'b))
+ '(b b b)) '(a a a))
+(equal (substitute-if 'z #'(lambda (arg) (eq arg 'x))
+ '(a x b x c x d x e x f))
+ '(a z b z c z d z e z f))
+(equal (substitute-if 'z #'(lambda (arg) (eq arg 'x))
+ '(a x b x c x d x e x f) :count nil)
+ '(a z b z c z d z e z f))
+(equal (substitute-if 'z #'(lambda (arg) (eq arg 'x))
+ '(a x b x c x d x e x f) :count 0)
+ '(a x b x c x d x e x f))
+(equal (substitute-if 'z #'(lambda (arg) (eq arg 'x))
+ '(a x b x c x d x e x f) :count -100)
+ '(a x b x c x d x e x f))
+(equal (substitute-if 'z #'(lambda (arg) (eq arg 'x))
+ '(a x b x c x d x e x f) :count 1)
+ '(a z b x c x d x e x f))
+(equal (substitute-if 'z #'(lambda (arg) (eq arg 'x))
+ '(a x b x c x d x e x f) :count 2)
+ '(a z b z c x d x e x f))
+(equal (substitute-if 'z #'(lambda (arg) (eq arg 'x))
+ '(a x b x c x d x e x f) :count 3)
+ '(a z b z c z d x e x f))
+(equal (substitute-if 'z #'(lambda (arg) (eq arg 'x))
+ '(a x b x c x d x e x f) :count 4)
+ '(a z b z c z d z e x f))
+(equal (substitute-if 'z #'(lambda (arg) (eq arg 'x))
+ '(a x b x c x d x e x f) :count 5)
+ '(a z b z c z d z e z f))
+(equal (substitute-if 'z #'(lambda (arg) (eq arg 'x))
+ '(a x b x c x d x e x f) :count 6)
+ '(a z b z c z d z e z f))
+(equal (substitute-if 'z #'(lambda (arg) (eq arg 'x))
+ '(a x b x c x d x e x f) :count 7)
+ '(a z b z c z d z e z f))
+(equal (substitute-if 'z #'(lambda (arg) (eq arg 'x))
+ '(a x b x c x d x e x f) :count nil :from-end t)
+ '(a z b z c z d z e z f))
+(equal (substitute-if 'z #'(lambda (arg) (eq arg 'x))
+ '(a x b x c x d x e x f) :count 0 :from-end t)
+ '(a x b x c x d x e x f))
+(equal (substitute-if 'z #'(lambda (arg) (eq arg 'x))
+ '(a x b x c x d x e x f) :count -100 :from-end t)
+ '(a x b x c x d x e x f))
+(equal (substitute-if 'z #'(lambda (arg) (eq arg 'x))
+ '(a x b x c x d x e x f) :count 1 :from-end t)
+ '(a x b x c x d x e z f))
+(equal (substitute-if 'z #'(lambda (arg) (eq arg 'x))
+ '(a x b x c x d x e x f) :count 2 :from-end t)
+ '(a x b x c x d z e z f))
+(equal (substitute-if 'z #'(lambda (arg) (eq arg 'x))
+ '(a x b x c x d x e x f) :count 3 :from-end t)
+ '(a x b x c z d z e z f))
+(equal (substitute-if 'z #'(lambda (arg) (eq arg 'x))
+ '(a x b x c x d x e x f) :count 4 :from-end t)
+ '(a x b z c z d z e z f))
+(equal (substitute-if 'z #'(lambda (arg) (eq arg 'x))
+ '(a x b x c x d x e x f) :count 5 :from-end t)
+ '(a z b z c z d z e z f))
+(equal (substitute-if 'z #'(lambda (arg) (eq arg 'x))
+ '(a x b x c x d x e x f) :count 6 :from-end t)
+ '(a z b z c z d z e z f))
+(equal (substitute-if 'z #'(lambda (arg) (eq arg 'x))
+ '(a x b x c x d x e x f) :count 7 :from-end t)
+ '(a z b z c z d z e z f))
+(equal (substitute-if 'z #'(lambda (arg) (eq arg 'x))
+ '(a x b x c x d x e x f) :start 2 :count 1)
+ '(a x b z c x d x e x f))
+(equal (substitute-if 'z #'(lambda (arg) (eq arg 'x))
+ '(a x b x c x d x e x f) :start 2 :end nil :count 1)
+ '(a x b z c x d x e x f))
+(equal (substitute-if 'z #'(lambda (arg) (eq arg 'x))
+ '(a x b x c x d x e x f) :start 2 :end 6 :count 100)
+ '(a x b z c z d x e x f))
+(equal (substitute-if 'z #'(lambda (arg) (eq arg 'x))
+ '(a x b x c x d x e x f) :start 2 :end 11 :count 100)
+ '(a x b z c z d z e z f))
+(equal (substitute-if 'z #'(lambda (arg) (eq arg 'x))
+ '(a x b x c x d x e x f) :start 2 :end 8 :count 10)
+ '(a x b z c z d z e x f))
+(equal (substitute-if 'z #'(lambda (arg) (eq arg 'x))
+ '(a x b x c x d x e x f)
+ :start 2 :end 8 :count 2 :from-end t)
+ '(a x b x c z d z e x f))
+(equal (substitute-if #\z #'(lambda (arg) (char< #\c arg))
+ '(#\a #\b #\c #\d #\e #\f))
+ '(#\a #\b #\c #\z #\z #\z))
+(equal (substitute-if "peace" #'(lambda (arg) (equal "war" arg))
+ '("love" "hate" "war" "peace"))
+ '("love" "hate" "peace" "peace"))
+(equal (substitute-if "peace" #'(lambda (arg) (string-equal "war" arg))
+ '("war" "War" "WAr" "WAR"))
+ '("peace" "peace" "peace" "peace"))
+(equal (substitute-if "peace" #'(lambda (arg) (string= "WAR" arg))
+ '("war" "War" "WAr" "WAR")
+ :key #'string-upcase)
+ '("peace" "peace" "peace" "peace"))
+(equal (substitute-if "peace" #'(lambda (arg) (string= "WAR" arg))
+ '("war" "War" "WAr" "WAR")
+ :start 1
+ :end 2
+ :key #'string-upcase)
+ '("war" "peace" "WAr" "WAR"))
+(equal (substitute-if "peace" #'(lambda (arg) (string= "WAR" arg))
+ '("war" "War" "WAr" "WAR")
+ :start 1
+ :end nil
+ :key #'string-upcase)
+ '("war" "peace" "peace" "peace"))
+(equal (substitute-if "peace" #'(lambda (arg) (string= "war" arg))
+ '("war" "War" "WAr" "WAR")
+ :key #'string-upcase)
+ '("war" "War" "WAr" "WAR"))
+(equal (substitute-if "peace" #'(lambda (arg) (string= "WAR" arg))
+ '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR")
+ :start 1
+ :end 7
+ :count 1
+ :key #'string-upcase)
+ '("war" "peace" "WAr" "WAR" "war" "War" "WAr" "WAR"))
+(equal (substitute-if "peace" #'(lambda (arg) (string= "WAR" arg))
+ '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR")
+ :start 1
+ :end 7
+ :count 2
+ :key #'string-upcase)
+ '("war" "peace" "peace" "WAR" "war" "War" "WAr" "WAR"))
+(equal (substitute-if "peace" #'(lambda (arg) (string= "WAR" arg))
+ '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR")
+ :start 1
+ :end 7
+ :count 2
+ :from-end t
+ :key #'string-upcase)
+ '("war" "War" "WAr" "WAR" "war" "peace" "peace" "WAR"))
+(equal (substitute-if "peace" #'(lambda (arg) (string= "WAR" arg))
+ '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR")
+ :start 1
+ :end 7
+ :count 0
+ :from-end t
+ :key #'string-upcase)
+ '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR"))
+(equal (substitute-if "peace" #'(lambda (arg) (string= "WAR" arg))
+ '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR")
+ :start 1
+ :end 7
+ :count -2
+ :from-end t
+ :key #'string-upcase)
+ '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR"))
+(equal (substitute-if "peace" #'(lambda (arg) (string= "WAR" arg))
+ '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR")
+ :start 1
+ :end 7
+ :count nil
+ :from-end t
+ :key #'string-upcase)
+ '("war" "peace" "peace" "peace" "peace" "peace" "peace" "WAR"))
+(equal (substitute-if "peace" #'(lambda (arg) (string= "WAR" arg))
+ '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR")
+ :start 1
+ :end 7
+ :count 6
+ :from-end t
+ :key #'string-upcase)
+ '("war" "peace" "peace" "peace" "peace" "peace" "peace" "WAR"))
+(equal (substitute-if "peace" #'(lambda (arg) (string= "WAR" arg))
+ '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR")
+ :start 1
+ :end 7
+ :count 7
+ :from-end t
+ :key #'string-upcase)
+ '("war" "peace" "peace" "peace" "peace" "peace" "peace" "WAR"))
+(equal (substitute-if "peace" #'(lambda (arg) (string= "WAR" arg))
+ '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR")
+ :start 1
+ :end 7
+ :count 100
+ :from-end t
+ :key #'string-upcase)
+ '("war" "peace" "peace" "peace" "peace" "peace" "peace" "WAR"))
+
+
+(equalp (substitute-if 'a #'(lambda (arg) (eq arg 'x)) #(x y z)) #(a y z))
+(equalp (substitute-if 'b #'(lambda (arg) (eq arg 'y)) #(x y z)) #(x b z))
+(equalp (substitute-if 'c #'(lambda (arg) (eq arg 'z)) #(x y z)) #(x y c))
+(equalp (substitute-if 'a #'(lambda (arg) (eq arg 'p)) #(x y z)) #(x y z))
+(equalp (substitute-if 'a #'(lambda (arg) (eq arg 'x)) #()) #())
+(equalp (substitute-if #\x #'(lambda (arg) (char< #\b arg))
+ #(#\a #\b #\c #\d #\e))
+ #(#\a #\b #\x #\x #\x))
+(equalp (substitute-if '(a) #'(lambda (arg) (eq arg 'x))
+ #((x) (y) (z)) :key #'car)
+ #((a) (y) (z)))
+(equalp (substitute-if 'c #'(lambda (arg) (eq arg 'b))
+ #(a b a b a b a b)) #(a c a c a c a c))
+(equalp (substitute-if 'a #'(lambda (arg) (eq arg 'b))
+ #(b b b)) #(a a a))
+(equalp (substitute-if 'z #'(lambda (arg) (eq arg 'x))
+ #(a x b x c x d x e x f))
+ #(a z b z c z d z e z f))
+(equalp (substitute-if 'z #'(lambda (arg) (eq arg 'x))
+ #(a x b x c x d x e x f) :count nil)
+ #(a z b z c z d z e z f))
+(equalp (substitute-if 'z #'(lambda (arg) (eq arg 'x))
+ #(a x b x c x d x e x f) :count 0)
+ #(a x b x c x d x e x f))
+(equalp (substitute-if 'z #'(lambda (arg) (eq arg 'x))
+ #(a x b x c x d x e x f) :count -100)
+ #(a x b x c x d x e x f))
+(equalp (substitute-if 'z #'(lambda (arg) (eq arg 'x))
+ #(a x b x c x d x e x f) :count 1)
+ #(a z b x c x d x e x f))
+(equalp (substitute-if 'z #'(lambda (arg) (eq arg 'x))
+ #(a x b x c x d x e x f) :count 2)
+ #(a z b z c x d x e x f))
+(equalp (substitute-if 'z #'(lambda (arg) (eq arg 'x))
+ #(a x b x c x d x e x f) :count 3)
+ #(a z b z c z d x e x f))
+(equalp (substitute-if 'z #'(lambda (arg) (eq arg 'x))
+ #(a x b x c x d x e x f) :count 4)
+ #(a z b z c z d z e x f))
+(equalp (substitute-if 'z #'(lambda (arg) (eq arg 'x))
+ #(a x b x c x d x e x f) :count 5)
+ #(a z b z c z d z e z f))
+(equalp (substitute-if 'z #'(lambda (arg) (eq arg 'x))
+ #(a x b x c x d x e x f) :count 6)
+ #(a z b z c z d z e z f))
+(equalp (substitute-if 'z #'(lambda (arg) (eq arg 'x))
+ #(a x b x c x d x e x f) :count 7)
+ #(a z b z c z d z e z f))
+(equalp (substitute-if 'z #'(lambda (arg) (eq arg 'x))
+ #(a x b x c x d x e x f) :count nil :from-end t)
+ #(a z b z c z d z e z f))
+(equalp (substitute-if 'z #'(lambda (arg) (eq arg 'x))
+ #(a x b x c x d x e x f) :count 0 :from-end t)
+ #(a x b x c x d x e x f))
+(equalp (substitute-if 'z #'(lambda (arg) (eq arg 'x))
+ #(a x b x c x d x e x f) :count -100 :from-end t)
+ #(a x b x c x d x e x f))
+(equalp (substitute-if 'z #'(lambda (arg) (eq arg 'x))
+ #(a x b x c x d x e x f) :count 1 :from-end t)
+ #(a x b x c x d x e z f))
+(equalp (substitute-if 'z #'(lambda (arg) (eq arg 'x))
+ #(a x b x c x d x e x f) :count 2 :from-end t)
+ #(a x b x c x d z e z f))
+(equalp (substitute-if 'z #'(lambda (arg) (eq arg 'x))
+ #(a x b x c x d x e x f) :count 3 :from-end t)
+ #(a x b x c z d z e z f))
+(equalp (substitute-if 'z #'(lambda (arg) (eq arg 'x))
+ #(a x b x c x d x e x f) :count 4 :from-end t)
+ #(a x b z c z d z e z f))
+(equalp (substitute-if 'z #'(lambda (arg) (eq arg 'x))
+ #(a x b x c x d x e x f) :count 5 :from-end t)
+ #(a z b z c z d z e z f))
+(equalp (substitute-if 'z #'(lambda (arg) (eq arg 'x))
+ #(a x b x c x d x e x f) :count 6 :from-end t)
+ #(a z b z c z d z e z f))
+(equalp (substitute-if 'z #'(lambda (arg) (eq arg 'x))
+ #(a x b x c x d x e x f) :count 7 :from-end t)
+ #(a z b z c z d z e z f))
+(equalp (substitute-if 'z #'(lambda (arg) (eq arg 'x))
+ #(a x b x c x d x e x f) :start 2 :count 1)
+ #(a x b z c x d x e x f))
+(equalp (substitute-if 'z #'(lambda (arg) (eq arg 'x))
+ #(a x b x c x d x e x f) :start 2 :end nil :count 1)
+ #(a x b z c x d x e x f))
+(equalp (substitute-if 'z #'(lambda (arg) (eq arg 'x))
+ #(a x b x c x d x e x f) :start 2 :end 6 :count 100)
+ #(a x b z c z d x e x f))
+(equalp (substitute-if 'z #'(lambda (arg) (eq arg 'x))
+ #(a x b x c x d x e x f) :start 2 :end 11 :count 100)
+ #(a x b z c z d z e z f))
+(equalp (substitute-if 'z #'(lambda (arg) (eq arg 'x))
+ #(a x b x c x d x e x f) :start 2 :end 8 :count 10)
+ #(a x b z c z d z e x f))
+(equalp (substitute-if 'z #'(lambda (arg) (eq arg 'x))
+ #(a x b x c x d x e x f)
+ :start 2 :end 8 :count 2 :from-end t)
+ #(a x b x c z d z e x f))
+(equalp (substitute-if #\z #'(lambda (arg) (char< #\c arg))
+ #(#\a #\b #\c #\d #\e #\f))
+ #(#\a #\b #\c #\z #\z #\z))
+(equalp (substitute-if "peace" #'(lambda (arg) (equal "war" arg))
+ #("love" "hate" "war" "peace"))
+ #("love" "hate" "peace" "peace"))
+(equalp (substitute-if "peace" #'(lambda (arg) (string-equal "war" arg))
+ #("war" "War" "WAr" "WAR"))
+ #("peace" "peace" "peace" "peace"))
+(equalp (substitute-if "peace" #'(lambda (arg) (string= "WAR" arg))
+ #("war" "War" "WAr" "WAR")
+ :key #'string-upcase)
+ #("peace" "peace" "peace" "peace"))
+(equalp (substitute-if "peace" #'(lambda (arg) (string= "WAR" arg))
+ #("war" "War" "WAr" "WAR")
+ :start 1
+ :end 2
+ :key #'string-upcase)
+ #("war" "peace" "WAr" "WAR"))
+(equalp (substitute-if "peace" #'(lambda (arg) (string= "WAR" arg))
+ #("war" "War" "WAr" "WAR")
+ :start 1
+ :end nil
+ :key #'string-upcase)
+ #("war" "peace" "peace" "peace"))
+(equalp (substitute-if "peace" #'(lambda (arg) (string= "war" arg))
+ #("war" "War" "WAr" "WAR")
+ :key #'string-upcase)
+ #("war" "War" "WAr" "WAR"))
+(equalp (substitute-if "peace" #'(lambda (arg) (string= "WAR" arg))
+ #("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR")
+ :start 1
+ :end 7
+ :count 1
+ :key #'string-upcase)
+ #("war" "peace" "WAr" "WAR" "war" "War" "WAr" "WAR"))
+(equalp (substitute-if "peace" #'(lambda (arg) (string= "WAR" arg))
+ #("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR")
+ :start 1
+ :end 7
+ :count 2
+ :key #'string-upcase)
+ #("war" "peace" "peace" "WAR" "war" "War" "WAr" "WAR"))
+(equalp (substitute-if "peace" #'(lambda (arg) (string= "WAR" arg))
+ #("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR")
+ :start 1
+ :end 7
+ :count 2
+ :from-end t
+ :key #'string-upcase)
+ #("war" "War" "WAr" "WAR" "war" "peace" "peace" "WAR"))
+(equalp (substitute-if "peace" #'(lambda (arg) (string= "WAR" arg))
+ #("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR")
+ :start 1
+ :end 7
+ :count 0
+ :from-end t
+ :key #'string-upcase)
+ #("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR"))
+(equalp (substitute-if "peace" #'(lambda (arg) (string= "WAR" arg))
+ #("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR")
+ :start 1
+ :end 7
+ :count -2
+ :from-end t
+ :key #'string-upcase)
+ #("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR"))
+(equalp (substitute-if "peace" #'(lambda (arg) (string= "WAR" arg))
+ #("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR")
+ :start 1
+ :end 7
+ :count nil
+ :from-end t
+ :key #'string-upcase)
+ #("war" "peace" "peace" "peace" "peace" "peace" "peace" "WAR"))
+(equalp (substitute-if "peace" #'(lambda (arg) (string= "WAR" arg))
+ #("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR")
+ :start 1
+ :end 7
+ :count 6
+ :from-end t
+ :key #'string-upcase)
+ #("war" "peace" "peace" "peace" "peace" "peace" "peace" "WAR"))
+(equalp (substitute-if "peace" #'(lambda (arg) (string= "WAR" arg))
+ #("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR")
+ :start 1
+ :end 7
+ :count 7
+ :from-end t
+ :key #'string-upcase)
+ #("war" "peace" "peace" "peace" "peace" "peace" "peace" "WAR"))
+(equalp (substitute-if "peace" #'(lambda (arg) (string= "WAR" arg))
+ #("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR")
+ :start 1
+ :end 7
+ :count 100
+ :from-end t
+ :key #'string-upcase)
+ #("war" "peace" "peace" "peace" "peace" "peace" "peace" "WAR"))
+
+(string= (substitute-if #\A #'(lambda (arg) (eql #\a arg)) "abcabc") "AbcAbc")
+(string= (substitute-if #\A #'(lambda (arg) (eql #\a arg)) "") "")
+(string= (substitute-if #\A #'(lambda (arg) (eql #\a arg)) "xyz") "xyz")
+(string= (substitute-if #\A #'(lambda (arg) (eql #\a arg))
+ "aaaaaaaaaa" :start 5 :end nil) "aaaaaAAAAA")
+(string= (substitute-if #\x #'(lambda (arg) (char< #\5 arg))
+ "0123456789") "012345xxxx")
+(string= (substitute-if #\x #'(lambda (arg) (char> #\5 arg))
+ "0123456789") "xxxxx56789")
+(string= (substitute-if #\x #'(lambda (arg) (char> #\D arg)) "abcdefg"
+ :key #'char-upcase)
+ "xxxdefg")
+(string= (substitute-if #\x #'(lambda (arg) (char> #\D arg)) "abcdefg"
+ :start 1
+ :end 2
+ :key #'char-upcase)
+ "axcdefg")
+(string= (substitute-if #\A #'(lambda (arg) (eql #\a arg))
+ "aaaaaaaaaa" :count 2) "AAaaaaaaaa")
+(string= (substitute-if #\A #'(lambda (arg) (eql #\a arg))
+ "aaaaaaaaaa" :count -1) "aaaaaaaaaa")
+(string= (substitute-if #\A #'(lambda (arg) (eql #\a arg))
+ "aaaaaaaaaa" :count 0) "aaaaaaaaaa")
+(string= (substitute-if #\A #'(lambda (arg) (eql #\a arg))
+ "aaaaaaaaaa" :count nil) "AAAAAAAAAA")
+(string= (substitute-if #\A #'(lambda (arg) (eql #\a arg))
+ "aaaaaaaaaa" :count 100) "AAAAAAAAAA")
+(string= (substitute-if #\A #'(lambda (arg) (eql #\a arg))
+ "aaaaaaaaaa" :count 9) "AAAAAAAAAa")
+(string= (substitute-if #\A #'(lambda (arg) (eql #\a arg))
+ "aaaaaaaaaa" :count 9 :from-end t) "aAAAAAAAAA")
+(string= (substitute-if #\A #'(lambda (arg) (eql #\a arg))
+ "aaaaaaaaaa"
+ :start 2
+ :end 8
+ :count 3)
+ "aaAAAaaaaa")
+(string= (substitute-if #\A #'(lambda (arg) (eql #\a arg))
+ "aaaaaaaaaa"
+ :start 2
+ :end 8
+ :from-end t
+ :count 3)
+ "aaaaaAAAaa")
+(string= (substitute-if #\x #'(lambda (arg) (eql #\A arg))
+ "aaaaaaaaaa"
+ :start 2
+ :end 8
+ :from-end t
+ :count 3)
+ "aaaaaaaaaa")
+(string= (substitute-if #\X #'(lambda (arg) (eql #\A arg))
+ "aaaaaaaaaa"
+ :start 2
+ :end 8
+ :from-end t
+ :key #'char-upcase
+ :count 3)
+ "aaaaaXXXaa")
+(string= (substitute-if #\X #'(lambda (arg) (char< #\D arg))
+ "abcdefghij"
+ :start 2
+ :end 8
+ :from-end t
+ :key #'char-upcase
+ :count 3)
+ "abcdeXXXij")
+(equalp (substitute-if 0 #'(lambda (arg) (= 1 arg)) #*1111) #*0000)
+(equalp (substitute-if 0 #'(lambda (arg) (= 1 arg))
+ #*1111 :start 1 :end nil) #*1000)
+(equalp (substitute-if 0 #'(lambda (arg) (= 1 arg))
+ #*1111 :start 1 :end 3) #*1001)
+(equalp (substitute-if 0 #'(lambda (arg) (= 1 arg))
+ #*11111111 :start 1 :end 7) #*10000001)
+(equalp (substitute-if 0 #'(lambda (arg) (= 1 arg))
+ #*11111111 :start 1 :end 7 :count 3) #*10001111)
+(equalp (substitute-if 0 #'(lambda (arg) (= 1 arg))
+ #*11111111 :start 1 :end 7 :count 3 :from-end t)
+ #*11110001)
+(equalp (substitute-if 1 #'(lambda (arg) (= 1 arg))
+ #*10101010
+ :start 1 :end 7 :count 3 :from-end t
+ :key #'(lambda (x) (if (zerop x) 1 0)))
+ #*11111110)
+(equalp (substitute-if 1 #'(lambda (arg) (>= 1 arg))
+ #*10101010
+ :start 1 :end 7 :count 3 :from-end t
+ :key #'(lambda (x) (if (zerop x) 1 0)))
+ #*10101110)
+
+
+
+(equal (substitute-if-not 'a #'(lambda (arg) (not (eq arg 'x))) '(x y z))
+ '(a y z))
+(equal (substitute-if-not 'b #'(lambda (arg) (not (eq arg 'y))) '(x y z))
+ '(x b z))
+(equal (substitute-if-not 'c #'(lambda (arg) (not (eq arg 'z))) '(x y z))
+ '(x y c))
+(equal (substitute-if-not 'a #'(lambda (arg) (not (eq arg 'p))) '(x y z))
+ '(x y z))
+(equal (substitute-if-not 'a #'(lambda (arg) (not (eq arg 'x))) '()) '())
+(equal (substitute-if-not #\x #'(lambda (arg) (not (char< #\b arg)))
+ '(#\a #\b #\c #\d #\e))
+ '(#\a #\b #\x #\x #\x))
+(equal (substitute-if-not '(a) #'(lambda (arg) (not (eq arg 'x)))
+ '((x) (y) (z)) :key #'car)
+ '((a) (y) (z)))
+(equal (substitute-if-not 'c #'(lambda (arg) (not (eq arg 'b)))
+ '(a b a b a b a b)) '(a c a c a c a c))
+(equal (substitute-if-not 'a #'(lambda (arg) (not (eq arg 'b)))
+ '(b b b)) '(a a a))
+(equal (substitute-if-not 'z #'(lambda (arg) (not (eq arg 'x)))
+ '(a x b x c x d x e x f))
+ '(a z b z c z d z e z f))
+(equal (substitute-if-not 'z #'(lambda (arg) (not (eq arg 'x)))
+ '(a x b x c x d x e x f) :count nil)
+ '(a z b z c z d z e z f))
+(equal (substitute-if-not 'z #'(lambda (arg) (not (eq arg 'x)))
+ '(a x b x c x d x e x f) :count 0)
+ '(a x b x c x d x e x f))
+(equal (substitute-if-not 'z #'(lambda (arg) (not (eq arg 'x)))
+ '(a x b x c x d x e x f) :count -100)
+ '(a x b x c x d x e x f))
+(equal (substitute-if-not 'z #'(lambda (arg) (not (eq arg 'x)))
+ '(a x b x c x d x e x f) :count 1)
+ '(a z b x c x d x e x f))
+(equal (substitute-if-not 'z #'(lambda (arg) (not (eq arg 'x)))
+ '(a x b x c x d x e x f) :count 2)
+ '(a z b z c x d x e x f))
+(equal (substitute-if-not 'z #'(lambda (arg) (not (eq arg 'x)))
+ '(a x b x c x d x e x f) :count 3)
+ '(a z b z c z d x e x f))
+(equal (substitute-if-not 'z #'(lambda (arg) (not (eq arg 'x)))
+ '(a x b x c x d x e x f) :count 4)
+ '(a z b z c z d z e x f))
+(equal (substitute-if-not 'z #'(lambda (arg) (not (eq arg 'x)))
+ '(a x b x c x d x e x f) :count 5)
+ '(a z b z c z d z e z f))
+(equal (substitute-if-not 'z #'(lambda (arg) (not (eq arg 'x)))
+ '(a x b x c x d x e x f) :count 6)
+ '(a z b z c z d z e z f))
+(equal (substitute-if-not 'z #'(lambda (arg) (not (eq arg 'x)))
+ '(a x b x c x d x e x f) :count 7)
+ '(a z b z c z d z e z f))
+(equal (substitute-if-not 'z #'(lambda (arg) (not (eq arg 'x)))
+ '(a x b x c x d x e x f) :count nil :from-end t)
+ '(a z b z c z d z e z f))
+(equal (substitute-if-not 'z #'(lambda (arg) (not (eq arg 'x)))
+ '(a x b x c x d x e x f) :count 0 :from-end t)
+ '(a x b x c x d x e x f))
+(equal (substitute-if-not 'z #'(lambda (arg) (not (eq arg 'x)))
+ '(a x b x c x d x e x f) :count -100 :from-end t)
+ '(a x b x c x d x e x f))
+(equal (substitute-if-not 'z #'(lambda (arg) (not (eq arg 'x)))
+ '(a x b x c x d x e x f) :count 1 :from-end t)
+ '(a x b x c x d x e z f))
+(equal (substitute-if-not 'z #'(lambda (arg) (not (eq arg 'x)))
+ '(a x b x c x d x e x f) :count 2 :from-end t)
+ '(a x b x c x d z e z f))
+(equal (substitute-if-not 'z #'(lambda (arg) (not (eq arg 'x)))
+ '(a x b x c x d x e x f) :count 3 :from-end t)
+ '(a x b x c z d z e z f))
+(equal (substitute-if-not 'z #'(lambda (arg) (not (eq arg 'x)))
+ '(a x b x c x d x e x f) :count 4 :from-end t)
+ '(a x b z c z d z e z f))
+(equal (substitute-if-not 'z #'(lambda (arg) (not (eq arg 'x)))
+ '(a x b x c x d x e x f) :count 5 :from-end t)
+ '(a z b z c z d z e z f))
+(equal (substitute-if-not 'z #'(lambda (arg) (not (eq arg 'x)))
+ '(a x b x c x d x e x f) :count 6 :from-end t)
+ '(a z b z c z d z e z f))
+(equal (substitute-if-not 'z #'(lambda (arg) (not (eq arg 'x)))
+ '(a x b x c x d x e x f) :count 7 :from-end t)
+ '(a z b z c z d z e z f))
+(equal (substitute-if-not 'z #'(lambda (arg) (not (eq arg 'x)))
+ '(a x b x c x d x e x f) :start 2 :count 1)
+ '(a x b z c x d x e x f))
+(equal (substitute-if-not 'z #'(lambda (arg) (not (eq arg 'x)))
+ '(a x b x c x d x e x f) :start 2 :end nil :count 1)
+ '(a x b z c x d x e x f))
+(equal (substitute-if-not 'z #'(lambda (arg) (not (eq arg 'x)))
+ '(a x b x c x d x e x f) :start 2 :end 6 :count 100)
+ '(a x b z c z d x e x f))
+(equal (substitute-if-not 'z #'(lambda (arg) (not (eq arg 'x)))
+ '(a x b x c x d x e x f) :start 2 :end 11 :count 100)
+ '(a x b z c z d z e z f))
+(equal (substitute-if-not 'z #'(lambda (arg) (not (eq arg 'x)))
+ '(a x b x c x d x e x f) :start 2 :end 8 :count 10)
+ '(a x b z c z d z e x f))
+(equal (substitute-if-not 'z #'(lambda (arg) (not (eq arg 'x)))
+ '(a x b x c x d x e x f)
+ :start 2 :end 8 :count 2 :from-end t)
+ '(a x b x c z d z e x f))
+(equal (substitute-if-not #\z #'(lambda (arg) (not (char< #\c arg)))
+ '(#\a #\b #\c #\d #\e #\f))
+ '(#\a #\b #\c #\z #\z #\z))
+(equal (substitute-if-not "peace" #'(lambda (arg) (not (equal "war" arg)))
+ '("love" "hate" "war" "peace"))
+ '("love" "hate" "peace" "peace"))
+(equal (substitute-if-not "peace"
+ #'(lambda (arg) (not (string-equal "war" arg)))
+ '("war" "War" "WAr" "WAR"))
+ '("peace" "peace" "peace" "peace"))
+(equal (substitute-if-not "peace" #'(lambda (arg) (not (string= "WAR" arg)))
+ '("war" "War" "WAr" "WAR")
+ :key #'string-upcase)
+ '("peace" "peace" "peace" "peace"))
+(equal (substitute-if-not "peace" #'(lambda (arg) (not (string= "WAR" arg)))
+ '("war" "War" "WAr" "WAR")
+ :start 1
+ :end 2
+ :key #'string-upcase)
+ '("war" "peace" "WAr" "WAR"))
+(equal (substitute-if-not "peace" #'(lambda (arg) (not (string= "WAR" arg)))
+ '("war" "War" "WAr" "WAR")
+ :start 1
+ :end nil
+ :key #'string-upcase)
+ '("war" "peace" "peace" "peace"))
+(equal (substitute-if-not "peace" #'(lambda (arg) (not (string= "war" arg)))
+ '("war" "War" "WAr" "WAR")
+ :key #'string-upcase)
+ '("war" "War" "WAr" "WAR"))
+(equal (substitute-if-not "peace" #'(lambda (arg) (not (string= "WAR" arg)))
+ '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR")
+ :start 1
+ :end 7
+ :count 1
+ :key #'string-upcase)
+ '("war" "peace" "WAr" "WAR" "war" "War" "WAr" "WAR"))
+(equal (substitute-if-not "peace" #'(lambda (arg) (not (string= "WAR" arg)))
+ '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR")
+ :start 1
+ :end 7
+ :count 2
+ :key #'string-upcase)
+ '("war" "peace" "peace" "WAR" "war" "War" "WAr" "WAR"))
+(equal (substitute-if-not "peace" #'(lambda (arg) (not (string= "WAR" arg)))
+ '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR")
+ :start 1
+ :end 7
+ :count 2
+ :from-end t
+ :key #'string-upcase)
+ '("war" "War" "WAr" "WAR" "war" "peace" "peace" "WAR"))
+(equal (substitute-if-not "peace" #'(lambda (arg) (not (string= "WAR" arg)))
+ '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR")
+ :start 1
+ :end 7
+ :count 0
+ :from-end t
+ :key #'string-upcase)
+ '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR"))
+(equal (substitute-if-not "peace" #'(lambda (arg) (not (string= "WAR" arg)))
+ '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR")
+ :start 1
+ :end 7
+ :count -2
+ :from-end t
+ :key #'string-upcase)
+ '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR"))
+(equal (substitute-if-not "peace" #'(lambda (arg) (not (string= "WAR" arg)))
+ '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR")
+ :start 1
+ :end 7
+ :count nil
+ :from-end t
+ :key #'string-upcase)
+ '("war" "peace" "peace" "peace" "peace" "peace" "peace" "WAR"))
+(equal (substitute-if-not "peace" #'(lambda (arg) (not (string= "WAR" arg)))
+ '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR")
+ :start 1
+ :end 7
+ :count 6
+ :from-end t
+ :key #'string-upcase)
+ '("war" "peace" "peace" "peace" "peace" "peace" "peace" "WAR"))
+(equal (substitute-if-not "peace" #'(lambda (arg) (not (string= "WAR" arg)))
+ '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR")
+ :start 1
+ :end 7
+ :count 7
+ :from-end t
+ :key #'string-upcase)
+ '("war" "peace" "peace" "peace" "peace" "peace" "peace" "WAR"))
+(equal (substitute-if-not "peace" #'(lambda (arg) (not (string= "WAR" arg)))
+ '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR")
+ :start 1
+ :end 7
+ :count 100
+ :from-end t
+ :key #'string-upcase)
+ '("war" "peace" "peace" "peace" "peace" "peace" "peace" "WAR"))
+
+
+(equalp (substitute-if-not 'a #'(lambda (arg) (not (eq arg 'x)))
+ #(x y z)) #(a y z))
+(equalp (substitute-if-not 'b #'(lambda (arg) (not (eq arg 'y)))
+ #(x y z)) #(x b z))
+(equalp (substitute-if-not 'c #'(lambda (arg) (not (eq arg 'z)))
+ #(x y z)) #(x y c))
+(equalp (substitute-if-not 'a #'(lambda (arg) (not (eq arg 'p)))
+ #(x y z)) #(x y z))
+(equalp (substitute-if-not 'a #'(lambda (arg) (not (eq arg 'x)))
+ #()) #())
+(equalp (substitute-if-not #\x #'(lambda (arg) (not (char< #\b arg)))
+ #(#\a #\b #\c #\d #\e))
+ #(#\a #\b #\x #\x #\x))
+(equalp (substitute-if-not '(a) #'(lambda (arg) (not (eq arg 'x)))
+ #((x) (y) (z)) :key #'car)
+ #((a) (y) (z)))
+(equalp (substitute-if-not 'c #'(lambda (arg) (not (eq arg 'b)))
+ #(a b a b a b a b)) #(a c a c a c a c))
+(equalp (substitute-if-not 'a #'(lambda (arg) (not (eq arg 'b)))
+ #(b b b)) #(a a a))
+(equalp (substitute-if-not 'z #'(lambda (arg) (not (eq arg 'x)))
+ #(a x b x c x d x e x f))
+ #(a z b z c z d z e z f))
+(equalp (substitute-if-not 'z #'(lambda (arg) (not (eq arg 'x)))
+ #(a x b x c x d x e x f) :count nil)
+ #(a z b z c z d z e z f))
+(equalp (substitute-if-not 'z #'(lambda (arg) (not (eq arg 'x)))
+ #(a x b x c x d x e x f) :count 0)
+ #(a x b x c x d x e x f))
+(equalp (substitute-if-not 'z #'(lambda (arg) (not (eq arg 'x)))
+ #(a x b x c x d x e x f) :count -100)
+ #(a x b x c x d x e x f))
+(equalp (substitute-if-not 'z #'(lambda (arg) (not (eq arg 'x)))
+ #(a x b x c x d x e x f) :count 1)
+ #(a z b x c x d x e x f))
+(equalp (substitute-if-not 'z #'(lambda (arg) (not (eq arg 'x)))
+ #(a x b x c x d x e x f) :count 2)
+ #(a z b z c x d x e x f))
+(equalp (substitute-if-not 'z #'(lambda (arg) (not (eq arg 'x)))
+ #(a x b x c x d x e x f) :count 3)
+ #(a z b z c z d x e x f))
+(equalp (substitute-if-not 'z #'(lambda (arg) (not (eq arg 'x)))
+ #(a x b x c x d x e x f) :count 4)
+ #(a z b z c z d z e x f))
+(equalp (substitute-if-not 'z #'(lambda (arg) (not (eq arg 'x)))
+ #(a x b x c x d x e x f) :count 5)
+ #(a z b z c z d z e z f))
+(equalp (substitute-if-not 'z #'(lambda (arg) (not (eq arg 'x)))
+ #(a x b x c x d x e x f) :count 6)
+ #(a z b z c z d z e z f))
+(equalp (substitute-if-not 'z #'(lambda (arg) (not (eq arg 'x)))
+ #(a x b x c x d x e x f) :count 7)
+ #(a z b z c z d z e z f))
+(equalp (substitute-if-not 'z #'(lambda (arg) (not (eq arg 'x)))
+ #(a x b x c x d x e x f) :count nil :from-end t)
+ #(a z b z c z d z e z f))
+(equalp (substitute-if-not 'z #'(lambda (arg) (not (eq arg 'x)))
+ #(a x b x c x d x e x f) :count 0 :from-end t)
+ #(a x b x c x d x e x f))
+(equalp (substitute-if-not 'z #'(lambda (arg) (not (eq arg 'x)))
+ #(a x b x c x d x e x f) :count -100 :from-end t)
+ #(a x b x c x d x e x f))
+(equalp (substitute-if-not 'z #'(lambda (arg) (not (eq arg 'x)))
+ #(a x b x c x d x e x f) :count 1 :from-end t)
+ #(a x b x c x d x e z f))
+(equalp (substitute-if-not 'z #'(lambda (arg) (not (eq arg 'x)))
+ #(a x b x c x d x e x f) :count 2 :from-end t)
+ #(a x b x c x d z e z f))
+(equalp (substitute-if-not 'z #'(lambda (arg) (not (eq arg 'x)))
+ #(a x b x c x d x e x f) :count 3 :from-end t)
+ #(a x b x c z d z e z f))
+(equalp (substitute-if-not 'z #'(lambda (arg) (not (eq arg 'x)))
+ #(a x b x c x d x e x f) :count 4 :from-end t)
+ #(a x b z c z d z e z f))
+(equalp (substitute-if-not 'z #'(lambda (arg) (not (eq arg 'x)))
+ #(a x b x c x d x e x f) :count 5 :from-end t)
+ #(a z b z c z d z e z f))
+(equalp (substitute-if-not 'z #'(lambda (arg) (not (eq arg 'x)))
+ #(a x b x c x d x e x f) :count 6 :from-end t)
+ #(a z b z c z d z e z f))
+(equalp (substitute-if-not 'z #'(lambda (arg) (not (eq arg 'x)))
+ #(a x b x c x d x e x f) :count 7 :from-end t)
+ #(a z b z c z d z e z f))
+(equalp (substitute-if-not 'z #'(lambda (arg) (not (eq arg 'x)))
+ #(a x b x c x d x e x f) :start 2 :count 1)
+ #(a x b z c x d x e x f))
+(equalp (substitute-if-not 'z #'(lambda (arg) (not (eq arg 'x)))
+ #(a x b x c x d x e x f) :start 2 :end nil :count 1)
+ #(a x b z c x d x e x f))
+(equalp (substitute-if-not 'z #'(lambda (arg) (not (eq arg 'x)))
+ #(a x b x c x d x e x f) :start 2 :end 6 :count 100)
+ #(a x b z c z d x e x f))
+(equalp (substitute-if-not 'z #'(lambda (arg) (not (eq arg 'x)))
+ #(a x b x c x d x e x f) :start 2 :end 11 :count 100)
+ #(a x b z c z d z e z f))
+(equalp (substitute-if-not 'z #'(lambda (arg) (not (eq arg 'x)))
+ #(a x b x c x d x e x f) :start 2 :end 8 :count 10)
+ #(a x b z c z d z e x f))
+(equalp (substitute-if-not 'z #'(lambda (arg) (not (eq arg 'x)))
+ #(a x b x c x d x e x f)
+ :start 2 :end 8 :count 2 :from-end t)
+ #(a x b x c z d z e x f))
+(equalp (substitute-if-not #\z #'(lambda (arg) (not (char< #\c arg)))
+ #(#\a #\b #\c #\d #\e #\f))
+ #(#\a #\b #\c #\z #\z #\z))
+(equalp (substitute-if-not "peace" #'(lambda (arg) (not (equal "war" arg)))
+ #("love" "hate" "war" "peace"))
+ #("love" "hate" "peace" "peace"))
+(equalp (substitute-if-not "peace"
+ #'(lambda (arg) (not (string-equal "war" arg)))
+ #("war" "War" "WAr" "WAR"))
+ #("peace" "peace" "peace" "peace"))
+(equalp (substitute-if-not "peace" #'(lambda (arg) (not (string= "WAR" arg)))
+ #("war" "War" "WAr" "WAR")
+ :key #'string-upcase)
+ #("peace" "peace" "peace" "peace"))
+(equalp (substitute-if-not "peace" #'(lambda (arg) (not (string= "WAR" arg)))
+ #("war" "War" "WAr" "WAR")
+ :start 1
+ :end 2
+ :key #'string-upcase)
+ #("war" "peace" "WAr" "WAR"))
+(equalp (substitute-if-not "peace" #'(lambda (arg) (not (string= "WAR" arg)))
+ #("war" "War" "WAr" "WAR")
+ :start 1
+ :end nil
+ :key #'string-upcase)
+ #("war" "peace" "peace" "peace"))
+(equalp (substitute-if-not "peace" #'(lambda (arg) (not (string= "war" arg)))
+ #("war" "War" "WAr" "WAR")
+ :key #'string-upcase)
+ #("war" "War" "WAr" "WAR"))
+(equalp (substitute-if-not "peace" #'(lambda (arg) (not (string= "WAR" arg)))
+ #("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR")
+ :start 1
+ :end 7
+ :count 1
+ :key #'string-upcase)
+ #("war" "peace" "WAr" "WAR" "war" "War" "WAr" "WAR"))
+(equalp (substitute-if-not "peace" #'(lambda (arg) (not (string= "WAR" arg)))
+ #("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR")
+ :start 1
+ :end 7
+ :count 2
+ :key #'string-upcase)
+ #("war" "peace" "peace" "WAR" "war" "War" "WAr" "WAR"))
+(equalp (substitute-if-not "peace" #'(lambda (arg) (not (string= "WAR" arg)))
+ #("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR")
+ :start 1
+ :end 7
+ :count 2
+ :from-end t
+ :key #'string-upcase)
+ #("war" "War" "WAr" "WAR" "war" "peace" "peace" "WAR"))
+(equalp (substitute-if-not "peace" #'(lambda (arg) (not (string= "WAR" arg)))
+ #("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR")
+ :start 1
+ :end 7
+ :count 0
+ :from-end t
+ :key #'string-upcase)
+ #("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR"))
+(equalp (substitute-if-not "peace" #'(lambda (arg) (not (string= "WAR" arg)))
+ #("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR")
+ :start 1
+ :end 7
+ :count -2
+ :from-end t
+ :key #'string-upcase)
+ #("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR"))
+(equalp (substitute-if-not "peace" #'(lambda (arg) (not (string= "WAR" arg)))
+ #("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR")
+ :start 1
+ :end 7
+ :count nil
+ :from-end t
+ :key #'string-upcase)
+ #("war" "peace" "peace" "peace" "peace" "peace" "peace" "WAR"))
+(equalp (substitute-if-not "peace" #'(lambda (arg) (not (string= "WAR" arg)))
+ #("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR")
+ :start 1
+ :end 7
+ :count 6
+ :from-end t
+ :key #'string-upcase)
+ #("war" "peace" "peace" "peace" "peace" "peace" "peace" "WAR"))
+(equalp (substitute-if-not "peace" #'(lambda (arg) (not (string= "WAR" arg)))
+ #("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR")
+ :start 1
+ :end 7
+ :count 7
+ :from-end t
+ :key #'string-upcase)
+ #("war" "peace" "peace" "peace" "peace" "peace" "peace" "WAR"))
+(equalp (substitute-if-not "peace" #'(lambda (arg) (not (string= "WAR" arg)))
+ #("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR")
+ :start 1
+ :end 7
+ :count 100
+ :from-end t
+ :key #'string-upcase)
+ #("war" "peace" "peace" "peace" "peace" "peace" "peace" "WAR"))
+
+(string= (substitute-if-not #\A #'(lambda (arg) (not (eql #\a arg))) "abcabc")
+ "AbcAbc")
+(string= (substitute-if-not #\A #'(lambda (arg) (not (eql #\a arg))) "") "")
+(string= (substitute-if-not #\A #'(lambda (arg) (not (eql #\a arg))) "xyz")
+ "xyz")
+(string= (substitute-if-not #\A #'(lambda (arg) (not (eql #\a arg)))
+ "aaaaaaaaaa" :start 5 :end nil) "aaaaaAAAAA")
+(string= (substitute-if-not #\x #'(lambda (arg) (not (char< #\5 arg)))
+ "0123456789") "012345xxxx")
+(string= (substitute-if-not #\x #'(lambda (arg) (not (char> #\5 arg)))
+ "0123456789") "xxxxx56789")
+(string= (substitute-if-not #\x #'(lambda (arg) (not (char> #\D arg)))
+ "abcdefg"
+ :key #'char-upcase)
+ "xxxdefg")
+(string= (substitute-if-not #\x #'(lambda (arg) (not (char> #\D arg)))
+ "abcdefg"
+ :start 1
+ :end 2
+ :key #'char-upcase)
+ "axcdefg")
+(string= (substitute-if-not #\A #'(lambda (arg) (not (eql #\a arg)))
+ "aaaaaaaaaa" :count 2) "AAaaaaaaaa")
+(string= (substitute-if-not #\A #'(lambda (arg) (not (eql #\a arg)))
+ "aaaaaaaaaa" :count -1) "aaaaaaaaaa")
+(string= (substitute-if-not #\A #'(lambda (arg) (not (eql #\a arg)))
+ "aaaaaaaaaa" :count 0) "aaaaaaaaaa")
+(string= (substitute-if-not #\A #'(lambda (arg) (not (eql #\a arg)))
+ "aaaaaaaaaa" :count nil) "AAAAAAAAAA")
+(string= (substitute-if-not #\A #'(lambda (arg) (not (eql #\a arg)))
+ "aaaaaaaaaa" :count 100) "AAAAAAAAAA")
+(string= (substitute-if-not #\A #'(lambda (arg) (not (eql #\a arg)))
+ "aaaaaaaaaa" :count 9) "AAAAAAAAAa")
+(string= (substitute-if-not #\A #'(lambda (arg) (not (eql #\a arg)))
+ "aaaaaaaaaa" :count 9 :from-end t) "aAAAAAAAAA")
+(string= (substitute-if-not #\A #'(lambda (arg) (not (eql #\a arg)))
+ "aaaaaaaaaa"
+ :start 2
+ :end 8
+ :count 3)
+ "aaAAAaaaaa")
+(string= (substitute-if-not #\A #'(lambda (arg) (not (eql #\a arg)))
+ "aaaaaaaaaa"
+ :start 2
+ :end 8
+ :from-end t
+ :count 3)
+ "aaaaaAAAaa")
+(string= (substitute-if-not #\x #'(lambda (arg) (not (eql #\A arg)))
+ "aaaaaaaaaa"
+ :start 2
+ :end 8
+ :from-end t
+ :count 3)
+ "aaaaaaaaaa")
+(string= (substitute-if-not #\X #'(lambda (arg) (not (eql #\A arg)))
+ "aaaaaaaaaa"
+ :start 2
+ :end 8
+ :from-end t
+ :key #'char-upcase
+ :count 3)
+ "aaaaaXXXaa")
+(string= (substitute-if-not #\X #'(lambda (arg) (not (char< #\D arg)))
+ "abcdefghij"
+ :start 2
+ :end 8
+ :from-end t
+ :key #'char-upcase
+ :count 3)
+ "abcdeXXXij")
+(equalp (substitute-if-not 0 #'(lambda (arg) (not (= 1 arg))) #*1111) #*0000)
+(equalp (substitute-if-not 0 #'(lambda (arg) (not (= 1 arg)))
+ #*1111 :start 1 :end nil) #*1000)
+(equalp (substitute-if-not 0 #'(lambda (arg) (not (= 1 arg)))
+ #*1111 :start 1 :end 3) #*1001)
+(equalp (substitute-if-not 0 #'(lambda (arg) (not (= 1 arg)))
+ #*11111111 :start 1 :end 7) #*10000001)
+(equalp (substitute-if-not 0 #'(lambda (arg) (not (= 1 arg)))
+ #*11111111 :start 1 :end 7 :count 3) #*10001111)
+(equalp (substitute-if-not 0 #'(lambda (arg) (not (= 1 arg)))
+ #*11111111 :start 1 :end 7 :count 3 :from-end t)
+ #*11110001)
+(equalp (substitute-if-not 1 #'(lambda (arg) (not (= 1 arg)))
+ #*10101010
+ :start 1 :end 7 :count 3 :from-end t
+ :key #'(lambda (x) (if (zerop x) 1 0)))
+ #*11111110)
+(equalp (substitute-if-not 1 #'(lambda (arg) (not (>= 1 arg)))
+ #*10101010
+ :start 1 :end 7 :count 3 :from-end t
+ :key #'(lambda (x) (if (zerop x) 1 0)))
+ #*10101110)
+
+
+(equal (nsubstitute 'a 'x (copy-seq '(x y z))) '(a y z))
+(equal (nsubstitute 'b 'y (copy-seq '(x y z))) '(x b z))
+(equal (nsubstitute 'c 'z (copy-seq '(x y z))) '(x y c))
+(equal (nsubstitute 'a 'p (copy-seq '(x y z))) '(x y z))
+(equal (nsubstitute 'a 'x (copy-seq '())) '())
+(equal (nsubstitute #\x #\b (copy-seq '(#\a #\b #\c #\d #\e)) :test #'char<)
+ '(#\a #\b #\x #\x #\x))
+(equal (nsubstitute #\x #\b (copy-seq '(#\a #\b #\c #\d #\e))
+ :test-not (complement #'char<))
+ '(#\a #\b #\x #\x #\x))
+(equal (nsubstitute '(a) 'x (copy-seq '((x) (y) (z))) :key #'car)
+ '((a) (y) (z)))
+(equal (nsubstitute 'c 'b (copy-seq '(a b a b a b a b))) '(a c a c a c a c))
+(equal (nsubstitute 'a 'b (copy-seq '(b b b))) '(a a a))
+(equal (nsubstitute 'z 'x (copy-seq '(a x b x c x d x e x f)))
+ '(a z b z c z d z e z f))
+(equal (nsubstitute 'z 'x (copy-seq '(a x b x c x d x e x f)) :count nil)
+ '(a z b z c z d z e z f))
+(equal (nsubstitute 'z 'x (copy-seq '(a x b x c x d x e x f)) :count 0)
+ '(a x b x c x d x e x f))
+(equal (nsubstitute 'z 'x (copy-seq '(a x b x c x d x e x f)) :count -100)
+ '(a x b x c x d x e x f))
+(equal (nsubstitute 'z 'x (copy-seq '(a x b x c x d x e x f)) :count 1)
+ '(a z b x c x d x e x f))
+(equal (nsubstitute 'z 'x (copy-seq '(a x b x c x d x e x f)) :count 2)
+ '(a z b z c x d x e x f))
+(equal (nsubstitute 'z 'x (copy-seq '(a x b x c x d x e x f)) :count 3)
+ '(a z b z c z d x e x f))
+(equal (nsubstitute 'z 'x (copy-seq '(a x b x c x d x e x f)) :count 4)
+ '(a z b z c z d z e x f))
+(equal (nsubstitute 'z 'x (copy-seq '(a x b x c x d x e x f)) :count 5)
+ '(a z b z c z d z e z f))
+(equal (nsubstitute 'z 'x (copy-seq '(a x b x c x d x e x f)) :count 6)
+ '(a z b z c z d z e z f))
+(equal (nsubstitute 'z 'x (copy-seq '(a x b x c x d x e x f)) :count 7)
+ '(a z b z c z d z e z f))
+(equal (nsubstitute 'z 'x (copy-seq '(a x b x c x d x e x f))
+ :count nil :from-end t)
+ '(a z b z c z d z e z f))
+(equal (nsubstitute 'z 'x (copy-seq '(a x b x c x d x e x f))
+ :count 0 :from-end t)
+ '(a x b x c x d x e x f))
+(equal (nsubstitute 'z 'x (copy-seq '(a x b x c x d x e x f))
+ :count -100 :from-end t)
+ '(a x b x c x d x e x f))
+(equal (nsubstitute 'z 'x (copy-seq '(a x b x c x d x e x f))
+ :count 1 :from-end t)
+ '(a x b x c x d x e z f))
+(equal (nsubstitute 'z 'x (copy-seq '(a x b x c x d x e x f))
+ :count 2 :from-end t)
+ '(a x b x c x d z e z f))
+(equal (nsubstitute 'z 'x (copy-seq '(a x b x c x d x e x f))
+ :count 3 :from-end t)
+ '(a x b x c z d z e z f))
+(equal (nsubstitute 'z 'x (copy-seq '(a x b x c x d x e x f))
+ :count 4 :from-end t)
+ '(a x b z c z d z e z f))
+(equal (nsubstitute 'z 'x (copy-seq '(a x b x c x d x e x f))
+ :count 5 :from-end t)
+ '(a z b z c z d z e z f))
+(equal (nsubstitute 'z 'x (copy-seq '(a x b x c x d x e x f))
+ :count 6 :from-end t)
+ '(a z b z c z d z e z f))
+(equal (nsubstitute 'z 'x (copy-seq '(a x b x c x d x e x f))
+ :count 7 :from-end t)
+ '(a z b z c z d z e z f))
+(equal (nsubstitute 'z 'x (copy-seq '(a x b x c x d x e x f))
+ :start 2 :count 1)
+ '(a x b z c x d x e x f))
+(equal (nsubstitute 'z 'x (copy-seq '(a x b x c x d x e x f))
+ :start 2 :end nil :count 1)
+ '(a x b z c x d x e x f))
+(equal (nsubstitute 'z 'x (copy-seq '(a x b x c x d x e x f))
+ :start 2 :end 6 :count 100)
+ '(a x b z c z d x e x f))
+(equal (nsubstitute 'z 'x (copy-seq '(a x b x c x d x e x f))
+ :start 2 :end 11 :count 100)
+ '(a x b z c z d z e z f))
+(equal (nsubstitute 'z 'x (copy-seq '(a x b x c x d x e x f))
+ :start 2 :end 8 :count 10)
+ '(a x b z c z d z e x f))
+(equal (nsubstitute 'z 'x (copy-seq '(a x b x c x d x e x f))
+ :start 2 :end 8 :count 2 :from-end t)
+ '(a x b x c z d z e x f))
+(equal (nsubstitute #\z #\c (copy-seq '(#\a #\b #\c #\d #\e #\f))
+ :test #'char<)
+ '(#\a #\b #\c #\z #\z #\z))
+(equal (nsubstitute #\z #\c (copy-seq '(#\a #\b #\c #\d #\e #\f))
+ :test-not (complement #'char<))
+ '(#\a #\b #\c #\z #\z #\z))
+(equal (nsubstitute "peace" "war" (copy-seq '("love" "hate" "war" "peace"))
+ :test #'equal)
+ '("love" "hate" "peace" "peace"))
+(equal (nsubstitute "peace" "war" (copy-seq '("love" "hate" "war" "peace"))
+ :test-not (complement #'equal))
+ '("love" "hate" "peace" "peace"))
+(equal (nsubstitute "peace" "war" (copy-seq '("war" "War" "WAr" "WAR"))
+ :test #'string-equal)
+ '("peace" "peace" "peace" "peace"))
+(equal (nsubstitute "peace" "war" (copy-seq '("war" "War" "WAr" "WAR"))
+ :test-not (complement #'string-equal))
+ '("peace" "peace" "peace" "peace"))
+(equal (nsubstitute "peace" "WAR" (copy-seq '("war" "War" "WAr" "WAR"))
+ :test #'string=)
+ '("war" "War" "WAr" "peace"))
+(equal (nsubstitute "peace" "WAR" (copy-seq '("war" "War" "WAr" "WAR"))
+ :test-not (complement #'string=))
+ '("war" "War" "WAr" "peace"))
+(equal (nsubstitute "peace" "WAR" (copy-seq '("war" "War" "WAr" "WAR"))
+ :test #'string=
+ :key #'string-upcase)
+ '("peace" "peace" "peace" "peace"))
+(equal (nsubstitute "peace" "WAR" (copy-seq '("war" "War" "WAr" "WAR"))
+ :test-not (complement #'string=)
+ :key #'string-upcase)
+ '("peace" "peace" "peace" "peace"))
+(equal (nsubstitute "peace" "WAR" (copy-seq '("war" "War" "WAr" "WAR"))
+ :start 1
+ :end 2
+ :test #'string=
+ :key #'string-upcase)
+ '("war" "peace" "WAr" "WAR"))
+(equal (nsubstitute "peace" "WAR" (copy-seq '("war" "War" "WAr" "WAR"))
+ :start 1
+ :end 2
+ :test-not (complement #'string=)
+ :key #'string-upcase)
+ '("war" "peace" "WAr" "WAR"))
+(equal (nsubstitute "peace" "WAR" (copy-seq '("war" "War" "WAr" "WAR"))
+ :start 1
+ :end nil
+ :test #'string=
+ :key #'string-upcase)
+ '("war" "peace" "peace" "peace"))
+(equal (nsubstitute "peace" "WAR" (copy-seq '("war" "War" "WAr" "WAR"))
+ :start 1
+ :end nil
+ :test-not (complement #'string=)
+ :key #'string-upcase)
+ '("war" "peace" "peace" "peace"))
+(equal (nsubstitute "peace" "war" (copy-seq '("war" "War" "WAr" "WAR"))
+ :test #'string=
+ :key #'string-upcase)
+ '("war" "War" "WAr" "WAR"))
+(equal (nsubstitute "peace" "war" (copy-seq '("war" "War" "WAr" "WAR"))
+ :test-not (complement #'string=)
+ :key #'string-upcase)
+ '("war" "War" "WAr" "WAR"))
+(equal (nsubstitute "peace" "WAR"
+ (copy-seq
+ '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR"))
+ :start 1
+ :end 7
+ :count 1
+ :test-not (complement #'string=)
+ :key #'string-upcase)
+ '("war" "peace" "WAr" "WAR" "war" "War" "WAr" "WAR"))
+(equal (nsubstitute "peace" "WAR"
+ (copy-seq '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR"))
+ :start 1
+ :end 7
+ :count 2
+ :test-not (complement #'string=)
+ :key #'string-upcase)
+ '("war" "peace" "peace" "WAR" "war" "War" "WAr" "WAR"))
+(equal (nsubstitute "peace" "WAR"
+ (copy-seq
+ '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR"))
+ :start 1
+ :end 7
+ :count 2
+ :from-end t
+ :test-not (complement #'string=)
+ :key #'string-upcase)
+ '("war" "War" "WAr" "WAR" "war" "peace" "peace" "WAR"))
+(equal (nsubstitute "peace" "WAR"
+ (copy-seq
+ '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR"))
+ :start 1
+ :end 7
+ :count 0
+ :from-end t
+ :test-not (complement #'string=)
+ :key #'string-upcase)
+ '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR"))
+(equal (nsubstitute "peace" "WAR"
+ (copy-seq
+ '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR"))
+ :start 1
+ :end 7
+ :count -2
+ :from-end t
+ :test-not (complement #'string=)
+ :key #'string-upcase)
+ '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR"))
+(equal (nsubstitute "peace" "WAR"
+ (copy-seq
+ '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR"))
+ :start 1
+ :end 7
+ :count nil
+ :from-end t
+ :test-not (complement #'string=)
+ :key #'string-upcase)
+ '("war" "peace" "peace" "peace" "peace" "peace" "peace" "WAR"))
+(equal (nsubstitute "peace" "WAR"
+ (copy-seq
+ '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR"))
+ :start 1
+ :end 7
+ :count 6
+ :from-end t
+ :test-not (complement #'string=)
+ :key #'string-upcase)
+ '("war" "peace" "peace" "peace" "peace" "peace" "peace" "WAR"))
+(equal (nsubstitute "peace" "WAR"
+ (copy-seq
+ '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR"))
+ :start 1
+ :end 7
+ :count 7
+ :from-end t
+ :test-not (complement #'string=)
+ :key #'string-upcase)
+ '("war" "peace" "peace" "peace" "peace" "peace" "peace" "WAR"))
+(equal (nsubstitute "peace" "WAR"
+ (copy-seq
+ '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR"))
+ :start 1
+ :end 7
+ :count 100
+ :from-end t
+ :test-not (complement #'string=)
+ :key #'string-upcase)
+ '("war" "peace" "peace" "peace" "peace" "peace" "peace" "WAR"))
+
+
+(equalp (nsubstitute 'a 'x (copy-seq #(x y z))) #(a y z))
+(equalp (nsubstitute 'b 'y (copy-seq #(x y z))) #(x b z))
+(equalp (nsubstitute 'c 'z (copy-seq #(x y z))) #(x y c))
+(equalp (nsubstitute 'a 'p (copy-seq #(x y z))) #(x y z))
+(equalp (nsubstitute 'a 'x (copy-seq #())) #())
+(equalp (nsubstitute #\x #\b (copy-seq #(#\a #\b #\c #\d #\e)) :test #'char<)
+ #(#\a #\b #\x #\x #\x))
+(equalp (nsubstitute #\x #\b (copy-seq #(#\a #\b #\c #\d #\e))
+ :test-not (complement #'char<))
+ #(#\a #\b #\x #\x #\x))
+(equalp (nsubstitute '(a) 'x (copy-seq #((x) (y) (z))) :key #'car)
+ #((a) (y) (z)))
+(equalp (nsubstitute 'c 'b (copy-seq #(a b a b a b a b))) #(a c a c a c a c))
+(equalp (nsubstitute 'a 'b (copy-seq #(b b b))) #(a a a))
+(equalp (nsubstitute 'z 'x (copy-seq #(a x b x c x d x e x f)))
+ #(a z b z c z d z e z f))
+(equalp (nsubstitute 'z 'x (copy-seq #(a x b x c x d x e x f)) :count nil)
+ #(a z b z c z d z e z f))
+(equalp (nsubstitute 'z 'x (copy-seq #(a x b x c x d x e x f)) :count 0)
+ #(a x b x c x d x e x f))
+(equalp (nsubstitute 'z 'x (copy-seq #(a x b x c x d x e x f)) :count -100)
+ #(a x b x c x d x e x f))
+(equalp (nsubstitute 'z 'x (copy-seq #(a x b x c x d x e x f)) :count 1)
+ #(a z b x c x d x e x f))
+(equalp (nsubstitute 'z 'x (copy-seq #(a x b x c x d x e x f)) :count 2)
+ #(a z b z c x d x e x f))
+(equalp (nsubstitute 'z 'x (copy-seq #(a x b x c x d x e x f)) :count 3)
+ #(a z b z c z d x e x f))
+(equalp (nsubstitute 'z 'x (copy-seq #(a x b x c x d x e x f)) :count 4)
+ #(a z b z c z d z e x f))
+(equalp (nsubstitute 'z 'x (copy-seq #(a x b x c x d x e x f)) :count 5)
+ #(a z b z c z d z e z f))
+(equalp (nsubstitute 'z 'x (copy-seq #(a x b x c x d x e x f)) :count 6)
+ #(a z b z c z d z e z f))
+(equalp (nsubstitute 'z 'x (copy-seq #(a x b x c x d x e x f)) :count 7)
+ #(a z b z c z d z e z f))
+(equalp (nsubstitute 'z 'x (copy-seq #(a x b x c x d x e x f))
+ :count nil :from-end t)
+ #(a z b z c z d z e z f))
+(equalp (nsubstitute 'z 'x (copy-seq #(a x b x c x d x e x f))
+ :count 0 :from-end t)
+ #(a x b x c x d x e x f))
+(equalp (nsubstitute 'z 'x (copy-seq #(a x b x c x d x e x f))
+ :count -100 :from-end t)
+ #(a x b x c x d x e x f))
+(equalp (nsubstitute 'z 'x (copy-seq #(a x b x c x d x e x f))
+ :count 1 :from-end t)
+ #(a x b x c x d x e z f))
+(equalp (nsubstitute 'z 'x (copy-seq #(a x b x c x d x e x f))
+ :count 2 :from-end t)
+ #(a x b x c x d z e z f))
+(equalp (nsubstitute 'z 'x (copy-seq #(a x b x c x d x e x f))
+ :count 3 :from-end t)
+ #(a x b x c z d z e z f))
+(equalp (nsubstitute 'z 'x (copy-seq #(a x b x c x d x e x f))
+ :count 4 :from-end t)
+ #(a x b z c z d z e z f))
+(equalp (nsubstitute 'z 'x (copy-seq #(a x b x c x d x e x f))
+ :count 5 :from-end t)
+ #(a z b z c z d z e z f))
+(equalp (nsubstitute 'z 'x (copy-seq #(a x b x c x d x e x f))
+ :count 6 :from-end t)
+ #(a z b z c z d z e z f))
+(equalp (nsubstitute 'z 'x (copy-seq #(a x b x c x d x e x f))
+ :count 7 :from-end t)
+ #(a z b z c z d z e z f))
+(equalp (nsubstitute 'z 'x (copy-seq #(a x b x c x d x e x f))
+ :start 2 :count 1)
+ #(a x b z c x d x e x f))
+(equalp (nsubstitute 'z 'x (copy-seq #(a x b x c x d x e x f))
+ :start 2 :end nil :count 1)
+ #(a x b z c x d x e x f))
+(equalp (nsubstitute 'z 'x (copy-seq #(a x b x c x d x e x f))
+ :start 2 :end 6 :count 100)
+ #(a x b z c z d x e x f))
+(equalp (nsubstitute 'z 'x (copy-seq #(a x b x c x d x e x f))
+ :start 2 :end 11 :count 100)
+ #(a x b z c z d z e z f))
+(equalp (nsubstitute 'z 'x (copy-seq #(a x b x c x d x e x f))
+ :start 2 :end 8 :count 10)
+ #(a x b z c z d z e x f))
+(equalp (nsubstitute 'z 'x (copy-seq #(a x b x c x d x e x f))
+ :start 2 :end 8 :count 2 :from-end t)
+ #(a x b x c z d z e x f))
+(equalp (nsubstitute #\z #\c (copy-seq #(#\a #\b #\c #\d #\e #\f))
+ :test #'char<)
+ #(#\a #\b #\c #\z #\z #\z))
+(equalp (nsubstitute #\z #\c (copy-seq #(#\a #\b #\c #\d #\e #\f))
+ :test-not (complement #'char<))
+ #(#\a #\b #\c #\z #\z #\z))
+(equalp (nsubstitute "peace" "war" (copy-seq #("love" "hate" "war" "peace"))
+ :test #'equal)
+ #("love" "hate" "peace" "peace"))
+(equalp (nsubstitute "peace" "war" (copy-seq #("love" "hate" "war" "peace"))
+ :test-not (complement #'equal))
+ #("love" "hate" "peace" "peace"))
+(equalp (nsubstitute "peace" "war" (copy-seq #("war" "War" "WAr" "WAR"))
+ :test #'string-equal)
+ #("peace" "peace" "peace" "peace"))
+(equalp (nsubstitute "peace" "war" (copy-seq #("war" "War" "WAr" "WAR"))
+ :test-not (complement #'string-equal))
+ #("peace" "peace" "peace" "peace"))
+(equalp (nsubstitute "peace" "WAR" (copy-seq #("war" "War" "WAr" "WAR"))
+ :test #'string=)
+ #("war" "War" "WAr" "peace"))
+(equalp (nsubstitute "peace" "WAR" (copy-seq #("war" "War" "WAr" "WAR"))
+ :test-not (complement #'string=))
+ #("war" "War" "WAr" "peace"))
+(equalp (nsubstitute "peace" "WAR" (copy-seq #("war" "War" "WAr" "WAR"))
+ :test #'string=
+ :key #'string-upcase)
+ #("peace" "peace" "peace" "peace"))
+(equalp (nsubstitute "peace" "WAR" (copy-seq #("war" "War" "WAr" "WAR"))
+ :test-not (complement #'string=)
+ :key #'string-upcase)
+ #("peace" "peace" "peace" "peace"))
+(equalp (nsubstitute "peace" "WAR" (copy-seq #("war" "War" "WAr" "WAR"))
+ :start 1
+ :end 2
+ :test #'string=
+ :key #'string-upcase)
+ #("war" "peace" "WAr" "WAR"))
+(equalp (nsubstitute "peace" "WAR" (copy-seq #("war" "War" "WAr" "WAR"))
+ :start 1
+ :end 2
+ :test-not (complement #'string=)
+ :key #'string-upcase)
+ #("war" "peace" "WAr" "WAR"))
+(equalp (nsubstitute "peace" "WAR" (copy-seq #("war" "War" "WAr" "WAR"))
+ :start 1
+ :end nil
+ :test #'string=
+ :key #'string-upcase)
+ #("war" "peace" "peace" "peace"))
+(equalp (nsubstitute "peace" "WAR" (copy-seq #("war" "War" "WAr" "WAR"))
+ :start 1
+ :end nil
+ :test-not (complement #'string=)
+ :key #'string-upcase)
+ #("war" "peace" "peace" "peace"))
+(equalp (nsubstitute "peace" "war" (copy-seq #("war" "War" "WAr" "WAR"))
+ :test #'string=
+ :key #'string-upcase)
+ #("war" "War" "WAr" "WAR"))
+(equalp (nsubstitute "peace" "war" (copy-seq #("war" "War" "WAr" "WAR"))
+ :test-not (complement #'string=)
+ :key #'string-upcase)
+ #("war" "War" "WAr" "WAR"))
+(equalp (nsubstitute "peace" "WAR"
+ (copy-seq
+ #("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR"))
+ :start 1
+ :end 7
+ :count 1
+ :test-not (complement #'string=)
+ :key #'string-upcase)
+ #("war" "peace" "WAr" "WAR" "war" "War" "WAr" "WAR"))
+(equalp (nsubstitute "peace" "WAR"
+ (copy-seq
+ #("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR"))
+ :start 1
+ :end 7
+ :count 2
+ :test-not (complement #'string=)
+ :key #'string-upcase)
+ #("war" "peace" "peace" "WAR" "war" "War" "WAr" "WAR"))
+(equalp (nsubstitute "peace" "WAR"
+ (copy-seq
+ #("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR"))
+ :start 1
+ :end 7
+ :count 2
+ :from-end t
+ :test-not (complement #'string=)
+ :key #'string-upcase)
+ #("war" "War" "WAr" "WAR" "war" "peace" "peace" "WAR"))
+(equalp (nsubstitute "peace" "WAR"
+ (copy-seq
+ #("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR"))
+ :start 1
+ :end 7
+ :count 0
+ :from-end t
+ :test-not (complement #'string=)
+ :key #'string-upcase)
+ #("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR"))
+(equalp (nsubstitute "peace" "WAR"
+ (copy-seq
+ #("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR"))
+ :start 1
+ :end 7
+ :count -2
+ :from-end t
+ :test-not (complement #'string=)
+ :key #'string-upcase)
+ #("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR"))
+(equalp (nsubstitute "peace" "WAR"
+ (copy-seq
+ #("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR"))
+ :start 1
+ :end 7
+ :count nil
+ :from-end t
+ :test-not (complement #'string=)
+ :key #'string-upcase)
+ #("war" "peace" "peace" "peace" "peace" "peace" "peace" "WAR"))
+(equalp (nsubstitute "peace" "WAR"
+ (copy-seq
+ #("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR"))
+ :start 1
+ :end 7
+ :count 6
+ :from-end t
+ :test-not (complement #'string=)
+ :key #'string-upcase)
+ #("war" "peace" "peace" "peace" "peace" "peace" "peace" "WAR"))
+(equalp (nsubstitute "peace" "WAR"
+ (copy-seq
+ #("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR"))
+ :start 1
+ :end 7
+ :count 7
+ :from-end t
+ :test-not (complement #'string=)
+ :key #'string-upcase)
+ #("war" "peace" "peace" "peace" "peace" "peace" "peace" "WAR"))
+(equalp (nsubstitute "peace" "WAR"
+ (copy-seq
+ #("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR"))
+ :start 1
+ :end 7
+ :count 100
+ :from-end t
+ :test-not (complement #'string=)
+ :key #'string-upcase)
+ #("war" "peace" "peace" "peace" "peace" "peace" "peace" "WAR"))
+(string= (nsubstitute #\A #\a (copy-seq "abcabc")) "AbcAbc")
+(string= (nsubstitute #\A #\a (copy-seq "")) "")
+(string= (nsubstitute #\A #\a (copy-seq "xyz")) "xyz")
+(string= (nsubstitute #\A #\a (copy-seq "aaaaaaaaaa") :start 5 :end nil)
+ "aaaaaAAAAA")
+(string= (nsubstitute #\x #\5 (copy-seq "0123456789") :test #'char<)
+ "012345xxxx")
+(string= (nsubstitute #\x #\5 (copy-seq "0123456789") :test #'char>)
+ "xxxxx56789")
+(string= (nsubstitute #\x #\D (copy-seq "abcdefg")
+ :key #'char-upcase
+ :test #'char>)
+ "xxxdefg")
+(string= (nsubstitute #\x #\D (copy-seq "abcdefg")
+ :start 1
+ :end 2
+ :key #'char-upcase
+ :test #'char>)
+ "axcdefg")
+(string= (nsubstitute #\A #\a (copy-seq "aaaaaaaaaa") :count 2) "AAaaaaaaaa")
+(string= (nsubstitute #\A #\a (copy-seq "aaaaaaaaaa") :count -1) "aaaaaaaaaa")
+(string= (nsubstitute #\A #\a (copy-seq "aaaaaaaaaa") :count 0) "aaaaaaaaaa")
+(string= (nsubstitute #\A #\a (copy-seq "aaaaaaaaaa") :count nil) "AAAAAAAAAA")
+(string= (nsubstitute #\A #\a (copy-seq "aaaaaaaaaa") :count 100) "AAAAAAAAAA")
+(string= (nsubstitute #\A #\a (copy-seq "aaaaaaaaaa") :count 9) "AAAAAAAAAa")
+(string= (nsubstitute #\A #\a (copy-seq "aaaaaaaaaa") :count 9 :from-end t)
+ "aAAAAAAAAA")
+(string= (nsubstitute #\A #\a (copy-seq "aaaaaaaaaa")
+ :start 2
+ :end 8
+ :count 3)
+ "aaAAAaaaaa")
+(string= (nsubstitute #\A #\a (copy-seq "aaaaaaaaaa")
+ :start 2
+ :end 8
+ :from-end t
+ :count 3)
+ "aaaaaAAAaa")
+(string= (nsubstitute #\x #\A (copy-seq "aaaaaaaaaa")
+ :start 2
+ :end 8
+ :from-end t
+ :count 3)
+ "aaaaaaaaaa")
+(string= (nsubstitute #\X #\A (copy-seq "aaaaaaaaaa")
+ :start 2
+ :end 8
+ :from-end t
+ :key #'char-upcase
+ :count 3)
+ "aaaaaXXXaa")
+(string= (nsubstitute #\X #\D (copy-seq "abcdefghij")
+ :start 2
+ :end 8
+ :from-end t
+ :key #'char-upcase
+ :test #'char<
+ :count 3)
+ "abcdeXXXij")
+(equalp (nsubstitute 0 1 (copy-seq #*1111)) #*0000)
+(equalp (nsubstitute 0 1 (copy-seq #*1111) :start 1 :end nil) #*1000)
+(equalp (nsubstitute 0 1 (copy-seq #*1111) :start 1 :end 3) #*1001)
+(equalp (nsubstitute 0 1 (copy-seq #*11111111) :start 1 :end 7) #*10000001)
+(equalp (nsubstitute 0 1 (copy-seq #*11111111) :start 1 :end 7 :count 3)
+ #*10001111)
+(equalp (nsubstitute 0 1 (copy-seq #*11111111)
+ :start 1 :end 7 :count 3 :from-end t)
+ #*11110001)
+(equalp (nsubstitute 1 1 (copy-seq #*10101010)
+ :start 1 :end 7 :count 3 :from-end t
+ :key #'(lambda (x) (if (zerop x) 1 0)))
+ #*11111110)
+(equalp (nsubstitute 1 1 (copy-seq #*10101010)
+ :start 1 :end 7 :count 3 :from-end t
+ :key #'(lambda (x) (if (zerop x) 1 0))
+ :test #'>=)
+ #*10101110)
+
+
+
+(equal (nsubstitute-if 'a #'(lambda (arg) (eq arg 'x)) (copy-seq '(x y z)))
+ '(a y z))
+(equal (nsubstitute-if 'b #'(lambda (arg) (eq arg 'y)) (copy-seq '(x y z)))
+ '(x b z))
+(equal (nsubstitute-if 'c #'(lambda (arg) (eq arg 'z)) (copy-seq '(x y z)))
+ '(x y c))
+(equal (nsubstitute-if 'a #'(lambda (arg) (eq arg 'p)) (copy-seq '(x y z)))
+ '(x y z))
+(equal (nsubstitute-if 'a #'(lambda (arg) (eq arg 'x)) (copy-seq '()))
+ '())
+(equal (nsubstitute-if #\x #'(lambda (arg) (char< #\b arg))
+ (copy-seq '(#\a #\b #\c #\d #\e)))
+ '(#\a #\b #\x #\x #\x))
+(equal (nsubstitute-if '(a) #'(lambda (arg) (eq arg 'x))
+ (copy-seq '((x) (y) (z))) :key #'car)
+ '((a) (y) (z)))
+(equal (nsubstitute-if 'c #'(lambda (arg) (eq arg 'b))
+ (copy-seq '(a b a b a b a b))) '(a c a c a c a c))
+(equal (nsubstitute-if 'a #'(lambda (arg) (eq arg 'b))
+ (copy-seq '(b b b))) '(a a a))
+(equal (nsubstitute-if 'z #'(lambda (arg) (eq arg 'x))
+ (copy-seq '(a x b x c x d x e x f)))
+ '(a z b z c z d z e z f))
+(equal (nsubstitute-if 'z #'(lambda (arg) (eq arg 'x))
+ (copy-seq '(a x b x c x d x e x f)) :count nil)
+ '(a z b z c z d z e z f))
+(equal (nsubstitute-if 'z #'(lambda (arg) (eq arg 'x))
+ (copy-seq '(a x b x c x d x e x f)) :count 0)
+ '(a x b x c x d x e x f))
+(equal (nsubstitute-if 'z #'(lambda (arg) (eq arg 'x))
+ (copy-seq '(a x b x c x d x e x f)) :count -100)
+ '(a x b x c x d x e x f))
+(equal (nsubstitute-if 'z #'(lambda (arg) (eq arg 'x))
+ (copy-seq '(a x b x c x d x e x f)) :count 1)
+ '(a z b x c x d x e x f))
+(equal (nsubstitute-if 'z #'(lambda (arg) (eq arg 'x))
+ (copy-seq '(a x b x c x d x e x f)) :count 2)
+ '(a z b z c x d x e x f))
+(equal (nsubstitute-if 'z #'(lambda (arg) (eq arg 'x))
+ (copy-seq '(a x b x c x d x e x f)) :count 3)
+ '(a z b z c z d x e x f))
+(equal (nsubstitute-if 'z #'(lambda (arg) (eq arg 'x))
+ (copy-seq '(a x b x c x d x e x f)) :count 4)
+ '(a z b z c z d z e x f))
+(equal (nsubstitute-if 'z #'(lambda (arg) (eq arg 'x))
+ (copy-seq '(a x b x c x d x e x f)) :count 5)
+ '(a z b z c z d z e z f))
+(equal (nsubstitute-if 'z #'(lambda (arg) (eq arg 'x))
+ (copy-seq '(a x b x c x d x e x f)) :count 6)
+ '(a z b z c z d z e z f))
+(equal (nsubstitute-if 'z #'(lambda (arg) (eq arg 'x))
+ (copy-seq '(a x b x c x d x e x f)) :count 7)
+ '(a z b z c z d z e z f))
+(equal (nsubstitute-if 'z #'(lambda (arg) (eq arg 'x))
+ (copy-seq '(a x b x c x d x e x f))
+ :count nil :from-end t)
+ '(a z b z c z d z e z f))
+(equal (nsubstitute-if 'z #'(lambda (arg) (eq arg 'x))
+ (copy-seq '(a x b x c x d x e x f)) :count 0 :from-end t)
+ '(a x b x c x d x e x f))
+(equal (nsubstitute-if 'z #'(lambda (arg) (eq arg 'x))
+ (copy-seq '(a x b x c x d x e x f))
+ :count -100 :from-end t)
+ '(a x b x c x d x e x f))
+(equal (nsubstitute-if 'z #'(lambda (arg) (eq arg 'x))
+ (copy-seq '(a x b x c x d x e x f))
+ :count 1 :from-end t)
+ '(a x b x c x d x e z f))
+(equal (nsubstitute-if 'z #'(lambda (arg) (eq arg 'x))
+ (copy-seq '(a x b x c x d x e x f))
+ :count 2 :from-end t)
+ '(a x b x c x d z e z f))
+(equal (nsubstitute-if 'z #'(lambda (arg) (eq arg 'x))
+ (copy-seq '(a x b x c x d x e x f))
+ :count 3 :from-end t)
+ '(a x b x c z d z e z f))
+(equal (nsubstitute-if 'z #'(lambda (arg) (eq arg 'x))
+ (copy-seq '(a x b x c x d x e x f))
+ :count 4 :from-end t)
+ '(a x b z c z d z e z f))
+(equal (nsubstitute-if 'z #'(lambda (arg) (eq arg 'x))
+ (copy-seq '(a x b x c x d x e x f))
+ :count 5 :from-end t)
+ '(a z b z c z d z e z f))
+(equal (nsubstitute-if 'z #'(lambda (arg) (eq arg 'x))
+ (copy-seq '(a x b x c x d x e x f))
+ :count 6 :from-end t)
+ '(a z b z c z d z e z f))
+(equal (nsubstitute-if 'z #'(lambda (arg) (eq arg 'x))
+ (copy-seq '(a x b x c x d x e x f))
+ :count 7 :from-end t)
+ '(a z b z c z d z e z f))
+(equal (nsubstitute-if 'z #'(lambda (arg) (eq arg 'x))
+ (copy-seq '(a x b x c x d x e x f)) :start 2 :count 1)
+ '(a x b z c x d x e x f))
+(equal (nsubstitute-if 'z #'(lambda (arg) (eq arg 'x))
+ (copy-seq '(a x b x c x d x e x f))
+ :start 2 :end nil :count 1)
+ '(a x b z c x d x e x f))
+(equal (nsubstitute-if 'z #'(lambda (arg) (eq arg 'x))
+ (copy-seq '(a x b x c x d x e x f))
+ :start 2 :end 6 :count 100)
+ '(a x b z c z d x e x f))
+(equal (nsubstitute-if 'z #'(lambda (arg) (eq arg 'x))
+ (copy-seq '(a x b x c x d x e x f))
+ :start 2 :end 11 :count 100)
+ '(a x b z c z d z e z f))
+(equal (nsubstitute-if 'z #'(lambda (arg) (eq arg 'x))
+ (copy-seq '(a x b x c x d x e x f))
+ :start 2 :end 8 :count 10)
+ '(a x b z c z d z e x f))
+(equal (nsubstitute-if 'z #'(lambda (arg) (eq arg 'x))
+ (copy-seq '(a x b x c x d x e x f))
+ :start 2 :end 8 :count 2 :from-end t)
+ '(a x b x c z d z e x f))
+(equal (nsubstitute-if #\z #'(lambda (arg) (char< #\c arg))
+ (copy-seq '(#\a #\b #\c #\d #\e #\f)))
+ '(#\a #\b #\c #\z #\z #\z))
+(equal (nsubstitute-if "peace" #'(lambda (arg) (equal "war" arg))
+ (copy-seq '("love" "hate" "war" "peace")))
+ '("love" "hate" "peace" "peace"))
+(equal (nsubstitute-if "peace" #'(lambda (arg) (string-equal "war" arg))
+ (copy-seq '("war" "War" "WAr" "WAR")))
+ '("peace" "peace" "peace" "peace"))
+(equal (nsubstitute-if "peace" #'(lambda (arg) (string= "WAR" arg))
+ (copy-seq '("war" "War" "WAr" "WAR"))
+ :key #'string-upcase)
+ '("peace" "peace" "peace" "peace"))
+(equal (nsubstitute-if "peace" #'(lambda (arg) (string= "WAR" arg))
+ (copy-seq '("war" "War" "WAr" "WAR"))
+ :start 1
+ :end 2
+ :key #'string-upcase)
+ '("war" "peace" "WAr" "WAR"))
+(equal (nsubstitute-if "peace" #'(lambda (arg) (string= "WAR" arg))
+ (copy-seq '("war" "War" "WAr" "WAR"))
+ :start 1
+ :end nil
+ :key #'string-upcase)
+ '("war" "peace" "peace" "peace"))
+(equal (nsubstitute-if "peace" #'(lambda (arg) (string= "war" arg))
+ (copy-seq '("war" "War" "WAr" "WAR"))
+ :key #'string-upcase)
+ '("war" "War" "WAr" "WAR"))
+(equal (nsubstitute-if "peace" #'(lambda (arg) (string= "WAR" arg))
+ (copy-seq
+ '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR"))
+ :start 1
+ :end 7
+ :count 1
+ :key #'string-upcase)
+ '("war" "peace" "WAr" "WAR" "war" "War" "WAr" "WAR"))
+(equal (nsubstitute-if "peace" #'(lambda (arg) (string= "WAR" arg))
+ (copy-seq
+ '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR"))
+ :start 1
+ :end 7
+ :count 2
+ :key #'string-upcase)
+ '("war" "peace" "peace" "WAR" "war" "War" "WAr" "WAR"))
+(equal (nsubstitute-if "peace" #'(lambda (arg) (string= "WAR" arg))
+ (copy-seq
+ '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR"))
+ :start 1
+ :end 7
+ :count 2
+ :from-end t
+ :key #'string-upcase)
+ '("war" "War" "WAr" "WAR" "war" "peace" "peace" "WAR"))
+(equal (nsubstitute-if "peace" #'(lambda (arg) (string= "WAR" arg))
+ (copy-seq
+ '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR"))
+ :start 1
+ :end 7
+ :count 0
+ :from-end t
+ :key #'string-upcase)
+ '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR"))
+(equal (nsubstitute-if "peace" #'(lambda (arg) (string= "WAR" arg))
+ (copy-seq
+ '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR"))
+ :start 1
+ :end 7
+ :count -2
+ :from-end t
+ :key #'string-upcase)
+ '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR"))
+(equal (nsubstitute-if "peace" #'(lambda (arg) (string= "WAR" arg))
+ (copy-seq
+ '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR"))
+ :start 1
+ :end 7
+ :count nil
+ :from-end t
+ :key #'string-upcase)
+ '("war" "peace" "peace" "peace" "peace" "peace" "peace" "WAR"))
+(equal (nsubstitute-if "peace" #'(lambda (arg) (string= "WAR" arg))
+ (copy-seq
+ '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR"))
+ :start 1
+ :end 7
+ :count 6
+ :from-end t
+ :key #'string-upcase)
+ '("war" "peace" "peace" "peace" "peace" "peace" "peace" "WAR"))
+(equal (nsubstitute-if "peace" #'(lambda (arg) (string= "WAR" arg))
+ (copy-seq
+ '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR"))
+ :start 1
+ :end 7
+ :count 7
+ :from-end t
+ :key #'string-upcase)
+ '("war" "peace" "peace" "peace" "peace" "peace" "peace" "WAR"))
+(equal (nsubstitute-if "peace" #'(lambda (arg) (string= "WAR" arg))
+ (copy-seq
+ '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR"))
+ :start 1
+ :end 7
+ :count 100
+ :from-end t
+ :key #'string-upcase)
+ '("war" "peace" "peace" "peace" "peace" "peace" "peace" "WAR"))
+
+
+(equalp (nsubstitute-if 'a #'(lambda (arg) (eq arg 'x)) (copy-seq #(x y z)))
+ #(a y z))
+(equalp (nsubstitute-if 'b #'(lambda (arg) (eq arg 'y)) (copy-seq #(x y z)))
+ #(x b z))
+(equalp (nsubstitute-if 'c #'(lambda (arg) (eq arg 'z)) (copy-seq #(x y z)))
+ #(x y c))
+(equalp (nsubstitute-if 'a #'(lambda (arg) (eq arg 'p)) (copy-seq #(x y z)))
+ #(x y z))
+(equalp (nsubstitute-if 'a #'(lambda (arg) (eq arg 'x)) (copy-seq #())) #())
+(equalp (nsubstitute-if #\x #'(lambda (arg) (char< #\b arg))
+ (copy-seq #(#\a #\b #\c #\d #\e)))
+ #(#\a #\b #\x #\x #\x))
+(equalp (nsubstitute-if '(a) #'(lambda (arg) (eq arg 'x))
+ (copy-seq #((x) (y) (z))) :key #'car)
+ #((a) (y) (z)))
+(equalp (nsubstitute-if 'c #'(lambda (arg) (eq arg 'b))
+ (copy-seq #(a b a b a b a b))) #(a c a c a c a c))
+(equalp (nsubstitute-if 'a #'(lambda (arg) (eq arg 'b))
+ (copy-seq #(b b b))) #(a a a))
+(equalp (nsubstitute-if 'z #'(lambda (arg) (eq arg 'x))
+ (copy-seq #(a x b x c x d x e x f)))
+ #(a z b z c z d z e z f))
+(equalp (nsubstitute-if 'z #'(lambda (arg) (eq arg 'x))
+ (copy-seq #(a x b x c x d x e x f)) :count nil)
+ #(a z b z c z d z e z f))
+(equalp (nsubstitute-if 'z #'(lambda (arg) (eq arg 'x))
+ (copy-seq #(a x b x c x d x e x f)) :count 0)
+ #(a x b x c x d x e x f))
+(equalp (nsubstitute-if 'z #'(lambda (arg) (eq arg 'x))
+ (copy-seq #(a x b x c x d x e x f)) :count -100)
+ #(a x b x c x d x e x f))
+(equalp (nsubstitute-if 'z #'(lambda (arg) (eq arg 'x))
+ (copy-seq #(a x b x c x d x e x f)) :count 1)
+ #(a z b x c x d x e x f))
+(equalp (nsubstitute-if 'z #'(lambda (arg) (eq arg 'x))
+ (copy-seq #(a x b x c x d x e x f)) :count 2)
+ #(a z b z c x d x e x f))
+(equalp (nsubstitute-if 'z #'(lambda (arg) (eq arg 'x))
+ (copy-seq #(a x b x c x d x e x f)) :count 3)
+ #(a z b z c z d x e x f))
+(equalp (nsubstitute-if 'z #'(lambda (arg) (eq arg 'x))
+ (copy-seq #(a x b x c x d x e x f)) :count 4)
+ #(a z b z c z d z e x f))
+(equalp (nsubstitute-if 'z #'(lambda (arg) (eq arg 'x))
+ (copy-seq #(a x b x c x d x e x f)) :count 5)
+ #(a z b z c z d z e z f))
+(equalp (nsubstitute-if 'z #'(lambda (arg) (eq arg 'x))
+ (copy-seq #(a x b x c x d x e x f)) :count 6)
+ #(a z b z c z d z e z f))
+(equalp (nsubstitute-if 'z #'(lambda (arg) (eq arg 'x))
+ (copy-seq #(a x b x c x d x e x f)) :count 7)
+ #(a z b z c z d z e z f))
+(equalp (nsubstitute-if 'z #'(lambda (arg) (eq arg 'x))
+ (copy-seq #(a x b x c x d x e x f))
+ :count nil :from-end t)
+ #(a z b z c z d z e z f))
+(equalp (nsubstitute-if 'z #'(lambda (arg) (eq arg 'x))
+ (copy-seq #(a x b x c x d x e x f))
+ :count 0 :from-end t)
+ #(a x b x c x d x e x f))
+(equalp (nsubstitute-if 'z #'(lambda (arg) (eq arg 'x))
+ (copy-seq #(a x b x c x d x e x f))
+ :count -100 :from-end t)
+ #(a x b x c x d x e x f))
+(equalp (nsubstitute-if 'z #'(lambda (arg) (eq arg 'x))
+ (copy-seq #(a x b x c x d x e x f))
+ :count 1 :from-end t)
+ #(a x b x c x d x e z f))
+(equalp (nsubstitute-if 'z #'(lambda (arg) (eq arg 'x))
+ (copy-seq #(a x b x c x d x e x f))
+ :count 2 :from-end t)
+ #(a x b x c x d z e z f))
+(equalp (nsubstitute-if 'z #'(lambda (arg) (eq arg 'x))
+ (copy-seq #(a x b x c x d x e x f))
+ :count 3 :from-end t)
+ #(a x b x c z d z e z f))
+(equalp (nsubstitute-if 'z #'(lambda (arg) (eq arg 'x))
+ (copy-seq #(a x b x c x d x e x f))
+ :count 4 :from-end t)
+ #(a x b z c z d z e z f))
+(equalp (nsubstitute-if 'z #'(lambda (arg) (eq arg 'x))
+ (copy-seq #(a x b x c x d x e x f))
+ :count 5 :from-end t)
+ #(a z b z c z d z e z f))
+(equalp (nsubstitute-if 'z #'(lambda (arg) (eq arg 'x))
+ (copy-seq #(a x b x c x d x e x f))
+ :count 6 :from-end t)
+ #(a z b z c z d z e z f))
+(equalp (nsubstitute-if 'z #'(lambda (arg) (eq arg 'x))
+ (copy-seq #(a x b x c x d x e x f))
+ :count 7 :from-end t)
+ #(a z b z c z d z e z f))
+(equalp (nsubstitute-if 'z #'(lambda (arg) (eq arg 'x))
+ (copy-seq #(a x b x c x d x e x f))
+ :start 2 :count 1)
+ #(a x b z c x d x e x f))
+(equalp (nsubstitute-if 'z #'(lambda (arg) (eq arg 'x))
+ (copy-seq #(a x b x c x d x e x f))
+ :start 2 :end nil :count 1)
+ #(a x b z c x d x e x f))
+(equalp (nsubstitute-if 'z #'(lambda (arg) (eq arg 'x))
+ (copy-seq #(a x b x c x d x e x f))
+ :start 2 :end 6 :count 100)
+ #(a x b z c z d x e x f))
+(equalp (nsubstitute-if 'z #'(lambda (arg) (eq arg 'x))
+ (copy-seq #(a x b x c x d x e x f))
+ :start 2 :end 11 :count 100)
+ #(a x b z c z d z e z f))
+(equalp (nsubstitute-if 'z #'(lambda (arg) (eq arg 'x))
+ (copy-seq #(a x b x c x d x e x f))
+ :start 2 :end 8 :count 10)
+ #(a x b z c z d z e x f))
+(equalp (nsubstitute-if 'z #'(lambda (arg) (eq arg 'x))
+ (copy-seq #(a x b x c x d x e x f))
+ :start 2 :end 8 :count 2 :from-end t)
+ #(a x b x c z d z e x f))
+(equalp (nsubstitute-if #\z #'(lambda (arg) (char< #\c arg))
+ (copy-seq #(#\a #\b #\c #\d #\e #\f)))
+ #(#\a #\b #\c #\z #\z #\z))
+(equalp (nsubstitute-if "peace" #'(lambda (arg) (equal "war" arg))
+ (copy-seq #("love" "hate" "war" "peace")))
+ #("love" "hate" "peace" "peace"))
+(equalp (nsubstitute-if "peace" #'(lambda (arg) (string-equal "war" arg))
+ (copy-seq #("war" "War" "WAr" "WAR")))
+ #("peace" "peace" "peace" "peace"))
+(equalp (nsubstitute-if "peace" #'(lambda (arg) (string= "WAR" arg))
+ (copy-seq #("war" "War" "WAr" "WAR"))
+ :key #'string-upcase)
+ #("peace" "peace" "peace" "peace"))
+(equalp (nsubstitute-if "peace" #'(lambda (arg) (string= "WAR" arg))
+ (copy-seq #("war" "War" "WAr" "WAR"))
+ :start 1
+ :end 2
+ :key #'string-upcase)
+ #("war" "peace" "WAr" "WAR"))
+(equalp (nsubstitute-if "peace" #'(lambda (arg) (string= "WAR" arg))
+ (copy-seq #("war" "War" "WAr" "WAR"))
+ :start 1
+ :end nil
+ :key #'string-upcase)
+ #("war" "peace" "peace" "peace"))
+(equalp (nsubstitute-if "peace" #'(lambda (arg) (string= "war" arg))
+ (copy-seq #("war" "War" "WAr" "WAR"))
+ :key #'string-upcase)
+ #("war" "War" "WAr" "WAR"))
+(equalp (nsubstitute-if "peace" #'(lambda (arg) (string= "WAR" arg))
+ (copy-seq
+ #("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR"))
+ :start 1
+ :end 7
+ :count 1
+ :key #'string-upcase)
+ #("war" "peace" "WAr" "WAR" "war" "War" "WAr" "WAR"))
+(equalp (nsubstitute-if "peace" #'(lambda (arg) (string= "WAR" arg))
+ (copy-seq
+ #("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR"))
+ :start 1
+ :end 7
+ :count 2
+ :key #'string-upcase)
+ #("war" "peace" "peace" "WAR" "war" "War" "WAr" "WAR"))
+(equalp (nsubstitute-if "peace" #'(lambda (arg) (string= "WAR" arg))
+ (copy-seq
+ #("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR"))
+ :start 1
+ :end 7
+ :count 2
+ :from-end t
+ :key #'string-upcase)
+ #("war" "War" "WAr" "WAR" "war" "peace" "peace" "WAR"))
+(equalp (nsubstitute-if "peace" #'(lambda (arg) (string= "WAR" arg))
+ (copy-seq
+ #("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR"))
+ :start 1
+ :end 7
+ :count 0
+ :from-end t
+ :key #'string-upcase)
+ #("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR"))
+(equalp (nsubstitute-if "peace" #'(lambda (arg) (string= "WAR" arg))
+ (copy-seq
+ #("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR"))
+ :start 1
+ :end 7
+ :count -2
+ :from-end t
+ :key #'string-upcase)
+ #("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR"))
+(equalp (nsubstitute-if "peace" #'(lambda (arg) (string= "WAR" arg))
+ (copy-seq
+ #("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR"))
+ :start 1
+ :end 7
+ :count nil
+ :from-end t
+ :key #'string-upcase)
+ #("war" "peace" "peace" "peace" "peace" "peace" "peace" "WAR"))
+(equalp (nsubstitute-if "peace" #'(lambda (arg) (string= "WAR" arg))
+ (copy-seq
+ #("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR"))
+ :start 1
+ :end 7
+ :count 6
+ :from-end t
+ :key #'string-upcase)
+ #("war" "peace" "peace" "peace" "peace" "peace" "peace" "WAR"))
+(equalp (nsubstitute-if "peace" #'(lambda (arg) (string= "WAR" arg))
+ (copy-seq
+ #("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR"))
+ :start 1
+ :end 7
+ :count 7
+ :from-end t
+ :key #'string-upcase)
+ #("war" "peace" "peace" "peace" "peace" "peace" "peace" "WAR"))
+(equalp (nsubstitute-if "peace" #'(lambda (arg) (string= "WAR" arg))
+ (copy-seq
+ #("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR"))
+ :start 1
+ :end 7
+ :count 100
+ :from-end t
+ :key #'string-upcase)
+ #("war" "peace" "peace" "peace" "peace" "peace" "peace" "WAR"))
+
+(string= (nsubstitute-if #\A #'(lambda (arg) (eql #\a arg))
+ (copy-seq "abcabc")) "AbcAbc")
+(string= (nsubstitute-if #\A #'(lambda (arg) (eql #\a arg)) (copy-seq "")) "")
+(string= (nsubstitute-if #\A #'(lambda (arg) (eql #\a arg)) (copy-seq "xyz"))
+ "xyz")
+(string= (nsubstitute-if #\A #'(lambda (arg) (eql #\a arg))
+ (copy-seq "aaaaaaaaaa") :start 5 :end nil)
+ "aaaaaAAAAA")
+(string= (nsubstitute-if #\x #'(lambda (arg) (char< #\5 arg))
+ (copy-seq "0123456789")) "012345xxxx")
+(string= (nsubstitute-if #\x #'(lambda (arg) (char> #\5 arg))
+ (copy-seq "0123456789")) "xxxxx56789")
+(string= (nsubstitute-if #\x #'(lambda (arg) (char> #\D arg))
+ (copy-seq "abcdefg")
+ :key #'char-upcase)
+ "xxxdefg")
+(string= (nsubstitute-if #\x #'(lambda (arg) (char> #\D arg))
+ (copy-seq "abcdefg")
+ :start 1
+ :end 2
+ :key #'char-upcase)
+ "axcdefg")
+(string= (nsubstitute-if #\A #'(lambda (arg) (eql #\a arg))
+ (copy-seq "aaaaaaaaaa") :count 2) "AAaaaaaaaa")
+(string= (nsubstitute-if #\A #'(lambda (arg) (eql #\a arg))
+ (copy-seq "aaaaaaaaaa") :count -1) "aaaaaaaaaa")
+(string= (nsubstitute-if #\A #'(lambda (arg) (eql #\a arg))
+ (copy-seq "aaaaaaaaaa") :count 0) "aaaaaaaaaa")
+(string= (nsubstitute-if #\A #'(lambda (arg) (eql #\a arg))
+ (copy-seq "aaaaaaaaaa") :count nil) "AAAAAAAAAA")
+(string= (nsubstitute-if #\A #'(lambda (arg) (eql #\a arg))
+ (copy-seq "aaaaaaaaaa") :count 100) "AAAAAAAAAA")
+(string= (nsubstitute-if #\A #'(lambda (arg) (eql #\a arg))
+ (copy-seq "aaaaaaaaaa") :count 9) "AAAAAAAAAa")
+(string= (nsubstitute-if #\A #'(lambda (arg) (eql #\a arg))
+ (copy-seq "aaaaaaaaaa") :count 9 :from-end t)
+ "aAAAAAAAAA")
+(string= (nsubstitute-if #\A #'(lambda (arg) (eql #\a arg))
+ (copy-seq "aaaaaaaaaa")
+ :start 2
+ :end 8
+ :count 3)
+ "aaAAAaaaaa")
+(string= (nsubstitute-if #\A #'(lambda (arg) (eql #\a arg))
+ (copy-seq "aaaaaaaaaa")
+ :start 2
+ :end 8
+ :from-end t
+ :count 3)
+ "aaaaaAAAaa")
+(string= (nsubstitute-if #\x #'(lambda (arg) (eql #\A arg))
+ (copy-seq "aaaaaaaaaa")
+ :start 2
+ :end 8
+ :from-end t
+ :count 3)
+ "aaaaaaaaaa")
+(string= (nsubstitute-if #\X #'(lambda (arg) (eql #\A arg))
+ (copy-seq "aaaaaaaaaa")
+ :start 2
+ :end 8
+ :from-end t
+ :key #'char-upcase
+ :count 3)
+ "aaaaaXXXaa")
+(string= (nsubstitute-if #\X #'(lambda (arg) (char< #\D arg))
+ (copy-seq "abcdefghij")
+ :start 2
+ :end 8
+ :from-end t
+ :key #'char-upcase
+ :count 3)
+ "abcdeXXXij")
+(equalp (nsubstitute-if 0 #'(lambda (arg) (= 1 arg)) (copy-seq #*1111)) #*0000)
+(equalp (nsubstitute-if 0 #'(lambda (arg) (= 1 arg))
+ (copy-seq #*1111) :start 1 :end nil) #*1000)
+(equalp (nsubstitute-if 0 #'(lambda (arg) (= 1 arg))
+ (copy-seq #*1111) :start 1 :end 3) #*1001)
+(equalp (nsubstitute-if 0 #'(lambda (arg) (= 1 arg))
+ (copy-seq #*11111111) :start 1 :end 7) #*10000001)
+(equalp (nsubstitute-if 0 #'(lambda (arg) (= 1 arg))
+ (copy-seq #*11111111) :start 1 :end 7 :count 3)
+ #*10001111)
+(equalp (nsubstitute-if 0 #'(lambda (arg) (= 1 arg))
+ (copy-seq #*11111111)
+ :start 1 :end 7 :count 3 :from-end t)
+ #*11110001)
+(equalp (nsubstitute-if 1 #'(lambda (arg) (= 1 arg))
+ (copy-seq #*10101010)
+ :start 1 :end 7 :count 3 :from-end t
+ :key #'(lambda (x) (if (zerop x) 1 0)))
+ #*11111110)
+(equalp (nsubstitute-if 1 #'(lambda (arg) (>= 1 arg))
+ (copy-seq #*10101010)
+ :start 1 :end 7 :count 3 :from-end t
+ :key #'(lambda (x) (if (zerop x) 1 0)))
+ #*10101110)
+
+
+(equal (nsubstitute-if-not 'a #'(lambda (arg) (not (eq arg 'x)))
+ (copy-seq '(x y z)))
+ '(a y z))
+(equal (nsubstitute-if-not 'b #'(lambda (arg) (not (eq arg 'y)))
+ (copy-seq '(x y z)))
+ '(x b z))
+(equal (nsubstitute-if-not 'c #'(lambda (arg) (not (eq arg 'z)))
+ (copy-seq '(x y z)))
+ '(x y c))
+(equal (nsubstitute-if-not 'a #'(lambda (arg) (not (eq arg 'p)))
+ (copy-seq '(x y z)))
+ '(x y z))
+(equal (nsubstitute-if-not 'a #'(lambda (arg) (not (eq arg 'x)))
+ (copy-seq '())) '())
+(equal (nsubstitute-if-not #\x #'(lambda (arg) (not (char< #\b arg)))
+ (copy-seq '(#\a #\b #\c #\d #\e)))
+ '(#\a #\b #\x #\x #\x))
+(equal (nsubstitute-if-not '(a) #'(lambda (arg) (not (eq arg 'x)))
+ (copy-seq '((x) (y) (z))) :key #'car)
+ '((a) (y) (z)))
+(equal (nsubstitute-if-not 'c #'(lambda (arg) (not (eq arg 'b)))
+ (copy-seq '(a b a b a b a b))) '(a c a c a c a c))
+(equal (nsubstitute-if-not 'a #'(lambda (arg) (not (eq arg 'b)))
+ (copy-seq '(b b b))) '(a a a))
+(equal (nsubstitute-if-not 'z #'(lambda (arg) (not (eq arg 'x)))
+ (copy-seq '(a x b x c x d x e x f)))
+ '(a z b z c z d z e z f))
+(equal (nsubstitute-if-not 'z #'(lambda (arg) (not (eq arg 'x)))
+ (copy-seq '(a x b x c x d x e x f)) :count nil)
+ '(a z b z c z d z e z f))
+(equal (nsubstitute-if-not 'z #'(lambda (arg) (not (eq arg 'x)))
+ (copy-seq '(a x b x c x d x e x f)) :count 0)
+ '(a x b x c x d x e x f))
+(equal (nsubstitute-if-not 'z #'(lambda (arg) (not (eq arg 'x)))
+ (copy-seq '(a x b x c x d x e x f)) :count -100)
+ '(a x b x c x d x e x f))
+(equal (nsubstitute-if-not 'z #'(lambda (arg) (not (eq arg 'x)))
+ (copy-seq '(a x b x c x d x e x f)) :count 1)
+ '(a z b x c x d x e x f))
+(equal (nsubstitute-if-not 'z #'(lambda (arg) (not (eq arg 'x)))
+ (copy-seq '(a x b x c x d x e x f)) :count 2)
+ '(a z b z c x d x e x f))
+(equal (nsubstitute-if-not 'z #'(lambda (arg) (not (eq arg 'x)))
+ (copy-seq '(a x b x c x d x e x f)) :count 3)
+ '(a z b z c z d x e x f))
+(equal (nsubstitute-if-not 'z #'(lambda (arg) (not (eq arg 'x)))
+ (copy-seq '(a x b x c x d x e x f)) :count 4)
+ '(a z b z c z d z e x f))
+(equal (nsubstitute-if-not 'z #'(lambda (arg) (not (eq arg 'x)))
+ (copy-seq '(a x b x c x d x e x f)) :count 5)
+ '(a z b z c z d z e z f))
+(equal (nsubstitute-if-not 'z #'(lambda (arg) (not (eq arg 'x)))
+ (copy-seq '(a x b x c x d x e x f)) :count 6)
+ '(a z b z c z d z e z f))
+(equal (nsubstitute-if-not 'z #'(lambda (arg) (not (eq arg 'x)))
+ (copy-seq '(a x b x c x d x e x f)) :count 7)
+ '(a z b z c z d z e z f))
+(equal (nsubstitute-if-not 'z #'(lambda (arg) (not (eq arg 'x)))
+ (copy-seq '(a x b x c x d x e x f))
+ :count nil :from-end t)
+ '(a z b z c z d z e z f))
+(equal (nsubstitute-if-not 'z #'(lambda (arg) (not (eq arg 'x)))
+ (copy-seq '(a x b x c x d x e x f))
+ :count 0 :from-end t)
+ '(a x b x c x d x e x f))
+(equal (nsubstitute-if-not 'z #'(lambda (arg) (not (eq arg 'x)))
+ (copy-seq '(a x b x c x d x e x f))
+ :count -100 :from-end t)
+ '(a x b x c x d x e x f))
+(equal (nsubstitute-if-not 'z #'(lambda (arg) (not (eq arg 'x)))
+ (copy-seq '(a x b x c x d x e x f))
+ :count 1 :from-end t)
+ '(a x b x c x d x e z f))
+(equal (nsubstitute-if-not 'z #'(lambda (arg) (not (eq arg 'x)))
+ (copy-seq '(a x b x c x d x e x f))
+ :count 2 :from-end t)
+ '(a x b x c x d z e z f))
+(equal (nsubstitute-if-not 'z #'(lambda (arg) (not (eq arg 'x)))
+ (copy-seq '(a x b x c x d x e x f))
+ :count 3 :from-end t)
+ '(a x b x c z d z e z f))
+(equal (nsubstitute-if-not 'z #'(lambda (arg) (not (eq arg 'x)))
+ (copy-seq '(a x b x c x d x e x f))
+ :count 4 :from-end t)
+ '(a x b z c z d z e z f))
+(equal (nsubstitute-if-not 'z #'(lambda (arg) (not (eq arg 'x)))
+ (copy-seq '(a x b x c x d x e x f))
+ :count 5 :from-end t)
+ '(a z b z c z d z e z f))
+(equal (nsubstitute-if-not 'z #'(lambda (arg) (not (eq arg 'x)))
+ (copy-seq '(a x b x c x d x e x f))
+ :count 6 :from-end t)
+ '(a z b z c z d z e z f))
+(equal (nsubstitute-if-not 'z #'(lambda (arg) (not (eq arg 'x)))
+ (copy-seq '(a x b x c x d x e x f))
+ :count 7 :from-end t)
+ '(a z b z c z d z e z f))
+(equal (nsubstitute-if-not 'z #'(lambda (arg) (not (eq arg 'x)))
+ (copy-seq '(a x b x c x d x e x f))
+ :start 2 :count 1)
+ '(a x b z c x d x e x f))
+(equal (nsubstitute-if-not 'z #'(lambda (arg) (not (eq arg 'x)))
+ (copy-seq '(a x b x c x d x e x f))
+ :start 2 :end nil :count 1)
+ '(a x b z c x d x e x f))
+(equal (nsubstitute-if-not 'z #'(lambda (arg) (not (eq arg 'x)))
+ (copy-seq '(a x b x c x d x e x f))
+ :start 2 :end 6 :count 100)
+ '(a x b z c z d x e x f))
+(equal (nsubstitute-if-not 'z #'(lambda (arg) (not (eq arg 'x)))
+ (copy-seq '(a x b x c x d x e x f))
+ :start 2 :end 11 :count 100)
+ '(a x b z c z d z e z f))
+(equal (nsubstitute-if-not 'z #'(lambda (arg) (not (eq arg 'x)))
+ (copy-seq '(a x b x c x d x e x f))
+ :start 2 :end 8 :count 10)
+ '(a x b z c z d z e x f))
+(equal (nsubstitute-if-not 'z #'(lambda (arg) (not (eq arg 'x)))
+ (copy-seq '(a x b x c x d x e x f))
+ :start 2 :end 8 :count 2 :from-end t)
+ '(a x b x c z d z e x f))
+(equal (nsubstitute-if-not #\z #'(lambda (arg) (not (char< #\c arg)))
+ (copy-seq '(#\a #\b #\c #\d #\e #\f)))
+ '(#\a #\b #\c #\z #\z #\z))
+(equal (nsubstitute-if-not "peace" #'(lambda (arg) (not (equal "war" arg)))
+ (copy-seq '("love" "hate" "war" "peace")))
+ '("love" "hate" "peace" "peace"))
+(equal (nsubstitute-if-not "peace"
+ #'(lambda (arg) (not (string-equal "war" arg)))
+ (copy-seq '("war" "War" "WAr" "WAR")))
+ '("peace" "peace" "peace" "peace"))
+(equal (nsubstitute-if-not "peace" #'(lambda (arg) (not (string= "WAR" arg)))
+ (copy-seq '("war" "War" "WAr" "WAR"))
+ :key #'string-upcase)
+ '("peace" "peace" "peace" "peace"))
+(equal (nsubstitute-if-not "peace" #'(lambda (arg) (not (string= "WAR" arg)))
+ (copy-seq '("war" "War" "WAr" "WAR"))
+ :start 1
+ :end 2
+ :key #'string-upcase)
+ '("war" "peace" "WAr" "WAR"))
+(equal (nsubstitute-if-not "peace" #'(lambda (arg) (not (string= "WAR" arg)))
+ (copy-seq '("war" "War" "WAr" "WAR"))
+ :start 1
+ :end nil
+ :key #'string-upcase)
+ '("war" "peace" "peace" "peace"))
+(equal (nsubstitute-if-not "peace" #'(lambda (arg) (not (string= "war" arg)))
+ (copy-seq '("war" "War" "WAr" "WAR"))
+ :key #'string-upcase)
+ '("war" "War" "WAr" "WAR"))
+(equal (nsubstitute-if-not "peace" #'(lambda (arg) (not (string= "WAR" arg)))
+ (copy-seq
+ '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR"))
+ :start 1
+ :end 7
+ :count 1
+ :key #'string-upcase)
+ '("war" "peace" "WAr" "WAR" "war" "War" "WAr" "WAR"))
+(equal (nsubstitute-if-not "peace" #'(lambda (arg) (not (string= "WAR" arg)))
+ (copy-seq
+ '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR"))
+ :start 1
+ :end 7
+ :count 2
+ :key #'string-upcase)
+ '("war" "peace" "peace" "WAR" "war" "War" "WAr" "WAR"))
+(equal (nsubstitute-if-not "peace" #'(lambda (arg) (not (string= "WAR" arg)))
+ (copy-seq
+ '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR"))
+ :start 1
+ :end 7
+ :count 2
+ :from-end t
+ :key #'string-upcase)
+ '("war" "War" "WAr" "WAR" "war" "peace" "peace" "WAR"))
+(equal (nsubstitute-if-not "peace" #'(lambda (arg) (not (string= "WAR" arg)))
+ (copy-seq
+ '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR"))
+ :start 1
+ :end 7
+ :count 0
+ :from-end t
+ :key #'string-upcase)
+ '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR"))
+(equal (nsubstitute-if-not "peace" #'(lambda (arg) (not (string= "WAR" arg)))
+ (copy-seq
+ '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR"))
+ :start 1
+ :end 7
+ :count -2
+ :from-end t
+ :key #'string-upcase)
+ '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR"))
+(equal (nsubstitute-if-not "peace" #'(lambda (arg) (not (string= "WAR" arg)))
+ (copy-seq
+ '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR"))
+ :start 1
+ :end 7
+ :count nil
+ :from-end t
+ :key #'string-upcase)
+ '("war" "peace" "peace" "peace" "peace" "peace" "peace" "WAR"))
+(equal (nsubstitute-if-not "peace" #'(lambda (arg) (not (string= "WAR" arg)))
+ (copy-seq
+ '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR"))
+ :start 1
+ :end 7
+ :count 6
+ :from-end t
+ :key #'string-upcase)
+ '("war" "peace" "peace" "peace" "peace" "peace" "peace" "WAR"))
+(equal (nsubstitute-if-not "peace" #'(lambda (arg) (not (string= "WAR" arg)))
+ (copy-seq
+ '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR"))
+ :start 1
+ :end 7
+ :count 7
+ :from-end t
+ :key #'string-upcase)
+ '("war" "peace" "peace" "peace" "peace" "peace" "peace" "WAR"))
+(equal (nsubstitute-if-not "peace" #'(lambda (arg) (not (string= "WAR" arg)))
+ (copy-seq
+ '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR"))
+ :start 1
+ :end 7
+ :count 100
+ :from-end t
+ :key #'string-upcase)
+ '("war" "peace" "peace" "peace" "peace" "peace" "peace" "WAR"))
+
+
+(equalp (nsubstitute-if-not 'a #'(lambda (arg) (not (eq arg 'x)))
+ (copy-seq #(x y z))) #(a y z))
+(equalp (nsubstitute-if-not 'b #'(lambda (arg) (not (eq arg 'y)))
+ (copy-seq #(x y z))) #(x b z))
+(equalp (nsubstitute-if-not 'c #'(lambda (arg) (not (eq arg 'z)))
+ (copy-seq #(x y z))) #(x y c))
+(equalp (nsubstitute-if-not 'a #'(lambda (arg) (not (eq arg 'p)))
+ (copy-seq #(x y z))) #(x y z))
+(equalp (nsubstitute-if-not 'a #'(lambda (arg) (not (eq arg 'x)))
+ (copy-seq #())) #())
+(equalp (nsubstitute-if-not #\x #'(lambda (arg) (not (char< #\b arg)))
+ (copy-seq #(#\a #\b #\c #\d #\e)))
+ #(#\a #\b #\x #\x #\x))
+(equalp (nsubstitute-if-not '(a) #'(lambda (arg) (not (eq arg 'x)))
+ (copy-seq #((x) (y) (z))) :key #'car)
+ #((a) (y) (z)))
+(equalp (nsubstitute-if-not 'c #'(lambda (arg) (not (eq arg 'b)))
+ (copy-seq #(a b a b a b a b))) #(a c a c a c a c))
+(equalp (nsubstitute-if-not 'a #'(lambda (arg) (not (eq arg 'b)))
+ (copy-seq #(b b b))) #(a a a))
+(equalp (nsubstitute-if-not 'z #'(lambda (arg) (not (eq arg 'x)))
+ (copy-seq #(a x b x c x d x e x f)))
+ #(a z b z c z d z e z f))
+(equalp (nsubstitute-if-not 'z #'(lambda (arg) (not (eq arg 'x)))
+ (copy-seq #(a x b x c x d x e x f)) :count nil)
+ #(a z b z c z d z e z f))
+(equalp (nsubstitute-if-not 'z #'(lambda (arg) (not (eq arg 'x)))
+ (copy-seq #(a x b x c x d x e x f)) :count 0)
+ #(a x b x c x d x e x f))
+(equalp (nsubstitute-if-not 'z #'(lambda (arg) (not (eq arg 'x)))
+ (copy-seq #(a x b x c x d x e x f)) :count -100)
+ #(a x b x c x d x e x f))
+(equalp (nsubstitute-if-not 'z #'(lambda (arg) (not (eq arg 'x)))
+ (copy-seq #(a x b x c x d x e x f)) :count 1)
+ #(a z b x c x d x e x f))
+(equalp (nsubstitute-if-not 'z #'(lambda (arg) (not (eq arg 'x)))
+ (copy-seq #(a x b x c x d x e x f)) :count 2)
+ #(a z b z c x d x e x f))
+(equalp (nsubstitute-if-not 'z #'(lambda (arg) (not (eq arg 'x)))
+ (copy-seq #(a x b x c x d x e x f)) :count 3)
+ #(a z b z c z d x e x f))
+(equalp (nsubstitute-if-not 'z #'(lambda (arg) (not (eq arg 'x)))
+ (copy-seq #(a x b x c x d x e x f)) :count 4)
+ #(a z b z c z d z e x f))
+(equalp (nsubstitute-if-not 'z #'(lambda (arg) (not (eq arg 'x)))
+ (copy-seq #(a x b x c x d x e x f)) :count 5)
+ #(a z b z c z d z e z f))
+(equalp (nsubstitute-if-not 'z #'(lambda (arg) (not (eq arg 'x)))
+ (copy-seq #(a x b x c x d x e x f)) :count 6)
+ #(a z b z c z d z e z f))
+(equalp (nsubstitute-if-not 'z #'(lambda (arg) (not (eq arg 'x)))
+ (copy-seq #(a x b x c x d x e x f)) :count 7)
+ #(a z b z c z d z e z f))
+(equalp (nsubstitute-if-not 'z #'(lambda (arg) (not (eq arg 'x)))
+ (copy-seq #(a x b x c x d x e x f))
+ :count nil :from-end t)
+ #(a z b z c z d z e z f))
+(equalp (nsubstitute-if-not 'z #'(lambda (arg) (not (eq arg 'x)))
+ (copy-seq #(a x b x c x d x e x f))
+ :count 0 :from-end t)
+ #(a x b x c x d x e x f))
+(equalp (nsubstitute-if-not 'z #'(lambda (arg) (not (eq arg 'x)))
+ (copy-seq #(a x b x c x d x e x f))
+ :count -100 :from-end t)
+ #(a x b x c x d x e x f))
+(equalp (nsubstitute-if-not 'z #'(lambda (arg) (not (eq arg 'x)))
+ (copy-seq #(a x b x c x d x e x f))
+ :count 1 :from-end t)
+ #(a x b x c x d x e z f))
+(equalp (nsubstitute-if-not 'z #'(lambda (arg) (not (eq arg 'x)))
+ (copy-seq #(a x b x c x d x e x f))
+ :count 2 :from-end t)
+ #(a x b x c x d z e z f))
+(equalp (nsubstitute-if-not 'z #'(lambda (arg) (not (eq arg 'x)))
+ (copy-seq #(a x b x c x d x e x f))
+ :count 3 :from-end t)
+ #(a x b x c z d z e z f))
+(equalp (nsubstitute-if-not 'z #'(lambda (arg) (not (eq arg 'x)))
+ (copy-seq #(a x b x c x d x e x f))
+ :count 4 :from-end t)
+ #(a x b z c z d z e z f))
+(equalp (nsubstitute-if-not 'z #'(lambda (arg) (not (eq arg 'x)))
+ (copy-seq #(a x b x c x d x e x f))
+ :count 5 :from-end t)
+ #(a z b z c z d z e z f))
+(equalp (nsubstitute-if-not 'z #'(lambda (arg) (not (eq arg 'x)))
+ (copy-seq #(a x b x c x d x e x f))
+ :count 6 :from-end t)
+ #(a z b z c z d z e z f))
+(equalp (nsubstitute-if-not 'z #'(lambda (arg) (not (eq arg 'x)))
+ (copy-seq #(a x b x c x d x e x f))
+ :count 7 :from-end t)
+ #(a z b z c z d z e z f))
+(equalp (nsubstitute-if-not 'z #'(lambda (arg) (not (eq arg 'x)))
+ (copy-seq #(a x b x c x d x e x f))
+ :start 2 :count 1)
+ #(a x b z c x d x e x f))
+(equalp (nsubstitute-if-not 'z #'(lambda (arg) (not (eq arg 'x)))
+ (copy-seq #(a x b x c x d x e x f))
+ :start 2 :end nil :count 1)
+ #(a x b z c x d x e x f))
+(equalp (nsubstitute-if-not 'z #'(lambda (arg) (not (eq arg 'x)))
+ (copy-seq #(a x b x c x d x e x f))
+ :start 2 :end 6 :count 100)
+ #(a x b z c z d x e x f))
+(equalp (nsubstitute-if-not 'z #'(lambda (arg) (not (eq arg 'x)))
+ (copy-seq #(a x b x c x d x e x f))
+ :start 2 :end 11 :count 100)
+ #(a x b z c z d z e z f))
+(equalp (nsubstitute-if-not 'z #'(lambda (arg) (not (eq arg 'x)))
+ (copy-seq #(a x b x c x d x e x f))
+ :start 2 :end 8 :count 10)
+ #(a x b z c z d z e x f))
+(equalp (nsubstitute-if-not 'z #'(lambda (arg) (not (eq arg 'x)))
+ (copy-seq #(a x b x c x d x e x f))
+ :start 2 :end 8 :count 2 :from-end t)
+ #(a x b x c z d z e x f))
+(equalp (nsubstitute-if-not #\z #'(lambda (arg) (not (char< #\c arg)))
+ (copy-seq #(#\a #\b #\c #\d #\e #\f)))
+ #(#\a #\b #\c #\z #\z #\z))
+(equalp (nsubstitute-if-not "peace" #'(lambda (arg) (not (equal "war" arg)))
+ (copy-seq #("love" "hate" "war" "peace")))
+ #("love" "hate" "peace" "peace"))
+(equalp (nsubstitute-if-not "peace"
+ #'(lambda (arg) (not (string-equal "war" arg)))
+ (copy-seq #("war" "War" "WAr" "WAR")))
+ #("peace" "peace" "peace" "peace"))
+(equalp (nsubstitute-if-not "peace" #'(lambda (arg) (not (string= "WAR" arg)))
+ (copy-seq #("war" "War" "WAr" "WAR"))
+ :key #'string-upcase)
+ #("peace" "peace" "peace" "peace"))
+(equalp (nsubstitute-if-not "peace" #'(lambda (arg) (not (string= "WAR" arg)))
+ (copy-seq #("war" "War" "WAr" "WAR"))
+ :start 1
+ :end 2
+ :key #'string-upcase)
+ #("war" "peace" "WAr" "WAR"))
+(equalp (nsubstitute-if-not "peace" #'(lambda (arg) (not (string= "WAR" arg)))
+ (copy-seq #("war" "War" "WAr" "WAR"))
+ :start 1
+ :end nil
+ :key #'string-upcase)
+ #("war" "peace" "peace" "peace"))
+(equalp (nsubstitute-if-not "peace" #'(lambda (arg) (not (string= "war" arg)))
+ (copy-seq #("war" "War" "WAr" "WAR"))
+ :key #'string-upcase)
+ #("war" "War" "WAr" "WAR"))
+(equalp (nsubstitute-if-not "peace" #'(lambda (arg) (not (string= "WAR" arg)))
+ (copy-seq
+ #("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR"))
+ :start 1
+ :end 7
+ :count 1
+ :key #'string-upcase)
+ #("war" "peace" "WAr" "WAR" "war" "War" "WAr" "WAR"))
+(equalp (nsubstitute-if-not "peace" #'(lambda (arg) (not (string= "WAR" arg)))
+ (copy-seq
+ #("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR"))
+ :start 1
+ :end 7
+ :count 2
+ :key #'string-upcase)
+ #("war" "peace" "peace" "WAR" "war" "War" "WAr" "WAR"))
+(equalp (nsubstitute-if-not "peace" #'(lambda (arg) (not (string= "WAR" arg)))
+ (copy-seq
+ #("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR"))
+ :start 1
+ :end 7
+ :count 2
+ :from-end t
+ :key #'string-upcase)
+ #("war" "War" "WAr" "WAR" "war" "peace" "peace" "WAR"))
+(equalp (nsubstitute-if-not "peace" #'(lambda (arg) (not (string= "WAR" arg)))
+ (copy-seq
+ #("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR"))
+ :start 1
+ :end 7
+ :count 0
+ :from-end t
+ :key #'string-upcase)
+ #("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR"))
+(equalp (nsubstitute-if-not "peace" #'(lambda (arg) (not (string= "WAR" arg)))
+ (copy-seq
+ #("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR"))
+ :start 1
+ :end 7
+ :count -2
+ :from-end t
+ :key #'string-upcase)
+ #("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR"))
+(equalp (nsubstitute-if-not "peace" #'(lambda (arg) (not (string= "WAR" arg)))
+ (copy-seq
+ #("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR"))
+ :start 1
+ :end 7
+ :count nil
+ :from-end t
+ :key #'string-upcase)
+ #("war" "peace" "peace" "peace" "peace" "peace" "peace" "WAR"))
+(equalp (nsubstitute-if-not "peace" #'(lambda (arg) (not (string= "WAR" arg)))
+ (copy-seq
+ #("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR"))
+ :start 1
+ :end 7
+ :count 6
+ :from-end t
+ :key #'string-upcase)
+ #("war" "peace" "peace" "peace" "peace" "peace" "peace" "WAR"))
+(equalp (nsubstitute-if-not "peace" #'(lambda (arg) (not (string= "WAR" arg)))
+ (copy-seq
+ #("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR"))
+ :start 1
+ :end 7
+ :count 7
+ :from-end t
+ :key #'string-upcase)
+ #("war" "peace" "peace" "peace" "peace" "peace" "peace" "WAR"))
+(equalp (nsubstitute-if-not "peace" #'(lambda (arg) (not (string= "WAR" arg)))
+ (copy-seq
+ #("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR"))
+ :start 1
+ :end 7
+ :count 100
+ :from-end t
+ :key #'string-upcase)
+ #("war" "peace" "peace" "peace" "peace" "peace" "peace" "WAR"))
+
+(string= (nsubstitute-if-not #\A #'(lambda (arg) (not (eql #\a arg)))
+ (copy-seq "abcabc"))
+ "AbcAbc")
+(string= (nsubstitute-if-not #\A #'(lambda (arg) (not (eql #\a arg)))
+ (copy-seq "")) "")
+(string= (nsubstitute-if-not #\A #'(lambda (arg) (not (eql #\a arg)))
+ (copy-seq "xyz"))
+ "xyz")
+(string= (nsubstitute-if-not #\A #'(lambda (arg) (not (eql #\a arg)))
+ (copy-seq "aaaaaaaaaa") :start 5 :end nil)
+ "aaaaaAAAAA")
+(string= (nsubstitute-if-not #\x #'(lambda (arg) (not (char< #\5 arg)))
+ (copy-seq "0123456789")) "012345xxxx")
+(string= (nsubstitute-if-not #\x #'(lambda (arg) (not (char> #\5 arg)))
+ (copy-seq "0123456789")) "xxxxx56789")
+(string= (nsubstitute-if-not #\x #'(lambda (arg) (not (char> #\D arg)))
+ (copy-seq "abcdefg")
+ :key #'char-upcase)
+ "xxxdefg")
+(string= (nsubstitute-if-not #\x #'(lambda (arg) (not (char> #\D arg)))
+ (copy-seq "abcdefg")
+ :start 1
+ :end 2
+ :key #'char-upcase)
+ "axcdefg")
+(string= (nsubstitute-if-not #\A #'(lambda (arg) (not (eql #\a arg)))
+ (copy-seq "aaaaaaaaaa") :count 2) "AAaaaaaaaa")
+(string= (nsubstitute-if-not #\A #'(lambda (arg) (not (eql #\a arg)))
+ (copy-seq "aaaaaaaaaa") :count -1) "aaaaaaaaaa")
+(string= (nsubstitute-if-not #\A #'(lambda (arg) (not (eql #\a arg)))
+ (copy-seq "aaaaaaaaaa") :count 0) "aaaaaaaaaa")
+(string= (nsubstitute-if-not #\A #'(lambda (arg) (not (eql #\a arg)))
+ (copy-seq "aaaaaaaaaa") :count nil) "AAAAAAAAAA")
+(string= (nsubstitute-if-not #\A #'(lambda (arg) (not (eql #\a arg)))
+ (copy-seq "aaaaaaaaaa") :count 100) "AAAAAAAAAA")
+(string= (nsubstitute-if-not #\A #'(lambda (arg) (not (eql #\a arg)))
+ (copy-seq "aaaaaaaaaa") :count 9) "AAAAAAAAAa")
+(string= (nsubstitute-if-not #\A #'(lambda (arg) (not (eql #\a arg)))
+ (copy-seq "aaaaaaaaaa") :count 9 :from-end t)
+ "aAAAAAAAAA")
+(string= (nsubstitute-if-not #\A #'(lambda (arg) (not (eql #\a arg)))
+ (copy-seq "aaaaaaaaaa")
+ :start 2
+ :end 8
+ :count 3)
+ "aaAAAaaaaa")
+(string= (nsubstitute-if-not #\A #'(lambda (arg) (not (eql #\a arg)))
+ (copy-seq "aaaaaaaaaa")
+ :start 2
+ :end 8
+ :from-end t
+ :count 3)
+ "aaaaaAAAaa")
+(string= (nsubstitute-if-not #\x #'(lambda (arg) (not (eql #\A arg)))
+ (copy-seq "aaaaaaaaaa")
+ :start 2
+ :end 8
+ :from-end t
+ :count 3)
+ "aaaaaaaaaa")
+(string= (nsubstitute-if-not #\X #'(lambda (arg) (not (eql #\A arg)))
+ (copy-seq "aaaaaaaaaa")
+ :start 2
+ :end 8
+ :from-end t
+ :key #'char-upcase
+ :count 3)
+ "aaaaaXXXaa")
+(string= (nsubstitute-if-not #\X #'(lambda (arg) (not (char< #\D arg)))
+ (copy-seq "abcdefghij")
+ :start 2
+ :end 8
+ :from-end t
+ :key #'char-upcase
+ :count 3)
+ "abcdeXXXij")
+(equalp (nsubstitute-if-not 0 #'(lambda (arg) (not (= 1 arg)))
+ (copy-seq #*1111)) #*0000)
+(equalp (nsubstitute-if-not 0 #'(lambda (arg) (not (= 1 arg)))
+ (copy-seq #*1111) :start 1 :end nil) #*1000)
+(equalp (nsubstitute-if-not 0 #'(lambda (arg) (not (= 1 arg)))
+ (copy-seq #*1111) :start 1 :end 3) #*1001)
+(equalp (nsubstitute-if-not 0 #'(lambda (arg) (not (= 1 arg)))
+ (copy-seq #*11111111) :start 1 :end 7) #*10000001)
+(equalp (nsubstitute-if-not 0 #'(lambda (arg) (not (= 1 arg)))
+ (copy-seq #*11111111) :start 1 :end 7 :count 3)
+ #*10001111)
+(equalp (nsubstitute-if-not 0 #'(lambda (arg) (not (= 1 arg)))
+ (copy-seq #*11111111)
+ :start 1 :end 7 :count 3 :from-end t)
+ #*11110001)
+(equalp (nsubstitute-if-not 1 #'(lambda (arg) (not (= 1 arg)))
+ (copy-seq #*10101010)
+ :start 1 :end 7 :count 3 :from-end t
+ :key #'(lambda (x) (if (zerop x) 1 0)))
+ #*11111110)
+(equalp (nsubstitute-if-not 1 #'(lambda (arg) (not (>= 1 arg)))
+ (copy-seq #*10101010)
+ :start 1 :end 7 :count 3 :from-end t
+ :key #'(lambda (x) (if (zerop x) 1 0)))
+ #*10101110)
+
+
+(string= (concatenate 'string "all" " " "together" " " "now")
+ "all together now")
+(equal (concatenate 'list "ABC" '(d e f) #(1 2 3) #*1011)
+ '(#\A #\B #\C D E F 1 2 3 1 0 1 1))
+(null (concatenate 'list))
+(HANDLER-CASE (PROGN (CONCATENATE 'SYMBOL))
+ (ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (CONCATENATE 'CLASS))
+ (ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+
+
+(equal (concatenate 'list '() '(a b c) '(x y z)) '(a b c x y z))
+(equal (concatenate 'list '(a) #(b) '(c) #(x y) '(z)) '(a b c x y z))
+(equal (concatenate 'list '(a b c) #(d e f) "ghi" #*0101)
+ '(a b c d e f #\g #\h #\i 0 1 0 1))
+(null (concatenate 'list))
+(let* ((list0 '(a b c))
+ (list (concatenate 'list list0)))
+ (and (not (eq list0 list))
+ (equal list list0)
+ (equal list '(a b c))))
+(null (concatenate 'list '() #() "" #*))
+(equal (concatenate 'list #(a b c) '() '() '(x y z) #() #() #* #(j k l))
+ '(a b c x y z j k l))
+
+(equalp (concatenate 'vector '() '(a b c) '(x y z)) #(a b c x y z))
+(equalp (concatenate 'vector '(a) #(b) '(c) #(x y) '(z)) #(a b c x y z))
+(equalp (concatenate 'vector '(a b c) #(d e f) "ghi" #*0101)
+ #(a b c d e f #\g #\h #\i 0 1 0 1))
+(equalp (concatenate 'vector) #())
+(let* ((vector0 #(a b c))
+ (vector (concatenate 'vector vector0)))
+ (and (not (eq vector0 vector))
+ (equalp vector vector0)
+ (equalp vector #(a b c))))
+(equalp (concatenate 'vector '() #() "" #*) #())
+(equalp (concatenate 'vector #(a b c) '() '() '(x y z) #() #() #* #(j k l))
+ #(a b c x y z j k l))
+
+(string= (concatenate 'string "abc" "def" "ghi" "jkl" "mno" "pqr")
+ "abcdefghijklmnopqr")
+(string= (concatenate
+ 'string
+ "" "abc" "" "def" "" "ghi" "" "" "jkl" "" "mno" "" "pqr" "" "")
+ "abcdefghijklmnopqr")
+(string= (concatenate 'string) "")
+(string= (concatenate 'string "" '() #* #()) "")
+(string= (concatenate 'string "abc" '(#\d #\e #\f #\g) #(#\h #\i #\j #\k #\l))
+ "abcdefghijkl")
+(equal (concatenate 'bit-vector #*0101 #*1010) #*01011010)
+(equal (concatenate 'bit-vector #*0101 #*1010 #* #*11 #*1 #*1)
+ #*010110101111)
+(equal (concatenate 'bit-vector '(0 1 0 1) '(0 1 0 1) #(0 1 0 1) #*0101)
+ #*0101010101010101)
+(equal (concatenate 'bit-vector) #*)
+(equal (concatenate 'bit-vector #*) #*)
+(equal (concatenate 'bit-vector #* '() #()) #*)
+
+
+
+(let ((test1 (list 1 3 4 6 7))
+ (test2 (list 2 5 8)))
+ (equal (merge 'list test1 test2 #'<) '(1 2 3 4 5 6 7 8)))
+(let ((test1 (copy-seq "BOY"))
+ (test2 (copy-seq "nosy")))
+ (equal (merge 'string test1 test2 #'char-lessp) "BnOosYy"))
+(let ((test1 (vector '(red . 1) '(blue . 4)))
+ (test2 (vector '(yellow . 2) '(green . 7))))
+ (equalp (merge 'vector test1 test2 #'< :key #'cdr)
+ #((RED . 1) (YELLOW . 2) (BLUE . 4) (GREEN . 7))))
+
+
+(equal (merge 'list (list 1 3 5 7 9) (list 0 2 4 6 8) #'<)
+ '(0 1 2 3 4 5 6 7 8 9))
+(equal (merge 'cons (list 1 3 5 7 9) (list 0 2 4 6 8) #'<)
+ '(0 1 2 3 4 5 6 7 8 9))
+(equal (merge 'list (list 0 1 2) nil #'<) '(0 1 2))
+(equal (merge 'list nil (list 0 1 2) #'<) '(0 1 2))
+(equal (merge 'list nil nil #'<) nil)
+(equal (merge 'list
+ (list '(1 1) '(2 1) '(3 1))
+ (list '(1 2) '(2 2) '(3 2)) #'< :key #'car)
+ '((1 1) (1 2) (2 1) (2 2) (3 1) (3 2)))
+(equal (merge 'list
+ (list '(1 1) '(2 1) '(2 1 1) '(3 1))
+ (list '(1 2) '(2 2) '(3 2)) #'< :key #'car)
+ '((1 1) (1 2) (2 1) (2 1 1) (2 2) (3 1) (3 2)))
+(equal (merge 'list
+ (list '(1 1) '(2 1) '(2 1 1) '(3 1))
+ (list '(1 2) '(2 2) '(3 2) '(3 2 2)) #'< :key #'car)
+ '((1 1) (1 2) (2 1) (2 1 1) (2 2) (3 1) (3 2) (3 2 2)))
+(equal (merge 'list (list 3 1 9 5 7) (list 8 6 0 2 4) #'<)
+ '(3 1 8 6 0 2 4 9 5 7))
+
+
+(equal (merge 'list (vector 1 3 5 7 9) (list 0 2 4 6 8) #'<)
+ '(0 1 2 3 4 5 6 7 8 9))
+(equal (merge 'cons (vector 1 3 5 7 9) (list 0 2 4 6 8) #'<)
+ '(0 1 2 3 4 5 6 7 8 9))
+(equal (merge 'list (vector 0 1 2) nil #'<) '(0 1 2))
+(equal (merge 'list #() (list 0 1 2) #'<) '(0 1 2))
+(equal (merge 'list #() #() #'<) nil)
+(equal (merge 'list
+ (vector '(1 1) '(2 1) '(3 1))
+ (list '(1 2) '(2 2) '(3 2)) #'< :key #'car)
+ '((1 1) (1 2) (2 1) (2 2) (3 1) (3 2)))
+(equal (merge 'list
+ (vector '(1 1) '(2 1) '(2 1 1) '(3 1))
+ (list '(1 2) '(2 2) '(3 2)) #'< :key #'car)
+ '((1 1) (1 2) (2 1) (2 1 1) (2 2) (3 1) (3 2)))
+(equal (merge 'list
+ (vector '(1 1) '(2 1) '(2 1 1) '(3 1))
+ (list '(1 2) '(2 2) '(3 2) '(3 2 2)) #'< :key #'car)
+ '((1 1) (1 2) (2 1) (2 1 1) (2 2) (3 1) (3 2) (3 2 2)))
+(equal (merge 'list (vector 3 1 9 5 7) (list 8 6 0 2 4) #'<)
+ '(3 1 8 6 0 2 4 9 5 7))
+
+
+(equal (merge 'list (list 1 3 5 7 9) (vector 0 2 4 6 8) #'<)
+ '(0 1 2 3 4 5 6 7 8 9))
+(equal (merge 'cons (list 1 3 5 7 9) (vector 0 2 4 6 8) #'<)
+ '(0 1 2 3 4 5 6 7 8 9))
+(equal (merge 'list (list 0 1 2) #() #'<) '(0 1 2))
+(equal (merge 'list nil (vector 0 1 2) #'<) '(0 1 2))
+(equal (merge 'list nil #() #'<) nil)
+(equal (merge 'list
+ (list '(1 1) '(2 1) '(3 1))
+ (vector '(1 2) '(2 2) '(3 2)) #'< :key #'car)
+ '((1 1) (1 2) (2 1) (2 2) (3 1) (3 2)))
+(equal (merge 'list
+ (list '(1 1) '(2 1) '(2 1 1) '(3 1))
+ (vector '(1 2) '(2 2) '(3 2)) #'< :key #'car)
+ '((1 1) (1 2) (2 1) (2 1 1) (2 2) (3 1) (3 2)))
+(equal (merge 'list
+ (list '(1 1) '(2 1) '(2 1 1) '(3 1))
+ (vector '(1 2) '(2 2) '(3 2) '(3 2 2)) #'< :key #'car)
+ '((1 1) (1 2) (2 1) (2 1 1) (2 2) (3 1) (3 2) (3 2 2)))
+(equal (merge 'list (list 3 1 9 5 7) (vector 8 6 0 2 4) #'<)
+ '(3 1 8 6 0 2 4 9 5 7))
+
+
+(equal (merge 'list (vector 1 3 5 7 9) (vector 0 2 4 6 8) #'<)
+ '(0 1 2 3 4 5 6 7 8 9))
+(equal (merge 'cons (vector 1 3 5 7 9) (vector 0 2 4 6 8) #'<)
+ '(0 1 2 3 4 5 6 7 8 9))
+(equal (merge 'list (vector 0 1 2) #() #'<) '(0 1 2))
+(equal (merge 'list #() (vector 0 1 2) #'<) '(0 1 2))
+(equal (merge 'list #() #() #'<) nil)
+(equal (merge 'list
+ (vector '(1 1) '(2 1) '(3 1))
+ (vector '(1 2) '(2 2) '(3 2)) #'< :key #'car)
+ '((1 1) (1 2) (2 1) (2 2) (3 1) (3 2)))
+(equal (merge 'list
+ (vector '(1 1) '(2 1) '(2 1 1) '(3 1))
+ (vector '(1 2) '(2 2) '(3 2)) #'< :key #'car)
+ '((1 1) (1 2) (2 1) (2 1 1) (2 2) (3 1) (3 2)))
+(equal (merge 'list
+ (vector '(1 1) '(2 1) '(2 1 1) '(3 1))
+ (vector '(1 2) '(2 2) '(3 2) '(3 2 2)) #'< :key #'car)
+ '((1 1) (1 2) (2 1) (2 1 1) (2 2) (3 1) (3 2) (3 2 2)))
+(equal (merge 'list (vector 3 1 9 5 7) (vector 8 6 0 2 4) #'<)
+ '(3 1 8 6 0 2 4 9 5 7))
+
+
+(equalp (merge 'vector (list 1 3 5 7 9) (list 0 2 4 6 8) #'<)
+ #(0 1 2 3 4 5 6 7 8 9))
+(equalp (merge 'vector (list 1 3 5 7 9) (list 0 2 4 6 8) #'<)
+ #(0 1 2 3 4 5 6 7 8 9))
+(equalp (merge 'vector (list 0 1 2) nil #'<) #(0 1 2))
+(equalp (merge 'vector nil (list 0 1 2) #'<) #(0 1 2))
+(equalp (merge 'vector nil nil #'<) #())
+(equalp (merge 'vector
+ (list '(1 1) '(2 1) '(3 1))
+ (list '(1 2) '(2 2) '(3 2)) #'< :key #'car)
+ #((1 1) (1 2) (2 1) (2 2) (3 1) (3 2)))
+(equalp (merge 'vector
+ (list '(1 1) '(2 1) '(2 1 1) '(3 1))
+ (list '(1 2) '(2 2) '(3 2)) #'< :key #'car)
+ #((1 1) (1 2) (2 1) (2 1 1) (2 2) (3 1) (3 2)))
+(equalp (merge 'vector
+ (list '(1 1) '(2 1) '(2 1 1) '(3 1))
+ (list '(1 2) '(2 2) '(3 2) '(3 2 2)) #'< :key #'car)
+ #((1 1) (1 2) (2 1) (2 1 1) (2 2) (3 1) (3 2) (3 2 2)))
+(equalp (merge 'vector (list 3 1 9 5 7) (list 8 6 0 2 4) #'<)
+ #(3 1 8 6 0 2 4 9 5 7))
+
+
+(equalp (merge 'vector (vector 1 3 5 7 9) (list 0 2 4 6 8) #'<)
+ #(0 1 2 3 4 5 6 7 8 9))
+(equalp (merge 'vector (vector 1 3 5 7 9) (list 0 2 4 6 8) #'<)
+ #(0 1 2 3 4 5 6 7 8 9))
+(equalp (merge 'vector (vector 0 1 2) nil #'<) #(0 1 2))
+(equalp (merge 'vector #() (list 0 1 2) #'<) #(0 1 2))
+(equalp (merge 'vector #() #() #'<) #())
+(equalp (merge 'vector
+ (vector '(1 1) '(2 1) '(3 1))
+ (list '(1 2) '(2 2) '(3 2)) #'< :key #'car)
+ #((1 1) (1 2) (2 1) (2 2) (3 1) (3 2)))
+(equalp (merge 'vector
+ (vector '(1 1) '(2 1) '(2 1 1) '(3 1))
+ (list '(1 2) '(2 2) '(3 2)) #'< :key #'car)
+ #((1 1) (1 2) (2 1) (2 1 1) (2 2) (3 1) (3 2)))
+(equalp (merge 'vector
+ (vector '(1 1) '(2 1) '(2 1 1) '(3 1))
+ (list '(1 2) '(2 2) '(3 2) '(3 2 2)) #'< :key #'car)
+ #((1 1) (1 2) (2 1) (2 1 1) (2 2) (3 1) (3 2) (3 2 2)))
+(equalp (merge 'vector (vector 3 1 9 5 7) (list 8 6 0 2 4) #'<)
+ #(3 1 8 6 0 2 4 9 5 7))
+
+
+(equalp (merge 'vector (list 1 3 5 7 9) (vector 0 2 4 6 8) #'<)
+ #(0 1 2 3 4 5 6 7 8 9))
+(equalp (merge 'vector (list 1 3 5 7 9) (vector 0 2 4 6 8) #'<)
+ #(0 1 2 3 4 5 6 7 8 9))
+(equalp (merge 'vector (list 0 1 2) #() #'<) #(0 1 2))
+(equalp (merge 'vector nil (vector 0 1 2) #'<) #(0 1 2))
+(equalp (merge 'vector nil #() #'<) #())
+(equalp (merge 'vector
+ (list '(1 1) '(2 1) '(3 1))
+ (vector '(1 2) '(2 2) '(3 2)) #'< :key #'car)
+ #((1 1) (1 2) (2 1) (2 2) (3 1) (3 2)))
+(equalp (merge 'vector
+ (list '(1 1) '(2 1) '(2 1 1) '(3 1))
+ (vector '(1 2) '(2 2) '(3 2)) #'< :key #'car)
+ #((1 1) (1 2) (2 1) (2 1 1) (2 2) (3 1) (3 2)))
+(equalp (merge 'vector
+ (list '(1 1) '(2 1) '(2 1 1) '(3 1))
+ (vector '(1 2) '(2 2) '(3 2) '(3 2 2)) #'< :key #'car)
+ #((1 1) (1 2) (2 1) (2 1 1) (2 2) (3 1) (3 2) (3 2 2)))
+(equalp (merge 'vector (list 3 1 9 5 7) (vector 8 6 0 2 4) #'<)
+ #(3 1 8 6 0 2 4 9 5 7))
+
+
+(equalp (merge 'vector (vector 1 3 5 7 9) (vector 0 2 4 6 8) #'<)
+ #(0 1 2 3 4 5 6 7 8 9))
+(equalp (merge 'vector (vector 0 1 2) #() #'<) #(0 1 2))
+(equalp (merge 'vector #() (vector 0 1 2) #'<) #(0 1 2))
+(equalp (merge 'vector #() #() #'<) #())
+(equalp (merge 'vector
+ (vector '(1 1) '(2 1) '(3 1))
+ (vector '(1 2) '(2 2) '(3 2)) #'< :key #'car)
+ #((1 1) (1 2) (2 1) (2 2) (3 1) (3 2)))
+(equalp (merge 'vector
+ (vector '(1 1) '(2 1) '(2 1 1) '(3 1))
+ (vector '(1 2) '(2 2) '(3 2)) #'< :key #'car)
+ #((1 1) (1 2) (2 1) (2 1 1) (2 2) (3 1) (3 2)))
+(equalp (merge 'vector
+ (vector '(1 1) '(2 1) '(2 1 1) '(3 1))
+ (vector '(1 2) '(2 2) '(3 2) '(3 2 2)) #'< :key #'car)
+ #((1 1) (1 2) (2 1) (2 1 1) (2 2) (3 1) (3 2) (3 2 2)))
+(equalp (merge 'vector (vector 3 1 9 5 7) (vector 8 6 0 2 4) #'<)
+ #(3 1 8 6 0 2 4 9 5 7))
+
+
+(string= (merge 'string (list #\a #\c #\e) (list #\b #\d #\f) #'char<) "abcdef")
+(string= (merge 'string (list #\a #\b #\c) (list #\d #\e #\f) #'char<) "abcdef")
+(string= (merge 'string (list #\a #\b #\c) '() #'char<) "abc")
+(string= (merge 'string '() (list #\a #\b #\c) #'char<) "abc")
+(string= (merge 'string (list #\a #\b #\c) (copy-seq "") #'char<) "abc")
+(string= (merge 'string (list #\a #\b #\c) (copy-seq "BCD") #'char-lessp)
+ "abBcCD")
+(string= (merge 'string (list #\a #\b #\z) #(#\c #\x #\y) #'char<) "abcxyz")
+
+(equal (merge 'bit-vector (copy-seq #*0101) (copy-seq #*1010) #'<) #*01011010)
+(equal (merge 'bit-vector (copy-seq #*0101) (copy-seq #*) #'<) #*0101)
+(equal (merge 'bit-vector (copy-seq #*0101) '() #'<) #*0101)
+(equal (merge 'bit-vector nil (copy-seq #*0101) #'<) #*0101)
+(equal (merge 'bit-vector (copy-seq #*0101) (copy-seq #*0101) #'<) #*00101101)
+
+
+
+
+(equal (remove 4 '(1 3 4 5 9)) '(1 3 5 9))
+(equal (remove 4 '(1 2 4 1 3 4 5)) '(1 2 1 3 5))
+(equal (remove 4 '(1 2 4 1 3 4 5) :count 1) '(1 2 1 3 4 5))
+(equal (remove 4 '(1 2 4 1 3 4 5) :count 1 :from-end t) '(1 2 4 1 3 5))
+(equal (remove 3 '(1 2 4 1 3 4 5) :test #'>) '(4 3 4 5))
+(let* ((lst '(list of four elements))
+ (lst2 (copy-seq lst))
+ (lst3 (delete 'four lst)))
+ (and (equal lst3 '(LIST OF ELEMENTS))
+ (not (equal lst lst2))))
+(equal (remove-if #'oddp '(1 2 4 1 3 4 5)) '(2 4 4))
+(equal (remove-if #'evenp '(1 2 4 1 3 4 5) :count 1 :from-end t)
+ '(1 2 4 1 3 5))
+(equal (remove-if-not #'evenp '(1 2 3 4 5 6 7 8 9) :count 2 :from-end t)
+ '(1 2 3 4 5 6 8))
+(equal (delete 4 (list 1 2 4 1 3 4 5)) '(1 2 1 3 5))
+(equal (delete 4 (list 1 2 4 1 3 4 5) :count 1) '(1 2 1 3 4 5))
+(equal (delete 4 (list 1 2 4 1 3 4 5) :count 1 :from-end t) '(1 2 4 1 3 5))
+(equal (delete 3 (list 1 2 4 1 3 4 5) :test #'>) '(4 3 4 5))
+(equal (delete-if #'oddp (list 1 2 4 1 3 4 5)) '(2 4 4))
+(equal (delete-if #'evenp (list 1 2 4 1 3 4 5) :count 1 :from-end t)
+ '(1 2 4 1 3 5))
+(equal (delete-if #'evenp (list 1 2 3 4 5 6)) '(1 3 5))
+
+
+(let* ((list0 (list 0 1 2 3 4))
+ (list (remove 3 list0)))
+ (and (not (eq list0 list))
+ (equal list0 '(0 1 2 3 4))
+ (equal list '(0 1 2 4))))
+(equal (remove 'a (list 'a 'b 'c 'a 'b 'c)) '(b c b c))
+(equal (remove 'b (list 'a 'b 'c 'a 'b 'c)) '(a c a c))
+(equal (remove 'c (list 'a 'b 'c 'a 'b 'c)) '(a b a b))
+(equal (remove 'a (list 'a 'a 'a)) '())
+(equal (remove 'z (list 'a 'b 'c)) '(a b c))
+(equal (remove 'a '()) '())
+(equal (remove 'a (list 'a 'b 'c 'a 'b 'c) :count 0) '(a b c a b c))
+(equal (remove 'a (list 'a 'b 'c 'a 'b 'c) :count 1) '(b c a b c))
+(equal (remove 'a (list 'a 'b 'c 'a 'b 'c) :count 1 :from-end t) '(a b c b c))
+(equal (remove 'a (list 'a 'b 'c 'a 'b 'c) :count 2) '(b c b c))
+(equal (remove 'a (list 'a 'b 'c 'a 'b 'c) :count 2 :from-end t) '(b c b c))
+(equal (remove 'a (list 'a 'b 'c 'a 'b 'c) :count 3) '(b c b c))
+(equal (remove 'a (list 'a 'b 'c 'a 'b 'c) :count 3 :from-end t) '(b c b c))
+(equal (remove 'a (list 'a 'b 'c 'a 'b 'c) :count 4) '(b c b c))
+(equal (remove 'a (list 'a 'b 'c 'a 'b 'c) :count 4 :from-end t) '(b c b c))
+(equal (remove 'a (list 'a 'b 'c 'a 'b 'c) :count -1) '(a b c a b c))
+(equal (remove 'a (list 'a 'b 'c 'a 'b 'c) :count -10) '(a b c a b c))
+(equal (remove 'a (list 'a 'b 'c 'a 'b 'c) :count -100) '(a b c a b c))
+(equal (remove 'a (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1)
+ '(a b c b c b c b c))
+(equal (remove 'a (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :count 1)
+ '(a b c b c a b c a b c))
+(equal (remove 'a (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :count 2)
+ '(a b c b c b c a b c))
+(equal (remove 'a (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c)
+ :start 1 :end nil :count 2)
+ '(a b c b c b c a b c))
+(equal (remove 'a (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8)
+ '(a b c b c b c a b c))
+(equal (remove 'a (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c)
+ :start 1 :end 8 :count 1)
+ '(a b c b c a b c a b c))
+(equal (remove 'a (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c)
+ :start 1 :end 8 :count 1 :from-end t)
+ '(a b c a b c b c a b c))
+(equal (remove 'a (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c)
+ :start 1 :end 8 :count 0 :from-end t)
+ '(a b c a b c a b c a b c))
+(equal (remove 'a (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c)
+ :start 1 :end 8 :count -100 :from-end t)
+ '(a b c a b c a b c a b c))
+(equal (remove 'a (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 1)
+ '(a b c a b c a b c a b c))
+(equal (remove 'a (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 2 :end 2)
+ '(a b c a b c a b c a b c))
+(equal (remove 'a (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 12 :end 12)
+ '(a b c a b c a b c a b c))
+(equal (remove 'a (list '(a) '(b) '(c) '(a) '(b) '(c)) :key #'car)
+ '((b) (c) (b) (c)))
+(equal (remove 'a (list '(a . b) '(b . c) '(c . a)
+ '(a . b) '(b . c) '(c . a))
+ :key #'cdr)
+ '((a . b) (b . c) (a . b) (b . c)))
+(equal (remove "love" (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key #'car)
+ '(("Love") ("LOve") ("LOVe") ("LOVE")))
+(equal (remove "love" (list '("Love") '("LOve") '("LOVe") '("LOVE"))
+ :key #'car :count -10)
+ '(("Love") ("LOve") ("LOVe") ("LOVE")))
+(equal (remove "love" (list '("Love") '("LOve") '("LOVe") '("LOVE"))
+ :key #'car :test #'string-equal)
+ '())
+(equal (remove "love" (list '("Love") '("LOve") '("LOVe") '("LOVE"))
+ :key #'car :test-not (complement #'string-equal))
+ '())
+(equal (remove "love" (list '("Love") '("LOve") '("LOVe") '("LOVE"))
+ :key #'car :test #'string-equal :count 1)
+ '(("LOve") ("LOVe") ("LOVE")))
+(equal (remove "love" (list '("Love") '("LOve") '("LOVe") '("LOVE"))
+ :key #'car :test-not (complement #'string-equal) :count 1)
+ '(("LOve") ("LOVe") ("LOVE")))
+(equal (remove "love" (list '("Love") '("LOve") '("LOVe") '("LOVE"))
+ :key #'car :test #'string-equal :count 1 :from-end t)
+ '(("Love") ("LOve") ("LOVe")))
+(equal (remove "love" (list '("Love") '("LOve") '("LOVe") '("LOVE"))
+ :key #'car :test-not (complement #'string-equal)
+ :count 1 :from-end t)
+ '(("Love") ("LOve") ("LOVe")))
+(equal (remove "love" (list '("Love") '("LOve") '("LOVe") '("LOVE"))
+ :key #'car :test #'string-equal :count 2 :from-end t)
+ '(("Love") ("LOve")))
+(equal (remove "love" (list '("Love") '("LOve") '("LOVe") '("LOVE"))
+ :key #'car :test-not (complement #'string-equal)
+ :count 2 :from-end t)
+ '(("Love") ("LOve")))
+(equal (remove "love" (list '("Love") '("LOve") '("LOVe") '("LOVE"))
+ :key #'car :test #'string-equal :start 1 :end 3)
+ '(("Love") ("LOVE")))
+(equal (remove "love" (list '("Love") '("LOve") '("LOVe") '("LOVE"))
+ :key #'car :test-not (complement #'string-equal) :start 1 :end 3)
+ '(("Love") ("LOVE")))
+(equal (remove "love" (list '("Love") '("LOve") '("LOVe") '("LOVE"))
+ :key #'car :test #'string-equal :count 1 :start 1 :end 3)
+ '(("Love") ("LOVe") ("LOVE")))
+(equal (remove "love" (list '("Love") '("LOve") '("LOVe") '("LOVE"))
+ :key #'car :test-not (complement #'string-equal)
+ :count 1 :start 1 :end 3)
+ '(("Love") ("LOVe") ("LOVE")))
+(equal (remove "love" (list '("Love") '("LOve") '("LOVe") '("LOVE"))
+ :key #'car :test #'string-equal :count 1 :from-end t
+ :start 1 :end 3)
+ '(("Love") ("LOve") ("LOVE")))
+(equal (remove "love" (list '("Love") '("LOve") '("LOVe") '("LOVE"))
+ :key #'car :test-not (complement #'string-equal)
+ :count 1 :from-end t :start 1 :end 3)
+ '(("Love") ("LOve") ("LOVE")))
+(equal (remove "love" (list '("Love") '("LOve") '("LOVe") '("LOVE"))
+ :key #'car :test #'string-equal :count 10 :from-end t
+ :start 1 :end 3)
+ '(("Love") ("LOVE")))
+(equal (remove "love" (list '("Love") '("LOve") '("LOVe") '("LOVE"))
+ :key #'car :test-not (complement #'string-equal)
+ :count 10 :from-end t :start 1 :end 3)
+ '(("Love") ("LOVE")))
+
+
+(let* ((vector0 (vector 0 1 2 3 4))
+ (vector (remove 3 vector0)))
+ (and (not (eq vector0 vector))
+ (equalp vector0 #(0 1 2 3 4))
+ (equalp vector #(0 1 2 4))))
+(equalp (remove 'a (vector 'a 'b 'c 'a 'b 'c)) #(b c b c))
+(equalp (remove 'b (vector 'a 'b 'c 'a 'b 'c)) #(a c a c))
+(equalp (remove 'c (vector 'a 'b 'c 'a 'b 'c)) #(a b a b))
+(equalp (remove 'a (vector 'a 'a 'a)) #())
+(equalp (remove 'z (vector 'a 'b 'c)) #(a b c))
+(equalp (remove 'a #()) #())
+(equalp (remove 'a (vector 'a 'b 'c 'a 'b 'c) :count 0) #(a b c a b c))
+(equalp (remove 'a (vector 'a 'b 'c 'a 'b 'c) :count 1) #(b c a b c))
+(equalp (remove 'a (vector 'a 'b 'c 'a 'b 'c) :count 1 :from-end t) #(a b c b c))
+(equalp (remove 'a (vector 'a 'b 'c 'a 'b 'c) :count 2) #(b c b c))
+(equalp (remove 'a (vector 'a 'b 'c 'a 'b 'c) :count 2 :from-end t) #(b c b c))
+(equalp (remove 'a (vector 'a 'b 'c 'a 'b 'c) :count 3) #(b c b c))
+(equalp (remove 'a (vector 'a 'b 'c 'a 'b 'c) :count 3 :from-end t) #(b c b c))
+(equalp (remove 'a (vector 'a 'b 'c 'a 'b 'c) :count 4) #(b c b c))
+(equalp (remove 'a (vector 'a 'b 'c 'a 'b 'c) :count 4 :from-end t) #(b c b c))
+(equalp (remove 'a (vector 'a 'b 'c 'a 'b 'c) :count -1) #(a b c a b c))
+(equalp (remove 'a (vector 'a 'b 'c 'a 'b 'c) :count -10) #(a b c a b c))
+(equalp (remove 'a (vector 'a 'b 'c 'a 'b 'c) :count -100) #(a b c a b c))
+(equalp (remove 'a (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1)
+ #(a b c b c b c b c))
+(equalp (remove 'a (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c)
+ :start 1 :count 1)
+ #(a b c b c a b c a b c))
+(equalp (remove 'a (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c)
+ :start 1 :count 2)
+ #(a b c b c b c a b c))
+(equalp (remove 'a (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c)
+ :start 1 :end nil :count 2)
+ #(a b c b c b c a b c))
+(equalp (remove 'a (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8)
+ #(a b c b c b c a b c))
+(equalp (remove 'a (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c)
+ :start 1 :end 8 :count 1)
+ #(a b c b c a b c a b c))
+(equalp (remove 'a (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c)
+ :start 1 :end 8 :count 1 :from-end t)
+ #(a b c a b c b c a b c))
+(equalp (remove 'a (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c)
+ :start 1 :end 8 :count 0 :from-end t)
+ #(a b c a b c a b c a b c))
+(equalp (remove 'a (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c)
+ :start 1 :end 8 :count -100 :from-end t)
+ #(a b c a b c a b c a b c))
+(equalp (remove 'a (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 1)
+ #(a b c a b c a b c a b c))
+(equalp (remove 'a (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 2 :end 2)
+ #(a b c a b c a b c a b c))
+(equalp (remove 'a (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c)
+ :start 12 :end 12)
+ #(a b c a b c a b c a b c))
+(equalp (remove 'a (vector '(a) '(b) '(c) '(a) '(b) '(c)) :key #'car)
+ #((b) (c) (b) (c)))
+(equalp (remove 'a (vector '(a . b) '(b . c) '(c . a)
+ '(a . b) '(b . c) '(c . a))
+ :key #'cdr)
+ #((a . b) (b . c) (a . b) (b . c)))
+(equalp (remove "love" (vector '("Love") '("LOve") '("LOVe") '("LOVE"))
+ :key #'car)
+ #(("Love") ("LOve") ("LOVe") ("LOVE")))
+(equalp (remove "love" (vector '("Love") '("LOve") '("LOVe") '("LOVE"))
+ :key #'car :count -10)
+ #(("Love") ("LOve") ("LOVe") ("LOVE")))
+(equalp (remove "love" (vector '("Love") '("LOve") '("LOVe") '("LOVE"))
+ :key #'car :test #'string-equal)
+ #())
+(equalp (remove "love" (vector '("Love") '("LOve") '("LOVe") '("LOVE"))
+ :key #'car :test-not (complement #'string-equal))
+ #())
+(equalp (remove "love" (vector '("Love") '("LOve") '("LOVe") '("LOVE"))
+ :key #'car :test #'string-equal :count 1)
+ #(("LOve") ("LOVe") ("LOVE")))
+(equalp (remove "love" (vector '("Love") '("LOve") '("LOVe") '("LOVE"))
+ :key #'car :test-not (complement #'string-equal) :count 1)
+ #(("LOve") ("LOVe") ("LOVE")))
+(equalp (remove "love" (vector '("Love") '("LOve") '("LOVe") '("LOVE"))
+ :key #'car :test #'string-equal :count 1 :from-end t)
+ #(("Love") ("LOve") ("LOVe")))
+(equalp (remove "love" (vector '("Love") '("LOve") '("LOVe") '("LOVE"))
+ :key #'car :test-not (complement #'string-equal)
+ :count 1 :from-end t)
+ #(("Love") ("LOve") ("LOVe")))
+(equalp (remove "love" (vector '("Love") '("LOve") '("LOVe") '("LOVE"))
+ :key #'car :test #'string-equal :count 2 :from-end t)
+ #(("Love") ("LOve")))
+(equalp (remove "love" (vector '("Love") '("LOve") '("LOVe") '("LOVE"))
+ :key #'car :test-not (complement #'string-equal)
+ :count 2 :from-end t)
+ #(("Love") ("LOve")))
+(equalp (remove "love" (vector '("Love") '("LOve") '("LOVe") '("LOVE"))
+ :key #'car :test #'string-equal :start 1 :end 3)
+ #(("Love") ("LOVE")))
+(equalp (remove "love" (vector '("Love") '("LOve") '("LOVe") '("LOVE"))
+ :key #'car :test-not (complement #'string-equal) :start 1 :end 3)
+ #(("Love") ("LOVE")))
+(equalp (remove "love" (vector '("Love") '("LOve") '("LOVe") '("LOVE"))
+ :key #'car :test #'string-equal :count 1 :start 1 :end 3)
+ #(("Love") ("LOVe") ("LOVE")))
+(equalp (remove "love" (vector '("Love") '("LOve") '("LOVe") '("LOVE"))
+ :key #'car :test-not (complement #'string-equal)
+ :count 1 :start 1 :end 3)
+ #(("Love") ("LOVe") ("LOVE")))
+(equalp (remove "love" (vector '("Love") '("LOve") '("LOVe") '("LOVE"))
+ :key #'car :test #'string-equal :count 1 :from-end t
+ :start 1 :end 3)
+ #(("Love") ("LOve") ("LOVE")))
+(equalp (remove "love" (vector '("Love") '("LOve") '("LOVe") '("LOVE"))
+ :key #'car :test-not (complement #'string-equal)
+ :count 1 :from-end t :start 1 :end 3)
+ #(("Love") ("LOve") ("LOVE")))
+(equalp (remove "love" (vector '("Love") '("LOve") '("LOVe") '("LOVE"))
+ :key #'car :test #'string-equal :count 10 :from-end t
+ :start 1 :end 3)
+ #(("Love") ("LOVE")))
+(equalp (remove "love" (vector '("Love") '("LOve") '("LOVe") '("LOVE"))
+ :key #'car :test-not (complement #'string-equal)
+ :count 10 :from-end t :start 1 :end 3)
+ #(("Love") ("LOVE")))
+
+(string= (remove #\a (copy-seq "abcabc")) "bcbc")
+(string= (remove #\a (copy-seq "")) "")
+(string= (remove #\a (copy-seq "xyz")) "xyz")
+(string= (remove #\a (copy-seq "ABCABC")) "ABCABC")
+(string= (remove #\a (copy-seq "ABCABC") :key #'char-downcase) "BCBC")
+(string= (remove #\a (copy-seq "abcabc") :count 1) "bcabc")
+(string= (remove #\a (copy-seq "abcabc") :count 1 :from-end t) "abcbc")
+(string= (remove #\a (copy-seq "abcabc") :count 0) "abcabc")
+(string= (remove #\a (copy-seq "abcabc") :count -10) "abcabc")
+(let* ((str0 (copy-seq "abc"))
+ (str (remove #\a str0)))
+ (and (not (eq str0 str))
+ (string= str0 "abc")
+ (string= str "bc")))
+(string= (remove #\a (copy-seq "abcabc") :count 0) "abcabc")
+(string= (remove #\a (copy-seq "abcabc")) "bcbc")
+(string= (remove #\b (copy-seq "abcabc")) "acac")
+(string= (remove #\c (copy-seq "abcabc")) "abab")
+(string= (remove #\a (copy-seq "abcabc") :count 0) "abcabc")
+(string= (remove #\a (copy-seq "abcabc") :count 1) "bcabc")
+(string= (remove #\a (copy-seq "abcabc") :count 1 :from-end t) "abcbc")
+(string= (remove #\a (copy-seq "abcabc") :count 2) "bcbc")
+(string= (remove #\a (copy-seq "abcabc") :count 2 :from-end t) "bcbc")
+(string= (remove #\a (copy-seq "abcabc") :count 3) "bcbc")
+(string= (remove #\a (copy-seq "abcabc") :count 3 :from-end t) "bcbc")
+(string= (remove #\a (copy-seq "abcabc") :count 4) "bcbc")
+(string= (remove #\a (copy-seq "abcabc") :count 4 :from-end t) "bcbc")
+(string= (remove #\a (copy-seq "abcabc") :count -1) "abcabc")
+(string= (remove #\a (copy-seq "abcabc") :count -10) "abcabc")
+(string= (remove #\a (copy-seq "abcabc") :count -100) "abcabc")
+(string= (remove #\a (copy-seq "abcabcabcabc") :start 1) "abcbcbcbc")
+(string= (remove #\a (copy-seq "abcabcabcabc") :start 1 :count 1) "abcbcabcabc")
+(string= (remove #\a (copy-seq "abcabcabcabc") :start 1 :count 2) "abcbcbcabc")
+(string= (remove #\a (copy-seq "abcabcabcabc") :start 1 :end nil :count 2)
+ "abcbcbcabc")
+(string= (remove #\a (copy-seq "abcabcabcabc") :start 1 :end 8) "abcbcbcabc")
+(string= (remove #\a (copy-seq "abcabcabcabc") :start 1 :end 8 :count 1)
+ "abcbcabcabc")
+(string= (remove #\a (copy-seq "abcabcabcabc")
+ :start 1 :end 8 :count 1 :from-end t)
+ "abcabcbcabc")
+(string= (remove #\a (copy-seq "abcabcabcabc")
+ :start 1 :end 8 :count 0 :from-end t)
+ "abcabcabcabc")
+(string= (remove #\a (copy-seq "abcabcabcabc")
+ :start 1 :end 8 :count -100 :from-end t)
+ "abcabcabcabc")
+(string= (remove #\a (copy-seq "abcabcabcabc") :start 1 :end 1)
+ "abcabcabcabc")
+(string= (remove #\a (copy-seq "abcabcabcabc") :start 2 :end 2) "abcabcabcabc")
+(string= (remove #\a (copy-seq "abcabcabcabc") :start 12 :end 12) "abcabcabcabc")
+(equal (remove 0 #*0101) #*11)
+(equal (remove 0 #*01010101 :count 1) #*1010101)
+(equal (remove 0 #*01010101 :count 1 :from-end t) #*0101011)
+(equal (remove 0 #*01010101 :start 1) #*01111)
+(equal (remove 0 #*01010101 :start 1 :end nil) #*01111)
+(equal (remove 0 #*01010101 :start 1 :end 6) #*011101)
+(equal (remove 0 #*01010101 :start 1 :end 6 :count 1) #*0110101)
+(equal (remove 0 #*01010101 :start 1 :end 6 :count 1 :from-end t) #*0101101)
+(equal (remove 0 #*01010101
+ :start 1 :end 6 :count 1 :from-end t
+ :test #'(lambda (a b) (declare (ignore a)) (oddp b)))
+ #*0101001)
+(equal (remove 0 #*01010101
+ :start 1 :end 6 :count 1 :from-end t
+ :test-not #'(lambda (a b) (declare (ignore a)) (evenp b)))
+ #*0101001)
+(equal (remove 0 #*01010101
+ :start 1 :end 6 :count 1 :from-end t
+ :test #'(lambda (a b) (declare (ignore a)) (evenp b)))
+ #*0101101)
+(equal (remove 0 #*01010101
+ :start 1 :end 6 :count 1 :from-end t
+ :test-not #'(lambda (a b) (declare (ignore a)) (oddp b)))
+ #*0101101)
+(equal (remove 0 #*01010101
+ :start 1 :end 6 :count 1 :from-end t
+ :key #'(lambda (arg) (* arg 10))
+ :test #'(lambda (a b) (declare (ignore a)) (> b 1)))
+ #*0101001)
+
+
+(let* ((list0 (list 0 1 2 3 4))
+ (list (remove-if #'(lambda (arg) (eql arg 3)) list0)))
+ (and (not (eq list0 list))
+ (equal list0 '(0 1 2 3 4))
+ (equal list '(0 1 2 4))))
+(equal (remove-if #'(lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c))
+ '(b c b c))
+(equal (remove-if #'(lambda (arg) (eql arg 'b)) (list 'a 'b 'c 'a 'b 'c))
+ '(a c a c))
+(equal (remove-if #'(lambda (arg) (eql arg 'c)) (list 'a 'b 'c 'a 'b 'c))
+ '(a b a b))
+(equal (remove-if #'(lambda (arg) (eql arg 'a)) (list 'a 'a 'a)) '())
+(equal (remove-if #'(lambda (arg) (eql arg 'z)) (list 'a 'b 'c)) '(a b c))
+(equal (remove-if #'(lambda (arg) (eql arg 'a)) '()) '())
+(equal (remove-if #'(lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c)
+ :count 0) '(a b c a b c))
+(equal (remove-if #'(lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c)
+ :count 1) '(b c a b c))
+(equal (remove-if #'(lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c)
+ :count 1 :from-end t) '(a b c b c))
+(equal (remove-if #'(lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c)
+ :count 2) '(b c b c))
+(equal (remove-if #'(lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c)
+ :count 2 :from-end t) '(b c b c))
+(equal (remove-if #'(lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c)
+ :count 3) '(b c b c))
+(equal (remove-if #'(lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c)
+ :count 3 :from-end t) '(b c b c))
+(equal (remove-if #'(lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c)
+ :count 4) '(b c b c))
+(equal (remove-if #'(lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c)
+ :count 4 :from-end t) '(b c b c))
+(equal (remove-if #'(lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c)
+ :count -1) '(a b c a b c))
+(equal (remove-if #'(lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c)
+ :count -10) '(a b c a b c))
+(equal (remove-if #'(lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c)
+ :count -100) '(a b c a b c))
+(equal (remove-if #'(lambda (arg) (eql arg 'a))
+ (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1)
+ '(a b c b c b c b c))
+(equal (remove-if #'(lambda (arg) (eql arg 'a))
+ (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :count 1)
+ '(a b c b c a b c a b c))
+(equal (remove-if #'(lambda (arg) (eql arg 'a))
+ (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :count 2)
+ '(a b c b c b c a b c))
+(equal (remove-if #'(lambda (arg) (eql arg 'a))
+ (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c)
+ :start 1 :end nil :count 2)
+ '(a b c b c b c a b c))
+(equal (remove-if #'(lambda (arg) (eql arg 'a))
+ (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8)
+ '(a b c b c b c a b c))
+(equal (remove-if #'(lambda (arg) (eql arg 'a))
+ (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c)
+ :start 1 :end 8 :count 1)
+ '(a b c b c a b c a b c))
+(equal (remove-if #'(lambda (arg) (eql arg 'a))
+ (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c)
+ :start 1 :end 8 :count 1 :from-end t)
+ '(a b c a b c b c a b c))
+(equal (remove-if #'(lambda (arg) (eql arg 'a))
+ (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c)
+ :start 1 :end 8 :count 0 :from-end t)
+ '(a b c a b c a b c a b c))
+(equal (remove-if #'(lambda (arg) (eql arg 'a))
+ (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c)
+ :start 1 :end 8 :count -100 :from-end t)
+ '(a b c a b c a b c a b c))
+(equal (remove-if #'(lambda (arg) (eql arg 'a))
+ (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 1)
+ '(a b c a b c a b c a b c))
+(equal (remove-if #'(lambda (arg) (eql arg 'a))
+ (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 2 :end 2)
+ '(a b c a b c a b c a b c))
+(equal (remove-if #'(lambda (arg) (eql arg 'a))
+ (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c)
+ :start 12 :end 12)
+ '(a b c a b c a b c a b c))
+(equal (remove-if #'(lambda (arg) (eql arg 'a))
+ (list '(a) '(b) '(c) '(a) '(b) '(c)) :key #'car)
+ '((b) (c) (b) (c)))
+(equal (remove-if #'(lambda (arg) (eql arg 'a))
+ (list '(a . b) '(b . c) '(c . a)
+ '(a . b) '(b . c) '(c . a))
+ :key #'cdr)
+ '((a . b) (b . c) (a . b) (b . c)))
+(equal (remove-if #'(lambda (arg) (eql arg "love"))
+ (list '("Love") '("LOve") '("LOVe") '("LOVE"))
+ :key #'car)
+ '(("Love") ("LOve") ("LOVe") ("LOVE")))
+(equal (remove-if #'(lambda (arg) (eql arg "love"))
+ (list '("Love") '("LOve") '("LOVe") '("LOVE"))
+ :key #'car :count -10)
+ '(("Love") ("LOve") ("LOVe") ("LOVE")))
+(equal (remove-if #'(lambda (arg) (string-equal arg "love"))
+ (list '("Love") '("LOve") '("LOVe") '("LOVE"))
+ :key #'car)
+ '())
+(equal (remove-if #'(lambda (arg) (string-equal arg "love"))
+ (list '("Love") '("LOve") '("LOVe") '("LOVE"))
+ :key #'car :count 1)
+ '(("LOve") ("LOVe") ("LOVE")))
+(equal (remove-if #'(lambda (arg) (string-equal arg "love"))
+ (list '("Love") '("LOve") '("LOVe") '("LOVE"))
+ :key #'car :count 1 :from-end t)
+ '(("Love") ("LOve") ("LOVe")))
+(equal (remove-if #'(lambda (arg) (string-equal arg "love"))
+ (list '("Love") '("LOve") '("LOVe") '("LOVE"))
+ :key #'car :count 2 :from-end t)
+ '(("Love") ("LOve")))
+(equal (remove-if #'(lambda (arg) (string-equal arg "love"))
+ (list '("Love") '("LOve") '("LOVe") '("LOVE"))
+ :key #'car :start 1 :end 3)
+ '(("Love") ("LOVE")))
+(equal (remove-if #'(lambda (arg) (string-equal arg "love"))
+ (list '("Love") '("LOve") '("LOVe") '("LOVE"))
+ :key #'car :count 1 :start 1 :end 3)
+ '(("Love") ("LOVe") ("LOVE")))
+(equal (remove-if #'(lambda (arg) (string-equal arg "love"))
+ (list '("Love") '("LOve") '("LOVe") '("LOVE"))
+ :key #'car :count 1 :from-end t
+ :start 1 :end 3)
+ '(("Love") ("LOve") ("LOVE")))
+(equal (remove-if #'(lambda (arg) (string-equal arg "love"))
+ (list '("Love") '("LOve") '("LOVe") '("LOVE"))
+ :key #'car :count 10 :from-end t :start 1 :end 3)
+ '(("Love") ("LOVE")))
+
+
+(let* ((vector0 (vector 0 1 2 3 4))
+ (vector (remove-if #'(lambda (arg) (eql arg 3)) vector0)))
+ (and (not (eq vector0 vector))
+ (equalp vector0 #(0 1 2 3 4))
+ (equalp vector #(0 1 2 4))))
+(equalp (remove-if #'(lambda (arg) (eql arg 'a))
+ (vector 'a 'b 'c 'a 'b 'c)) #(b c b c))
+(equalp (remove-if #'(lambda (arg) (eql arg 'b))
+ (vector 'a 'b 'c 'a 'b 'c)) #(a c a c))
+(equalp (remove-if #'(lambda (arg) (eql arg 'c))
+ (vector 'a 'b 'c 'a 'b 'c)) #(a b a b))
+(equalp (remove-if #'(lambda (arg) (eql arg 'a))
+ (vector 'a 'a 'a)) #())
+(equalp (remove-if #'(lambda (arg) (eql arg 'z))
+ (vector 'a 'b 'c)) #(a b c))
+(equalp (remove-if #'(lambda (arg) (eql arg 'a)) #()) #())
+(equalp (remove-if #'(lambda (arg) (eql arg 'a))
+ (vector 'a 'b 'c 'a 'b 'c) :count 0) #(a b c a b c))
+(equalp (remove-if #'(lambda (arg) (eql arg 'a))
+ (vector 'a 'b 'c 'a 'b 'c) :count 1) #(b c a b c))
+(equalp (remove-if #'(lambda (arg) (eql arg 'a))
+ (vector 'a 'b 'c 'a 'b 'c) :count 1 :from-end t) #(a b c b c))
+(equalp (remove-if #'(lambda (arg) (eql arg 'a))
+ (vector 'a 'b 'c 'a 'b 'c) :count 2) #(b c b c))
+(equalp (remove-if #'(lambda (arg) (eql arg 'a))
+ (vector 'a 'b 'c 'a 'b 'c) :count 2 :from-end t) #(b c b c))
+(equalp (remove-if #'(lambda (arg) (eql arg 'a))
+ (vector 'a 'b 'c 'a 'b 'c) :count 3) #(b c b c))
+(equalp (remove-if #'(lambda (arg) (eql arg 'a))
+ (vector 'a 'b 'c 'a 'b 'c) :count 3 :from-end t) #(b c b c))
+(equalp (remove-if #'(lambda (arg) (eql arg 'a))
+ (vector 'a 'b 'c 'a 'b 'c) :count 4) #(b c b c))
+(equalp (remove-if #'(lambda (arg) (eql arg 'a))
+ (vector 'a 'b 'c 'a 'b 'c) :count 4 :from-end t) #(b c b c))
+(equalp (remove-if #'(lambda (arg) (eql arg 'a))
+ (vector 'a 'b 'c 'a 'b 'c) :count -1) #(a b c a b c))
+(equalp (remove-if #'(lambda (arg) (eql arg 'a))
+ (vector 'a 'b 'c 'a 'b 'c) :count -10) #(a b c a b c))
+(equalp (remove-if #'(lambda (arg) (eql arg 'a))
+ (vector 'a 'b 'c 'a 'b 'c) :count -100) #(a b c a b c))
+(equalp (remove-if #'(lambda (arg) (eql arg 'a))
+ (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1)
+ #(a b c b c b c b c))
+(equalp (remove-if #'(lambda (arg) (eql arg 'a))
+ (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c)
+ :start 1 :count 1)
+ #(a b c b c a b c a b c))
+(equalp (remove-if #'(lambda (arg) (eql arg 'a))
+ (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c)
+ :start 1 :count 2)
+ #(a b c b c b c a b c))
+(equalp (remove-if #'(lambda (arg) (eql arg 'a))
+ (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c)
+ :start 1 :end nil :count 2)
+ #(a b c b c b c a b c))
+(equalp (remove-if #'(lambda (arg) (eql arg 'a))
+ (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8)
+ #(a b c b c b c a b c))
+(equalp (remove-if #'(lambda (arg) (eql arg 'a))
+ (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c)
+ :start 1 :end 8 :count 1)
+ #(a b c b c a b c a b c))
+(equalp (remove-if #'(lambda (arg) (eql arg 'a))
+ (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c)
+ :start 1 :end 8 :count 1 :from-end t)
+ #(a b c a b c b c a b c))
+(equalp (remove-if #'(lambda (arg) (eql arg 'a))
+ (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c)
+ :start 1 :end 8 :count 0 :from-end t)
+ #(a b c a b c a b c a b c))
+(equalp (remove-if #'(lambda (arg) (eql arg 'a))
+ (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c)
+ :start 1 :end 8 :count -100 :from-end t)
+ #(a b c a b c a b c a b c))
+(equalp (remove-if #'(lambda (arg) (eql arg 'a))
+ (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 1)
+ #(a b c a b c a b c a b c))
+(equalp (remove-if #'(lambda (arg) (eql arg 'a))
+ (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 2 :end 2)
+ #(a b c a b c a b c a b c))
+(equalp (remove-if #'(lambda (arg) (eql arg 'a))
+ (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c)
+ :start 12 :end 12)
+ #(a b c a b c a b c a b c))
+(equalp (remove-if #'(lambda (arg) (eql arg 'a))
+ (vector '(a) '(b) '(c) '(a) '(b) '(c)) :key #'car)
+ #((b) (c) (b) (c)))
+(equalp (remove-if #'(lambda (arg) (eql arg 'a))
+ (vector '(a . b) '(b . c) '(c . a)
+ '(a . b) '(b . c) '(c . a))
+ :key #'cdr)
+ #((a . b) (b . c) (a . b) (b . c)))
+(equalp (remove-if #'(lambda (arg) (eql arg "love"))
+ (vector '("Love") '("LOve") '("LOVe") '("LOVE"))
+ :key #'car)
+ #(("Love") ("LOve") ("LOVe") ("LOVE")))
+(equalp (remove-if #'(lambda (arg) (eql arg "love"))
+ (vector '("Love") '("LOve") '("LOVe") '("LOVE"))
+ :key #'car :count -10)
+ #(("Love") ("LOve") ("LOVe") ("LOVE")))
+(equalp (remove-if #'(lambda (arg) (string-equal arg "love"))
+ (vector '("Love") '("LOve") '("LOVe") '("LOVE"))
+ :key #'car)
+ #())
+(equalp (remove-if #'(lambda (arg) (string-equal arg "love"))
+ (vector '("Love") '("LOve") '("LOVe") '("LOVE"))
+ :key #'car)
+ #())
+(equalp (remove-if #'(lambda (arg) (string-equal arg "love"))
+ (vector '("Love") '("LOve") '("LOVe") '("LOVE"))
+ :key #'car :count 1)
+ #(("LOve") ("LOVe") ("LOVE")))
+(equalp (remove-if #'(lambda (arg) (string-equal arg "love"))
+ (vector '("Love") '("LOve") '("LOVe") '("LOVE"))
+ :key #'car :count 1)
+ #(("LOve") ("LOVe") ("LOVE")))
+(equalp (remove-if #'(lambda (arg) (string-equal arg "love"))
+ (vector '("Love") '("LOve") '("LOVe") '("LOVE"))
+ :key #'car :count 1 :from-end t)
+ #(("Love") ("LOve") ("LOVe")))
+(equalp (remove-if #'(lambda (arg) (string-equal arg "love"))
+ (vector '("Love") '("LOve") '("LOVe") '("LOVE"))
+ :key #'car :count 1 :from-end t)
+ #(("Love") ("LOve") ("LOVe")))
+(equalp (remove-if #'(lambda (arg) (string-equal arg "love"))
+ (vector '("Love") '("LOve") '("LOVe") '("LOVE"))
+ :key #'car :count 2 :from-end t)
+ #(("Love") ("LOve")))
+(equalp (remove-if #'(lambda (arg) (string-equal arg "love"))
+ (vector '("Love") '("LOve") '("LOVe") '("LOVE"))
+ :key #'car :count 2 :from-end t)
+ #(("Love") ("LOve")))
+(equalp (remove-if #'(lambda (arg) (string-equal arg "love"))
+ (vector '("Love") '("LOve") '("LOVe") '("LOVE"))
+ :key #'car :start 1 :end 3)
+ #(("Love") ("LOVE")))
+(equalp (remove-if #'(lambda (arg) (string-equal arg "love"))
+ (vector '("Love") '("LOve") '("LOVe") '("LOVE"))
+ :key #'car :count 1 :start 1 :end 3)
+ #(("Love") ("LOVe") ("LOVE")))
+(equalp (remove-if #'(lambda (arg) (string-equal arg "love"))
+ (vector '("Love") '("LOve") '("LOVe") '("LOVE"))
+ :key #'car :count 1 :from-end t
+ :start 1 :end 3)
+ #(("Love") ("LOve") ("LOVE")))
+(equalp (remove-if #'(lambda (arg) (string-equal arg "love"))
+ (vector '("Love") '("LOve") '("LOVe") '("LOVE"))
+ :key #'car :count 10 :from-end t
+ :start 1 :end 3)
+ #(("Love") ("LOVE")))
+
+(string= (remove-if #'(lambda (arg) (string-equal arg #\a)) (copy-seq "abcabc"))
+ "bcbc")
+(string= (remove-if #'(lambda (arg) (string-equal arg #\a)) (copy-seq "")) "")
+(string= (remove-if #'(lambda (arg) (string-equal arg #\a)) (copy-seq "xyz"))
+ "xyz")
+(string= (remove-if #'(lambda (arg) (string-equal arg #\a)) (copy-seq "ABCABC")
+ :key #'char-downcase) "BCBC")
+(string= (remove-if #'(lambda (arg) (string-equal arg #\a)) (copy-seq "abcabc")
+ :count 1) "bcabc")
+(string= (remove-if #'(lambda (arg) (string-equal arg #\a)) (copy-seq "abcabc")
+ :count 1 :from-end t) "abcbc")
+(string= (remove-if #'(lambda (arg) (string-equal arg #\a)) (copy-seq "abcabc")
+ :count 0) "abcabc")
+(string= (remove-if #'(lambda (arg) (string-equal arg #\a)) (copy-seq "abcabc")
+ :count -10) "abcabc")
+(let* ((str0 (copy-seq "abc"))
+ (str (remove-if #'(lambda (arg) (string-equal arg #\a)) str0)))
+ (and (not (eq str0 str))
+ (string= str0 "abc")
+ (string= str "bc")))
+(string= (remove-if #'(lambda (arg) (string-equal arg #\a)) (copy-seq "abcabc")
+ :count 0) "abcabc")
+(string= (remove-if #'(lambda (arg) (string-equal arg #\a)) (copy-seq "abcabc"))
+ "bcbc")
+(string= (remove-if #'(lambda (arg) (string-equal arg #\b)) (copy-seq "abcabc"))
+ "acac")
+(string= (remove-if #'(lambda (arg) (string-equal arg #\c)) (copy-seq "abcabc"))
+ "abab")
+(string= (remove-if #'(lambda (arg) (string-equal arg #\a)) (copy-seq "abcabc")
+ :count 0) "abcabc")
+(string= (remove-if #'(lambda (arg) (string-equal arg #\a)) (copy-seq "abcabc")
+ :count 1) "bcabc")
+(string= (remove-if #'(lambda (arg) (string-equal arg #\a)) (copy-seq "abcabc")
+ :count 1 :from-end t) "abcbc")
+(string= (remove-if #'(lambda (arg) (string-equal arg #\a)) (copy-seq "abcabc")
+ :count 2) "bcbc")
+(string= (remove-if #'(lambda (arg) (string-equal arg #\a)) (copy-seq "abcabc")
+ :count 2 :from-end t) "bcbc")
+(string= (remove-if #'(lambda (arg) (string-equal arg #\a)) (copy-seq "abcabc")
+ :count 3) "bcbc")
+(string= (remove-if #'(lambda (arg) (string-equal arg #\a)) (copy-seq "abcabc")
+ :count 3 :from-end t) "bcbc")
+(string= (remove-if #'(lambda (arg) (string-equal arg #\a)) (copy-seq "abcabc")
+ :count 4) "bcbc")
+(string= (remove-if #'(lambda (arg) (string-equal arg #\a)) (copy-seq "abcabc")
+ :count 4 :from-end t) "bcbc")
+(string= (remove-if #'(lambda (arg) (string-equal arg #\a)) (copy-seq "abcabc")
+ :count -1) "abcabc")
+(string= (remove-if #'(lambda (arg) (string-equal arg #\a)) (copy-seq "abcabc")
+ :count -10) "abcabc")
+(string= (remove-if #'(lambda (arg) (string-equal arg #\a)) (copy-seq "abcabc")
+ :count -100) "abcabc")
+(string= (remove-if #'(lambda (arg) (string-equal arg #\a))
+ (copy-seq "abcabcabcabc") :start 1) "abcbcbcbc")
+(string= (remove-if #'(lambda (arg) (string-equal arg #\a))
+ (copy-seq "abcabcabcabc") :start 1 :count 1) "abcbcabcabc")
+(string= (remove-if #'(lambda (arg) (eql arg #\a)) (copy-seq "abcabcabcabc")
+ :start 1 :count 2)
+ "abcbcbcabc")
+(string= (remove-if #'(lambda (arg) (eql arg #\a)) (copy-seq "abcabcabcabc")
+ :start 1 :end nil :count 2)
+ "abcbcbcabc")
+(string= (remove-if #'(lambda (arg) (eql arg #\a)) (copy-seq "abcabcabcabc")
+ :start 1 :end 8) "abcbcbcabc")
+(string= (remove-if #'(lambda (arg) (eql arg #\a)) (copy-seq "abcabcabcabc")
+ :start 1 :end 8 :count 1)
+ "abcbcabcabc")
+(string= (remove-if #'(lambda (arg) (eql arg #\a)) (copy-seq "abcabcabcabc")
+ :start 1 :end 8 :count 1 :from-end t)
+ "abcabcbcabc")
+(string= (remove-if #'(lambda (arg) (eql arg #\a)) (copy-seq "abcabcabcabc")
+ :start 1 :end 8 :count 0 :from-end t)
+ "abcabcabcabc")
+(string= (remove-if #'(lambda (arg) (eql arg #\a)) (copy-seq "abcabcabcabc")
+ :start 1 :end 8 :count -100 :from-end t)
+ "abcabcabcabc")
+(string= (remove-if #'(lambda (arg) (eql arg #\a)) (copy-seq "abcabcabcabc")
+ :start 1 :end 1)
+ "abcabcabcabc")
+(string= (remove-if #'(lambda (arg) (eql arg #\a)) (copy-seq "abcabcabcabc")
+ :start 2 :end 2) "abcabcabcabc")
+(string= (remove-if #'(lambda (arg) (eql arg #\a)) (copy-seq "abcabcabcabc")
+ :start 12 :end 12) "abcabcabcabc")
+(equal (remove-if #'zerop #*0101) #*11)
+(equal (remove-if #'zerop #*01010101 :count 1) #*1010101)
+(equal (remove-if #'zerop #*01010101 :count 1 :from-end t) #*0101011)
+(equal (remove-if #'zerop #*01010101 :start 1) #*01111)
+(equal (remove-if #'zerop #*01010101 :start 1 :end nil) #*01111)
+(equal (remove-if #'zerop #*01010101 :start 1 :end 6) #*011101)
+(equal (remove-if #'zerop #*01010101 :start 1 :end 6 :count 1) #*0110101)
+(equal (remove-if #'zerop #*01010101 :start 1 :end 6 :count 1 :from-end t)
+ #*0101101)
+(equal (remove-if #'oddp #*01010101 :start 1 :end 6 :count 1 :from-end t)
+ #*0101001)
+(equal (remove-if #'evenp #*01010101 :start 1 :end 6 :count 1 :from-end t)
+ #*0101101)
+(equal (remove-if #'plusp #*01010101
+ :start 1 :end 6 :count 1 :from-end t
+ :key #'(lambda (arg) (* arg 10)))
+ #*0101001)
+
+
+(let* ((list0 (list 0 1 2 3 4))
+ (list (remove-if-not #'(lambda (arg) (not (eql arg 3))) list0)))
+ (and (not (eq list0 list))
+ (equal list0 '(0 1 2 3 4))
+ (equal list '(0 1 2 4))))
+(equal (remove-if-not #'(lambda (arg) (not (eql arg 'a)))
+ (list 'a 'b 'c 'a 'b 'c))
+ '(b c b c))
+(equal (remove-if-not #'(lambda (arg) (not (eql arg 'b)))
+ (list 'a 'b 'c 'a 'b 'c))
+ '(a c a c))
+(equal (remove-if-not #'(lambda (arg) (not (eql arg 'c)))
+ (list 'a 'b 'c 'a 'b 'c))
+ '(a b a b))
+(equal (remove-if-not #'(lambda (arg) (not (eql arg 'a)))
+ (list 'a 'a 'a)) '())
+(equal (remove-if-not #'(lambda (arg) (not (eql arg 'z)))
+ (list 'a 'b 'c)) '(a b c))
+(equal (remove-if-not #'(lambda (arg) (not (eql arg 'a))) '()) '())
+(equal (remove-if-not #'(lambda (arg) (not (eql arg 'a)))
+ (list 'a 'b 'c 'a 'b 'c) :count 0) '(a b c a b c))
+(equal (remove-if-not #'(lambda (arg) (not (eql arg 'a)))
+ (list 'a 'b 'c 'a 'b 'c) :count 1) '(b c a b c))
+(equal (remove-if-not #'(lambda (arg) (not (eql arg 'a)))
+ (list 'a 'b 'c 'a 'b 'c) :count 1 :from-end t)
+ '(a b c b c))
+(equal (remove-if-not #'(lambda (arg) (not (eql arg 'a)))
+ (list 'a 'b 'c 'a 'b 'c) :count 2)
+ '(b c b c))
+(equal (remove-if-not #'(lambda (arg) (not (eql arg 'a)))
+ (list 'a 'b 'c 'a 'b 'c) :count 2 :from-end t)
+ '(b c b c))
+(equal (remove-if-not #'(lambda (arg) (not (eql arg 'a)))
+ (list 'a 'b 'c 'a 'b 'c) :count 3)
+ '(b c b c))
+(equal (remove-if-not #'(lambda (arg) (not (eql arg 'a)))
+ (list 'a 'b 'c 'a 'b 'c) :count 3 :from-end t)
+ '(b c b c))
+(equal (remove-if-not #'(lambda (arg) (not (eql arg 'a)))
+ (list 'a 'b 'c 'a 'b 'c) :count 4)
+ '(b c b c))
+(equal (remove-if-not #'(lambda (arg) (not (eql arg 'a)))
+ (list 'a 'b 'c 'a 'b 'c) :count 4 :from-end t)
+ '(b c b c))
+(equal (remove-if-not #'(lambda (arg) (not (eql arg 'a)))
+ (list 'a 'b 'c 'a 'b 'c) :count -1)
+ '(a b c a b c))
+(equal (remove-if-not #'(lambda (arg) (not (eql arg 'a)))
+ (list 'a 'b 'c 'a 'b 'c) :count -10)
+ '(a b c a b c))
+(equal (remove-if-not #'(lambda (arg) (not (eql arg 'a)))
+ (list 'a 'b 'c 'a 'b 'c) :count -100)
+ '(a b c a b c))
+(equal (remove-if-not #'(lambda (arg) (not (eql arg 'a)))
+ (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1)
+ '(a b c b c b c b c))
+(equal (remove-if-not #'(lambda (arg) (not (eql arg 'a)))
+ (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c)
+ :start 1 :count 1)
+ '(a b c b c a b c a b c))
+(equal (remove-if-not #'(lambda (arg) (not (eql arg 'a)))
+ (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c)
+ :start 1 :count 2)
+ '(a b c b c b c a b c))
+(equal (remove-if-not #'(lambda (arg) (not (eql arg 'a)))
+ (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c)
+ :start 1 :end nil :count 2)
+ '(a b c b c b c a b c))
+(equal (remove-if-not #'(lambda (arg) (not (eql arg 'a)))
+ (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8)
+ '(a b c b c b c a b c))
+(equal (remove-if-not #'(lambda (arg) (not (eql arg 'a)))
+ (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c)
+ :start 1 :end 8 :count 1)
+ '(a b c b c a b c a b c))
+(equal (remove-if-not #'(lambda (arg) (not (eql arg 'a)))
+ (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c)
+ :start 1 :end 8 :count 1 :from-end t)
+ '(a b c a b c b c a b c))
+(equal (remove-if-not #'(lambda (arg) (not (eql arg 'a)))
+ (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c)
+ :start 1 :end 8 :count 0 :from-end t)
+ '(a b c a b c a b c a b c))
+(equal (remove-if-not #'(lambda (arg) (not (eql arg 'a)))
+ (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c)
+ :start 1 :end 8 :count -100 :from-end t)
+ '(a b c a b c a b c a b c))
+(equal (remove-if-not #'(lambda (arg) (not (eql arg 'a)))
+ (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 1)
+ '(a b c a b c a b c a b c))
+(equal (remove-if-not #'(lambda (arg) (not (eql arg 'a)))
+ (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 2 :end 2)
+ '(a b c a b c a b c a b c))
+(equal (remove-if-not #'(lambda (arg) (not (eql arg 'a)))
+ (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c)
+ :start 12 :end 12)
+ '(a b c a b c a b c a b c))
+(equal (remove-if-not #'(lambda (arg) (not (eql arg 'a)))
+ (list '(a) '(b) '(c) '(a) '(b) '(c)) :key #'car)
+ '((b) (c) (b) (c)))
+(equal (remove-if-not #'(lambda (arg) (not (eql arg 'a)))
+ (list '(a . b) '(b . c) '(c . a)
+ '(a . b) '(b . c) '(c . a))
+ :key #'cdr)
+ '((a . b) (b . c) (a . b) (b . c)))
+(equal (remove-if-not #'(lambda (arg) (not (eql arg "love")))
+ (list '("Love") '("LOve") '("LOVe") '("LOVE"))
+ :key #'car)
+ '(("Love") ("LOve") ("LOVe") ("LOVE")))
+(equal (remove-if-not #'(lambda (arg) (not (eql arg "love")))
+ (list '("Love") '("LOve") '("LOVe") '("LOVE"))
+ :key #'car :count -10)
+ '(("Love") ("LOve") ("LOVe") ("LOVE")))
+(equal (remove-if-not #'(lambda (arg) (not (string-equal arg "love")))
+ (list '("Love") '("LOve") '("LOVe") '("LOVE"))
+ :key #'car)
+ '())
+(equal (remove-if-not #'(lambda (arg) (not (string-equal arg "love")))
+ (list '("Love") '("LOve") '("LOVe") '("LOVE"))
+ :key #'car :count 1)
+ '(("LOve") ("LOVe") ("LOVE")))
+(equal (remove-if-not #'(lambda (arg) (not (string-equal arg "love")))
+ (list '("Love") '("LOve") '("LOVe") '("LOVE"))
+ :key #'car :count 1 :from-end t)
+ '(("Love") ("LOve") ("LOVe")))
+(equal (remove-if-not #'(lambda (arg) (not (string-equal arg "love")))
+ (list '("Love") '("LOve") '("LOVe") '("LOVE"))
+ :key #'car :count 2 :from-end t)
+ '(("Love") ("LOve")))
+(equal (remove-if-not #'(lambda (arg) (not (string-equal arg "love")))
+ (list '("Love") '("LOve") '("LOVe") '("LOVE"))
+ :key #'car :start 1 :end 3)
+ '(("Love") ("LOVE")))
+(equal (remove-if-not #'(lambda (arg) (not (string-equal arg "love")))
+ (list '("Love") '("LOve") '("LOVe") '("LOVE"))
+ :key #'car :count 1 :start 1 :end 3)
+ '(("Love") ("LOVe") ("LOVE")))
+(equal (remove-if-not #'(lambda (arg) (not (string-equal arg "love")))
+ (list '("Love") '("LOve") '("LOVe") '("LOVE"))
+ :key #'car :count 1 :from-end t
+ :start 1 :end 3)
+ '(("Love") ("LOve") ("LOVE")))
+(equal (remove-if-not #'(lambda (arg) (not (string-equal arg "love")))
+ (list '("Love") '("LOve") '("LOVe") '("LOVE"))
+ :key #'car :count 10 :from-end t :start 1 :end 3)
+ '(("Love") ("LOVE")))
+
+
+(let* ((vector0 (vector 0 1 2 3 4))
+ (vector (remove-if-not #'(lambda (arg) (not (eql arg 3))) vector0)))
+ (and (not (eq vector0 vector))
+ (equalp vector0 #(0 1 2 3 4))
+ (equalp vector #(0 1 2 4))))
+(equalp (remove-if-not #'(lambda (arg) (not (eql arg 'a)))
+ (vector 'a 'b 'c 'a 'b 'c)) #(b c b c))
+(equalp (remove-if-not #'(lambda (arg) (not (eql arg 'b)))
+ (vector 'a 'b 'c 'a 'b 'c)) #(a c a c))
+(equalp (remove-if-not #'(lambda (arg) (not (eql arg 'c)))
+ (vector 'a 'b 'c 'a 'b 'c)) #(a b a b))
+(equalp (remove-if-not #'(lambda (arg) (not (eql arg 'a)))
+ (vector 'a 'a 'a)) #())
+(equalp (remove-if-not #'(lambda (arg) (not (eql arg 'z)))
+ (vector 'a 'b 'c)) #(a b c))
+(equalp (remove-if-not #'(lambda (arg) (not (eql arg 'a))) #()) #())
+(equalp (remove-if-not #'(lambda (arg) (not (eql arg 'a)))
+ (vector 'a 'b 'c 'a 'b 'c) :count 0) #(a b c a b c))
+(equalp (remove-if-not #'(lambda (arg) (not (eql arg 'a)))
+ (vector 'a 'b 'c 'a 'b 'c) :count 1) #(b c a b c))
+(equalp (remove-if-not #'(lambda (arg) (not (eql arg 'a)))
+ (vector 'a 'b 'c 'a 'b 'c) :count 1 :from-end t) #(a b c b c))
+(equalp (remove-if-not #'(lambda (arg) (not (eql arg 'a)))
+ (vector 'a 'b 'c 'a 'b 'c) :count 2) #(b c b c))
+(equalp (remove-if-not #'(lambda (arg) (not (eql arg 'a)))
+ (vector 'a 'b 'c 'a 'b 'c) :count 2 :from-end t) #(b c b c))
+(equalp (remove-if-not #'(lambda (arg) (not (eql arg 'a)))
+ (vector 'a 'b 'c 'a 'b 'c) :count 3) #(b c b c))
+(equalp (remove-if-not #'(lambda (arg) (not (eql arg 'a)))
+ (vector 'a 'b 'c 'a 'b 'c) :count 3 :from-end t) #(b c b c))
+(equalp (remove-if-not #'(lambda (arg) (not (eql arg 'a)))
+ (vector 'a 'b 'c 'a 'b 'c) :count 4) #(b c b c))
+(equalp (remove-if-not #'(lambda (arg) (not (eql arg 'a)))
+ (vector 'a 'b 'c 'a 'b 'c) :count 4 :from-end t) #(b c b c))
+(equalp (remove-if-not #'(lambda (arg) (not (eql arg 'a)))
+ (vector 'a 'b 'c 'a 'b 'c) :count -1) #(a b c a b c))
+(equalp (remove-if-not #'(lambda (arg) (not (eql arg 'a)))
+ (vector 'a 'b 'c 'a 'b 'c) :count -10) #(a b c a b c))
+(equalp (remove-if-not #'(lambda (arg) (not (eql arg 'a)))
+ (vector 'a 'b 'c 'a 'b 'c) :count -100) #(a b c a b c))
+(equalp (remove-if-not #'(lambda (arg) (not (eql arg 'a)))
+ (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1)
+ #(a b c b c b c b c))
+(equalp (remove-if-not #'(lambda (arg) (not (eql arg 'a)))
+ (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c)
+ :start 1 :count 1)
+ #(a b c b c a b c a b c))
+(equalp (remove-if-not #'(lambda (arg) (not (eql arg 'a)))
+ (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c)
+ :start 1 :count 2)
+ #(a b c b c b c a b c))
+(equalp (remove-if-not #'(lambda (arg) (not (eql arg 'a)))
+ (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c)
+ :start 1 :end nil :count 2)
+ #(a b c b c b c a b c))
+(equalp (remove-if-not #'(lambda (arg) (not (eql arg 'a)))
+ (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8)
+ #(a b c b c b c a b c))
+(equalp (remove-if-not #'(lambda (arg) (not (eql arg 'a)))
+ (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c)
+ :start 1 :end 8 :count 1)
+ #(a b c b c a b c a b c))
+(equalp (remove-if-not #'(lambda (arg) (not (eql arg 'a)))
+ (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c)
+ :start 1 :end 8 :count 1 :from-end t)
+ #(a b c a b c b c a b c))
+(equalp (remove-if-not #'(lambda (arg) (not (eql arg 'a)))
+ (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c)
+ :start 1 :end 8 :count 0 :from-end t)
+ #(a b c a b c a b c a b c))
+(equalp (remove-if-not #'(lambda (arg) (not (eql arg 'a)))
+ (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c)
+ :start 1 :end 8 :count -100 :from-end t)
+ #(a b c a b c a b c a b c))
+(equalp (remove-if-not #'(lambda (arg) (not (eql arg 'a)))
+ (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 1)
+ #(a b c a b c a b c a b c))
+(equalp (remove-if-not #'(lambda (arg) (not (eql arg 'a)))
+ (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 2 :end 2)
+ #(a b c a b c a b c a b c))
+(equalp (remove-if-not #'(lambda (arg) (not (eql arg 'a)))
+ (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c)
+ :start 12 :end 12)
+ #(a b c a b c a b c a b c))
+(equalp (remove-if-not #'(lambda (arg) (not (eql arg 'a)))
+ (vector '(a) '(b) '(c) '(a) '(b) '(c)) :key #'car)
+ #((b) (c) (b) (c)))
+(equalp (remove-if-not #'(lambda (arg) (not (eql arg 'a)))
+ (vector '(a . b) '(b . c) '(c . a)
+ '(a . b) '(b . c) '(c . a))
+ :key #'cdr)
+ #((a . b) (b . c) (a . b) (b . c)))
+(equalp (remove-if-not #'(lambda (arg) (not (eql arg "love")))
+ (vector '("Love") '("LOve") '("LOVe") '("LOVE"))
+ :key #'car)
+ #(("Love") ("LOve") ("LOVe") ("LOVE")))
+(equalp (remove-if-not #'(lambda (arg) (not (eql arg "love")))
+ (vector '("Love") '("LOve") '("LOVe") '("LOVE"))
+ :key #'car :count -10)
+ #(("Love") ("LOve") ("LOVe") ("LOVE")))
+(equalp (remove-if-not #'(lambda (arg) (not (string-equal arg "love")))
+ (vector '("Love") '("LOve") '("LOVe") '("LOVE"))
+ :key #'car)
+ #())
+(equalp (remove-if-not #'(lambda (arg) (not (string-equal arg "love")))
+ (vector '("Love") '("LOve") '("LOVe") '("LOVE"))
+ :key #'car)
+ #())
+(equalp (remove-if-not #'(lambda (arg) (not (string-equal arg "love")))
+ (vector '("Love") '("LOve") '("LOVe") '("LOVE"))
+ :key #'car :count 1)
+ #(("LOve") ("LOVe") ("LOVE")))
+(equalp (remove-if-not #'(lambda (arg) (not (string-equal arg "love")))
+ (vector '("Love") '("LOve") '("LOVe") '("LOVE"))
+ :key #'car :count 1)
+ #(("LOve") ("LOVe") ("LOVE")))
+(equalp (remove-if-not #'(lambda (arg) (not (string-equal arg "love")))
+ (vector '("Love") '("LOve") '("LOVe") '("LOVE"))
+ :key #'car :count 1 :from-end t)
+ #(("Love") ("LOve") ("LOVe")))
+(equalp (remove-if-not #'(lambda (arg) (not (string-equal arg "love")))
+ (vector '("Love") '("LOve") '("LOVe") '("LOVE"))
+ :key #'car :count 1 :from-end t)
+ #(("Love") ("LOve") ("LOVe")))
+(equalp (remove-if-not #'(lambda (arg) (not (string-equal arg "love")))
+ (vector '("Love") '("LOve") '("LOVe") '("LOVE"))
+ :key #'car :count 2 :from-end t)
+ #(("Love") ("LOve")))
+(equalp (remove-if-not #'(lambda (arg) (not (string-equal arg "love")))
+ (vector '("Love") '("LOve") '("LOVe") '("LOVE"))
+ :key #'car :count 2 :from-end t)
+ #(("Love") ("LOve")))
+(equalp (remove-if-not #'(lambda (arg) (not (string-equal arg "love")))
+ (vector '("Love") '("LOve") '("LOVe") '("LOVE"))
+ :key #'car :start 1 :end 3)
+ #(("Love") ("LOVE")))
+(equalp (remove-if-not #'(lambda (arg) (not (string-equal arg "love")))
+ (vector '("Love") '("LOve") '("LOVe") '("LOVE"))
+ :key #'car :count 1 :start 1 :end 3)
+ #(("Love") ("LOVe") ("LOVE")))
+(equalp (remove-if-not #'(lambda (arg) (not (string-equal arg "love")))
+ (vector '("Love") '("LOve") '("LOVe") '("LOVE"))
+ :key #'car :count 1 :from-end t
+ :start 1 :end 3)
+ #(("Love") ("LOve") ("LOVE")))
+(equalp (remove-if-not #'(lambda (arg) (not (string-equal arg "love")))
+ (vector '("Love") '("LOve") '("LOVe") '("LOVE"))
+ :key #'car :count 10 :from-end t
+ :start 1 :end 3)
+ #(("Love") ("LOVE")))
+
+(string= (remove-if-not #'(lambda (arg) (not (string-equal arg #\a)))
+ (copy-seq "abcabc"))
+ "bcbc")
+(string= (remove-if-not #'(lambda (arg) (not (string-equal arg #\a)))
+ (copy-seq "")) "")
+(string= (remove-if-not #'(lambda (arg) (not (string-equal arg #\a)))
+ (copy-seq "xyz"))
+ "xyz")
+(string= (remove-if-not #'(lambda (arg) (not (string-equal arg #\a)))
+ (copy-seq "ABCABC")
+ :key #'char-downcase) "BCBC")
+(string= (remove-if-not #'(lambda (arg) (not (string-equal arg #\a)))
+ (copy-seq "abcabc")
+ :count 1) "bcabc")
+(string= (remove-if-not #'(lambda (arg) (not (string-equal arg #\a)))
+ (copy-seq "abcabc")
+ :count 1 :from-end t) "abcbc")
+(string= (remove-if-not #'(lambda (arg) (not (string-equal arg #\a)))
+ (copy-seq "abcabc")
+ :count 0) "abcabc")
+(string= (remove-if-not #'(lambda (arg) (not (string-equal arg #\a)))
+ (copy-seq "abcabc")
+ :count -10) "abcabc")
+(let* ((str0 (copy-seq "abc"))
+ (str (remove-if-not #'(lambda (arg) (not (string-equal arg #\a))) str0)))
+ (and (not (eq str0 str))
+ (string= str0 "abc")
+ (string= str "bc")))
+(string= (remove-if-not #'(lambda (arg) (not (string-equal arg #\a)))
+ (copy-seq "abcabc")
+ :count 0) "abcabc")
+(string= (remove-if-not #'(lambda (arg) (not (string-equal arg #\a)))
+ (copy-seq "abcabc"))
+ "bcbc")
+(string= (remove-if-not #'(lambda (arg) (not (string-equal arg #\b)))
+ (copy-seq "abcabc"))
+ "acac")
+(string= (remove-if-not #'(lambda (arg) (not (string-equal arg #\c)))
+ (copy-seq "abcabc"))
+ "abab")
+(string= (remove-if-not #'(lambda (arg) (not (string-equal arg #\a)))
+ (copy-seq "abcabc")
+ :count 0) "abcabc")
+(string= (remove-if-not #'(lambda (arg) (not (string-equal arg #\a)))
+ (copy-seq "abcabc")
+ :count 1) "bcabc")
+(string= (remove-if-not #'(lambda (arg) (not (string-equal arg #\a)))
+ (copy-seq "abcabc")
+ :count 1 :from-end t) "abcbc")
+(string= (remove-if-not #'(lambda (arg) (not (string-equal arg #\a)))
+ (copy-seq "abcabc")
+ :count 2) "bcbc")
+(string= (remove-if-not #'(lambda (arg) (not (string-equal arg #\a)))
+ (copy-seq "abcabc")
+ :count 2 :from-end t) "bcbc")
+(string= (remove-if-not #'(lambda (arg) (not (string-equal arg #\a)))
+ (copy-seq "abcabc")
+ :count 3) "bcbc")
+(string= (remove-if-not #'(lambda (arg) (not (string-equal arg #\a)))
+ (copy-seq "abcabc")
+ :count 3 :from-end t) "bcbc")
+(string= (remove-if-not #'(lambda (arg) (not (string-equal arg #\a)))
+ (copy-seq "abcabc")
+ :count 4) "bcbc")
+(string= (remove-if-not #'(lambda (arg) (not (string-equal arg #\a)))
+ (copy-seq "abcabc")
+ :count 4 :from-end t) "bcbc")
+(string= (remove-if-not #'(lambda (arg) (not (string-equal arg #\a)))
+ (copy-seq "abcabc")
+ :count -1) "abcabc")
+(string= (remove-if-not #'(lambda (arg) (not (string-equal arg #\a)))
+ (copy-seq "abcabc")
+ :count -10) "abcabc")
+(string= (remove-if-not #'(lambda (arg) (not (string-equal arg #\a)))
+ (copy-seq "abcabc")
+ :count -100) "abcabc")
+(string= (remove-if-not #'(lambda (arg) (not (string-equal arg #\a)))
+ (copy-seq "abcabcabcabc") :start 1) "abcbcbcbc")
+(string= (remove-if-not #'(lambda (arg) (not (string-equal arg #\a)))
+ (copy-seq "abcabcabcabc") :start 1 :count 1) "abcbcabcabc")
+(string= (remove-if-not #'(lambda (arg) (not (eql arg #\a)))
+ (copy-seq "abcabcabcabc") :start 1 :count 2)
+ "abcbcbcabc")
+(string= (remove-if-not #'(lambda (arg) (not (eql arg #\a)))
+ (copy-seq "abcabcabcabc") :start 1 :end nil :count 2)
+ "abcbcbcabc")
+(string= (remove-if-not #'(lambda (arg) (not (eql arg #\a)))
+ (copy-seq "abcabcabcabc") :start 1 :end 8) "abcbcbcabc")
+(string= (remove-if-not #'(lambda (arg) (not (eql arg #\a)))
+ (copy-seq "abcabcabcabc") :start 1 :end 8 :count 1)
+ "abcbcabcabc")
+(string= (remove-if-not #'(lambda (arg) (not (eql arg #\a)))
+ (copy-seq "abcabcabcabc")
+ :start 1 :end 8 :count 1 :from-end t)
+ "abcabcbcabc")
+(string= (remove-if-not #'(lambda (arg) (not (eql arg #\a)))
+ (copy-seq "abcabcabcabc")
+ :start 1 :end 8 :count 0 :from-end t)
+ "abcabcabcabc")
+(string= (remove-if-not #'(lambda (arg) (not (eql arg #\a)))
+ (copy-seq "abcabcabcabc")
+ :start 1 :end 8 :count -100 :from-end t)
+ "abcabcabcabc")
+(string= (remove-if-not #'(lambda (arg) (not (eql arg #\a)))
+ (copy-seq "abcabcabcabc") :start 1 :end 1)
+ "abcabcabcabc")
+(string= (remove-if-not #'(lambda (arg) (not (eql arg #\a)))
+ (copy-seq "abcabcabcabc")
+ :start 2 :end 2) "abcabcabcabc")
+(string= (remove-if-not #'(lambda (arg) (not (eql arg #\a)))
+ (copy-seq "abcabcabcabc")
+ :start 12 :end 12) "abcabcabcabc")
+(equal (remove-if-not (complement #'zerop) #*0101) #*11)
+(equal (remove-if-not (complement #'zerop) #*01010101 :count 1) #*1010101)
+(equal (remove-if-not (complement #'zerop) #*01010101 :count 1 :from-end t)
+ #*0101011)
+(equal (remove-if-not (complement #'zerop) #*01010101 :start 1) #*01111)
+(equal (remove-if-not (complement #'zerop) #*01010101 :start 1 :end nil) #*01111)
+(equal (remove-if-not (complement #'zerop) #*01010101 :start 1 :end 6) #*011101)
+(equal (remove-if-not (complement #'zerop) #*01010101 :start 1 :end 6 :count 1)
+ #*0110101)
+(equal (remove-if-not (complement #'zerop) #*01010101
+ :start 1 :end 6 :count 1 :from-end t)
+ #*0101101)
+(equal (remove-if-not (complement #'oddp) #*01010101
+ :start 1 :end 6 :count 1 :from-end t)
+ #*0101001)
+(equal (remove-if-not (complement #'evenp)
+ #*01010101 :start 1 :end 6 :count 1 :from-end t)
+ #*0101101)
+(equal (remove-if-not (complement #'plusp) #*01010101
+ :start 1 :end 6 :count 1 :from-end t
+ :key #'(lambda (arg) (* arg 10)))
+ #*0101001)
+
+
+(equal (delete 'a (list 'a 'b 'c 'a 'b 'c)) '(b c b c))
+(equal (delete 'b (list 'a 'b 'c 'a 'b 'c)) '(a c a c))
+(equal (delete 'c (list 'a 'b 'c 'a 'b 'c)) '(a b a b))
+(equal (delete 'a (list 'a 'a 'a)) '())
+(equal (delete 'z (list 'a 'b 'c)) '(a b c))
+(equal (delete 'a '()) '())
+(equal (delete 'a (list 'a 'b 'c 'a 'b 'c) :count 0) '(a b c a b c))
+(equal (delete 'a (list 'a 'b 'c 'a 'b 'c) :count 1) '(b c a b c))
+(equal (delete 'a (list 'a 'b 'c 'a 'b 'c) :count 1 :from-end t) '(a b c b c))
+(equal (delete 'a (list 'a 'b 'c 'a 'b 'c) :count 2) '(b c b c))
+(equal (delete 'a (list 'a 'b 'c 'a 'b 'c) :count 2 :from-end t) '(b c b c))
+(equal (delete 'a (list 'a 'b 'c 'a 'b 'c) :count 3) '(b c b c))
+(equal (delete 'a (list 'a 'b 'c 'a 'b 'c) :count 3 :from-end t) '(b c b c))
+(equal (delete 'a (list 'a 'b 'c 'a 'b 'c) :count 4) '(b c b c))
+(equal (delete 'a (list 'a 'b 'c 'a 'b 'c) :count 4 :from-end t) '(b c b c))
+(equal (delete 'a (list 'a 'b 'c 'a 'b 'c) :count -1) '(a b c a b c))
+(equal (delete 'a (list 'a 'b 'c 'a 'b 'c) :count -10) '(a b c a b c))
+(equal (delete 'a (list 'a 'b 'c 'a 'b 'c) :count -100) '(a b c a b c))
+(equal (delete 'a (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1)
+ '(a b c b c b c b c))
+(equal (delete 'a (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :count 1)
+ '(a b c b c a b c a b c))
+(equal (delete 'a (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :count 2)
+ '(a b c b c b c a b c))
+(equal (delete 'a (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c)
+ :start 1 :end nil :count 2)
+ '(a b c b c b c a b c))
+(equal (delete 'a (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8)
+ '(a b c b c b c a b c))
+(equal (delete 'a (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c)
+ :start 1 :end 8 :count 1)
+ '(a b c b c a b c a b c))
+(equal (delete 'a (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c)
+ :start 1 :end 8 :count 1 :from-end t)
+ '(a b c a b c b c a b c))
+(equal (delete 'a (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c)
+ :start 1 :end 8 :count 0 :from-end t)
+ '(a b c a b c a b c a b c))
+(equal (delete 'a (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c)
+ :start 1 :end 8 :count -100 :from-end t)
+ '(a b c a b c a b c a b c))
+(equal (delete 'a (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 1)
+ '(a b c a b c a b c a b c))
+(equal (delete 'a (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 2 :end 2)
+ '(a b c a b c a b c a b c))
+(equal (delete 'a (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 12 :end 12)
+ '(a b c a b c a b c a b c))
+(equal (delete 'a (list '(a) '(b) '(c) '(a) '(b) '(c)) :key #'car)
+ '((b) (c) (b) (c)))
+(equal (delete 'a (list '(a . b) '(b . c) '(c . a)
+ '(a . b) '(b . c) '(c . a))
+ :key #'cdr)
+ '((a . b) (b . c) (a . b) (b . c)))
+(equal (delete "love" (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key #'car)
+ '(("Love") ("LOve") ("LOVe") ("LOVE")))
+(equal (delete "love" (list '("Love") '("LOve") '("LOVe") '("LOVE"))
+ :key #'car :count -10)
+ '(("Love") ("LOve") ("LOVe") ("LOVE")))
+(equal (delete "love" (list '("Love") '("LOve") '("LOVe") '("LOVE"))
+ :key #'car :test #'string-equal)
+ '())
+(equal (delete "love" (list '("Love") '("LOve") '("LOVe") '("LOVE"))
+ :key #'car :test-not (complement #'string-equal))
+ '())
+(equal (delete "love" (list '("Love") '("LOve") '("LOVe") '("LOVE"))
+ :key #'car :test #'string-equal :count 1)
+ '(("LOve") ("LOVe") ("LOVE")))
+(equal (delete "love" (list '("Love") '("LOve") '("LOVe") '("LOVE"))
+ :key #'car :test-not (complement #'string-equal) :count 1)
+ '(("LOve") ("LOVe") ("LOVE")))
+(equal (delete "love" (list '("Love") '("LOve") '("LOVe") '("LOVE"))
+ :key #'car :test #'string-equal :count 1 :from-end t)
+ '(("Love") ("LOve") ("LOVe")))
+(equal (delete "love" (list '("Love") '("LOve") '("LOVe") '("LOVE"))
+ :key #'car :test-not (complement #'string-equal)
+ :count 1 :from-end t)
+ '(("Love") ("LOve") ("LOVe")))
+(equal (delete "love" (list '("Love") '("LOve") '("LOVe") '("LOVE"))
+ :key #'car :test #'string-equal :count 2 :from-end t)
+ '(("Love") ("LOve")))
+(equal (delete "love" (list '("Love") '("LOve") '("LOVe") '("LOVE"))
+ :key #'car :test-not (complement #'string-equal)
+ :count 2 :from-end t)
+ '(("Love") ("LOve")))
+(equal (delete "love" (list '("Love") '("LOve") '("LOVe") '("LOVE"))
+ :key #'car :test #'string-equal :start 1 :end 3)
+ '(("Love") ("LOVE")))
+(equal (delete "love" (list '("Love") '("LOve") '("LOVe") '("LOVE"))
+ :key #'car :test-not (complement #'string-equal) :start 1 :end 3)
+ '(("Love") ("LOVE")))
+(equal (delete "love" (list '("Love") '("LOve") '("LOVe") '("LOVE"))
+ :key #'car :test #'string-equal :count 1 :start 1 :end 3)
+ '(("Love") ("LOVe") ("LOVE")))
+(equal (delete "love" (list '("Love") '("LOve") '("LOVe") '("LOVE"))
+ :key #'car :test-not (complement #'string-equal)
+ :count 1 :start 1 :end 3)
+ '(("Love") ("LOVe") ("LOVE")))
+(equal (delete "love" (list '("Love") '("LOve") '("LOVe") '("LOVE"))
+ :key #'car :test #'string-equal :count 1 :from-end t
+ :start 1 :end 3)
+ '(("Love") ("LOve") ("LOVE")))
+(equal (delete "love" (list '("Love") '("LOve") '("LOVe") '("LOVE"))
+ :key #'car :test-not (complement #'string-equal)
+ :count 1 :from-end t :start 1 :end 3)
+ '(("Love") ("LOve") ("LOVE")))
+(equal (delete "love" (list '("Love") '("LOve") '("LOVe") '("LOVE"))
+ :key #'car :test #'string-equal :count 10 :from-end t
+ :start 1 :end 3)
+ '(("Love") ("LOVE")))
+(equal (delete "love" (list '("Love") '("LOve") '("LOVe") '("LOVE"))
+ :key #'car :test-not (complement #'string-equal)
+ :count 10 :from-end t :start 1 :end 3)
+ '(("Love") ("LOVE")))
+
+
+(equalp (delete 'a (vector 'a 'b 'c 'a 'b 'c)) #(b c b c))
+(equalp (delete 'b (vector 'a 'b 'c 'a 'b 'c)) #(a c a c))
+(equalp (delete 'c (vector 'a 'b 'c 'a 'b 'c)) #(a b a b))
+(equalp (delete 'a (vector 'a 'a 'a)) #())
+(equalp (delete 'z (vector 'a 'b 'c)) #(a b c))
+(equalp (delete 'a #()) #())
+(equalp (delete 'a (vector 'a 'b 'c 'a 'b 'c) :count 0) #(a b c a b c))
+(equalp (delete 'a (vector 'a 'b 'c 'a 'b 'c) :count 1) #(b c a b c))
+(equalp (delete 'a (vector 'a 'b 'c 'a 'b 'c) :count 1 :from-end t) #(a b c b c))
+(equalp (delete 'a (vector 'a 'b 'c 'a 'b 'c) :count 2) #(b c b c))
+(equalp (delete 'a (vector 'a 'b 'c 'a 'b 'c) :count 2 :from-end t) #(b c b c))
+(equalp (delete 'a (vector 'a 'b 'c 'a 'b 'c) :count 3) #(b c b c))
+(equalp (delete 'a (vector 'a 'b 'c 'a 'b 'c) :count 3 :from-end t) #(b c b c))
+(equalp (delete 'a (vector 'a 'b 'c 'a 'b 'c) :count 4) #(b c b c))
+(equalp (delete 'a (vector 'a 'b 'c 'a 'b 'c) :count 4 :from-end t) #(b c b c))
+(equalp (delete 'a (vector 'a 'b 'c 'a 'b 'c) :count -1) #(a b c a b c))
+(equalp (delete 'a (vector 'a 'b 'c 'a 'b 'c) :count -10) #(a b c a b c))
+(equalp (delete 'a (vector 'a 'b 'c 'a 'b 'c) :count -100) #(a b c a b c))
+(equalp (delete 'a (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1)
+ #(a b c b c b c b c))
+(equalp (delete 'a (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c)
+ :start 1 :count 1)
+ #(a b c b c a b c a b c))
+(equalp (delete 'a (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c)
+ :start 1 :count 2)
+ #(a b c b c b c a b c))
+(equalp (delete 'a (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c)
+ :start 1 :end nil :count 2)
+ #(a b c b c b c a b c))
+(equalp (delete 'a (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8)
+ #(a b c b c b c a b c))
+(equalp (delete 'a (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c)
+ :start 1 :end 8 :count 1)
+ #(a b c b c a b c a b c))
+(equalp (delete 'a (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c)
+ :start 1 :end 8 :count 1 :from-end t)
+ #(a b c a b c b c a b c))
+(equalp (delete 'a (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c)
+ :start 1 :end 8 :count 0 :from-end t)
+ #(a b c a b c a b c a b c))
+(equalp (delete 'a (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c)
+ :start 1 :end 8 :count -100 :from-end t)
+ #(a b c a b c a b c a b c))
+(equalp (delete 'a (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 1)
+ #(a b c a b c a b c a b c))
+(equalp (delete 'a (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 2 :end 2)
+ #(a b c a b c a b c a b c))
+(equalp (delete 'a (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c)
+ :start 12 :end 12)
+ #(a b c a b c a b c a b c))
+(equalp (delete 'a (vector '(a) '(b) '(c) '(a) '(b) '(c)) :key #'car)
+ #((b) (c) (b) (c)))
+(equalp (delete 'a (vector '(a . b) '(b . c) '(c . a)
+ '(a . b) '(b . c) '(c . a))
+ :key #'cdr)
+ #((a . b) (b . c) (a . b) (b . c)))
+(equalp (delete "love" (vector '("Love") '("LOve") '("LOVe") '("LOVE"))
+ :key #'car)
+ #(("Love") ("LOve") ("LOVe") ("LOVE")))
+(equalp (delete "love" (vector '("Love") '("LOve") '("LOVe") '("LOVE"))
+ :key #'car :count -10)
+ #(("Love") ("LOve") ("LOVe") ("LOVE")))
+(equalp (delete "love" (vector '("Love") '("LOve") '("LOVe") '("LOVE"))
+ :key #'car :test #'string-equal)
+ #())
+(equalp (delete "love" (vector '("Love") '("LOve") '("LOVe") '("LOVE"))
+ :key #'car :test-not (complement #'string-equal))
+ #())
+(equalp (delete "love" (vector '("Love") '("LOve") '("LOVe") '("LOVE"))
+ :key #'car :test #'string-equal :count 1)
+ #(("LOve") ("LOVe") ("LOVE")))
+(equalp (delete "love" (vector '("Love") '("LOve") '("LOVe") '("LOVE"))
+ :key #'car :test-not (complement #'string-equal) :count 1)
+ #(("LOve") ("LOVe") ("LOVE")))
+(equalp (delete "love" (vector '("Love") '("LOve") '("LOVe") '("LOVE"))
+ :key #'car :test #'string-equal :count 1 :from-end t)
+ #(("Love") ("LOve") ("LOVe")))
+(equalp (delete "love" (vector '("Love") '("LOve") '("LOVe") '("LOVE"))
+ :key #'car :test-not (complement #'string-equal)
+ :count 1 :from-end t)
+ #(("Love") ("LOve") ("LOVe")))
+(equalp (delete "love" (vector '("Love") '("LOve") '("LOVe") '("LOVE"))
+ :key #'car :test #'string-equal :count 2 :from-end t)
+ #(("Love") ("LOve")))
+(equalp (delete "love" (vector '("Love") '("LOve") '("LOVe") '("LOVE"))
+ :key #'car :test-not (complement #'string-equal)
+ :count 2 :from-end t)
+ #(("Love") ("LOve")))
+(equalp (delete "love" (vector '("Love") '("LOve") '("LOVe") '("LOVE"))
+ :key #'car :test #'string-equal :start 1 :end 3)
+ #(("Love") ("LOVE")))
+(equalp (delete "love" (vector '("Love") '("LOve") '("LOVe") '("LOVE"))
+ :key #'car :test-not (complement #'string-equal) :start 1 :end 3)
+ #(("Love") ("LOVE")))
+(equalp (delete "love" (vector '("Love") '("LOve") '("LOVe") '("LOVE"))
+ :key #'car :test #'string-equal :count 1 :start 1 :end 3)
+ #(("Love") ("LOVe") ("LOVE")))
+(equalp (delete "love" (vector '("Love") '("LOve") '("LOVe") '("LOVE"))
+ :key #'car :test-not (complement #'string-equal)
+ :count 1 :start 1 :end 3)
+ #(("Love") ("LOVe") ("LOVE")))
+(equalp (delete "love" (vector '("Love") '("LOve") '("LOVe") '("LOVE"))
+ :key #'car :test #'string-equal :count 1 :from-end t
+ :start 1 :end 3)
+ #(("Love") ("LOve") ("LOVE")))
+(equalp (delete "love" (vector '("Love") '("LOve") '("LOVe") '("LOVE"))
+ :key #'car :test-not (complement #'string-equal)
+ :count 1 :from-end t :start 1 :end 3)
+ #(("Love") ("LOve") ("LOVE")))
+(equalp (delete "love" (vector '("Love") '("LOve") '("LOVe") '("LOVE"))
+ :key #'car :test #'string-equal :count 10 :from-end t
+ :start 1 :end 3)
+ #(("Love") ("LOVE")))
+(equalp (delete "love" (vector '("Love") '("LOve") '("LOVe") '("LOVE"))
+ :key #'car :test-not (complement #'string-equal)
+ :count 10 :from-end t :start 1 :end 3)
+ #(("Love") ("LOVE")))
+
+(string= (delete #\a (copy-seq "abcabc")) "bcbc")
+(string= (delete #\a (copy-seq "")) "")
+(string= (delete #\a (copy-seq "xyz")) "xyz")
+(string= (delete #\a (copy-seq "ABCABC")) "ABCABC")
+(string= (delete #\a (copy-seq "ABCABC") :key #'char-downcase) "BCBC")
+(string= (delete #\a (copy-seq "abcabc") :count 1) "bcabc")
+(string= (delete #\a (copy-seq "abcabc") :count 1 :from-end t) "abcbc")
+(string= (delete #\a (copy-seq "abcabc") :count 0) "abcabc")
+(string= (delete #\a (copy-seq "abcabc") :count -10) "abcabc")
+(string= (delete #\a (copy-seq "abcabc") :count 0) "abcabc")
+(string= (delete #\a (copy-seq "abcabc")) "bcbc")
+(string= (delete #\b (copy-seq "abcabc")) "acac")
+(string= (delete #\c (copy-seq "abcabc")) "abab")
+(string= (delete #\a (copy-seq "abcabc") :count 0) "abcabc")
+(string= (delete #\a (copy-seq "abcabc") :count 1) "bcabc")
+(string= (delete #\a (copy-seq "abcabc") :count 1 :from-end t) "abcbc")
+(string= (delete #\a (copy-seq "abcabc") :count 2) "bcbc")
+(string= (delete #\a (copy-seq "abcabc") :count 2 :from-end t) "bcbc")
+(string= (delete #\a (copy-seq "abcabc") :count 3) "bcbc")
+(string= (delete #\a (copy-seq "abcabc") :count 3 :from-end t) "bcbc")
+(string= (delete #\a (copy-seq "abcabc") :count 4) "bcbc")
+(string= (delete #\a (copy-seq "abcabc") :count 4 :from-end t) "bcbc")
+(string= (delete #\a (copy-seq "abcabc") :count -1) "abcabc")
+(string= (delete #\a (copy-seq "abcabc") :count -10) "abcabc")
+(string= (delete #\a (copy-seq "abcabc") :count -100) "abcabc")
+(string= (delete #\a (copy-seq "abcabcabcabc") :start 1) "abcbcbcbc")
+(string= (delete #\a (copy-seq "abcabcabcabc") :start 1 :count 1) "abcbcabcabc")
+(string= (delete #\a (copy-seq "abcabcabcabc") :start 1 :count 2) "abcbcbcabc")
+(string= (delete #\a (copy-seq "abcabcabcabc") :start 1 :end nil :count 2)
+ "abcbcbcabc")
+(string= (delete #\a (copy-seq "abcabcabcabc") :start 1 :end 8) "abcbcbcabc")
+(string= (delete #\a (copy-seq "abcabcabcabc") :start 1 :end 8 :count 1)
+ "abcbcabcabc")
+(string= (delete #\a (copy-seq "abcabcabcabc")
+ :start 1 :end 8 :count 1 :from-end t)
+ "abcabcbcabc")
+(string= (delete #\a (copy-seq "abcabcabcabc")
+ :start 1 :end 8 :count 0 :from-end t)
+ "abcabcabcabc")
+(string= (delete #\a (copy-seq "abcabcabcabc")
+ :start 1 :end 8 :count -100 :from-end t)
+ "abcabcabcabc")
+(string= (delete #\a (copy-seq "abcabcabcabc") :start 1 :end 1)
+ "abcabcabcabc")
+(string= (delete #\a (copy-seq "abcabcabcabc") :start 2 :end 2) "abcabcabcabc")
+(string= (delete #\a (copy-seq "abcabcabcabc") :start 12 :end 12) "abcabcabcabc")
+(equal (delete 0 #*0101) #*11)
+(equal (delete 0 #*01010101 :count 1) #*1010101)
+(equal (delete 0 #*01010101 :count 1 :from-end t) #*0101011)
+(equal (delete 0 #*01010101 :start 1) #*01111)
+(equal (delete 0 #*01010101 :start 1 :end nil) #*01111)
+(equal (delete 0 #*01010101 :start 1 :end 6) #*011101)
+(equal (delete 0 #*01010101 :start 1 :end 6 :count 1) #*0110101)
+(equal (delete 0 #*01010101 :start 1 :end 6 :count 1 :from-end t) #*0101101)
+(equal (delete 0 #*01010101
+ :start 1 :end 6 :count 1 :from-end t
+ :test #'(lambda (a b) (declare (ignore a)) (oddp b)))
+ #*0101001)
+(equal (delete 0 #*01010101
+ :start 1 :end 6 :count 1 :from-end t
+ :test-not #'(lambda (a b) (declare (ignore a)) (evenp b)))
+ #*0101001)
+(equal (delete 0 #*01010101
+ :start 1 :end 6 :count 1 :from-end t
+ :test #'(lambda (a b) (declare (ignore a)) (evenp b)))
+ #*0101101)
+(equal (delete 0 #*01010101
+ :start 1 :end 6 :count 1 :from-end t
+ :test-not #'(lambda (a b) (declare (ignore a)) (oddp b)))
+ #*0101101)
+(equal (delete 0 #*01010101
+ :start 1 :end 6 :count 1 :from-end t
+ :key #'(lambda (arg) (* arg 10))
+ :test #'(lambda (a b) (declare (ignore a)) (> b 1)))
+ #*0101001)
+
+
+(equal (delete-if #'(lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c))
+ '(b c b c))
+(equal (delete-if #'(lambda (arg) (eql arg 'b)) (list 'a 'b 'c 'a 'b 'c))
+ '(a c a c))
+(equal (delete-if #'(lambda (arg) (eql arg 'c)) (list 'a 'b 'c 'a 'b 'c))
+ '(a b a b))
+(equal (delete-if #'(lambda (arg) (eql arg 'a)) (list 'a 'a 'a)) '())
+(equal (delete-if #'(lambda (arg) (eql arg 'z)) (list 'a 'b 'c)) '(a b c))
+(equal (delete-if #'(lambda (arg) (eql arg 'a)) '()) '())
+(equal (delete-if #'(lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c)
+ :count 0) '(a b c a b c))
+(equal (delete-if #'(lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c)
+ :count 1) '(b c a b c))
+(equal (delete-if #'(lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c)
+ :count 1 :from-end t) '(a b c b c))
+(equal (delete-if #'(lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c)
+ :count 2) '(b c b c))
+(equal (delete-if #'(lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c)
+ :count 2 :from-end t) '(b c b c))
+(equal (delete-if #'(lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c)
+ :count 3) '(b c b c))
+(equal (delete-if #'(lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c)
+ :count 3 :from-end t) '(b c b c))
+(equal (delete-if #'(lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c)
+ :count 4) '(b c b c))
+(equal (delete-if #'(lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c)
+ :count 4 :from-end t) '(b c b c))
+(equal (delete-if #'(lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c)
+ :count -1) '(a b c a b c))
+(equal (delete-if #'(lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c)
+ :count -10) '(a b c a b c))
+(equal (delete-if #'(lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c)
+ :count -100) '(a b c a b c))
+(equal (delete-if #'(lambda (arg) (eql arg 'a))
+ (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1)
+ '(a b c b c b c b c))
+(equal (delete-if #'(lambda (arg) (eql arg 'a))
+ (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :count 1)
+ '(a b c b c a b c a b c))
+(equal (delete-if #'(lambda (arg) (eql arg 'a))
+ (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :count 2)
+ '(a b c b c b c a b c))
+(equal (delete-if #'(lambda (arg) (eql arg 'a))
+ (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c)
+ :start 1 :end nil :count 2)
+ '(a b c b c b c a b c))
+(equal (delete-if #'(lambda (arg) (eql arg 'a))
+ (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8)
+ '(a b c b c b c a b c))
+(equal (delete-if #'(lambda (arg) (eql arg 'a))
+ (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c)
+ :start 1 :end 8 :count 1)
+ '(a b c b c a b c a b c))
+(equal (delete-if #'(lambda (arg) (eql arg 'a))
+ (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c)
+ :start 1 :end 8 :count 1 :from-end t)
+ '(a b c a b c b c a b c))
+(equal (delete-if #'(lambda (arg) (eql arg 'a))
+ (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c)
+ :start 1 :end 8 :count 0 :from-end t)
+ '(a b c a b c a b c a b c))
+(equal (delete-if #'(lambda (arg) (eql arg 'a))
+ (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c)
+ :start 1 :end 8 :count -100 :from-end t)
+ '(a b c a b c a b c a b c))
+(equal (delete-if #'(lambda (arg) (eql arg 'a))
+ (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 1)
+ '(a b c a b c a b c a b c))
+(equal (delete-if #'(lambda (arg) (eql arg 'a))
+ (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 2 :end 2)
+ '(a b c a b c a b c a b c))
+(equal (delete-if #'(lambda (arg) (eql arg 'a))
+ (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c)
+ :start 12 :end 12)
+ '(a b c a b c a b c a b c))
+(equal (delete-if #'(lambda (arg) (eql arg 'a))
+ (list '(a) '(b) '(c) '(a) '(b) '(c)) :key #'car)
+ '((b) (c) (b) (c)))
+(equal (delete-if #'(lambda (arg) (eql arg 'a))
+ (list '(a . b) '(b . c) '(c . a)
+ '(a . b) '(b . c) '(c . a))
+ :key #'cdr)
+ '((a . b) (b . c) (a . b) (b . c)))
+(equal (delete-if #'(lambda (arg) (eql arg "love"))
+ (list '("Love") '("LOve") '("LOVe") '("LOVE"))
+ :key #'car)
+ '(("Love") ("LOve") ("LOVe") ("LOVE")))
+(equal (delete-if #'(lambda (arg) (eql arg "love"))
+ (list '("Love") '("LOve") '("LOVe") '("LOVE"))
+ :key #'car :count -10)
+ '(("Love") ("LOve") ("LOVe") ("LOVE")))
+(equal (delete-if #'(lambda (arg) (string-equal arg "love"))
+ (list '("Love") '("LOve") '("LOVe") '("LOVE"))
+ :key #'car)
+ '())
+(equal (delete-if #'(lambda (arg) (string-equal arg "love"))
+ (list '("Love") '("LOve") '("LOVe") '("LOVE"))
+ :key #'car :count 1)
+ '(("LOve") ("LOVe") ("LOVE")))
+(equal (delete-if #'(lambda (arg) (string-equal arg "love"))
+ (list '("Love") '("LOve") '("LOVe") '("LOVE"))
+ :key #'car :count 1 :from-end t)
+ '(("Love") ("LOve") ("LOVe")))
+(equal (delete-if #'(lambda (arg) (string-equal arg "love"))
+ (list '("Love") '("LOve") '("LOVe") '("LOVE"))
+ :key #'car :count 2 :from-end t)
+ '(("Love") ("LOve")))
+(equal (delete-if #'(lambda (arg) (string-equal arg "love"))
+ (list '("Love") '("LOve") '("LOVe") '("LOVE"))
+ :key #'car :start 1 :end 3)
+ '(("Love") ("LOVE")))
+(equal (delete-if #'(lambda (arg) (string-equal arg "love"))
+ (list '("Love") '("LOve") '("LOVe") '("LOVE"))
+ :key #'car :count 1 :start 1 :end 3)
+ '(("Love") ("LOVe") ("LOVE")))
+(equal (delete-if #'(lambda (arg) (string-equal arg "love"))
+ (list '("Love") '("LOve") '("LOVe") '("LOVE"))
+ :key #'car :count 1 :from-end t
+ :start 1 :end 3)
+ '(("Love") ("LOve") ("LOVE")))
+(equal (delete-if #'(lambda (arg) (string-equal arg "love"))
+ (list '("Love") '("LOve") '("LOVe") '("LOVE"))
+ :key #'car :count 10 :from-end t :start 1 :end 3)
+ '(("Love") ("LOVE")))
+
+
+(equalp (delete-if #'(lambda (arg) (eql arg 'a))
+ (vector 'a 'b 'c 'a 'b 'c)) #(b c b c))
+(equalp (delete-if #'(lambda (arg) (eql arg 'b))
+ (vector 'a 'b 'c 'a 'b 'c)) #(a c a c))
+(equalp (delete-if #'(lambda (arg) (eql arg 'c))
+ (vector 'a 'b 'c 'a 'b 'c)) #(a b a b))
+(equalp (delete-if #'(lambda (arg) (eql arg 'a))
+ (vector 'a 'a 'a)) #())
+(equalp (delete-if #'(lambda (arg) (eql arg 'z))
+ (vector 'a 'b 'c)) #(a b c))
+(equalp (delete-if #'(lambda (arg) (eql arg 'a)) #()) #())
+(equalp (delete-if #'(lambda (arg) (eql arg 'a))
+ (vector 'a 'b 'c 'a 'b 'c) :count 0) #(a b c a b c))
+(equalp (delete-if #'(lambda (arg) (eql arg 'a))
+ (vector 'a 'b 'c 'a 'b 'c) :count 1) #(b c a b c))
+(equalp (delete-if #'(lambda (arg) (eql arg 'a))
+ (vector 'a 'b 'c 'a 'b 'c) :count 1 :from-end t) #(a b c b c))
+(equalp (delete-if #'(lambda (arg) (eql arg 'a))
+ (vector 'a 'b 'c 'a 'b 'c) :count 2) #(b c b c))
+(equalp (delete-if #'(lambda (arg) (eql arg 'a))
+ (vector 'a 'b 'c 'a 'b 'c) :count 2 :from-end t) #(b c b c))
+(equalp (delete-if #'(lambda (arg) (eql arg 'a))
+ (vector 'a 'b 'c 'a 'b 'c) :count 3) #(b c b c))
+(equalp (delete-if #'(lambda (arg) (eql arg 'a))
+ (vector 'a 'b 'c 'a 'b 'c) :count 3 :from-end t) #(b c b c))
+(equalp (delete-if #'(lambda (arg) (eql arg 'a))
+ (vector 'a 'b 'c 'a 'b 'c) :count 4) #(b c b c))
+(equalp (delete-if #'(lambda (arg) (eql arg 'a))
+ (vector 'a 'b 'c 'a 'b 'c) :count 4 :from-end t) #(b c b c))
+(equalp (delete-if #'(lambda (arg) (eql arg 'a))
+ (vector 'a 'b 'c 'a 'b 'c) :count -1) #(a b c a b c))
+(equalp (delete-if #'(lambda (arg) (eql arg 'a))
+ (vector 'a 'b 'c 'a 'b 'c) :count -10) #(a b c a b c))
+(equalp (delete-if #'(lambda (arg) (eql arg 'a))
+ (vector 'a 'b 'c 'a 'b 'c) :count -100) #(a b c a b c))
+(equalp (delete-if #'(lambda (arg) (eql arg 'a))
+ (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1)
+ #(a b c b c b c b c))
+(equalp (delete-if #'(lambda (arg) (eql arg 'a))
+ (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c)
+ :start 1 :count 1)
+ #(a b c b c a b c a b c))
+(equalp (delete-if #'(lambda (arg) (eql arg 'a))
+ (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c)
+ :start 1 :count 2)
+ #(a b c b c b c a b c))
+(equalp (delete-if #'(lambda (arg) (eql arg 'a))
+ (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c)
+ :start 1 :end nil :count 2)
+ #(a b c b c b c a b c))
+(equalp (delete-if #'(lambda (arg) (eql arg 'a))
+ (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8)
+ #(a b c b c b c a b c))
+(equalp (delete-if #'(lambda (arg) (eql arg 'a))
+ (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c)
+ :start 1 :end 8 :count 1)
+ #(a b c b c a b c a b c))
+(equalp (delete-if #'(lambda (arg) (eql arg 'a))
+ (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c)
+ :start 1 :end 8 :count 1 :from-end t)
+ #(a b c a b c b c a b c))
+(equalp (delete-if #'(lambda (arg) (eql arg 'a))
+ (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c)
+ :start 1 :end 8 :count 0 :from-end t)
+ #(a b c a b c a b c a b c))
+(equalp (delete-if #'(lambda (arg) (eql arg 'a))
+ (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c)
+ :start 1 :end 8 :count -100 :from-end t)
+ #(a b c a b c a b c a b c))
+(equalp (delete-if #'(lambda (arg) (eql arg 'a))
+ (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 1)
+ #(a b c a b c a b c a b c))
+(equalp (delete-if #'(lambda (arg) (eql arg 'a))
+ (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 2 :end 2)
+ #(a b c a b c a b c a b c))
+(equalp (delete-if #'(lambda (arg) (eql arg 'a))
+ (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c)
+ :start 12 :end 12)
+ #(a b c a b c a b c a b c))
+(equalp (delete-if #'(lambda (arg) (eql arg 'a))
+ (vector '(a) '(b) '(c) '(a) '(b) '(c)) :key #'car)
+ #((b) (c) (b) (c)))
+(equalp (delete-if #'(lambda (arg) (eql arg 'a))
+ (vector '(a . b) '(b . c) '(c . a)
+ '(a . b) '(b . c) '(c . a))
+ :key #'cdr)
+ #((a . b) (b . c) (a . b) (b . c)))
+(equalp (delete-if #'(lambda (arg) (eql arg "love"))
+ (vector '("Love") '("LOve") '("LOVe") '("LOVE"))
+ :key #'car)
+ #(("Love") ("LOve") ("LOVe") ("LOVE")))
+(equalp (delete-if #'(lambda (arg) (eql arg "love"))
+ (vector '("Love") '("LOve") '("LOVe") '("LOVE"))
+ :key #'car :count -10)
+ #(("Love") ("LOve") ("LOVe") ("LOVE")))
+(equalp (delete-if #'(lambda (arg) (string-equal arg "love"))
+ (vector '("Love") '("LOve") '("LOVe") '("LOVE"))
+ :key #'car)
+ #())
+(equalp (delete-if #'(lambda (arg) (string-equal arg "love"))
+ (vector '("Love") '("LOve") '("LOVe") '("LOVE"))
+ :key #'car)
+ #())
+(equalp (delete-if #'(lambda (arg) (string-equal arg "love"))
+ (vector '("Love") '("LOve") '("LOVe") '("LOVE"))
+ :key #'car :count 1)
+ #(("LOve") ("LOVe") ("LOVE")))
+(equalp (delete-if #'(lambda (arg) (string-equal arg "love"))
+ (vector '("Love") '("LOve") '("LOVe") '("LOVE"))
+ :key #'car :count 1)
+ #(("LOve") ("LOVe") ("LOVE")))
+(equalp (delete-if #'(lambda (arg) (string-equal arg "love"))
+ (vector '("Love") '("LOve") '("LOVe") '("LOVE"))
+ :key #'car :count 1 :from-end t)
+ #(("Love") ("LOve") ("LOVe")))
+(equalp (delete-if #'(lambda (arg) (string-equal arg "love"))
+ (vector '("Love") '("LOve") '("LOVe") '("LOVE"))
+ :key #'car :count 1 :from-end t)
+ #(("Love") ("LOve") ("LOVe")))
+(equalp (delete-if #'(lambda (arg) (string-equal arg "love"))
+ (vector '("Love") '("LOve") '("LOVe") '("LOVE"))
+ :key #'car :count 2 :from-end t)
+ #(("Love") ("LOve")))
+(equalp (delete-if #'(lambda (arg) (string-equal arg "love"))
+ (vector '("Love") '("LOve") '("LOVe") '("LOVE"))
+ :key #'car :count 2 :from-end t)
+ #(("Love") ("LOve")))
+(equalp (delete-if #'(lambda (arg) (string-equal arg "love"))
+ (vector '("Love") '("LOve") '("LOVe") '("LOVE"))
+ :key #'car :start 1 :end 3)
+ #(("Love") ("LOVE")))
+(equalp (delete-if #'(lambda (arg) (string-equal arg "love"))
+ (vector '("Love") '("LOve") '("LOVe") '("LOVE"))
+ :key #'car :count 1 :start 1 :end 3)
+ #(("Love") ("LOVe") ("LOVE")))
+(equalp (delete-if #'(lambda (arg) (string-equal arg "love"))
+ (vector '("Love") '("LOve") '("LOVe") '("LOVE"))
+ :key #'car :count 1 :from-end t
+ :start 1 :end 3)
+ #(("Love") ("LOve") ("LOVE")))
+(equalp (delete-if #'(lambda (arg) (string-equal arg "love"))
+ (vector '("Love") '("LOve") '("LOVe") '("LOVE"))
+ :key #'car :count 10 :from-end t
+ :start 1 :end 3)
+ #(("Love") ("LOVE")))
+
+(string= (delete-if #'(lambda (arg) (string-equal arg #\a)) (copy-seq "abcabc"))
+ "bcbc")
+(string= (delete-if #'(lambda (arg) (string-equal arg #\a)) (copy-seq "")) "")
+(string= (delete-if #'(lambda (arg) (string-equal arg #\a)) (copy-seq "xyz"))
+ "xyz")
+(string= (delete-if #'(lambda (arg) (string-equal arg #\a)) (copy-seq "ABCABC")
+ :key #'char-downcase) "BCBC")
+(string= (delete-if #'(lambda (arg) (string-equal arg #\a)) (copy-seq "abcabc")
+ :count 1) "bcabc")
+(string= (delete-if #'(lambda (arg) (string-equal arg #\a)) (copy-seq "abcabc")
+ :count 1 :from-end t) "abcbc")
+(string= (delete-if #'(lambda (arg) (string-equal arg #\a)) (copy-seq "abcabc")
+ :count 0) "abcabc")
+(string= (delete-if #'(lambda (arg) (string-equal arg #\a)) (copy-seq "abcabc")
+ :count -10) "abcabc")
+(string= (delete-if #'(lambda (arg) (string-equal arg #\a)) (copy-seq "abcabc")
+ :count 0) "abcabc")
+(string= (delete-if #'(lambda (arg) (string-equal arg #\a)) (copy-seq "abcabc"))
+ "bcbc")
+(string= (delete-if #'(lambda (arg) (string-equal arg #\b)) (copy-seq "abcabc"))
+ "acac")
+(string= (delete-if #'(lambda (arg) (string-equal arg #\c)) (copy-seq "abcabc"))
+ "abab")
+(string= (delete-if #'(lambda (arg) (string-equal arg #\a)) (copy-seq "abcabc")
+ :count 0) "abcabc")
+(string= (delete-if #'(lambda (arg) (string-equal arg #\a)) (copy-seq "abcabc")
+ :count 1) "bcabc")
+(string= (delete-if #'(lambda (arg) (string-equal arg #\a)) (copy-seq "abcabc")
+ :count 1 :from-end t) "abcbc")
+(string= (delete-if #'(lambda (arg) (string-equal arg #\a)) (copy-seq "abcabc")
+ :count 2) "bcbc")
+(string= (delete-if #'(lambda (arg) (string-equal arg #\a)) (copy-seq "abcabc")
+ :count 2 :from-end t) "bcbc")
+(string= (delete-if #'(lambda (arg) (string-equal arg #\a)) (copy-seq "abcabc")
+ :count 3) "bcbc")
+(string= (delete-if #'(lambda (arg) (string-equal arg #\a)) (copy-seq "abcabc")
+ :count 3 :from-end t) "bcbc")
+(string= (delete-if #'(lambda (arg) (string-equal arg #\a)) (copy-seq "abcabc")
+ :count 4) "bcbc")
+(string= (delete-if #'(lambda (arg) (string-equal arg #\a)) (copy-seq "abcabc")
+ :count 4 :from-end t) "bcbc")
+(string= (delete-if #'(lambda (arg) (string-equal arg #\a)) (copy-seq "abcabc")
+ :count -1) "abcabc")
+(string= (delete-if #'(lambda (arg) (string-equal arg #\a)) (copy-seq "abcabc")
+ :count -10) "abcabc")
+(string= (delete-if #'(lambda (arg) (string-equal arg #\a)) (copy-seq "abcabc")
+ :count -100) "abcabc")
+(string= (delete-if #'(lambda (arg) (string-equal arg #\a))
+ (copy-seq "abcabcabcabc") :start 1) "abcbcbcbc")
+(string= (delete-if #'(lambda (arg) (string-equal arg #\a))
+ (copy-seq "abcabcabcabc") :start 1 :count 1) "abcbcabcabc")
+(string= (delete-if #'(lambda (arg) (eql arg #\a)) (copy-seq "abcabcabcabc")
+ :start 1 :count 2)
+ "abcbcbcabc")
+(string= (delete-if #'(lambda (arg) (eql arg #\a)) (copy-seq "abcabcabcabc")
+ :start 1 :end nil :count 2)
+ "abcbcbcabc")
+(string= (delete-if #'(lambda (arg) (eql arg #\a)) (copy-seq "abcabcabcabc")
+ :start 1 :end 8) "abcbcbcabc")
+(string= (delete-if #'(lambda (arg) (eql arg #\a)) (copy-seq "abcabcabcabc")
+ :start 1 :end 8 :count 1)
+ "abcbcabcabc")
+(string= (delete-if #'(lambda (arg) (eql arg #\a)) (copy-seq "abcabcabcabc")
+ :start 1 :end 8 :count 1 :from-end t)
+ "abcabcbcabc")
+(string= (delete-if #'(lambda (arg) (eql arg #\a)) (copy-seq "abcabcabcabc")
+ :start 1 :end 8 :count 0 :from-end t)
+ "abcabcabcabc")
+(string= (delete-if #'(lambda (arg) (eql arg #\a)) (copy-seq "abcabcabcabc")
+ :start 1 :end 8 :count -100 :from-end t)
+ "abcabcabcabc")
+(string= (delete-if #'(lambda (arg) (eql arg #\a)) (copy-seq "abcabcabcabc")
+ :start 1 :end 1)
+ "abcabcabcabc")
+(string= (delete-if #'(lambda (arg) (eql arg #\a)) (copy-seq "abcabcabcabc")
+ :start 2 :end 2) "abcabcabcabc")
+(string= (delete-if #'(lambda (arg) (eql arg #\a)) (copy-seq "abcabcabcabc")
+ :start 12 :end 12) "abcabcabcabc")
+(equal (delete-if #'zerop #*0101) #*11)
+(equal (delete-if #'zerop #*01010101 :count 1) #*1010101)
+(equal (delete-if #'zerop #*01010101 :count 1 :from-end t) #*0101011)
+(equal (delete-if #'zerop #*01010101 :start 1) #*01111)
+(equal (delete-if #'zerop #*01010101 :start 1 :end nil) #*01111)
+(equal (delete-if #'zerop #*01010101 :start 1 :end 6) #*011101)
+(equal (delete-if #'zerop #*01010101 :start 1 :end 6 :count 1) #*0110101)
+(equal (delete-if #'zerop #*01010101 :start 1 :end 6 :count 1 :from-end t)
+ #*0101101)
+(equal (delete-if #'oddp #*01010101 :start 1 :end 6 :count 1 :from-end t)
+ #*0101001)
+(equal (delete-if #'evenp #*01010101 :start 1 :end 6 :count 1 :from-end t)
+ #*0101101)
+(equal (delete-if #'plusp #*01010101
+ :start 1 :end 6 :count 1 :from-end t
+ :key #'(lambda (arg) (* arg 10)))
+ #*0101001)
+
+
+(equal (delete-if-not #'(lambda (arg) (not (eql arg 'a)))
+ (list 'a 'b 'c 'a 'b 'c))
+ '(b c b c))
+(equal (delete-if-not #'(lambda (arg) (not (eql arg 'b)))
+ (list 'a 'b 'c 'a 'b 'c))
+ '(a c a c))
+(equal (delete-if-not #'(lambda (arg) (not (eql arg 'c)))
+ (list 'a 'b 'c 'a 'b 'c))
+ '(a b a b))
+(equal (delete-if-not #'(lambda (arg) (not (eql arg 'a)))
+ (list 'a 'a 'a)) '())
+(equal (delete-if-not #'(lambda (arg) (not (eql arg 'z)))
+ (list 'a 'b 'c)) '(a b c))
+(equal (delete-if-not #'(lambda (arg) (not (eql arg 'a))) '()) '())
+(equal (delete-if-not #'(lambda (arg) (not (eql arg 'a)))
+ (list 'a 'b 'c 'a 'b 'c) :count 0) '(a b c a b c))
+(equal (delete-if-not #'(lambda (arg) (not (eql arg 'a)))
+ (list 'a 'b 'c 'a 'b 'c) :count 1) '(b c a b c))
+(equal (delete-if-not #'(lambda (arg) (not (eql arg 'a)))
+ (list 'a 'b 'c 'a 'b 'c) :count 1 :from-end t)
+ '(a b c b c))
+(equal (delete-if-not #'(lambda (arg) (not (eql arg 'a)))
+ (list 'a 'b 'c 'a 'b 'c) :count 2)
+ '(b c b c))
+(equal (delete-if-not #'(lambda (arg) (not (eql arg 'a)))
+ (list 'a 'b 'c 'a 'b 'c) :count 2 :from-end t)
+ '(b c b c))
+(equal (delete-if-not #'(lambda (arg) (not (eql arg 'a)))
+ (list 'a 'b 'c 'a 'b 'c) :count 3)
+ '(b c b c))
+(equal (delete-if-not #'(lambda (arg) (not (eql arg 'a)))
+ (list 'a 'b 'c 'a 'b 'c) :count 3 :from-end t)
+ '(b c b c))
+(equal (delete-if-not #'(lambda (arg) (not (eql arg 'a)))
+ (list 'a 'b 'c 'a 'b 'c) :count 4)
+ '(b c b c))
+(equal (delete-if-not #'(lambda (arg) (not (eql arg 'a)))
+ (list 'a 'b 'c 'a 'b 'c) :count 4 :from-end t)
+ '(b c b c))
+(equal (delete-if-not #'(lambda (arg) (not (eql arg 'a)))
+ (list 'a 'b 'c 'a 'b 'c) :count -1)
+ '(a b c a b c))
+(equal (delete-if-not #'(lambda (arg) (not (eql arg 'a)))
+ (list 'a 'b 'c 'a 'b 'c) :count -10)
+ '(a b c a b c))
+(equal (delete-if-not #'(lambda (arg) (not (eql arg 'a)))
+ (list 'a 'b 'c 'a 'b 'c) :count -100)
+ '(a b c a b c))
+(equal (delete-if-not #'(lambda (arg) (not (eql arg 'a)))
+ (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1)
+ '(a b c b c b c b c))
+(equal (delete-if-not #'(lambda (arg) (not (eql arg 'a)))
+ (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c)
+ :start 1 :count 1)
+ '(a b c b c a b c a b c))
+(equal (delete-if-not #'(lambda (arg) (not (eql arg 'a)))
+ (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c)
+ :start 1 :count 2)
+ '(a b c b c b c a b c))
+(equal (delete-if-not #'(lambda (arg) (not (eql arg 'a)))
+ (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c)
+ :start 1 :end nil :count 2)
+ '(a b c b c b c a b c))
+(equal (delete-if-not #'(lambda (arg) (not (eql arg 'a)))
+ (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8)
+ '(a b c b c b c a b c))
+(equal (delete-if-not #'(lambda (arg) (not (eql arg 'a)))
+ (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c)
+ :start 1 :end 8 :count 1)
+ '(a b c b c a b c a b c))
+(equal (delete-if-not #'(lambda (arg) (not (eql arg 'a)))
+ (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c)
+ :start 1 :end 8 :count 1 :from-end t)
+ '(a b c a b c b c a b c))
+(equal (delete-if-not #'(lambda (arg) (not (eql arg 'a)))
+ (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c)
+ :start 1 :end 8 :count 0 :from-end t)
+ '(a b c a b c a b c a b c))
+(equal (delete-if-not #'(lambda (arg) (not (eql arg 'a)))
+ (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c)
+ :start 1 :end 8 :count -100 :from-end t)
+ '(a b c a b c a b c a b c))
+(equal (delete-if-not #'(lambda (arg) (not (eql arg 'a)))
+ (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 1)
+ '(a b c a b c a b c a b c))
+(equal (delete-if-not #'(lambda (arg) (not (eql arg 'a)))
+ (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 2 :end 2)
+ '(a b c a b c a b c a b c))
+(equal (delete-if-not #'(lambda (arg) (not (eql arg 'a)))
+ (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c)
+ :start 12 :end 12)
+ '(a b c a b c a b c a b c))
+(equal (delete-if-not #'(lambda (arg) (not (eql arg 'a)))
+ (list '(a) '(b) '(c) '(a) '(b) '(c)) :key #'car)
+ '((b) (c) (b) (c)))
+(equal (delete-if-not #'(lambda (arg) (not (eql arg 'a)))
+ (list '(a . b) '(b . c) '(c . a)
+ '(a . b) '(b . c) '(c . a))
+ :key #'cdr)
+ '((a . b) (b . c) (a . b) (b . c)))
+(equal (delete-if-not #'(lambda (arg) (not (eql arg "love")))
+ (list '("Love") '("LOve") '("LOVe") '("LOVE"))
+ :key #'car)
+ '(("Love") ("LOve") ("LOVe") ("LOVE")))
+(equal (delete-if-not #'(lambda (arg) (not (eql arg "love")))
+ (list '("Love") '("LOve") '("LOVe") '("LOVE"))
+ :key #'car :count -10)
+ '(("Love") ("LOve") ("LOVe") ("LOVE")))
+(equal (delete-if-not #'(lambda (arg) (not (string-equal arg "love")))
+ (list '("Love") '("LOve") '("LOVe") '("LOVE"))
+ :key #'car)
+ '())
+(equal (delete-if-not #'(lambda (arg) (not (string-equal arg "love")))
+ (list '("Love") '("LOve") '("LOVe") '("LOVE"))
+ :key #'car :count 1)
+ '(("LOve") ("LOVe") ("LOVE")))
+(equal (delete-if-not #'(lambda (arg) (not (string-equal arg "love")))
+ (list '("Love") '("LOve") '("LOVe") '("LOVE"))
+ :key #'car :count 1 :from-end t)
+ '(("Love") ("LOve") ("LOVe")))
+(equal (delete-if-not #'(lambda (arg) (not (string-equal arg "love")))
+ (list '("Love") '("LOve") '("LOVe") '("LOVE"))
+ :key #'car :count 2 :from-end t)
+ '(("Love") ("LOve")))
+(equal (delete-if-not #'(lambda (arg) (not (string-equal arg "love")))
+ (list '("Love") '("LOve") '("LOVe") '("LOVE"))
+ :key #'car :start 1 :end 3)
+ '(("Love") ("LOVE")))
+(equal (delete-if-not #'(lambda (arg) (not (string-equal arg "love")))
+ (list '("Love") '("LOve") '("LOVe") '("LOVE"))
+ :key #'car :count 1 :start 1 :end 3)
+ '(("Love") ("LOVe") ("LOVE")))
+(equal (delete-if-not #'(lambda (arg) (not (string-equal arg "love")))
+ (list '("Love") '("LOve") '("LOVe") '("LOVE"))
+ :key #'car :count 1 :from-end t
+ :start 1 :end 3)
+ '(("Love") ("LOve") ("LOVE")))
+(equal (delete-if-not #'(lambda (arg) (not (string-equal arg "love")))
+ (list '("Love") '("LOve") '("LOVe") '("LOVE"))
+ :key #'car :count 10 :from-end t :start 1 :end 3)
+ '(("Love") ("LOVE")))
+
+
+(equalp (delete-if-not #'(lambda (arg) (not (eql arg 'a)))
+ (vector 'a 'b 'c 'a 'b 'c)) #(b c b c))
+(equalp (delete-if-not #'(lambda (arg) (not (eql arg 'b)))
+ (vector 'a 'b 'c 'a 'b 'c)) #(a c a c))
+(equalp (delete-if-not #'(lambda (arg) (not (eql arg 'c)))
+ (vector 'a 'b 'c 'a 'b 'c)) #(a b a b))
+(equalp (delete-if-not #'(lambda (arg) (not (eql arg 'a)))
+ (vector 'a 'a 'a)) #())
+(equalp (delete-if-not #'(lambda (arg) (not (eql arg 'z)))
+ (vector 'a 'b 'c)) #(a b c))
+(equalp (delete-if-not #'(lambda (arg) (not (eql arg 'a))) #()) #())
+(equalp (delete-if-not #'(lambda (arg) (not (eql arg 'a)))
+ (vector 'a 'b 'c 'a 'b 'c) :count 0) #(a b c a b c))
+(equalp (delete-if-not #'(lambda (arg) (not (eql arg 'a)))
+ (vector 'a 'b 'c 'a 'b 'c) :count 1) #(b c a b c))
+(equalp (delete-if-not #'(lambda (arg) (not (eql arg 'a)))
+ (vector 'a 'b 'c 'a 'b 'c) :count 1 :from-end t) #(a b c b c))
+(equalp (delete-if-not #'(lambda (arg) (not (eql arg 'a)))
+ (vector 'a 'b 'c 'a 'b 'c) :count 2) #(b c b c))
+(equalp (delete-if-not #'(lambda (arg) (not (eql arg 'a)))
+ (vector 'a 'b 'c 'a 'b 'c) :count 2 :from-end t) #(b c b c))
+(equalp (delete-if-not #'(lambda (arg) (not (eql arg 'a)))
+ (vector 'a 'b 'c 'a 'b 'c) :count 3) #(b c b c))
+(equalp (delete-if-not #'(lambda (arg) (not (eql arg 'a)))
+ (vector 'a 'b 'c 'a 'b 'c) :count 3 :from-end t) #(b c b c))
+(equalp (delete-if-not #'(lambda (arg) (not (eql arg 'a)))
+ (vector 'a 'b 'c 'a 'b 'c) :count 4) #(b c b c))
+(equalp (delete-if-not #'(lambda (arg) (not (eql arg 'a)))
+ (vector 'a 'b 'c 'a 'b 'c) :count 4 :from-end t) #(b c b c))
+(equalp (delete-if-not #'(lambda (arg) (not (eql arg 'a)))
+ (vector 'a 'b 'c 'a 'b 'c) :count -1) #(a b c a b c))
+(equalp (delete-if-not #'(lambda (arg) (not (eql arg 'a)))
+ (vector 'a 'b 'c 'a 'b 'c) :count -10) #(a b c a b c))
+(equalp (delete-if-not #'(lambda (arg) (not (eql arg 'a)))
+ (vector 'a 'b 'c 'a 'b 'c) :count -100) #(a b c a b c))
+(equalp (delete-if-not #'(lambda (arg) (not (eql arg 'a)))
+ (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1)
+ #(a b c b c b c b c))
+(equalp (delete-if-not #'(lambda (arg) (not (eql arg 'a)))
+ (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c)
+ :start 1 :count 1)
+ #(a b c b c a b c a b c))
+(equalp (delete-if-not #'(lambda (arg) (not (eql arg 'a)))
+ (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c)
+ :start 1 :count 2)
+ #(a b c b c b c a b c))
+(equalp (delete-if-not #'(lambda (arg) (not (eql arg 'a)))
+ (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c)
+ :start 1 :end nil :count 2)
+ #(a b c b c b c a b c))
+(equalp (delete-if-not #'(lambda (arg) (not (eql arg 'a)))
+ (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8)
+ #(a b c b c b c a b c))
+(equalp (delete-if-not #'(lambda (arg) (not (eql arg 'a)))
+ (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c)
+ :start 1 :end 8 :count 1)
+ #(a b c b c a b c a b c))
+(equalp (delete-if-not #'(lambda (arg) (not (eql arg 'a)))
+ (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c)
+ :start 1 :end 8 :count 1 :from-end t)
+ #(a b c a b c b c a b c))
+(equalp (delete-if-not #'(lambda (arg) (not (eql arg 'a)))
+ (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c)
+ :start 1 :end 8 :count 0 :from-end t)
+ #(a b c a b c a b c a b c))
+(equalp (delete-if-not #'(lambda (arg) (not (eql arg 'a)))
+ (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c)
+ :start 1 :end 8 :count -100 :from-end t)
+ #(a b c a b c a b c a b c))
+(equalp (delete-if-not #'(lambda (arg) (not (eql arg 'a)))
+ (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 1)
+ #(a b c a b c a b c a b c))
+(equalp (delete-if-not #'(lambda (arg) (not (eql arg 'a)))
+ (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 2 :end 2)
+ #(a b c a b c a b c a b c))
+(equalp (delete-if-not #'(lambda (arg) (not (eql arg 'a)))
+ (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c)
+ :start 12 :end 12)
+ #(a b c a b c a b c a b c))
+(equalp (delete-if-not #'(lambda (arg) (not (eql arg 'a)))
+ (vector '(a) '(b) '(c) '(a) '(b) '(c)) :key #'car)
+ #((b) (c) (b) (c)))
+(equalp (delete-if-not #'(lambda (arg) (not (eql arg 'a)))
+ (vector '(a . b) '(b . c) '(c . a)
+ '(a . b) '(b . c) '(c . a))
+ :key #'cdr)
+ #((a . b) (b . c) (a . b) (b . c)))
+(equalp (delete-if-not #'(lambda (arg) (not (eql arg "love")))
+ (vector '("Love") '("LOve") '("LOVe") '("LOVE"))
+ :key #'car)
+ #(("Love") ("LOve") ("LOVe") ("LOVE")))
+(equalp (delete-if-not #'(lambda (arg) (not (eql arg "love")))
+ (vector '("Love") '("LOve") '("LOVe") '("LOVE"))
+ :key #'car :count -10)
+ #(("Love") ("LOve") ("LOVe") ("LOVE")))
+(equalp (delete-if-not #'(lambda (arg) (not (string-equal arg "love")))
+ (vector '("Love") '("LOve") '("LOVe") '("LOVE"))
+ :key #'car)
+ #())
+(equalp (delete-if-not #'(lambda (arg) (not (string-equal arg "love")))
+ (vector '("Love") '("LOve") '("LOVe") '("LOVE"))
+ :key #'car)
+ #())
+(equalp (delete-if-not #'(lambda (arg) (not (string-equal arg "love")))
+ (vector '("Love") '("LOve") '("LOVe") '("LOVE"))
+ :key #'car :count 1)
+ #(("LOve") ("LOVe") ("LOVE")))
+(equalp (delete-if-not #'(lambda (arg) (not (string-equal arg "love")))
+ (vector '("Love") '("LOve") '("LOVe") '("LOVE"))
+ :key #'car :count 1)
+ #(("LOve") ("LOVe") ("LOVE")))
+(equalp (delete-if-not #'(lambda (arg) (not (string-equal arg "love")))
+ (vector '("Love") '("LOve") '("LOVe") '("LOVE"))
+ :key #'car :count 1 :from-end t)
+ #(("Love") ("LOve") ("LOVe")))
+(equalp (delete-if-not #'(lambda (arg) (not (string-equal arg "love")))
+ (vector '("Love") '("LOve") '("LOVe") '("LOVE"))
+ :key #'car :count 1 :from-end t)
+ #(("Love") ("LOve") ("LOVe")))
+(equalp (delete-if-not #'(lambda (arg) (not (string-equal arg "love")))
+ (vector '("Love") '("LOve") '("LOVe") '("LOVE"))
+ :key #'car :count 2 :from-end t)
+ #(("Love") ("LOve")))
+(equalp (delete-if-not #'(lambda (arg) (not (string-equal arg "love")))
+ (vector '("Love") '("LOve") '("LOVe") '("LOVE"))
+ :key #'car :count 2 :from-end t)
+ #(("Love") ("LOve")))
+(equalp (delete-if-not #'(lambda (arg) (not (string-equal arg "love")))
+ (vector '("Love") '("LOve") '("LOVe") '("LOVE"))
+ :key #'car :start 1 :end 3)
+ #(("Love") ("LOVE")))
+(equalp (delete-if-not #'(lambda (arg) (not (string-equal arg "love")))
+ (vector '("Love") '("LOve") '("LOVe") '("LOVE"))
+ :key #'car :count 1 :start 1 :end 3)
+ #(("Love") ("LOVe") ("LOVE")))
+(equalp (delete-if-not #'(lambda (arg) (not (string-equal arg "love")))
+ (vector '("Love") '("LOve") '("LOVe") '("LOVE"))
+ :key #'car :count 1 :from-end t
+ :start 1 :end 3)
+ #(("Love") ("LOve") ("LOVE")))
+(equalp (delete-if-not #'(lambda (arg) (not (string-equal arg "love")))
+ (vector '("Love") '("LOve") '("LOVe") '("LOVE"))
+ :key #'car :count 10 :from-end t
+ :start 1 :end 3)
+ #(("Love") ("LOVE")))
+
+(string= (delete-if-not #'(lambda (arg) (not (string-equal arg #\a)))
+ (copy-seq "abcabc"))
+ "bcbc")
+(string= (delete-if-not #'(lambda (arg) (not (string-equal arg #\a)))
+ (copy-seq "")) "")
+(string= (delete-if-not #'(lambda (arg) (not (string-equal arg #\a)))
+ (copy-seq "xyz"))
+ "xyz")
+(string= (delete-if-not #'(lambda (arg) (not (string-equal arg #\a)))
+ (copy-seq "ABCABC")
+ :key #'char-downcase) "BCBC")
+(string= (delete-if-not #'(lambda (arg) (not (string-equal arg #\a)))
+ (copy-seq "abcabc")
+ :count 1) "bcabc")
+(string= (delete-if-not #'(lambda (arg) (not (string-equal arg #\a)))
+ (copy-seq "abcabc")
+ :count 1 :from-end t) "abcbc")
+(string= (delete-if-not #'(lambda (arg) (not (string-equal arg #\a)))
+ (copy-seq "abcabc")
+ :count 0) "abcabc")
+(string= (delete-if-not #'(lambda (arg) (not (string-equal arg #\a)))
+ (copy-seq "abcabc")
+ :count -10) "abcabc")
+(string= (delete-if-not #'(lambda (arg) (not (string-equal arg #\a)))
+ (copy-seq "abcabc")
+ :count 0) "abcabc")
+(string= (delete-if-not #'(lambda (arg) (not (string-equal arg #\a)))
+ (copy-seq "abcabc"))
+ "bcbc")
+(string= (delete-if-not #'(lambda (arg) (not (string-equal arg #\b)))
+ (copy-seq "abcabc"))
+ "acac")
+(string= (delete-if-not #'(lambda (arg) (not (string-equal arg #\c)))
+ (copy-seq "abcabc"))
+ "abab")
+(string= (delete-if-not #'(lambda (arg) (not (string-equal arg #\a)))
+ (copy-seq "abcabc")
+ :count 0) "abcabc")
+(string= (delete-if-not #'(lambda (arg) (not (string-equal arg #\a)))
+ (copy-seq "abcabc")
+ :count 1) "bcabc")
+(string= (delete-if-not #'(lambda (arg) (not (string-equal arg #\a)))
+ (copy-seq "abcabc")
+ :count 1 :from-end t) "abcbc")
+(string= (delete-if-not #'(lambda (arg) (not (string-equal arg #\a)))
+ (copy-seq "abcabc")
+ :count 2) "bcbc")
+(string= (delete-if-not #'(lambda (arg) (not (string-equal arg #\a)))
+ (copy-seq "abcabc")
+ :count 2 :from-end t) "bcbc")
+(string= (delete-if-not #'(lambda (arg) (not (string-equal arg #\a)))
+ (copy-seq "abcabc")
+ :count 3) "bcbc")
+(string= (delete-if-not #'(lambda (arg) (not (string-equal arg #\a)))
+ (copy-seq "abcabc")
+ :count 3 :from-end t) "bcbc")
+(string= (delete-if-not #'(lambda (arg) (not (string-equal arg #\a)))
+ (copy-seq "abcabc")
+ :count 4) "bcbc")
+(string= (delete-if-not #'(lambda (arg) (not (string-equal arg #\a)))
+ (copy-seq "abcabc")
+ :count 4 :from-end t) "bcbc")
+(string= (delete-if-not #'(lambda (arg) (not (string-equal arg #\a)))
+ (copy-seq "abcabc")
+ :count -1) "abcabc")
+(string= (delete-if-not #'(lambda (arg) (not (string-equal arg #\a)))
+ (copy-seq "abcabc")
+ :count -10) "abcabc")
+(string= (delete-if-not #'(lambda (arg) (not (string-equal arg #\a)))
+ (copy-seq "abcabc")
+ :count -100) "abcabc")
+(string= (delete-if-not #'(lambda (arg) (not (string-equal arg #\a)))
+ (copy-seq "abcabcabcabc") :start 1) "abcbcbcbc")
+(string= (delete-if-not #'(lambda (arg) (not (string-equal arg #\a)))
+ (copy-seq "abcabcabcabc") :start 1 :count 1) "abcbcabcabc")
+(string= (delete-if-not #'(lambda (arg) (not (eql arg #\a)))
+ (copy-seq "abcabcabcabc") :start 1 :count 2)
+ "abcbcbcabc")
+(string= (delete-if-not #'(lambda (arg) (not (eql arg #\a)))
+ (copy-seq "abcabcabcabc") :start 1 :end nil :count 2)
+ "abcbcbcabc")
+(string= (delete-if-not #'(lambda (arg) (not (eql arg #\a)))
+ (copy-seq "abcabcabcabc") :start 1 :end 8) "abcbcbcabc")
+(string= (delete-if-not #'(lambda (arg) (not (eql arg #\a)))
+ (copy-seq "abcabcabcabc") :start 1 :end 8 :count 1)
+ "abcbcabcabc")
+(string= (delete-if-not #'(lambda (arg) (not (eql arg #\a)))
+ (copy-seq "abcabcabcabc")
+ :start 1 :end 8 :count 1 :from-end t)
+ "abcabcbcabc")
+(string= (delete-if-not #'(lambda (arg) (not (eql arg #\a)))
+ (copy-seq "abcabcabcabc")
+ :start 1 :end 8 :count 0 :from-end t)
+ "abcabcabcabc")
+(string= (delete-if-not #'(lambda (arg) (not (eql arg #\a)))
+ (copy-seq "abcabcabcabc")
+ :start 1 :end 8 :count -100 :from-end t)
+ "abcabcabcabc")
+(string= (delete-if-not #'(lambda (arg) (not (eql arg #\a)))
+ (copy-seq "abcabcabcabc") :start 1 :end 1)
+ "abcabcabcabc")
+(string= (delete-if-not #'(lambda (arg) (not (eql arg #\a)))
+ (copy-seq "abcabcabcabc")
+ :start 2 :end 2) "abcabcabcabc")
+(string= (delete-if-not #'(lambda (arg) (not (eql arg #\a)))
+ (copy-seq "abcabcabcabc")
+ :start 12 :end 12) "abcabcabcabc")
+(equal (delete-if-not (complement #'zerop) #*0101) #*11)
+(equal (delete-if-not (complement #'zerop) #*01010101 :count 1) #*1010101)
+(equal (delete-if-not (complement #'zerop) #*01010101 :count 1 :from-end t)
+ #*0101011)
+(equal (delete-if-not (complement #'zerop) #*01010101 :start 1) #*01111)
+(equal (delete-if-not (complement #'zerop) #*01010101 :start 1 :end nil) #*01111)
+(equal (delete-if-not (complement #'zerop) #*01010101 :start 1 :end 6) #*011101)
+(equal (delete-if-not (complement #'zerop) #*01010101 :start 1 :end 6 :count 1)
+ #*0110101)
+(equal (delete-if-not (complement #'zerop) #*01010101
+ :start 1 :end 6 :count 1 :from-end t)
+ #*0101101)
+(equal (delete-if-not (complement #'oddp) #*01010101
+ :start 1 :end 6 :count 1 :from-end t)
+ #*0101001)
+(equal (delete-if-not (complement #'evenp)
+ #*01010101 :start 1 :end 6 :count 1 :from-end t)
+ #*0101101)
+(equal (delete-if-not (complement #'plusp) #*01010101
+ :start 1 :end 6 :count 1 :from-end t
+ :key #'(lambda (arg) (* arg 10)))
+ #*0101001)
+
+
+(equal (remove-duplicates "aBcDAbCd" :test #'char-equal :from-end t) "aBcD")
+(equal (remove-duplicates '(a b c b d d e)) '(A C B D E))
+(equal (remove-duplicates '(a b c b d d e) :from-end t) '(A B C D E))
+(equal (remove-duplicates '((foo #\a) (bar #\%) (baz #\A))
+ :test #'char-equal :key #'cadr)
+ '((BAR #\%) (BAZ #\A)))
+(equal (remove-duplicates '((foo #\a) (bar #\%) (baz #\A))
+ :test #'char-equal :key #'cadr :from-end t)
+ '((FOO #\a) (BAR #\%)))
+(let* ((list0 (list 0 1 2 3 4 5 6))
+ (list (delete-duplicates list0 :key #'oddp :start 1 :end 6)))
+ (equal list '(0 4 5 6)))
+
+
+#-CLISP ;Bruno: The tests ignores ANSI CL "remove-duplicates returns a sequence
+ ; that may share with sequence or may be identical to sequence
+ ; if no elements need to be removed."
+(let* ((list0 (list 0 1 2))
+ (list (remove-duplicates list0)))
+ (and (not (eq list0 list))
+ (equal list0 '(0 1 2))
+ (equal list '(0 1 2))))
+(let* ((list0 (list 2 1 0 1 0 1 2))
+ (list (remove-duplicates list0)))
+ (and (not (eq list0 list))
+ (equal list0 '(2 1 0 1 0 1 2))
+ (equal list '(0 1 2))))
+#-CLISP ;Bruno: The tests ignores ANSI CL "remove-duplicates returns a sequence
+ ; that may share with sequence or may be identical to sequence if no
+ ; elements need to be removed."
+(let* ((vector0 (vector 0 1 2))
+ (vector (remove-duplicates vector0)))
+ (and (not (eq vector0 vector))
+ (equalp vector0 #(0 1 2))
+ (equalp vector #(0 1 2))))
+(let* ((vector0 (vector 2 1 0 1 0 1 2))
+ (vector (remove-duplicates vector0)))
+ (and (not (eq vector0 vector))
+ (equalp vector0 #(2 1 0 1 0 1 2))
+ (equalp vector #(0 1 2))))
+
+(equal (remove-duplicates (list 0 1 2 2 3 3 3)) '(0 1 2 3))
+(equal (remove-duplicates (list 0 0 0 2 0 1 1 2 2 2 1 1 1 1 2)) '(0 1 2))
+(equal (remove-duplicates (list 'a 'a 'b 'c 'c)) '(a b c))
+(equal (remove-duplicates (list 0 1 2)) '(0 1 2))
+(equal (remove-duplicates (list 2 0 2 1 1 1 0 0 0 1 2)) '(0 1 2))
+(equal (remove-duplicates (list)) '())
+(equal (remove-duplicates (list '(x . 0) '(y . 1) '(z . 2)
+ '(a . 0) '(b . 1) '(c . 2)) :key #'cdr)
+ '((a . 0) (b . 1) (c . 2)))
+(equal (remove-duplicates (list '(x . 0) '(y . 1) '(z . 2)
+ '(a . 0) '(b . 1) '(c . 2))
+ :key #'cdr
+ :test #'(lambda (a b) (and (oddp a) (oddp b))))
+ '((x . 0) (z . 2) (a . 0) (b . 1) (c . 2)))
+(equal (remove-duplicates (list '(x . 0) '(y . 1) '(z . 2)
+ '(a . 0) '(b . 1) '(c . 2))
+ :key #'cdr
+ :test-not #'(lambda (a b)
+ (not (and (oddp a) (oddp b)))))
+ '((x . 0) (z . 2) (a . 0) (b . 1) (c . 2)))
+(equal (remove-duplicates (list '(x . 0) '(y . 1) '(z . 2)
+ '(a . 0) '(b . 1) '(c . 2))
+ :key #'cdr
+ :test #'(lambda (a b) (and (evenp a) (evenp b))))
+ '((y . 1) (b . 1) (c . 2)))
+(equal (remove-duplicates (list '(x . 0) '(y . 1) '(z . 2)
+ '(a . 0) '(b . 1) '(c . 2))
+ :key #'cdr
+ :test-not #'(lambda (a b)
+ (not (and (evenp a) (evenp b)))))
+ '((y . 1) (b . 1) (c . 2)))
+(equal (remove-duplicates (list 0 1 2 0 1 2 0 1 2 0 1 2) :start 3 :end 9)
+ '(0 1 2 0 1 2 0 1 2))
+(equal (remove-duplicates (list '(0 . 0) '(1 . 1) '(2 . 2)
+ '(0 . 3) '(1 . 4) '(2 . 5)
+ '(0 . 6) '(1 . 7) '(2 . 8)
+ '(0 . 9) '(1 . 10) '(2 . 11)))
+ (list '(0 . 0) '(1 . 1) '(2 . 2)
+ '(0 . 3) '(1 . 4) '(2 . 5)
+ '(0 . 6) '(1 . 7) '(2 . 8)
+ '(0 . 9) '(1 . 10) '(2 . 11)))
+(equal (remove-duplicates (list '(0 . 0) '(1 . 1) '(2 . 2)
+ '(0 . 3) '(1 . 4) '(2 . 5)
+ '(0 . 6) '(1 . 7) '(2 . 8)
+ '(0 . 9) '(1 . 10) '(2 . 11))
+ :key #'car)
+ '((0 . 9) (1 . 10) (2 . 11)))
+(equal (remove-duplicates (list '(0 . 0) '(1 . 1) '(2 . 2)
+ '(0 . 3) '(1 . 4) '(2 . 5)
+ '(0 . 6) '(1 . 7) '(2 . 8)
+ '(0 . 9) '(1 . 10) '(2 . 11))
+ :key #'car :from-end t)
+ (list '(0 . 0) '(1 . 1) '(2 . 2)))
+(equal (remove-duplicates (list '(0 . 0) '(1 . 1) '(2 . 2)
+ '(0 . 3) '(1 . 4) '(2 . 5)
+ '(0 . 6) '(1 . 7) '(2 . 8)
+ '(0 . 9) '(1 . 10) '(2 . 11))
+ :start 3 :key #'car)
+ (list '(0 . 0) '(1 . 1) '(2 . 2)
+ '(0 . 9) '(1 . 10) '(2 . 11)))
+(equal (remove-duplicates (list '(0 . 0) '(1 . 1) '(2 . 2)
+ '(0 . 3) '(1 . 4) '(2 . 5)
+ '(0 . 6) '(1 . 7) '(2 . 8)
+ '(0 . 9) '(1 . 10) '(2 . 11))
+ :start 3 :key #'car :from-end t)
+ (list '(0 . 0) '(1 . 1) '(2 . 2)
+ '(0 . 3) '(1 . 4) '(2 . 5)))
+(equal (remove-duplicates (list '(0 . 0) '(1 . 1) '(2 . 2)
+ '(0 . 3) '(1 . 4) '(2 . 5)
+ '(0 . 6) '(1 . 7) '(2 . 8)
+ '(0 . 9) '(1 . 10) '(2 . 11))
+ :start 3 :end nil :key #'car)
+ (list '(0 . 0) '(1 . 1) '(2 . 2)
+ '(0 . 9) '(1 . 10) '(2 . 11)))
+(equal (remove-duplicates (list '(0 . 0) '(1 . 1) '(2 . 2)
+ '(0 . 3) '(1 . 4) '(2 . 5)
+ '(0 . 6) '(1 . 7) '(2 . 8)
+ '(0 . 9) '(1 . 10) '(2 . 11))
+ :start 3 :end 9 :key #'car)
+ '((0 . 0) (1 . 1) (2 . 2)
+ (0 . 6) (1 . 7) (2 . 8)
+ (0 . 9) (1 . 10) (2 . 11)))
+(equal (remove-duplicates (list '(0 . 0) '(1 . 1) '(2 . 2)
+ '(0 . 3) '(1 . 4) '(2 . 5)
+ '(0 . 6) '(1 . 7) '(2 . 8)
+ '(0 . 9) '(1 . 10) '(2 . 11))
+ :start 3 :end 9 :key #'car :from-end t)
+ (list '(0 . 0) '(1 . 1) '(2 . 2)
+ '(0 . 3) '(1 . 4) '(2 . 5)
+ '(0 . 9) '(1 . 10) '(2 . 11)))
+(equal (remove-duplicates (list "Monday" "Tuesday" "Wednesday" "Thursday"
+ "Friday" "Saturday" "Sunday")
+ :key #'length)
+ (list "Tuesday" "Wednesday" "Saturday" "Sunday"))
+(equal (remove-duplicates (list "Monday" "Tuesday" "Wednesday" "Thursday"
+ "Friday" "Saturday" "Sunday")
+ :key #'(lambda (arg) (char arg 0)) :test #'char=)
+ (list "Monday" "Wednesday" "Thursday" "Friday" "Sunday"))
+(equal (remove-duplicates (list "Monday" "Tuesday" "Wednesday" "Thursday"
+ "Friday" "Saturday" "Sunday")
+ :key #'(lambda (arg) (char arg 0))
+ :test-not (complement #'char=))
+ (list "Monday" "Wednesday" "Thursday" "Friday" "Sunday"))
+(equal (remove-duplicates (list #\a #\b #\c #\A #\B #\C) :key #'char-upcase)
+ '(#\A #\B #\C))
+(equal (remove-duplicates (list #\a #\b #\c #\A #\B #\C)
+ :key #'char-upcase :from-end t)
+ '(#\a #\b #\c))
+(equal (remove-duplicates (list #\a #\b #\c #\A #\B #\C) :test #'char=)
+ (list #\a #\b #\c #\A #\B #\C))
+(equal (remove-duplicates (list #\a #\b #\c #\A #\B #\C)
+ :test-not (complement #'char=))
+ (list #\a #\b #\c #\A #\B #\C))
+(equal (remove-duplicates (list #\a #\b #\c #\A #\B #\C) :test #'char-equal)
+ (list #\A #\B #\C))
+(equal (remove-duplicates (list #\a #\b #\c #\A #\B #\C)
+ :test-not (complement #'char-equal))
+ (list #\A #\B #\C))
+(equal (remove-duplicates (list #\a #\b #\c #\A #\B #\C)
+ :test #'char-equal :from-end t)
+ (list #\a #\b #\c))
+(equal (remove-duplicates (list #\a #\b #\c #\A #\B #\C)
+ :test-not (complement #'char-equal) :from-end t)
+ (list #\a #\b #\c))
+(equal (remove-duplicates (list #\a #\1 #\b #\1 #\2 #\c #\0 #\A #\0 #\B #\C #\9)
+ :key #'alpha-char-p)
+ (list #\C #\9))
+(equal (remove-duplicates (list #\a #\1 #\b #\1 #\2 #\c #\0 #\A #\0 #\B #\C #\9)
+ :key #'alphanumericp)
+ (list #\9))
+(equal (remove-duplicates (list '(#\A . 0) '(#\b . 1) '(#\C . 2)
+ '(#\a . 3) '(#\B . 4) '(#\c . 5)
+ '(#\A . 6) '(#\b . 7) '(#\C . 8)
+ '(#\a . 9) '(#\B . 10) '(#\c . 11)))
+ (list '(#\A . 0) '(#\b . 1) '(#\C . 2)
+ '(#\a . 3) '(#\B . 4) '(#\c . 5)
+ '(#\A . 6) '(#\b . 7) '(#\C . 8)
+ '(#\a . 9) '(#\B . 10) '(#\c . 11)))
+(equal (remove-duplicates (list '(#\A . 0) '(#\b . 1) '(#\C . 2)
+ '(#\a . 3) '(#\B . 4) '(#\c . 5)
+ '(#\A . 6) '(#\b . 7) '(#\C . 8)
+ '(#\a . 9) '(#\B . 10) '(#\c . 11))
+ :key #'car)
+ (list '(#\A . 6) '(#\b . 7) '(#\C . 8)
+ '(#\a . 9) '(#\B . 10) '(#\c . 11)))
+(equal (remove-duplicates (list '(#\A . 0) '(#\b . 1) '(#\C . 2)
+ '(#\a . 3) '(#\B . 4) '(#\c . 5)
+ '(#\A . 6) '(#\b . 7) '(#\C . 8)
+ '(#\a . 9) '(#\B . 10) '(#\c . 11))
+ :key #'car :start 3 :end 9)
+ (list '(#\A . 0) '(#\b . 1) '(#\C . 2)
+ '(#\a . 3) '(#\B . 4) '(#\c . 5)
+ '(#\A . 6) '(#\b . 7) '(#\C . 8)
+ '(#\a . 9) '(#\B . 10) '(#\c . 11)))
+(equal (remove-duplicates (list '(#\A . 0) '(#\b . 1) '(#\C . 2)
+ '(#\a . 3) '(#\B . 4) '(#\c . 5)
+ '(#\A . 6) '(#\b . 7) '(#\C . 8)
+ '(#\a . 9) '(#\B . 10) '(#\c . 11))
+ :key #'car :start 3 :end 9 :test #'char-equal)
+ (list '(#\A . 0) '(#\b . 1) '(#\C . 2)
+ '(#\A . 6) '(#\b . 7) '(#\C . 8)
+ '(#\a . 9) '(#\B . 10) '(#\c . 11)))
+(equal (remove-duplicates (list '(#\A . 0) '(#\b . 1) '(#\C . 2)
+ '(#\a . 3) '(#\B . 4) '(#\c . 5)
+ '(#\A . 6) '(#\b . 7) '(#\C . 8)
+ '(#\a . 9) '(#\B . 10) '(#\c . 11))
+ :key #'car :start 3 :end 9
+ :test-not (complement #'char-equal))
+ (list '(#\A . 0) '(#\b . 1) '(#\C . 2)
+ '(#\A . 6) '(#\b . 7) '(#\C . 8)
+ '(#\a . 9) '(#\B . 10) '(#\c . 11)))
+(equal (remove-duplicates (list '(#\A . 0) '(#\b . 1) '(#\C . 2)
+ '(#\a . 3) '(#\B . 4) '(#\c . 5)
+ '(#\A . 6) '(#\b . 7) '(#\C . 8)
+ '(#\a . 9) '(#\B . 10) '(#\c . 11))
+ :key #'car :start 3 :end 9 :test #'char-equal
+ :from-end t)
+ (list '(#\A . 0) '(#\b . 1) '(#\C . 2)
+ '(#\a . 3) '(#\B . 4) '(#\c . 5)
+ '(#\a . 9) '(#\B . 10) '(#\c . 11)))
+(equal (remove-duplicates (list '(#\A . 0) '(#\b . 1) '(#\C . 2)
+ '(#\a . 3) '(#\B . 4) '(#\c . 5)
+ '(#\A . 6) '(#\b . 7) '(#\C . 8)
+ '(#\a . 9) '(#\B . 10) '(#\c . 11))
+ :key #'car :start 3 :end 9
+ :test-not (complement #'char-equal) :from-end t)
+ (list '(#\A . 0) '(#\b . 1) '(#\C . 2)
+ '(#\a . 3) '(#\B . 4) '(#\c . 5)
+ '(#\a . 9) '(#\B . 10) '(#\c . 11)))
+(equal (remove-duplicates (list '(#\A . 0) '(#\b . 1) '(#\C . 2)
+ '(#\a . 3) '(#\B . 4) '(#\c . 5)
+ '(#\A . 6) '(#\b . 7) '(#\C . 8)
+ '(#\a . 9) '(#\B . 10) '(#\c . 11))
+ :key #'car :start 3)
+ (list '(#\A . 0) '(#\b . 1) '(#\C . 2)
+ '(#\A . 6) '(#\b . 7) '(#\C . 8)
+ '(#\a . 9) '(#\B . 10) '(#\c . 11)))
+(equal (remove-duplicates (list '(#\A . 0) '(#\b . 1) '(#\C . 2)
+ '(#\a . 3) '(#\B . 4) '(#\c . 5)
+ '(#\A . 6) '(#\b . 7) '(#\C . 8)
+ '(#\a . 9) '(#\B . 10) '(#\c . 11))
+ :key #'car :start 3 :end nil)
+ (list '(#\A . 0) '(#\b . 1) '(#\C . 2)
+ '(#\A . 6) '(#\b . 7) '(#\C . 8)
+ '(#\a . 9) '(#\B . 10) '(#\c . 11)))
+(equal (remove-duplicates (list '(#\A . 0) '(#\b . 1) '(#\C . 2)
+ '(#\a . 3) '(#\B . 4) '(#\c . 5)
+ '(#\A . 6) '(#\b . 7) '(#\C . 8)
+ '(#\a . 9) '(#\B . 10) '(#\c . 11))
+ :key #'car :start 3 :from-end t)
+ (list '(#\A . 0) '(#\b . 1) '(#\C . 2)
+ '(#\a . 3) '(#\B . 4) '(#\c . 5)
+ '(#\A . 6) '(#\b . 7) '(#\C . 8)))
+(equal (remove-duplicates (list '(#\A . 0) '(#\b . 1) '(#\C . 2)
+ '(#\a . 3) '(#\B . 4) '(#\c . 5)
+ '(#\A . 6) '(#\b . 7) '(#\C . 8)
+ '(#\a . 9) '(#\B . 10) '(#\c . 11))
+ :key #'car :end 9)
+ (list '(#\a . 3) '(#\B . 4) '(#\c . 5)
+ '(#\A . 6) '(#\b . 7) '(#\C . 8)
+ '(#\a . 9) '(#\B . 10) '(#\c . 11)))
+(equal (remove-duplicates (list '(#\A . 0) '(#\b . 1) '(#\C . 2)
+ '(#\a . 3) '(#\B . 4) '(#\c . 5)
+ '(#\A . 6) '(#\b . 7) '(#\C . 8)
+ '(#\a . 9) '(#\B . 10) '(#\c . 11))
+ :key #'car :end 9 :from-end t)
+ (list '(#\A . 0) '(#\b . 1) '(#\C . 2)
+ '(#\a . 3) '(#\B . 4) '(#\c . 5)
+ '(#\a . 9) '(#\B . 10) '(#\c . 11)))
+(equal (remove-duplicates (list '(#\A . 0) '(#\b . 1) '(#\C . 2)
+ '(#\a . 3) '(#\B . 4) '(#\c . 5)
+ '(#\A . 6) '(#\b . 7) '(#\C . 8)
+ '(#\a . 9) '(#\B . 10) '(#\c . 11))
+ :key #'car :start 0 :end 12 :test #'char-equal)
+ (list '(#\a . 9) '(#\B . 10) '(#\c . 11)))
+(equal (remove-duplicates (list '(#\A . 0) '(#\b . 1) '(#\C . 2)
+ '(#\a . 3) '(#\B . 4) '(#\c . 5)
+ '(#\A . 6) '(#\b . 7) '(#\C . 8)
+ '(#\a . 9) '(#\B . 10) '(#\c . 11))
+ :key #'car :start 0 :end 12
+ :test-not (complement #'char-equal))
+ (list '(#\a . 9) '(#\B . 10) '(#\c . 11)))
+(equal (remove-duplicates (list '(#\A . 0) '(#\b . 1) '(#\C . 2)
+ '(#\a . 3) '(#\B . 4) '(#\c . 5)
+ '(#\A . 6) '(#\b . 7) '(#\C . 8)
+ '(#\a . 9) '(#\B . 10) '(#\c . 11))
+ :key #'car :start 0 :end 12 :test #'char-equal
+ :from-end t)
+ '((#\A . 0) (#\b . 1) (#\C . 2)))
+(equal (remove-duplicates (list '(#\A . 0) '(#\b . 1) '(#\C . 2)
+ '(#\a . 3) '(#\B . 4) '(#\c . 5)
+ '(#\A . 6) '(#\b . 7) '(#\C . 8)
+ '(#\a . 9) '(#\B . 10) '(#\c . 11))
+ :key #'car :start 0 :end 12
+ :test-not (complement #'char-equal) :from-end t)
+ '((#\A . 0) (#\b . 1) (#\C . 2)))
+
+
+(equalp (remove-duplicates (vector 0 1 2 2 3 3 3)) #(0 1 2 3))
+(equalp (remove-duplicates (vector 0 0 0 2 0 1 1 2 2 2 1 1 1 1 2)) #(0 1 2))
+(equalp (remove-duplicates (vector 'a 'a 'b 'c 'c)) #(a b c))
+(equalp (remove-duplicates (vector 0 1 2)) #(0 1 2))
+(equalp (remove-duplicates (vector 2 0 2 1 1 1 0 0 0 1 2)) #(0 1 2))
+(equalp (remove-duplicates (vector)) #())
+(equalp (remove-duplicates (vector '(x . 0) '(y . 1) '(z . 2)
+ '(a . 0) '(b . 1) '(c . 2)) :key #'cdr)
+ #((a . 0) (b . 1) (c . 2)))
+(equalp (remove-duplicates (vector '(x . 0) '(y . 1) '(z . 2)
+ '(a . 0) '(b . 1) '(c . 2))
+ :key #'cdr
+ :test #'(lambda (a b) (and (oddp a) (oddp b))))
+ #((x . 0) (z . 2) (a . 0) (b . 1) (c . 2)))
+(equalp (remove-duplicates (vector '(x . 0) '(y . 1) '(z . 2)
+ '(a . 0) '(b . 1) '(c . 2))
+ :key #'cdr
+ :test-not #'(lambda (a b)
+ (not (and (oddp a) (oddp b)))))
+ #((x . 0) (z . 2) (a . 0) (b . 1) (c . 2)))
+(equalp (remove-duplicates (vector '(x . 0) '(y . 1) '(z . 2)
+ '(a . 0) '(b . 1) '(c . 2))
+ :key #'cdr
+ :test #'(lambda (a b) (and (evenp a) (evenp b))))
+ #((y . 1) (b . 1) (c . 2)))
+(equalp (remove-duplicates (vector '(x . 0) '(y . 1) '(z . 2)
+ '(a . 0) '(b . 1) '(c . 2))
+ :key #'cdr
+ :test-not #'(lambda (a b)
+ (not (and (evenp a) (evenp b)))))
+ #((y . 1) (b . 1) (c . 2)))
+(equalp (remove-duplicates (vector 0 1 2 0 1 2 0 1 2 0 1 2) :start 3 :end 9)
+ #(0 1 2 0 1 2 0 1 2))
+(equalp (remove-duplicates (vector '(0 . 0) '(1 . 1) '(2 . 2)
+ '(0 . 3) '(1 . 4) '(2 . 5)
+ '(0 . 6) '(1 . 7) '(2 . 8)
+ '(0 . 9) '(1 . 10) '(2 . 11)))
+ (vector '(0 . 0) '(1 . 1) '(2 . 2)
+ '(0 . 3) '(1 . 4) '(2 . 5)
+ '(0 . 6) '(1 . 7) '(2 . 8)
+ '(0 . 9) '(1 . 10) '(2 . 11)))
+(equalp (remove-duplicates (vector '(0 . 0) '(1 . 1) '(2 . 2)
+ '(0 . 3) '(1 . 4) '(2 . 5)
+ '(0 . 6) '(1 . 7) '(2 . 8)
+ '(0 . 9) '(1 . 10) '(2 . 11))
+ :key #'car)
+ #((0 . 9) (1 . 10) (2 . 11)))
+(equalp (remove-duplicates (vector '(0 . 0) '(1 . 1) '(2 . 2)
+ '(0 . 3) '(1 . 4) '(2 . 5)
+ '(0 . 6) '(1 . 7) '(2 . 8)
+ '(0 . 9) '(1 . 10) '(2 . 11))
+ :key #'car :from-end t)
+ (vector '(0 . 0) '(1 . 1) '(2 . 2)))
+(equalp (remove-duplicates (vector '(0 . 0) '(1 . 1) '(2 . 2)
+ '(0 . 3) '(1 . 4) '(2 . 5)
+ '(0 . 6) '(1 . 7) '(2 . 8)
+ '(0 . 9) '(1 . 10) '(2 . 11))
+ :start 3 :key #'car)
+ (vector '(0 . 0) '(1 . 1) '(2 . 2)
+ '(0 . 9) '(1 . 10) '(2 . 11)))
+(equalp (remove-duplicates (vector '(0 . 0) '(1 . 1) '(2 . 2)
+ '(0 . 3) '(1 . 4) '(2 . 5)
+ '(0 . 6) '(1 . 7) '(2 . 8)
+ '(0 . 9) '(1 . 10) '(2 . 11))
+ :start 3 :key #'car :from-end t)
+ (vector '(0 . 0) '(1 . 1) '(2 . 2)
+ '(0 . 3) '(1 . 4) '(2 . 5)))
+(equalp (remove-duplicates (vector '(0 . 0) '(1 . 1) '(2 . 2)
+ '(0 . 3) '(1 . 4) '(2 . 5)
+ '(0 . 6) '(1 . 7) '(2 . 8)
+ '(0 . 9) '(1 . 10) '(2 . 11))
+ :start 3 :end nil :key #'car)
+ (vector '(0 . 0) '(1 . 1) '(2 . 2)
+ '(0 . 9) '(1 . 10) '(2 . 11)))
+(equalp (remove-duplicates (vector '(0 . 0) '(1 . 1) '(2 . 2)
+ '(0 . 3) '(1 . 4) '(2 . 5)
+ '(0 . 6) '(1 . 7) '(2 . 8)
+ '(0 . 9) '(1 . 10) '(2 . 11))
+ :start 3 :end 9 :key #'car)
+ #((0 . 0) (1 . 1) (2 . 2)
+ (0 . 6) (1 . 7) (2 . 8)
+ (0 . 9) (1 . 10) (2 . 11)))
+(equalp (remove-duplicates (vector '(0 . 0) '(1 . 1) '(2 . 2)
+ '(0 . 3) '(1 . 4) '(2 . 5)
+ '(0 . 6) '(1 . 7) '(2 . 8)
+ '(0 . 9) '(1 . 10) '(2 . 11))
+ :start 3 :end 9 :key #'car :from-end t)
+ (vector '(0 . 0) '(1 . 1) '(2 . 2)
+ '(0 . 3) '(1 . 4) '(2 . 5)
+ '(0 . 9) '(1 . 10) '(2 . 11)))
+(equalp (remove-duplicates (vector "Monday" "Tuesday" "Wednesday" "Thursday"
+ "Friday" "Saturday" "Sunday")
+ :key #'length)
+ (vector "Tuesday" "Wednesday" "Saturday" "Sunday"))
+(equalp (remove-duplicates (vector "Monday" "Tuesday" "Wednesday" "Thursday"
+ "Friday" "Saturday" "Sunday")
+ :key #'(lambda (arg) (char arg 0)) :test #'char=)
+ (vector "Monday" "Wednesday" "Thursday" "Friday" "Sunday"))
+(equalp (remove-duplicates (vector "Monday" "Tuesday" "Wednesday" "Thursday"
+ "Friday" "Saturday" "Sunday")
+ :key #'(lambda (arg) (char arg 0))
+ :test-not (complement #'char=))
+ (vector "Monday" "Wednesday" "Thursday" "Friday" "Sunday"))
+(equalp (remove-duplicates (vector #\a #\b #\c #\A #\B #\C) :key #'char-upcase)
+ #(#\A #\B #\C))
+(equalp (remove-duplicates (vector #\a #\b #\c #\A #\B #\C)
+ :key #'char-upcase :from-end t)
+ #(#\a #\b #\c))
+(equalp (remove-duplicates (vector #\a #\b #\c #\A #\B #\C) :test #'char=)
+ (vector #\a #\b #\c #\A #\B #\C))
+(equalp (remove-duplicates (vector #\a #\b #\c #\A #\B #\C)
+ :test-not (complement #'char=))
+ (vector #\a #\b #\c #\A #\B #\C))
+(equalp (remove-duplicates (vector #\a #\b #\c #\A #\B #\C) :test #'char-equal)
+ (vector #\A #\B #\C))
+(equalp (remove-duplicates (vector #\a #\b #\c #\A #\B #\C)
+ :test-not (complement #'char-equal))
+ (vector #\A #\B #\C))
+(equalp (remove-duplicates (vector #\a #\b #\c #\A #\B #\C)
+ :test #'char-equal :from-end t)
+ (vector #\a #\b #\c))
+(equalp (remove-duplicates (vector #\a #\b #\c #\A #\B #\C)
+ :test-not (complement #'char-equal) :from-end t)
+ (vector #\a #\b #\c))
+
+(equalp (remove-duplicates
+ (vector #\a #\1 #\b #\1 #\2 #\c #\0 #\A #\0 #\B #\C #\9)
+ :key #'alpha-char-p)
+ (vector #\C #\9))
+(equalp (remove-duplicates
+ (vector #\a #\1 #\b #\1 #\2 #\c #\0 #\A #\0 #\B #\C #\9)
+ :key #'alphanumericp)
+ (vector #\9))
+(equalp (remove-duplicates (vector '(#\A . 0) '(#\b . 1) '(#\C . 2)
+ '(#\a . 3) '(#\B . 4) '(#\c . 5)
+ '(#\A . 6) '(#\b . 7) '(#\C . 8)
+ '(#\a . 9) '(#\B . 10) '(#\c . 11)))
+ (vector '(#\A . 0) '(#\b . 1) '(#\C . 2)
+ '(#\a . 3) '(#\B . 4) '(#\c . 5)
+ '(#\A . 6) '(#\b . 7) '(#\C . 8)
+ '(#\a . 9) '(#\B . 10) '(#\c . 11)))
+(equalp (remove-duplicates (vector '(#\A . 0) '(#\b . 1) '(#\C . 2)
+ '(#\a . 3) '(#\B . 4) '(#\c . 5)
+ '(#\A . 6) '(#\b . 7) '(#\C . 8)
+ '(#\a . 9) '(#\B . 10) '(#\c . 11))
+ :key #'car)
+ (vector '(#\A . 6) '(#\b . 7) '(#\C . 8)
+ '(#\a . 9) '(#\B . 10) '(#\c . 11)))
+(equalp (remove-duplicates (vector '(#\A . 0) '(#\b . 1) '(#\C . 2)
+ '(#\a . 3) '(#\B . 4) '(#\c . 5)
+ '(#\A . 6) '(#\b . 7) '(#\C . 8)
+ '(#\a . 9) '(#\B . 10) '(#\c . 11))
+ :key #'car :start 3 :end 9)
+ (vector '(#\A . 0) '(#\b . 1) '(#\C . 2)
+ '(#\a . 3) '(#\B . 4) '(#\c . 5)
+ '(#\A . 6) '(#\b . 7) '(#\C . 8)
+ '(#\a . 9) '(#\B . 10) '(#\c . 11)))
+(equalp (remove-duplicates (vector '(#\A . 0) '(#\b . 1) '(#\C . 2)
+ '(#\a . 3) '(#\B . 4) '(#\c . 5)
+ '(#\A . 6) '(#\b . 7) '(#\C . 8)
+ '(#\a . 9) '(#\B . 10) '(#\c . 11))
+ :key #'car :start 3 :end 9 :test #'char-equal)
+ (vector '(#\A . 0) '(#\b . 1) '(#\C . 2)
+ '(#\A . 6) '(#\b . 7) '(#\C . 8)
+ '(#\a . 9) '(#\B . 10) '(#\c . 11)))
+(equalp (remove-duplicates (vector '(#\A . 0) '(#\b . 1) '(#\C . 2)
+ '(#\a . 3) '(#\B . 4) '(#\c . 5)
+ '(#\A . 6) '(#\b . 7) '(#\C . 8)
+ '(#\a . 9) '(#\B . 10) '(#\c . 11))
+ :key #'car :start 3 :end 9
+ :test-not (complement #'char-equal))
+ (vector '(#\A . 0) '(#\b . 1) '(#\C . 2)
+ '(#\A . 6) '(#\b . 7) '(#\C . 8)
+ '(#\a . 9) '(#\B . 10) '(#\c . 11)))
+(equalp (remove-duplicates (vector '(#\A . 0) '(#\b . 1) '(#\C . 2)
+ '(#\a . 3) '(#\B . 4) '(#\c . 5)
+ '(#\A . 6) '(#\b . 7) '(#\C . 8)
+ '(#\a . 9) '(#\B . 10) '(#\c . 11))
+ :key #'car :start 3 :end 9 :test #'char-equal
+ :from-end t)
+ (vector '(#\A . 0) '(#\b . 1) '(#\C . 2)
+ '(#\a . 3) '(#\B . 4) '(#\c . 5)
+ '(#\a . 9) '(#\B . 10) '(#\c . 11)))
+(equalp (remove-duplicates (vector '(#\A . 0) '(#\b . 1) '(#\C . 2)
+ '(#\a . 3) '(#\B . 4) '(#\c . 5)
+ '(#\A . 6) '(#\b . 7) '(#\C . 8)
+ '(#\a . 9) '(#\B . 10) '(#\c . 11))
+ :key #'car :start 3 :end 9
+ :test-not (complement #'char-equal)
+ :from-end t)
+ (vector '(#\A . 0) '(#\b . 1) '(#\C . 2)
+ '(#\a . 3) '(#\B . 4) '(#\c . 5)
+ '(#\a . 9) '(#\B . 10) '(#\c . 11)))
+(equalp (remove-duplicates (vector '(#\A . 0) '(#\b . 1) '(#\C . 2)
+ '(#\a . 3) '(#\B . 4) '(#\c . 5)
+ '(#\A . 6) '(#\b . 7) '(#\C . 8)
+ '(#\a . 9) '(#\B . 10) '(#\c . 11))
+ :key #'car :start 3)
+ (vector '(#\A . 0) '(#\b . 1) '(#\C . 2)
+ '(#\A . 6) '(#\b . 7) '(#\C . 8)
+ '(#\a . 9) '(#\B . 10) '(#\c . 11)))
+(equalp (remove-duplicates (vector '(#\A . 0) '(#\b . 1) '(#\C . 2)
+ '(#\a . 3) '(#\B . 4) '(#\c . 5)
+ '(#\A . 6) '(#\b . 7) '(#\C . 8)
+ '(#\a . 9) '(#\B . 10) '(#\c . 11))
+ :key #'car :start 3 :end nil)
+ (vector '(#\A . 0) '(#\b . 1) '(#\C . 2)
+ '(#\A . 6) '(#\b . 7) '(#\C . 8)
+ '(#\a . 9) '(#\B . 10) '(#\c . 11)))
+(equalp (remove-duplicates (vector '(#\A . 0) '(#\b . 1) '(#\C . 2)
+ '(#\a . 3) '(#\B . 4) '(#\c . 5)
+ '(#\A . 6) '(#\b . 7) '(#\C . 8)
+ '(#\a . 9) '(#\B . 10) '(#\c . 11))
+ :key #'car :start 3 :from-end t)
+ (vector '(#\A . 0) '(#\b . 1) '(#\C . 2)
+ '(#\a . 3) '(#\B . 4) '(#\c . 5)
+ '(#\A . 6) '(#\b . 7) '(#\C . 8)))
+(equalp (remove-duplicates (vector '(#\A . 0) '(#\b . 1) '(#\C . 2)
+ '(#\a . 3) '(#\B . 4) '(#\c . 5)
+ '(#\A . 6) '(#\b . 7) '(#\C . 8)
+ '(#\a . 9) '(#\B . 10) '(#\c . 11))
+ :key #'car :end 9)
+ (vector '(#\a . 3) '(#\B . 4) '(#\c . 5)
+ '(#\A . 6) '(#\b . 7) '(#\C . 8)
+ '(#\a . 9) '(#\B . 10) '(#\c . 11)))
+(equalp (remove-duplicates (vector '(#\A . 0) '(#\b . 1) '(#\C . 2)
+ '(#\a . 3) '(#\B . 4) '(#\c . 5)
+ '(#\A . 6) '(#\b . 7) '(#\C . 8)
+ '(#\a . 9) '(#\B . 10) '(#\c . 11))
+ :key #'car :end 9 :from-end t)
+ (vector '(#\A . 0) '(#\b . 1) '(#\C . 2)
+ '(#\a . 3) '(#\B . 4) '(#\c . 5)
+ '(#\a . 9) '(#\B . 10) '(#\c . 11)))
+(equalp (remove-duplicates (vector '(#\A . 0) '(#\b . 1) '(#\C . 2)
+ '(#\a . 3) '(#\B . 4) '(#\c . 5)
+ '(#\A . 6) '(#\b . 7) '(#\C . 8)
+ '(#\a . 9) '(#\B . 10) '(#\c . 11))
+ :key #'car :start 0 :end 12 :test #'char-equal)
+ (vector '(#\a . 9) '(#\B . 10) '(#\c . 11)))
+(equalp (remove-duplicates (vector '(#\A . 0) '(#\b . 1) '(#\C . 2)
+ '(#\a . 3) '(#\B . 4) '(#\c . 5)
+ '(#\A . 6) '(#\b . 7) '(#\C . 8)
+ '(#\a . 9) '(#\B . 10) '(#\c . 11))
+ :key #'car :start 0 :end 12
+ :test-not (complement #'char-equal))
+ (vector '(#\a . 9) '(#\B . 10) '(#\c . 11)))
+(equalp (remove-duplicates (vector '(#\A . 0) '(#\b . 1) '(#\C . 2)
+ '(#\a . 3) '(#\B . 4) '(#\c . 5)
+ '(#\A . 6) '(#\b . 7) '(#\C . 8)
+ '(#\a . 9) '(#\B . 10) '(#\c . 11))
+ :key #'car :start 0 :end 12 :test #'char-equal
+ :from-end t)
+ #((#\A . 0) (#\b . 1) (#\C . 2)))
+(equalp (remove-duplicates (vector '(#\A . 0) '(#\b . 1) '(#\C . 2)
+ '(#\a . 3) '(#\B . 4) '(#\c . 5)
+ '(#\A . 6) '(#\b . 7) '(#\C . 8)
+ '(#\a . 9) '(#\B . 10) '(#\c . 11))
+ :key #'car :start 0 :end 12
+ :test-not (complement #'char-equal) :from-end t)
+ #((#\A . 0) (#\b . 1) (#\C . 2)))
+
+(string= (remove-duplicates (copy-seq "")) "")
+(string= (remove-duplicates (copy-seq "abc")) "abc")
+(string= (remove-duplicates (copy-seq "abcabc")) "abc")
+(string= (remove-duplicates (copy-seq "cbaabc")) "abc")
+(string= (remove-duplicates (copy-seq "cbaabc") :from-end t) "cba")
+(string= (remove-duplicates (copy-seq "cbaabcABCCBA")) "abcCBA")
+(string= (remove-duplicates (copy-seq "cbaabcABCCBA") :from-end t) "cbaABC")
+(string= (remove-duplicates (copy-seq "cbaabcABCCBA") :key #'char-downcase)
+ "CBA")
+(string= (remove-duplicates (copy-seq "cbaabcABCCBA")
+ :key #'char-downcase :from-end t)
+ "cba")
+(string= (remove-duplicates (copy-seq "cbaabcABCCBA") :start 3) "cbaabcCBA")
+(string= (remove-duplicates (copy-seq "cbaabcABCCBA") :start 3 :from-end t)
+ "cbaabcABC")
+(string= (remove-duplicates (copy-seq "cbaabcABCCBA") :start 3 :end 9)
+ "cbaabcABCCBA")
+(string= (remove-duplicates (copy-seq "cbaabcABCCBA")
+ :start 3 :end 9 :key #'char-upcase)
+ "cbaABCCBA")
+(string= (remove-duplicates (copy-seq "cbaabcABCCBA")
+ :start 3 :end 9 :key #'char-upcase :from-end t)
+ "cbaabcCBA")
+(string= (remove-duplicates (copy-seq "cbaabcABCCBA")
+ :start 3 :end 9 :test #'char-equal :from-end t)
+ "cbaabcCBA")
+(string= (remove-duplicates (copy-seq "cbaabcABCCBA")
+ :start 3 :end 9 :test-not (complement #'char-equal)
+ :from-end t)
+ "cbaabcCBA")
+(string= (remove-duplicates (copy-seq "cbaabcABCCBA")
+ :start 3 :end 9 :key #'upper-case-p :test #'eq)
+ "cbacCCBA")
+(string= (remove-duplicates (copy-seq "cbaabcABCCBA")
+ :start 3 :end 9 :key #'upper-case-p :test #'eq
+ :from-end t)
+ "cbaaACBA")
+(equal (remove-duplicates (copy-seq #*0011)) #*01)
+(equal (remove-duplicates (copy-seq #*0110)) #*10)
+(equal (remove-duplicates (copy-seq #*0110) :from-end t) #*01)
+(equal (remove-duplicates (copy-seq #*0110) :start 1) #*010)
+(equal (remove-duplicates (copy-seq #*0001111011000100010)) #*10)
+(equal (remove-duplicates (copy-seq #*0001111011000100010) :from-end t) #*01)
+(equal (remove-duplicates (copy-seq #*)) #*)
+(equal (remove-duplicates (copy-seq #*01)) #*01)
+(equal (remove-duplicates (copy-seq #*10)) #*10)
+(equal (remove-duplicates (copy-seq #*0)) #*0)
+(equal (remove-duplicates (copy-seq #*1)) #*1)
+(equal (remove-duplicates (copy-seq #*1001) :start 1 :end 3) #*101)
+(equal (remove-duplicates (copy-seq #*01011010) :start 2 :end 6) #*011010)
+(equal (remove-duplicates (copy-seq #*01011010) :start 2 :end 6 :from-end t)
+ #*010110)
+(equal (remove-duplicates (copy-seq #*01011010)
+ :start 2 :end 6 :from-end t
+ :key #'(lambda (arg) (char "aA" arg)))
+ #*010110)
+(equal (remove-duplicates (copy-seq #*01011010)
+ :start 2 :end 6 :from-end t
+ :key #'(lambda (arg) (char "aA" arg))
+ :test #'char-equal)
+ #*01010)
+(equal (remove-duplicates (copy-seq #*01011010)
+ :start 2 :end 6 :from-end t
+ :key #'(lambda (arg) (char "aA" arg))
+ :test-not (complement #'char-equal))
+ #*01010)
+(equal (remove-duplicates (copy-seq #*01011010)
+ :start 2 :end 6
+ :key #'(lambda (arg) (char "aA" arg))
+ :test #'char-equal)
+ #*01010)
+(equal (remove-duplicates (copy-seq #*01011010)
+ :start 2 :end 6
+ :key #'(lambda (arg) (char "aA" arg))
+ :test-not (complement #'char-equal))
+ #*01010)
diff --git a/Sacla/tests/must-sequence.patch b/Sacla/tests/must-sequence.patch
new file mode 100644
index 0000000..0c01d53
--- /dev/null
+++ b/Sacla/tests/must-sequence.patch
@@ -0,0 +1,26 @@
+*** sacla/lisp/test/must-sequence.lisp 2004-08-03 08:34:55.000000000 +0200
+--- CLISP/clisp-20040712/sacla-tests/must-sequence.lisp 2004-08-06 03:23:37.000000000 +0200
+***************
+*** 9545,9550 ****
+--- 9545,9553 ----
+ (equal list '(0 4 5 6)))
+
+
++ #-CLISP ; The tests ignores ANSI CL "remove-duplicates returns a sequence that
++ ; may share with sequence or may be identical to sequence if no elements
++ ; need to be removed."
+ (let* ((list0 (list 0 1 2))
+ (list (remove-duplicates list0)))
+ (and (not (eq list0 list))
+***************
+*** 9555,9560 ****
+--- 9558,9566 ----
+ (and (not (eq list0 list))
+ (equal list0 '(2 1 0 1 0 1 2))
+ (equal list '(0 1 2))))
++ #-CLISP ; The tests ignores ANSI CL "remove-duplicates returns a sequence that
++ ; may share with sequence or may be identical to sequence if no elements
++ ; need to be removed."
+ (let* ((vector0 (vector 0 1 2))
+ (vector (remove-duplicates vector0)))
+ (and (not (eq vector0 vector))
diff --git a/Sacla/tests/must-string.lisp b/Sacla/tests/must-string.lisp
new file mode 100644
index 0000000..763d747
--- /dev/null
+++ b/Sacla/tests/must-string.lisp
@@ -0,0 +1,608 @@
+;; Copyright (C) 2002-2004, Yuji Minejima <ggb01164@nifty.ne.jp>
+;; ALL RIGHTS RESERVED.
+;;
+;; $Id: must-string.lisp,v 1.7 2004/02/20 07:23:42 yuji Exp $
+;;
+;; Redistribution and use in source and binary forms, with or without
+;; modification, are permitted provided that the following conditions
+;; are met:
+;;
+;; * Redistributions of source code must retain the above copyright
+;; notice, this list of conditions and the following disclaimer.
+;; * 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.
+;;
+;; 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
+;; OWNER 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.
+
+(simple-string-p "")
+(simple-string-p "abc")
+(not (simple-string-p 'not-a-string))
+(let ((str (make-array 3 :element-type 'character :fill-pointer t)))
+ (if (not (simple-vector-p str))
+ (not (simple-string-p str))
+ (simple-string-p str)))
+
+(char= (char "abc" 0) #\a)
+(char= (char "abc" 1) #\b)
+(char= (char "abc" 2) #\c)
+(char= (schar "abc" 0) #\a)
+(char= (schar "abc" 1) #\b)
+(char= (schar "abc" 2) #\c)
+(let ((str (make-array 10
+ :element-type 'character
+ :fill-pointer 3
+ :initial-contents "0123456789")))
+ (and (string= str "012")
+ (char= (char str 3) #\3)
+ (char= (char str 4) #\4)
+ (char= (char str 5) #\5)
+ (char= (char str 6) #\6)
+ (char= (char str 7) #\7)
+ (char= (char str 8) #\8)
+ (char= (char str 9) #\9)
+ (char= (vector-pop str) #\2)))
+
+(string= (string "") "")
+(string= (string "abc") "abc")
+(string= (string "a") "a")
+(string= (string 'abc) "ABC")
+(string= (string 'a) "A")
+(string= (string #\a) "a")
+
+
+(string= (string-upcase "abcde") "ABCDE")
+(string= (string-upcase "Dr. Livingston, I presume?")
+ "DR. LIVINGSTON, I PRESUME?")
+(string= (string-upcase "Dr. Livingston, I presume?" :start 6 :end 10)
+ "Dr. LiVINGston, I presume?")
+(string= (string-upcase 'Kludgy-HASH-Search) "KLUDGY-HASH-SEARCH")
+(string= (string-upcase "abcde" :start 2 :end nil) "abCDE")
+
+(string= (string-downcase "Dr. Livingston, I presume?")
+ "dr. livingston, i presume?")
+(string= (string-downcase 'Kludgy-HASH-Search) "kludgy-hash-search")
+(string= (string-downcase "A FOOL" :start 2 :end nil) "A fool")
+(string= (string-capitalize "elm 13c arthur;fig don't")
+ "Elm 13c Arthur;Fig Don'T")
+(string= (string-capitalize " hello ") " Hello ")
+(string= (string-capitalize
+ "occlUDeD cASEmenTs FOreSTAll iNADVertent DEFenestraTION")
+ "Occluded Casements Forestall Inadvertent Defenestration")
+(string= (string-capitalize 'kludgy-hash-search) "Kludgy-Hash-Search")
+(string= (string-capitalize "DON'T!") "Don'T!") ;not "Don't!"
+(string= (string-capitalize "pipe 13a, foo16c") "Pipe 13a, Foo16c")
+(string= (string-capitalize "a fool" :start 2 :end nil) "a Fool")
+
+(let ((str (copy-seq "0123ABCD890a")))
+ (and (string= (nstring-downcase str :start 5 :end 7) "0123AbcD890a")
+ (string= str "0123AbcD890a")))
+
+(let* ((str0 (copy-seq "abcde"))
+ (str (nstring-upcase str0)))
+ (and (eq str0 str)
+ (string= str "ABCDE")))
+(let* ((str0 (copy-seq "Dr. Livingston, I presume?"))
+ (str (nstring-upcase str0)))
+ (and (eq str0 str)
+ (string= str "DR. LIVINGSTON, I PRESUME?")))
+(let* ((str0 (copy-seq "Dr. Livingston, I presume?"))
+ (str (nstring-upcase str0 :start 6 :end 10)))
+ (and (eq str0 str)
+ (string= str "Dr. LiVINGston, I presume?")))
+
+(let* ((str0 (copy-seq "abcde"))
+ (str (nstring-upcase str0 :start 2 :end nil)))
+ (string= str "abCDE"))
+
+
+
+(let* ((str0 (copy-seq "Dr. Livingston, I presume?"))
+ (str (nstring-downcase str0)))
+ (and (eq str0 str)
+ (string= str "dr. livingston, i presume?")))
+(let* ((str0 (copy-seq "ABCDE"))
+ (str (nstring-downcase str0 :start 2 :end nil)))
+ (string= str "ABcde"))
+
+(let* ((str0 (copy-seq "elm 13c arthur;fig don't"))
+ (str (nstring-capitalize str0)))
+ (and (eq str0 str)
+ (string= str "Elm 13c Arthur;Fig Don'T")))
+
+(let* ((str0 (copy-seq " hello "))
+ (str (nstring-capitalize str0)))
+ (and (eq str0 str)
+ (string= str " Hello ")))
+(let* ((str0 (copy-seq
+ "occlUDeD cASEmenTs FOreSTAll iNADVertent DEFenestraTION"))
+ (str (nstring-capitalize str0)))
+ (and (eq str0 str)
+ (string= str
+ "Occluded Casements Forestall Inadvertent Defenestration")))
+(let* ((str0 (copy-seq "DON'T!"))
+ (str (nstring-capitalize str0)))
+ (and (eq str0 str)
+ (string= str "Don'T!"))) ;not "Don't!"
+(let* ((str0 (copy-seq "pipe 13a, foo16c"))
+ (str (nstring-capitalize str0)))
+ (and (eq str0 str)
+ (string= str "Pipe 13a, Foo16c")))
+(let* ((str0 (copy-seq "a fool"))
+ (str (nstring-capitalize str0 :start 2 :end nil)))
+ (string= str "a Fool"))
+
+
+
+(string= (string-trim "abc" "abcaakaaakabcaaa") "kaaak")
+(string= (string-trim '(#\Space #\Tab #\Newline) " garbanzo beans
+ ") "garbanzo beans")
+(string= (string-trim " (*)" " ( *three (silly) words* ) ")
+ "three (silly) words")
+(string= (string-left-trim "abc" "labcabcabc") "labcabcabc")
+(string= (string-left-trim " (*)" " ( *three (silly) words* ) ")
+ "three (silly) words* ) ")
+(string= (string-right-trim " (*)" " ( *three (silly) words* ) ")
+ " ( *three (silly) words")
+(string= (string-trim "ABC" "abc") "abc")
+(string= (string-trim "AABBCC" "abc") "abc")
+(string= (string-trim "" "abc") "abc")
+(string= (string-trim "ABC" "") "")
+(string= (string-trim "cba" "abc") "")
+(string= (string-trim "cba" "abccba") "")
+(string= (string-trim "ccbbba" "abccba") "")
+(string= (string-trim "cba" "abcxabc") "x")
+(string= (string-trim "xyz" "xxyabcxyyz") "abc")
+(string= (string-trim "CBA" 'abcxabc) "X")
+(string= (string-trim "a" #\a) "")
+
+
+(string= (string-left-trim "ABC" "abc") "abc")
+(string= (string-left-trim "" "abc") "abc")
+(string= (string-left-trim "ABC" "") "")
+(string= (string-left-trim "cba" "abc") "")
+(string= (string-left-trim "cba" "abccba") "")
+(string= (string-left-trim "cba" "abcxabc") "xabc")
+(string= (string-left-trim "xyz" "xxyabcxyz") "abcxyz")
+(string= (string-left-trim "CBA" 'abcxabc) "XABC")
+(string= (string-left-trim "a" #\a) "")
+
+(string= (string-right-trim "ABC" "abc") "abc")
+(string= (string-right-trim "" "abc") "abc")
+(string= (string-right-trim "ABC" "") "")
+(string= (string-right-trim "cba" "abc") "")
+(string= (string-right-trim "cba" "abccba") "")
+(string= (string-right-trim "cba" "abcxabc") "abcx")
+(string= (string-right-trim "xyz" "xxyabcxyz") "xxyabc")
+(string= (string-right-trim "CBA" 'abcxabc) "ABCX")
+(string= (string-right-trim "a" #\a) "")
+
+
+
+(string= (string "already a string") "already a string")
+(string= (string 'elm) "ELM")
+(string= (string #\c) "c")
+
+
+(string= "foo" "foo")
+(not (string= "foo" "Foo"))
+(not (string= "foo" "bar"))
+(string= "together" "frog" :start1 1 :end1 3 :start2 2)
+(string-equal "foo" "Foo")
+(string= "abcd" "01234abcd9012" :start2 5 :end2 9)
+(eql (string< "aaaa" "aaab") 3)
+(eql (string>= "aaaaa" "aaaa") 4)
+(eql (string-not-greaterp "Abcde" "abcdE") 5)
+(eql (string-lessp "012AAAA789" "01aaab6"
+ :start1 3 :end1 7
+ :start2 2 :end2 6) 6)
+(not (string-not-equal "AAAA" "aaaA"))
+
+
+(string= "" "")
+(string= (make-array 0 :element-type 'character)
+ (make-array 0 :element-type 'base-char))
+(not (string= "abc" ""))
+(not (string= "" "abc"))
+(not (string= "A" "a"))
+(string= "abc" "xyz" :start1 3 :start2 3)
+(string= "abc" "xyz" :start1 1 :end1 1 :start2 0 :end2 0)
+(string= "axyza" "xyz" :start1 1 :end1 4)
+(string= "axyza" "xyz" :start1 1 :end1 4 :start2 0 :end2 nil)
+(string= "abxyz" "xyabz" :end1 2 :start2 2 :end2 4)
+(not (string= "love" "hate"))
+(string= 'love 'love)
+(not (string= 'love "hate"))
+(string= #\a #\a)
+
+
+(not (string/= "" ""))
+(not (string/= (make-array 0 :element-type 'character)
+ (make-array 0 :element-type 'base-char)))
+(eql (string/= "abc" "") 0)
+(eql (string/= "" "abc") 0)
+(eql (string/= "A" "a") 0)
+(not (string/= "abc" "xyz" :start1 3 :start2 3))
+(not (string/= "abc" "xyz" :start1 1 :end1 1 :start2 0 :end2 0))
+(not (string/= "axyza" "xyz" :start1 1 :end1 4))
+(not (string/= "axyza" "xyz" :start1 1 :end1 4 :start2 0 :end2 nil))
+(not (string/= "abxyz" "xyabz" :end1 2 :start2 2 :end2 4))
+(eql (string/= "love" "hate") 0)
+(eql (string/= "love" "loVe") 2)
+(not (string/= "life" "death" :start1 3 :start2 1 :end2 2))
+(eql (string/= "abcxyz" "ABCxyZ" :start1 3 :start2 3) 5)
+(eql (string/= "abcxyz" "ABCxyZ" :start1 3 :end1 nil :start2 3 :end2 nil) 5)
+(eql (string/= "abcxyz" "ABCxyZ" :end1 nil :start2 3 :end2 3) 0)
+(eql (string/= "abc" "abcxyz") 3)
+(eql (string/= "abcxyz" "abc") 3)
+(eql (string/= "abcxyz" "") 0)
+(eql (string/= "AbcDef" "cdef" :start1 2) 3)
+(eql (string/= "cdef" "AbcDef" :start2 2) 1)
+(= (string/= 'love "hate") 0)
+(not (string/= 'love 'love))
+(not (string/= #\a #\a))
+(= (string/= #\a #\b) 0)
+
+(not (string< "" ""))
+(not (string< "dog" "dog"))
+(not (string< " " " "))
+(not (string< "abc" ""))
+(eql (string< "" "abc") 0)
+(eql (string< "ab" "abc") 2)
+(not (string< "abc" "ab"))
+(eql (string< "aaa" "aba") 1)
+(not (string< "aba" "aaa"))
+(not (string< "my cat food" "your dog food" :start1 6 :start2 8))
+(not (string< "cat food 2 dollars" "dog food 3 dollars"
+ :start1 3 :end1 9 :start2 3 :end2 9))
+(eql (string< "xyzabc" "abcd" :start1 3) 6)
+(eql (string< "abc" "abc" :end1 1) 1)
+(eql (string< "xyzabc" "abc" :start1 3 :end1 5) 5)
+(eql (string< "xyz" "abcxyzXYZ" :start2 3) 3)
+(not (string< "abc" "abcxyz" :end2 3))
+(eql (string< "xyz" "abcxyz" :end1 2 :start2 3) 2)
+(not (string< "xyzabc" "abcdef" :start1 3 :end2 3))
+(eql (string< "aaaa" "z") 0)
+(eql (string< "pppTTTaTTTqqq" "pTTTxTTT" :start1 3 :start2 1) 6)
+(eql (string< "pppTTTaTTTqqq" "pTTTxTTT"
+ :start1 6 :end1 7
+ :start2 4 :end2 5) 6)
+(not (string< (make-array 0 :element-type 'character)
+ (make-array 0 :element-type 'base-char)))
+(not (string< 'love 'hate))
+(= (string< 'peace 'war) 0)
+(not (string< 'love 'love))
+(not (string< #\a #\a))
+(= (string< #\a #\b) 0)
+
+
+(not (string> "" ""))
+(not (string> "dog" "dog"))
+(not (string> " " " "))
+(eql (string> "abc" "") 0)
+(not (string> "" "abc"))
+(not (string> "ab" "abc"))
+(eql (string> "abc" "ab") 2)
+(eql (string> "aba" "aaa") 1)
+(not (string> "aaa" "aba"))
+(not (string> "my cat food" "your dog food" :start1 6 :start2 8))
+(not (string> "cat food 2 dollars" "dog food 3 dollars"
+ :start1 3 :end1 9 :start2 3 :end2 9))
+(eql (string> "xyzabcde" "abcd" :start1 3) 7)
+(not (string> "abc" "abc" :end1 1))
+(eql (string> "xyzabc" "a" :start1 3 :end1 5) 4)
+(eql (string> "xyzXYZ" "abcxyz" :start2 3) 3)
+(eql (string> "abcxyz" "abcxyz" :end2 3) 3)
+(not (string> "xyzXYZ" "abcxyz" :end1 2 :start2 3))
+(not (string> "xyzabc" "abcdef" :start1 3 :end2 3))
+(eql (string> "z" "aaaa") 0)
+(eql (string> "pTTTxTTTqqq" "pppTTTaTTT" :start1 1 :start2 3) 4)
+(eql (string> "pppTTTxTTTqqq" "pTTTaTTT"
+ :start1 6 :end1 7
+ :start2 4 :end2 5) 6)
+(not (string> (make-array 0 :element-type 'character)
+ (make-array 0 :element-type 'base-char)))
+(= (string> 'love 'hate) 0)
+(not (string> 'peace 'war))
+(not (string> 'love 'love))
+(not (string> #\a #\a))
+(not (string> #\a #\b))
+(= (string> #\z #\a) 0)
+
+
+(eql (string<= "" "") 0)
+(eql (string<= "dog" "dog") 3)
+(eql (string<= " " " ") 1)
+(not (string<= "abc" ""))
+(eql (string<= "ab" "abc") 2)
+(eql (string<= "aaa" "aba") 1)
+(not (string<= "aba" "aaa"))
+(eql (string<= "my cat food" "your dog food" :start1 6 :start2 8) 11)
+(eql (string<= "cat food 2 dollars" "dog food 3 dollars"
+ :start1 3 :end1 9 :start2 3 :end2 9) 9)
+(eql (string<= "xyzabc" "abcd" :start1 3) 6)
+(eql (string<= "abc" "abc" :end1 1) 1)
+(eql (string<= "xyzabc" "abc" :start1 3 :end1 5) 5)
+(eql (string<= "xyz" "abcxyzXYZ" :start2 3) 3)
+(eql (string<= "abc" "abcxyz" :end2 3) 3)
+(eql (string<= "xyz" "abcxyz" :end1 2 :start2 3) 2)
+(eql (string<= "xyzabc" "abcdef" :start1 3 :end2 3) 6)
+(eql (string<= "aaaa" "z") 0)
+(eql (string<= "pppTTTaTTTqqq" "pTTTxTTT" :start1 3 :start2 1) 6)
+(eql (string<= "pppTTTaTTTqqq" "pTTTxTTT"
+ :start1 6 :end1 7
+ :start2 4 :end2 5) 6)
+(eql (string<= (make-array 0 :element-type 'character)
+ (make-array 0 :element-type 'base-char)) 0)
+(not (string<= 'love 'hate))
+(= (string<= 'peace 'war) 0)
+(= (string<= 'love 'love) 4)
+(= (string<= #\a #\a) 1)
+(= (string<= #\a #\b) 0)
+(not (string<= #\z #\a))
+
+
+(eql (string>= "" "") 0)
+(eql (string>= "dog" "dog") 3)
+(eql (string>= " " " ") 1)
+(eql (string>= "abc" "") 0)
+(not (string>= "" "abc"))
+(not (string>= "ab" "abc"))
+(eql (string>= "abc" "ab") 2)
+(eql (string>= "aba" "aaa") 1)
+(not (string>= "aaa" "aba"))
+(eql (string>= "my cat food" "your dog food" :start1 6 :start2 8) 11)
+(eql (string>= "cat food 2 dollars" "dog food 3 dollars"
+ :start1 3 :end1 9 :start2 3 :end2 9) 9)
+(eql (string>= "xyzabcde" "abcd" :start1 3) 7)
+(not (string>= "abc" "abc" :end1 1))
+(eql (string>= "xyzabc" "a" :start1 3 :end1 5) 4)
+(eql (string>= "xyzXYZ" "abcxyz" :start2 3) 3)
+(eql (string>= "abcxyz" "abcxyz" :end2 3) 3)
+(not (string>= "xyzXYZ" "abcxyz" :end1 2 :start2 3))
+(eql (string>= "xyzabc" "abcdef" :start1 3 :end2 3) 6)
+(eql (string>= "z" "aaaa") 0)
+(eql (string>= "pTTTxTTTqqq" "pppTTTaTTT" :start1 1 :start2 3) 4)
+(eql (string>= "pppTTTxTTTqqq" "pTTTaTTT"
+ :start1 6 :end1 7
+ :start2 4 :end2 5) 6)
+(eql (string>= (make-array 0 :element-type 'character)
+ (make-array 0 :element-type 'base-char)) 0)
+(= (string>= 'love 'hate) 0)
+(not (string>= 'peace 'war))
+(= (string>= 'love 'love) 4)
+(= (string>= #\a #\a) 1)
+(not (string>= #\a #\b))
+(= (string>= #\z #\a) 0)
+
+
+
+
+(string-equal "" "")
+(string-equal (make-array 0 :element-type 'character)
+ (make-array 0 :element-type 'base-char))
+(not (string-equal "abc" ""))
+(not (string-equal "" "abc"))
+(string-equal "A" "a")
+(string-equal "abc" "xyz" :start1 3 :start2 3)
+(string-equal "abc" "xyz" :start1 1 :end1 1 :start2 0 :end2 0)
+(string-equal "axyza" "xyz" :start1 1 :end1 4)
+(string-equal "axyza" "xyz" :start1 1 :end1 4 :start2 0 :end2 nil)
+(string-equal "abxyz" "xyabz" :end1 2 :start2 2 :end2 4)
+(not (string-equal "love" "hate"))
+(string-equal "xyz" "XYZ")
+(not (string-equal 'love 'hate))
+(not (string-equal 'peace 'war))
+(string-equal 'love 'love)
+(string-equal #\a #\a)
+(not (string-equal #\a #\b))
+(not (string-equal #\z #\a))
+
+
+(not (string-not-equal "" ""))
+(not (string-not-equal (make-array 0 :element-type 'character)
+ (make-array 0 :element-type 'base-char)))
+(eql (string-not-equal "abc" "") 0)
+(eql (string-not-equal "" "abc") 0)
+(not (string-not-equal "A" "a"))
+(not (string-not-equal "abc" "xyz" :start1 3 :start2 3))
+(not (string-not-equal "abc" "xyz" :start1 1 :end1 1 :start2 0 :end2 0))
+(not (string-not-equal "axyza" "xyz" :start1 1 :end1 4))
+(not (string-not-equal "axyza" "xyz" :start1 1 :end1 4 :start2 0 :end2 nil))
+(not (string-not-equal "abxyz" "xyabz" :end1 2 :start2 2 :end2 4))
+(eql (string-not-equal "love" "hate") 0)
+(not (string-not-equal "love" "loVe"))
+(not (string-not-equal "life" "death" :start1 3 :start2 1 :end2 2))
+(not (string-not-equal "abcxyz" "ABCxyZ" :start1 3 :start2 3))
+(not (string-not-equal "abcxyz" "ABCxyZ" :start1 3 :end1 nil :start2 3 :end2 nil))
+(eql (string-not-equal "abcxyz" "ABCxyZ" :end1 nil :start2 3 :end2 3) 0)
+(eql (string-not-equal "abc" "abcxyz") 3)
+(eql (string-not-equal "abcxyz" "abc") 3)
+(eql (string-not-equal "abcxyz" "") 0)
+(not (string-not-equal "AbcDef" "cdef" :start1 2))
+(not (string-not-equal "cdef" "AbcDef" :start2 2))
+(not (string-not-equal "ABC" "abc"))
+(= (string-not-equal 'love 'hate) 0)
+(= (string-not-equal 'peace 'war) 0)
+(not (string-not-equal 'love 'love))
+(not (string-not-equal #\a #\a))
+(= (string-not-equal #\a #\b) 0)
+(= (string-not-equal #\z #\a) 0)
+
+
+(not (string-lessp "" ""))
+(not (string-lessp "dog" "dog"))
+(not (string-lessp " " " "))
+(not (string-lessp "abc" ""))
+(eql (string-lessp "" "abc") 0)
+(eql (string-lessp "ab" "abc") 2)
+(not (string-lessp "abc" "ab"))
+(eql (string-lessp "aaa" "aba") 1)
+(not (string-lessp "aba" "aaa"))
+(not (string-lessp "my cat food" "your dog food" :start1 6 :start2 8))
+(not (string-lessp "cat food 2 dollars" "dog food 3 dollars"
+ :start1 3 :end1 9 :start2 3 :end2 9))
+(eql (string-lessp "xyzabc" "abcd" :start1 3) 6)
+(eql (string-lessp "abc" "abc" :end1 1) 1)
+(eql (string-lessp "xyzabc" "abc" :start1 3 :end1 5) 5)
+(eql (string-lessp "xyz" "abcxyzXYZ" :start2 3) 3)
+(not (string-lessp "abc" "abcxyz" :end2 3))
+(eql (string-lessp "xyz" "abcxyz" :end1 2 :start2 3) 2)
+(not (string-lessp "xyzabc" "abcdef" :start1 3 :end2 3))
+(eql (string-lessp "aaaa" "z") 0)
+(eql (string-lessp "pppTTTaTTTqqq" "pTTTxTTT" :start1 3 :start2 1) 6)
+(eql (string-lessp "pppTTTaTTTqqq" "pTTTxTTT"
+ :start1 6 :end1 7
+ :start2 4 :end2 5) 6)
+(not (string-lessp (make-array 0 :element-type 'character)
+ (make-array 0 :element-type 'base-char)))
+(and (not (string-lessp "abc" "ABC"))
+ (not (string-lessp "ABC" "abc")))
+(not (string-lessp 'love 'hate))
+(= (string-lessp 'peace 'war) 0)
+(not (string-lessp 'love 'love))
+(not (string-lessp #\a #\a))
+(= (string-lessp #\a #\b) 0)
+(not (string-lessp #\z #\a))
+
+
+(not (string-greaterp "" ""))
+(not (string-greaterp "dog" "dog"))
+(not (string-greaterp " " " "))
+(eql (string-greaterp "abc" "") 0)
+(not (string-greaterp "" "abc"))
+(not (string-greaterp "ab" "abc"))
+(eql (string-greaterp "abc" "ab") 2)
+(eql (string-greaterp "aba" "aaa") 1)
+(not (string-greaterp "aaa" "aba"))
+(not (string-greaterp "my cat food" "your dog food" :start1 6 :start2 8))
+(not (string-greaterp "cat food 2 dollars" "dog food 3 dollars"
+ :start1 3 :end1 9 :start2 3 :end2 9))
+(eql (string-greaterp "xyzabcde" "abcd" :start1 3) 7)
+(not (string-greaterp "abc" "abc" :end1 1))
+(eql (string-greaterp "xyzabc" "a" :start1 3 :end1 5) 4)
+(eql (string-greaterp "xyzXYZ" "abcxyz" :start2 3) 3)
+(eql (string-greaterp "abcxyz" "abcxyz" :end2 3) 3)
+(not (string-greaterp "xyzXYZ" "abcxyz" :end1 2 :start2 3))
+(not (string-greaterp "xyzabc" "abcdef" :start1 3 :end2 3))
+(eql (string-greaterp "z" "aaaa") 0)
+(eql (string-greaterp "pTTTxTTTqqq" "pppTTTaTTT" :start1 1 :start2 3) 4)
+(eql (string-greaterp "pppTTTxTTTqqq" "pTTTaTTT"
+ :start1 6 :end1 7
+ :start2 4 :end2 5) 6)
+(not (string-greaterp (make-array 0 :element-type 'character)
+ (make-array 0 :element-type 'base-char)))
+(and (not (string-greaterp "abc" "ABC"))
+ (not (string-greaterp "ABC" "abc")))
+(= (string-greaterp 'love 'hate) 0)
+(not (string-greaterp 'peace 'war))
+(not (string-greaterp 'love 'love))
+(not (string-greaterp #\a #\a))
+(not (string-greaterp #\a #\b))
+(= (string-greaterp #\z #\a) 0)
+
+
+(eql (string-not-greaterp "" "") 0)
+(eql (string-not-greaterp "dog" "dog") 3)
+(eql (string-not-greaterp " " " ") 1)
+(not (string-not-greaterp "abc" ""))
+(eql (string-not-greaterp "ab" "abc") 2)
+(eql (string-not-greaterp "aaa" "aba") 1)
+(not (string-not-greaterp "aba" "aaa"))
+(eql (string-not-greaterp "my cat food" "your dog food" :start1 6 :start2 8) 11)
+(eql (string-not-greaterp "cat food 2 dollars" "dog food 3 dollars"
+ :start1 3 :end1 9 :start2 3 :end2 9) 9)
+(eql (string-not-greaterp "xyzabc" "abcd" :start1 3) 6)
+(eql (string-not-greaterp "abc" "abc" :end1 1) 1)
+(eql (string-not-greaterp "xyzabc" "abc" :start1 3 :end1 5) 5)
+(eql (string-not-greaterp "xyz" "abcxyzXYZ" :start2 3) 3)
+(eql (string-not-greaterp "abc" "abcxyz" :end2 3) 3)
+(eql (string-not-greaterp "xyz" "abcxyz" :end1 2 :start2 3) 2)
+(eql (string-not-greaterp "xyzabc" "abcdef" :start1 3 :end2 3) 6)
+(eql (string-not-greaterp "aaaa" "z") 0)
+(eql (string-not-greaterp "pppTTTaTTTqqq" "pTTTxTTT" :start1 3 :start2 1) 6)
+(eql (string-not-greaterp "pppTTTaTTTqqq" "pTTTxTTT"
+ :start1 6 :end1 7
+ :start2 4 :end2 5) 6)
+(eql (string-not-greaterp (make-array 0 :element-type 'character)
+ (make-array 0 :element-type 'base-char)) 0)
+(and (eql (string-not-greaterp "abc" "ABC") 3)
+ (eql (string-not-greaterp "ABC" "abc") 3))
+(not (string-not-greaterp 'love 'hate))
+(= (string-not-greaterp 'peace 'war) 0)
+(= (string-not-greaterp 'love 'love) 4)
+(= (string-not-greaterp #\a #\a) 1)
+(= (string-not-greaterp #\a #\b) 0)
+(not (string-not-greaterp #\z #\a))
+
+
+(eql (string-not-lessp "" "") 0)
+(eql (string-not-lessp "dog" "dog") 3)
+(eql (string-not-lessp " " " ") 1)
+(eql (string-not-lessp "abc" "") 0)
+(not (string-not-lessp "" "abc"))
+(not (string-not-lessp "ab" "abc"))
+(eql (string-not-lessp "abc" "ab") 2)
+(eql (string-not-lessp "aba" "aaa") 1)
+(not (string-not-lessp "aaa" "aba"))
+(eql (string-not-lessp "my cat food" "your dog food" :start1 6 :start2 8) 11)
+(eql (string-not-lessp "cat food 2 dollars" "dog food 3 dollars"
+ :start1 3 :end1 9 :start2 3 :end2 9) 9)
+(eql (string-not-lessp "xyzabcde" "abcd" :start1 3) 7)
+(not (string-not-lessp "abc" "abc" :end1 1))
+(eql (string-not-lessp "xyzabc" "a" :start1 3 :end1 5) 4)
+(eql (string-not-lessp "xyzXYZ" "abcxyz" :start2 3) 3)
+(eql (string-not-lessp "abcxyz" "abcxyz" :end2 3) 3)
+(not (string-not-lessp "xyzXYZ" "abcxyz" :end1 2 :start2 3))
+(eql (string-not-lessp "xyzabc" "abcdef" :start1 3 :end2 3) 6)
+(eql (string-not-lessp "z" "aaaa") 0)
+(eql (string-not-lessp "pTTTxTTTqqq" "pppTTTaTTT" :start1 1 :start2 3) 4)
+(eql (string-not-lessp "pppTTTxTTTqqq" "pTTTaTTT"
+ :start1 6 :end1 7
+ :start2 4 :end2 5) 6)
+(eql (string-not-lessp (make-array 0 :element-type 'character)
+ (make-array 0 :element-type 'base-char)) 0)
+(and (eql (string-not-lessp "abc" "ABC") 3)
+ (eql (string-not-lessp "ABC" "abc") 3))
+(= (string-not-lessp 'love 'hate) 0)
+(not (string-not-lessp 'peace 'war))
+(= (string-not-lessp 'love 'love) 4)
+(= (string-not-lessp #\a #\a) 1)
+(not (string-not-lessp #\a #\b))
+(= (string-not-lessp #\z #\a) 0)
+
+
+
+(stringp "aaaaaa")
+(stringp (make-array 0 :element-type 'character))
+(stringp (make-array 0 :element-type 'base-char))
+(stringp (make-array 0 :element-type 'standard-char))
+(not (stringp #\a))
+(not (stringp 'a))
+(not (stringp '(string)))
+
+(string= (make-string 3 :initial-element #\a) "aaa")
+(let ((str (make-string 3)))
+ (and (simple-string-p str)
+ (setf (schar str 0) #\x)
+ (setf (schar str 1) #\y)
+ (setf (schar str 2) #\z)
+ (string= str "xyz")))
+(string= (make-string 1 :initial-element #\Space) " ")
+(string= (make-string 0) "")
+
+(subtypep (upgraded-array-element-type
+ (array-element-type (make-string 3 :element-type 'standard-char)))
+ 'character)
+
diff --git a/Sacla/tests/must-symbol.lisp b/Sacla/tests/must-symbol.lisp
new file mode 100644
index 0000000..74d8176
--- /dev/null
+++ b/Sacla/tests/must-symbol.lisp
@@ -0,0 +1,459 @@
+;; Copyright (C) 2002-2004, Yuji Minejima <ggb01164@nifty.ne.jp>
+;; ALL RIGHTS RESERVED.
+;;
+;; $Id: must-symbol.lisp,v 1.7 2004/02/20 07:23:42 yuji Exp $
+;;
+;; Redistribution and use in source and binary forms, with or without
+;; modification, are permitted provided that the following conditions
+;; are met:
+;;
+;; * Redistributions of source code must retain the above copyright
+;; notice, this list of conditions and the following disclaimer.
+;; * 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.
+;;
+;; 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
+;; OWNER 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.
+
+(symbolp 'elephant)
+(not (symbolp 12))
+(symbolp nil)
+(symbolp '())
+(symbolp :test)
+(not (symbolp "hello"))
+
+(not (keywordp 'elephant))
+(not (keywordp 12))
+(keywordp :test)
+(keywordp ':test)
+(not (keywordp nil))
+(keywordp :nil)
+(not (keywordp '(:test)))
+(not (keywordp "hello"))
+(not (keywordp ":hello"))
+(not (keywordp '&optional))
+
+
+(let ((new (make-symbol "symbol")))
+ (string= (symbol-name new) "symbol"))
+
+(let ((new (make-symbol "symbol")))
+ (not (boundp new)))
+
+(let ((new (make-symbol "symbol")))
+ (not (fboundp new)))
+
+(let ((new (make-symbol "symbol")))
+ (null (symbol-plist new)))
+
+(let ((new (make-symbol "symbol")))
+ (null (symbol-package new)))
+
+(let ((new (make-symbol "symbol")))
+ (not (member new (find-all-symbols "symbol"))))
+
+(every #'identity
+ (mapcar
+ #'(lambda (name)
+ (let ((new (make-symbol name)))
+ (and (string= (symbol-name new) name)
+ (not (boundp new))
+ (not (fboundp new))
+ (null (symbol-plist new))
+ (not (member new (find-all-symbols name))))))
+ '("" "Symbol" "eat-this" "SYMBOL" ":S:Y:M:B:O:L:")))
+
+
+(let ((copy (copy-symbol 'cl:car)))
+ (string= (symbol-name copy) (symbol-name 'cl:car)))
+
+(let ((copy (copy-symbol 'cl:car)))
+ (not (boundp copy)))
+
+(let ((copy (copy-symbol 'cl:car)))
+ (not (fboundp copy)))
+
+(let ((copy (copy-symbol 'cl:car)))
+ (null (symbol-plist copy)))
+
+(let ((copy (copy-symbol 'cl:car)))
+ (null (symbol-package copy)))
+
+
+(let ((copy (copy-symbol 'cl:car "copy properties too")))
+ (string= (symbol-name copy) (symbol-name 'cl:car)))
+
+(let ((copy (copy-symbol 'cl:car "copy properties too")))
+ (if (boundp 'cl:car)
+ (boundp copy)
+ (not (boundp copy))))
+
+(let ((copy (copy-symbol 'cl:car "copy properties too")))
+ (eq (symbol-function copy) (symbol-function 'cl:car)))
+
+(let ((copy (copy-symbol 'cl:car "copy properties too")))
+ (equal (symbol-plist copy) (symbol-plist 'cl:car)))
+
+(let ((copy (copy-symbol 'cl:car "copy properties too")))
+ (null (symbol-package copy)))
+
+
+
+(every #'identity
+ (mapcar
+ #'(lambda (symbol)
+ (let ((copy1 (copy-symbol symbol))
+ (copy2 (copy-symbol symbol "copy-properties")))
+ (and (string= (symbol-name copy1) (symbol-name symbol))
+ (string= (symbol-name copy2) (symbol-name symbol))
+ (not (boundp copy1))
+ (if (boundp symbol)
+ (boundp copy2)
+ (not (boundp copy2)))
+ (not (fboundp copy1))
+ (if (fboundp symbol)
+ (fboundp copy2)
+ (not (fboundp copy2)))
+ (null (symbol-plist copy1))
+ (equal (symbol-plist copy2) (symbol-plist symbol))
+ (null (symbol-package copy1))
+ (null (symbol-package copy2))
+ (not (member copy1 (find-all-symbols symbol)))
+ (not (member copy2 (find-all-symbols symbol))))))
+ '(nil cl:cdr cl:*package* cl:list symbol weird-symbol)))
+
+
+(let ((new (gensym)))
+ (not (boundp new)))
+
+(let ((new (gensym)))
+ (not (fboundp new)))
+
+(let ((new (gensym)))
+ (null (symbol-plist new)))
+
+(let ((new (gensym)))
+ (null (symbol-package new)))
+
+
+(let ((new (gensym "How about this")))
+ (not (boundp new)))
+
+(let ((new (gensym "How about this")))
+ (not (fboundp new)))
+
+(let ((new (gensym "How about this")))
+ (null (symbol-plist new)))
+
+(let ((new (gensym "How about this")))
+ (null (symbol-package new)))
+
+
+(let ((new (gensym 100)))
+ (not (boundp new)))
+
+(let ((new (gensym 10)))
+ (not (fboundp new)))
+
+(let ((new (gensym 9)))
+ (null (symbol-plist new)))
+
+(let ((new (gensym 8)))
+ (null (symbol-package new)))
+
+
+(let* ((counter *gensym-counter*)
+ (new (gensym)))
+ (string= (symbol-name new)
+ (with-output-to-string (stream)
+ (format stream "G~D" counter))))
+
+(let* ((counter *gensym-counter*)
+ (new (gensym "JJ")))
+ (string= (symbol-name new)
+ (with-output-to-string (stream)
+ (format stream "JJ~D" counter))))
+
+(let* ((counter *gensym-counter*)
+ (new (gensym "")))
+ (string= (symbol-name new)
+ (with-output-to-string (stream)
+ (format stream "~D" counter))))
+
+(let ((new (gensym 0)))
+ (string= (symbol-name new) "G0"))
+
+(let ((new (gensym 1000)))
+ (string= (symbol-name new) "G1000"))
+
+
+
+(let ((symbol (gentemp)))
+ (char= (aref (symbol-name symbol) 0) #\T))
+
+(let ((symbol (gentemp)))
+ (not (boundp symbol)))
+
+(let ((symbol (gentemp)))
+ (not (fboundp symbol)))
+
+(let ((symbol (gentemp)))
+ (null (symbol-plist symbol)))
+
+(let ((symbol (gentemp)))
+ (multiple-value-bind (symbol-found status)
+ (find-symbol (symbol-name symbol))
+ (and (eq symbol-found symbol)
+ (if (eq *package* (find-package "KEYWORD"))
+ (eq status :external)
+ (eq status :internal)))))
+
+(let ((symbol-1 (gentemp))
+ (symbol-2 (gentemp)))
+ (not (string= (symbol-name symbol-1) (symbol-name symbol-2))))
+
+(let ((symbol (gentemp "prefix")))
+ (string= (subseq (symbol-name symbol) 0 6) "prefix"))
+
+(let ((symbol (gentemp "prefix")))
+ (not (boundp symbol)))
+
+(let ((symbol (gentemp "prefix")))
+ (not (fboundp symbol)))
+
+(let ((symbol (gentemp "prefix")))
+ (null (symbol-plist symbol)))
+
+(let ((symbol (gentemp "prefix")))
+ (multiple-value-bind (symbol-found status)
+ (find-symbol (symbol-name symbol))
+ (and (eq symbol-found symbol)
+ (if (eq *package* (find-package "KEYWORD"))
+ (eq status :external)
+ (eq status :internal)))))
+
+
+(let* ((package (defpackage "TEST-PACKAGE-FOR-GENTEMP"))
+ (symbol (gentemp "prefix" package)))
+ (string= (subseq (symbol-name symbol) 0 6) "prefix"))
+
+(let* ((package (defpackage "TEST-PACKAGE-FOR-GENTEMP"))
+ (symbol (gentemp "prefix" package)))
+ (not (boundp symbol)))
+
+(let* ((package (defpackage "TEST-PACKAGE-FOR-GENTEMP"))
+ (symbol (gentemp "prefix" package)))
+ (not (fboundp symbol)))
+
+(let* ((package (defpackage "TEST-PACKAGE-FOR-GENTEMP"))
+ (symbol (gentemp "prefix" package)))
+ (null (symbol-plist symbol)))
+
+(let* ((package (defpackage "TEST-PACKAGE-FOR-GENTEMP"))
+ (symbol (gentemp "prefix" package)))
+ (multiple-value-bind (symbol-found status)
+ (find-symbol (symbol-name symbol) package)
+ (and (eq symbol-found symbol)
+ (eq status :internal))))
+
+
+
+(functionp (symbol-function 'cl:car))
+(eq (symbol-function 'cl:car) (fdefinition 'cl:car))
+(progn (setf (symbol-function 'symbol-for-test) #'car)
+ (eq (symbol-for-test '(a)) 'a))
+
+(let ((f #'(lambda (a) a)))
+ (setf (symbol-function 'symbol-for-test) f)
+ (eq (symbol-function 'symbol-for-test) f))
+
+
+(stringp (symbol-name 'symbol))
+(string= (symbol-name (intern "TEST-SYMBOL")) "TEST-SYMBOL")
+
+
+(eq (symbol-package 'cl:car) (find-package "COMMON-LISP"))
+(eq (symbol-package ':key) (find-package "KEYWORD"))
+(null (symbol-package (make-symbol "temp")))
+(null (symbol-package (gensym)))
+(packagep (symbol-package 'a))
+(packagep (symbol-package 'my-symbol))
+
+
+(listp (symbol-plist 'car))
+(listp (symbol-plist 'cdr))
+(null (symbol-plist (gensym)))
+(null (symbol-plist (gentemp)))
+
+(let ((symbol (gensym)))
+ (setf (symbol-plist symbol) (list 'a 1 'b 2 'c 3))
+ (equal (symbol-plist symbol) '(a 1 b 2 c 3)))
+
+(let ((symbol (gensym)))
+ (setf (symbol-plist symbol) (list 'a 1 'b 2 'c 3))
+ (setf (symbol-plist symbol) '())
+ (null (symbol-plist symbol)))
+
+
+(progn (setf (symbol-value 'a) 1)
+ (eql (symbol-value 'a) 1))
+
+(progn
+ (setf (symbol-value 'a) 1)
+ (let ((a 2))
+ (eql (symbol-value 'a) 1)))
+
+(progn
+ (setf (symbol-value 'a) 1)
+ (let ((a 2))
+ (setq a 3)
+ (eql (symbol-value 'a) 1)))
+
+(progn
+ (setf (symbol-value 'a) 1)
+ (let ((a 2))
+ (declare (special a))
+ (eql (symbol-value 'a) 2)))
+
+(progn
+ (setf (symbol-value 'a) 1)
+ (let ((a 2))
+ (declare (special a))
+ (setq a 3)
+ (eql (symbol-value 'a) 3)))
+
+(progn
+ (setf (symbol-value 'a) 1)
+ (and (eql (let ((a 2))
+ (setf (symbol-value 'a) 3)
+ a)
+ 2)
+ (eql a 3)))
+
+(progn
+ (setf (symbol-value 'a) 1)
+ (let ((a 4))
+ (declare (special a))
+ (let ((b (symbol-value 'a)))
+ (setf (symbol-value 'a) 5)
+ (and (eql a 5)
+ (eql b 4)))))
+
+(eq (symbol-value :any-keyword) :any-keyword)
+(eq (symbol-value 'nil) nil)
+(eq (symbol-value '()) nil)
+(eq (symbol-value t) t)
+
+
+(let ((symbol (gensym)))
+ (setf (symbol-plist symbol) (list 'a 1 'b 2 'c 3))
+ (and (eql (get symbol 'a) 1)
+ (eql (get symbol 'b) 2)
+ (eql (get symbol 'c) 3)
+ (eql (get symbol 'd) nil)
+ (eql (get symbol 'e 9) 9)))
+
+(let ((symbol (gensym)))
+ (setf (symbol-plist symbol) (list 'a 1 'b 2 'c 3))
+ (and (eql (setf (get symbol 'a) 9) 9)
+ (eql (get symbol 'a) 9)
+ (eql (setf (get symbol 'b) 8) 8)
+ (eql (get symbol 'b) 8)
+ (eql (setf (get symbol 'c) 7) 7)
+ (eql (get symbol 'c) 7)
+ (eql (setf (get symbol 'd) 6) 6)
+ (eql (get symbol 'd) 6)
+ (eql (setf (get symbol 'e) 5) 5)
+ (eql (get symbol 'e) 5)))
+
+(let ((symbol (gensym))
+ tmp)
+ (and (null (get symbol 'a))
+ (setf (get symbol 'a (setq tmp 1)) tmp)
+ (eql (get symbol 'a) 1)))
+
+(let ((symbol (gensym)))
+ (setf (symbol-plist symbol) (list 'a 1 'b 2 'c 3 'a 9))
+ (and (eql (setf (get symbol 'a) 5) 5)
+ (eql (get symbol 'a) 5)))
+
+
+(let ((symbol (gensym)))
+ (setf (symbol-plist symbol) (list 'a 1 'b 2 'c 3))
+ (and (remprop symbol 'a)
+ (eq (get symbol 'a 'not-found) 'not-found)))
+
+(let ((symbol (gensym)))
+ (not (remprop symbol 'a)))
+
+(let ((symbol (gensym)))
+ (setf (symbol-plist symbol) (list 'a 1 'b 2 'c 3 'a 9))
+ (and (remprop symbol 'a)
+ (eql (get symbol 'a) 9)))
+
+(let ((symbol (gensym)))
+ (setf (symbol-plist symbol) (list 'a 1 'b 2 'c 3 'a 9))
+ (and (remprop symbol 'a)
+ (eql (get symbol 'a) 9)
+ (remprop symbol 'a)
+ (eq (get symbol 'a 'not-found) 'not-found)))
+
+
+(not (boundp (gensym)))
+(let ((symbol (gensym)))
+ (set symbol 1)
+ (boundp symbol))
+
+(let ((test-symbol 1))
+ (not (boundp 'test-symbol)))
+
+(let ((test-symbol 1))
+ (declare (special test-symbol))
+ (boundp 'test-symbol))
+
+
+(not (boundp (makunbound (gensym))))
+
+(let ((test-symbol 0))
+ (declare (special test-symbol))
+ (and (let ((test-symbol 1))
+ (declare (special test-symbol))
+ (not (boundp (makunbound 'test-symbol))))
+ (boundp 'test-symbol)))
+
+
+(let ((test-symbol 0))
+ (declare (special test-symbol))
+ (and (let ((test-symbol 1))
+ (makunbound 'test-symbol)
+ (eql test-symbol 1))
+ (not (boundp 'test-symbol))))
+
+
+(let ((test-symbol 0))
+ (declare (special test-symbol))
+ (and
+ (eql test-symbol 0)
+ (setf (symbol-value 'test-symbol) 1)
+ (eql test-symbol 1)
+ (eql (set 'test-symbol 10) 10)
+ (eql test-symbol 10)))
+
+(let ((test-symbol 0))
+ (declare (special test-symbol))
+ (and (let ((test-symbol 1))
+ (set 'test-symbol 100)
+ (eql test-symbol 1))
+ (eql test-symbol 100)))
+
diff --git a/Sacla/tests/should-array.lisp b/Sacla/tests/should-array.lisp
new file mode 100644
index 0000000..ce72337
--- /dev/null
+++ b/Sacla/tests/should-array.lisp
@@ -0,0 +1,229 @@
+;; Copyright (C) 2002-2004, Yuji Minejima <ggb01164@nifty.ne.jp>
+;; ALL RIGHTS RESERVED.
+;;
+;; $Id: should-array.lisp,v 1.12 2004/08/09 02:49:55 yuji Exp $
+;;
+;; Redistribution and use in source and binary forms, with or without
+;; modification, are permitted provided that the following conditions
+;; are met:
+;;
+;; * Redistributions of source code must retain the above copyright
+;; notice, this list of conditions and the following disclaimer.
+;; * 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.
+;;
+;; 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
+;; OWNER 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.
+
+(HANDLER-CASE (PROGN (ADJUST-ARRAY (MAKE-ARRAY '(3 3)) '(1 9) :FILL-POINTER 1))
+ (ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+
+#-CLISP ;Bruno: Why expect an error? A string _is_ an array.
+(progn
+ #-(or cmu clispxxx)
+ (HANDLER-CASE (PROGN (ADJUSTABLE-ARRAY-P "not-a-symbol"))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+ #+(or cmu clispxxx) 'skipped)
+
+(progn
+ #-cmu
+ (HANDLER-CASE (PROGN (ADJUSTABLE-ARRAY-P #\a))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+ #+cmu 'skipped)
+
+(progn
+ #-cmu
+ (HANDLER-CASE (PROGN (ADJUSTABLE-ARRAY-P '(NIL)))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+ #+cmu 'skipped)
+
+(HANDLER-CASE (PROGN (ARRAY-DIMENSIONS 'NOT-AN-ARRAY))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (ARRAY-DIMENSIONS #\a))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (ARRAY-DIMENSIONS '(NIL)))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+
+
+(HANDLER-CASE (PROGN (ARRAY-ELEMENT-TYPE 'NOT-AN-ARRAY))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (ARRAY-ELEMENT-TYPE #\a))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (ARRAY-ELEMENT-TYPE '(NIL)))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+
+(progn
+ #-cmu
+ (HANDLER-CASE (PROGN (ARRAY-HAS-FILL-POINTER-P 'NOT-AN-ARRAY))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+ #+cmu 'skipped)
+
+(progn
+ #-cmu
+ (HANDLER-CASE (PROGN (ARRAY-HAS-FILL-POINTER-P #\a))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+ #+cmu 'skipped)
+
+(progn
+ #-cmu
+ (HANDLER-CASE (PROGN (ARRAY-HAS-FILL-POINTER-P '(NIL)))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+ #+cmu 'skipped)
+
+(progn
+ #-cmu
+ (HANDLER-CASE (PROGN (ARRAY-DISPLACEMENT 'NOT-AN-ARRAY))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+ #+cmu 'skipped)
+
+(progn
+ #-cmu
+ (HANDLER-CASE (PROGN (ARRAY-DISPLACEMENT #\a))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+ #+cmu 'skipped)
+
+(progn
+ #-cmu
+ (HANDLER-CASE (PROGN (ARRAY-DISPLACEMENT '(NIL)))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+ #+cmu 'skipped)
+
+(HANDLER-CASE (PROGN (ARRAY-RANK 'NOT-AN-ARRAY))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (ARRAY-RANK #\a))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (ARRAY-RANK '(NIL)))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+
+(HANDLER-CASE (PROGN (ARRAY-TOTAL-SIZE 'NOT-AN-ARRAY))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (ARRAY-TOTAL-SIZE #\a))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (ARRAY-TOTAL-SIZE '(NIL)))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+
+(HANDLER-CASE (PROGN (FILL-POINTER 'NOT-AN-ARRAY))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (FILL-POINTER #\a))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (FILL-POINTER '(NIL)))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+
+(let ((vector (make-array 10 :fill-pointer nil)))
+ (or (not (array-has-fill-pointer-p vector))
+ (HANDLER-CASE (PROGN (FILL-POINTER VECTOR))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))))
+
+(let ((vector (make-array 10 :fill-pointer nil)))
+ (or (not (array-has-fill-pointer-p vector))
+ (HANDLER-CASE (PROGN (SETF (FILL-POINTER VECTOR) 0))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))))
+
+(progn
+ #-(or cmu clisp)
+ (HANDLER-CASE (PROGN (VECTOR-POP (MAKE-ARRAY 10 :FILL-POINTER NIL)))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+ #+(or cmu clisp) 'skipped)
+
+(HANDLER-CASE (PROGN (VECTOR-POP (MAKE-ARRAY 10 :FILL-POINTER 0)))
+ (ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(let ((vec (make-array 3 :fill-pointer t :initial-contents '(a b c))))
+ (and (eq (vector-pop vec) 'c)
+ (eq (vector-pop vec) 'b)
+ (eq (vector-pop vec) 'a)
+ (HANDLER-CASE (PROGN (VECTOR-POP VEC))
+ (ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))))
+
+
+(let ((vector (make-array 10 :fill-pointer nil)))
+ (or (not (array-has-fill-pointer-p vector))
+ (HANDLER-CASE (PROGN (VECTOR-PUSH 'A VECTOR))
+ (ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))))
+
+(let ((vector (make-array 10 :fill-pointer nil)))
+ (or (not (array-has-fill-pointer-p vector))
+ (HANDLER-CASE (PROGN (VECTOR-PUSH-EXTEND 'A VECTOR))
+ (ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))))
+
+(let ((vector (make-array 1 :fill-pointer t :adjustable nil)))
+ (or (adjustable-array-p vector)
+ (HANDLER-CASE (PROGN (VECTOR-PUSH-EXTEND 'A VECTOR))
+ (ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))))
+
diff --git a/Sacla/tests/should-array.patch b/Sacla/tests/should-array.patch
new file mode 100644
index 0000000..113e1c7
--- /dev/null
+++ b/Sacla/tests/should-array.patch
@@ -0,0 +1,32 @@
+*** sacla/lisp/test/should-array.lisp 2004-08-03 08:34:55.000000000 +0200
+--- CLISP/clisp-20040712/sacla-tests/should-array.lisp 2004-08-06 03:27:42.000000000 +0200
+***************
+*** 31,43 ****
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+
+ (progn
+! #-(or cmu clisp)
+ (HANDLER-CASE (PROGN (ADJUSTABLE-ARRAY-P "not-a-symbol"))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+! #+(or cmu clisp) 'skipped)
+
+ (progn
+ #-cmu
+--- 31,44 ----
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+
++ #-CLISP ; Why expect an error? A string _is_ an array.
+ (progn
+! #-(or cmu clispxxx)
+ (HANDLER-CASE (PROGN (ADJUSTABLE-ARRAY-P "not-a-symbol"))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+! #+(or cmu clispxxx) 'skipped)
+
+ (progn
+ #-cmu
diff --git a/Sacla/tests/should-character.lisp b/Sacla/tests/should-character.lisp
new file mode 100644
index 0000000..40643ad
--- /dev/null
+++ b/Sacla/tests/should-character.lisp
@@ -0,0 +1,252 @@
+;; Copyright (C) 2002-2004, Yuji Minejima <ggb01164@nifty.ne.jp>
+;; ALL RIGHTS RESERVED.
+;;
+;; $Id: should-character.lisp,v 1.10 2004/02/20 07:23:42 yuji Exp $
+;;
+;; Redistribution and use in source and binary forms, with or without
+;; modification, are permitted provided that the following conditions
+;; are met:
+;;
+;; * Redistributions of source code must retain the above copyright
+;; notice, this list of conditions and the following disclaimer.
+;; * 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.
+;;
+;; 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
+;; OWNER 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.
+
+(HANDLER-CASE (PROGN (CHAR=))
+ (PROGRAM-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (CHAR/=))
+ (PROGRAM-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (CHAR<))
+ (PROGRAM-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (CHAR>))
+ (PROGRAM-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (CHAR<=))
+ (PROGRAM-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (CHAR>=))
+ (PROGRAM-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+
+(HANDLER-CASE (PROGN (CHAR-EQUAL))
+ (PROGRAM-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (CHAR-NOT-EQUAL))
+ (PROGRAM-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (CHAR-LESSP))
+ (PROGRAM-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (CHAR-GREATERP))
+ (PROGRAM-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (CHAR-NOT-GREATERP))
+ (PROGRAM-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (CHAR-NOT-LESSP))
+ (PROGRAM-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+
+
+(HANDLER-CASE (PROGN (CHARACTER "abc"))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+
+(HANDLER-CASE (PROGN (CHARACTER 'MORE-THAN-ONE))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+
+(HANDLER-CASE (PROGN (CHARACTER '(NIL)))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+
+(HANDLER-CASE (PROGN (ALPHA-CHAR-P "abc"))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (ALPHA-CHAR-P 'NOT-A-CHAR))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (ALPHA-CHAR-P '(NIL)))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+
+(HANDLER-CASE (PROGN (ALPHANUMERICP "abc"))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (ALPHANUMERICP 'NOT-A-CHAR))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (ALPHANUMERICP '(NIL)))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+
+(progn
+ #-cmu
+ (HANDLER-CASE (PROGN (GRAPHIC-CHAR-P "abc"))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+ #+cmu 'skipped)
+
+(progn
+ #-cmu
+ (HANDLER-CASE (PROGN (GRAPHIC-CHAR-P 'NOT-A-CHAR))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+ #+cmu 'skipped)
+
+(progn
+ #-cmu
+ (HANDLER-CASE (PROGN (GRAPHIC-CHAR-P '(NIL)))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+ #+cmu 'skipped)
+
+(HANDLER-CASE (PROGN (STANDARD-CHAR-P "abc"))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (STANDARD-CHAR-P 'NOT-A-CHAR))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (STANDARD-CHAR-P '(NIL)))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+
+(HANDLER-CASE (PROGN (CHAR-UPCASE "abc"))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (CHAR-UPCASE 'NOT-A-CHAR))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (CHAR-UPCASE '(NIL)))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+
+(HANDLER-CASE (PROGN (CHAR-DOWNCASE "abc"))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (CHAR-DOWNCASE 'NOT-A-CHAR))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (CHAR-DOWNCASE '(NIL)))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+
+(HANDLER-CASE (PROGN (UPPER-CASE-P "abc"))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (UPPER-CASE-P 'NOT-A-CHAR))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (UPPER-CASE-P '(NIL)))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+
+(HANDLER-CASE (PROGN (LOWER-CASE-P "abc"))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (LOWER-CASE-P 'NOT-A-CHAR))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (LOWER-CASE-P '(NIL)))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+
+(HANDLER-CASE (PROGN (BOTH-CASE-P "abc"))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (BOTH-CASE-P 'NOT-A-CHAR))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (BOTH-CASE-P '(NIL)))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+
+(HANDLER-CASE (PROGN (CHAR-CODE "abc"))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (CHAR-CODE 'NOT-A-CHAR))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (CHAR-CODE '(NIL)))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+
+(HANDLER-CASE (PROGN (CHAR-NAME "abc"))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (CHAR-NAME 'NOT-A-CHAR))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (CHAR-NAME '(NIL)))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+
+(HANDLER-CASE (PROGN (NAME-CHAR '(NIL)))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
diff --git a/Sacla/tests/should-cons.lisp b/Sacla/tests/should-cons.lisp
new file mode 100644
index 0000000..1d58d06
--- /dev/null
+++ b/Sacla/tests/should-cons.lisp
@@ -0,0 +1,631 @@
+;; Copyright (C) 2002-2004, Yuji Minejima <ggb01164@nifty.ne.jp>
+;; ALL RIGHTS RESERVED.
+;;
+;; $Id: should-cons.lisp,v 1.4 2004/02/20 07:23:42 yuji Exp $
+;;
+;; Redistribution and use in source and binary forms, with or without
+;; modification, are permitted provided that the following conditions
+;; are met:
+;;
+;; * Redistributions of source code must retain the above copyright
+;; notice, this list of conditions and the following disclaimer.
+;; * 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.
+;;
+;; 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
+;; OWNER 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.
+
+(HANDLER-CASE (PROGN (RPLACA NIL 1))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (RPLACA "NOT A CONS" 1))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (RPLACD NIL 1))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (RPLACD "NOT A CONS" 1))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+
+(HANDLER-CASE (PROGN (CAR "NOT A CONS"))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (CDR "NOT A CONS"))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (CAAR "NOT A CONS"))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (CADR "NOT A CONS"))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (CDAR "NOT A CONS"))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (CDDR "NOT A CONS"))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (CAAAR "NOT A CONS"))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (CAADR "NOT A CONS"))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (CADAR "NOT A CONS"))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (CADDR "NOT A CONS"))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (CDAAR "NOT A CONS"))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (CDADR "NOT A CONS"))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (CDDAR "NOT A CONS"))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (CDDDR "NOT A CONS"))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (CAAAAR "NOT A CONS"))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (CAAADR "NOT A CONS"))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (CAADAR "NOT A CONS"))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (CAADDR "NOT A CONS"))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (CADAAR "NOT A CONS"))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (CADADR "NOT A CONS"))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (CADDAR "NOT A CONS"))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (CADDDR "NOT A CONS"))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (CDAAAR "NOT A CONS"))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (CDAADR "NOT A CONS"))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (CDADAR "NOT A CONS"))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (CDADDR "NOT A CONS"))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (CDDAAR "NOT A CONS"))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (CDDADR "NOT A CONS"))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (CDDDAR "NOT A CONS"))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (CDDDDR "NOT A CONS"))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+
+(HANDLER-CASE (PROGN (LIST-LENGTH '(1 . 2)))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (LIST-LENGTH "NEITHER A PROPER LIST NOR A CIRCULAR LIST"))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (LIST-LENGTH 'NEITHER-A-PROPER-LIST-NOR-A-CIRCULAR-LIST))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+
+
+(HANDLER-CASE (PROGN (MAKE-LIST NIL))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (MAKE-LIST -1))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (MAKE-LIST 1.2))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (MAKE-LIST 'A))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (MAKE-LIST "NOT A NON-NEGATIVE INTEGER"))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+
+
+(HANDLER-CASE (PROGN (FIRST "NOT A CONS"))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (SECOND "NOT A CONS"))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (THIRD "NOT A CONS"))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (FOURTH "NOT A CONS"))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (FIFTH "NOT A CONS"))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (SIXTH "NOT A CONS"))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (SEVENTH "NOT A CONS"))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (NINTH "NOT A CONS"))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (TENTH "NOT A CONS"))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+
+(HANDLER-CASE (PROGN (NTHCDR -1 '(1 2 3)))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (NTHCDR 1.1 '(1 2 3)))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (NTHCDR #\a '(1 2 3)))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (NTHCDR 3 '(1 . 2)))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+
+(HANDLER-CASE (PROGN (NTH -1 '(1 2)))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (NTH "" '(1 2)))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (NTH 3 '(1 . 2)))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+
+(HANDLER-CASE (PROGN (ENDP 1))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (ENDP #\z))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (ENDP 'NOT-A-LIST))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (ENDP "not-a-list"))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+
+(HANDLER-CASE (PROGN (BUTLAST 'NOT-A-LIST))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (BUTLAST 'NOT-A-LIST 'NOT-A-INTEGER))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (BUTLAST '(1 2 3 4 5) -1))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (BUTLAST '(1 2 3 4 5) 'A))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+
+(HANDLER-CASE (PROGN (NBUTLAST 'NOT-A-LIST))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (NBUTLAST 'NOT-A-LIST 'NOT-A-INTEGER))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (NBUTLAST '(1 2 3 4 5) -1))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (NBUTLAST '(1 2 3 4 5) 'A))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+
+
+(HANDLER-CASE (PROGN (LDIFF 'NOT-A-LIST 'OBJ))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (TAILP 'OBJ 'NOT-A-LIST))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+
+(HANDLER-CASE (PROGN (REST "NOT A CONS"))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+
+(HANDLER-CASE (PROGN (MEMBER 'A 'NOT-A-SET))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (MEMBER 'A '(1 . 2)))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (MEMBER 'A '(1 2 3 4 . 5)))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+
+(HANDLER-CASE (PROGN (MEMBER-IF #'ATOM 'NOT-A-SET))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (MEMBER-IF #'CONSP '(1 . 2)))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (MEMBER-IF #'CONSP '(1 2 3 4 . 5)))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+
+(HANDLER-CASE (PROGN (MEMBER-IF-NOT (COMPLEMENT #'ATOM) 'NOT-A-SET))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (MEMBER-IF-NOT (COMPLEMENT #'CONSP) '(1 . 2)))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (MEMBER-IF-NOT (COMPLEMENT #'CONSP) '(1 2 3 4 . 5)))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+
+(HANDLER-CASE (PROGN (MAPCAR #'CAR 'NOT-A-LIST))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (MAPCAR #'LIST '(0 1) 'NOT-A-LIST))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (MAPCAR #'LIST '(0 . 1)))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+
+(HANDLER-CASE (PROGN (MAPC #'CAR 'NOT-A-LIST))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (MAPC #'LIST '(0 1) 'NOT-A-LIST))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (MAPC #'LIST '(0 . 1)))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+
+(HANDLER-CASE (PROGN (MAPCAN #'CAR 'NOT-A-LIST))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (MAPCAN #'LIST '(0 1) 'NOT-A-LIST))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (MAPCAN #'LIST '(0 . 1)))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+
+(HANDLER-CASE (PROGN (MAPLIST #'CAR 'NOT-A-LIST))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (MAPLIST #'LIST '(0 1) 'NOT-A-LIST))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (MAPLIST #'LIST '(0 . 1)))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+
+(HANDLER-CASE (PROGN (MAPL #'CAR 'NOT-A-LIST))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (MAPL #'LIST '(0 1) 'NOT-A-LIST))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (MAPL #'LIST '(0 . 1)))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+
+(HANDLER-CASE (PROGN (MAPCON #'CAR 'NOT-A-LIST))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (MAPCON #'LIST '(0 1) 'NOT-A-LIST))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (MAPCON #'LIST '(0 . 1)))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+
+
+(HANDLER-CASE (PROGN (ASSOC 'KEY '(A B C)))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (ASSOC-IF #'NUMBERP '(A B C)))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (ASSOC-IF-NOT #'NUMBERP '(A B C)))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+
+(HANDLER-CASE (PROGN (ASSOC 'KEY '0))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (ASSOC-IF #'NUMBERP '0))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (ASSOC-IF-NOT #'NUMBERP '0))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+
+(HANDLER-CASE (PROGN (ASSOC 'KEY 'NOT-AN-ALIST))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (ASSOC-IF 'IDENTITY 'NOT-AN-ALIST))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (ASSOC-IF-NOT 'IDENTITY 'NOT-AN-ALIST))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+
+(HANDLER-CASE (PROGN (PAIRLIS 'NOT-A-LIST 'NOT-A-LIST '((A . B))))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (PAIRLIS '0 '(0 1 2) '((KEY . DATUM))))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (PAIRLIS '(0) '1 '((KEY . DATUM))))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+
+(HANDLER-CASE (PROGN (INTERSECTION '(0) '1))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (INTERSECTION '(0) '1 :TEST #'EQUALP))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (INTERSECTION #\a '(1 2 3) :TEST #'=))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (INTERSECTION 0 1))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (INTERSECTION #\a #\b))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (INTERSECTION 0 1 :TEST #'=))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (INTERSECTION #\a #\b :TEST-NOT (COMPLEMENT #'CHAR=)))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (INTERSECTION '(1 2 3 . 4) '(2 3)))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (INTERSECTION '(1 2 3 . 4) '(2 3) :TEST #'=))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (INTERSECTION '(1 2 3) '(2 . 3) :TEST #'=))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE
+ (PROGN (INTERSECTION '((1) (2) (3)) '((2) 3) :TEST #'= :KEY #'CAR))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+
+(HANDLER-CASE (PROGN (NINTERSECTION (LIST 0) '1))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (NINTERSECTION (LIST 0) '1 :TEST #'EQUALP))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (NINTERSECTION #\a '(1 2 3) :TEST #'=))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (NINTERSECTION 0 1))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (NINTERSECTION #\a #\b))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (NINTERSECTION 0 1 :TEST #'=))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (INTERSECTION #\a #\b :TEST-NOT (COMPLEMENT #'CHAR=)))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (NINTERSECTION (LIST* 1 2 3 4) '(2 3)))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (NINTERSECTION (LIST* 1 2 3 4) '(2 3) :TEST #'=))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (NINTERSECTION (LIST 1 2 3) '(2 . 3) :TEST #'=))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE
+ (PROGN (NINTERSECTION (LIST '(1) '(2) '(3)) '((2) 3) :TEST #'= :KEY #'CAR))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+
+
+(HANDLER-CASE (PROGN (ADJOIN 'A 'A))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (ADJOIN 'X '(A . B)))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+
+
+(HANDLER-CASE (PROGN (SET-DIFFERENCE 'NOT-A-LIST 'NOT-A-LIST))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (NSET-DIFFERENCE 'NOT-A-LIST 'NOT-A-LIST))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+
+(HANDLER-CASE (PROGN (SET-EXCLUSIVE-OR 'NOT-A-LIST 'NOT-A-LIST))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (NSET-EXCLUSIVE-OR 'NOT-A-LIST 'NOT-A-LIST))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+
+(HANDLER-CASE (PROGN (UNION 'NOT-A-LIST 'NOT-A-LIST))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+
diff --git a/Sacla/tests/should-data-and-control.lisp b/Sacla/tests/should-data-and-control.lisp
new file mode 100644
index 0000000..5a3e28a
--- /dev/null
+++ b/Sacla/tests/should-data-and-control.lisp
@@ -0,0 +1,49 @@
+;; Copyright (C) 2002-2004, Yuji Minejima <ggb01164@nifty.ne.jp>
+;; ALL RIGHTS RESERVED.
+;;
+;; $Id: should-data-and-control.lisp,v 1.9 2004/02/20 07:23:42 yuji Exp $
+;;
+;; Redistribution and use in source and binary forms, with or without
+;; modification, are permitted provided that the following conditions
+;; are met:
+;;
+;; * Redistributions of source code must retain the above copyright
+;; notice, this list of conditions and the following disclaimer.
+;; * 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.
+;;
+;; 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
+;; OWNER 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.
+
+(HANDLER-CASE (PROGN (FUNCALL (GENSYM) 0 1 2))
+ (UNDEFINED-FUNCTION NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+;; (HANDLER-CASE (PROGN (FUNCALL 'IF T NIL T))
+;; (UNDEFINED-FUNCTION NIL T)
+;; (ERROR NIL NIL)
+;; (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+
+(HANDLER-CASE (PROGN (VALUES-LIST 'NOT-A-LIST))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (VALUES-LIST #\a))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (VALUES-LIST '(A . B)))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
diff --git a/Sacla/tests/should-eval.lisp b/Sacla/tests/should-eval.lisp
new file mode 100644
index 0000000..c441400
--- /dev/null
+++ b/Sacla/tests/should-eval.lisp
@@ -0,0 +1,40 @@
+;; Copyright (C) 2002-2004, Yuji Minejima <ggb01164@nifty.ne.jp>
+;; ALL RIGHTS RESERVED.
+;;
+;; $Id: should-eval.lisp,v 1.7 2004/02/20 07:23:42 yuji Exp $
+;;
+;; Redistribution and use in source and binary forms, with or without
+;; modification, are permitted provided that the following conditions
+;; are met:
+;;
+;; * Redistributions of source code must retain the above copyright
+;; notice, this list of conditions and the following disclaimer.
+;; * 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.
+;;
+;; 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
+;; OWNER 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.
+
+(HANDLER-CASE (PROGN (SPECIAL-OPERATOR-P '(IF T NIL T)))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+
+(HANDLER-CASE (PROGN (SPECIAL-OPERATOR-P '(NOT A SYMBOL)))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+
+
+
diff --git a/Sacla/tests/should-hash-table.lisp b/Sacla/tests/should-hash-table.lisp
new file mode 100644
index 0000000..2b5f98d
--- /dev/null
+++ b/Sacla/tests/should-hash-table.lisp
@@ -0,0 +1,48 @@
+;; Copyright (C) 2002-2004, Yuji Minejima <ggb01164@nifty.ne.jp>
+;; ALL RIGHTS RESERVED.
+;;
+;; $Id: should-hash-table.lisp,v 1.7 2004/02/20 07:23:42 yuji Exp $
+;;
+;; Redistribution and use in source and binary forms, with or without
+;; modification, are permitted provided that the following conditions
+;; are met:
+;;
+;; * Redistributions of source code must retain the above copyright
+;; notice, this list of conditions and the following disclaimer.
+;; * 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.
+;;
+;; 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
+;; OWNER 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.
+
+(HANDLER-CASE (PROGN (HASH-TABLE-REHASH-SIZE 'NOT-A-HASH-TABLE))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+
+(HANDLER-CASE (PROGN (HASH-TABLE-REHASH-THRESHOLD 'NOT-A-HASH-TABLE))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+
+(HANDLER-CASE (PROGN (HASH-TABLE-TEST 'NOT-A-HASH-TABLE))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+
+
+
+
+
+
diff --git a/Sacla/tests/should-package.lisp b/Sacla/tests/should-package.lisp
new file mode 100644
index 0000000..fc68915
--- /dev/null
+++ b/Sacla/tests/should-package.lisp
@@ -0,0 +1,53 @@
+;; Copyright (C) 2002-2004, Yuji Minejima <ggb01164@nifty.ne.jp>
+;; ALL RIGHTS RESERVED.
+;;
+;; $Id: should-package.lisp,v 1.8 2004/02/20 07:23:42 yuji Exp $
+;;
+;; Redistribution and use in source and binary forms, with or without
+;; modification, are permitted provided that the following conditions
+;; are met:
+;;
+;; * Redistributions of source code must retain the above copyright
+;; notice, this list of conditions and the following disclaimer.
+;; * 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.
+;;
+;; 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
+;; OWNER 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.
+
+(HANDLER-CASE (PROGN (PACKAGE-NAME '(NOT A PACKAGE DESIGNATOR)))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (PACKAGE-NICKNAMES '(NOT A PACKAGE DESIGNATOR)))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (PACKAGE-SHADOWING-SYMBOLS '(NOT A PACKAGE DESIGNATOR)))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (PACKAGE-USE-LIST '(NOT A PACKAGE DESIGNATOR)))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (PACKAGE-USED-BY-LIST '(NOT A PACKAGE DESIGNATOR)))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (EVAL (MACROEXPAND '(WITH-PACKAGE-ITERATOR (GET 'CL)))))
+ (PROGRAM-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+
diff --git a/Sacla/tests/should-sequence.lisp b/Sacla/tests/should-sequence.lisp
new file mode 100644
index 0000000..455a941
--- /dev/null
+++ b/Sacla/tests/should-sequence.lisp
@@ -0,0 +1,375 @@
+;; Copyright (C) 2002-2004, Yuji Minejima <ggb01164@nifty.ne.jp>
+;; ALL RIGHTS RESERVED.
+;;
+;; $Id: should-sequence.lisp,v 1.18 2004/02/20 07:23:42 yuji Exp $
+;;
+;; Redistribution and use in source and binary forms, with or without
+;; modification, are permitted provided that the following conditions
+;; are met:
+;;
+;; * Redistributions of source code must retain the above copyright
+;; notice, this list of conditions and the following disclaimer.
+;; * 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.
+;;
+;; 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
+;; OWNER 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.
+
+(HANDLER-CASE (PROGN (LENGTH 'NOT-A-SEQ))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+
+
+
+(HANDLER-CASE (PROGN (COPY-SEQ 'NOT-A-SEQ))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (COPY-SEQ #2A((#\a #\b #\c) (#\x #\y #\z))))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (COPY-SEQ #\a))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (COPY-SEQ '(A . B)))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+
+
+(HANDLER-CASE (PROGN (ELT 'NOT-A-SEQ 0))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (ELT #\a 0))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (ELT '(0 1 . 2) 2))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+;; (HANDLER-CASE (PROGN (ELT '#1=(0 1 . #1#) 3))
+;; (TYPE-ERROR NIL T)
+;; (ERROR NIL NIL)
+;; (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+
+(HANDLER-CASE (PROGN (SETF (ELT 'NOT-A-SEQ 0) 0))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (SETF (ELT #\a 0) 0))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (SETF (ELT '(0 1 . 2) 2) 0))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+;; (HANDLER-CASE (PROGN (SETF (ELT '#1=(0 1 . #1#) 3) 0))
+;; (TYPE-ERROR NIL T)
+;; (ERROR NIL NIL)
+;; (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+
+(HANDLER-CASE (PROGN (ELT "012" -1))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (ELT "012" 'INDEX))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (ELT "012" "xyz"))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (ELT "012" 100))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (ELT #(A B C D) 100))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (ELT '(0 1 2) 100))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE
+ (PROGN
+ (ELT (MAKE-ARRAY 10 :FILL-POINTER 3
+ :INITIAL-CONTENTS '(0 1 2 3 4 5 6 7 8 9))
+ 3))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+
+
+
+(HANDLER-CASE (PROGN (SETF (ELT (COPY-SEQ "012") -1) #\a))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (SETF (ELT (COPY-SEQ "012") 'INDEX) #\a))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (SETF (ELT (COPY-SEQ "012") "xyz") #\a))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (SETF (ELT (COPY-SEQ "012") 100) #\a))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (SETF (ELT (LIST 0 1 2) 100) 0))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (SETF (ELT (LIST 0 1 2) -1) 0))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+
+
+(HANDLER-CASE (PROGN (FILL 'NOT-A-SEQ 'A))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (FILL #\a 'A))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (FILL (LIST 0 1 2) 'A :START 'NOT-A-INT))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (FILL (LIST 0 1 2) 'A :START -1))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (FILL (LIST 0 1 2) 'A :END 'NOT-A-INT))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (FILL (LIST 0 1 2) 'A :END -1))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+
+(HANDLER-CASE (PROGN (MAKE-SEQUENCE '(VECTOR * 2) 3))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (MAKE-SEQUENCE '(VECTOR * 4) 3))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (MAKE-SEQUENCE '(ARRAY * 3) 2))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (MAKE-SEQUENCE '(ARRAY * (1 2 3)) 2))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (MAKE-SEQUENCE 'SYMBOL 2))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+
+
+(HANDLER-CASE (PROGN (SUBSEQ 'NOT-A-SEQ 0))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (SUBSEQ #\a 0))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+
+(HANDLER-CASE (PROGN (SETF (SUBSEQ (LIST 0 1 2 3) 1) 'NOT-A-SEQ))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (SETF (SUBSEQ (VECTOR 0 1 2 3) 1) 'NOT-A-SEQ))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+
+(HANDLER-CASE (PROGN (MAP '(VECTOR T 10) #'+ '(0 1) '(1 0)))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (MAP 'LIST #'+ '(0 1) '(1 0) 'NOT-A-SEQ))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+
+(progn
+ #-cmu
+ (HANDLER-CASE (PROGN (MAP '(VECTOR * 4) #'CONS "abc" "de"))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+ #+cmu 'skipped)
+(progn
+ #-(or cmu clisp)
+ (HANDLER-CASE (PROGN (MAP 'NULL #'CONS "abc" "de"))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+ #+(or cmu clisp) 'skipped)
+(progn
+ #-cmu
+ (HANDLER-CASE (PROGN (MAP '(CONS * NULL) #'CONS "abc" "de"))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+ #+cmu 'skipped)
+
+
+(HANDLER-CASE (PROGN (MAP-INTO 'NOT-A-SEQ #'+ '(0 1 2)))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(progn
+ #-cmu
+ (HANDLER-CASE (PROGN (MAP-INTO (LIST 0 1 2 3) #'+ 'NOT-A-SEQ))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+ #+cmu 'skipped)
+(progn
+ #-cmu
+ (HANDLER-CASE (PROGN (MAP-INTO (LIST 0 1 2 3) #'+ '(0 1) 'NOT-A-SEQ))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+ #+cmu 'skipped)
+
+(HANDLER-CASE (PROGN (REDUCE #'LIST 'NOT-A-SEQUENCE))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+
+(HANDLER-CASE (PROGN (COUNT 0 'NOT-A-SEQUENCE))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (COUNT 0 #\a))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (COUNT-IF #'NUMBERP 'NOT-A-SEQUENCE))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (COUNT-IF #'NUMBERP #\a))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (COUNT-IF-NOT #'NUMBERP 'NOT-A-SEQUENCE))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (COUNT-IF-NOT #'NUMBERP #\a))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+
+(HANDLER-CASE (PROGN (REVERSE 'NOT-A-SEQUENCE))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (NREVERSE 'NOT-A-SEQUENCE))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+
+
+(HANDLER-CASE (PROGN (FIND 'ITEM 'NOT-A-SEQUENCE))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (FIND-IF (CONSTANTLY NIL) 'NOT-A-SEQUENCE))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (FIND-IF-NOT (CONSTANTLY T) 'NOT-A-SEQUENCE))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+
+(HANDLER-CASE (PROGN (POSITION 'ITEM 'NOT-A-SEQUENCE))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (POSITION-IF (CONSTANTLY NIL) 'NOT-A-SEQUENCE))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (POSITION-IF-NOT (CONSTANTLY T) 'NOT-A-SEQUENCE))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+
+(HANDLER-CASE (PROGN (CONCATENATE '(VECTOR * 2) "a" "bc"))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (MERGE '(VECTOR * 4) '(1 5) '(2 4 6) #'<))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+
+(HANDLER-CASE (PROGN (REMOVE 'A 'NOT-A-SEQUENCE))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (REMOVE-IF (CONSTANTLY T) 'NOT-A-SEQUENCE))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE
+ (PROGN (REMOVE-IF-NOT (COMPLEMENT (CONSTANTLY T)) 'NOT-A-SEQUENCE))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (DELETE 'A 'NOT-A-SEQUENCE))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (DELETE-IF (CONSTANTLY T) 'NOT-A-SEQUENCE))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE
+ (PROGN (DELETE-IF-NOT (COMPLEMENT (CONSTANTLY T)) 'NOT-A-SEQUENCE))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+
+(HANDLER-CASE (PROGN (REMOVE-DUPLICATES 'NOT-A-SEQUENCE))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (DELETE-DUPLICATES 'NOT-A-SEQUENCE))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+
diff --git a/Sacla/tests/should-string.lisp b/Sacla/tests/should-string.lisp
new file mode 100644
index 0000000..53a4c8b
--- /dev/null
+++ b/Sacla/tests/should-string.lisp
@@ -0,0 +1,28 @@
+;; Copyright (C) 2002-2004, Yuji Minejima <ggb01164@nifty.ne.jp>
+;; ALL RIGHTS RESERVED.
+;;
+;; $Id: should-string.lisp,v 1.8 2004/02/20 07:23:42 yuji Exp $
+;;
+;; Redistribution and use in source and binary forms, with or without
+;; modification, are permitted provided that the following conditions
+;; are met:
+;;
+;; * Redistributions of source code must retain the above copyright
+;; notice, this list of conditions and the following disclaimer.
+;; * 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.
+;;
+;; 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
+;; OWNER 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.
+
diff --git a/Sacla/tests/should-symbol.lisp b/Sacla/tests/should-symbol.lisp
new file mode 100644
index 0000000..9628622
--- /dev/null
+++ b/Sacla/tests/should-symbol.lisp
@@ -0,0 +1,227 @@
+;; Copyright (C) 2002-2004, Yuji Minejima <ggb01164@nifty.ne.jp>
+;; ALL RIGHTS RESERVED.
+;;
+;; $Id: should-symbol.lisp,v 1.7 2004/02/20 07:23:42 yuji Exp $
+;;
+;; Redistribution and use in source and binary forms, with or without
+;; modification, are permitted provided that the following conditions
+;; are met:
+;;
+;; * Redistributions of source code must retain the above copyright
+;; notice, this list of conditions and the following disclaimer.
+;; * 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.
+;;
+;; 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
+;; OWNER 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.
+
+(HANDLER-CASE (PROGN (MAKE-SYMBOL 'NOT-A-STRING))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (MAKE-SYMBOL #\a))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (MAKE-SYMBOL '(NAME)))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+
+(HANDLER-CASE (PROGN (COPY-SYMBOL "NOT A SYMBOL"))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (COPY-SYMBOL #\a))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (COPY-SYMBOL '(NAME)))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+
+
+(HANDLER-CASE (PROGN (GENSYM 'EAT-THIS))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (GENSYM -1))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (GENSYM #\a))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+
+
+(HANDLER-CASE (PROGN (GENTEMP 'NOT-A-STRING))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (GENTEMP #\a))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (GENTEMP "TEMP" '(NIL)))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+
+
+(HANDLER-CASE (PROGN (SYMBOL-FUNCTION "not-a-function"))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (SYMBOL-FUNCTION #\a))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (SYMBOL-FUNCTION '(NIL)))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE
+ (PROGN (FMAKUNBOUND 'SYMBOL-FOR-TEST) (SYMBOL-FUNCTION 'SYMBOL-FOR-TEST))
+ (UNDEFINED-FUNCTION NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+
+(HANDLER-CASE (PROGN (SYMBOL-NAME "not-a-symbol"))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (SYMBOL-NAME #\a))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (SYMBOL-NAME '(NIL)))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+
+(HANDLER-CASE (PROGN (SYMBOL-PACKAGE "not-a-symbol"))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (SYMBOL-PACKAGE #\a))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (SYMBOL-PACKAGE '(NIL)))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+
+(HANDLER-CASE (PROGN (SYMBOL-PLIST "not-a-symbol"))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (SYMBOL-PLIST #\a))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (SYMBOL-PLIST '(NIL)))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+
+(HANDLER-CASE (PROGN (SYMBOL-VALUE "not-a-symbol"))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (SYMBOL-VALUE #\a))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (SYMBOL-VALUE '(NIL)))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+
+(HANDLER-CASE (PROGN (PROGN (MAKUNBOUND 'A) (SYMBOL-VALUE 'A)))
+ (UNBOUND-VARIABLE NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+
+
+
+(HANDLER-CASE (PROGN (GET "not-a-symbol" 'A))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (GET #\a 'A))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (GET '(NIL) 'A))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+
+
+
+(HANDLER-CASE (PROGN (REMPROP "not-a-symbol" 'A))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (REMPROP #\a 'A))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (REMPROP '(NIL) 'A))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+
+(HANDLER-CASE (PROGN (BOUNDP "not-a-symbol"))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (BOUNDP #\a))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (BOUNDP '(NIL)))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+
+(HANDLER-CASE (PROGN (MAKUNBOUND "not-a-symbol"))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (MAKUNBOUND #\a))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (MAKUNBOUND '(NIL)))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+
+(HANDLER-CASE (PROGN (SET "not-a-symbol" 1))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (SET #\a 0))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (SET '(NIL) 2))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+
diff --git a/Sacla/tests/x-sequence.lisp b/Sacla/tests/x-sequence.lisp
new file mode 100644
index 0000000..1c43652
--- /dev/null
+++ b/Sacla/tests/x-sequence.lisp
@@ -0,0 +1,300 @@
+;; Copyright (C) 2002-2004, Yuji Minejima <ggb01164@nifty.ne.jp>
+;; ALL RIGHTS RESERVED.
+;;
+;; $Id: x-sequence.lisp,v 1.11 2004/02/20 07:23:42 yuji Exp $
+;;
+;; Redistribution and use in source and binary forms, with or without
+;; modification, are permitted provided that the following conditions
+;; are met:
+;;
+;; * Redistributions of source code must retain the above copyright
+;; notice, this list of conditions and the following disclaimer.
+;; * 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.
+;;
+;; 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
+;; OWNER 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.
+
+(HANDLER-CASE (PROGN (SUBSEQ '(0 1 . 2) 1))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (SUBSEQ '#1=(0 1 . #1#) 3))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (MAP 'LIST #'+ '(0 1 . 2) '(1 0 -1 -2)))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+
+(HANDLER-CASE (PROGN (REDUCE #'LIST '(1 . 2)))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (REDUCE #'LIST '#1=(1 2 3 4 5 6 7 8 9 . #1#)))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (REDUCE #'LIST '(A . #1=(1 2 3 4 5 6 7 8 9 . #1#))))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (REDUCE #'LIST '(A B . #1=(1 2 3 4 5 6 7 8 9 . #1#))))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (REDUCE #'LIST '(A B C . #1=(1 2 3 4 5 6 7 8 9 . #1#))))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (REDUCE #'LIST '(A B C D . #1=(1 2 3 4 5 6 7 8 9 . #1#))))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE
+ (PROGN (REDUCE #'LIST '(A B C D E . #1=(1 2 3 4 5 6 7 8 9 . #1#))))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE
+ (PROGN (REDUCE #'LIST '(A B C D E F . #1=(1 2 3 4 5 6 7 8 9 . #1#))))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE
+ (PROGN (REDUCE #'LIST '(A B C D E F G . #1=(1 2 3 4 5 6 7 8 9 . #1#))))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE
+ (PROGN (REDUCE #'LIST '(A B C D E F G H . #1=(1 2 3 4 5 6 7 8 9 . #1#))))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE
+ (PROGN (REDUCE #'LIST '(A B C D E F G H I . #1=(1 2 3 4 5 6 7 8 9 . #1#))))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE
+ (PROGN (REDUCE #'LIST '(A B C D E F G H I J . #1=(1 2 3 4 5 6 7 8 9 . #1#))))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE
+ (PROGN
+ (REDUCE #'LIST '(A B C D E F G H I J K . #1=(1 2 3 4 5 6 7 8 9 . #1#))))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+
+
+(HANDLER-CASE (PROGN (LENGTH '(A . B)))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (LENGTH '#1=(0 1 . #1#)))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (REDUCE #'LIST '(1 . 2)))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (REDUCE #'LIST '#1=(1 2 3 4 5 6 7 8 9 . #1#)))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (LENGTH '(A . #1=(1 2 3 4 5 6 7 8 9 . #1#))))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (LENGTH '(A B . #1=(1 2 3 4 5 6 7 8 9 . #1#))))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (LENGTH '(A B C . #1=(1 2 3 4 5 6 7 8 9 . #1#))))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (LENGTH '(A B C D . #1=(1 2 3 4 5 6 7 8 9 . #1#))))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (LENGTH '(A B C D E . #1=(1 2 3 4 5 6 7 8 9 . #1#))))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (LENGTH '(A B C D E F . #1=(1 2 3 4 5 6 7 8 9 . #1#))))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (LENGTH '(A B C D E F G . #1=(1 2 3 4 5 6 7 8 9 . #1#))))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE
+ (PROGN (LENGTH '(A B C D E F G H . #1=(1 2 3 4 5 6 7 8 9 . #1#))))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE
+ (PROGN (LENGTH '(A B C D E F G H I . #1=(1 2 3 4 5 6 7 8 9 . #1#))))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE
+ (PROGN (LENGTH '(A B C D E F G H I J . #1=(1 2 3 4 5 6 7 8 9 . #1#))))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE
+ (PROGN (LENGTH '(A B C D E F G H I J K . #1=(1 2 3 4 5 6 7 8 9 . #1#))))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+
+
+(HANDLER-CASE (PROGN (REVERSE '(A . B)))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (REVERSE '#1=(0 1 . #1#)))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (REVERSE '#1=(1 2 3 4 5 6 7 8 9 . #1#)))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (REVERSE '(A . #1=(1 2 3 4 5 6 7 8 9 . #1#))))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (REVERSE '(A B . #1=(1 2 3 4 5 6 7 8 9 . #1#))))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (REVERSE '(A B C . #1=(1 2 3 4 5 6 7 8 9 . #1#))))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (REVERSE '(A B C D . #1=(1 2 3 4 5 6 7 8 9 . #1#))))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (REVERSE '(A B C D E . #1=(1 2 3 4 5 6 7 8 9 . #1#))))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (REVERSE '(A B C D E F . #1=(1 2 3 4 5 6 7 8 9 . #1#))))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (REVERSE '(A B C D E F G . #1=(1 2 3 4 5 6 7 8 9 . #1#))))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE
+ (PROGN (REVERSE '(A B C D E F G H . #1=(1 2 3 4 5 6 7 8 9 . #1#))))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE
+ (PROGN (REVERSE '(A B C D E F G H I . #1=(1 2 3 4 5 6 7 8 9 . #1#))))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE
+ (PROGN (REVERSE '(A B C D E F G H I J . #1=(1 2 3 4 5 6 7 8 9 . #1#))))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE
+ (PROGN (REVERSE '(A B C D E F G H I J K . #1=(1 2 3 4 5 6 7 8 9 . #1#))))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+
+
+(HANDLER-CASE (PROGN (NREVERSE (CONS 'A 'B)))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE
+ (PROGN
+ (LET ((A (LIST 0 1)))
+ (SETF (CDDR A) A)
+ (NREVERSE A)))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+
+(HANDLER-CASE
+ (PROGN
+ (LET ((A (LIST 0 1 2 3)))
+ (SETF (CDR (NTHCDR 3 A)) A)
+ (NREVERSE A)))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+
+(HANDLER-CASE
+ (PROGN
+ (LET ((A (LIST 0 1 2 3 4)))
+ (SETF (CDR (NTHCDR 4 A)) (CDDR A))
+ (NREVERSE A)))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+
+(HANDLER-CASE (PROGN (FIND 'ITEM '(A B . C)))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (FIND-IF (CONSTANTLY NIL) '(A B . C)))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (FIND-IF-NOT (CONSTANTLY T) '(A B . C)))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+
+(HANDLER-CASE (PROGN (FIND 'ITEM '#1=(A B . #1#)))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (FIND-IF (CONSTANTLY NIL) '#1=(A B . #1#)))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (FIND-IF-NOT (CONSTANTLY T) '#1=(A B . #1#)))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+
+(HANDLER-CASE (PROGN (POSITION 'ITEM '#1=(A B . #1#)))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (POSITION-IF (CONSTANTLY NIL) '#1=(A B . #1#)))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
+(HANDLER-CASE (PROGN (POSITION-IF-NOT (CONSTANTLY T) '#1=(A B . #1#)))
+ (TYPE-ERROR NIL T)
+ (ERROR NIL NIL)
+ (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))