diff options
| author | Matthias Andreas Benkard <matthias@benkard.de> | 2008-07-31 09:33:25 +0200 |
|---|---|---|
| committer | Matthias Andreas Benkard <matthias@benkard.de> | 2008-07-31 09:33:25 +0200 |
| commit | 0f383318a079bd0c7bb23c909f30771b1c20b29c (patch) | |
| tree | bc4e2e9a4d5670c4d2dd3886637d11f7f4d5581c /Sacla/tests | |
| parent | 563dd3a5963fb34903e2e209833d66a19e691d96 (diff) | |
Add Sacla to the repository.
Diffstat (limited to 'Sacla/tests')
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)) |