sigsegv on s390 only giving start address of page in segv handler
Christoph Egger
christoph at debian.org
Sun Apr 3 13:49:20 UTC 2011
Hi!
Sorry for not getting to it quicker.
Bruno Haible <bruno at clisp.org> writes:
> On 2011-03-13, you reported that with the Linux/S390 specific modifications
> to libsigsegv clisp did not yet work correctly. I proposed a patch that ought
> to fix this:
> <http://lists.gnu.org/archive/html/bug-libsigsegv/2011-03/msg00007.html>
>
> Did you have time to test this patch? I would not want to commit into clisp
> a patch that is not tested, and I don't want to release libsigsegv 2.10
> before it has been asserted that it works fine in clisp.
Using the -pre libsigsegv I can build clisp fine and it appears to
be basically working -- playing around doesn't result in any obvious
problems. However `make check` is segfaulting. I've attached output of
make check.
Regards
Christoph
-------------- next part --------------
mkdir -p gllib
test -f gllib/Makefile || sh config.status gllib/Makefile depfiles
cd gllib && make CFLAGS="-g -O2 -W -Wswitch -Wcomment -Wpointer-arith -Wimplicit -Wreturn-type -Wmissing-declarations -Wno-sign-compare -Wno-format-nonliteral -O2 -falign-functions=4 -DENABLE_UNICODE -DDYNAMIC_FFI -DDYNAMIC_MODULES -I. -fPIC" CLISP_LIBDIR=/home/christoph/clisp/src
make[1]: Entering directory `/home/christoph/clisp/src/gllib'
make all-recursive
make[2]: Entering directory `/home/christoph/clisp/src/gllib'
make[3]: Entering directory `/home/christoph/clisp/src/gllib'
make[3]: Nothing to be done for `all-am'.
make[3]: Leaving directory `/home/christoph/clisp/src/gllib'
make[2]: Leaving directory `/home/christoph/clisp/src/gllib'
make[1]: Leaving directory `/home/christoph/clisp/src/gllib'
test -r libgnu_cl.a || ln -s gllib/libgnu.a libgnu_cl.a
cmp -s init.fas stage/init.fas || (echo "Test failed." ; exit 1)
cmp -s defseq.fas stage/defseq.fas || (echo "Test failed." ; exit 1)
cmp -s backquote.fas stage/backquote.fas || (echo "Test failed." ; exit 1)
cmp -s defmacro.fas stage/defmacro.fas || (echo "Test failed." ; exit 1)
cmp -s macros1.fas stage/macros1.fas || (echo "Test failed." ; exit 1)
cmp -s macros2.fas stage/macros2.fas || (echo "Test failed." ; exit 1)
cmp -s defs1.fas stage/defs1.fas || (echo "Test failed." ; exit 1)
cmp -s lambdalist.fas stage/lambdalist.fas || (echo "Test failed." ; exit 1)
cmp -s places.fas stage/places.fas || (echo "Test failed." ; exit 1)
cmp -s floatprint.fas stage/floatprint.fas || (echo "Test failed." ; exit 1)
cmp -s defpackage.fas stage/defpackage.fas || (echo "Test failed." ; exit 1)
cmp -s type.fas stage/type.fas || (echo "Test failed." ; exit 1)
cmp -s subtypep.fas stage/subtypep.fas || (echo "Test failed." ; exit 1)
cmp -s clos-package.fas stage/clos-package.fas || (echo "Test failed." ; exit 1)
cmp -s clos-macros.fas stage/clos-macros.fas || (echo "Test failed." ; exit 1)
cmp -s clos-class0.fas stage/clos-class0.fas || (echo "Test failed." ; exit 1)
cmp -s clos-metaobject1.fas stage/clos-metaobject1.fas || (echo "Test failed." ; exit 1)
cmp -s clos-slotdef1.fas stage/clos-slotdef1.fas || (echo "Test failed." ; exit 1)
cmp -s clos-stablehash1.fas stage/clos-stablehash1.fas || (echo "Test failed." ; exit 1)
cmp -s clos-specializer1.fas stage/clos-specializer1.fas || (echo "Test failed." ; exit 1)
cmp -s clos-class1.fas stage/clos-class1.fas || (echo "Test failed." ; exit 1)
cmp -s clos-class2.fas stage/clos-class2.fas || (echo "Test failed." ; exit 1)
cmp -s clos-class3.fas stage/clos-class3.fas || (echo "Test failed." ; exit 1)
cmp -s defstruct.fas stage/defstruct.fas || (echo "Test failed." ; exit 1)
cmp -s format.fas stage/format.fas || (echo "Test failed." ; exit 1)
cmp -s international.fas stage/international.fas || (echo "Test failed." ; exit 1)
cmp -s savemem.fas stage/savemem.fas || (echo "Test failed." ; exit 1)
cmp -s functions.fas stage/functions.fas || (echo "Test failed." ; exit 1)
cmp -s trace.fas stage/trace.fas || (echo "Test failed." ; exit 1)
cmp -s cmacros.fas stage/cmacros.fas || (echo "Test failed." ; exit 1)
cmp -s compiler.fas stage/compiler.fas || (echo "Test failed." ; exit 1)
cmp -s defs2.fas stage/defs2.fas || (echo "Test failed." ; exit 1)
cmp -s loop.fas stage/loop.fas || (echo "Test failed." ; exit 1)
cmp -s clos.fas stage/clos.fas || (echo "Test failed." ; exit 1)
cmp -s clos-stablehash2.fas stage/clos-stablehash2.fas || (echo "Test failed." ; exit 1)
cmp -s clos-specializer2.fas stage/clos-specializer2.fas || (echo "Test failed." ; exit 1)
cmp -s clos-specializer3.fas stage/clos-specializer3.fas || (echo "Test failed." ; exit 1)
cmp -s clos-class4.fas stage/clos-class4.fas || (echo "Test failed." ; exit 1)
cmp -s clos-class5.fas stage/clos-class5.fas || (echo "Test failed." ; exit 1)
cmp -s clos-class6.fas stage/clos-class6.fas || (echo "Test failed." ; exit 1)
cmp -s clos-slotdef2.fas stage/clos-slotdef2.fas || (echo "Test failed." ; exit 1)
cmp -s clos-slotdef3.fas stage/clos-slotdef3.fas || (echo "Test failed." ; exit 1)
cmp -s clos-slots1.fas stage/clos-slots1.fas || (echo "Test failed." ; exit 1)
cmp -s clos-slots2.fas stage/clos-slots2.fas || (echo "Test failed." ; exit 1)
cmp -s clos-method1.fas stage/clos-method1.fas || (echo "Test failed." ; exit 1)
cmp -s clos-method2.fas stage/clos-method2.fas || (echo "Test failed." ; exit 1)
cmp -s clos-method3.fas stage/clos-method3.fas || (echo "Test failed." ; exit 1)
cmp -s clos-method4.fas stage/clos-method4.fas || (echo "Test failed." ; exit 1)
cmp -s clos-methcomb1.fas stage/clos-methcomb1.fas || (echo "Test failed." ; exit 1)
cmp -s clos-methcomb2.fas stage/clos-methcomb2.fas || (echo "Test failed." ; exit 1)
cmp -s clos-methcomb3.fas stage/clos-methcomb3.fas || (echo "Test failed." ; exit 1)
cmp -s clos-methcomb4.fas stage/clos-methcomb4.fas || (echo "Test failed." ; exit 1)
cmp -s clos-genfun1.fas stage/clos-genfun1.fas || (echo "Test failed." ; exit 1)
cmp -s clos-genfun2a.fas stage/clos-genfun2a.fas || (echo "Test failed." ; exit 1)
cmp -s clos-genfun2b.fas stage/clos-genfun2b.fas || (echo "Test failed." ; exit 1)
cmp -s clos-genfun3.fas stage/clos-genfun3.fas || (echo "Test failed." ; exit 1)
cmp -s clos-genfun4.fas stage/clos-genfun4.fas || (echo "Test failed." ; exit 1)
cmp -s clos-genfun5.fas stage/clos-genfun5.fas || (echo "Test failed." ; exit 1)
cmp -s clos-dependent.fas stage/clos-dependent.fas || (echo "Test failed." ; exit 1)
cmp -s clos-print.fas stage/clos-print.fas || (echo "Test failed." ; exit 1)
cmp -s clos-custom.fas stage/clos-custom.fas || (echo "Test failed." ; exit 1)
cmp -s documentation.fas stage/documentation.fas || (echo "Test failed." ; exit 1)
cmp -s fill-out.fas stage/fill-out.fas || (echo "Test failed." ; exit 1)
cmp -s disassem.fas stage/disassem.fas || (echo "Test failed." ; exit 1)
cmp -s condition.fas stage/condition.fas || (echo "Test failed." ; exit 1)
cmp -s loadform.fas stage/loadform.fas || (echo "Test failed." ; exit 1)
cmp -s gstream.fas stage/gstream.fas || (echo "Test failed." ; exit 1)
cmp -s xcharin.fas stage/xcharin.fas || (echo "Test failed." ; exit 1)
cmp -s keyboard.fas stage/keyboard.fas || (echo "Test failed." ; exit 1)
cmp -s screen.fas stage/screen.fas || (echo "Test failed." ; exit 1)
cmp -s runprog.fas stage/runprog.fas || (echo "Test failed." ; exit 1)
cmp -s query.fas stage/query.fas || (echo "Test failed." ; exit 1)
cmp -s reploop.fas stage/reploop.fas || (echo "Test failed." ; exit 1)
cmp -s dribble.fas stage/dribble.fas || (echo "Test failed." ; exit 1)
cmp -s complete.fas stage/complete.fas || (echo "Test failed." ; exit 1)
cmp -s pprint.fas stage/pprint.fas || (echo "Test failed." ; exit 1)
cmp -s describe.fas stage/describe.fas || (echo "Test failed." ; exit 1)
cmp -s room.fas stage/room.fas || (echo "Test failed." ; exit 1)
cmp -s edit.fas stage/edit.fas || (echo "Test failed." ; exit 1)
cmp -s macros3.fas stage/macros3.fas || (echo "Test failed." ; exit 1)
cmp -s clhs.fas stage/clhs.fas || (echo "Test failed." ; exit 1)
cmp -s inspect.fas stage/inspect.fas || (echo "Test failed." ; exit 1)
cmp -s gray.fas stage/gray.fas || (echo "Test failed." ; exit 1)
cmp -s case-sensitive.fas stage/case-sensitive.fas || (echo "Test failed." ; exit 1)
cmp -s foreign1.fas stage/foreign1.fas || (echo "Test failed." ; exit 1)
cmp -s exporting.fas stage/exporting.fas || (echo "Test failed." ; exit 1)
cmp -s german.fas stage/german.fas || (echo "Test failed." ; exit 1)
cmp -s french.fas stage/french.fas || (echo "Test failed." ; exit 1)
cmp -s spanish.fas stage/spanish.fas || (echo "Test failed." ; exit 1)
cmp -s russian.fas stage/russian.fas || (echo "Test failed." ; exit 1)
cmp -s danish.fas stage/danish.fas || (echo "Test failed." ; exit 1)
cmp -s dutch.fas stage/dutch.fas || (echo "Test failed." ; exit 1)
cmp -s deprecated.fas stage/deprecated.fas || (echo "Test failed." ; exit 1)
cmp -s config.fas stage/config.fas || (echo "Test failed." ; exit 1)
echo "Test passed."
Test passed.
rm -f fresh-line.out
./lisp.run -B . -N locale -E UTF-8 -Epathname 1:1 -Emisc 1:1 -norc -q -M lispinit.mem -x '(progn (dolist (s (quote (*terminal-io* *standard-output* *error-output* *query-io* *debug-io* *trace-output*))) (format t "~S = ~S~%" s (symbol-value s))) (values))' 2>&1 | cat > fresh-line.out
./lisp.run -B . -N locale -E UTF-8 -Epathname 1:1 -Emisc 1:1 -norc -q -M lispinit.mem -x '(progn (format *terminal-io* "~&Line1 to *terminal-io*") (format *terminal-io* "~&Line2 to *terminal-io*") (values))' 2>&1 | cat >> fresh-line.out
./lisp.run -B . -N locale -E UTF-8 -Epathname 1:1 -Emisc 1:1 -norc -q -M lispinit.mem -x '(progn (format *terminal-io* "~&Line1 to *terminal-io*") (format *standard-output* "~&Line2 to *standard-output*") (values))' 2>&1 | cat >> fresh-line.out
./lisp.run -B . -N locale -E UTF-8 -Epathname 1:1 -Emisc 1:1 -norc -q -M lispinit.mem -x '(progn (format *terminal-io* "~&Line1 to *terminal-io*") (format *error-output* "~&Line2 to *error-output*") (values))' 2>&1 | cat >> fresh-line.out
./lisp.run -B . -N locale -E UTF-8 -Epathname 1:1 -Emisc 1:1 -norc -q -M lispinit.mem -x '(progn (format *terminal-io* "~&Line1 to *terminal-io*") (format *query-io* "~&Line2 to *query-io*") (values))' 2>&1 | cat >> fresh-line.out
./lisp.run -B . -N locale -E UTF-8 -Epathname 1:1 -Emisc 1:1 -norc -q -M lispinit.mem -x '(progn (format *terminal-io* "~&Line1 to *terminal-io*") (format *debug-io* "~&Line2 to *debug-io*") (values))' 2>&1 | cat >> fresh-line.out
./lisp.run -B . -N locale -E UTF-8 -Epathname 1:1 -Emisc 1:1 -norc -q -M lispinit.mem -x '(progn (format *terminal-io* "~&Line1 to *terminal-io*") (format *trace-output* "~&Line2 to *trace-output*") (values))' 2>&1 | cat >> fresh-line.out
./lisp.run -B . -N locale -E UTF-8 -Epathname 1:1 -Emisc 1:1 -norc -q -M lispinit.mem -x '(progn (format *standard-output* "~&Line1 to *standard-output*") (format *terminal-io* "~&Line2 to *terminal-io*") (values))' 2>&1 | cat >> fresh-line.out
./lisp.run -B . -N locale -E UTF-8 -Epathname 1:1 -Emisc 1:1 -norc -q -M lispinit.mem -x '(progn (format *standard-output* "~&Line1 to *standard-output*") (format *standard-output* "~&Line2 to *standard-output*") (values))' 2>&1 | cat >> fresh-line.out
./lisp.run -B . -N locale -E UTF-8 -Epathname 1:1 -Emisc 1:1 -norc -q -M lispinit.mem -x '(progn (format *standard-output* "~&Line1 to *standard-output*") (format *error-output* "~&Line2 to *error-output*") (values))' 2>&1 | cat >> fresh-line.out
./lisp.run -B . -N locale -E UTF-8 -Epathname 1:1 -Emisc 1:1 -norc -q -M lispinit.mem -x '(progn (format *standard-output* "~&Line1 to *standard-output*") (format *query-io* "~&Line2 to *query-io*") (values))' 2>&1 | cat >> fresh-line.out
./lisp.run -B . -N locale -E UTF-8 -Epathname 1:1 -Emisc 1:1 -norc -q -M lispinit.mem -x '(progn (format *standard-output* "~&Line1 to *standard-output*") (format *debug-io* "~&Line2 to *debug-io*") (values))' 2>&1 | cat >> fresh-line.out
./lisp.run -B . -N locale -E UTF-8 -Epathname 1:1 -Emisc 1:1 -norc -q -M lispinit.mem -x '(progn (format *standard-output* "~&Line1 to *standard-output*") (format *trace-output* "~&Line2 to *trace-output*") (values))' 2>&1 | cat >> fresh-line.out
./lisp.run -B . -N locale -E UTF-8 -Epathname 1:1 -Emisc 1:1 -norc -q -M lispinit.mem -x '(progn (format *error-output* "~&Line1 to *error-output*") (format *terminal-io* "~&Line2 to *terminal-io*") (values))' 2>&1 | cat >> fresh-line.out
./lisp.run -B . -N locale -E UTF-8 -Epathname 1:1 -Emisc 1:1 -norc -q -M lispinit.mem -x '(progn (format *error-output* "~&Line1 to *error-output*") (format *standard-output* "~&Line2 to *standard-output*") (values))' 2>&1 | cat >> fresh-line.out
./lisp.run -B . -N locale -E UTF-8 -Epathname 1:1 -Emisc 1:1 -norc -q -M lispinit.mem -x '(progn (format *error-output* "~&Line1 to *error-output*") (format *error-output* "~&Line2 to *error-output*") (values))' 2>&1 | cat >> fresh-line.out
./lisp.run -B . -N locale -E UTF-8 -Epathname 1:1 -Emisc 1:1 -norc -q -M lispinit.mem -x '(progn (format *error-output* "~&Line1 to *error-output*") (format *query-io* "~&Line2 to *query-io*") (values))' 2>&1 | cat >> fresh-line.out
./lisp.run -B . -N locale -E UTF-8 -Epathname 1:1 -Emisc 1:1 -norc -q -M lispinit.mem -x '(progn (format *error-output* "~&Line1 to *error-output*") (format *debug-io* "~&Line2 to *debug-io*") (values))' 2>&1 | cat >> fresh-line.out
./lisp.run -B . -N locale -E UTF-8 -Epathname 1:1 -Emisc 1:1 -norc -q -M lispinit.mem -x '(progn (format *error-output* "~&Line1 to *error-output*") (format *trace-output* "~&Line2 to *trace-output*") (values))' 2>&1 | cat >> fresh-line.out
./lisp.run -B . -N locale -E UTF-8 -Epathname 1:1 -Emisc 1:1 -norc -q -M lispinit.mem -x '(progn (format *query-io* "~&Line1 to *query-io*") (format *terminal-io* "~&Line2 to *terminal-io*") (values))' 2>&1 | cat >> fresh-line.out
./lisp.run -B . -N locale -E UTF-8 -Epathname 1:1 -Emisc 1:1 -norc -q -M lispinit.mem -x '(progn (format *query-io* "~&Line1 to *query-io*") (format *standard-output* "~&Line2 to *standard-output*") (values))' 2>&1 | cat >> fresh-line.out
./lisp.run -B . -N locale -E UTF-8 -Epathname 1:1 -Emisc 1:1 -norc -q -M lispinit.mem -x '(progn (format *query-io* "~&Line1 to *query-io*") (format *error-output* "~&Line2 to *error-output*") (values))' 2>&1 | cat >> fresh-line.out
./lisp.run -B . -N locale -E UTF-8 -Epathname 1:1 -Emisc 1:1 -norc -q -M lispinit.mem -x '(progn (format *query-io* "~&Line1 to *query-io*") (format *query-io* "~&Line2 to *query-io*") (values))' 2>&1 | cat >> fresh-line.out
./lisp.run -B . -N locale -E UTF-8 -Epathname 1:1 -Emisc 1:1 -norc -q -M lispinit.mem -x '(progn (format *query-io* "~&Line1 to *query-io*") (format *debug-io* "~&Line2 to *debug-io*") (values))' 2>&1 | cat >> fresh-line.out
./lisp.run -B . -N locale -E UTF-8 -Epathname 1:1 -Emisc 1:1 -norc -q -M lispinit.mem -x '(progn (format *query-io* "~&Line1 to *query-io*") (format *trace-output* "~&Line2 to *trace-output*") (values))' 2>&1 | cat >> fresh-line.out
./lisp.run -B . -N locale -E UTF-8 -Epathname 1:1 -Emisc 1:1 -norc -q -M lispinit.mem -x '(progn (format *debug-io* "~&Line1 to *debug-io*") (format *terminal-io* "~&Line2 to *terminal-io*") (values))' 2>&1 | cat >> fresh-line.out
./lisp.run -B . -N locale -E UTF-8 -Epathname 1:1 -Emisc 1:1 -norc -q -M lispinit.mem -x '(progn (format *debug-io* "~&Line1 to *debug-io*") (format *standard-output* "~&Line2 to *standard-output*") (values))' 2>&1 | cat >> fresh-line.out
./lisp.run -B . -N locale -E UTF-8 -Epathname 1:1 -Emisc 1:1 -norc -q -M lispinit.mem -x '(progn (format *debug-io* "~&Line1 to *debug-io*") (format *error-output* "~&Line2 to *error-output*") (values))' 2>&1 | cat >> fresh-line.out
./lisp.run -B . -N locale -E UTF-8 -Epathname 1:1 -Emisc 1:1 -norc -q -M lispinit.mem -x '(progn (format *debug-io* "~&Line1 to *debug-io*") (format *query-io* "~&Line2 to *query-io*") (values))' 2>&1 | cat >> fresh-line.out
./lisp.run -B . -N locale -E UTF-8 -Epathname 1:1 -Emisc 1:1 -norc -q -M lispinit.mem -x '(progn (format *debug-io* "~&Line1 to *debug-io*") (format *debug-io* "~&Line2 to *debug-io*") (values))' 2>&1 | cat >> fresh-line.out
./lisp.run -B . -N locale -E UTF-8 -Epathname 1:1 -Emisc 1:1 -norc -q -M lispinit.mem -x '(progn (format *debug-io* "~&Line1 to *debug-io*") (format *trace-output* "~&Line2 to *trace-output*") (values))' 2>&1 | cat >> fresh-line.out
./lisp.run -B . -N locale -E UTF-8 -Epathname 1:1 -Emisc 1:1 -norc -q -M lispinit.mem -x '(progn (format *trace-output* "~&Line1 to *trace-output*") (format *terminal-io* "~&Line2 to *terminal-io*") (values))' 2>&1 | cat >> fresh-line.out
./lisp.run -B . -N locale -E UTF-8 -Epathname 1:1 -Emisc 1:1 -norc -q -M lispinit.mem -x '(progn (format *trace-output* "~&Line1 to *trace-output*") (format *standard-output* "~&Line2 to *standard-output*") (values))' 2>&1 | cat >> fresh-line.out
./lisp.run -B . -N locale -E UTF-8 -Epathname 1:1 -Emisc 1:1 -norc -q -M lispinit.mem -x '(progn (format *trace-output* "~&Line1 to *trace-output*") (format *error-output* "~&Line2 to *error-output*") (values))' 2>&1 | cat >> fresh-line.out
./lisp.run -B . -N locale -E UTF-8 -Epathname 1:1 -Emisc 1:1 -norc -q -M lispinit.mem -x '(progn (format *trace-output* "~&Line1 to *trace-output*") (format *query-io* "~&Line2 to *query-io*") (values))' 2>&1 | cat >> fresh-line.out
./lisp.run -B . -N locale -E UTF-8 -Epathname 1:1 -Emisc 1:1 -norc -q -M lispinit.mem -x '(progn (format *trace-output* "~&Line1 to *trace-output*") (format *debug-io* "~&Line2 to *debug-io*") (values))' 2>&1 | cat >> fresh-line.out
./lisp.run -B . -N locale -E UTF-8 -Epathname 1:1 -Emisc 1:1 -norc -q -M lispinit.mem -x '(progn (format *trace-output* "~&Line1 to *trace-output*") (format *trace-output* "~&Line2 to *trace-output*") (values))' 2>&1 | cat >> fresh-line.out
if grep 'Line1.*Line2' fresh-line.out > /dev/null; then exit 1; fi
rm -f fresh-line.out
./lisp.run -B . -N locale -E UTF-8 -Epathname 1:1 -Emisc 1:1 -norc -q -M lispinit.mem 0>/dev/null
test `echo '(princ (+ 11 99))' | ./lisp.run -B . -N locale -E UTF-8 -Epathname 1:1 -Emisc 1:1 -norc -q -M lispinit.mem - | tr -d '\r'` = 110 || exit 1
test "`echo '(+ foo bar)' | ./lisp.run -B . -N locale -E UTF-8 -Epathname 1:1 -Emisc 1:1 -norc -q -M lispinit.mem -x '(setq foo 11 bar 99)' -repl | tr -d '\r'| tr '\n' '_'`" = '99_[1]> _110_' || exit 1
rm -f script.lisp; echo '(error "loading script.lisp")' > script.lisp
if ./lisp.run -B . -N locale -E UTF-8 -Epathname 1:1 -Emisc 1:1 -norc -q -M lispinit.mem -x '(load "script.lisp")' -repl < /dev/null; then exit 1; else :; fi
;; Loading file script.lisp ...
*** - loading script.lisp
The following restarts are available:
SKIP :R1 skip (ERROR loading script.lisp)
RETRY :R2 retry (ERROR loading script.lisp)
STOP :R3 stop loading file /home/christoph/clisp/src/script.lisp
ABORT :R4 Abort main loop
(echo '(progn (setf (stream-element-type *standard-input*) (quote (unsigned-byte 8))) (exit 42))' | ./lisp.run -B . -N locale -E UTF-8 -Epathname 1:1 -Emisc 1:1 -norc -q -M lispinit.mem -; test $? = 42) || exit 1
test `echo '(setf (stream-element-type *standard-output*) (quote (unsigned-byte 8))) (write-sequence (convert-string-to-bytes "42" charset:ascii) *standard-output*) (setf (stream-element-type *standard-output*) (quote character)) (terpri)' | ./lisp.run -B . -N locale -E UTF-8 -Epathname 1:1 -Emisc 1:1 -norc -q -M lispinit.mem - | tr -d '\r'` = 42 || exit 1
rm -f script.lisp; echo '(+ 11 99)' > script.lisp
test `./lisp.run -B . -N locale -E UTF-8 -Epathname 1:1 -Emisc 1:1 -norc -q -M lispinit.mem < script.lisp | tr -d '\r'` = 110 || exit 1
rm -f script.lisp; echo '(princ (+ 11 99))' > script.lisp
test `./lisp.run -B . -N locale -E UTF-8 -Epathname 1:1 -Emisc 1:1 -norc -q -M lispinit.mem script.lisp | tr -d '\r'` = 110 || exit 1
rm -f script.lisp; echo '(+ foo bar)' > script.lisp
test `./lisp.run -B . -N locale -E UTF-8 -Epathname 1:1 -Emisc 1:1 -norc -q -M lispinit.mem -x '(setq foo 11 bar 99)' -repl < script.lisp | tr -d '\r'| tr '\n' '_'` = 99_110_ || exit 1
rm -f script.lisp; echo '(progn (setf (stream-element-type *standard-input*) (quote (unsigned-byte 8))) (exit 42))' > script.lisp
(./lisp.run -B . -N locale -E UTF-8 -Epathname 1:1 -Emisc 1:1 -norc -q -M lispinit.mem < script.lisp; test $? = 42) || exit 1
(./lisp.run -B . -N locale -E UTF-8 -Epathname 1:1 -Emisc 1:1 -norc -q -M lispinit.mem script.lisp; test $? = 42) || exit 1
rm -f script.lisp; echo '(setf (stream-element-type *standard-output*) (quote (unsigned-byte 8))) (write-sequence (convert-string-to-bytes "42" charset:ascii) *standard-output*) (setf (stream-element-type *standard-output*) (quote character)) (terpri)' > script.lisp
test `./lisp.run -B . -N locale -E UTF-8 -Epathname 1:1 -Emisc 1:1 -norc -q -M lispinit.mem script.lisp | tr -d '\r'` = 42 || exit 1
rm -f script.lisp; echo '(with-open-stream (s (make-stream :output :element-type (quote (unsigned-byte 8)))) (write-sequence (convert-string-to-bytes "42" charset:ascii) s) (values))' > script.lisp
test `./lisp.run -B . -N locale -E UTF-8 -Epathname 1:1 -Emisc 1:1 -norc -q -M lispinit.mem < script.lisp | tr -d '\r'` = 42 || exit 1
test `./lisp.run -B . -N locale -E UTF-8 -Epathname 1:1 -Emisc 1:1 -norc -q -M lispinit.mem script.lisp | tr -d '\r'` = 42 || exit 1
rm -f script.lisp; nohup ./lisp.run -B . -N locale -E UTF-8 -Epathname 1:1 -Emisc 1:1 -norc -q -M lispinit.mem -x 42 2>&1 > script.lisp; test `tail -n 1 script.lisp | tr -d '\r'` = 42 || exit 1
nohup: ignoring input
rm -f script.lisp
./lisp.run -B . -N locale -E UTF-8 -Epathname 1:1 -Emisc 1:1 -norc -M lispinit.mem -x "(saveinitmem \"foo\" :executable t :norc t)"
i i i i i i i ooooo o ooooooo ooooo ooooo
I I I I I I I 8 8 8 8 8 o 8 8
I \ `+' / I 8 8 8 8 8 8
\ `-+-' / 8 8 8 ooooo 8oooo
`-__|__-' 8 8 8 8 8
| 8 o 8 8 o 8 8
------+------ ooooo 8oooooo ooo8ooo ooooo 8
Welcome to GNU CLISP 2.49 (2010-07-07) <http://clisp.cons.org/>
Copyright (c) Bruno Haible, Michael Stoll 1992, 1993
Copyright (c) Bruno Haible, Marcus Daniels 1994-1997
Copyright (c) Bruno Haible, Pierpaolo Bernardi, Sam Steingold 1998
Copyright (c) Bruno Haible, Sam Steingold 1999-2000
Copyright (c) Sam Steingold, Bruno Haible 2001-2010
Type :h and hit Enter for context help.
;; Wrote the memory image into foo (8,175,274 bytes)
Bytes permanently allocated: 90,464
Bytes currently in use: 1,810,600
Bytes available until next GC: 902,276
1810600 ;
902276 ;
90464 ;
1 ;
65284 ;
11984
Bye.
./foo -x "(setq zz 10) (saveinitmem \"foo\")"
i i i i i i i ooooo o ooooooo ooooo ooooo
I I I I I I I 8 8 8 8 8 o 8 8
I \ `+' / I 8 8 8 8 8 8
\ `-+-' / 8 8 8 ooooo 8oooo
`-__|__-' 8 8 8 8 8
| 8 o 8 8 o 8 8
------+------ ooooo 8oooooo ooo8ooo ooooo 8
Welcome to GNU CLISP 2.49 (2010-07-07) <http://clisp.cons.org/>
Copyright (c) Bruno Haible, Michael Stoll 1992, 1993
Copyright (c) Bruno Haible, Marcus Daniels 1994-1997
Copyright (c) Bruno Haible, Pierpaolo Bernardi, Sam Steingold 1998
Copyright (c) Bruno Haible, Sam Steingold 1999-2000
Copyright (c) Sam Steingold, Bruno Haible 2001-2010
Type :h and hit Enter for context help.
10
;; Wrote the memory image into foo.mem (1,901,924 bytes)
Bytes permanently allocated: 90,464
Bytes currently in use: 1,810,384
Bytes available until next GC: 902,114
1810384 ;
902114 ;
90464 ;
1 ;
23304 ;
11973
Bye.
./foo -norc -M foo.mem -x zz
i i i i i i i ooooo o ooooooo ooooo ooooo
I I I I I I I 8 8 8 8 8 o 8 8
I \ `+' / I 8 8 8 8 8 8
\ `-+-' / 8 8 8 ooooo 8oooo
`-__|__-' 8 8 8 8 8
| 8 o 8 8 o 8 8
------+------ ooooo 8oooooo ooo8ooo ooooo 8
Welcome to GNU CLISP 2.49 (2010-07-07) <http://clisp.cons.org/>
Copyright (c) Bruno Haible, Michael Stoll 1992, 1993
Copyright (c) Bruno Haible, Marcus Daniels 1994-1997
Copyright (c) Bruno Haible, Pierpaolo Bernardi, Sam Steingold 1998
Copyright (c) Bruno Haible, Sam Steingold 1999-2000
Copyright (c) Sam Steingold, Bruno Haible 2001-2010
Type :h and hit Enter for context help.
10
Bye.
./lisp.run -B . -N locale -E UTF-8 -Epathname 1:1 -Emisc 1:1 -norc -M lispinit.mem -x "(saveinitmem \"foo\" :executable t :norc t :quiet t :init-function (lambda () (prin1 *args*) (exit)))" -- a 1
i i i i i i i ooooo o ooooooo ooooo ooooo
I I I I I I I 8 8 8 8 8 o 8 8
I \ `+' / I 8 8 8 8 8 8
\ `-+-' / 8 8 8 ooooo 8oooo
`-__|__-' 8 8 8 8 8
| 8 o 8 8 o 8 8
------+------ ooooo 8oooooo ooo8ooo ooooo 8
Welcome to GNU CLISP 2.49 (2010-07-07) <http://clisp.cons.org/>
Copyright (c) Bruno Haible, Michael Stoll 1992, 1993
Copyright (c) Bruno Haible, Marcus Daniels 1994-1997
Copyright (c) Bruno Haible, Pierpaolo Bernardi, Sam Steingold 1998
Copyright (c) Bruno Haible, Sam Steingold 1999-2000
Copyright (c) Sam Steingold, Bruno Haible 2001-2010
Type :h and hit Enter for context help.
;; Wrote the memory image into foo (8,176,054 bytes)
Bytes permanently allocated: 90,464
Bytes currently in use: 1,811,380
Bytes available until next GC: 902,666
1811380 ;
902666 ;
90464 ;
1 ;
67824 ;
11976
Bye.
test "`./foo b | tr -d '\r'`" = '("b")' || exit 1
test "`./foo b 2 | tr -d '\r'`" = '("b" "2")' || exit 1
ls -l lisp.run lispinit.mem foo foo.mem
-rwxr-xr-x 1 christoph Debian 8176054 Apr 3 13:41 foo
-rw-r--r-- 1 christoph Debian 1901924 Apr 3 13:41 foo.mem
-rw-r--r-- 1 christoph Debian 1909972 Apr 3 13:38 lispinit.mem
-rwxr-xr-x 1 christoph Debian 6273098 Apr 3 13:37 lisp.run
rm -f foo foo.mem
cd tests && make SHELL='/bin/bash' LEXE=.run
make[1]: Entering directory `/home/christoph/clisp/src/tests'
rm -f *.erg
LC_MESSAGES=en_US ../lisp.run -E utf-8 -norc -B ../ -N ../locale -M ../lispinit.mem -m 30MW -L english -i tests -x "(time (run-all-tests))"
i i i i i i i ooooo o ooooooo ooooo ooooo
I I I I I I I 8 8 8 8 8 o 8 8
I \ `+' / I 8 8 8 8 8 8
\ `-+-' / 8 8 8 ooooo 8oooo
`-__|__-' 8 8 8 8 8
| 8 o 8 8 o 8 8
------+------ ooooo 8oooooo ooo8ooo ooooo 8
Welcome to GNU CLISP 2.49 (2010-07-07) <http://clisp.cons.org/>
Copyright (c) Bruno Haible, Michael Stoll 1992, 1993
Copyright (c) Bruno Haible, Marcus Daniels 1994-1997
Copyright (c) Bruno Haible, Pierpaolo Bernardi, Sam Steingold 1998
Copyright (c) Bruno Haible, Sam Steingold 1999-2000
Copyright (c) Sam Steingold, Bruno Haible 2001-2010
Type :h and hit Enter for context help.
;; Loading file /home/christoph/clisp/src/tests/tests.fas ...
;; Loaded file /home/christoph/clisp/src/tests/tests.fas
RUN-TEST: started #<INPUT BUFFERED FILE-STREAM CHARACTER #P"alltest.tst" @1>
((LAMBDA (A B) (+ A (* B 3))) 4 5)
EQL-OK: 19
((LAMBDA (A &OPTIONAL (B 2)) (+ A (* B 3))) 4 5)
EQL-OK: 19
((LAMBDA (&OPTIONAL (A 2 B) (C 3 D) &REST X) (LIST A B C D X)))
EQUAL-OK: (2 NIL 3 NIL NIL)
((LAMBDA (A B &KEY C D) (LIST A B C D)) 1 2)
EQUAL-OK: (1 2 NIL NIL)
((LAMBDA (A &OPTIONAL (B 3) &REST X &KEY C (D A)) (LIST A B C D X)) 1)
EQUAL-OK: (1 3 NIL 1 NIL)
((LAMBDA (X &AUX (A 3) (B 4)) (+ X (* A B))) 2)
EQL-OK: 14
((LAMBDA (X Y &OPTIONAL A B &REST Z &KEY C (D Y) &AUX (U 3) (V 4)) (+ X Y A (* B (CAR Z)) C (* D U) V)) 3 4 5 2 7 :C 6 :D 8)
[SIMPLE-PROGRAM-ERROR]: :LAMBDA: keyword arguments in (7 :C 6 :D 8) should occur pairwise
EQL-OK: ERROR
((LAMBDA (X Y) ((LAMBDA (A B) (LIST A B)) 'U 'V)) 5 6)
EQUAL-OK: (U V)
((LAMBDA (X &ALLOW-OTHER-KEYS) (LIST X Y)) 2 :Y 3)
[SIMPLE-PROGRAM-ERROR]: APPLY: argument list given to SYSTEM::ERROR-OF-TYPE is dotted (terminated by "Lambda list marker &ALLOW-OTHER-KEYS not allowed here.")
EQL-OK: ERROR
LAMBDA-LIST-KEYWORDS
EQUAL-OK: (&OPTIONAL &REST &KEY &ALLOW-OTHER-KEYS &AUX &BODY &WHOLE &ENVIRONMENT)
(LET ((S (PRIN1-TO-STRING LAMBDA-PARAMETERS-LIMIT))) (OR (EQUAL S "65536") (EQUAL S "4294967296") (EQUAL S "4096")))
EQL-OK: T
(TYPEP 'NIL 'NULL)
EQL-OK: T
(TYPEP '(A B C) 'NULL)
EQL-OK: NIL
(TYPEP 'ABC 'SYMBOL)
EQL-OK: T
(TYPEP 4 'ATOM)
EQL-OK: T
(TYPEP 55 'CONS)
EQL-OK: NIL
(TYPEP '(A (B C)) 'LIST)
EQL-OK: T
(TYPEP 5/8 'NUMBER)
EQL-OK: T
(TYPEP -800 'INTEGER)
EQL-OK: T
(TYPEP 5/7 'RATIONAL)
EQL-OK: T
(TYPEP 2.718 'FLOAT)
EQL-OK: T
(TYPEP #C(1.23 3.56) 'FLOAT)
EQL-OK: NIL
(TYPEP #\a 'CHARACTER)
EQL-OK: T
(TYPEP "abc" 'STRING)
EQL-OK: T
(TYPEP '#(1 2 3) 'STRING)
EQL-OK: NIL
(TYPEP '#(A B C) 'BIT-VECTOR)
EQL-OK: NIL
(TYPEP '#(A B C) 'VECTOR)
EQL-OK: T
(TYPEP "abc" 'VECTOR)
EQL-OK: T
(TYPEP '#(1 2 3 4) 'SIMPLE-VECTOR)
EQL-OK: T
(TYPEP 3 'SIMPLE-VECTOR)
EQL-OK: NIL
(TYPEP "a b cd" 'SIMPLE-STRING)
EQL-OK: T
(TYPEP 'ABC 'SIMPLE-STRING)
EQL-OK: NIL
(TYPEP #*1101 'SIMPLE-BIT-VECTOR)
EQL-OK: T
(TYPEP '#(1 0 0 1) 'SIMPLE-BIT-VECTOR)
EQL-OK: NIL
(TYPEP '#2A((A B) (C D)) 'ARRAY)
EQL-OK: T
(SETQ X 7)
EQL-OK: 7
(TYPEP X 'COMPILED-FUNCTION)
EQL-OK: NIL
(TYPEP X 'COMMON)
[SIMPLE-ERROR]: TYPEP: invalid type specification COMMON
EQL-OK: ERROR
(SUBTYPEP 'CHARACTER 'NUMBER)
EQL-OK: NIL
(SUBTYPEP 'NUMBER 'CHARACTER)
EQL-OK: NIL
(SUBTYPEP 'STRING 'NUMBER)
EQL-OK: NIL
(SUBTYPEP 'COMPLEX 'NUMBER)
EQL-OK: T
(SUBTYPEP 'FLOAT 'NUMBER)
EQL-OK: T
(SUBTYPEP 'FIXNUM 'NUMBER)
EQL-OK: T
(SUBTYPEP 'RATIONAL 'NUMBER)
EQL-OK: T
(SUBTYPEP 'FLOAT 'COMPLEX)
EQL-OK: NIL
(SUBTYPEP 'INTEGER 'RATIONAL)
EQL-OK: T
(SUBTYPEP 'NUMBER 'VECTOR)
EQL-OK: NIL
(SUBTYPEP 'VECTOR 'ARRAY)
EQL-OK: T
(SUBTYPEP 'NUMBER 'ARRAY)
EQL-OK: NIL
(NULL 'NIL)
EQL-OK: T
(SYMBOLP *STANDARD-INPUT*)
EQL-OK: NIL
(SYMBOLP 'CAR)
EQL-OK: T
(ATOM 'ABC)
EQL-OK: T
(CONSP (ACONS 'X 'Y 'A))
EQL-OK: T
(LISTP '(((A . B) . C)))
EQL-OK: T
(LISTP 'A)
EQL-OK: NIL
(LISTP NIL)
EQL-OK: T
(LISTP '(A B C))
EQL-OK: T
(NUMBERP #*101)
EQL-OK: NIL
(NUMBERP -5)
EQL-OK: T
(INTEGERP 5)
EQL-OK: T
(INTEGERP #\+)
EQL-OK: NIL
(RATIONALP 0)
EQL-OK: T
(FLOATP -5)
EQL-OK: NIL
(FLOATP (READ-FROM-STRING "1.0e30"))
EQL-OK: T
(FLOATP 123.4)
EQL-OK: T
(COMPLEXP 1/2)
EQL-OK: NIL
(COMPLEXP #C(2 3))
EQL-OK: T
(CHARACTERP #\1)
EQL-OK: T
(STRINGP "abc")
EQL-OK: T
(STRINGP :+*/-)
EQL-OK: NIL
(BIT-VECTOR-P (READ-FROM-STRING "#5*01110"))
EQL-OK: T
(VECTORP "abc")
EQL-OK: T
(SIMPLE-VECTOR-P #*101)
EQL-OK: NIL
(SIMPLE-STRING-P "abc")
EQL-OK: T
(SIMPLE-STRING-P :+*/-)
EQL-OK: NIL
(SIMPLE-BIT-VECTOR-P #*101)
EQL-OK: T
(ARRAYP (READ-FROM-STRING "#7(2 4 3)"))
EQL-OK: T
(ARRAYP '(READ-FROM-STRING "#1a 5.77"))
EQL-OK: NIL
(PACKAGEP (READ-FROM-STRING "#5*01110"))
EQL-OK: NIL
(PACKAGEP *PACKAGE*)
EQL-OK: T
(FUNCTIONP 'ATOM)
EQL-OK: NIL
(COMPILED-FUNCTION-P 'DO)
EQL-OK: NIL
(EQ '(1 2 3 4 5) (COPY-LIST '(1 2 3 4 5)))
EQL-OK: NIL
(SETQ X '((1 . A) (2 . B) (3 . C)))
EQUAL-OK: ((1 . A) (2 . B) (3 . C))
(EQ (CADR X) (CADR (COPY-ALIST X)))
EQL-OK: NIL
(EQ #\A #\A)
EQL-OK: T
(EQ "Foo" "Foo")
EQL-OK: NIL
(EQ "Foo" (COPY-SEQ "Foo"))
EQL-OK: NIL
(EQL #C(3.0 -4.0) #C(3 -4))
EQL-OK: NIL
(EQL (CONS 'A 'B) (CONS 'A 'C))
EQL-OK: NIL
(EQUAL '(1 2 3 4 5) (COPY-LIST '(1 2 3 4 5)))
EQL-OK: T
(EQUAL X (COPY-ALIST X))
EQL-OK: T
(EQUAL 3 3)
EQL-OK: T
(EQUAL 3 3.0)
EQL-OK: NIL
(EQUAL 3.0 3.0)
EQL-OK: T
(EQUAL #C(3 -4) #C(3 -4))
EQL-OK: T
(EQUALP '(1 2 3 4 5) (COPY-LIST '(1 2 3 4 5)))
EQL-OK: T
(EQUALP " foo" " FOO")
EQL-OK: T
(EQUALP " fou" " FOO")
EQL-OK: NIL
(EQUALP '(0 1) '(#P""))
EQL-OK: NIL
(NOT 1)
EQL-OK: NIL
(NOT NIL)
EQL-OK: T
(AND (EQ 1 2) (EQ 2 3) (EQ 3 4) (EQ 4 4))
EQL-OK: NIL
(AND (EQ 1 2) (EQ 3 3) (EQ 3 4) (EQ 4 4))
EQL-OK: NIL
(OR (EQ 2 2) (EQ 3 3) (EQ 3 4) (EQ 4 4))
EQL-OK: T
(OR (EQ 1 2) (EQ 2 3) (EQ 3 4) (EQ 4 5))
EQL-OK: NIL
(SETQ LI1 '(A (B) ((C) (D))))
EQUAL-OK: (A (B) ((C) (D)))
(SETQ VEC1 '#(0 1 2 3))
EQUALP-OK: #(0 1 2 3)
(SETF (NTH 1 LI1) 'UU)
EQL-OK: UU
(EVAL 'LI1)
EQUAL-OK: (A UU ((C) (D)))
(SETF (ELT LI1 1) 'OO)
EQL-OK: OO
(SETF (ELT VEC1 1) 'OO)
EQL-OK: OO
(EVAL 'LI1)
EQUAL-OK: (A OO ((C) (D)))
(EVAL 'VEC1)
EQUALP-OK: #(0 OO 2 3)
(SETF (REST LI1) '((WW)))
EQUAL-OK: ((WW))
(EVAL 'LI1)
EQUAL-OK: (A (WW))
(SETF (FIRST LI1) 'AA)
EQL-OK: AA
(FIRST LI1)
EQL-OK: AA
(SETF (SECOND LI1) 'BB)
EQL-OK: BB
(EVAL 'LI1)
EQUAL-OK: (AA BB)
(SETF (REST LI1) '(2 3 4 5 6 7 8 9 10))
EQUAL-OK: (2 3 4 5 6 7 8 9 10)
(SETF (SECOND LI1) 22)
EQL-OK: 22
(EVAL 'LI1)
EQUAL-OK: (AA 22 3 4 5 6 7 8 9 10)
(SETF (THIRD LI1) '33)
EQL-OK: 33
(SETF (FOURTH LI1) '44)
EQL-OK: 44
(SETF (FIFTH LI1) '55)
EQL-OK: 55
(SETF (SIXTH LI1) '66)
EQL-OK: 66
(SETF (SEVENTH LI1) '77)
EQL-OK: 77
(SETF (EIGHTH LI1) '88)
EQL-OK: 88
(SETF (NINTH LI1) '99)
EQL-OK: 99
(SETF (TENTH LI1) '1010)
EQL-OK: 1010
(EVAL 'LI1)
EQUAL-OK: (AA 22 33 44 55 66 77 88 99 1010)
(SETF (FIRST LI1) '(((A))))
EQUAL-OK: (((A)))
(SETF (CAAAR LI1) 'UU)
EQL-OK: UU
(CAAAR LI1)
EQL-OK: UU
(CAR LI1)
EQUAL-OK: ((UU))
(SETF (CAAR LI1) 'OO)
EQL-OK: OO
(EVAL 'LI1)
EQUAL-OK: ((OO) 22 33 44 55 66 77 88 99 1010)
(SETF (CAR LI1) 'II)
EQL-OK: II
(EVAL 'LI1)
EQUAL-OK: (II 22 33 44 55 66 77 88 99 1010)
(SETF (CDDDR LI1) 'PP)
EQL-OK: PP
(EVAL 'LI1)
EQUAL-OK: (II 22 33 . PP)
(SETF (CADDR LI1) '333)
EQL-OK: 333
(EVAL 'LI1)
EQUAL-OK: (II 22 333 . PP)
(SETF (SVREF VEC1 2) 'KK)
EQL-OK: KK
(EVAL 'VEC1)
EQUALP-OK: #(0 OO KK 3)
(SETF (GET 'A 'B) 'UU)
EQL-OK: UU
(GET 'A 'B)
EQL-OK: UU
(SETF (GETF (CADR (SETQ XX '(AAA (I1 V1 I2 V2)))) 'I2) 'V222)
EQL-OK: V222
(EVAL 'XX)
EQUAL-OK: (AAA (I1 V1 I2 V222))
(GETF (CADR XX) 'I2)
EQL-OK: V222
(GETF (CADR XX) 'I1)
EQL-OK: V1
(SETF (DOCUMENTATION 'BEISPIEL 'TYP1) "doc 1")
EQUAL-OK: "doc 1"
(SETF (DOCUMENTATION 'BEISPIEL 'TYP2) "doc 2")
EQUAL-OK: "doc 2"
(DOCUMENTATION 'BEISPIEL 'TYP2)
EQUAL-OK: "doc 2"
(SETF (DOCUMENTATION 'BEISPIEL 'TYP2) "doc 3")
EQUAL-OK: "doc 3"
(DOCUMENTATION 'BEISPIEL 'TYP2)
EQUAL-OK: "doc 3"
(SYMBOL-PLIST 'BEISPIEL)
EQUAL-OK: (SYSTEM::DOC (TYP2 "doc 3" TYP1 "doc 1"))
(SETF (SYMBOL-VALUE 'XX) 'VOELLIGNEU)
EQL-OK: VOELLIGNEU
(EVAL 'XX)
EQL-OK: VOELLIGNEU
(LET ((X (LIST 'A 'B 'C))) (RPLACD (LAST X) X) (LIST-LENGTH X))
EQL-OK: NIL
(MAPCAR #'(LAMBDA (X) (LIST X)) '(A B C))
EQUAL-OK: ((A) (B) (C))
(MAPC #'(LAMBDA (X Y Z) (LIST X Y Z)) '(A B C) '(1 2 3) '(U I V))
EQUAL-OK: (A B C)
(MAPL #'(LAMBDA (X Y Z) (LIST X Y Z)) '(A B C) '(1 2 3) '(U I V))
EQUAL-OK: (A B C)
(MAPLIST #'(LAMBDA (X Y Z) (LIST X Y Z)) '(A B C) '(1 2 3) '(U I V))
EQUAL-OK: (((A B C) (1 2 3) (U I V)) ((B C) (2 3) (I V)) ((C) (3) (V)))
(MAPCON #'(LAMBDA (X Y Z) (LIST X Y Z)) '(A B) '(1 2 3) '(U I V))
EQUAL-OK: ((A B) (1 2 3) (U I V) (B) (2 3) (I V))
(MAPCAN #'(LAMBDA (X Y Z) (LIST X Y Z)) '(A B C) '(1 2 3) '(U I V))
EQUAL-OK: (A 1 U B 2 I C 3 V)
(FUNCALL (COMPILE NIL (LAMBDA (X) (FLET ((FOO (Y) (+ Y 1))) (FOO (* 2 X))))) 3)
EQL-OK: 7
(LET ((NOT-A-GLOBALLY-SPECIAL-VAR 3)) (PROGV '(NOT-A-GLOBALLY-SPECIAL-VAR) '(4) (LIST NOT-A-GLOBALLY-SPECIAL-VAR (SYMBOL-VALUE 'NOT-A-GLOBALLY-SPECIAL-VAR))))
EQUAL-OK: (3 4)
(FLET ((CONS (X Y) `(KONS ,X ,Y))) (LET ((CONS (SYMBOL-FUNCTION '+))) (FUNCALL #'CONS (FUNCALL 'CONS 1 2) (FUNCALL CONS 1 2))))
EQUAL-OK: (KONS (1 . 2) 3)
(LET* ((N (MIN (1- LAMBDA-PARAMETERS-LIMIT) (IF (STRING= "g++" (SOFTWARE-TYPE) :END2 3) 256 1024))) (VARS (LOOP REPEAT N COLLECT (GENSYM)))) (EVAL `(= ,N (FLET ((%F ,VARS (+ , at VARS))) (%F ,@(LOOP FOR E IN VARS COLLECT 1))))))
EQL-OK: T
(LET ((LS (LOOP FOR I FROM 1 TO (MIN (1- MULTIPLE-VALUES-LIMIT) 100000) COLLECT I))) (EQUAL LS (MULTIPLE-VALUE-LIST (VALUES-LIST LS))))
EQL-OK: T
(KEYWORDP 36)
EQL-OK: NIL
(KEYWORDP :RENAME)
EQL-OK: T
(ZEROP -456)
EQL-OK: NIL
(ZEROP 0)
EQL-OK: T
(PLUSP 3)
EQL-OK: T
(PLUSP 3453786543987565)
EQL-OK: T
(MINUSP -456)
EQL-OK: T
(ODDP -1)
EQL-OK: T
(ODDP 0)
EQL-OK: NIL
(EVENP -456)
EQL-OK: T
(EVENP -345)
EQL-OK: NIL
(= 5/2 2.5)
EQL-OK: T
(/= 3.0 3)
EQL-OK: NIL
(/= 3.0 #C(3.0 1.0))
EQL-OK: T
(< 3.0 3)
EQL-OK: NIL
(< 3 3.0 3 #C(3.0 0.0))
[SIMPLE-TYPE-ERROR]: <: #1=#C(3.0 0.0) is not a real number
EQL-OK: ERROR
(< -5 -4 -2 0 4 5)
EQL-OK: T
(> 8 7 6 5 4)
EQL-OK: T
(> 3 3.0 3 #C(3.0 0.0))
[SIMPLE-TYPE-ERROR]: >: #1=#C(3.0 0.0) is not a real number
EQL-OK: ERROR
(<= 3.0 3)
EQL-OK: T
(<= 3 3)
EQL-OK: T
(<= 1 3 3 2 5)
EQL-OK: NIL
(<= 5/2 2.5)
EQL-OK: T
(>= -5 -4 -2 0 4 5)
EQL-OK: NIL
(MAX 1 3 2 -7)
EQL-OK: 3
(+ 1 1/2 0.5 #C(3.0 5.5))
EQL-OK: #C(5.0 5.5)
(- 3 0 3 5 -6)
EQL-OK: 1
(- #C(0 6) 1/4 0.5 7)
EQUALP-OK: #C(-7.75 6.0)
(* 7 6 5 4 3 2 1)
EQL-OK: 5040
(* 2 2 2.0 2)
EQL-OK: 16.0
(/ -8)
EQL-OK: -1/8
(/ 4 2)
EQL-OK: 2
(1+ 0)
EQL-OK: 1
(1+ #C(0 1))
EQL-OK: #C(1 1)
(1- 5.0)
EQL-OK: 4.0
(CONJUGATE #C(3/5 4/5))
EQL-OK: #C(3/5 -4/5)
(GCD 91 -49)
EQL-OK: 7
(LCM 14 35)
EQL-OK: 70
(PRIN1-TO-STRING (EXP 1))
EQUAL-OK: "2.7182817"
(EXPT #C(0 1) 2)
EQL-OK: -1
(PRIN1-TO-STRING (EXPT 2 #C(0 1)))
EQUAL-OK: "#C(0.7692389 0.63896126)"
(PRIN1-TO-STRING (LOG -3 10))
EQUAL-OK: "#C(0.47712126 1.3643764)"
(LOG 3 0)
[SIMPLE-DIVISION-BY-ZERO]: LOG: division by zero
EQL-OK: ERROR
(SQRT 9)
EQUALP-OK: 3.0
(SQRT -9.0)
EQUALP-OK: #C(0.0 3.0)
(ISQRT 9)
EQL-OK: 3
(ISQRT 26)
EQL-OK: 5
(ABS 6)
EQL-OK: 6
(ABS -6)
EQL-OK: 6
(SIGNUM 0)
EQL-OK: 0
(SIGNUM -4)
EQL-OK: -1
(SIGNUM 4)
EQL-OK: 1
(PRIN1-TO-STRING (SIN (* 8 (/ PI 2))))
EQUAL-OK: "2.0066230454737344098L-19"
(LET* ((FUDGE 2) (VAL (TAN (/ PI 2))) (REF (COS (/ PI 2))) (REL-ERR (ABS (/ (- (/ VAL) REF) REF)))) (< REL-ERR (* FUDGE LONG-FLOAT-EPSILON)))
EQL-OK: T
(PRIN1-TO-STRING (SIN (EXPT 10 3)))
EQUAL-OK: "0.82687956"
(COS 0)
EQUALP-OK: 1.0
(PRIN1-TO-STRING (COS (/ PI 2)))
EQUAL-OK: "-2.5082788068421680123L-20"
(PRIN1-TO-STRING (TAN 1))
EQUAL-OK: "1.5574077"
(PRIN1-TO-STRING (TAN (/ PI 2)))
EQUAL-OK: "-3.9867976290042641156L19"
(PRIN1-TO-STRING (CIS -1))
EQUAL-OK: "#C(0.5403023 -0.84147096)"
(CIS 2.5)
EQL-OK: #C(-0.8011436 0.5984721)
(PRIN1-TO-STRING (ASIN -1))
EQUAL-OK: "-1.5707964"
(ASIN 0)
EQUALP-OK: 0.0
(ASIN 2)
EQL-OK: #C(1.5707964 -1.316958)
(PRIN1-TO-STRING (ACOS 0))
EQUAL-OK: "1.5707964"
(PRIN1-TO-STRING (ACOS -1))
EQUAL-OK: "3.1415927"
(PRIN1-TO-STRING (ACOS 2))
EQUAL-OK: "#C(0 1.316958)"
(ACOS 1.00001)
EQUALP-OK: #C(0.0 0.0044751023)
(ATAN 1)
EQL-OK: 0.7853981
(PRIN1-TO-STRING PI)
EQUAL-OK: "3.1415926535897932385L0"
(SINH 0)
EQUALP-OK: 0.0
(PRIN1-TO-STRING (SINH #C(5.0 -9.6)))
EQUAL-OK: "#C(-73.06699 12.93681)"
(COSH 0)
EQUALP-OK: 1.0
(PRIN1-TO-STRING (COSH 1))
EQUAL-OK: "1.5430807"
(TANH 50)
EQL-OK: 1.0
(PRIN1-TO-STRING (TANH 0.00753))
EQUAL-OK: "0.0075298576"
(PRIN1-TO-STRING (ASINH 0.5))
EQUAL-OK: "0.48121184"
(PRIN1-TO-STRING (ASINH 3/7))
EQUAL-OK: "0.4164307"
(ACOSH 0)
EQL-OK: #C(0 1.5707964)
(ACOSH 1)
EQL-OK: 0
(ACOSH -1)
EQL-OK: #C(0 3.1415927)
(PRIN1-TO-STRING (ATANH 0.5))
EQUAL-OK: "0.54930615"
(PRIN1-TO-STRING (ATANH 3/7))
EQUAL-OK: "0.4581453"
(= (SIN (* #C(0 1) 5)) (* #C(0 1) (SINH 5)))
EQL-OK: T
(= (COS (* #C(0 1) 5)) (COSH 5))
EQL-OK: T
(= (TAN (* #C(0 1) 5)) (* #C(0 1) (TANH 5)))
EQL-OK: T
(= (SINH (* #C(0 1) 5)) (* #C(0 1) (SIN 5)))
EQL-OK: T
(= (COSH (* #C(0 1) 5)) (COS 5))
EQL-OK: T
(= (TANH (* #C(0 1) 5)) (* #C(0 1) (TAN 5)))
EQL-OK: T
(FLOAT 1)
EQL-OK: 1.0
(FLOAT 0.5)
EQL-OK: 0.5
(RATIONAL 2)
EQL-OK: 2
(RATIONAL 2.0)
EQL-OK: 2
(RATIONAL 2.5)
EQL-OK: 5/2
(RATIONALIZE 2.5)
EQL-OK: 5/2
(RATIONALIZE 7/3)
EQL-OK: 7/3
(RATIONALIZE PI)
EQL-OK: 8717442233/2774848045
(NUMERATOR 5/2)
EQL-OK: 5
(NUMERATOR (/ 8 -6))
EQL-OK: -4
(DENOMINATOR 5/2)
EQL-OK: 2
(DENOMINATOR (/ 8 -6))
EQL-OK: 3
(GCD (NUMERATOR 7/9) (DENOMINATOR 7/9))
EQL-OK: 1
(FLOOR 2.6)
EQL-OK: 2
(FLOOR 2.5)
EQL-OK: 2
(CEILING 2.6)
EQL-OK: 3
(CEILING 2.5)
EQL-OK: 3
(CEILING 2.4)
EQL-OK: 3
(TRUNCATE 2.6)
EQL-OK: 2
(TRUNCATE 2.5)
EQL-OK: 2
(TRUNCATE 2.4)
EQL-OK: 2
(ROUND 2.6)
EQL-OK: 3
(ROUND 2.5)
EQL-OK: 2
(ROUND 2.4)
EQL-OK: 2
(MOD 13 4)
EQL-OK: 1
(MOD -13 4)
EQL-OK: 3
(PRIN1-TO-STRING (REM 13.4 1))
EQUAL-OK: "0.39999962"
(FFLOOR 2.6)
EQUALP-OK: 2
(FFLOOR 2.5)
EQUALP-OK: 2
(FFLOOR 2.4)
EQUALP-OK: 2
(FCEILING -0.3)
EQUALP-OK: 0
(FCEILING -0.7)
EQUALP-OK: 0
(FCEILING -2.4)
EQUALP-OK: -2
(FTRUNCATE 2.5)
EQL-OK: 2.0
(FTRUNCATE 2.4)
EQL-OK: 2.0
(FROUND -0.7)
EQL-OK: -1.0
(FROUND -2.4)
EQL-OK: -2.0
(DECODE-FLOAT 35.0)
EQL-OK: 0.546875
(DECODE-FLOAT 3.5s0)
EQL-OK: 0.875s0
(SCALE-FLOAT 2.5 5)
EQL-OK: 80.0
(SCALE-FLOAT 0.7541 2)
EQL-OK: 3.0164
(FLOAT-RADIX 2.5)
EQL-OK: 2
(FLOAT-RADIX 3.5d0)
EQL-OK: 2
(COMPLEX 1/4 7.3)
EQUALP-OK: #C(0.25 7.3)
(COMPLEX 1 0)
EQL-OK: 1
(REALPART 5)
EQL-OK: 5
(REALPART #C(1.4 0.0))
EQL-OK: 1.4
(IMAGPART 5)
EQL-OK: 0
(IMAGPART #C(1.4 0.0))
EQL-OK: 0.0
(LOGCOUNT 13)
EQL-OK: 3
(LOGCOUNT -13)
EQL-OK: 2
(INTEGER-LENGTH 0)
EQL-OK: 0
(INTEGER-LENGTH 1)
EQL-OK: 1
BOOLE-CLR
EQL-OK: 0
BOOLE-SET
EQL-OK: 15
BOOLE-1
EQL-OK: 10
BOOLE-2
EQL-OK: 12
BOOLE-C1
EQL-OK: 5
BOOLE-C2
EQL-OK: 3
BOOLE-AND
EQL-OK: 8
BOOLE-IOR
EQL-OK: 14
BOOLE-XOR
EQL-OK: 6
BOOLE-EQV
EQL-OK: 9
BOOLE-NAND
EQL-OK: 7
BOOLE-NOR
EQL-OK: 1
BOOLE-ANDC1
EQL-OK: 4
BOOLE-ANDC2
EQL-OK: 2
BOOLE-ORC1
EQL-OK: 13
BOOLE-ORC2
EQL-OK: 11
(LET ((S (PRIN1-TO-STRING MOST-POSITIVE-FIXNUM))) (OR (EQUAL S "16777215") (EQUAL S "33554431") (EQUAL S "67108863") (EQUAL S "4294967295") (EQUAL S "1099511627775") (EQUAL S "281474976710655")))
EQL-OK: T
(LET ((S (PRIN1-TO-STRING MOST-NEGATIVE-FIXNUM))) (OR (EQUAL S "-16777216") (EQUAL S "-33554432") (EQUAL S "-67108864") (EQUAL S "-4294967296") (EQUAL S "-1099511627776") (EQUAL S "-281474976710656")))
EQL-OK: T
(PRIN1-TO-STRING MOST-POSITIVE-SHORT-FLOAT)
EQUAL-OK: "3.4028s38"
(PRIN1-TO-STRING LEAST-POSITIVE-SHORT-FLOAT)
EQUAL-OK: "1.1755s-38"
(PRIN1-TO-STRING LEAST-NEGATIVE-SHORT-FLOAT)
EQUAL-OK: "-1.1755s-38"
(PRIN1-TO-STRING MOST-NEGATIVE-SHORT-FLOAT)
EQUAL-OK: "-3.4028s38"
(LET ((S (PRIN1-TO-STRING MOST-POSITIVE-SINGLE-FLOAT))) (OR (EQUAL S "1.7014117E38") (EQUAL S "3.4028235E38")))
EQL-OK: T
(LET ((S (PRIN1-TO-STRING LEAST-POSITIVE-SINGLE-FLOAT))) (OR (EQUAL S "2.938736E-39") (EQUAL S "1.1754944E-38")))
EQL-OK: T
(LET ((S (PRIN1-TO-STRING LEAST-NEGATIVE-SINGLE-FLOAT))) (OR (EQUAL S "-2.938736E-39") (EQUAL S "-1.1754944E-38")))
EQL-OK: T
(LET ((S (PRIN1-TO-STRING MOST-NEGATIVE-SINGLE-FLOAT))) (OR (EQUAL S "-1.7014117E38") (EQUAL S "-3.4028235E38")))
EQL-OK: T
(LET ((S (PRIN1-TO-STRING MOST-POSITIVE-DOUBLE-FLOAT))) (OR (EQUAL S "8.988465674311579d307") (EQUAL S "1.7976931348623157d308")))
EQL-OK: T
(LET ((S (PRIN1-TO-STRING LEAST-POSITIVE-DOUBLE-FLOAT))) (OR (EQUAL S "5.562684646268004d-309") (EQUAL S "2.2250738585072014d-308")))
EQL-OK: T
(LET ((S (PRIN1-TO-STRING LEAST-NEGATIVE-DOUBLE-FLOAT))) (OR (EQUAL S "-5.562684646268004d-309") (EQUAL S "-2.2250738585072014d-308")))
EQL-OK: T
(LET ((S (PRIN1-TO-STRING MOST-NEGATIVE-DOUBLE-FLOAT))) (OR (EQUAL S "-8.988465674311579d307") (EQUAL S "-1.7976931348623157d308")))
EQL-OK: T
(PRIN1-TO-STRING MOST-POSITIVE-LONG-FLOAT)
EQUAL-OK: "8.8080652584198167656L646456992"
(PRIN1-TO-STRING LEAST-POSITIVE-LONG-FLOAT)
EQUAL-OK: "5.676615526003731344L-646456994"
(PRIN1-TO-STRING LEAST-NEGATIVE-LONG-FLOAT)
EQUAL-OK: "-5.676615526003731344L-646456994"
(PRIN1-TO-STRING MOST-NEGATIVE-LONG-FLOAT)
EQUAL-OK: "-8.8080652584198167656L646456992"
(PRIN1-TO-STRING SHORT-FLOAT-EPSILON)
EQUAL-OK: "7.6295s-6"
(PRIN1-TO-STRING SINGLE-FLOAT-EPSILON)
EQUAL-OK: "5.960465E-8"
(LET ((S (PRIN1-TO-STRING DOUBLE-FLOAT-EPSILON))) (OR (EQUAL S "1.1102230246251568d-16")))
EQL-OK: T
(PRIN1-TO-STRING LONG-FLOAT-EPSILON)
EQUAL-OK: "5.4210108624275221706L-20"
(PRIN1-TO-STRING SHORT-FLOAT-NEGATIVE-EPSILON)
EQUAL-OK: "3.81476s-6"
(PRIN1-TO-STRING SINGLE-FLOAT-NEGATIVE-EPSILON)
EQUAL-OK: "2.9802326E-8"
(LET ((S (PRIN1-TO-STRING DOUBLE-FLOAT-NEGATIVE-EPSILON))) (OR (EQUAL S "5.551115123125784d-17")))
EQL-OK: T
(PRIN1-TO-STRING LONG-FLOAT-NEGATIVE-EPSILON)
EQUAL-OK: "2.7105054312137610853L-20"
(/ 1 0)
[SIMPLE-DIVISION-BY-ZERO]: /: division by zero
EQL-OK: ERROR
(/ 1 0.0s0)
[SIMPLE-DIVISION-BY-ZERO]: /: division by zero
EQL-OK: ERROR
(/ 1 0.0)
[SIMPLE-DIVISION-BY-ZERO]: /: division by zero
EQL-OK: ERROR
(/ 1 0.0d0)
[SIMPLE-DIVISION-BY-ZERO]: /: division by zero
EQL-OK: ERROR
(/ 1 0.0L0)
[SIMPLE-DIVISION-BY-ZERO]: /: division by zero
EQL-OK: ERROR
(EXPT 10.0s0 1000)
[SIMPLE-FLOATING-POINT-OVERFLOW]: EXPT: floating point overflow
EQL-OK: ERROR
(EXPT 10.0 1000)
[SIMPLE-FLOATING-POINT-OVERFLOW]: EXPT: floating point overflow
EQL-OK: ERROR
(EXPT 10.0d0 1000)
[SIMPLE-FLOATING-POINT-OVERFLOW]: EXPT: floating point overflow
EQL-OK: ERROR
(EXPT 10.0L0 1000000000)
[SIMPLE-FLOATING-POINT-OVERFLOW]: EXPT: floating point overflow
EQL-OK: ERROR
(STANDARD-CHAR-P #\a)
EQL-OK: T
(STANDARD-CHAR-P 1)
[SIMPLE-TYPE-ERROR]: STANDARD-CHAR-P: argument 1 is not a character
EQL-OK: ERROR
(GRAPHIC-CHAR-P #\a)
EQL-OK: T
(GRAPHIC-CHAR-P 1)
[SIMPLE-TYPE-ERROR]: GRAPHIC-CHAR-P: argument 1 is not a character
EQL-OK: ERROR
(STRING-CHAR-P #\a)
EQL-OK: T
(STRING-CHAR-P #\1)
EQL-OK: T
(STRING-CHAR-P "")
[SIMPLE-TYPE-ERROR]: STRING-CHAR-P: argument #1="" is not a character
EQL-OK: ERROR
(ALPHA-CHAR-P #\a)
EQL-OK: T
(ALPHA-CHAR-P #\$)
EQL-OK: NIL
(UPPER-CASE-P #\a)
EQL-OK: NIL
(LOWER-CASE-P #\A)
EQL-OK: NIL
(BOTH-CASE-P #\a)
EQL-OK: T
(BOTH-CASE-P #\$)
EQL-OK: NIL
(DIGIT-CHAR-P #\a)
EQL-OK: NIL
(DIGIT-CHAR-P #\5)
EQL-OK: 5
(ALPHANUMERICP #\a)
EQL-OK: T
(ALPHANUMERICP #\$)
EQL-OK: NIL
(CHAR= #\d #\d)
EQL-OK: T
(CHAR/= #\d #\d)
EQL-OK: NIL
(CHAR< #\z #\0)
EQL-OK: NIL
(CHAR-EQUAL #\d #\d)
EQL-OK: T
(CHAR-NOT-EQUAL #\d #\d)
EQL-OK: NIL
(CHAR-LESSP #\d #\x)
EQL-OK: T
(CHAR-LESSP #\d #\d)
EQL-OK: NIL
(CHAR-NOT-GREATERP #\d #\d)
EQL-OK: T
(CHAR-GREATERP #\e #\d)
EQL-OK: T
(CHAR-NOT-LESSP #\e #\d)
EQL-OK: T
(CHAR-UPCASE #\a)
EQL-OK: #\A
(CHAR-UPCASE #\=)
EQL-OK: #\=
(CHAR= (CHAR-DOWNCASE (CHAR-UPCASE #\x)) #\x)
EQL-OK: T
(CHAR-DOWNCASE #\A)
EQL-OK: #\a
(CHAR= (CHAR-UPCASE (CHAR-DOWNCASE #\X)) #\X)
EQL-OK: T
(DIGIT-CHAR 7)
EQL-OK: #\7
(DIGIT-CHAR 12)
EQL-OK: NIL
CHAR-CODE-LIMIT
EQL-OK: 1114112
(ELT (SYMBOL-NAME 'ABC) 0)
EQL-OK: #\A
(SUBSEQ '(A B C D E) 2)
EQUAL-OK: (C D E)
(COPY-SEQ '#(A B C))
EQUALP-OK: #(A B C)
(COPY-SEQ '((A B) C (D E)))
EQUAL-OK: ((A B) C (D E))
(LENGTH '#(A B C D E F))
EQL-OK: 6
(LENGTH '(A B C D E F))
EQL-OK: 6
(NREVERSE '(A (B (C) D)))
EQUAL-OK: ((B (C) D) A)
(REVERSE '(1 2 3 4))
EQUAL-OK: (4 3 2 1)
(MAKE-SEQUENCE 'VECTOR 4 :INITIAL-ELEMENT 'O)
EQUALP-OK: #(O O O O)
(MAKE-SEQUENCE 'LIST 4 :INITIAL-ELEMENT 'O)
EQUAL-OK: (O O O O)
(EQUALP (MAKE-SEQUENCE 'STRING 5 :INITIAL-ELEMENT #\a) (MAKE-STRING 5 :INITIAL-ELEMENT #\a))
EQL-OK: T
(CONCATENATE 'LIST '(A B C) '(1 2))
EQUAL-OK: (A B C 1 2)
(MAP 'LIST 'LIST '(#\a #\b #\c) '(#\1 #\2 #\3))
EQUAL-OK: ((#\a #\1) (#\b #\2) (#\c #\3))
(MAP 'LIST 'LIST '(A B C) '(1 2 3))
EQUAL-OK: ((A 1) (B 2) (C 3))
(MAKE-SEQUENCE '(VECTOR T 5) 5 :INITIAL-ELEMENT 'A)
EQUALP-OK: #(A A A A A)
(MAKE-SEQUENCE '(VECTOR T 5) 6 :INITIAL-ELEMENT 'A)
[SIMPLE-TYPE-ERROR]: MAKE-SEQUENCE: sequence type forces length 5, but result has length 6
EQL-OK: ERROR
(MAKE-SEQUENCE '(OR (VECTOR T 5) (VECTOR T 10)) 5 :INITIAL-ELEMENT 'A)
EQUALP-OK: #(A A A A A)
(MAKE-SEQUENCE '(OR (VECTOR T 5) (VECTOR T 10)) 6 :INITIAL-ELEMENT 'A)
[SIMPLE-TYPE-ERROR]: MAKE-SEQUENCE: the result #1=#(A A A A A A) is not of type #2=(OR (VECTOR T 5) (VECTOR T 10))
EQL-OK: ERROR
(MAKE-SEQUENCE '(VECTOR T 5) 5 :INITIAL-ELEMENT #\A :UPDATE #'(LAMBDA (C) (CODE-CHAR (1+ (CHAR-CODE C)))))
EQUALP-OK: #(#\A #\B #\C #\D #\E)
(MAKE-SEQUENCE '(VECTOR T 5) 6 :INITIAL-ELEMENT #\A :UPDATE #'(LAMBDA (C) (CODE-CHAR (1+ (CHAR-CODE C)))))
[SIMPLE-TYPE-ERROR]: MAKE-SEQUENCE: sequence type forces length 5, but result has length 6
EQL-OK: ERROR
(MAKE-SEQUENCE '(OR (VECTOR T 5) (VECTOR T 10)) 5 :INITIAL-ELEMENT #\A :UPDATE #'(LAMBDA (C) (CODE-CHAR (1+ (CHAR-CODE C)))))
EQUALP-OK: #(#\A #\B #\C #\D #\E)
(MAKE-SEQUENCE '(OR (VECTOR T 5) (VECTOR T 10)) 6 :INITIAL-ELEMENT #\A :UPDATE #'(LAMBDA (C) (CODE-CHAR (1+ (CHAR-CODE C)))))
[SIMPLE-TYPE-ERROR]: MAKE-SEQUENCE: the result #1=#(#\A #\B #\C #\D #\E #\F) is not of type #2=(OR (VECTOR T 5) (VECTOR T 10))
EQL-OK: ERROR
(COERCE #(A B C D E) '(VECTOR T 5))
EQUALP-OK: #(A B C D E)
(COERCE #(A B C D E F) '(VECTOR T 5))
[SIMPLE-TYPE-ERROR]: COERCE: sequence type forces length 5, but result has length 6
EQL-OK: ERROR
(COERCE #(A B C D E) '(OR (VECTOR T 5) (VECTOR T 10)))
EQUALP-OK: #(A B C D E)
(COERCE #(A B C D E F) '(OR (VECTOR T 5) (VECTOR T 10)))
[SIMPLE-TYPE-ERROR]: COERCE: the result #1=#(A B C D E F) is not of type #2=(OR (VECTOR T 5) (VECTOR T 10))
EQL-OK: ERROR
(COERCE '(A B C D E) '(VECTOR T 5))
EQUALP-OK: #(A B C D E)
(COERCE '(A B C D E F) '(VECTOR T 5))
[SIMPLE-TYPE-ERROR]: COERCE: sequence type forces length 5, but result has length 6
EQL-OK: ERROR
(COERCE '(A B C D E) '(OR (VECTOR T 5) (VECTOR T 10)))
EQUALP-OK: #(A B C D E)
(COERCE '(A B C D E F) '(OR (VECTOR T 5) (VECTOR T 10)))
[SIMPLE-TYPE-ERROR]: COERCE: the result #1=#(A B C D E F) is not of type #2=(OR (VECTOR T 5) (VECTOR T 10))
EQL-OK: ERROR
(SYSTEM::COERCED-SUBSEQ #(A B C D E) '(VECTOR T 5))
EQUALP-OK: #(A B C D E)
(SYSTEM::COERCED-SUBSEQ #(A B C D E F) '(VECTOR T 5))
[SIMPLE-TYPE-ERROR]: SYSTEM::COERCED-SUBSEQ: sequence type forces length 5, but result has length 6
EQL-OK: ERROR
(SYSTEM::COERCED-SUBSEQ #(A B C D E) '(OR (VECTOR T 5) (VECTOR T 10)))
EQUALP-OK: #(A B C D E)
(SYSTEM::COERCED-SUBSEQ #(A B C D E F) '(OR (VECTOR T 5) (VECTOR T 10)))
[SIMPLE-TYPE-ERROR]: SYSTEM::COERCED-SUBSEQ: the result #1=#(A B C D E F) is not of type #2=(OR (VECTOR T 5) (VECTOR T 10))
EQL-OK: ERROR
(SYSTEM::COERCED-SUBSEQ '(A B C D E) '(VECTOR T 5))
EQUALP-OK: #(A B C D E)
(SYSTEM::COERCED-SUBSEQ '(A B C D E F) '(VECTOR T 5))
[SIMPLE-TYPE-ERROR]: SYSTEM::COERCED-SUBSEQ: sequence type forces length 5, but result has length 6
EQL-OK: ERROR
(SYSTEM::COERCED-SUBSEQ '(A B C D E) '(OR (VECTOR T 5) (VECTOR T 10)))
EQUALP-OK: #(A B C D E)
(SYSTEM::COERCED-SUBSEQ '(A B C D E F) '(OR (VECTOR T 5) (VECTOR T 10)))
[SIMPLE-TYPE-ERROR]: SYSTEM::COERCED-SUBSEQ: the result #1=#(A B C D E F) is not of type #2=(OR (VECTOR T 5) (VECTOR T 10))
EQL-OK: ERROR
(CONCATENATE '(VECTOR T 5) '(A B C) '(D E))
EQUALP-OK: #(A B C D E)
(CONCATENATE '(VECTOR T 5) '(A B C) '(D E F))
[SIMPLE-TYPE-ERROR]: CONCATENATE: sequence type forces length 5, but result has length 6
EQL-OK: ERROR
(CONCATENATE '(OR (VECTOR T 5) (VECTOR T 10)) '(A B C) '(D E))
EQUALP-OK: #(A B C D E)
(CONCATENATE '(OR (VECTOR T 5) (VECTOR T 10)) '(A B C) '(D E F))
[SIMPLE-TYPE-ERROR]: CONCATENATE: the result #1=#(A B C D E F) is not of type #2=(OR (VECTOR T 5) (VECTOR T 10))
EQL-OK: ERROR
(MAP '(VECTOR T 5) #'IDENTITY '(A B C D E))
EQUALP-OK: #(A B C D E)
(MAP '(VECTOR T 5) #'IDENTITY '(A B C D E F))
[SIMPLE-TYPE-ERROR]: MAP: sequence type forces length 5, but result has length 6
EQL-OK: ERROR
(MAP '(OR (VECTOR T 5) (VECTOR T 10)) #'IDENTITY '(A B C D E))
EQUALP-OK: #(A B C D E)
(MAP '(OR (VECTOR T 5) (VECTOR T 10)) #'IDENTITY '(A B C D E F))
[SIMPLE-TYPE-ERROR]: MAP: the result #1=#(A B C D E F) is not of type #2=(OR (VECTOR T 5) (VECTOR T 10))
EQL-OK: ERROR
(MERGE '(VECTOR T 5) '(A B C D E) 'NIL #'<)
EQUALP-OK: #(A B C D E)
(MERGE '(VECTOR T 5) '(A B C D E F) 'NIL #'<)
[SIMPLE-TYPE-ERROR]: MERGE: sequence type forces length 5, but result has length 6
EQL-OK: ERROR
(MERGE '(OR (VECTOR T 5) (VECTOR T 10)) '(A B C D E) 'NIL #'<)
EQUALP-OK: #(A B C D E)
(MERGE '(OR (VECTOR T 5) (VECTOR T 10)) '(A B C D E F) 'NIL #'<)
[SIMPLE-TYPE-ERROR]: MERGE: the result #1=#(A B C D E F) is not of type #2=(OR (VECTOR T 5) (VECTOR T 10))
EQL-OK: ERROR
(SOME 'NULL '(A B NIL T E))
EQL-OK: T
(EVERY 'ATOM '(A 8 #(A B)))
EQL-OK: T
(NOTANY 'EQ '(A B C D E 4) '(I J K L M 4))
EQL-OK: NIL
(NOTEVERY 'EQ '#(U) '(A X U))
EQL-OK: T
(REDUCE 'LIST '(A) :FROM-END NIL :INITIAL-VALUE NIL)
EQUAL-OK: (NIL A)
(REDUCE 'LIST '(A B C D) :FROM-END NIL :INITIAL-VALUE 'III)
EQUAL-OK: ((((III A) B) C) D)
(REDUCE 'LIST '(A B C D) :FROM-END T)
EQUAL-OK: (A (B (C D)))
(FILL '#(A B C D) 'I :START 1 :END 3)
EQUALP-OK: #(A I I D)
(REPLACE '#(A B C D) '#(I J) :START1 1)
EQUALP-OK: #(A I J D)
(REMOVE 'NUMBERP '#(Y A 4 A C 9 A D 2 3) :COUNT 1 :FROM-END T)
EQUALP-OK: #(Y A 4 A C 9 A D 2 3)
(REMOVE 'A '(A 1 B A 2 A) :START 1)
EQUAL-OK: (A 1 B 2)
(REMOVE-DUPLICATES '(A B C A D A) :START 1)
EQUAL-OK: (A B C D A)
(REMOVE-IF 'NUMBERP '#(Y A 4 A C 9 A D 2 3))
EQUALP-OK: #(Y A A C A D)
(REMOVE-IF-NOT 'NUMBERP '#(Y A 4 A C 9 A D 2 3))
EQUALP-OK: #(4 9 2 3)
(REMOVE-IF-NOT 'NUMBERP '#(Y A 4 A C 9 A D 2 3) :COUNT 2 :FROM-END NIL)
EQUALP-OK: #(4 A C 9 A D 2 3)
(DELETE '(A) '((A B) (C D) (A)) :TEST 'EQUAL)
EQUAL-OK: ((A B) (C D))
(DELETE-IF #'(LAMBDA (X) (EQ (CAR X) 'A)) '((A B) (C D) (A)))
EQUAL-OK: ((C D))
(DELETE-IF-NOT 'NUMBERP '(A 3 B 4))
EQUAL-OK: (3 4)
(NSUBSTITUTE 'NEW '(1 OLD) '((0 OLD) (1 OLD) (2 OLD)) :TEST-NOT 'EQUAL :FROM-END T)
EQUAL-OK: (NEW (1 OLD) NEW)
(NSUBSTITUTE 'NEW 'OLD '(0 OLD 1 OLD 2 OLD) :END 2)
EQUAL-OK: (0 NEW 1 OLD 2 OLD)
(NSUBSTITUTE-IF 'NEW 'NUMBERP '(0 A 1 B 2 C 3 D) :COUNT 2 :END 5)
EQUAL-OK: (NEW A NEW B 2 C 3 D)
(NSUBSTITUTE-IF-NOT 'NEW 'NUMBERP '(0 A 1 B 2 C 3 D) :COUNT 2 :FROM-END T)
EQUAL-OK: (0 A 1 B 2 NEW 3 NEW)
(SUBSTITUTE 'NEW '(2 OLD) '((1 OLD) (2 OLD) (3 OLD) (4 OLD)) :TEST 'EQUAL :START 3)
EQUAL-OK: ((1 OLD) (2 OLD) (3 OLD) (4 OLD))
(SUBSTITUTE-IF 'NEW 'NUMBERP '(A 1 B 2 D 3))
EQUAL-OK: (A NEW B NEW D NEW)
(SUBSTITUTE-IF-NOT 'NEW 'NUMBERP '(A 1 B 2 D 3) :COUNT 2 :FROM-END T)
EQUAL-OK: (A 1 NEW 2 NEW 3)
(FIND '0 '((0 A) (1 A) (2 A) (0 B)) :TEST '= :FROM-END T :KEY 'CAR :START 1)
EQUAL-OK: (0 B)
(FIND-IF 'NUMBERP '((A 0) (B 1) (C 2)) :KEY 'CADR :START 3)
EQL-OK: NIL
(POSITION 'A '((0 A) (1 B) (2 A) (3 B)) :TEST #'(LAMBDA (X Y) (EQ X (CADR Y))) :START 1)
EQL-OK: 2
(POSITION 'A '((0 A) (1 B) (2 A) (3 B)) :KEY 'CADR)
EQL-OK: 0
(POSITION-IF 'NUMBERP '((0 X) (1 7.0) (2 8)) :FROM-END T :START 1 :KEY 'CADR)
EQL-OK: 2
(COUNT '(A) '(A (A) A (A) A B) :TEST-NOT 'EQUAL :KEY #'(LAMBDA (X) (IF (ATOM X) (LIST X))))
EQL-OK: 3
(COUNT-IF-NOT 'NUMBERP '#(A 3 B 5 7 C D) :START 2 :END 5)
EQL-OK: 1
(MISMATCH '(A B C 3 4 5) '(A B X 3 4 B) :START1 1 :START2 5 :END1 2 :TEST-NOT 'EQ)
EQL-OK: 1
(MISMATCH '(A B C 3 4 5) '(U B X 3 4 5) :FROM-END T)
EQL-OK: 3
(SEARCH "ABCD" "0ABIABJBCBC" :END1 3 :START1 1 :START2 0 :FROM-END T)
EQL-OK: 9
(SEARCH '(#\A #\B #\C #\D) "0ABIABJBCBC" :END1 2 :START2 0 :FROM-END T)
EQL-OK: 4
(SEARCH '(A B C D) '(0 A B I A B J B C B C) :END1 2 :START2 2)
EQL-OK: 4
(SORT '((U 3) (I 1) (A 7) (K 3) (C 4) (B 6)) '< :KEY 'CADR)
EQUAL-OK: ((I 1) (U 3) (K 3) (C 4) (B 6) (A 7))
(STABLE-SORT '((B 4) (A 3) (A 2) (B 1) (C 9) (B 2)) 'STRING< :KEY 'CAR)
EQUAL-OK: ((A 3) (A 2) (B 4) (B 1) (B 2) (C 9))
(MERGE 'LIST '(5 1 4 4 7) '(2 3 5 6 8 9) '<)
EQUAL-OK: (2 3 5 1 4 4 5 6 7 8 9)
(MERGE 'LIST '(1 4 4 7) '(2 3 5 6 8 9) '<)
EQUAL-OK: (1 2 3 4 4 5 6 7 8 9)
(CAR '(A B C D E F G))
EQL-OK: A
(CDR '(A B C D E F G))
EQUAL-OK: (B C D E F G)
(CADR '(A B C D E F G))
EQL-OK: B
(CDDR '(A B C D E F G))
EQUAL-OK: (C D E F G)
(CADDR '(A B C D E F G))
EQL-OK: C
(CDDDR '(A B C D E F G))
EQUAL-OK: (D E F G)
(CADDDR '(A B C D E F G))
EQL-OK: D
(CDDDDR '(A B C D E F G))
EQUAL-OK: (E F G)
(CAADR '(((((1 2 3) 4) 5) (6 7)) (((U V W) X) Y) ((Q W E) R) (A B C) E F G))
EQUAL-OK: ((U V W) X)
(CADAR '(((((1 2 3) 4) 5) (6 7)) (((U V W) X) Y) ((Q W E) R) (A B C) E F G))
EQUAL-OK: (6 7)
(CDAAR '(((((1 2 3) 4) 5) (6 7)) (((U V W) X) Y) ((Q W E) R) (A B C) E F G))
EQUAL-OK: (5)
(CDADR '(((((1 2 3) 4) 5) (6 7)) (((U V W) X) Y) ((Q W E) R) (A B C) E F G))
EQUAL-OK: (Y)
(CDDAR '(((((1 2 3) 4) 5) (6 7)) (((U V W) X) Y) ((Q W E) R) (A B C) E F G))
EQL-OK: NIL
(CAAAAR '(((((1 2 3) 4) 5) (6 7)) (((U V W) X) Y) ((Q W E) R) (A B C) E F G))
EQUAL-OK: (1 2 3)
(CAADAR '(((((1 2 3) 4) 5) (6 7)) (((U V W) X) Y) ((Q W E) R) (A B C) E F G))
EQL-OK: 6
(CAADDR '(((((1 2 3) 4) 5) (6 7)) (((U V W) X) Y) ((Q W E) R) (A B C) E F G))
EQUAL-OK: (Q W E)
(CADAAR '(((((1 2 3) 4) 5) (6 7)) (((U V W) X) Y) ((Q W E) R) (A B C) E F G))
EQL-OK: 5
(CADADR '(((((1 2 3) 4) 5) (6 7)) (((U V W) X) Y) ((Q W E) R) (A B C) E F G))
EQL-OK: Y
(CADDAR '(((((1 2 3) 4) 5) (6 7)) (((U V W) X) Y) ((Q W E) R) (A B C) E F G))
EQL-OK: NIL
(CADDDR '(((((1 2 3) 4) 5) (6 7)) (((U V W) X) Y) ((Q W E) R) (A B C) E F G))
EQUAL-OK: (A B C)
(CDAAAR '(((((1 2 3) 4) 5) (6 7)) (((U V W) X) Y) ((Q W E) R) (A B C) E F G))
EQUAL-OK: (4)
(CDAADR '(((((1 2 3) 4) 5) (6 7)) (((U V W) X) Y) ((Q W E) R) (A B C) E F G))
EQUAL-OK: (X)
(CDADAR '(((((1 2 3) 4) 5) (6 7)) (((U V W) X) Y) ((Q W E) R) (A B C) E F G))
EQUAL-OK: (7)
(CONS 1 2)
EQUAL-OK: (1 . 2)
(CONS 'A (CONS 'B (CONS 'C 'NIL)))
EQUAL-OK: (A B C)
(CONS 'A '(B C D))
EQUAL-OK: (A B C D)
(TREE-EQUAL 5 (+ 2 3) :TEST #'EQL)
EQL-OK: T
(ENDP 'NIL)
EQL-OK: T
(ENDP '(A . B))
EQL-OK: NIL
(LIST-LENGTH '(A B C D))
EQL-OK: 4
(LET ((X (LIST 'A 'B 'C))) (RPLACD (LAST X) X) (LIST-LENGTH X))
EQL-OK: NIL
(NTH 0 '(A B C D))
EQL-OK: A
(FIRST '(1 2 3 4 5 6 7 8 9 10 11))
EQL-OK: 1
(SECOND '(1 2 3 4 5 6 7 8 9 10 11))
EQL-OK: 2
(THIRD '(1 2 3 4 5 6 7 8 9 10 11))
EQL-OK: 3
(FOURTH '(1 2 3 4 5 6 7 8 9 10 11))
EQL-OK: 4
(FIFTH '(1 2 3 4 5 6 7 8 9 10 11))
EQL-OK: 5
(SIXTH '(1 2 3 4 5 6 7 8 9 10 11))
EQL-OK: 6
(SEVENTH '(1 2 3 4 5 6 7 8 9 10 11))
EQL-OK: 7
(EIGHTH '(1 2 3 4 5 6 7 8 9 10 11))
EQL-OK: 8
(NINTH '(1 2 3 4 5 6 7 8 9 10 11))
EQL-OK: 9
(TENTH '(1 2 3 4 5 6 7 8 9 10 11))
EQL-OK: 10
(REST '(A . B))
EQL-OK: B
(NTHCDR 1 '(A B C D))
EQUAL-OK: (B C D)
(LAST '(1 2 3 4 5))
EQUAL-OK: (5)
(LAST '(1 2 3 . 4))
EQUAL-OK: (3 . 4)
(LIST 'A 'B 'C 'D)
EQUAL-OK: (A B C D)
(LIST* 'A 'B 'C 'D)
EQUAL-OK: (A B C . D)
(MAKE-LIST 4 :INITIAL-ELEMENT 'O)
EQUAL-OK: (O O O O)
(MAKE-LIST 3 :INITIAL-ELEMENT 'RAH)
EQUAL-OK: (RAH RAH RAH)
(APPEND '(A B C) '(D E F) 'NIL '(G))
EQUAL-OK: (A B C D E F G)
(COPY-LIST '(1 2 3 4 5))
EQUAL-OK: (1 2 3 4 5)
(COPY-LIST '(1 2 3 . 4))
EQUAL-OK: (1 2 3 . 4)
(COPY-ALIST '(A B))
EQUAL-OK: (A B)
(COPY-ALIST '((1 . A) (2 . B) (3 . C)))
EQUAL-OK: ((1 . A) (2 . B) (3 . C))
(COPY-ALIST '((A B) C (D E)))
EQUAL-OK: ((A B) C (D E))
(COPY-TREE '(A B (C (D) (E F)) G))
EQUAL-OK: (A B (C (D) (E F)) G)
(REVAPPEND '(A B C) '(D E F))
EQUAL-OK: (C B A D E F)
(REVAPPEND '(A B C) 'I)
EQUAL-OK: (C B A . I)
(NRECONC '(A B C) '(I J))
EQUAL-OK: (C B A I J)
(SETQ AA NIL)
EQL-OK: NIL
(PUSH '1 AA)
EQUAL-OK: (1)
(PUSH '2 AA)
EQUAL-OK: (2 1)
(POP AA)
EQL-OK: 2
(POP AA)
EQL-OK: 1
(POP AA)
EQL-OK: NIL
(SETQ AA '(B A))
EQUAL-OK: (B A)
(PUSHNEW 'A AA)
EQUAL-OK: (B A)
(PUSHNEW 'C AA)
EQUAL-OK: (C B A)
(PUSHNEW 'U (CAR (SETQ XX '(NIL KKK))))
EQUAL-OK: (U)
(PUSHNEW 'U (CAR XX))
EQUAL-OK: (U)
(PUSHNEW 'V (CAR XX))
EQUAL-OK: (V U)
(EVAL 'XX)
EQUAL-OK: ((V U) KKK)
(BUTLAST '(A B C) 2)
EQUAL-OK: (A)
(NBUTLAST '(A B C D) 6)
EQL-OK: NIL
(NBUTLAST '(A B C D) 1)
EQUAL-OK: (A B C)
(LDIFF (SETQ XX '(A B C D E)) (CDDR XX))
EQUAL-OK: (A B)
(LDIFF (SETQ XX '(A B C D . E)) (CDDR XX))
EQUAL-OK: (A B)
(LDIFF '(A B C D . E) 'E)
EQUAL-OK: (A B C D)
(LDIFF '(1 . 2) 3)
EQUAL-OK: (1 . 2)
(LET ((LISTS '#((A B C) (A B C . D))) (LD-RES #(#(NIL (A B) (A B C) (A B C) (A B C) (A B C) (A B C)) #(NIL (A B) (A B C . D) (A B C . D) (A B C . D) (A B C) (A B C . D)))) (TP-RES #(#(T T NIL NIL T NIL NIL) #(T T NIL NIL NIL T NIL)))) (DOTIMES (I (LENGTH LISTS)) (LET* ((LIST (AREF LISTS I)) (L-R (AREF LD-RES I)) (T-R (AREF TP-RES I)) (OBJECTS (VECTOR LIST (CDDR LIST) (COPY-LIST (CDDR LIST)) '(F G H) 'NIL 'D 'X))) (DOTIMES (J (LENGTH OBJECTS)) (LET ((OBJECT (AREF OBJECTS J))) (UNLESS (EQUAL (TAILP OBJECT LIST) (AREF T-R J)) (ERROR "(tailp ~s ~s): ~s; should be: ~s" OBJECT LIST (TAILP OBJECT LIST) (AREF T-R J))) (UNLESS (EQUAL (LDIFF LIST OBJECT) (AREF L-R J)) (ERROR "(ldiff ~s ~s): ~s; should be: ~s" LIST OBJECT (LDIFF LIST OBJECT) (AREF L-R J))))))))
EQL-OK: NIL
(TAILP 10203040506070 (LIST* 'A 'B (1- 10203040506071)))
EQL-OK: T
(NSUBST 'A 'B '(U B (B) C) :TEST-NOT #'(LAMBDA (X Y) (NOT (EQL X Y))))
EQUAL-OK: (U A (A) C)
(NSUBST-IF 'OO 'NUMBERP '(A B C (3 (4) 0)))
EQUAL-OK: (A B C (OO (OO) OO))
(NSUBST-IF-NOT 'OO #'(LAMBDA (X) (OR (LIST X) (SYMBOLP X))) '(A B C (3 (4) 0)))
EQUAL-OK: (A B C (3 (4) 0))
(SUBST 'A 'B '(U B (B) C) :TEST-NOT #'(LAMBDA (X Y) (NOT (EQL X Y))) :KEY #'(LAMBDA (U) (IF (LISTP U) (CAR U))))
EQUAL-OK: (U . A)
(SUBST-IF 'NUMMMER 'NUMBERP '((A (7 (V 6)))))
EQUAL-OK: ((A (NUMMMER (V NUMMMER))))
(SUBST-IF-NOT 'NUMMMER #'(LAMBDA (X) (OR (LISTP X) (NUMBERP X))) '((A (7 (V 6)))))
EQUAL-OK: ((NUMMMER (7 (NUMMMER 6))))
(NSUBLIS '(((A) . UU) (A . II)) '(I (A) A) :TEST #'(LAMBDA (X Y) (IF (LISTP Y) (EQL X (CAR Y)))))
EQUAL-OK: (I (UU) UU)
(SUBLIS '(((A) . UU) (A . II)) '(I (A) A) :TEST #'(LAMBDA (X Y) (IF (LISTP Y) (EQL X (CAR Y)))))
EQUAL-OK: (I (UU) UU)
(MEMBER 'A '((A) (B) (A) (C)) :KEY 'CAR)
EQUAL-OK: ((A) (B) (A) (C))
(MEMBER-IF 'NUMBERP '((A) (B) (3) (C)) :KEY 'CAR)
EQUAL-OK: ((3) (C))
(MEMBER-IF-NOT 'NUMBERP '((8) (A) (B) (3) (C)) :KEY 'CAR)
EQUAL-OK: ((A) (B) (3) (C))
(TAILP (CDDR (SETQ XX '(U I A B))) XX)
EQL-OK: T
(TAILP 'D '(A B C . D))
EQL-OK: T
(ADJOIN 'A '((A) B C) :TEST 'EQUAL)
EQUAL-OK: (A (A) B C)
(NUNION '(A B C D) '(U I B A))
EQUAL-OK: (C D U I B A)
(UNION '(A B C D) '(A D I V))
EQUAL-OK: (B C A D I V)
(INTERSECTION '((A 1) (A 2) (A 3)) '((A 4) (A 2) (B 6) (C 7)) :TEST 'EQUAL)
EQUAL-OK: ((A 2))
(NINTERSECTION '(A B C D) '(C D E F G) :TEST-NOT 'EQL)
EQUAL-OK: (A B C D)
(NSET-DIFFERENCE '(A B C D) '(I J C))
EQUAL-OK: (A B D)
(NSET-EXCLUSIVE-OR '(A B C) '(I A D C))
EQUAL-OK: (B I D)
(SET-DIFFERENCE '(ANTON BERTA AUTO BERLIN) '(AMERILLA) :TEST #'(LAMBDA (X Y) (EQL (ELT (SYMBOL-NAME X) 0) (ELT (SYMBOL-NAME Y) 0))))
EQUAL-OK: (BERTA BERLIN)
(SET-EXCLUSIVE-OR '(ANTON ANNA EMIL) '(BERTA AUTO AUGUST) :TEST #'(LAMBDA (X Y) (EQL (ELT (SYMBOL-NAME X) 0) (ELT (SYMBOL-NAME Y) 0))))
EQUAL-OK: (EMIL BERTA)
(SUBSETP '(A B) '(B A U I C D))
EQL-OK: T
(ACONS 'A 'B '((C . D)))
EQUAL-OK: ((A . B) (C . D))
(ACONS 'A 'B NIL)
EQUAL-OK: ((A . B))
(ASSOC 'A '((B C) A ((A) U) (A I)) :TEST-NOT #'(LAMBDA (X Y) (IF (ATOM Y) (EQL Y X))))
EQUAL-OK: (B C)
(ASSOC-IF 'SYMBOLP '((A . 3) (3 . A)))
EQUAL-OK: (A . 3)
(ASSOC-IF-NOT 'NUMBERP '((A . 3) (3 . A)))
EQUAL-OK: (A . 3)
(PAIRLIS '(A B C) '(1 2 3))
EQUAL-OK: ((C . 3) (B . 2) (A . 1))
(RASSOC 'A '((1 . B) (2 . A)))
EQUAL-OK: (2 . A)
(RASSOC-IF 'SYMBOLP '((1 . 3) (2 . A)))
EQUAL-OK: (2 . A)
(RASSOC-IF-NOT 'SYMBOLP '((1 . 3) (2 . A)))
EQUAL-OK: (1 . 3)
(HASH-TABLE-P (MAKE-HASH-TABLE :TEST #'EQL :REHASH-SIZE 2 :SIZE 20))
EQL-OK: T
(HASH-TABLE-P (MAKE-HASH-TABLE :TEST #'EQL :REHASH-SIZE 1.1 :SIZE 20))
EQL-OK: T
(DEFUN TEST-HASH-TABLE-ITERATOR (HASH-TABLE) (LET ((ALL-ENTRIES 'NIL) (GENERATED-ENTRIES 'NIL) (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))
EQL-OK: TEST-HASH-TABLE-ITERATOR
(LET ((TAB (MAKE-HASH-TABLE :TEST #'EQUAL))) (SETF (GETHASH "Richard" TAB) "Gabriel") (SETF (GETHASH "Bruno" TAB) "Haible") (SETF (GETHASH "Michael" TAB) "Stoll") (SETF (GETHASH "Linus" TAB) "Torvalds") (SETF (GETHASH "Richard" TAB) "Stallman") (TEST-HASH-TABLE-ITERATOR TAB))
EQL-OK: T
(GETHASH "foo" (READ-FROM-STRING (PRIN1-TO-STRING (MAKE-HASH-TABLE :TEST 'EQUALP :INITIAL-CONTENTS '(("FOO" . "bar"))))))
EQUAL-OK: "bar"
(DEFSTRUCT (ICE-CREAM-FACTORY (:CONSTRUCTOR MAKE-FACTORY) (:CONSTRUCTOR FABRICATE-FACTORY (&KEY (CAPACITY 5) LOCATION (LOCAL-FLAVORS (CASE LOCATION ((HAWAII) '(PINEAPPLE MACADAMIA GUAVA)) ((MASSACHUSETTS) '(LOBSTER BAKED-BEAN)) ((CALIFORNIA) '(GINGER LOTUS AVOCADO BEAN-SPROUT GARLIC)) ((TEXAS) '(JALAPENO BARBECUE)))) (FLAVORS (SUBSEQ (APPEND LOCAL-FLAVORS '(VANILLA CHOCOLATE STRAWBERRY PISTACHIO MAPLE-WALNUT PEPPERMINT)) 0 CAPACITY)) ((:OWN OWNER))))) (CAPACITY 3) (FLAVORS '(VANILLA CHOCOLATE STRAWBERRY MANGO)) (OWNER 'ME))
EQL-OK: ICE-CREAM-FACTORY
(LET ((HOUSTON (FABRICATE-FACTORY :CAPACITY 4 :LOCATION 'TEXAS))) (ICE-CREAM-FACTORY-FLAVORS HOUSTON))
EQUAL-OK: (JALAPENO BARBECUE VANILLA CHOCOLATE)
(LET ((CAMBRIDGE (FABRICATE-FACTORY :LOCATION 'MASSACHUSETTS))) (ICE-CREAM-FACTORY-FLAVORS CAMBRIDGE))
EQUAL-OK: (LOBSTER BAKED-BEAN VANILLA CHOCOLATE STRAWBERRY)
(LET ((SEATTLE (FABRICATE-FACTORY :LOCAL-FLAVORS '(SALMON)))) (ICE-CREAM-FACTORY-FLAVORS SEATTLE))
EQUAL-OK: (SALMON VANILLA CHOCOLATE STRAWBERRY PISTACHIO)
(LET ((WHEATON (FABRICATE-FACTORY :CAPACITY 4 :LOCATION 'ILLINOIS))) (ICE-CREAM-FACTORY-FLAVORS WHEATON))
EQUAL-OK: (VANILLA CHOCOLATE STRAWBERRY PISTACHIO)
(LET ((PITTSBURGH (FABRICATE-FACTORY :CAPACITY 4))) (ICE-CREAM-FACTORY-FLAVORS PITTSBURGH))
EQUAL-OK: (VANILLA CHOCOLATE STRAWBERRY PISTACHIO)
(LET ((CLEVELAND (MAKE-FACTORY :CAPACITY 4))) (ICE-CREAM-FACTORY-FLAVORS CLEVELAND))
EQUAL-OK: (VANILLA CHOCOLATE STRAWBERRY MANGO)
(PROGN (DEFVAR *X* 'GLOBAL-X) (LET ((Y 'LOCAL-Y)) (DEFSTRUCT BAZ (*X* 'X-INIT) (Y *X*) (Z Y))))
EQL-OK: BAZ
(MAKE-BAZ)
EQUALP-OK: #S(BAZ :*X* X-INIT :Y GLOBAL-X :Z LOCAL-Y)
(CONSTANTP -5)
EQL-OK: T
(CONSTANTP (READ-FROM-STRING "1.0e30"))
EQL-OK: T
(STREAMP *STANDARD-INPUT*)
EQL-OK: T
(INPUT-STREAM-P *TERMINAL-IO*)
EQL-OK: T
(READTABLEP *READTABLE*)
EQL-OK: T
(READTABLEP 'PROGN)
EQL-OK: NIL
(GET-DISPATCH-MACRO-CHARACTER #\# #\0)
EQL-OK: NIL
(STRINGP (SHOW (LISP-IMPLEMENTATION-TYPE)))
"CLISP"
EQL-OK: T
(STRINGP (SHOW (LISP-IMPLEMENTATION-VERSION)))
"2.49 (2010-07-07) (built 3510826523) (memory 3510826706)"
EQL-OK: T
(STRINGP (SHOW (MACHINE-INSTANCE)))
"zelenka.debian.org [80.245.147.40]"
EQL-OK: T
(STRINGP (SHOW (MACHINE-TYPE)))
"S390X"
EQL-OK: T
(STRINGP (SHOW (MACHINE-VERSION)))
"S390X"
EQL-OK: T
(SYSTEM::FIXNUMP 10)
EQL-OK: T
(MODULE-INFO "clisp" T)
EQUAL-OK: "clisp"
(UNINTERN 'X)
EQL-OK: T
RUN-TEST: finished "alltest" (0 errors out of 636 tests)
RUN-TEST: started #<INPUT BUFFERED FILE-STREAM CHARACTER #P"array.tst" @1>
(FORMAT T "~%double-float arrays~%")
double-float arrays
EQL-OK: NIL
(EQUALP (SETQ DA1 (MAKE-ARRAY '(4 2 3) :INITIAL-CONTENTS '(((1.0d0 2.0d0 3.0d0) (4.0d0 5.0d0 6.0d0)) ((7.0d0 8.0d0 9.0d0) (10.0d0 11.0d0 12.0d0)) ((13.0d0 14.0d0 15.0d0) (16.0d0 17.0d0 18.0d0)) ((19.0d0 20.0d0 21.0d0) (22.0d0 23.0d0 24.0d0))) :ELEMENT-TYPE 'DOUBLE-FLOAT)) '#3A(((1.0d0 2.0d0 3.0d0) (4.0d0 5.0d0 6.0d0)) ((7.0d0 8.0d0 9.0d0) (10.0d0 11.0d0 12.0d0)) ((13.0d0 14.0d0 15.0d0) (16.0d0 17.0d0 18.0d0)) ((19.0d0 20.0d0 21.0d0) (22.0d0 23.0d0 24.0d0))))
EQL-OK: T
(AREF DA1 0 0 0)
EQL-OK: 1.0d0
(AREF DA1 0 0 1)
EQL-OK: 2.0d0
(AREF DA1 0 0 2)
EQL-OK: 3.0d0
(AREF DA1 0 1 0)
EQL-OK: 4.0d0
(AREF DA1 0 1 1)
EQL-OK: 5.0d0
(AREF DA1 0 1 2)
EQL-OK: 6.0d0
(AREF DA1 1 0 0)
EQL-OK: 7.0d0
(AREF DA1 1 0 1)
EQL-OK: 8.0d0
(AREF DA1 1 0 2)
EQL-OK: 9.0d0
(AREF DA1 1 1 0)
EQL-OK: 10.0d0
(AREF DA1 1 1 1)
EQL-OK: 11.0d0
(AREF DA1 1 1 2)
EQL-OK: 12.0d0
(AREF DA1 2 0 0)
EQL-OK: 13.0d0
(AREF DA1 2 0 1)
EQL-OK: 14.0d0
(AREF DA1 2 0 2)
EQL-OK: 15.0d0
(AREF DA1 2 1 0)
EQL-OK: 16.0d0
(AREF DA1 2 1 1)
EQL-OK: 17.0d0
(AREF DA1 2 1 2)
EQL-OK: 18.0d0
(AREF DA1 3 0 0)
EQL-OK: 19.0d0
(AREF DA1 3 0 1)
EQL-OK: 20.0d0
(AREF DA1 3 0 2)
EQL-OK: 21.0d0
(AREF DA1 3 1 0)
EQL-OK: 22.0d0
(AREF DA1 3 1 1)
EQL-OK: 23.0d0
(AREF DA1 3 1 1)
EQL-OK: 23.0d0
(FORMAT T "~%single-float arrays~%")
single-float arrays
EQL-OK: NIL
(EQUALP (SETQ FA1 (MAKE-ARRAY '(4 2 3) :INITIAL-CONTENTS '(((1.0 2.0 3.0) (4.0 5.0 6.0)) ((7.0 8.0 9.0) (10.0 11.0 12.0)) ((13.0 14.0 15.0) (16.0 17.0 18.0)) ((19.0 20.0 21.0) (22.0 23.0 24.0))) :ELEMENT-TYPE 'SINGLE-FLOAT)) '#3A(((1.0 2.0 3.0) (4.0 5.0 6.0)) ((7.0 8.0 9.0) (10.0 11.0 12.0)) ((13.0 14.0 15.0) (16.0 17.0 18.0)) ((19.0 20.0 21.0) (22.0 23.0 24.0))))
EQL-OK: T
(AREF FA1 0 0 0)
EQL-OK: 1.0
(AREF FA1 0 0 1)
EQL-OK: 2.0
(AREF FA1 0 0 2)
EQL-OK: 3.0
(AREF FA1 0 1 0)
EQL-OK: 4.0
(AREF FA1 0 1 1)
EQL-OK: 5.0
(AREF FA1 0 1 2)
EQL-OK: 6.0
(AREF FA1 1 0 0)
EQL-OK: 7.0
(AREF FA1 1 0 1)
EQL-OK: 8.0
(AREF FA1 1 0 2)
EQL-OK: 9.0
(AREF FA1 1 1 0)
EQL-OK: 10.0
(AREF FA1 1 1 1)
EQL-OK: 11.0
(AREF FA1 1 1 2)
EQL-OK: 12.0
(AREF FA1 2 0 0)
EQL-OK: 13.0
(AREF FA1 2 0 1)
EQL-OK: 14.0
(AREF FA1 2 0 2)
EQL-OK: 15.0
(AREF FA1 2 1 0)
EQL-OK: 16.0
(AREF FA1 2 1 1)
EQL-OK: 17.0
(AREF FA1 2 1 2)
EQL-OK: 18.0
(AREF FA1 3 0 0)
EQL-OK: 19.0
(AREF FA1 3 0 1)
EQL-OK: 20.0
(AREF FA1 3 0 2)
EQL-OK: 21.0
(AREF FA1 3 1 0)
EQL-OK: 22.0
(AREF FA1 3 1 1)
EQL-OK: 23.0
(AREF FA1 3 1 1)
EQL-OK: 23.0
(FORMAT T "~%array limits~%")
array limits
EQL-OK: NIL
(LET ((S (PRIN1-TO-STRING ARRAY-RANK-LIMIT))) (OR (EQUAL S "4294967296") (EQUAL S "65536") (EQUAL S (PRIN1-TO-STRING LAMBDA-PARAMETERS-LIMIT))))
EQL-OK: T
(LET ((S (PRIN1-TO-STRING ARRAY-DIMENSION-LIMIT))) (OR (EQUAL S "4294967296") (EQUAL S (PRIN1-TO-STRING MOST-POSITIVE-FIXNUM))))
EQL-OK: T
(LET ((S (PRIN1-TO-STRING ARRAY-TOTAL-SIZE-LIMIT))) (OR (EQUAL S "4294967296") (EQUAL S (PRIN1-TO-STRING MOST-POSITIVE-FIXNUM))))
EQL-OK: T
(<= ARRAY-DIMENSION-LIMIT ARRAY-TOTAL-SIZE-LIMIT)
EQL-OK: T
(FORMAT T "~%simple vectors~%")
simple vectors
EQL-OK: NIL
(EQUALP (SETQ SV (VECTOR 'A 'B 'C 1.0s0 3.7d0 4.1)) '#(A B C 1.0s0 3.7d0 4.1))
EQL-OK: T
(SVREF SV 0)
EQL-OK: A
(SVREF SV 1)
EQL-OK: B
(SVREF SV 2)
EQL-OK: C
(SVREF SV 3)
EQL-OK: 1.0s0
(SVREF SV 4)
EQL-OK: 3.7d0
(FORMAT T "~%set elements~%")
set elements
EQL-OK: NIL
(SETF (SVREF SV 0) 'TEST)
EQL-OK: TEST
(EQUALP SV '#(TEST B C 1.0s0 3.7d0 4.1))
EQL-OK: T
(FORMAT T "~%test array-element-type~%")
test array-element-type
EQL-OK: NIL
(ARRAY-ELEMENT-TYPE SV)
EQL-OK: T
(ARRAY-ELEMENT-TYPE DA1)
EQL-OK: T
(FORMAT T "~%test rank~%")
test rank
EQL-OK: NIL
(ARRAY-RANK DA1)
EQL-OK: 3
(ARRAY-RANK FA1)
EQL-OK: 3
(FORMAT T "~%test individual dimensions~%")
test individual dimensions
EQL-OK: NIL
(ARRAY-DIMENSION DA1 0)
EQL-OK: 4
(ARRAY-DIMENSION DA1 1)
EQL-OK: 2
(ARRAY-DIMENSION DA1 2)
EQL-OK: 3
(ARRAY-DIMENSION DA1 3)
[SIMPLE-TYPE-ERROR]: ARRAY-DIMENSION: 3 is not an nonnegative integer less than the rank of #3A(((1.0d0 2.0d0 3.0d0) (4.0d0 5.0d0 6.0d0)) ((7.0d0 8.0d0 9.0d0) (10.0d0 11.0d0 12.0d0)) ((13.0d0 14.0d0 15.0d0) (16.0d0 17.0d0 18.0d0)) ((19.0d0 20.0d0 21.0d0) (22.0d0 23.0d0 24.0d0)))
EQL-OK: ERROR
(FORMAT T "~%0-dim. array pseudo-scalar with contents mod 5~%")
0-dim. array pseudo-scalar with contents mod 5
EQL-OK: NIL
(PROGN (SETQ ZERO (MAKE-ARRAY 'NIL :ELEMENT-TYPE '(MOD 5))) T)
EQL-OK: T
(ARRAY-RANK ZERO)
EQL-OK: 0
(SETF (AREF ZERO) 4)
EQL-OK: 4
(SETF (AREF ZERO) 1.0)
[SIMPLE-TYPE-ERROR]: SYSTEM::STORE: #1=1.0 does not fit into #0A4, bad type
EQL-OK: ERROR
(FORMAT T "~%3-dim general array~%")
3-dim general array
EQL-OK: NIL
(EQUALP (SETQ A1 (MAKE-ARRAY '(4 2 3) :INITIAL-CONTENTS '(((A B C) (1 2 3)) ((D E F) (3 1 2)) ((G H I) (2 3 1)) ((J K L) (0 0 0))))) '#3A(((A B C) (1 2 3)) ((D E F) (3 1 2)) ((G H I) (2 3 1)) ((J K L) (0 0 0))))
EQL-OK: T
(AREF A1 0 0 0)
EQL-OK: A
(AREF A1 0 0 1)
EQL-OK: B
(AREF A1 0 0 2)
EQL-OK: C
(AREF A1 0 1 0)
EQL-OK: 1
(AREF A1 0 1 1)
EQL-OK: 2
(AREF A1 0 1 2)
EQL-OK: 3
(AREF A1 1 0 0)
EQL-OK: D
(AREF A1 1 0 1)
EQL-OK: E
(AREF A1 1 0 2)
EQL-OK: F
(AREF A1 1 1 0)
EQL-OK: 3
(AREF A1 1 1 1)
EQL-OK: 1
(AREF A1 1 1 2)
EQL-OK: 2
(AREF A1 2 0 0)
EQL-OK: G
(AREF A1 2 0 1)
EQL-OK: H
(AREF A1 2 0 2)
EQL-OK: I
(AREF A1 2 1 0)
EQL-OK: 2
(AREF A1 2 1 1)
EQL-OK: 3
(AREF A1 2 1 2)
EQL-OK: 1
(AREF A1 3 0 0)
EQL-OK: J
(AREF A1 3 0 1)
EQL-OK: K
(AREF A1 3 0 2)
EQL-OK: L
(AREF A1 3 1 0)
EQL-OK: 0
(AREF A1 3 1 1)
EQL-OK: 0
(AREF A1 3 1 1)
EQL-OK: 0
(FORMAT T "~%2-dim adjustable displaced array~%")
2-dim adjustable displaced array
EQL-OK: NIL
(PROGN (SETQ M (MAKE-ARRAY '(4 4) :ADJUSTABLE T :INITIAL-CONTENTS '((ALPHA BETA GAMMA DELTA) (EPSILON ZETA ETA THETA) (IOTA KAPPA LAMBDA MU) (NU XI OMICRON PI)))) T)
EQL-OK: T
(AREF M 0 0)
EQL-OK: ALPHA
(AREF M 0 1)
EQL-OK: BETA
(AREF M 0 2)
EQL-OK: GAMMA
(AREF M 0 3)
EQL-OK: DELTA
(AREF M 1 0)
EQL-OK: EPSILON
(AREF M 1 1)
EQL-OK: ZETA
(AREF M 1 2)
EQL-OK: ETA
(AREF M 1 3)
EQL-OK: THETA
(AREF M 2 0)
EQL-OK: IOTA
(AREF M 2 1)
EQL-OK: KAPPA
(AREF M 2 2)
EQL-OK: LAMBDA
(AREF M 2 3)
EQL-OK: MU
(AREF M 3 0)
EQL-OK: NU
(AREF M 3 1)
EQL-OK: XI
(AREF M 3 2)
EQL-OK: OMICRON
(AREF M 3 3)
EQL-OK: PI
(FORMAT T "~%sisplaced~%")
sisplaced
EQL-OK: NIL
(EQUALP (SETQ MD0 (MAKE-ARRAY 4 :DISPLACED-TO M)) '#(ALPHA BETA GAMMA DELTA))
EQL-OK: T
(EQUALP (SETQ MD1 (MAKE-ARRAY 4 :DISPLACED-TO M :DISPLACED-INDEX-OFFSET 4)) '#(EPSILON ZETA ETA THETA))
EQL-OK: T
(EQUALP (SETQ MD2 (MAKE-ARRAY 4 :DISPLACED-TO M :DISPLACED-INDEX-OFFSET 8)) '#(IOTA KAPPA LAMBDA MU))
EQL-OK: T
(FORMAT T "~%adjust m~%")
adjust m
EQL-OK: NIL
(PROGN (ADJUST-ARRAY M '(3 5) :INITIAL-ELEMENT 'BAZ) T)
EQL-OK: T
(AREF M 0 0)
EQL-OK: ALPHA
(AREF M 0 1)
EQL-OK: BETA
(AREF M 0 2)
EQL-OK: GAMMA
(AREF M 0 3)
EQL-OK: DELTA
(AREF M 0 4)
EQL-OK: BAZ
(AREF M 1 0)
EQL-OK: EPSILON
(AREF M 1 1)
EQL-OK: ZETA
(AREF M 1 2)
EQL-OK: ETA
(AREF M 1 3)
EQL-OK: THETA
(AREF M 1 4)
EQL-OK: BAZ
(AREF M 2 0)
EQL-OK: IOTA
(AREF M 2 1)
EQL-OK: KAPPA
(AREF M 2 2)
EQL-OK: LAMBDA
(FORMAT T "~%Test interaction of the keywords~%")
Test interaction of the keywords
EQL-OK: NIL
(PROGN (SETQ DV (MAKE-ARRAY 10 :ELEMENT-TYPE 'DOUBLE-FLOAT :INITIAL-CONTENTS '(0.0d0 1.0d0 2.0d0 3.0d0 4.0d0 5.0d0 6.0d0 7.0d0 8.0d0 9.0d0))) T)
EQL-OK: T
(AREF DV 0)
EQL-OK: 0.0d0
(AREF DV 1)
EQL-OK: 1.0d0
(AREF DV 2)
EQL-OK: 2.0d0
(AREF DV 3)
EQL-OK: 3.0d0
(AREF DV 4)
EQL-OK: 4.0d0
(AREF DV 5)
EQL-OK: 5.0d0
(AREF DV 6)
EQL-OK: 6.0d0
(AREF DV 7)
EQL-OK: 7.0d0
(AREF DV 8)
EQL-OK: 8.0d0
(AREF DV 9)
EQL-OK: 9.0d0
(SETF (AREF DV 5) -5.0d0)
EQL-OK: -5.0d0
(FORMAT T "~%test indeces~%")
test indeces
EQL-OK: NIL
(DEFUN ARRAY-INDEX-TEST (A &REST SUBS) (UNLESS (APPLY #'ARRAY-IN-BOUNDS-P A SUBS) (RETURN-FROM ARRAY-INDEX-TEST 'ERROR)) (= (APPLY #'ARRAY-ROW-MAJOR-INDEX A SUBS) (APPLY #'+ (MAPLIST #'(LAMBDA (X Y) (* (CAR X) (APPLY #'* (CDR Y)))) SUBS (ARRAY-DIMENSIONS A)))))
EQL-OK: ARRAY-INDEX-TEST
(ARRAY-INDEX-TEST (MAKE-ARRAY '(5 4 3 2 1)) 4 2 2 1 0)
EQL-OK: T
(ARRAY-INDEX-TEST (MAKE-ARRAY '(5 4 3 2 1)) 3 4 2 1 2)
EQL-OK: ERROR
(FORMAT T "~%bitvectors~%")
bitvectors
EQL-OK: NIL
(SETQ BVZERO (MAKE-ARRAY 100 :ELEMENT-TYPE 'BIT :INITIAL-ELEMENT 0))
EQUAL-OK: #*0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000
(SETQ BVONE (MAKE-ARRAY 100 :ELEMENT-TYPE 'BIT :INITIAL-ELEMENT 1))
EQUAL-OK: #*1111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111
(SETQ BV3 (MAKE-ARRAY 100 :ELEMENT-TYPE 'BIT :INITIAL-ELEMENT 0))
EQUAL-OK: #*0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000
(SETQ BV2 (MAKE-ARRAY 100 :ELEMENT-TYPE 'BIT :INITIAL-ELEMENT 0))
EQUAL-OK: #*0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000
(SETQ BV1 (MAKE-ARRAY 100 :ELEMENT-TYPE 'BIT :INITIAL-ELEMENT 0))
EQUAL-OK: #*0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000
(FORMAT T "~%set bitvectors~%")
set bitvectors
EQL-OK: NIL
(DOTIMES (I 50 BV1) (SETF (SBIT BV1 (* I 2)) 1))
EQUAL-OK: #*1010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010
(DOTIMES (I 50 BV2) (SETF (BIT BV2 (* I 2)) 1))
EQUAL-OK: #*1010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010
(EQUALP BV1 BV2)
EQL-OK: T
(DOTIMES (I 25 BV3) (SETF (SBIT BV3 (* I 4)) 1))
EQUAL-OK: #*1000100010001000100010001000100010001000100010001000100010001000100010001000100010001000100010001000
(BIT-AND BV1 BV3)
EQUAL-OK: #*1000100010001000100010001000100010001000100010001000100010001000100010001000100010001000100010001000
(BIT-IOR BV1 BV3)
EQUAL-OK: #*1010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010
(BIT-XOR BV1 BV3)
EQUAL-OK: #*0010001000100010001000100010001000100010001000100010001000100010001000100010001000100010001000100010
(BIT-EQV BV1 BV3)
EQUAL-OK: #*1101110111011101110111011101110111011101110111011101110111011101110111011101110111011101110111011101
(BIT-NAND BV1 BV3)
EQUAL-OK: #*0111011101110111011101110111011101110111011101110111011101110111011101110111011101110111011101110111
(BIT-ANDC1 BV1 BV3)
EQUAL-OK: #*0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000
(BIT-ANDC2 BV1 BV3)
EQUAL-OK: #*0010001000100010001000100010001000100010001000100010001000100010001000100010001000100010001000100010
(BIT-ORC1 BV1 BV3)
EQUAL-OK: #*1101110111011101110111011101110111011101110111011101110111011101110111011101110111011101110111011101
(BIT-ORC2 BV1 BV3)
EQUAL-OK: #*1111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111
(BIT-NOT BV1)
EQUAL-OK: #*0101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101
(BIT-NOT BVZERO)
EQUAL-OK: #*1111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111
(BIT-NOT BVONE)
EQUAL-OK: #*0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000
(LET* ((S1 (MAKE-ARRAY NIL :INITIAL-ELEMENT 0 :ELEMENT-TYPE 'BIT)) (S2 (MAKE-ARRAY NIL :INITIAL-ELEMENT 1 :ELEMENT-TYPE 'BIT))) (LIST (BIT-XOR S1 S2) S1 S2))
EQUALP-OK: (#0A1 #0A0 #0A1)
(LET* ((A1 (MAKE-ARRAY '(2 2) :ELEMENT-TYPE 'BIT :INITIAL-CONTENTS '((0 1) (0 1)))) (A2 (MAKE-ARRAY '(2 2) :ELEMENT-TYPE 'BIT :INITIAL-CONTENTS '((0 0) (1 1)))) (RESULT (BIT-AND A1 A2))) (LIST A1 A2 RESULT))
EQUALP-OK: (#2A((0 1) (0 1)) #2A((0 0) (1 1)) #2A((0 0) (0 1)))
(FORMAT T "~%test operations with fill-pointer~%")
test operations with fill-pointer
EQL-OK: NIL
(MAKE-ARRAY '(3 4 5) :FILL-POINTER T)
[SIMPLE-ERROR]: MAKE-ARRAY: :FILL-POINTER may not be specified for an array of rank 3
EQL-OK: ERROR
(EQUALP (MAKE-ARRAY 5 :FILL-POINTER 5) '#(NIL NIL NIL NIL NIL))
EQL-OK: T
(MAKE-ARRAY 5 :FILL-POINTER -5)
[SIMPLE-TYPE-ERROR]: MAKE-ARRAY: fill-pointer -5 should be a nonnegative fixnum
EQL-OK: ERROR
(FORMAT T "~%general vector with fillpointer~%")
general vector with fillpointer
EQL-OK: NIL
(PROGN (SETQ VMF (MAKE-ARRAY 5 :FILL-POINTER 0)) T)
EQL-OK: T
(FILL-POINTER VMF)
EQL-OK: 0
(VECTOR-PUSH 'A VMF)
EQL-OK: 0
(FILL-POINTER VMF)
EQL-OK: 1
(VECTOR-PUSH 'B VMF)
EQL-OK: 1
(VECTOR-PUSH 'C VMF)
EQL-OK: 2
(VECTOR-PUSH 'D VMF)
EQL-OK: 3
(VECTOR-PUSH 'E VMF)
EQL-OK: 4
(VECTOR-PUSH 'VOLL VMF)
EQL-OK: NIL
(VECTOR-POP VMF)
EQL-OK: E
(VECTOR-POP VMF)
EQL-OK: D
(VECTOR-POP VMF)
EQL-OK: C
(VECTOR-POP VMF)
EQL-OK: B
(VECTOR-POP VMF)
EQL-OK: A
(VECTOR-POP VMF)
[SIMPLE-ERROR]: VECTOR-POP: #() has length zero
EQL-OK: ERROR
(FORMAT T "~%adjustable general vector with fillpointer~%")
adjustable general vector with fillpointer
EQL-OK: NIL
(PROGN (SETQ VMFA (MAKE-ARRAY 5 :FILL-POINTER 0 :ADJUSTABLE T)) T)
EQL-OK: T
(FILL-POINTER VMFA)
EQL-OK: 0
(VECTOR-PUSH-EXTEND 'A VMFA)
EQL-OK: 0
(FILL-POINTER VMFA)
EQL-OK: 1
(VECTOR-PUSH-EXTEND 'B VMFA)
EQL-OK: 1
(VECTOR-PUSH-EXTEND 'C VMFA)
EQL-OK: 2
(VECTOR-PUSH-EXTEND 'D VMFA)
EQL-OK: 3
(VECTOR-PUSH-EXTEND 'E VMFA)
EQL-OK: 4
(VECTOR-PUSH-EXTEND 'VOLL VMFA)
EQL-OK: 5
(VECTOR-POP VMFA)
EQL-OK: VOLL
(VECTOR-POP VMFA)
EQL-OK: E
(VECTOR-POP VMFA)
EQL-OK: D
(VECTOR-POP VMFA)
EQL-OK: C
(VECTOR-POP VMFA)
EQL-OK: B
(VECTOR-POP VMFA)
EQL-OK: A
(FORMAT T "~%Doppeltgen. Vector mit Fillpointer ~%")
Doppeltgen. Vector mit Fillpointer
EQL-OK: NIL
(PROGN (SETQ VMFD (MAKE-ARRAY 5 :FILL-POINTER 0 :ELEMENT-TYPE 'DOUBLE-FLOAT)) T)
EQL-OK: T
(FILL-POINTER VMFD)
EQL-OK: 0
(VECTOR-PUSH 0.0d0 VMFD)
EQL-OK: 0
(FILL-POINTER VMFD)
EQL-OK: 1
(VECTOR-PUSH 1.0d0 VMFD)
EQL-OK: 1
(VECTOR-PUSH 2.0d0 VMFD)
EQL-OK: 2
(VECTOR-PUSH 3.0d0 VMFD)
EQL-OK: 3
(VECTOR-PUSH 4.0d0 VMFD)
EQL-OK: 4
(VECTOR-PUSH 5.0d0 VMFD)
EQL-OK: NIL
(VECTOR-POP VMFD)
EQL-OK: 4.0d0
(VECTOR-POP VMFD)
EQL-OK: 3.0d0
(VECTOR-POP VMFD)
EQL-OK: 2.0d0
(VECTOR-POP VMFD)
EQL-OK: 1.0d0
(VECTOR-POP VMFD)
EQL-OK: 0.0d0
(VECTOR-POP VMFD)
[SIMPLE-ERROR]: VECTOR-POP: #() has length zero
EQL-OK: ERROR
(PROGN (SETQ VMFAD (MAKE-ARRAY 5 :FILL-POINTER 0 :ELEMENT-TYPE 'DOUBLE-FLOAT :ADJUSTABLE T)) T)
EQL-OK: T
(FILL-POINTER VMFAD)
EQL-OK: 0
(VECTOR-PUSH-EXTEND 0.0d0 VMFAD)
EQL-OK: 0
(FILL-POINTER VMFAD)
EQL-OK: 1
(VECTOR-PUSH-EXTEND 1.0d0 VMFAD)
EQL-OK: 1
(VECTOR-PUSH-EXTEND 2.0d0 VMFAD)
EQL-OK: 2
(VECTOR-PUSH-EXTEND 3.0d0 VMFAD)
EQL-OK: 3
(VECTOR-PUSH-EXTEND 4.0d0 VMFAD)
EQL-OK: 4
(VECTOR-PUSH-EXTEND 5.0d0 VMFAD)
EQL-OK: 5
(SETF (FILL-POINTER VMFAD) 3)
EQL-OK: 3
(AREF VMFAD 5)
EQL-OK: 5.0d0
(ELT VMFAD 5)
[SIMPLE-TYPE-ERROR]: ELT: index 5 for #(0.0d0 1.0d0 2.0d0) is out of range
EQL-OK: ERROR
(SETF (FILL-POINTER VMFAD) 6)
EQL-OK: 6
VMFAD
EQUALP-OK: #(0.0d0 1.0d0 2.0d0 3.0d0 4.0d0 5.0d0)
(REVERSE VMFAD)
EQUALP-OK: #(5.0d0 4.0d0 3.0d0 2.0d0 1.0d0 0.0d0)
(NREVERSE VMFAD)
EQUALP-OK: #(5.0d0 4.0d0 3.0d0 2.0d0 1.0d0 0.0d0)
VMFAD
EQUALP-OK: #(5.0d0 4.0d0 3.0d0 2.0d0 1.0d0 0.0d0)
(VECTOR-POP VMFAD)
EQL-OK: 0.0d0
(VECTOR-POP VMFAD)
EQL-OK: 1.0d0
(VECTOR-POP VMFAD)
EQL-OK: 2.0d0
(VECTOR-POP VMFAD)
EQL-OK: 3.0d0
(VECTOR-POP VMFAD)
EQL-OK: 4.0d0
(VECTOR-POP VMFAD)
EQL-OK: 5.0d0
(VECTOR-PUSH-EXTEND 5.0s0 VMFAD)
EQL-OK: 0
(UPGRADED-ARRAY-ELEMENT-TYPE NIL)
EQL-OK: NIL
(ARRAYP (SETQ NIL-ARR (MAKE-ARRAY '(10 20) :ELEMENT-TYPE NIL)))
EQL-OK: T
(ARRAY-ELEMENT-TYPE (SETQ NIL-VEC (MAKE-ARRAY 4 :ELEMENT-TYPE NIL :DISPLACED-TO NIL-ARR :DISPLACED-INDEX-OFFSET 2)))
EQL-OK: NIL
(TYPEP NIL-VEC 'SEQUENCE)
EQL-OK: T
(AREF NIL-ARR 2 2)
[SIMPLE-ERROR]: AREF: cannot retrieve values from an array of element type NIL
EQL-OK: ERROR
(SETF (AREF NIL-VEC 1) 0)
[SIMPLE-TYPE-ERROR]: SYSTEM::STORE: 0 does not fit into #A(NIL (4)), bad type
EQL-OK: ERROR
(FILL NIL-VEC 1)
[SIMPLE-TYPE-ERROR]: FILL: 1 does not fit into #A(NIL (4)), bad type
EQL-OK: ERROR
(REPLACE NIL-VEC #(0 1 0 1))
[SIMPLE-TYPE-ERROR]: REPLACE: 0 cannot be stored in an array of element type NIL
EQL-OK: ERROR
(REPLACE #(0 1 0 1) NIL-VEC)
[SIMPLE-ERROR]: REPLACE: cannot retrieve values from an array of element type NIL
EQL-OK: ERROR
(PROGN (COPY-SEQ NIL-VEC))
EQUAL-OK: #A(NIL (4))
(SETQ NIL-VEC NIL NIL-ARR NIL)
EQL-OK: NIL
(ADJUSTABLE-ARRAY-P (SETQ ADA (ADJUST-ARRAY (MAKE-ARRAY '(2 3) :ADJUSTABLE T :INITIAL-CONTENTS '((A B C) (1 2 3))) '(4 6))))
EQL-OK: T
(ARRAY-DIMENSIONS ADA)
EQUAL-OK: (4 6)
(AREF ADA 1 1)
EQL-OK: 2
(SETQ BETA (MAKE-ARRAY '(2 3) :ADJUSTABLE T))
EQUALP-OK: #2A((NIL NIL NIL) (NIL NIL NIL))
(ADJUST-ARRAY BETA '(4 6) :DISPLACED-TO ADA)
EQUALP-OK: #2A((A B C NIL NIL NIL) (1 2 3 NIL NIL NIL) (NIL NIL NIL NIL NIL NIL) (NIL NIL NIL NIL NIL NIL))
(ARRAY-DIMENSIONS BETA)
EQUAL-OK: (4 6)
(AREF BETA 1 1)
EQL-OK: 2
(ADJUST-ARRAY #2A((ALPHA BETA GAMMA DELTA) (EPSILON ZETA ETA THETA) (IOTA KAPPA LAMBDA MU) (NU XI OMICRON PI)) '(3 5) :INITIAL-ELEMENT 'BAZ)
EQUALP-OK: #2A((ALPHA BETA GAMMA DELTA BAZ) (EPSILON ZETA ETA THETA BAZ) (IOTA KAPPA LAMBDA MU BAZ))
(ADJUST-ARRAY #(1 2 3 4) '(6))
EQUALP-OK: #(1 2 3 4 NIL NIL)
(LET* ((A1 (MAKE-ARRAY 5 :INITIAL-CONTENTS '(A B C D E) :FILL-POINTER 3)) (A2 (ADJUST-ARRAY A1 8 :FILL-POINTER 5 :INITIAL-ELEMENT 'X))) (ASSERT (IF (ADJUSTABLE-ARRAY-P A1) (EQ A1 A2) (EQUAL (ARRAY-DIMENSIONS A1) '(5)))) (ASSERT (NOT (ARRAY-DISPLACEMENT A2))) (LIST (ARRAY-DIMENSIONS A2) (FILL-POINTER A2) A2 (AREF A2 5) (AREF A2 6) (AREF A2 7)))
EQUALP-OK: ((8) 5 #(A B C D E) X X X)
(EQUAL (MAKE-STRING 0) (MAKE-ARRAY 0 :ELEMENT-TYPE NIL))
EQL-OK: T
(EQUALP (MAKE-ARRAY '(1 2 0)) (MAKE-ARRAY '(1 2 0) :ELEMENT-TYPE NIL))
EQL-OK: T
(ROW-MAJOR-AREF "abcd" 3)
EQL-OK: #\d
(SETF (ROW-MAJOR-AREF "abcd" 3) 17)
[SIMPLE-TYPE-ERROR]: SYSTEM::ROW-MAJOR-STORE: 17 does not fit into "abcd", bad type
EQL-OK: ERROR
(LET* ((A1 (MAKE-ARRAY 5 :INITIAL-CONTENTS "abcde" :FILL-POINTER 3 :ADJUSTABLE T :ELEMENT-TYPE 'CHARACTER)) (A2 (ADJUST-ARRAY A1 8 :FILL-POINTER 5 :INITIAL-ELEMENT #\x :ELEMENT-TYPE 'CHARACTER))) (ASSERT (OR (NOT (ADJUSTABLE-ARRAY-P A1)) (EQ A1 A2))) (ASSERT (OR (ADJUSTABLE-ARRAY-P A1) (EQUAL (ARRAY-DIMENSIONS A1) '(5)))) (ASSERT (EQUAL (ARRAY-DIMENSIONS A2) '(8))) (ASSERT (NOT (ARRAY-DISPLACEMENT A2))) (ASSERT (EQUAL (LIST (AREF A2 5) (AREF A2 6) (AREF A2 7)) '(#\x #\x #\x))) (LIST (FILL-POINTER A2) A2))
EQUAL-OK: (5 "abcde")
RUN-TEST: finished "array" (0 errors out of 290 tests)
RUN-TEST: started #<INPUT BUFFERED FILE-STREAM CHARACTER #P"backquot.tst" @1>
(SETF X '(A B C))
EQUAL-OK: (A B C)
`(X ,X , at X FOO ,(CADR X) BAR ,(CDR X) BAZ ,@(CDR X) ,.X)
EQUAL-OK: (X (A B C) A B C FOO B BAR (B C) BAZ B C A B C)
(READ-FROM-STRING "`, at x")
[SIMPLE-READER-ERROR]: READ: the syntax `, at form is invalid
EQL-OK: ERROR
`(,X . ,X)
EQUAL-OK: ((A B C) A B C)
(READ-FROM-STRING "`(,x . , at x)")
[SIMPLE-READER-ERROR]: READ: the syntax `( ... . , at form) is invalid
EQL-OK: ERROR
(READ-FROM-STRING ",x")
[SIMPLE-READER-ERROR]: READ: comma is illegal outside of backquote
EQL-OK: ERROR
(READ-FROM-STRING "`#1A(1 2 ,(+ 2 2) 4)")
[SIMPLE-READER-ERROR]: READ: unquotes may not occur in arrays
EQL-OK: ERROR
(DEFSTRUCT FOO (A B))
EQL-OK: FOO
(READ-FROM-STRING "`#S(FOO :A ,'A :B ,'B)")
[SIMPLE-READER-ERROR]: READ: unquotes may not occur in structures
EQL-OK: ERROR
(READ-FROM-STRING "``(,,,x)")
[SIMPLE-READER-ERROR]: READ: more commas out than backquotes in, is illegal
EQL-OK: ERROR
(LET ((LIST '(A B C D))) `(FOO `(BAR ,@',(MAPCAR #'(LAMBDA (SYM) `(BAZ ',SYM ,SYM)) LIST))))
EQUAL-OK: (FOO '(BAR (BAZ 'A A) (BAZ 'B B) (BAZ 'C C) (BAZ 'D D)))
`#(1 2 3 4)
EQUALP-OK: #(1 2 3 4)
`#(, at X)
EQUALP-OK: #(A B C)
(SETF A 10 B 20 C 30)
EQL-OK: 30
`(,A ,B ,C)
EQUAL-OK: (10 20 30)
(EVAL ``(,, at X))
EQUAL-OK: (10 20 30)
(EVAL ``(,,@(MAPCAR #'(LAMBDA (Z) `(LIST ',Z)) X)))
EQUAL-OK: ((A) (B) (C))
(EVAL ``(,@,@(MAPCAR #'(LAMBDA (Z) `(LIST ',Z)) X)))
EQUAL-OK: (A B C)
(EVAL (EVAL ```(,,@,@(MAPCAR #'(LAMBDA (Z) `(LIST ',Z)) X))))
EQUAL-OK: (10 20 30)
(SETF AA (LIST 10) BB (LIST 20) CC (LIST 30))
EQUAL-OK: (30)
(SETF XX '(AA BB CC))
EQUAL-OK: (AA BB CC)
(EVAL (EVAL ```(,,@,@(MAPCAR #'(LAMBDA (Z) `(LIST ',Z)) XX))))
EQUAL-OK: ((10) (20) (30))
(EVAL (EVAL ```(,@,@,@(MAPCAR #'(LAMBDA (Z) `(LIST ',Z)) XX))))
EQUAL-OK: (10 20 30)
(EVAL (EVAL ```(ALPHA ,@,@,@(MAPCAR #'(LAMBDA (Z) `(LIST ',Z)) XX) OMEGA)))
EQUAL-OK: (ALPHA 10 20 30 OMEGA)
(EVAL (EVAL ```(ALPHA ,.,.,.(MAPCAR #'(LAMBDA (Z) `(LIST ',Z)) XX) OMEGA)))
EQUAL-OK: (ALPHA 10 20 30 OMEGA)
AA
EQUAL-OK: (10 20 30 OMEGA)
BB
EQUAL-OK: (20 30 OMEGA)
CC
EQUAL-OK: (30 OMEGA)
``````````,,,,,,,,,,'X
EQL-OK: X
``````````,',',',',',',',',','X
EQUAL-OK: '''''''''X
(LET ((X 3)) `````(,(,(,(,(,(INCF X)))))) X)
EQL-OK: 4
(FORMAT NIL "~a" ``,,`,3)
EQUAL-OK: "3"
(FORMAT NIL "~a" '``,,`,3)
EQUAL-OK: "``,,`,3"
(FORMAT NIL "~a" '``,(,.ALPHA ,`,`(, at 42) . ,OMEGA))
EQUAL-OK: "``,(,.ALPHA ,`,`(, at 42) . ,OMEGA)"
`(2 3 . #(,(+ 2 2) ,@(LIST 5)))
EQUALP-OK: (2 3 . #(4 5))
(ARRAY-ELEMENT-TYPE `#(1 2 3))
EQUAL-OK: (UNSIGNED-BYTE 8)
(MACROEXPAND-1 '`(C1))
EQUAL-OK: '(C1)
(MACROEXPAND-1 '`(,(F1)))
EQUAL-OK: (LIST (F1))
(MACROEXPAND-1 '`(,@(F1)))
EQUAL-OK: (F1)
(MACROEXPAND-1 '`(,.(F1)))
EQUAL-OK: (F1)
(MACROEXPAND-1 '`(C1 C2))
EQUAL-OK: '(C1 C2)
(MACROEXPAND-1 '`(,(F1) C2))
EQUAL-OK: (CONS (F1) '(C2))
(MACROEXPAND-1 '`(,@(F1) C2))
EQUAL-OK: (APPEND (F1) '(C2))
(MACROEXPAND-1 '`(,.(F1) C2))
EQUAL-OK: (NCONC (F1) '(C2))
(MACROEXPAND-1 '`(C1 ,(F2)))
EQUAL-OK: (LIST 'C1 (F2))
(MACROEXPAND-1 '`(,(F1) ,(F2)))
EQUAL-OK: (LIST (F1) (F2))
(MACROEXPAND-1 '`(,@(F1) ,(F2)))
EQUAL-OK: (APPEND (F1) (LIST (F2)))
(MACROEXPAND-1 '`(,.(F1) ,(F2)))
EQUAL-OK: (NCONC (F1) (LIST (F2)))
(MACROEXPAND-1 '`(C1 ,@(F2)))
EQUAL-OK: (CONS 'C1 (F2))
(MACROEXPAND-1 '`(,(F1) ,@(F2)))
EQUAL-OK: (CONS (F1) (F2))
(MACROEXPAND-1 '`(,@(F1) ,@(F2)))
EQUAL-OK: (APPEND (F1) (F2))
(MACROEXPAND-1 '`(,.(F1) ,@(F2)))
EQUAL-OK: (NCONC (F1) (F2))
(MACROEXPAND-1 '`(C1 ,.(F2)))
EQUAL-OK: (CONS 'C1 (F2))
(MACROEXPAND-1 '`(,(F1) ,.(F2)))
EQUAL-OK: (CONS (F1) (F2))
(MACROEXPAND-1 '`(,@(F1) ,.(F2)))
EQUAL-OK: (APPEND (F1) (F2))
(MACROEXPAND-1 '`(,.(F1) ,.(F2)))
EQUAL-OK: (NCONC (F1) (F2))
(MACROEXPAND-1 '`(,@(F1) ,@(F2) ,@(F3)))
EQUAL-OK: (APPEND (F1) (F2) (F3))
(MACROEXPAND-1 '`(,(F1) ,@(F2) ,.(F3)))
EQUAL-OK: (CONS (F1) (APPEND (F2) (F3)))
(MACROEXPAND-1 '`(,.(F1) ,.(F2) ,@(F3)))
EQUAL-OK: (NCONC (F1) (F2) (F3))
(MACROEXPAND-1 '``(,.(F1) ,.(F2) ,.,@(F3)))
EQUAL-OK: `(NCONC (F1) (F2) ,@(F3))
(MACROEXPAND-1 '`#(A B))
EQUALP-OK: #(A B)
(MACROEXPAND-1 '`#(,(F1) ,(F2)))
EQUAL-OK: (VECTOR (F1) (F2))
(MACROEXPAND-1 '`#(,(F1) ,@(F2)))
EQUAL-OK: (MULTIPLE-VALUE-CALL #'VECTOR (VALUES (F1)) (VALUES-LIST (F2)))
(MACROEXPAND-1 '`#(A ,(F1) ,@(F2) C D))
EQUAL-OK: (MULTIPLE-VALUE-CALL #'VECTOR 'A (VALUES (F1)) (VALUES-LIST (F2)) 'C 'D)
(MACROEXPAND-1 '``#(,,@(F1) ,,@(F2)))
EQUAL-OK: `(VECTOR ,@(F1) ,@(F2))
(MACROEXPAND-1 '``#(,,.(F1) ,,@(F2)))
EQUAL-OK: `(VECTOR ,.(F1) ,@(F2))
(MACROEXPAND-1 '``#(,.,.(F1) ,.,@(F2) ,@,.(F3) ,@,@(F4)))
EQUAL-OK: `(MULTIPLE-VALUE-CALL #'VECTOR (VALUES-LIST (NCONC ,.(F1))) (VALUES-LIST (NCONC ,@(F2))) (VALUES-LIST (APPEND ,.(F3))) (VALUES-LIST (APPEND ,@(F4))))
(MACROEXPAND-1 '`(, at NIL ,@(F1)))
EQUAL-OK: (F1)
(MACROEXPAND-1 '`(,@(F1) , at NIL))
EQUAL-OK: (F1)
(MACROEXPAND-1 '`(,.NIL ,.(F1)))
EQUAL-OK: (F1)
(MACROEXPAND-1 '`(,.(F1) ,.NIL))
EQUAL-OK: (F1)
(LET ((Q '(R S)) (R '(3 5)) (S '(4 6))) (FLET ((R (X) (REDUCE #'* X))) (MACROEXPAND-1 ``(,,Q))))
EQUAL-OK: (LIST (R S))
(LET ((Q '(R S)) (R '(3 5)) (S '(4 6))) (FLET ((R (X) (REDUCE #'* X))) (MACROEXPAND-1 ``(,@,Q))))
EQUAL-OK: (R S)
(LET ((Q '(R S)) (R '(3 5)) (S '(4 6))) (FLET ((R (X) (REDUCE #'* X))) (MACROEXPAND-1 ``(,, at Q))))
EQUAL-OK: (LIST R S)
(LET ((Q '(R S)) (R '(3 5)) (S '(4 6))) (FLET ((R (X) (REDUCE #'* X))) (MACROEXPAND-1 ``(,@, at Q))))
EQUAL-OK: (APPEND R S)
(LET ((P '(UNION X Y)) (Q '((UNION X Y) (LIST 'SQRT 9))) (R '(UNION X Y)) (S '((UNION X Y)))) (MACROEXPAND-1 ``(FOO ,,P)))
EQUAL-OK: (LIST 'FOO (UNION X Y))
(LET ((P '(UNION X Y)) (Q '((UNION X Y) (LIST 'SQRT 9))) (R '(UNION X Y)) (S '((UNION X Y)))) (MACROEXPAND-1 ``(FOO ,, at Q)))
EQUAL-OK: (LIST 'FOO (UNION X Y) (LIST 'SQRT 9))
(LET ((P '(UNION X Y)) (Q '((UNION X Y) (LIST 'SQRT 9))) (R '(UNION X Y)) (S '((UNION X Y)))) (MACROEXPAND-1 ``(FOO ,',R)))
EQUAL-OK: '(FOO (UNION X Y))
(LET ((P '(UNION X Y)) (Q '((UNION X Y) (LIST 'SQRT 9))) (R '(UNION X Y)) (S '((UNION X Y)))) (MACROEXPAND-1 ``(FOO ,', at S)))
EQUAL-OK: '(FOO (UNION X Y))
(LET ((P '(UNION X Y)) (Q '((UNION X Y) (LIST 'SQRT 9))) (R '(UNION X Y)) (S '((UNION X Y)))) (MACROEXPAND-1 ``(FOO ,@,P)))
EQUAL-OK: (CONS 'FOO (UNION X Y))
(LET ((P '(UNION X Y)) (Q '((UNION X Y) (LIST 'SQRT 9))) (R '(UNION X Y)) (S '((UNION X Y)))) (MACROEXPAND-1 ``(FOO ,@, at Q)))
EQUAL-OK: (CONS 'FOO (APPEND (UNION X Y) (LIST 'SQRT 9)))
(LET ((P '(UNION X Y)) (Q '((UNION X Y) (LIST 'SQRT 9))) (R '(UNION X Y)) (S '((UNION X Y)))) (MACROEXPAND-1 ``(FOO ,@',R)))
EQUAL-OK: '(FOO UNION X Y)
(LET ((P '(UNION X Y)) (Q '((UNION X Y) (LIST 'SQRT 9))) (R '(UNION X Y)) (S '((UNION X Y)))) (MACROEXPAND-1 ``(FOO ,@', at S)))
EQUAL-OK: (CONS 'FOO '(UNION X Y))
(LET ((O 1)) (DECLARE (SPECIAL O)) (EVAL (LET ((A 2) (B 3)) (DECLARE (SPECIAL A B)) ``(,O ,@',(MAPCAR #'SYMBOL-VALUE '(A B))))))
EQUAL-OK: (1 2 3)
(LET ((O 1)) (DECLARE (SPECIAL O)) (EVAL (LET ((A 2) (B 3)) (DECLARE (SPECIAL A B)) ``(,O ,@',(MAPCAR #'SYMBOL-VALUE '(A B)) FOUR))))
EQUAL-OK: (1 2 3 FOUR)
(LET ((ENV 1)) (EVAL (LET ((GET-CODE '(:A 12 :B 45 :DOUBLE (* %BUFFER 2)))) `(DEFUN GET-MACRO (DISPLAY EVENT-KEY VARIABLE) `(LET ((%BUFFER ,DISPLAY)) (DECLARE (IGNORABLE %BUFFER)) ,(GETF `(:DISPLAY (THE T ,DISPLAY) :EVENT-KEY (THE T ,EVENT-KEY) ,@',(MAPCAR #'(LAMBDA (FORM) (INCF ENV ENV) FORM) GET-CODE)) VARIABLE))))) (LIST (EVAL (GET-MACRO 1234 5678 :DISPLAY)) (EVAL (GET-MACRO 1234 5678 :EVENT-KEY)) (EVAL (GET-MACRO 1234 5678 :A)) (EVAL (GET-MACRO 1234 5678 :DOUBLE)) ENV))
EQUAL-OK: (1234 5678 12 2468 64)
(PROGN (DEFMACRO DEFINE-SETF (VAR &REST VALUES) "define a setf function name (setf <var>) that will
set the variable `var' to the sum of the given values
plus the one given when setf'ed." `(DEFSETF ,(INTERN (SYMBOL-NAME VAR)) NIL (VALUE) `(SETF ,',VAR (+ ,VALUE ,@',VALUES)))) (DEFVAR *AVAR* NIL) (DEFINE-SETF *AVAR* 1 2 3) (LIST (SETF (*AVAR*) 4) *AVAR*))
EQUAL-OK: (10 10)
(LET ((A 12)) (MACROLET ((B NIL (LET ((C 19)) ``(,A ,@',@(LIST C))))) (B)))
EQUAL-OK: (12 . 19)
(UNINTERN 'X)
EQL-OK: T
RUN-TEST: finished "backquot" (0 errors out of 89 tests)
RUN-TEST: started #<INPUT BUFFERED FILE-STREAM CHARACTER #P"bin-io.tst" @1>
(DEFUN CLISP-TEST-BIN-I/O (&KEY (NUM 10) (FILE-NAME "bin-io-tst") (TYPE 'UNSIGNED-BYTE) (SIZE 40) (ENDIANNESS :LITTLE) (INT-LIST (ECASE TYPE (UNSIGNED-BYTE (LOOP :WITH MAX = (ASH 1 SIZE) :REPEAT NUM :COLLECT (RANDOM MAX))) (SIGNED-BYTE (LOOP :WITH MAX = (ASH 1 SIZE) :AND TOP = (ASH 1 (1- SIZE)) :REPEAT NUM :COLLECT (- (RANDOM MAX) TOP))))) (FLOAT-LIST (LOOP :REPEAT NUM :COLLECT (RANDOM 1.0d0)))) (LET ((ELTYPE (LIST TYPE SIZE))) (WITH-OPEN-FILE (FOO FILE-NAME :DIRECTION :OUTPUT :ELEMENT-TYPE 'UNSIGNED-BYTE) (DOLIST (NUM INT-LIST) (WRITE-INTEGER NUM FOO ELTYPE ENDIANNESS)) (DOLIST (NUM FLOAT-LIST) (WRITE-FLOAT NUM FOO 'DOUBLE-FLOAT ENDIANNESS))) (UNWIND-PROTECT (WITH-OPEN-FILE (FOO FILE-NAME :DIRECTION :INPUT :ELEMENT-TYPE 'UNSIGNED-BYTE) (LIST (FILE-LENGTH FOO) INT-LIST FLOAT-LIST (LOOP :FOR NUM :IN INT-LIST :FOR NN = (READ-INTEGER FOO ELTYPE ENDIANNESS) :COLLECT NN :UNLESS (= NN NUM) :DO (ERROR "~s/~s: wrote: ~s read: ~s" ENDIANNESS ELTYPE NUM NN)) (LOOP :FOR NUM :IN FLOAT-LIST :FOR NN = (READ-FLOAT FOO 'DOUBLE-FLOAT ENDIANNESS) :COLLECT NN :UNLESS (= NN NUM) :DO (ERROR "~s: wrote: ~s read: ~s" ENDIANNESS NUM NN)))) (DELETE-FILE FILE-NAME))))
EQL-OK: CLISP-TEST-BIN-I/O
(DOLIST (E '(:LITTLE :BIG)) (DOLIST (S '(UNSIGNED-BYTE SIGNED-BYTE)) (CLISP-TEST-BIN-I/O :ENDIANNESS E :TYPE S)))
EQL-OK: NIL
(LET ((VEC (MAKE-ARRAY 8 :ELEMENT-TYPE '(UNSIGNED-BYTE 8) :INITIAL-CONTENTS '(63 240 0 0 0 0 0 0)))) (WITH-OPEN-FILE (FOO "bin-io-tst" :DIRECTION :OUTPUT :ELEMENT-TYPE '(UNSIGNED-BYTE 8)) (WRITE-SEQUENCE VEC FOO)) (UNWIND-PROTECT (WITH-OPEN-FILE (FOO "bin-io-tst" :DIRECTION :INPUT :ELEMENT-TYPE '(UNSIGNED-BYTE 8)) (READ-FLOAT FOO 'DOUBLE-FLOAT :BIG)) (DELETE-FILE "bin-io-tst")))
EQL-OK: 1.0d0
(PROGN (DEFCLASS LIST-INPUT-STREAM (FUNDAMENTAL-INPUT-STREAM) ((LIST :INITARG :LIST))) (DEFMETHOD STREAM-ELEMENT-TYPE ((STREAM LIST-INPUT-STREAM)) T) (DEFMETHOD STREAM-READ-CHAR ((STREAM LIST-INPUT-STREAM)) (WITH-SLOTS (LIST) STREAM (IF LIST (LET ((RET (POP LIST))) (TYPECASE RET (INTEGER (CODE-CHAR RET)) (CHARACTER RET) (T (COERCE RET 'CHARACTER)))) :EOF))) (DEFMETHOD STREAM-UNREAD-CHAR ((STREAM LIST-INPUT-STREAM) (CHAR CHARACTER)) (WITH-SLOTS (LIST) STREAM (PUSH CHAR LIST))) (DEFMETHOD STREAM-READ-BYTE ((STREAM LIST-INPUT-STREAM)) (WITH-SLOTS (LIST) STREAM (IF LIST (LET ((RET (POP LIST))) (TYPECASE RET (INTEGER RET) (CHARACTER (CHAR-CODE RET)) (T (COERCE RET 'INTEGER)))) :EOF))) (DEFUN LIST->INTEGER (LIST TYPE ENDIANNESS) (READ-INTEGER (MAKE-INSTANCE 'LIST-INPUT-STREAM :LIST LIST) TYPE ENDIANNESS)) (DEFUN LIST->FLOAT (LIST TYPE ENDIANNESS) (READ-FLOAT (MAKE-INSTANCE 'LIST-INPUT-STREAM :LIST LIST) TYPE ENDIANNESS)))
WARNING: The generic function #<STANDARD-GENERIC-FUNCTION STREAM-ELEMENT-TYPE> is being modified, but has already been called.
EQL-OK: LIST->FLOAT
(LIST->FLOAT '(63 240 0 0 0 0 0 0) 'DOUBLE-FLOAT :BIG)
EQL-OK: 1.0d0
(LIST->FLOAT '(0 0 0 0 0 0 240 63) 'DOUBLE-FLOAT :LITTLE)
EQL-OK: 1.0d0
(LIST->INTEGER '(0 1) '(UNSIGNED-BYTE 16) :BIG)
EQL-OK: 1
(LIST->INTEGER '(1 0) '(UNSIGNED-BYTE 16) :BIG)
EQL-OK: 256
(LIST->INTEGER '(1 0) '(UNSIGNED-BYTE 16) :LITTLE)
EQL-OK: 1
(LIST->INTEGER '(0 1) '(UNSIGNED-BYTE 16) :LITTLE)
EQL-OK: 256
(PROGN (DEFCLASS LIST-OUTPUT-STREAM (FUNDAMENTAL-OUTPUT-STREAM) ((LIST :INITFORM NIL))) (DEFMETHOD STREAM-ELEMENT-TYPE ((STREAM LIST-OUTPUT-STREAM)) T) (DEFMETHOD STREAM-WRITE-CHAR ((STREAM LIST-OUTPUT-STREAM) (CHAR CHARACTER)) (WITH-SLOTS (LIST) STREAM (PUSH CHAR LIST))) (DEFMETHOD STREAM-WRITE-BYTE ((STREAM LIST-OUTPUT-STREAM) (BYTE INTEGER)) (WITH-SLOTS (LIST) STREAM (PUSH BYTE LIST))) (DEFUN INTEGER->LIST (INTEGER TYPE ENDIANNESS) (LET ((OUT (MAKE-INSTANCE 'LIST-OUTPUT-STREAM))) (WRITE-INTEGER INTEGER OUT TYPE ENDIANNESS) (WITH-SLOTS (LIST) OUT (REVERSE LIST)))) (DEFUN FLOAT->LIST (FLOAT TYPE ENDIANNESS) (LET ((OUT (MAKE-INSTANCE 'LIST-OUTPUT-STREAM))) (WRITE-FLOAT FLOAT OUT TYPE ENDIANNESS) (WITH-SLOTS (LIST) OUT (REVERSE LIST)))))
WARNING: The generic function #<STANDARD-GENERIC-FUNCTION STREAM-WRITE-CHAR> is being modified, but has already been called.
EQL-OK: FLOAT->LIST
(FLOAT->LIST 1.0d0 'DOUBLE-FLOAT :BIG)
EQUAL-OK: (63 240 0 0 0 0 0 0)
(FLOAT->LIST 1.0d0 'DOUBLE-FLOAT :LITTLE)
EQUAL-OK: (0 0 0 0 0 0 240 63)
(INTEGER->LIST 1 '(UNSIGNED-BYTE 16) :BIG)
EQUAL-OK: (0 1)
(INTEGER->LIST 1 '(UNSIGNED-BYTE 16) :LITTLE)
EQUAL-OK: (1 0)
RUN-TEST: finished "bin-io" (0 errors out of 15 tests)
RUN-TEST: started #<INPUT BUFFERED FILE-STREAM CHARACTER #P"characters.tst" @1>
CHAR-CODE-LIMIT
EQL-OK: 1114112
(STANDARD-CHAR-P #\a)
EQL-OK: T
(STANDARD-CHAR-P #\$)
EQL-OK: T
(STANDARD-CHAR-P #\.)
EQL-OK: T
(STANDARD-CHAR-P #\A)
EQL-OK: T
(STANDARD-CHAR-P 1)
[SIMPLE-TYPE-ERROR]: STANDARD-CHAR-P: argument 1 is not a character
EQL-OK: ERROR
(STANDARD-CHAR-P #\\)
EQL-OK: T
(STANDARD-CHAR-P #\5)
EQL-OK: T
(STANDARD-CHAR-P #\))
EQL-OK: T
(STANDARD-CHAR-P #\%)
EQL-OK: T
(STANDARD-CHAR-P #\Backspace)
EQL-OK: NIL
(STANDARD-CHAR-P #\Page)
EQL-OK: NIL
(STANDARD-CHAR-P #\Return)
EQL-OK: NIL
(GRAPHIC-CHAR-P #\a)
EQL-OK: T
(GRAPHIC-CHAR-P #\$)
EQL-OK: T
(GRAPHIC-CHAR-P #\.)
EQL-OK: T
(GRAPHIC-CHAR-P #\A)
EQL-OK: T
(GRAPHIC-CHAR-P 1)
[SIMPLE-TYPE-ERROR]: GRAPHIC-CHAR-P: argument 1 is not a character
EQL-OK: ERROR
(GRAPHIC-CHAR-P #\\)
EQL-OK: T
(GRAPHIC-CHAR-P #\5)
EQL-OK: T
(GRAPHIC-CHAR-P #\))
EQL-OK: T
(GRAPHIC-CHAR-P #\%)
EQL-OK: T
(GRAPHIC-CHAR-P #\Backspace)
EQL-OK: NIL
(GRAPHIC-CHAR-P #\Page)
EQL-OK: NIL
(GRAPHIC-CHAR-P #\Return)
EQL-OK: NIL
(STRING-CHAR-P #\a)
EQL-OK: T
(STRING-CHAR-P #\$)
EQL-OK: T
(STRING-CHAR-P #\.)
EQL-OK: T
(STRING-CHAR-P #\A)
EQL-OK: T
(STRING-CHAR-P 1)
[SIMPLE-TYPE-ERROR]: STRING-CHAR-P: argument 1 is not a character
EQL-OK: ERROR
(STRING-CHAR-P #\\)
EQL-OK: T
(STRING-CHAR-P #\5)
EQL-OK: T
(STRING-CHAR-P #\))
EQL-OK: T
(STRING-CHAR-P #\%)
EQL-OK: T
(STRING-CHAR-P #\Backspace)
EQL-OK: T
(STRING-CHAR-P #\Page)
EQL-OK: T
(STRING-CHAR-P #\Return)
EQL-OK: T
(ALPHA-CHAR-P #\a)
EQL-OK: T
(ALPHA-CHAR-P #\$)
EQL-OK: NIL
(ALPHA-CHAR-P #\.)
EQL-OK: NIL
(ALPHA-CHAR-P #\A)
EQL-OK: T
(ALPHA-CHAR-P 1)
[SIMPLE-TYPE-ERROR]: ALPHA-CHAR-P: argument 1 is not a character
EQL-OK: ERROR
(ALPHA-CHAR-P #\\)
EQL-OK: NIL
(ALPHA-CHAR-P #\5)
EQL-OK: NIL
(ALPHA-CHAR-P #\))
EQL-OK: NIL
(ALPHA-CHAR-P #\%)
EQL-OK: NIL
(ALPHA-CHAR-P #\Backspace)
EQL-OK: NIL
(ALPHA-CHAR-P #\Page)
EQL-OK: NIL
(ALPHA-CHAR-P #\Return)
EQL-OK: NIL
(UPPER-CASE-P #\a)
EQL-OK: NIL
(UPPER-CASE-P #\$)
EQL-OK: NIL
(UPPER-CASE-P #\.)
EQL-OK: NIL
(UPPER-CASE-P #\A)
EQL-OK: T
(UPPER-CASE-P 1)
[SIMPLE-TYPE-ERROR]: UPPER-CASE-P: argument 1 is not a character
EQL-OK: ERROR
(UPPER-CASE-P #\\)
EQL-OK: NIL
(UPPER-CASE-P #\5)
EQL-OK: NIL
(UPPER-CASE-P #\))
EQL-OK: NIL
(UPPER-CASE-P #\%)
EQL-OK: NIL
(UPPER-CASE-P #\Backspace)
EQL-OK: NIL
(UPPER-CASE-P #\Page)
EQL-OK: NIL
(UPPER-CASE-P #\Return)
EQL-OK: NIL
(LOWER-CASE-P #\a)
EQL-OK: T
(LOWER-CASE-P #\$)
EQL-OK: NIL
(LOWER-CASE-P #\.)
EQL-OK: NIL
(LOWER-CASE-P #\A)
EQL-OK: NIL
(LOWER-CASE-P 1)
[SIMPLE-TYPE-ERROR]: LOWER-CASE-P: argument 1 is not a character
EQL-OK: ERROR
(LOWER-CASE-P #\\)
EQL-OK: NIL
(LOWER-CASE-P #\5)
EQL-OK: NIL
(LOWER-CASE-P #\))
EQL-OK: NIL
(LOWER-CASE-P #\%)
EQL-OK: NIL
(LOWER-CASE-P #\Backspace)
EQL-OK: NIL
(LOWER-CASE-P #\Page)
EQL-OK: NIL
(LOWER-CASE-P #\Return)
EQL-OK: NIL
(BOTH-CASE-P #\a)
EQL-OK: T
(BOTH-CASE-P #\$)
EQL-OK: NIL
(BOTH-CASE-P #\.)
EQL-OK: NIL
(BOTH-CASE-P #\A)
EQL-OK: T
(BOTH-CASE-P 1)
[SIMPLE-TYPE-ERROR]: BOTH-CASE-P: argument 1 is not a character
EQL-OK: ERROR
(BOTH-CASE-P #\\)
EQL-OK: NIL
(BOTH-CASE-P #\5)
EQL-OK: NIL
(BOTH-CASE-P #\))
EQL-OK: NIL
(BOTH-CASE-P #\%)
EQL-OK: NIL
(BOTH-CASE-P #\Backspace)
EQL-OK: NIL
(BOTH-CASE-P #\Page)
EQL-OK: NIL
(BOTH-CASE-P #\Return)
EQL-OK: NIL
(DIGIT-CHAR-P #\a)
EQL-OK: NIL
(DIGIT-CHAR-P #\$)
EQL-OK: NIL
(DIGIT-CHAR-P #\.)
EQL-OK: NIL
(DIGIT-CHAR-P #\A)
EQL-OK: NIL
(DIGIT-CHAR-P 1)
[SIMPLE-TYPE-ERROR]: DIGIT-CHAR-P: argument 1 is not a character
EQL-OK: ERROR
(DIGIT-CHAR-P #\\)
EQL-OK: NIL
(DIGIT-CHAR-P #\5)
EQL-OK: 5
(DIGIT-CHAR-P #\))
EQL-OK: NIL
(DIGIT-CHAR-P #\%)
EQL-OK: NIL
(DIGIT-CHAR-P #\Backspace)
EQL-OK: NIL
(DIGIT-CHAR-P #\Page)
EQL-OK: NIL
(DIGIT-CHAR-P #\Return)
EQL-OK: NIL
(DIGIT-CHAR-P #\5 4)
EQL-OK: NIL
(DIGIT-CHAR-P #\5 8)
EQL-OK: 5
(DIGIT-CHAR-P #\E 16)
EQL-OK: 14
(DIGIT-CHAR-P #\R 35)
EQL-OK: 27
(DIGIT-CHAR-P #\5 4)
EQL-OK: NIL
(DIGIT-CHAR-P #\5 5)
EQL-OK: NIL
(DIGIT-CHAR-P #\5 6)
EQL-OK: 5
(DIGIT-CHAR-P #\1 2)
EQL-OK: 1
(ALPHANUMERICP #\a)
EQL-OK: T
(ALPHANUMERICP #\$)
EQL-OK: NIL
(ALPHANUMERICP #\.)
EQL-OK: NIL
(ALPHANUMERICP #\A)
EQL-OK: T
(ALPHANUMERICP 1)
[SIMPLE-TYPE-ERROR]: ALPHANUMERICP: argument 1 is not a character
EQL-OK: ERROR
(ALPHANUMERICP #\\)
EQL-OK: NIL
(ALPHANUMERICP #\5)
EQL-OK: T
(ALPHANUMERICP #\))
EQL-OK: NIL
(ALPHANUMERICP #\%)
EQL-OK: NIL
(ALPHANUMERICP #\Backspace)
EQL-OK: NIL
(ALPHANUMERICP #\Page)
EQL-OK: NIL
(ALPHANUMERICP #\Return)
EQL-OK: NIL
(ALPHANUMERICP #\5 4)
[SIMPLE-SOURCE-PROGRAM-ERROR]: EVAL: too many arguments given to ALPHANUMERICP: #1=(ALPHANUMERICP #\5 4)
EQL-OK: ERROR
(ALPHANUMERICP #\5 8)
[SIMPLE-SOURCE-PROGRAM-ERROR]: EVAL: too many arguments given to ALPHANUMERICP: #1=(ALPHANUMERICP #\5 8)
EQL-OK: ERROR
(ALPHANUMERICP #\E 16)
[SIMPLE-SOURCE-PROGRAM-ERROR]: EVAL: too many arguments given to ALPHANUMERICP: #1=(ALPHANUMERICP #\E 16)
EQL-OK: ERROR
(ALPHANUMERICP #\R 35)
[SIMPLE-SOURCE-PROGRAM-ERROR]: EVAL: too many arguments given to ALPHANUMERICP: #1=(ALPHANUMERICP #\R 35)
EQL-OK: ERROR
(CHAR= #\d #\d)
EQL-OK: T
(CHAR/= #\d #\d)
EQL-OK: NIL
(CHAR= #\d #\x)
EQL-OK: NIL
(CHAR/= #\d #\x)
EQL-OK: T
(CHAR= #\d #\D)
EQL-OK: NIL
(CHAR/= #\d #\D)
EQL-OK: T
(CHAR= #\d #\d #\d #\d)
EQL-OK: T
(CHAR/= #\d #\d #\d #\d)
EQL-OK: NIL
(CHAR= #\d #\d #\x #\d)
EQL-OK: NIL
(CHAR/= #\d #\d #\x #\d)
EQL-OK: NIL
(CHAR= #\d #\y #\x #\c)
EQL-OK: NIL
(CHAR/= #\d #\y #\x #\c)
EQL-OK: T
(CHAR= #\d #\c #\d)
EQL-OK: NIL
(CHAR/= #\d #\c #\d)
EQL-OK: NIL
(CHAR< #\d #\x)
EQL-OK: T
(CHAR<= #\d #\x)
EQL-OK: T
(CHAR< #\d #\d)
EQL-OK: NIL
(CHAR<= #\d #\d)
EQL-OK: T
(CHAR< #\a #\e #\y #\z)
EQL-OK: T
(CHAR<= #\a #\e #\y #\z)
EQL-OK: T
(CHAR< #\a #\e #\e #\y)
EQL-OK: NIL
(CHAR<= #\a #\e #\e #\y)
EQL-OK: T
(CHAR> #\e #\d)
EQL-OK: T
(CHAR>= #\e #\d)
EQL-OK: T
(CHAR> #\d #\c #\b #\a)
EQL-OK: T
(CHAR>= #\d #\c #\b #\a)
EQL-OK: T
(CHAR> #\d #\d #\b #\a)
EQL-OK: NIL
(CHAR>= #\d #\d #\b #\a)
EQL-OK: T
(CHAR> #\e #\d #\b #\c #\a)
EQL-OK: NIL
(CHAR>= #\e #\d #\b #\c #\a)
EQL-OK: NIL
(CHAR> #\z #\A)
EQL-OK: T
(CHAR> #\Z #\a)
EQL-OK: NIL
(CHAR< #\9 #\a)
EQL-OK: T
(CHAR> #\9 #\a)
EQL-OK: NIL
(CHAR> #\z #\0)
EQL-OK: T
(CHAR< #\z #\0)
EQL-OK: NIL
(CHAR-EQUAL #\d #\d)
EQL-OK: T
(CHAR-NOT-EQUAL #\d #\d)
EQL-OK: NIL
(CHAR-EQUAL #\d #\x)
EQL-OK: NIL
(CHAR-NOT-EQUAL #\d #\x)
EQL-OK: T
(CHAR-EQUAL #\d #\D)
EQL-OK: T
(CHAR-NOT-EQUAL #\d #\D)
EQL-OK: NIL
(CHAR-EQUAL #\d #\d #\d #\d)
EQL-OK: T
(CHAR-NOT-EQUAL #\d #\d #\d #\d)
EQL-OK: NIL
(CHAR-EQUAL #\d #\d #\x #\d)
EQL-OK: NIL
(CHAR-NOT-EQUAL #\d #\d #\x #\d)
EQL-OK: NIL
(CHAR-EQUAL #\d #\y #\x #\c)
EQL-OK: NIL
(CHAR-NOT-EQUAL #\d #\y #\x #\c)
EQL-OK: T
(CHAR-EQUAL #\d #\c #\d)
EQL-OK: NIL
(CHAR-NOT-EQUAL #\d #\c #\d)
EQL-OK: NIL
(CHAR-LESSP #\d #\x)
EQL-OK: T
(CHAR-NOT-GREATERP #\d #\x)
EQL-OK: T
(CHAR-LESSP #\d #\d)
EQL-OK: NIL
(CHAR-NOT-GREATERP #\d #\d)
EQL-OK: T
(CHAR-LESSP #\a #\e #\y #\z)
EQL-OK: T
(CHAR-NOT-GREATERP #\a #\e #\y #\z)
EQL-OK: T
(CHAR-LESSP #\a #\e #\e #\y)
EQL-OK: NIL
(CHAR-NOT-GREATERP #\a #\e #\e #\y)
EQL-OK: T
(CHAR-GREATERP #\e #\d)
EQL-OK: T
(CHAR-NOT-LESSP #\e #\d)
EQL-OK: T
(CHAR-GREATERP #\d #\c #\b #\a)
EQL-OK: T
(CHAR-NOT-LESSP #\d #\c #\b #\a)
EQL-OK: T
(CHAR-GREATERP #\d #\d #\b #\a)
EQL-OK: NIL
(CHAR-NOT-LESSP #\d #\d #\b #\a)
EQL-OK: T
(CHAR-GREATERP #\e #\d #\b #\c #\a)
EQL-OK: NIL
(CHAR-NOT-LESSP #\e #\d #\b #\c #\a)
EQL-OK: NIL
(CHAR-GREATERP #\z #\A)
EQL-OK: T
(CHAR-GREATERP #\Z #\a)
EQL-OK: T
(CHAR-LESSP #\9 #\a)
EQL-OK: T
(CHAR-GREATERP #\9 #\a)
EQL-OK: NIL
(CHAR-GREATERP #\z #\0)
EQL-OK: T
(CHAR-LESSP #\z #\0)
EQL-OK: NIL
(CHAR-EQUAL #\A #\a)
EQL-OK: T
(CHAR-UPCASE #\a)
EQL-OK: #\A
(CHAR-UPCASE #\A)
EQL-OK: #\A
(CHAR-UPCASE #\5)
EQL-OK: #\5
(CHAR-UPCASE #\;)
EQL-OK: #\;
(CHAR-UPCASE #\=)
EQL-OK: #\=
(CHAR= (CHAR-DOWNCASE (CHAR-UPCASE #\x)) #\x)
EQL-OK: T
(CHAR-DOWNCASE #\A)
EQL-OK: #\a
(CHAR-DOWNCASE #\a)
EQL-OK: #\a
(CHAR-DOWNCASE #\%)
EQL-OK: #\%
(CHAR-DOWNCASE #\+)
EQL-OK: #\+
(CHAR-DOWNCASE #\-)
EQL-OK: #\-
(CHAR= (CHAR-UPCASE (CHAR-DOWNCASE #\X)) #\X)
EQL-OK: T
(DIGIT-CHAR 7)
EQL-OK: #\7
(DIGIT-CHAR 12)
EQL-OK: NIL
(DIGIT-CHAR 'A)
[SIMPLE-TYPE-ERROR]: DIGIT-CHAR: the weight argument should be an integer, not A
EQL-OK: ERROR
(DIGIT-CHAR 12 16)
EQL-OK: #\C
(DIGIT-CHAR 6 2)
EQL-OK: NIL
(DIGIT-CHAR 1 2)
EQL-OK: #\1
CHAR-CONTROL-BIT
EQL-OK: 1
CHAR-META-BIT
EQL-OK: 2
CHAR-SUPER-BIT
EQL-OK: 4
CHAR-HYPER-BIT
EQL-OK: 8
(CHAR-NAME #\Space)
EQUAL-OK: "Space"
(CHAR-NAME #\Newline)
EQUAL-OK: "Newline"
(LET ((WRONG-CODES NIL)) (DOTIMES (CODE CHAR-CODE-LIMIT) (LET ((C (CODE-CHAR CODE))) (UNLESS (AND (OR (EQL C (NAME-CHAR (CHAR-NAME C))))) (PUSH CODE WRONG-CODES)))) WRONG-CODES)
EQL-OK: NIL
(LOOP :FOR I :FROM 0 :BELOW CHAR-CODE-LIMIT :FOR X = (CODE-CHAR I) :UNLESS (OR (NOT (CHARACTERP X)) (IF (OR (DIGIT-CHAR-P X) (ALPHA-CHAR-P X)) (ALPHANUMERICP X) (NOT (ALPHANUMERICP X)))) :COLLECT (LIST I X :DIGIT (DIGIT-CHAR-P X) :ALPHA (ALPHA-CHAR-P X) :ALPHANUMERICP (ALPHANUMERICP X)))
EQL-OK: NIL
(LOCALLY (DECLARE (COMPILE)) (LOOP :FOR I :FROM 0 :BELOW CHAR-CODE-LIMIT :FOR X = (CODE-CHAR I) :UNLESS (EQ (CHAR-INVERTCASE (CHAR-INVERTCASE X)) X) :COLLECT X))
EQL-OK: NIL
RUN-TEST: finished "characters" (0 errors out of 221 tests)
RUN-TEST: started #<INPUT BUFFERED FILE-STREAM CHARACTER #P"clos.tst" @1>
(USE-PACKAGE "CLOS")
EQL-OK: T
(UNINTERN '<C1>)
EQL-OK: T
(PROGN (DEFCLASS <C1> NIL ((X :INITFORM 0 :ACCESSOR X-VAL :READER GET-X :WRITER SET-X :INITARG :X) (Y :INITFORM 1 :ACCESSOR Y-VAL :READER GET-Y :WRITER SET-Y :INITARG :Y))) NIL)
EQL-OK: NIL
(PROGN (DEFCLASS <C2> (<C1>) ((Z :INITFORM 0 :ACCESSOR Z-VAL :READER GET-Z :WRITER SET-Z :INITARG :Z))) NIL)
EQL-OK: NIL
(DEFPARAMETER A (MAKE-INSTANCE (FIND-CLASS '<C1>) :X 10))
EQL-OK: A
(LET (CACHE) (DEFMETHOD SLOT-MISSING ((CLASS T) (OBJ <C1>) (SLOT-NAME T) (OPERATION T) &OPTIONAL (NEW-VALUE NIL NEW-VALUE-P)) (SETF CACHE (LIST SLOT-NAME OPERATION NEW-VALUE NEW-VALUE-P))) (LIST (SLOT-BOUNDP A 'ABCD) CACHE (SLOT-VALUE A 'ABCD) CACHE))
EQUAL-OK: (T (ABCD SLOT-BOUNDP NIL NIL) (ABCD SLOT-VALUE NIL NIL) (ABCD SLOT-VALUE NIL NIL))
(X-VAL A)
EQL-OK: 10
(Y-VAL A)
EQL-OK: 1
(SETF (X-VAL A) 20)
EQL-OK: 20
(X-VAL A)
EQL-OK: 20
(GET-X A)
EQL-OK: 20
(SET-X 10 A)
EQL-OK: 10
(X-VAL A)
EQL-OK: 10
(WITH-SLOTS (X Y) A (+ X Y))
EQL-OK: 11
(DEFUN FOO (Z) (WITH-SLOTS (X Y) Z (+ X Y)))
EQL-OK: FOO
(FOO A)
EQL-OK: 11
(COMPILE 'FOO)
EQL-OK: FOO
(FOO A)
EQL-OK: 11
(SYMBOL-CLEANUP 'FOO)
EQL-OK: T
(X-VAL (REINITIALIZE-INSTANCE A :X 20))
EQL-OK: 20
(X-VAL (REINITIALIZE-INSTANCE A :X 30))
EQL-OK: 30
(X-VAL (REINITIALIZE-INSTANCE A :X 50))
EQL-OK: 50
(X-VAL (REINITIALIZE-INSTANCE A :X 80))
EQL-OK: 80
(X-VAL (REINITIALIZE-INSTANCE A :Y 20))
EQL-OK: 80
(Y-VAL (REINITIALIZE-INSTANCE A :X 30))
EQL-OK: 20
(X-VAL (REINITIALIZE-INSTANCE A :Y 50))
EQL-OK: 30
(Y-VAL (REINITIALIZE-INSTANCE A :X 80))
EQL-OK: 50
(DEFPARAMETER B (MAKE-INSTANCE (FIND-CLASS '<C2>) :X 10 :Y 20 :Z 30))
EQL-OK: B
(X-VAL B)
EQL-OK: 10
(Y-VAL B)
EQL-OK: 20
(Z-VAL B)
EQL-OK: 30
(LET* ((FN (DEFGENERIC F (X Y) (:METHOD ((X T) (Y T)) (LIST X Y)))) (METH1 (DEFMETHOD F ((I INTEGER) (J NUMBER)) (+ I J))) (METH2 (DEFMETHOD F ((S1 STRING) (S2 STRING)) (CONCATENATE 'STRING S1 S2)))) (LAMBDA NIL (DEFMETHOD F ((X LIST) (Y LIST)) (APPEND X Y))) (LIST (EQ METH1 (FIND-METHOD #'F NIL (LIST (FIND-CLASS 'INTEGER) (FIND-CLASS 'NUMBER)))) (EQ METH2 (FIND-METHOD #'F NIL (LIST (FIND-CLASS 'STRING) (FIND-CLASS 'STRING))))))
EQUAL-OK: (T T)
(F T T)
EQUAL-OK: (T T)
(F 2 3)
EQL-OK: 5
(F 2 3.0)
EQL-OK: 5.0
(F 2.0 3)
EQUAL-OK: (2.0 3)
(F "ab" "cd")
EQUAL-OK: "abcd"
(F 1 "abc")
EQUAL-OK: (1 "abc")
(PROGN (DEFGENERIC F (X Y) (:METHOD ((X T) (Y T)) (LIST X Y)) (:METHOD ((I NUMBER) (J INTEGER)) (LIST (CALL-NEXT-METHOD) (- I J))) (:METHOD ((I INTEGER) (J NUMBER)) (LIST (CALL-NEXT-METHOD) (+ I J)))) NIL)
WARNING: The generic function #<STANDARD-GENERIC-FUNCTION F> is being modified, but has already been called.
WARNING: Replacing method #1=#<STANDARD-METHOD (#2=#<BUILT-IN-CLASS INTEGER> #3=#<BUILT-IN-CLASS NUMBER>)> in #<STANDARD-GENERIC-FUNCTION F>
EQL-OK: NIL
(F 'X 'Y)
EQUAL-OK: (X Y)
(F 1 2)
EQUAL-OK: (((1 2) -1) 3)
(F 1 2.0)
EQUAL-OK: ((1 2.0) 3.0)
(F 1.0 2)
EQUAL-OK: ((1.0 2) -1.0)
(PROGN (DEFGENERIC G (X) (:METHOD ((X NULL)) (CONS 'NULL (CALL-NEXT-METHOD))) (:METHOD ((X LIST)) (IF (NEXT-METHOD-P) (CONS 'LIST (CALL-NEXT-METHOD)) '(LIST$))) (:METHOD ((X SYMBOL)) (IF (NEXT-METHOD-P) (CONS 'SYMBOL (CALL-NEXT-METHOD)) '(SYMBOL$)))) NIL)
EQL-OK: NIL
(G 'X)
EQUAL-OK: (SYMBOL$)
(G '(X))
EQUAL-OK: (LIST$)
(G 'NIL)
EQUAL-OK: (NULL SYMBOL LIST$)
(DEFPARAMETER *HL* NIL)
EQL-OK: *HL*
(PROGN (DEFGENERIC HGEN (X) (:METHOD ((X INTEGER)) (SETF *HL* (CONS 'I-PRIMARY-1 *HL*)) (CALL-NEXT-METHOD) (SETF *HL* (CONS 'I-PRIMARY-2 *HL*))) (:METHOD :BEFORE ((X INTEGER)) (SETF *HL* (CONS 'I-BEFORE *HL*))) (:METHOD :AFTER ((X INTEGER)) (SETF *HL* (CONS 'I-AFTER *HL*))) (:METHOD :AROUND ((X INTEGER)) (SETF *HL* (CONS 'I-AROUND-1 *HL*)) (CALL-NEXT-METHOD) (SETF *HL* (CONS 'I-AROUND-2 *HL*))) (:METHOD ((X NUMBER)) (SETF *HL* (CONS 'N-PRIMARY-1 *HL*)) (CALL-NEXT-METHOD) (SETF *HL* (CONS 'N-PRIMARY-2 *HL*))) (:METHOD :BEFORE ((X NUMBER)) (SETF *HL* (CONS 'N-BEFORE *HL*))) (:METHOD :AFTER ((X NUMBER)) (SETF *HL* (CONS 'N-AFTER *HL*))) (:METHOD :AROUND ((X NUMBER)) (SETF *HL* (CONS 'N-AROUND-1 *HL*)) (CALL-NEXT-METHOD) (SETF *HL* (CONS 'N-AROUND-2 *HL*))) (:METHOD ((X T)) (SETF *HL* (CONS 'INNERMOST *HL*)))) (DEFUN H (X) (SETF *HL* 'NIL) (HGEN X) (REVERSE *HL*)))
EQL-OK: H
(H 'ABC)
EQUAL-OK: (INNERMOST)
(H 3.14)
EQUAL-OK: (N-AROUND-1 N-BEFORE N-PRIMARY-1 INNERMOST N-PRIMARY-2 N-AFTER N-AROUND-2)
(H 3)
EQUAL-OK: (I-AROUND-1 N-AROUND-1 I-BEFORE N-BEFORE I-PRIMARY-1 N-PRIMARY-1 INNERMOST N-PRIMARY-2 I-PRIMARY-2 N-AFTER I-AFTER N-AROUND-2 I-AROUND-2)
(PROGN (DEFGENERIC TESTGF00 (&REST ARGS &KEY) (:METHOD (&REST ARGS))) (TESTGF00 'A 'B))
[SIMPLE-KEYWORD-ERROR]: TESTGF00-<EMF-1>-1: illegal keyword/value pair A, B in argument list.
The allowed keywords are NIL
EQL-OK: ERROR
(LET ((METHODS NIL)) (DEFGENERIC FOO136 (MODE OBJECT)) (DEFMETHOD FOO136 (MODE (OBJECT T)) (IF (EQ MODE 'STORE) (PUSH #'CALL-NEXT-METHOD METHODS) (IF (EQ MODE 'LIST) (LIST 'T) (CONS (LIST 'T) (FUNCALL MODE))))) (DEFMETHOD FOO136 (MODE (OBJECT NUMBER)) (IF (EQ MODE 'STORE) (PROGN (PUSH #'CALL-NEXT-METHOD METHODS) (CALL-NEXT-METHOD)) (IF (EQ MODE 'LIST) (CONS 'NUMBER (CALL-NEXT-METHOD)) (CONS (CONS 'NUMBER (CALL-NEXT-METHOD 'LIST OBJECT)) (FUNCALL MODE))))) (DEFMETHOD FOO136 (MODE (OBJECT REAL)) (IF (EQ MODE 'STORE) (PROGN (PUSH #'CALL-NEXT-METHOD METHODS) (CALL-NEXT-METHOD)) (IF (EQ MODE 'LIST) (CONS 'REAL (CALL-NEXT-METHOD)) (CONS (CONS 'REAL (CALL-NEXT-METHOD 'LIST OBJECT)) (FUNCALL MODE))))) (DEFMETHOD FOO136 (MODE (OBJECT RATIONAL)) (IF (EQ MODE 'STORE) (PROGN (PUSH #'CALL-NEXT-METHOD METHODS) (CALL-NEXT-METHOD)) (IF (EQ MODE 'LIST) (CONS 'RATIONAL (CALL-NEXT-METHOD)) (CONS (CONS 'RATIONAL (CALL-NEXT-METHOD 'LIST OBJECT)) (FUNCALL MODE))))) (DEFMETHOD FOO136 (MODE (OBJECT INTEGER)) (IF (EQ MODE 'STORE) (PROGN (PUSH #'CALL-NEXT-METHOD METHODS) (CALL-NEXT-METHOD)) (IF (EQ MODE 'LIST) (CONS 'INTEGER (CALL-NEXT-METHOD)) (CONS (CONS 'INTEGER (CALL-NEXT-METHOD 'LIST OBJECT)) (FUNCALL MODE))))) (FOO136 'STORE 3) (MULTIPLE-VALUE-BIND (T-ERROR-METHOD NUMBER-T-METHOD REAL-NUMBER-METHOD RATIONAL-REAL-METHOD INTEGER-RATIONAL-METHOD) (VALUES-LIST METHODS) (FOO136 #'(LAMBDA NIL (FUNCALL NUMBER-T-METHOD #'(LAMBDA NIL (FUNCALL INTEGER-RATIONAL-METHOD #'(LAMBDA NIL (FUNCALL REAL-NUMBER-METHOD #'(LAMBDA NIL NIL) 5)) 5)) 5)) 5)))
EQUAL-OK: ((INTEGER RATIONAL REAL NUMBER T) (T) (RATIONAL REAL NUMBER T) (NUMBER T))
(UNINTERN '<C1>)
EQL-OK: T
(PROGN (DEFCLASS <C1> NIL ((X :INITFORM 0 :ACCESSOR X-VAL :INITARG :X) (Y :INITFORM 1 :ACCESSOR Y-VAL :INITARG :Y))) NIL)
WARNING: The generic function #<STANDARD-GENERIC-FUNCTION X-VAL> is being modified, but has already been called.
WARNING: The generic function #<STANDARD-GENERIC-FUNCTION (SETF X-VAL)> is being modified, but has already been called.
WARNING: The generic function #<STANDARD-GENERIC-FUNCTION Y-VAL> is being modified, but has already been called.
EQL-OK: NIL
(DEFPARAMETER A (MAKE-INSTANCE (FIND-CLASS '<C1>) :X 10))
EQL-OK: A
(DEFPARAMETER B (MAKE-INSTANCE (FIND-CLASS '<C1>) :Y 20 :X 10))
EQL-OK: B
(DEFPARAMETER C (MAKE-INSTANCE (FIND-CLASS '<C1>)))
EQL-OK: C
(X-VAL A)
EQL-OK: 10
(Y-VAL A)
EQL-OK: 1
(X-VAL B)
EQL-OK: 10
(Y-VAL B)
EQL-OK: 20
(X-VAL C)
EQL-OK: 0
(Y-VAL C)
EQL-OK: 1
(UNINTERN '<C1>)
EQL-OK: T
(LET* ((C (DEFCLASS <C1> NIL ((X :INITFORM 0 :ACCESSOR X-VAL :INITARG :X) (Y :INITFORM 1 :ACCESSOR Y-VAL :INITARG :Y)))) (M (DEFMETHOD INITIALIZE-INSTANCE :AFTER ((INSTANCE <C1>) &REST INITVALUES) (IF (= (X-VAL INSTANCE) 0) (SETF (X-VAL INSTANCE) (Y-VAL INSTANCE)))))) (EQ M (FIND-METHOD #'INITIALIZE-INSTANCE '(:AFTER) (LIST C))))
WARNING: The generic function #<STANDARD-GENERIC-FUNCTION X-VAL> is being modified, but has already been called.
WARNING: The generic function #<STANDARD-GENERIC-FUNCTION Y-VAL> is being modified, but has already been called.
EQL-OK: T
(X-VAL (MAKE-INSTANCE (FIND-CLASS '<C1>)))
EQL-OK: 1
(X-VAL (MAKE-INSTANCE (FIND-CLASS '<C1>) :X 10))
EQL-OK: 10
(X-VAL (MAKE-INSTANCE (FIND-CLASS '<C1>) :Y 20))
EQL-OK: 20
(X-VAL (MAKE-INSTANCE (FIND-CLASS '<C1>) :X 10 :Y 20))
EQL-OK: 10
(LET ((M (DEFMETHOD INITIALIZE-INSTANCE ((INST <C1>) &REST IGNORE) (CALL-NEXT-METHOD) 123))) (EQ M (FIND-METHOD #'INITIALIZE-INSTANCE NIL (LIST (FIND-CLASS '<C1>)))))
EQL-OK: T
(X-VAL (MAKE-INSTANCE (FIND-CLASS '<C1>) :X 101 :Y 120))
EQL-OK: 101
(SETF (FIND-CLASS '<C1>) NIL)
EQL-OK: NIL
(UNINTERN '<C1>)
EQL-OK: T
(EQ (CLASS-OF NIL) (FIND-CLASS 'NULL))
EQL-OK: T
(EQ (CLASS-OF T) (FIND-CLASS 'SYMBOL))
EQL-OK: T
(EQ (CLASS-OF 10) (FIND-CLASS 'INTEGER))
EQL-OK: T
(EQ (CLASS-OF 10.0) (FIND-CLASS 'FLOAT))
EQL-OK: T
(EQ (CLASS-OF '(A B)) (FIND-CLASS 'CONS))
EQL-OK: T
(EQ (CLASS-OF "abc") (FIND-CLASS 'STRING))
EQL-OK: T
(EQ (CLASS-OF '#(1 2)) (FIND-CLASS 'VECTOR))
EQL-OK: T
(EQ (CLASS-OF #'CAR) (FIND-CLASS 'FUNCTION))
EQL-OK: T
(EQ (CLASS-OF #'MAKE-INSTANCE) (FIND-CLASS 'STANDARD-GENERIC-FUNCTION))
EQL-OK: T
(EQ (CLASS-OF '#2A((A) (B))) (FIND-CLASS 'ARRAY))
EQL-OK: T
(EQ (CLASS-OF *STANDARD-INPUT*) (FIND-CLASS 'STREAM))
EQL-OK: NIL
(EQ (CLASS-OF (LAMBDA (X) X)) (FIND-CLASS 'FUNCTION))
EQL-OK: T
(EQ (CLASS-OF (FIND-CLASS 'T)) (FIND-CLASS 'BUILT-IN-CLASS))
EQL-OK: T
(EQ (CLASS-OF (MAKE-ARRAY NIL)) (FIND-CLASS 'ARRAY))
EQL-OK: T
(EQ (CLASS-OF (MAKE-ARRAY NIL :ELEMENT-TYPE NIL)) (FIND-CLASS 'ARRAY))
EQL-OK: T
(EQ (CLASS-OF (MAKE-ARRAY 10 :ELEMENT-TYPE NIL)) (FIND-CLASS 'STRING))
EQL-OK: T
(TYPEP "abc" (FIND-CLASS 'T))
EQL-OK: T
(TYPEP "abc" (FIND-CLASS 'ARRAY))
EQL-OK: T
(TYPEP "abc" (FIND-CLASS 'VECTOR))
EQL-OK: T
(TYPEP "abc" (FIND-CLASS 'STRING))
EQL-OK: T
(TYPEP "abc" (FIND-CLASS 'INTEGER))
EQL-OK: NIL
(TYPEP 3 (FIND-CLASS 'T))
EQL-OK: T
(TYPEP 3 (FIND-CLASS 'NUMBER))
EQL-OK: T
(TYPEP 3 (FIND-CLASS 'FLOAT))
EQL-OK: NIL
(TYPEP 3 (FIND-CLASS 'INTEGER))
EQL-OK: T
(TYPEP 3 (FIND-CLASS 'STRING))
EQL-OK: NIL
(NOT (NOT (TYPEP *STANDARD-INPUT* (FIND-CLASS 'STREAM))))
EQL-OK: T
(DEFUN SUBCLASSP (CLASS1 CLASS2) (CLOS::SUBCLASSP CLASS1 CLASS2))
EQL-OK: SUBCLASSP
(SUBCLASSP (FIND-CLASS 'NUMBER) (FIND-CLASS 'T))
EQL-OK: T
(SUBCLASSP (FIND-CLASS 'INTEGER) (FIND-CLASS 'NUMBER))
EQL-OK: T
(SUBCLASSP (FIND-CLASS 'FLOAT) (FIND-CLASS 'NUMBER))
EQL-OK: T
(DEFUN MLF-TESTER (SYMBOL &OPTIONAL (LISP-FILE "clos-tst-make-load-form-demo.lisp")) (UNWIND-PROTECT (LET (COMPILED-FILE) (WITH-OPEN-FILE (STREAM LISP-FILE :DIRECTION :OUTPUT) (FORMAT STREAM "(in-package ~s)~%(defparameter ~S '#.~S)~%" (PACKAGE-NAME (SYMBOL-PACKAGE SYMBOL)) SYMBOL SYMBOL)) (SETQ COMPILED-FILE (COMPILE-FILE LISP-FILE)) (SETF (SYMBOL-VALUE SYMBOL) NIL) (LOAD COMPILED-FILE) (SYMBOL-VALUE SYMBOL)) (POST-COMPILE-FILE-CLEANUP LISP-FILE)))
EQL-OK: MLF-TESTER
(DEFUN MLF-KILL (TYPE) (LET ((M (FIND-METHOD #'MAKE-LOAD-FORM NIL (LIST (FIND-CLASS TYPE)) NIL))) (WHEN M (REMOVE-METHOD #'MAKE-LOAD-FORM M))) (SETF (FIND-CLASS TYPE) NIL))
EQL-OK: MLF-KILL
(PROGN (DEFCLASS TEST-CLASS1 NIL ((FOO :INITARG :FOO :ACCESSOR FOO :INITFORM 0))) (DEFCLASS TEST-CLASS2 NIL ((FOO :INITARG :FOO :ACCESSOR FOO :INITFORM 0))) (DEFMETHOD MAKE-LOAD-FORM ((OBJ TEST-CLASS1) &OPTIONAL ENVIRONMENT) (DECLARE (IGNORE ENVIRONMENT)) `(MAKE-INSTANCE 'TEST-CLASS1 :FOO ',(FOO OBJ))) (DEFMETHOD MAKE-LOAD-FORM ((OBJ TEST-CLASS2) &OPTIONAL ENVIRONMENT) (DECLARE (IGNORE ENVIRONMENT)) `(MAKE-INSTANCE 'TEST-CLASS2 :FOO ',(FOO OBJ))) (DEFPARAMETER *T-LIST* (LIST (MAKE-INSTANCE 'TEST-CLASS1 :FOO 100) (MAKE-INSTANCE 'TEST-CLASS2 :FOO 200))) (MLF-TESTER '*T-LIST*) (MAPCAR #'FOO *T-LIST*))
;; Compiling file /home/christoph/clisp/src/tests/clos-tst-make-load-form-demo.lisp ...
;; Wrote file /home/christoph/clisp/src/tests/clos-tst-make-load-form-demo.fas
0 errors, 0 warnings
;; Loading file /home/christoph/clisp/src/tests/clos-tst-make-load-form-demo.fas ...
;; Loaded file /home/christoph/clisp/src/tests/clos-tst-make-load-form-demo.fas
EQUAL-OK: (100 200)
(DEFSTRUCT FOO A)
EQL-OK: FOO
(PROGN (DEFMETHOD MAKE-LOAD-FORM ((X FOO) &OPTIONAL ENV) (MAKE-LOAD-FORM-SAVING-SLOTS X :ENVIRONMENT ENV)) (DEFPARAMETER *TMP-FILE* "clos-tst-mlf-tmp.lisp") (WITH-OPEN-FILE (S *TMP-FILE* :DIRECTION :OUTPUT) (FORMAT S "(defparameter *foo* '#S(FOO :A BAR-CONST))~%")) (LOAD (COMPILE-FILE *TMP-FILE*)) *FOO*)
;; Compiling file /home/christoph/clisp/src/tests/clos-tst-mlf-tmp.lisp ...
;; Wrote file /home/christoph/clisp/src/tests/clos-tst-mlf-tmp.fas
0 errors, 0 warnings
;; Loading file /home/christoph/clisp/src/tests/clos-tst-mlf-tmp.fas ...
;; Loaded file /home/christoph/clisp/src/tests/clos-tst-mlf-tmp.fas
EQUALP-OK: #S(FOO :A BAR-CONST)
(PROGN (MAKUNBOUND '*FOO*) (DEFCONSTANT BAR-CONST 1) (UNWIND-PROTECT (PROGN (LOAD (COMPILE-FILE *TMP-FILE*)) *FOO*) (POST-COMPILE-FILE-CLEANUP *TMP-FILE*) (MLF-KILL 'FOO)))
;; Compiling file /home/christoph/clisp/src/tests/clos-tst-mlf-tmp.lisp ...
;; Wrote file /home/christoph/clisp/src/tests/clos-tst-mlf-tmp.fas
0 errors, 0 warnings
;; Loading file /home/christoph/clisp/src/tests/clos-tst-mlf-tmp.fas ...
;; Loaded file /home/christoph/clisp/src/tests/clos-tst-mlf-tmp.fas
EQUALP-OK: #<FOO BAR-CONST>
(PROGN (DEFCLASS POS NIL ((X :INITARG :X :READER POS-X) (Y :INITARG :Y :READER POS-Y) (R :ACCESSOR POS-R))) (DEFMETHOD SHARED-INITIALIZE :AFTER ((SELF POS) IGNORE1 &REST IGNORE2) (DECLARE (IGNORE IGNORE1 IGNORE2)) (UNLESS (SLOT-BOUNDP SELF 'R) (SETF (POS-R SELF) (SQRT (+ (* (POS-X SELF) (POS-X SELF)) (* (POS-Y SELF) (POS-Y SELF))))))) (DEFMETHOD MAKE-LOAD-FORM ((SELF POS) &OPTIONAL ENVIRONMENT) (DECLARE (IGNORE ENVIRONMENT)) `(MAKE-INSTANCE ',(CLASS-NAME (CLASS-OF SELF)) :X ',(POS-X SELF) :Y ',(POS-Y SELF))) (SETQ *FOO* (MAKE-INSTANCE 'POS :X 3.0 :Y 4.0)) (MLF-TESTER '*FOO*) (LIST (POS-X *FOO*) (POS-Y *FOO*) (POS-R *FOO*)))
;; Compiling file /home/christoph/clisp/src/tests/clos-tst-make-load-form-demo.lisp ...
;; Wrote file /home/christoph/clisp/src/tests/clos-tst-make-load-form-demo.fas
0 errors, 0 warnings
;; Loading file /home/christoph/clisp/src/tests/clos-tst-make-load-form-demo.fas ...
;; Loaded file /home/christoph/clisp/src/tests/clos-tst-make-load-form-demo.fas
EQUAL-OK: (3.0 4.0 5.0)
(PROGN (DEFCLASS TREE-WITH-PARENT NIL ((PARENT :ACCESSOR TREE-PARENT) (CHILDREN :INITARG :CHILDREN))) (DEFMETHOD MAKE-LOAD-FORM ((X TREE-WITH-PARENT) &OPTIONAL ENVIRONMENT) (DECLARE (IGNORE ENVIRONMENT)) (VALUES `(MAKE-INSTANCE ',(CLASS-NAME (CLASS-OF X))) `(SETF (TREE-PARENT ',X) ',(SLOT-VALUE X 'PARENT) (SLOT-VALUE ',X 'CHILDREN) ',(SLOT-VALUE X 'CHILDREN)))) (SETQ *FOO* (MAKE-INSTANCE 'TREE-WITH-PARENT :CHILDREN (LIST (MAKE-INSTANCE 'TREE-WITH-PARENT :CHILDREN NIL) (MAKE-INSTANCE 'TREE-WITH-PARENT :CHILDREN NIL)))) (SETF (TREE-PARENT *FOO*) *FOO*) (DOLIST (CH (SLOT-VALUE *FOO* 'CHILDREN)) (SETF (TREE-PARENT CH) *FOO*)) (MLF-TESTER '*FOO*) (LIST (EQ *FOO* (TREE-PARENT *FOO*)) (EVERY (LAMBDA (X) (EQ X *FOO*)) (MAPCAR #'TREE-PARENT (SLOT-VALUE *FOO* 'CHILDREN))) (EVERY #'NULL (MAPCAR (LAMBDA (X) (SLOT-VALUE X 'CHILDREN)) (SLOT-VALUE *FOO* 'CHILDREN)))))
;; Compiling file /home/christoph/clisp/src/tests/clos-tst-make-load-form-demo.lisp ...
;; Wrote file /home/christoph/clisp/src/tests/clos-tst-make-load-form-demo.fas
0 errors, 0 warnings
;; Loading file /home/christoph/clisp/src/tests/clos-tst-make-load-form-demo.fas ...
;; Loaded file /home/christoph/clisp/src/tests/clos-tst-make-load-form-demo.fas
EQUAL-OK: (T T T)
(PROGN (DEFPARAMETER *INITFORM-EXECUTED-COUNTER* 0) (DEFSTRUCT FOO (SLOT-1 (INCF *INITFORM-EXECUTED-COUNTER*))) (DEFPARAMETER *FOO* (MAKE-FOO)))
EQL-OK: *FOO*
*FOO*
EQUALP-OK: #S(FOO :SLOT-1 1)
*INITFORM-EXECUTED-COUNTER*
EQL-OK: 1
(PROGN (MAPC #'EVAL (MULTIPLE-VALUE-LIST (MAKE-LOAD-FORM-SAVING-SLOTS *FOO*))) *INITFORM-EXECUTED-COUNTER*)
EQL-OK: 1
(PROGN (DEFMETHOD PRINT-OBJECT ((F FOO) (O STREAM)) (FORMAT O "~1t<~a>" (FOO-SLOT-1 F))) (PRIN1-TO-STRING (MAKE-FOO)))
EQUAL-OK: " <2>"
(PROGN (MLF-KILL 'FOO) NIL)
EQL-OK: NIL
(DEFSTRUCT FOO SLOT)
EQL-OK: FOO
(LET ((FILE "clos-tst.lisp") C) (UNWIND-PROTECT (PROGN (MAKUNBOUND '*FOO*) (WITH-OPEN-FILE (F FILE :DIRECTION :OUTPUT) (FORMAT F "(eval-when (compile load eval) (defstruct foo slot))~@
(defparameter *foo* #.(make-foo))~%")) (LOAD (SETQ C (COMPILE-FILE FILE))) *FOO*) (POST-COMPILE-FILE-CLEANUP FILE)))
;; Compiling file /home/christoph/clisp/src/tests/clos-tst.lisp ...
WARNING: (SETF FIND-CLASS): redefining class FOO in /home/christoph/clisp/src/tests/clos-tst.lisp, was defined in top-level
;; Wrote file /home/christoph/clisp/src/tests/clos-tst.fas
0 errors, 1 warning
;; Loading file /home/christoph/clisp/src/tests/clos-tst.fas ...
;; Loaded file /home/christoph/clisp/src/tests/clos-tst.fas
EQUALP-OK: #S(FOO :SLOT NIL)
(FLET ((WEAK-LIST-LENGTH (W) (IF W (SYSTEM::%RECORD-REF (SYSTEM::%RECORD-REF W 0) 1) 0))) (LET (OLD1-WEAKPOINTERS-COUNT OLD-SUBCLASSES-COUNT OLD2-WEAKPOINTERS-COUNT NEW-SUBCLASSES-COUNT NEW-WEAKPOINTERS-COUNT) (DEFCLASS FOO64A NIL NIL) (DEFCLASS FOO64B (FOO64A) NIL) (LET ((USYMBOL (GENSYM))) (EVAL `(DEFCLASS ,USYMBOL (FOO64A) NIL)) (SETQ OLD1-WEAKPOINTERS-COUNT (WEAK-LIST-LENGTH (CLOS::CLASS-FINALIZED-DIRECT-SUBCLASSES-TABLE (FIND-CLASS 'FOO64A)))) (SETF (SYMBOL-VALUE USYMBOL) (1- (LENGTH (CLOS::LIST-ALL-FINALIZED-SUBCLASSES (FIND-CLASS 'FOO64A))))) (SETQ OLD2-WEAKPOINTERS-COUNT (WEAK-LIST-LENGTH (CLOS::CLASS-FINALIZED-DIRECT-SUBCLASSES-TABLE (FIND-CLASS 'FOO64A)))) (SETQ OLD-SUBCLASSES-COUNT (SYMBOL-VALUE USYMBOL))) (GC) (SETQ NEW-SUBCLASSES-COUNT (1- (LENGTH (CLOS::LIST-ALL-FINALIZED-SUBCLASSES (FIND-CLASS 'FOO64A))))) (SETQ NEW-WEAKPOINTERS-COUNT (WEAK-LIST-LENGTH (CLOS::CLASS-FINALIZED-DIRECT-SUBCLASSES-TABLE (FIND-CLASS 'FOO64A)))) (LIST OLD1-WEAKPOINTERS-COUNT OLD-SUBCLASSES-COUNT OLD2-WEAKPOINTERS-COUNT NEW-SUBCLASSES-COUNT NEW-WEAKPOINTERS-COUNT)))
EQUAL-OK: (2 2 2 1 1)
(LET (OLD-WEAKPOINTERS-COUNT NEW-WEAKPOINTERS-COUNT) (DEFCLASS FOO64C NIL NIL) (DEFCLASS FOO64D (FOO64C) NIL) (LET ((USYMBOL (GENSYM))) (EVAL `(DEFCLASS ,USYMBOL (FOO64C) NIL)) (SETQ OLD-WEAKPOINTERS-COUNT (LENGTH (CLASS-DIRECT-SUBCLASSES (FIND-CLASS 'FOO64C)))) (SETF (SYMBOL-VALUE USYMBOL) NIL)) (GC) (SETQ NEW-WEAKPOINTERS-COUNT (LENGTH (CLASS-DIRECT-SUBCLASSES (FIND-CLASS 'FOO64C)))) (LIST OLD-WEAKPOINTERS-COUNT NEW-WEAKPOINTERS-COUNT))
EQUAL-OK: (2 1)
(PROGN (DEFCLASS ABSTRACT-POSITION NIL NIL) (DEFCLASS X-Y-POSITION (ABSTRACT-POSITION) ((NAME :INITARG :NAME) (X :INITFORM 0 :INITARG :X) (Y :INITFORM 0 :INITARG :Y))) (DEFCLASS RHO-THETA-POSITION (ABSTRACT-POSITION) ((NAME :INITARG :NAME) (RHO :INITFORM 0) (THETA :INITFORM 0))) (DEFMETHOD UPDATE-INSTANCE-FOR-DIFFERENT-CLASS :BEFORE ((OLD X-Y-POSITION) (NEW RHO-THETA-POSITION) &KEY) (LET ((X (SLOT-VALUE OLD 'X)) (Y (SLOT-VALUE OLD 'Y))) (SETF (SLOT-VALUE NEW 'RHO) (SQRT (+ (* X X) (* Y Y))) (SLOT-VALUE NEW 'THETA) (ATAN Y X)))) (SETQ P1 (MAKE-INSTANCE 'X-Y-POSITION :NAME 'FOO :X 2 :Y 0) P2 (MAKE-INSTANCE 'X-Y-POSITION :NAME 'BAR :X 1 :Y 1)) (CHANGE-CLASS P1 'RHO-THETA-POSITION) (CHANGE-CLASS P2 'RHO-THETA-POSITION) (LIST (SLOT-VALUE P1 'NAME) (SLOT-VALUE P1 'RHO) (SLOT-VALUE P1 'THETA) (SLOT-VALUE P2 'NAME) (SLOT-VALUE P2 'RHO) (SLOT-VALUE P2 'THETA)))
EQUAL-OK: (FOO 2 0 BAR 1.4142135 0.7853981)
(PROGN (DEFCLASS C0 NIL (A B C)) (DEFCLASS C1 NIL (B C A)) (SETQ I (MAKE-INSTANCE 'C0)) (SETF (SLOT-VALUE I 'A) 1 (SLOT-VALUE I 'B) 2 (SLOT-VALUE I 'C) 3) (CHANGE-CLASS I 'C1) (LIST (SLOT-VALUE I 'A) (SLOT-VALUE I 'B) (SLOT-VALUE I 'C)))
EQUAL-OK: (1 2 3)
(PROGN (DEFCLASS C1 NIL NIL) (DEFCLASS C2 NIL NIL) (LIST (LET ((C (MAKE-INSTANCE 'C1))) (LIST (TYPE-OF (CHANGE-CLASS C 'C2)) (TYPE-OF (CHANGE-CLASS C 'C1)))) (LET ((C (MAKE-INSTANCE 'C1))) (LIST (TYPE-OF (CHANGE-CLASS C 'C1)) (TYPE-OF (CHANGE-CLASS C 'C1))))))
WARNING: DEFCLASS: Class C1 (or one of its ancestors) is being redefined, instances are obsolete
EQUAL-OK: ((C2 C1) (C1 C1))
(PROGN (DEFCLASS C7 NIL ((NAME :INITARG :NAME))) (DEFCLASS C8 NIL ((PEOPLE :INITARG :PEOPLE) NAME)) (LET ((X (MAKE-INSTANCE 'C7 :NAME 'QUEEN-MARY))) (CHANGE-CLASS X 'C8 :PEOPLE 700) (LIST (SLOT-VALUE X 'NAME) (SLOT-VALUE X 'PEOPLE))))
EQUAL-OK: (QUEEN-MARY 700)
(PROGN (DEFCLASS C3 NIL (A B C)) (DEFCLASS C4 NIL (B C D E)) (LET* ((I (MAKE-INSTANCE 'C3)) (NSLOTS-BEFORE (SYSTEM::%RECORD-LENGTH I))) (CHANGE-CLASS I 'C4) (GC) (< NSLOTS-BEFORE (SYSTEM::%RECORD-LENGTH I))))
EQL-OK: T
(LET (C1 C2) (DEFCLASS FOO60-B NIL NIL) (DEFCLASS FOO60-A (FOO60-B) NIL) (MAKE-INSTANCE 'FOO60-B) (SETQ C1 (FIND-CLASS 'FOO60-A)) (DEFCLASS FOO60-A NIL NIL) (SETQ C2 (FIND-CLASS 'FOO60-A)) (EQ C1 C2))
EQL-OK: T
(LET (C1 C2) (DEFCLASS FOO61-A (FOO61-B) NIL) (SETQ C1 (FIND-CLASS 'FOO61-A)) (DEFCLASS FOO61-A NIL NIL) (SETQ C2 (FIND-CLASS 'FOO61-A)) (EQ C1 C2))
EQL-OK: T
(PROGN (DEFCLASS FOO62-B (FOO62-A) NIL) (DEFCLASS FOO62-C (FOO62-B) NIL) (DEFCLASS FOO62-A NIL NIL) (MAKE-INSTANCE 'FOO62-C) (LIST (SUBTYPEP 'FOO62-B 'FOO62-B) (SUBTYPEP 'FOO62-C 'FOO62-B) (SUBTYPEP 'FOO62-B 'FOO62-C)))
EQUAL-OK: (T T NIL)
(PROGN (DEFCLASS FOO63-B (FOO63-A) NIL) (DEFCLASS FOO63-C (FOO63-B) NIL) (DEFCLASS FOO63-A NIL NIL) (LIST (SUBTYPEP 'FOO63-B 'FOO63-B) (SUBTYPEP 'FOO63-C 'FOO63-B) (SUBTYPEP 'FOO63-B 'FOO63-C)))
EQUAL-OK: (T T NIL)
(LET (FA FB FC) (DEFCLASS FOO65A NIL NIL) (DEFCLASS FOO65B (FOO65A) NIL) (DEFCLASS FOO65C (FOO65B) NIL) (SETQ FA (CLASS-FINALIZED-P (FIND-CLASS 'FOO65A)) FB (CLASS-FINALIZED-P (FIND-CLASS 'FOO65B)) FC (CLASS-FINALIZED-P (FIND-CLASS 'FOO65C))) (DEFCLASS FOO65B (FOO65A FOO65OTHER) NIL) (LIST FA FB FC (CLASS-FINALIZED-P (FIND-CLASS 'FOO65A)) (CLASS-FINALIZED-P (FIND-CLASS 'FOO65B)) (CLASS-FINALIZED-P (FIND-CLASS 'FOO65C))))
EQUAL-OK: (T T T T NIL NIL)
(PROGN (DEFCLASS ABSTRACT-POSITION NIL NIL) (DEFCLASS X-Y-POSITION (ABSTRACT-POSITION) ((X :INITFORM 0 :ACCESSOR POSITION-X) (Y :INITFORM 0 :ACCESSOR POSITION-Y))) (SETF I (MAKE-INSTANCE 'X-Y-POSITION) (POSITION-X I) 1.0d0 (POSITION-Y I) 1.0d0) (TYPE-OF I))
WARNING: DEFCLASS: Class X-Y-POSITION (or one of its ancestors) is being redefined, instances are obsolete
EQL-OK: X-Y-POSITION
(PROGN (DEFMETHOD UPDATE-INSTANCE-FOR-REDEFINED-CLASS :BEFORE ((POS X-Y-POSITION) ADDED DELETED PLIST &KEY) (LET ((X (GETF PLIST 'X)) (Y (GETF PLIST 'Y))) (SETF (POSITION-RHO POS) (SQRT (+ (* X X) (* Y Y))) (POSITION-THETA POS) (ATAN Y X)))) (DEFCLASS X-Y-POSITION (ABSTRACT-POSITION) ((RHO :INITFORM 0 :ACCESSOR POSITION-RHO) (THETA :INITFORM 0 :ACCESSOR POSITION-THETA))) (DEFMETHOD POSITION-X ((POS X-Y-POSITION)) (WITH-SLOTS (RHO THETA) POS (* RHO (COS THETA)))) (DEFMETHOD (SETF POSITION-X) (NEW-X (POS X-Y-POSITION)) (WITH-SLOTS (RHO THETA) POS (LET ((Y (POSITION-Y POS))) (SETQ RHO (SQRT (+ (* NEW-X NEW-X) (* Y Y))) THETA (ATAN Y NEW-X)) NEW-X))) (DEFMETHOD POSITION-Y ((POS X-Y-POSITION)) (WITH-SLOTS (RHO THETA) POS (* RHO (SIN THETA)))) (DEFMETHOD (SETF POSITION-Y) (NEW-Y (POS X-Y-POSITION)) (WITH-SLOTS (RHO THETA) POS (LET ((X (POSITION-X POS))) (SETQ RHO (SQRT (+ (* X X) (* NEW-Y NEW-Y))) THETA (ATAN NEW-Y X)) NEW-Y))) (LIST (TYPE-OF I) (POSITION-X I) (POSITION-Y I) (POSITION-RHO I) (POSITION-THETA I)))
WARNING: The generic function #<STANDARD-GENERIC-FUNCTION (SETF POSITION-Y)> is being modified, but has already been called.
WARNING: Removing method #1=#<STANDARD-WRITER-METHOD (#2=#<BUILT-IN-CLASS T> #3=#<STANDARD-CLASS X-Y-POSITION :VERSION 1>)> in
#<STANDARD-GENERIC-FUNCTION (SETF POSITION-Y)>
WARNING: The generic function #<STANDARD-GENERIC-FUNCTION (SETF POSITION-X)> is being modified, but has already been called.
WARNING: Removing method #1=#<STANDARD-WRITER-METHOD (#2=#<BUILT-IN-CLASS T> #3=#<STANDARD-CLASS X-Y-POSITION :VERSION 1>)> in
#<STANDARD-GENERIC-FUNCTION (SETF POSITION-X)>
WARNING: DEFCLASS: Class X-Y-POSITION (or one of its ancestors) is being redefined, instances are obsolete
EQUAL-OK: (X-Y-POSITION 1.0000000000000002d0 1.0d0 1.4142135623730951d0 0.7853981633974483d0)
(MULTIPLE-VALUE-BIND (VALUE CONDITION) (IGNORE-ERRORS (DEFCLASS FOO70 NIL NIL) (SETQ I (MAKE-INSTANCE 'FOO70)) (DEFCLASS FOO70 NIL ((SIZE :INITARG :SIZE :INITFORM 1) (OTHER))) (SLOT-VALUE I 'SIZE)) (LIST VALUE (TYPEP CONDITION 'ERROR)))
WARNING: DEFCLASS: Class FOO70 (or one of its ancestors) is being redefined, instances are obsolete
EQUAL-OK: (1 NIL)
(MULTIPLE-VALUE-BIND (VALUE CONDITION) (IGNORE-ERRORS (DEFCLASS FOO71 NIL NIL) (SETQ I (MAKE-INSTANCE 'FOO71)) (DEFCLASS FOO71 NIL ((SIZE :INITARG :SIZE :INITFORM 1 :ALLOCATION :CLASS) (OTHER))) (SLOT-VALUE I 'SIZE)) (LIST VALUE (TYPEP CONDITION 'ERROR)))
WARNING: DEFCLASS: Class FOO71 (or one of its ancestors) is being redefined, instances are obsolete
EQUAL-OK: (1 NIL)
(MULTIPLE-VALUE-BIND (VALUE CONDITION) (IGNORE-ERRORS (DEFCLASS FOO72 NIL ((SIZE :INITARG :SIZE :INITFORM 1))) (SETQ I (MAKE-INSTANCE 'FOO72 :SIZE 5)) (DEFCLASS FOO72 NIL ((OTHER))) (SLOT-VALUE I 'SIZE)) (LIST VALUE (TYPEP CONDITION 'ERROR)))
WARNING: DEFCLASS: Class FOO72 (or one of its ancestors) is being redefined, instances are obsolete
EQUAL-OK: (NIL T)
(MULTIPLE-VALUE-BIND (VALUE CONDITION) (IGNORE-ERRORS (DEFCLASS FOO73 NIL ((SIZE :INITARG :SIZE :INITFORM 1 :ALLOCATION :CLASS))) (SETQ I (MAKE-INSTANCE 'FOO73)) (DEFCLASS FOO73 NIL ((OTHER))) (SLOT-VALUE I 'SIZE)) (LIST VALUE (TYPEP CONDITION 'ERROR)))
WARNING: DEFCLASS: Class FOO73 (or one of its ancestors) is being redefined, instances are obsolete
EQUAL-OK: (NIL T)
(MULTIPLE-VALUE-BIND (VALUE CONDITION) (IGNORE-ERRORS (DEFCLASS FOO74 NIL ((SIZE :INITARG :SIZE :INITFORM 1 :ALLOCATION :CLASS))) (SETQ I (MAKE-INSTANCE 'FOO74)) (DEFCLASS FOO74 NIL ((SIZE :INITARG :SIZE :INITFORM 2 :ALLOCATION :CLASS) (OTHER))) (SLOT-VALUE I 'SIZE)) (LIST VALUE (TYPEP CONDITION 'ERROR)))
WARNING: DEFCLASS: Class FOO74 (or one of its ancestors) is being redefined, instances are obsolete
EQUAL-OK: (1 NIL)
(MULTIPLE-VALUE-BIND (VALUE CONDITION) (IGNORE-ERRORS (DEFCLASS FOO75 NIL ((SIZE :INITARG :SIZE :INITFORM 1 :ALLOCATION :CLASS))) (SETQ I (MAKE-INSTANCE 'FOO75)) (DEFCLASS FOO75 NIL ((SIZE :INITARG :SIZE :INITFORM 2) (OTHER))) (SLOT-VALUE I 'SIZE)) (LIST VALUE (TYPEP CONDITION 'ERROR)))
WARNING: DEFCLASS: Class FOO75 (or one of its ancestors) is being redefined, instances are obsolete
EQUAL-OK: (1 NIL)
(MULTIPLE-VALUE-BIND (VALUE CONDITION) (IGNORE-ERRORS (DEFCLASS FOO76 NIL ((SIZE :INITARG :SIZE :INITFORM 1))) (SETQ I (MAKE-INSTANCE 'FOO76 :SIZE 5)) (DEFCLASS FOO76 NIL ((SIZE :INITARG :SIZE :INITFORM 2) (OTHER))) (SLOT-VALUE I 'SIZE)) (LIST VALUE (TYPEP CONDITION 'ERROR)))
WARNING: DEFCLASS: Class FOO76 (or one of its ancestors) is being redefined, instances are obsolete
EQUAL-OK: (5 NIL)
(MULTIPLE-VALUE-BIND (VALUE CONDITION) (IGNORE-ERRORS (DEFCLASS FOO77 NIL ((SIZE :INITARG :SIZE :INITFORM 1))) (SETQ I (MAKE-INSTANCE 'FOO77 :SIZE 5)) (DEFCLASS FOO77 NIL ((SIZE :INITARG :SIZE :INITFORM 2 :ALLOCATION :CLASS) (OTHER))) (SLOT-VALUE I 'SIZE)) (LIST VALUE (TYPEP CONDITION 'ERROR)))
WARNING: DEFCLASS: Class FOO77 (or one of its ancestors) is being redefined, instances are obsolete
EQUAL-OK: (2 NIL)
(MULTIPLE-VALUE-BIND (VALUE CONDITION) (IGNORE-ERRORS (DEFCLASS FOO80A NIL NIL) (DEFCLASS FOO80B (FOO80A) NIL) (SETQ I (MAKE-INSTANCE 'FOO80B)) (DEFCLASS FOO80A NIL ((SIZE :INITARG :SIZE :INITFORM 1) (OTHER))) (SLOT-VALUE I 'SIZE)) (LIST VALUE (TYPEP CONDITION 'ERROR)))
WARNING: DEFCLASS: Class FOO80B (or one of its ancestors) is being redefined, instances are obsolete
EQUAL-OK: (1 NIL)
(MULTIPLE-VALUE-BIND (VALUE CONDITION) (IGNORE-ERRORS (DEFCLASS FOO81A NIL NIL) (DEFCLASS FOO81B (FOO81A) NIL) (SETQ I (MAKE-INSTANCE 'FOO81B)) (DEFCLASS FOO81A NIL ((SIZE :INITARG :SIZE :INITFORM 1 :ALLOCATION :CLASS) (OTHER))) (SLOT-VALUE I 'SIZE)) (LIST VALUE (TYPEP CONDITION 'ERROR)))
WARNING: DEFCLASS: Class FOO81B (or one of its ancestors) is being redefined, instances are obsolete
EQUAL-OK: (1 NIL)
(MULTIPLE-VALUE-BIND (VALUE CONDITION) (IGNORE-ERRORS (DEFCLASS FOO82A NIL ((SIZE :INITARG :SIZE :INITFORM 1))) (DEFCLASS FOO82B (FOO82A) NIL) (SETQ I (MAKE-INSTANCE 'FOO82B :SIZE 5)) (DEFCLASS FOO82A NIL ((OTHER))) (SLOT-VALUE I 'SIZE)) (LIST VALUE (TYPEP CONDITION 'ERROR)))
WARNING: DEFCLASS: Class FOO82B (or one of its ancestors) is being redefined, instances are obsolete
EQUAL-OK: (NIL T)
(MULTIPLE-VALUE-BIND (VALUE CONDITION) (IGNORE-ERRORS (DEFCLASS FOO83A NIL ((SIZE :INITARG :SIZE :INITFORM 1 :ALLOCATION :CLASS))) (DEFCLASS FOO83B (FOO83A) NIL) (SETQ I (MAKE-INSTANCE 'FOO83B)) (DEFCLASS FOO83A NIL ((OTHER))) (SLOT-VALUE I 'SIZE)) (LIST VALUE (TYPEP CONDITION 'ERROR)))
WARNING: DEFCLASS: Class FOO83B (or one of its ancestors) is being redefined, instances are obsolete
EQUAL-OK: (NIL T)
(MULTIPLE-VALUE-BIND (VALUE CONDITION) (IGNORE-ERRORS (DEFCLASS FOO84A NIL ((SIZE :INITARG :SIZE :INITFORM 1 :ALLOCATION :CLASS))) (DEFCLASS FOO84B (FOO84A) NIL) (SETQ I (MAKE-INSTANCE 'FOO84B)) (DEFCLASS FOO84A NIL ((SIZE :INITARG :SIZE :INITFORM 2 :ALLOCATION :CLASS) (OTHER))) (SLOT-VALUE I 'SIZE)) (LIST VALUE (TYPEP CONDITION 'ERROR)))
WARNING: DEFCLASS: Class FOO84B (or one of its ancestors) is being redefined, instances are obsolete
EQUAL-OK: (1 NIL)
(MULTIPLE-VALUE-BIND (VALUE CONDITION) (IGNORE-ERRORS (DEFCLASS FOO85A NIL ((SIZE :INITARG :SIZE :INITFORM 1 :ALLOCATION :CLASS))) (DEFCLASS FOO85B (FOO85A) NIL) (SETQ I (MAKE-INSTANCE 'FOO85B)) (DEFCLASS FOO85A NIL ((SIZE :INITARG :SIZE :INITFORM 2) (OTHER))) (SLOT-VALUE I 'SIZE)) (LIST VALUE (TYPEP CONDITION 'ERROR)))
WARNING: DEFCLASS: Class FOO85B (or one of its ancestors) is being redefined, instances are obsolete
EQUAL-OK: (1 NIL)
(MULTIPLE-VALUE-BIND (VALUE CONDITION) (IGNORE-ERRORS (DEFCLASS FOO86A NIL ((SIZE :INITARG :SIZE :INITFORM 1))) (DEFCLASS FOO86B (FOO86A) NIL) (SETQ I (MAKE-INSTANCE 'FOO86B :SIZE 5)) (DEFCLASS FOO86A NIL ((SIZE :INITARG :SIZE :INITFORM 2) (OTHER))) (SLOT-VALUE I 'SIZE)) (LIST VALUE (TYPEP CONDITION 'ERROR)))
WARNING: DEFCLASS: Class FOO86B (or one of its ancestors) is being redefined, instances are obsolete
EQUAL-OK: (5 NIL)
(MULTIPLE-VALUE-BIND (VALUE CONDITION) (IGNORE-ERRORS (DEFCLASS FOO87A NIL ((SIZE :INITARG :SIZE :INITFORM 1))) (DEFCLASS FOO87B (FOO87A) NIL) (SETQ I (MAKE-INSTANCE 'FOO87B :SIZE 5)) (DEFCLASS FOO87A NIL ((SIZE :INITARG :SIZE :INITFORM 2 :ALLOCATION :CLASS) (OTHER))) (SLOT-VALUE I 'SIZE)) (LIST VALUE (TYPEP CONDITION 'ERROR)))
WARNING: DEFCLASS: Class FOO87B (or one of its ancestors) is being redefined, instances are obsolete
EQUAL-OK: (2 NIL)
(PROGN (DEFCLASS FOO88B (FOO88A) ((S :INITARG :S))) (DEFCLASS FOO88C (B) NIL) (DEFCLASS FOO88A NIL NIL) (LIST (LENGTH (CLOS::LIST-FINALIZED-DIRECT-SUBCLASSES (FIND-CLASS 'FOO88A))) (LENGTH (CLOS::LIST-FINALIZED-DIRECT-SUBCLASSES (FIND-CLASS 'FOO88B))) (LENGTH (CLOS::LIST-FINALIZED-DIRECT-SUBCLASSES (FIND-CLASS 'FOO88C)))))
EQUAL-OK: (0 0 0)
(PROGN (DEFCLASS FOO89B (FOO89A) ((S :INITARG :S))) (DEFCLASS FOO89C (B) NIL) (DEFCLASS FOO89A NIL NIL) (LET ((X (MAKE-INSTANCE 'FOO89B :S 5))) (LIST (LENGTH (CLOS::LIST-FINALIZED-DIRECT-SUBCLASSES (FIND-CLASS 'FOO89A))) (LENGTH (CLOS::LIST-FINALIZED-DIRECT-SUBCLASSES (FIND-CLASS 'FOO89B))) (LENGTH (CLOS::LIST-FINALIZED-DIRECT-SUBCLASSES (FIND-CLASS 'FOO89C))))))
EQUAL-OK: (1 0 0)
(PROGN (DEFCLASS FOO90B (FOO90A) ((S :INITARG :S))) (DEFCLASS FOO90C (FOO90B) NIL) (DEFCLASS FOO90A NIL NIL) (LET ((X (MAKE-INSTANCE 'FOO90B :S 5))) (DEFCLASS FOO90B NIL (S)) (LIST (LENGTH (CLOS::LIST-FINALIZED-DIRECT-SUBCLASSES (FIND-CLASS 'FOO90A))) (LENGTH (CLOS::LIST-FINALIZED-DIRECT-SUBCLASSES (FIND-CLASS 'FOO90B))) (LENGTH (CLOS::LIST-FINALIZED-DIRECT-SUBCLASSES (FIND-CLASS 'FOO90C))))))
WARNING: DEFCLASS: Class FOO90B (or one of its ancestors) is being redefined, instances are obsolete
EQUAL-OK: (0 0 0)
(PROGN (DEFCLASS FOO91A NIL NIL) (DEFCLASS FOO91B (FOO91A) NIL) (DEFCLASS FOO91C (FOO91B) NIL) (DEFCLASS FOO91B (FOO91A FOO91OTHER) NIL) (LIST (LENGTH (CLOS::LIST-FINALIZED-DIRECT-SUBCLASSES (FIND-CLASS 'FOO91A))) (LENGTH (CLOS::LIST-FINALIZED-DIRECT-SUBCLASSES (FIND-CLASS 'FOO91B))) (LENGTH (CLOS::LIST-FINALIZED-DIRECT-SUBCLASSES (FIND-CLASS 'FOO91C)))))
EQUAL-OK: (0 0 0)
(PROGN (DEFCLASS FOO92B (FOO92A) ((S :INITARG :S))) (DEFCLASS FOO92A NIL NIL) (LET ((X (MAKE-INSTANCE 'FOO92B :S 5)) (UPDATE-COUNTER 0)) (DEFCLASS FOO92B (FOO92A) ((S) (S1) (S2))) (SLOT-VALUE X 'S) (DEFMETHOD UPDATE-INSTANCE-FOR-REDEFINED-CLASS ((OBJECT FOO92B) ADDED-SLOTS DISCARDED-SLOTS PROPERTY-LIST &REST INITARGS) (INCF UPDATE-COUNTER)) (MAKE-INSTANCES-OBSOLETE 'FOO92A) (SLOT-VALUE X 'S) UPDATE-COUNTER))
WARNING: DEFCLASS: Class FOO92B (or one of its ancestors) is being redefined, instances are obsolete
WARNING: MAKE-INSTANCES-OBSOLETE: instances of class FOO92B are made obsolete
EQL-OK: 1
(PROGN (DEFCLASS FOO93B (FOO93A) ((S :INITARG :S))) (DEFCLASS FOO93A NIL NIL) (LET ((X (MAKE-INSTANCE 'FOO93B :S 5)) (UPDATE-COUNTER 0)) (DEFCLASS FOO93B NIL ((S) (S1) (S2))) (SLOT-VALUE X 'S) (DEFMETHOD UPDATE-INSTANCE-FOR-REDEFINED-CLASS ((OBJECT FOO93B) ADDED-SLOTS DISCARDED-SLOTS PROPERTY-LIST &REST INITARGS) (INCF UPDATE-COUNTER)) (MAKE-INSTANCES-OBSOLETE 'FOO93A) (SLOT-VALUE X 'S) UPDATE-COUNTER))
WARNING: DEFCLASS: Class FOO93B (or one of its ancestors) is being redefined, instances are obsolete
EQL-OK: 0
(PROGN (DEFCLASS FOO94 NIL ((A :READER FOO94-GET-A :WRITER FOO94-SET-A) (B :READER FOO94-GET-B :WRITER FOO94-SET-B) (C :ACCESSOR FOO94-C) (D :ACCESSOR FOO94-D) (E :ACCESSOR FOO94-E))) (LIST* (NOT (NULL (FIND-METHOD #'FOO94-GET-A 'NIL (LIST (FIND-CLASS 'FOO94)) NIL))) (NOT (NULL (FIND-METHOD #'FOO94-SET-A 'NIL (LIST (FIND-CLASS 'T) (FIND-CLASS 'FOO94)) NIL))) (NOT (NULL (FIND-METHOD #'FOO94-GET-B 'NIL (LIST (FIND-CLASS 'FOO94)) NIL))) (NOT (NULL (FIND-METHOD #'FOO94-SET-B 'NIL (LIST (FIND-CLASS 'T) (FIND-CLASS 'FOO94)) NIL))) (NOT (NULL (FIND-METHOD #'FOO94-C 'NIL (LIST (FIND-CLASS 'FOO94)) NIL))) (NOT (NULL (FIND-METHOD #'(SETF FOO94-C) 'NIL (LIST (FIND-CLASS 'T) (FIND-CLASS 'FOO94)) NIL))) (NOT (NULL (FIND-METHOD #'FOO94-D 'NIL (LIST (FIND-CLASS 'FOO94)) NIL))) (NOT (NULL (FIND-METHOD #'(SETF FOO94-D) 'NIL (LIST (FIND-CLASS 'T) (FIND-CLASS 'FOO94)) NIL))) (NOT (NULL (FIND-METHOD #'FOO94-E 'NIL (LIST (FIND-CLASS 'FOO94)) NIL))) (NOT (NULL (FIND-METHOD #'(SETF FOO94-E) 'NIL (LIST (FIND-CLASS 'T) (FIND-CLASS 'FOO94)) NIL))) (PROGN (DEFCLASS FOO94 NIL ((A :READER FOO94-GET-A :WRITER FOO94-SET-A) (B) (C :ACCESSOR FOO94-C) (E :ACCESSOR FOO94-OTHER-E))) (LIST (NOT (NULL (FIND-METHOD #'FOO94-GET-A 'NIL (LIST (FIND-CLASS 'FOO94)) NIL))) (NOT (NULL (FIND-METHOD #'FOO94-SET-A 'NIL (LIST (FIND-CLASS 'T) (FIND-CLASS 'FOO94)) NIL))) (NOT (NULL (FIND-METHOD #'FOO94-GET-B 'NIL (LIST (FIND-CLASS 'FOO94)) NIL))) (NOT (NULL (FIND-METHOD #'FOO94-SET-B 'NIL (LIST (FIND-CLASS 'T) (FIND-CLASS 'FOO94)) NIL))) (NOT (NULL (FIND-METHOD #'FOO94-C 'NIL (LIST (FIND-CLASS 'FOO94)) NIL))) (NOT (NULL (FIND-METHOD #'(SETF FOO94-C) 'NIL (LIST (FIND-CLASS 'T) (FIND-CLASS 'FOO94)) NIL))) (NOT (NULL (FIND-METHOD #'FOO94-D 'NIL (LIST (FIND-CLASS 'FOO94)) NIL))) (NOT (NULL (FIND-METHOD #'(SETF FOO94-D) 'NIL (LIST (FIND-CLASS 'T) (FIND-CLASS 'FOO94)) NIL))) (NOT (NULL (FIND-METHOD #'FOO94-E 'NIL (LIST (FIND-CLASS 'FOO94)) NIL))) (NOT (NULL (FIND-METHOD #'(SETF FOO94-E) 'NIL (LIST (FIND-CLASS 'T) (FIND-CLASS 'FOO94)) NIL)))))))
EQUAL-OK: (T T T T T T T T T T T T NIL NIL T T NIL NIL NIL NIL)
(PROGN (DEFCLASS FOO95B NIL ((S :INITARG :S :ACCESSOR FOO95B-S))) (DEFCLASS FOO95B (FOO95A) ((S :ACCESSOR FOO95B-S))) T)
EQL-OK: T
(LET ((NOTES 'NIL)) (FLET ((NOTE (O) (SETQ NOTES (APPEND NOTES (LIST O))))) (DEFCLASS FOO96B NIL ((S :INITARG :S :ACCESSOR FOO96B-S))) (LET ((X (MAKE-INSTANCE 'FOO96B :S 5))) (NOTE (FOO96B-S X)) (NOTE (TYPEP (SECOND (MULTIPLE-VALUE-LIST (IGNORE-ERRORS (DEFCLASS FOO96B (FOO96A) ((S :ACCESSOR FOO96B-S)))))) 'ERROR)) (NOTE (FOO96B-S X)) (NOTE (SLOT-VALUE X 'S)) (DEFCLASS FOO96A NIL ((R :ACCESSOR FOO96B-R))) (NOTE (FOO96B-S X)) (NOTE (SLOT-VALUE X 'S)) (NOTE (SUBTYPEP 'FOO96B 'FOO96A)) NOTES)))
WARNING: The generic function #<STANDARD-GENERIC-FUNCTION FOO96B-S> is being modified, but has already been called.
WARNING: Removing method #1=#<STANDARD-READER-METHOD (#2=#<STANDARD-CLASS FOO96B>)> in #<STANDARD-GENERIC-FUNCTION FOO96B-S>
WARNING: DEFCLASS: Class FOO96B (or one of its ancestors) is being redefined, instances are obsolete
EQUAL-OK: (5 T 5 5 5 5 NIL)
(LET ((NOTES 'NIL)) (FLET ((NOTE (O) (SETQ NOTES (APPEND NOTES (LIST O))))) (DEFCLASS FOO97B NIL ((S :INITARG :S :ACCESSOR FOO97B-S))) (LET ((X (MAKE-INSTANCE 'FOO97B :S 5))) (NOTE (FOO97B-S X)) (NOTE (TYPEP (SECOND (MULTIPLE-VALUE-LIST (IGNORE-ERRORS (DEFCLASS FOO97B (FOO97A) ((S :ACCESSOR FOO97B-S)))))) 'ERROR)) (NOTE (FOO97B-S X)) (NOTE (SLOT-VALUE X 'S)) (DEFCLASS FOO97A NIL ((R :ACCESSOR FOO97B-R))) (NOTE (FOO97B-S X)) (NOTE (SLOT-VALUE X 'S)) (NOTE (SUBTYPEP 'FOO97B 'FOO97A)) NOTES)))
WARNING: The generic function #<STANDARD-GENERIC-FUNCTION FOO97B-S> is being modified, but has already been called.
WARNING: Removing method #1=#<STANDARD-READER-METHOD (#2=#<STANDARD-CLASS FOO97B>)> in #<STANDARD-GENERIC-FUNCTION FOO97B-S>
WARNING: DEFCLASS: Class FOO97B (or one of its ancestors) is being redefined, instances are obsolete
EQUAL-OK: (5 T 5 5 5 5 NIL)
(PROGN (DEFCLASS FOO100 NIL (A B C) (:FIXED-SLOT-LOCATIONS T)) (MAPCAR #'(LAMBDA (NAME) (LET ((SLOT (FIND NAME (CLASS-SLOTS (FIND-CLASS 'FOO100)) :KEY #'SLOT-DEFINITION-NAME))) (SLOT-DEFINITION-LOCATION SLOT))) '(A B C)))
EQUAL-OK: (1 2 3)
(PROGN (DEFCLASS FOO101A NIL (A B C) (:FIXED-SLOT-LOCATIONS T)) (DEFCLASS FOO101B (FOO101A) (D E F) (:FIXED-SLOT-LOCATIONS T)) (MAPCAR #'(LAMBDA (NAME) (LET ((SLOT (FIND NAME (CLASS-SLOTS (FIND-CLASS 'FOO101B)) :KEY #'SLOT-DEFINITION-NAME))) (SLOT-DEFINITION-LOCATION SLOT))) '(A B C D E F)))
EQUAL-OK: (1 2 3 4 5 6)
(PROGN (DEFCLASS FOO102A NIL (A B C) (:FIXED-SLOT-LOCATIONS T)) (DEFCLASS FOO102B NIL (D E F)) (DEFCLASS FOO102C (FOO102A FOO102B) (G H I)) (MAPCAR #'(LAMBDA (NAME) (LET ((SLOT (FIND NAME (CLASS-SLOTS (FIND-CLASS 'FOO102C)) :KEY #'SLOT-DEFINITION-NAME))) (SLOT-DEFINITION-LOCATION SLOT))) '(A B C D E F G H I)))
EQUAL-OK: (1 2 3 4 5 6 7 8 9)
(PROGN (DEFCLASS FOO103A NIL (A B C)) (DEFCLASS FOO103B NIL (D E F) (:FIXED-SLOT-LOCATIONS T)) (DEFCLASS FOO103C (FOO103A FOO103B) (G H I)) (MAPCAR #'(LAMBDA (NAME) (LET ((SLOT (FIND NAME (CLASS-SLOTS (FIND-CLASS 'FOO103C)) :KEY #'SLOT-DEFINITION-NAME))) (SLOT-DEFINITION-LOCATION SLOT))) '(A B C D E F G H I)))
EQUAL-OK: (4 5 6 1 2 3 7 8 9)
(PROGN (DEFCLASS FOO104A NIL (A B C) (:FIXED-SLOT-LOCATIONS T)) (DEFCLASS FOO104B NIL (D E F) (:FIXED-SLOT-LOCATIONS T)) (DEFCLASS FOO104C (FOO104A FOO104B) (G H I)) T)
[SIMPLE-ERROR]: In class FOO104C, the slots D and A are constrained from the superclasses to both be located at offset 1.
EQL-OK: ERROR
(PROGN (DEFCLASS FOO105A NIL (A B C) (:FIXED-SLOT-LOCATIONS T)) (DEFCLASS FOO105B NIL NIL (:FIXED-SLOT-LOCATIONS T)) (DEFCLASS FOO105C (FOO105A FOO105B) (G H I)) (MAPCAR #'(LAMBDA (NAME) (LET ((SLOT (FIND NAME (CLASS-SLOTS (FIND-CLASS 'FOO105C)) :KEY #'SLOT-DEFINITION-NAME))) (SLOT-DEFINITION-LOCATION SLOT))) '(A B C G H I)))
EQUAL-OK: (1 2 3 4 5 6)
(PROGN (DEFCLASS FOO106A NIL NIL (:FIXED-SLOT-LOCATIONS T)) (DEFCLASS FOO106B NIL (D E F) (:FIXED-SLOT-LOCATIONS T)) (DEFCLASS FOO106C (FOO106A FOO106B) (G H I)) (MAPCAR #'(LAMBDA (NAME) (LET ((SLOT (FIND NAME (CLASS-SLOTS (FIND-CLASS 'FOO106C)) :KEY #'SLOT-DEFINITION-NAME))) (SLOT-DEFINITION-LOCATION SLOT))) '(D E F G H I)))
EQUAL-OK: (1 2 3 4 5 6)
(PROGN (DEFCLASS FOO107A NIL ((A :ALLOCATION :INSTANCE) (B :ALLOCATION :INSTANCE) (C :ALLOCATION :CLASS) (D :ALLOCATION :CLASS) (E :ALLOCATION :CLASS)) (:FIXED-SLOT-LOCATIONS T)) (DEFCLASS FOO107B (FOO107A) ((B :ALLOCATION :CLASS))) T)
[SIMPLE-ERROR]: In class FOO107B, non-local slot B is constrained to be a local slot at offset 2.
EQL-OK: ERROR
(PROGN (DEFCLASS FOO108A NIL ((A :ALLOCATION :INSTANCE) (B :ALLOCATION :INSTANCE) (C :ALLOCATION :CLASS) (D :ALLOCATION :CLASS) (E :ALLOCATION :CLASS)) (:FIXED-SLOT-LOCATIONS T)) (DEFCLASS FOO108B (FOO108A) ((C :ALLOCATION :INSTANCE) (D :ALLOCATION :CLASS) (F :ALLOCATION :INSTANCE) (G :ALLOCATION :CLASS))) (MAPCAR #'(LAMBDA (NAME) (LET ((SLOT (FIND NAME (CLASS-SLOTS (FIND-CLASS 'FOO108B)) :KEY #'SLOT-DEFINITION-NAME))) (LET ((LOCATION (SLOT-DEFINITION-LOCATION SLOT))) (IF (CONSP LOCATION) (CLASS-NAME (CLOS::CV-NEWEST-CLASS (CAR LOCATION))) LOCATION)))) '(A B C D E F G)))
EQUAL-OK: (1 2 3 FOO108B FOO108A 4 FOO108B)
(LET ((CLASS1 (DEFCLASS FOO109 NIL NIL (:DOCUMENTATION "first")))) (CONS (DOCUMENTATION CLASS1 'T) (PROGN (SETF (FIND-CLASS 'FOO109) NIL) (LET ((CLASS2 (DEFCLASS FOO109 NIL NIL (:DOCUMENTATION "second")))) (LIST (DOCUMENTATION CLASS1 'T) (DOCUMENTATION CLASS2 'T))))))
EQUAL-OK: ("first" "first" "second")
(DEFCLASS FOO116 NIL NIL (:NAME BAR))
[SIMPLE-SOURCE-PROGRAM-ERROR]: DEFCLASS FOO116: invalid option #1=(:NAME BAR)
EQL-OK: ERROR
(DEFCLASS FOO117 NIL NIL (:DIRECT-SUPERCLASSES BAZ))
[SIMPLE-SOURCE-PROGRAM-ERROR]: DEFCLASS FOO117: invalid option #1=(:DIRECT-SUPERCLASSES BAZ)
EQL-OK: ERROR
(DEFCLASS FOO118 NIL NIL (:DIRECT-SLOTS X))
[SIMPLE-SOURCE-PROGRAM-ERROR]: DEFCLASS FOO118: invalid option #1=(:DIRECT-SLOTS X)
EQL-OK: ERROR
(DEFCLASS FOO119 NIL NIL (:DIRECT-DEFAULT-INITARGS (:X 5)))
[SIMPLE-SOURCE-PROGRAM-ERROR]: DEFCLASS FOO119: invalid option #1=(:DIRECT-DEFAULT-INITARGS (:X 5))
EQL-OK: ERROR
(DEFCLASS FOO120 NIL NIL (:OTHER-OPTION BLABLA))
[SIMPLE-SOURCE-PROGRAM-ERROR]: DEFCLASS FOO120: invalid option #1=(:OTHER-OPTION BLABLA)
EQL-OK: ERROR
(DEFCLASS FOO121 NIL ((X :NAME BAR)))
[SIMPLE-SOURCE-PROGRAM-ERROR]: DEFCLASS FOO121, slot option for slot X: :NAME is not a valid slot option
EQL-OK: ERROR
(DEFCLASS FOO122 NIL ((X :READERS (BAR))))
[SIMPLE-SOURCE-PROGRAM-ERROR]: DEFCLASS FOO122, slot option for slot X: :READERS is not a valid slot option
EQL-OK: ERROR
(DEFCLASS FOO123 NIL ((X :WRITERS (BAR))))
[SIMPLE-SOURCE-PROGRAM-ERROR]: DEFCLASS FOO123, slot option for slot X: :WRITERS is not a valid slot option
EQL-OK: ERROR
(DEFCLASS FOO124 NIL ((X :INITARGS (BAR))))
[SIMPLE-SOURCE-PROGRAM-ERROR]: DEFCLASS FOO124, slot option for slot X: :INITARGS is not a valid slot option
EQL-OK: ERROR
(DEFCLASS FOO125 NIL ((X :INITFORM 17 :INITFUNCTION (LAMBDA NIL 42))))
[SIMPLE-SOURCE-PROGRAM-ERROR]: DEFCLASS FOO125, slot option for slot X: :INITFUNCTION is not a valid slot option
EQL-OK: ERROR
(PROGN (DEFCLASS TESTCLASS31A NIL NIL) (DEFCLASS TESTCLASS31B (TESTCLASS31A) NIL) (DEFCLASS TESTCLASS31C (TESTCLASS31B) NIL) (LET ((*P* (MAKE-INSTANCE 'TESTCLASS31C))) (DEFGENERIC TESTGF37 (X)) (DEFMETHOD TESTGF37 ((X TESTCLASS31A)) (LIST 'A)) (DEFMETHOD TESTGF37 ((X TESTCLASS31B)) (CONS 'B (CALL-NEXT-METHOD))) (DEFMETHOD TESTGF37 ((X TESTCLASS31C)) (CONS 'C (CALL-NEXT-METHOD))) (DEFMETHOD TESTGF37 ((X (EQL *P*))) (CONS '*P* (CALL-NEXT-METHOD))) (LIST (TESTGF37 *P*) (PROGN (CHANGE-CLASS *P* 'TESTCLASS31B) (TESTGF37 *P*)))))
EQUAL-OK: ((*P* C B A) (*P* B A))
(PROGN (DEFCLASS TESTCLASS40A NIL NIL) (DEFCLASS TESTCLASS40B NIL NIL) (DEFCLASS TESTCLASS40C (TESTCLASS40B) NIL) (DEFGENERIC TESTGF40 (X) (:METHOD-COMBINATION LIST)) (DEFMETHOD TESTGF40 LIST ((X STANDARD-OBJECT)) 0) (DEFMETHOD TESTGF40 LIST ((X TESTCLASS40A)) 'A) (LET ((INST (MAKE-INSTANCE 'TESTCLASS40C))) (LIST (TESTGF40 INST) (PROGN (DEFCLASS TESTCLASS40B (TESTCLASS40A) NIL) (TESTGF40 INST)))))
WARNING: DEFCLASS: Class TESTCLASS40C (or one of its ancestors) is being redefined, instances are obsolete
EQUAL-OK: ((0) (A 0))
(PROGN (DEFCLASS TESTCLASS41A NIL NIL) (DEFCLASS TESTCLASS41B (TESTCLASS41A) NIL) (DEFCLASS TESTCLASS41C (TESTCLASS41B) NIL) (DEFGENERIC TESTGF41 (X) (:METHOD-COMBINATION LIST)) (DEFMETHOD TESTGF41 LIST ((X STANDARD-OBJECT)) 0) (DEFMETHOD TESTGF41 LIST ((X TESTCLASS41A)) 'A) (LET ((INST (MAKE-INSTANCE 'TESTCLASS41C))) (LIST (TESTGF41 INST) (PROGN (DEFCLASS TESTCLASS41B NIL NIL) (TESTGF41 INST)))))
WARNING: DEFCLASS: Class TESTCLASS41C (or one of its ancestors) is being redefined, instances are obsolete
EQUAL-OK: ((A 0) (0))
(PROGN (DEFCLASS TESTCLASS42A NIL NIL) (DEFCLASS TESTCLASS42B NIL NIL) (DEFCLASS TESTCLASS42C (TESTCLASS42A TESTCLASS42B) NIL) (DEFGENERIC TESTGF42 (X)) (DEFMETHOD TESTGF42 ((X TESTCLASS42A)) 'A) (DEFMETHOD TESTGF42 ((X TESTCLASS42B)) 'B) (LET ((INST (MAKE-INSTANCE 'TESTCLASS42C))) (LIST (TESTGF42 INST) (PROGN (DEFCLASS TESTCLASS42C (TESTCLASS42B TESTCLASS42A) NIL) (TESTGF42 INST)))))
WARNING: DEFCLASS: Class TESTCLASS42C (or one of its ancestors) is being redefined, instances are obsolete
EQUAL-OK: (A B)
(PROGN (DEFCLASS TESTCLASS45A NIL NIL) (DEFCLASS TESTCLASS45B NIL NIL) (DEFCLASS TESTCLASS45C (TESTCLASS45B) NIL) (LET ((INST (MAKE-INSTANCE 'TESTCLASS45C))) (DEFGENERIC TESTGF45 (X) (:METHOD-COMBINATION LIST)) (DEFMETHOD TESTGF45 LIST ((X TESTCLASS45A)) 'A) (DEFMETHOD TESTGF45 LIST ((X (EQL INST))) 'INST) (LIST (TESTGF45 INST) (PROGN (DEFCLASS TESTCLASS45B (TESTCLASS45A) NIL) (TESTGF45 INST)))))
WARNING: DEFCLASS: Class TESTCLASS45C (or one of its ancestors) is being redefined, instances are obsolete
EQUAL-OK: ((INST) (INST A))
(PROGN (DEFCLASS TESTCLASS46A NIL NIL) (DEFCLASS TESTCLASS46B (TESTCLASS46A) NIL) (DEFCLASS TESTCLASS46C (TESTCLASS46B) NIL) (LET ((INST (MAKE-INSTANCE 'TESTCLASS46C))) (DEFGENERIC TESTGF46 (X) (:METHOD-COMBINATION LIST)) (DEFMETHOD TESTGF46 LIST ((X TESTCLASS46A)) 'A) (DEFMETHOD TESTGF46 LIST ((X (EQL INST))) 'INST) (LIST (TESTGF46 INST) (PROGN (DEFCLASS TESTCLASS46B NIL NIL) (TESTGF46 INST)))))
WARNING: DEFCLASS: Class TESTCLASS46C (or one of its ancestors) is being redefined, instances are obsolete
EQUAL-OK: ((INST A) (INST))
(PROGN (DEFCLASS TESTCLASS47A NIL NIL) (DEFCLASS TESTCLASS47B NIL NIL) (DEFCLASS TESTCLASS47C (TESTCLASS47A TESTCLASS47B) NIL) (LET ((INST (MAKE-INSTANCE 'TESTCLASS47C))) (DEFGENERIC TESTGF47 (X)) (DEFMETHOD TESTGF47 ((X TESTCLASS47A)) 'A) (DEFMETHOD TESTGF47 ((X TESTCLASS47B)) 'B) (DEFMETHOD TESTGF47 ((X (EQL INST))) (LIST 'INST (CALL-NEXT-METHOD))) (LIST (TESTGF47 INST) (PROGN (DEFCLASS TESTCLASS47C (TESTCLASS47B TESTCLASS47A) NIL) (TESTGF47 INST)))))
WARNING: DEFCLASS: Class TESTCLASS47C (or one of its ancestors) is being redefined, instances are obsolete
EQUAL-OK: ((INST A) (INST B))
(PROGN (DEFCLASS TESTCLASS48A NIL NIL) (DEFCLASS TESTCLASS48B NIL NIL) (DEFCLASS TESTCLASS48C (TESTCLASS48B) NIL) (LET ((INST (MAKE-INSTANCE 'STANDARD-OBJECT))) (DEFGENERIC TESTGF48 (X) (:METHOD-COMBINATION LIST)) (DEFMETHOD TESTGF48 LIST ((X TESTCLASS48A)) 'A) (DEFMETHOD TESTGF48 LIST ((X (EQL INST))) 'INST) (CHANGE-CLASS INST 'TESTCLASS48C) (LIST (TESTGF48 INST) (PROGN (DEFCLASS TESTCLASS48B (TESTCLASS48A) NIL) (TESTGF48 INST)))))
WARNING: DEFCLASS: Class TESTCLASS48C (or one of its ancestors) is being redefined, instances are obsolete
EQUAL-OK: ((INST) (INST A))
(PROGN (DEFCLASS TESTCLASS49A NIL NIL) (DEFCLASS TESTCLASS49B (TESTCLASS49A) NIL) (DEFCLASS TESTCLASS49C (TESTCLASS49B) NIL) (LET ((INST (MAKE-INSTANCE 'STANDARD-OBJECT))) (DEFGENERIC TESTGF49 (X) (:METHOD-COMBINATION LIST)) (DEFMETHOD TESTGF49 LIST ((X TESTCLASS49A)) 'A) (DEFMETHOD TESTGF49 LIST ((X (EQL INST))) 'INST) (CHANGE-CLASS INST 'TESTCLASS49C) (LIST (TESTGF49 INST) (PROGN (DEFCLASS TESTCLASS49B NIL NIL) (TESTGF49 INST)))))
WARNING: DEFCLASS: Class TESTCLASS49C (or one of its ancestors) is being redefined, instances are obsolete
EQUAL-OK: ((INST A) (INST))
(PROGN (DEFCLASS TESTCLASS50A NIL NIL) (DEFCLASS TESTCLASS50B NIL NIL) (DEFCLASS TESTCLASS50C (TESTCLASS50A TESTCLASS50B) NIL) (LET ((INST (MAKE-INSTANCE 'STANDARD-OBJECT))) (DEFGENERIC TESTGF50 (X)) (DEFMETHOD TESTGF50 ((X TESTCLASS50A)) 'A) (DEFMETHOD TESTGF50 ((X TESTCLASS50B)) 'B) (DEFMETHOD TESTGF50 ((X (EQL INST))) (LIST 'INST (CALL-NEXT-METHOD))) (CHANGE-CLASS INST 'TESTCLASS50C) (LIST (TESTGF50 INST) (PROGN (DEFCLASS TESTCLASS50C (TESTCLASS50B TESTCLASS50A) NIL) (TESTGF50 INST)))))
WARNING: DEFCLASS: Class TESTCLASS50C (or one of its ancestors) is being redefined, instances are obsolete
EQUAL-OK: ((INST A) (INST B))
(ENSURE-GENERIC-FUNCTION 'CAR)
[SIMPLE-PROGRAM-ERROR]: ENSURE-GENERIC-FUNCTION: CAR does not name a generic function
EQL-OK: ERROR
(ENSURE-GENERIC-FUNCTION 'DEFCLASS)
[SIMPLE-PROGRAM-ERROR]: ENSURE-GENERIC-FUNCTION: DEFCLASS does not name a generic function
EQL-OK: ERROR
(ENSURE-GENERIC-FUNCTION 'TAGBODY)
[SIMPLE-PROGRAM-ERROR]: ENSURE-GENERIC-FUNCTION: TAGBODY does not name a generic function
EQL-OK: ERROR
(LET ((F 'EGF-FUN)) (WHEN (FBOUNDP F) (FMAKUNBOUND F)) (LIST (FBOUNDP F) (TYPEP (ENSURE-GENERIC-FUNCTION F) 'GENERIC-FUNCTION) (TYPEP (ENSURE-GENERIC-FUNCTION F) 'GENERIC-FUNCTION) (TYPEP (SYMBOL-FUNCTION F) 'GENERIC-FUNCTION)))
EQUAL-OK: (NIL T T T)
(LET ((F 'EGF-FUN)) (WHEN (FBOUNDP F) (FMAKUNBOUND F)) (LIST (FBOUNDP F) (TYPEP (ENSURE-GENERIC-FUNCTION F :LAMBDA-LIST '(A B C)) 'GENERIC-FUNCTION) (TYPEP (ENSURE-GENERIC-FUNCTION F :LAMBDA-LIST '(X Y)) 'GENERIC-FUNCTION) (TYPEP (SYMBOL-FUNCTION F) 'GENERIC-FUNCTION)))
EQUAL-OK: (NIL T T T)
(LET ((F 'EGF-FUN)) (WHEN (FBOUNDP F) (FMAKUNBOUND F)) (LIST (FBOUNDP F) (TYPEP (ENSURE-GENERIC-FUNCTION F :LAMBDA-LIST '(A B C)) 'GENERIC-FUNCTION) (TYPEP (EVAL `(DEFMETHOD ,F ((A T) (B T) (C T)) (LIST A B C))) 'STANDARD-METHOD)))
EQUAL-OK: (NIL T T)
(ENSURE-GENERIC-FUNCTION 'EGF-FUN :LAMBDA-LIST '(X Y))
[SIMPLE-ERROR]: #1=#<STANDARD-METHOD (#2=#<BUILT-IN-CLASS T> #2# #2#)> has 3, but #3=#<STANDARD-GENERIC-FUNCTION EGF-FUN> has 2 required parameters
EQL-OK: ERROR
(LET ((C1 (GENSYM)) (C2 (GENSYM))) (LET ((CLASS1 (EVAL `(DEFCLASS ,C1 (,C2) NIL)))) (IF (NOT (TYPEP CLASS1 'CLASS)) 1 (LET ((CLASS2 (EVAL `(DEFCLASS ,C2 NIL NIL)))) (IF (NOT (TYPEP CLASS2 'CLASS)) 2 (LET ((I1 (MAKE-INSTANCE C1)) (I2 (MAKE-INSTANCE C2))) (COND ((NOT (TYPEP I1 C1)) 3) ((NOT (TYPEP I1 CLASS1)) 4) ((NOT (TYPEP I1 C2)) 5) ((NOT (TYPEP I1 CLASS2)) 6) ((TYPEP I2 C1) 7) ((TYPEP I2 CLASS1) 8) ((NOT (TYPEP I2 C2)) 9) ((NOT (TYPEP I2 CLASS2)) 10) (T 'GOOD))))))))
EQL-OK: GOOD
(LET ((C1 (GENSYM)) (C2 (GENSYM)) (C3 (GENSYM))) (LET ((CLASS1 (EVAL `(DEFCLASS ,C1 (,C2 ,C3) NIL)))) (IF (NOT (TYPEP CLASS1 'CLASS)) 1 (LET ((CLASS2 (EVAL `(DEFCLASS ,C2 NIL NIL)))) (IF (NOT (TYPEP CLASS2 'CLASS)) 2 (LET ((CLASS3 (EVAL `(DEFCLASS ,C3 NIL NIL)))) (IF (NOT (TYPEP CLASS3 'CLASS)) 3 (LET ((I1 (MAKE-INSTANCE C1)) (I2 (MAKE-INSTANCE C2)) (I3 (MAKE-INSTANCE C3))) (COND ((NOT (TYPEP I1 C1)) 4) ((NOT (TYPEP I1 CLASS1)) 5) ((NOT (TYPEP I1 C2)) 6) ((NOT (TYPEP I1 CLASS2)) 7) ((NOT (TYPEP I1 C3)) 8) ((NOT (TYPEP I1 CLASS3)) 9) ((TYPEP I2 C1) 10) ((TYPEP I2 CLASS1) 11) ((TYPEP I3 C1) 12) ((TYPEP I3 CLASS1) 13) ((NOT (TYPEP I2 C2)) 14) ((NOT (TYPEP I2 CLASS2)) 15) ((NOT (TYPEP I3 C3)) 16) ((NOT (TYPEP I3 CLASS3)) 17) ((TYPEP I2 C3) 18) ((TYPEP I2 CLASS3) 19) ((TYPEP I3 C2) 20) ((TYPEP I3 CLASS2) 21) (T 'GOOD))))))))))
EQL-OK: GOOD
(LET ((C1 (GENSYM)) (C2 (GENSYM)) (C3 (GENSYM))) (LET ((CLASS1 (EVAL `(DEFCLASS ,C1 (,C2) NIL)))) (IF (NOT (TYPEP CLASS1 'CLASS)) 1 (LET ((CLASS2 (EVAL `(DEFCLASS ,C2 (,C3) NIL)))) (IF (NOT (TYPEP CLASS2 'CLASS)) 2 (LET ((CLASS3 (EVAL `(DEFCLASS ,C3 NIL NIL)))) (IF (NOT (TYPEP CLASS3 'CLASS)) 3 (LET ((I1 (MAKE-INSTANCE C1)) (I2 (MAKE-INSTANCE C2)) (I3 (MAKE-INSTANCE C3))) (COND ((NOT (TYPEP I1 C1)) 4) ((NOT (TYPEP I1 CLASS1)) 5) ((NOT (TYPEP I1 C2)) 6) ((NOT (TYPEP I1 CLASS2)) 7) ((NOT (TYPEP I1 C3)) 8) ((NOT (TYPEP I1 CLASS3)) 9) ((TYPEP I2 C1) 10) ((TYPEP I2 CLASS1) 11) ((TYPEP I3 C1) 12) ((TYPEP I3 CLASS1) 13) ((NOT (TYPEP I2 C2)) 14) ((NOT (TYPEP I2 CLASS2)) 15) ((NOT (TYPEP I3 C3)) 16) ((NOT (TYPEP I3 CLASS3)) 17) ((NOT (TYPEP I2 C3)) 18) ((NOT (TYPEP I2 CLASS3)) 19) ((TYPEP I3 C2) 20) ((TYPEP I3 CLASS2) 21) (T 'GOOD))))))))))
EQL-OK: GOOD
(BLOCK NIL (LET ((C1 (GENSYM)) (C2 (GENSYM)) (C3 (GENSYM)) (C4 (GENSYM)) (C5 (GENSYM))) (UNLESS (TYPEP (EVAL `(DEFCLASS ,C4 NIL NIL)) 'CLASS) (RETURN 1)) (UNLESS (TYPEP (EVAL `(DEFCLASS ,C5 NIL NIL)) 'CLASS) (RETURN 2)) (UNLESS (TYPEP (EVAL `(DEFCLASS ,C1 (,C2 ,C3) NIL)) 'CLASS) (RETURN 3)) (UNLESS (TYPEP (EVAL `(DEFCLASS ,C2 (,C4 ,C5) NIL)) 'CLASS) (RETURN 4)) (EVAL `(PROGN (DEFCLASS ,C3 (,C5 ,C4) NIL) (MAKE-INSTANCE ',C1)))))
[SIMPLE-ERROR]: DEFCLASS #1=#:G9218: inconsistent precedence graph, cycle (#2=#<STANDARD-CLASS #:G9221> #3=#<STANDARD-CLASS #:G9222>)
EQL-OK: ERROR
(PROGN (DEFCLASS CLASS-0203 NIL ((A :ALLOCATION :CLASS) (B :ALLOCATION :INSTANCE))) (DEFCLASS CLASS-0204 (CLASS-0203) (C D)) (LET ((C1 (MAKE-INSTANCE 'CLASS-0203)) (C2 (MAKE-INSTANCE 'CLASS-0204))) (LIST :BOUND (SLOT-BOUNDP C1 'A) (SLOT-BOUNDP C1 'B) (SLOT-BOUNDP C2 'A) (SLOT-BOUNDP C2 'B) (SLOT-BOUNDP C2 'C) (SLOT-BOUNDP C2 'D) (SETF (SLOT-VALUE C1 'A) 'X) :BOUND (SLOT-BOUNDP C1 'A) (SLOT-BOUNDP C1 'B) (SLOT-BOUNDP C2 'A) (SLOT-BOUNDP C2 'B) (SLOT-BOUNDP C2 'C) (SLOT-BOUNDP C2 'D) (SLOT-VALUE C1 'A) (SLOT-VALUE C2 'A) (EQ (SLOT-MAKUNBOUND C1 'A) C1) :BOUND (SLOT-BOUNDP C1 'A) (SLOT-BOUNDP C1 'B) (SLOT-BOUNDP C2 'A) (SLOT-BOUNDP C2 'B) (SLOT-BOUNDP C2 'C) (SLOT-BOUNDP C2 'D))))
EQUAL-OK: (:BOUND NIL NIL NIL NIL NIL NIL X :BOUND T NIL T NIL NIL NIL X X T :BOUND NIL NIL NIL NIL NIL NIL)
(PROGN (DEFCLASS CLASS-0206A NIL ((A :ALLOCATION :INSTANCE) (B :ALLOCATION :CLASS))) (DEFCLASS CLASS-0206B (CLASS-0206A) ((A :ALLOCATION :CLASS) (B :ALLOCATION :INSTANCE))) (LET ((C1 (MAKE-INSTANCE 'CLASS-0206A)) (C2 (MAKE-INSTANCE 'CLASS-0206B))) (LIST :BOUND (SLOT-BOUNDP C1 'A) (SLOT-BOUNDP C1 'B) (SLOT-BOUNDP C2 'A) (SLOT-BOUNDP C2 'B) (SETF (SLOT-VALUE C1 'A) 'X) (SETF (SLOT-VALUE C1 'B) 'Y) :BOUND (SLOT-BOUNDP C1 'A) (SLOT-BOUNDP C1 'B) (SLOT-BOUNDP C2 'A) (SLOT-BOUNDP C2 'B) :VALUE-1 (SLOT-VALUE C1 'A) (SLOT-VALUE C1 'B) (PROGN (SLOT-MAKUNBOUND C1 'A) (SLOT-MAKUNBOUND C1 'B) (SETF (SLOT-VALUE C2 'A) 'X)) (SETF (SLOT-VALUE C2 'B) 'Y) :BOUND (SLOT-BOUNDP C1 'A) (SLOT-BOUNDP C1 'B) (SLOT-BOUNDP C2 'A) (SLOT-BOUNDP C2 'B) :VALUE-2 (SLOT-VALUE C2 'A) (SLOT-VALUE C2 'B) (PROGN (SLOT-MAKUNBOUND C2 'A) (SLOT-MAKUNBOUND C2 'B) NIL))))
EQUAL-OK: (:BOUND NIL NIL NIL NIL X Y :BOUND T T NIL NIL :VALUE-1 X Y X Y :BOUND NIL NIL T T :VALUE-2 X Y NIL)
(LET* ((C (DEFCLASS REINIT-CLASS-01 NIL ((A :INITARG :A) (B :INITARG :B)))) (M (DEFMETHOD REINITIALIZE-INSTANCE :AFTER ((INSTANCE REINIT-CLASS-01) &REST INITARGS &KEY (X NIL X-P)) (DECLARE (IGNORE INITARGS)) (WHEN X-P (SETF (SLOT-VALUE INSTANCE 'A) X)) INSTANCE))) (EQ M (FIND-METHOD #'REINITIALIZE-INSTANCE '(:AFTER) (LIST C))))
EQL-OK: T
(LET* ((OBJ (MAKE-INSTANCE 'REINIT-CLASS-01)) (OBJ2 (REINITIALIZE-INSTANCE OBJ :A 1 :B 3))) (LIST (EQ OBJ OBJ2) (SLOT-VALUE OBJ2 'A) (SLOT-VALUE OBJ2 'B)))
EQUAL-OK: (T 1 3)
(LET* ((OBJ (MAKE-INSTANCE 'REINIT-CLASS-01 :A 10 :B 20)) (OBJ2 (REINITIALIZE-INSTANCE OBJ :X 3))) (LIST (EQ OBJ OBJ2) (SLOT-VALUE OBJ2 'A) (SLOT-VALUE OBJ2 'B)))
EQUAL-OK: (T 3 20)
(LET* ((OBJ (MAKE-INSTANCE 'REINIT-CLASS-01 :A 10 :B 20)) (OBJ2 (REINITIALIZE-INSTANCE OBJ :X 3 :X 100))) (LIST (EQ OBJ OBJ2) (SLOT-VALUE OBJ2 'A) (SLOT-VALUE OBJ2 'B)))
EQUAL-OK: (T 3 20)
(LET* ((OBJ (MAKE-INSTANCE 'REINIT-CLASS-01 :A 10 :B 20)) (OBJ2 (REINITIALIZE-INSTANCE OBJ :X 3 :GARBAGE 100))) (LIST (EQ OBJ OBJ2) (SLOT-VALUE OBJ2 'A) (SLOT-VALUE OBJ2 'B)))
[SIMPLE-KEYWORD-ERROR]: REINITIALIZE-INSTANCE: illegal keyword/value pair :GARBAGE, 100 in argument list.
The allowed keywords are #1=(:A :B :X)
EQL-OK: ERROR
(DEFGENERIC FOO126 (X Y) (:LAMBDA-LIST X))
[SIMPLE-SOURCE-PROGRAM-ERROR]: DEFGENERIC FOO126: invalid DEFGENERIC option #1=(:LAMBDA-LIST X)
EQL-OK: ERROR
(DEFGENERIC FOO127 (X Y) (:DECLARATIONS (OPTIMIZE (SPEED 3))))
[SIMPLE-SOURCE-PROGRAM-ERROR]: DEFGENERIC FOO127: invalid DEFGENERIC option #1=(:DECLARATIONS (OPTIMIZE (SPEED 3)))
EQL-OK: ERROR
(LET ((GF1 (DEFGENERIC NO-APP-METH-GF-01 NIL)) (GF2 (DEFGENERIC NO-APP-METH-GF-02 (X))) (GF3 (DEFGENERIC NO-APP-METH-GF-03 (X Y)))) (DEFMETHOD NO-APPLICABLE-METHOD ((X (EQL GF1)) &REST ARGS) (LIST 'NO-APPLICABLE-METHOD ARGS)) (DEFMETHOD NO-APPLICABLE-METHOD ((X (EQL GF2)) &REST ARGS) (LIST 'NO-APPLICABLE-METHOD ARGS)) (DEFMETHOD NO-APPLICABLE-METHOD ((X (EQL GF3)) &REST ARGS) (LIST 'NO-APPLICABLE-METHOD ARGS)) (LIST (NO-APP-METH-GF-01) (NO-APP-METH-GF-02 (CONS 'A 'B)) (NO-APP-METH-GF-03 (CONS 'A 'B) (CONS 'C 'D))))
EQUAL-OK: ((NO-APPLICABLE-METHOD NIL) (NO-APPLICABLE-METHOD ((A . B))) (NO-APPLICABLE-METHOD ((A . B) (C . D))))
(LET ((GF1 (DEFGENERIC NO-PRIM-METH-GF-01 NIL)) (GF2 (DEFGENERIC NO-PRIM-METH-GF-02 (X))) (GF3 (DEFGENERIC NO-PRIM-METH-GF-03 (X Y)))) (DEFMETHOD NO-PRIM-METH-GF-01 :AROUND NIL (LIST :AROUND (CALL-NEXT-METHOD))) (DEFMETHOD NO-PRIMARY-METHOD ((X (EQL GF1)) &REST ARGS) (LIST 'NO-PRIMARY-METHOD ARGS)) (DEFMETHOD NO-PRIM-METH-GF-02 :AROUND ((X T)) (LIST :AROUND X (CALL-NEXT-METHOD))) (DEFMETHOD NO-PRIMARY-METHOD ((X (EQL GF2)) &REST ARGS) (LIST 'NO-PRIMARY-METHOD ARGS)) (DEFMETHOD NO-PRIM-METH-GF-03 :AROUND ((X T) (Y T)) (LIST :AROUND X Y (CALL-NEXT-METHOD))) (DEFMETHOD NO-PRIMARY-METHOD ((X (EQL GF3)) &REST ARGS) (LIST 'NO-PRIMARY-METHOD ARGS)) (LIST (NO-PRIM-METH-GF-01) (NO-PRIM-METH-GF-02 (CONS 'A 'B)) (NO-PRIM-METH-GF-03 (CONS 'A 'B) (CONS 'C 'D))))
EQUAL-OK: ((NO-PRIMARY-METHOD NIL) (NO-PRIMARY-METHOD ((A . B))) (NO-PRIMARY-METHOD ((A . B) (C . D))))
(PROGN (DEFGENERIC TEST-MC-STANDARD (X) (:METHOD ((X STRING)) (CONS 'STRING (CALL-NEXT-METHOD))) (:METHOD ((X T)) X)) (LIST (TEST-MC-STANDARD 1) (TEST-MC-STANDARD "a")))
EQUAL-OK: (1 (STRING . "a"))
(PROGN (DEFGENERIC TEST-MC-STANDARD-BAD-QUALIFIERS (X Y)) (DEFMETHOD TEST-MC-STANDARD-BAD-QUALIFIERS ((X INTEGER) (Y INTEGER)) (+ X Y)) (DEFMETHOD TEST-MC-STANDARD-BAD-QUALIFIERS ((X FLOAT) (Y FLOAT)) (+ X Y)) (DEFMETHOD TEST-MC-STANDARD-BAD-QUALIFIERS :BEFFOR ((X FLOAT) (Y FLOAT)) (FORMAT T "x = ~S, y = ~S~%" X Y)) T)
[SIMPLE-PROGRAM-ERROR]: STANDARD method combination, used by #1=#<STANDARD-GENERIC-FUNCTION TEST-MC-STANDARD-BAD-QUALIFIERS>, allows no method qualifiers except (:BEFORE :AFTER :AROUND): #<STANDARD-METHOD :BEFFOR (#2=#<BUILT-IN-CLASS FLOAT> #2#)>
EQL-OK: ERROR
(PROGN (DEFGENERIC TEST-MC-STANDARD-BAD1 (X Y)) (DEFMETHOD TEST-MC-STANDARD-BAD1 ((X REAL) (Y REAL)) (+ X Y)) (DEFMETHOD TEST-MC-STANDARD-BAD1 :AFTER :BEFORE ((X INTEGER) (Y INTEGER)) (* X Y)) T)
[SIMPLE-PROGRAM-ERROR]: STANDARD method combination, used by #1=#<STANDARD-GENERIC-FUNCTION TEST-MC-STANDARD-BAD1>, does not allow more than one method qualifier on a method: #<STANDARD-METHOD :AFTER :BEFORE (#2=#<BUILT-IN-CLASS INTEGER> #2#)>
EQL-OK: ERROR
(PROGN (DEFGENERIC TEST-MC-STANDARD-BAD2 (X Y)) (DEFMETHOD TEST-MC-STANDARD-BAD2 ((X REAL) (Y REAL)) (+ X Y)) (DEFMETHOD TEST-MC-STANDARD-BAD2 :BEFORE ((X INTEGER) (Y INTEGER)) (FLOOR (CALL-NEXT-METHOD))) (TEST-MC-STANDARD-BAD2 3 4))
[SIMPLE-PROGRAM-ERROR]: #1=#<STANDARD-GENERIC-FUNCTION TEST-MC-STANDARD-BAD2>: CALL-NEXT-METHOD is invalid within :BEFORE methods
EQL-OK: ERROR
(PROGN (DEFGENERIC TEST-MC-STANDARD-BAD3 (X Y)) (DEFMETHOD TEST-MC-STANDARD-BAD3 ((X REAL) (Y REAL)) (+ X Y)) (DEFMETHOD TEST-MC-STANDARD-BAD3 :AFTER ((X INTEGER) (Y INTEGER)) (FLOOR (CALL-NEXT-METHOD))) (TEST-MC-STANDARD-BAD3 3 4))
[SIMPLE-PROGRAM-ERROR]: #1=#<STANDARD-GENERIC-FUNCTION TEST-MC-STANDARD-BAD3>: CALL-NEXT-METHOD is invalid within :AFTER methods
EQL-OK: ERROR
(PROGN (DEFGENERIC TEST-MC-STANDARD-BAD4 (X Y) (:METHOD-COMBINATION STANDARD :MOST-SPECIFIC-LAST)))
[SIMPLE-PROGRAM-ERROR]: DEFGENERIC TEST-MC-STANDARD-BAD4: The STANDARD method combination permits no options: (:MOST-SPECIFIC-LAST)
EQL-OK: ERROR
(PROGN (DEFGENERIC TEST-MC-PROGN (X S) (:METHOD-COMBINATION PROGN) (:METHOD PROGN ((X STRING) S) (VECTOR-PUSH-EXTEND 'STRING S)) (:METHOD PROGN ((X T) S) (VECTOR-PUSH-EXTEND 'T S)) (:METHOD :AROUND ((X NUMBER) S) (VECTOR-PUSH-EXTEND 'NUMBER S) (CALL-NEXT-METHOD))) (LIST (LET ((S (MAKE-ARRAY 10 :ADJUSTABLE T :FILL-POINTER 0))) (TEST-MC-PROGN 1 S) S) (LET ((S (MAKE-ARRAY 10 :ADJUSTABLE T :FILL-POINTER 0))) (TEST-MC-PROGN "a" S) S)))
EQUALP-OK: (#(NUMBER T) #(STRING T))
(PROGN (DEFGENERIC TEST-MC-APPEND-1 (X) (:METHOD-COMBINATION APPEND) (:METHOD ((X STRING)) (LIST (LENGTH X))) (:METHOD ((X VECTOR)) (LIST (ARRAY-ELEMENT-TYPE X)))) T)
[SIMPLE-PROGRAM-ERROR]: APPEND method combination, used by #<STANDARD-GENERIC-FUNCTION TEST-MC-APPEND-1>, does not allow less than one method qualifier on a method: #<STANDARD-METHOD (#1=#<BUILT-IN-CLASS STRING>)>
EQL-OK: ERROR
(PROGN (DEFGENERIC TEST-MC-APPEND-2 (X) (:METHOD-COMBINATION APPEND) (:METHOD APPEND ((X STRING)) (LIST (LENGTH X))) (:METHOD APPEND ((X VECTOR)) (LIST (TYPE-OF (AREF X 0)))) (:METHOD :AROUND ((X STRING)) (LIST #\" (CALL-NEXT-METHOD) #\")) (:METHOD :AROUND ((X VECTOR)) (COERCE (CALL-NEXT-METHOD) 'VECTOR))) (TEST-MC-APPEND-2 "abc"))
EQUALP-OK: (#\" #(3 STANDARD-CHAR) #\")
(PROGN (DEFGENERIC TEST-MC-APPEND-3 (X) (:METHOD-COMBINATION APPEND :MOST-SPECIFIC-LAST) (:METHOD APPEND ((X STRING)) (LIST (LENGTH X))) (:METHOD APPEND ((X VECTOR)) (LIST (TYPE-OF (AREF X 0)))) (:METHOD :AROUND ((X STRING)) (LIST #\" (CALL-NEXT-METHOD) #\")) (:METHOD :AROUND ((X VECTOR)) (COERCE (CALL-NEXT-METHOD) 'VECTOR))) (TEST-MC-APPEND-3 "abc"))
EQUALP-OK: (#\" #(STANDARD-CHAR 3) #\")
(DEFINE-METHOD-COMBINATION MC01 :DOCUMENTATION :OPERATOR)
[SIMPLE-SOURCE-PROGRAM-ERROR]: DEFINE-METHOD-COMBINATION MC01: :OPERATOR is not a string
EQL-OK: ERROR
(DEFINE-METHOD-COMBINATION MC02 :DOCUMENTATION NIL)
[SIMPLE-SOURCE-PROGRAM-ERROR]: DEFINE-METHOD-COMBINATION MC02: NIL is not a string
EQL-OK: ERROR
(DEFINE-METHOD-COMBINATION MC03 :DOCUMENTATION "foo" :DOCUMENTATION "bar")
[SIMPLE-SOURCE-PROGRAM-ERROR]: DEFINE-METHOD-COMBINATION MC03: option :DOCUMENTATION may only be given once
EQL-OK: ERROR
(DEFINE-METHOD-COMBINATION MC04 :IDENTITY-WITH-ONE-ARGUMENT NIL :OPERATOR LIST :DOCUMENTATION)
[SIMPLE-SOURCE-PROGRAM-ERROR]: DEFINE-METHOD-COMBINATION MC04: options must come in pairs
EQL-OK: ERROR
(DEFINE-METHOD-COMBINATION MC05 :IDENTITY-WITH-ONE-ARGUMENT NIL :OPERATOR LIST :DOCUMENTATION "test")
EQL-OK: MC05
(PROGN (DEFGENERIC TEST-MC05-1 (X) (:METHOD MC05 ((X REAL)) 'REAL) (:METHOD MC05 ((X INTEGER)) 'INTEGER) (:METHOD MC05 ((X NUMBER)) 'NUMBER) (:METHOD-COMBINATION MC05)) (TEST-MC05-1 3))
EQUAL-OK: (INTEGER REAL NUMBER)
(PROGN (DEFGENERIC TEST-MC05-2 (X) (:METHOD MC05 ((X REAL)) 'REAL) (:METHOD MC05 ((X INTEGER)) 'INTEGER) (:METHOD MC05 ((X NUMBER)) 'NUMBER) (:METHOD-COMBINATION MC05 (INTERN "MOST-SPECIFIC-LAST" "KEYWORD"))) (TEST-MC05-2 3))
[SIMPLE-PROGRAM-ERROR]: DEFGENERIC TEST-MC05-2: Invalid method-combination options (#1=(INTERN "MOST-SPECIFIC-LAST" "KEYWORD")) for #<METHOD-COMBINATION MC05 #x1A164421>: The value of CLOS::ORDER is #1#, should be :MOST-SPECIFIC-FIRST or :MOST-SPECIFIC-LAST.
EQL-OK: ERROR
(PROGN (DEFGENERIC TEST-MC05-3 (X) (:METHOD MC05 ((X REAL)) 'REAL) (:METHOD MC05 ((X INTEGER)) 'INTEGER) (:METHOD MC05 ((X NUMBER)) 'NUMBER) (:METHOD-COMBINATION MC05 :MOST-SPECIFIC-LAST)) (TEST-MC05-3 3))
EQUAL-OK: (NUMBER REAL INTEGER)
(PROGN (DEFGENERIC TEST-MC05-4 (X) (:METHOD MC05 ((X REAL)) 'REAL) (:METHOD-COMBINATION MC05 :MOST-SPECIFIC-LAST)) (TEST-MC05-4 3))
EQUAL-OK: (REAL)
(PROGN (DEFGENERIC TEST-MC05-5 (X) (:METHOD MC05 ((X REAL)) 'REAL) (:METHOD-COMBINATION MC05 NIL)))
[SIMPLE-PROGRAM-ERROR]: DEFGENERIC TEST-MC05-5: Invalid method-combination options (NIL) for #<METHOD-COMBINATION MC05 #x1A0C1859>: The value of CLOS::ORDER is NIL, should be :MOST-SPECIFIC-FIRST or :MOST-SPECIFIC-LAST.
EQL-OK: ERROR
(PROGN (DEFGENERIC TEST-MC05-6 (X) (:METHOD MC05 ((X REAL)) 'REAL) (:METHOD-COMBINATION MC05 :MOST-SPECIFIC-FIRST JUNK)))
[SIMPLE-PROGRAM-ERROR]: DEFGENERIC TEST-MC05-6: Invalid method-combination options (:MOST-SPECIFIC-FIRST JUNK) for #<METHOD-COMBINATION MC05 #x1A0C1859>: APPLY: too many arguments given to #<COMPILED-FUNCTION CLOS::METHOD-COMBINATION-OPTION-CHECKER>
EQL-OK: ERROR
(DEFINE-METHOD-COMBINATION MC06 :IDENTITY-WITH-ONE-ARGUMENT T :OPERATOR LIST :DOCUMENTATION "test")
EQL-OK: MC06
(PROGN (DEFGENERIC TEST-MC06-1 (X) (:METHOD MC06 ((X REAL)) 'REAL) (:METHOD-COMBINATION MC06 :MOST-SPECIFIC-LAST)) (TEST-MC06-1 3))
EQL-OK: REAL
(PROGN (DEFUN POSITIVE-INTEGER-QUALIFIER-P (METHOD-QUALIFIERS) (AND (= (LENGTH METHOD-QUALIFIERS) 1) (TYPEP (FIRST METHOD-QUALIFIERS) '(INTEGER 0 *)))) (DEFINE-METHOD-COMBINATION EXAMPLE-METHOD-COMBINATION NIL ((METHOD-LIST POSITIVE-INTEGER-QUALIFIER-P)) `(PROGN ,@(MAPCAR #'(LAMBDA (METHOD) `(CALL-METHOD ,METHOD)) (STABLE-SORT METHOD-LIST #'< :KEY #'(LAMBDA (METHOD) (FIRST (METHOD-QUALIFIERS METHOD))))))) (DEFGENERIC MC-TEST-PIQ (P1 P2 S) (:METHOD-COMBINATION EXAMPLE-METHOD-COMBINATION) (:METHOD 1 ((P1 T) (P2 T) S) (VECTOR-PUSH-EXTEND (LIST 1 P1 P2) S)) (:METHOD 4 ((P1 T) (P2 T) S) (VECTOR-PUSH-EXTEND (LIST 4 P1 P2) S)) (:METHOD 2 ((P1 T) (P2 T) S) (VECTOR-PUSH-EXTEND (LIST 2 P1 P2) S)) (:METHOD 3 ((P1 T) (P2 T) S) (VECTOR-PUSH-EXTEND (LIST 3 P1 P2) S))) (LET ((S (MAKE-ARRAY 10 :ADJUSTABLE T :FILL-POINTER 0))) (MC-TEST-PIQ 1 2 S) S))
[SIMPLE-ERROR]: For function #1=#<STANDARD-GENERIC-FUNCTION MC-TEST-PIQ> applied to argument list NIL:
While computing the effective method through #<METHOD-COMBINATION EXAMPLE-METHOD-COMBINATION #x1A0EEFE5>:
Impossible to combine the methods:
Method #2=#<STANDARD-METHOD 1 (#3=#<BUILT-IN-CLASS T> #3# #3#)> has the same specializers and different qualifiers than other methods in method group METHOD-LIST, and is actually used in the effective method.
EQL-OK: ERROR
(PROGN (DEFINE-METHOD-COMBINATION W-ARGS NIL ((METHOD-LIST *)) (:ARGUMENTS ARG1 ARG2 &AUX (EXTRA :EXTRA)) `(PROGN ,@(MAPCAR #'(LAMBDA (METHOD) `(CALL-METHOD ,METHOD)) METHOD-LIST))) (DEFGENERIC MC-TEST-W-ARGS (P1 P2 S) (:METHOD-COMBINATION W-ARGS) (:METHOD ((P1 NUMBER) (P2 T) S) (VECTOR-PUSH-EXTEND (LIST 'NUMBER P1 P2) S)) (:METHOD ((P1 STRING) (P2 T) S) (VECTOR-PUSH-EXTEND (LIST 'STRING P1 P2) S)) (:METHOD ((P1 T) (P2 T) S) (VECTOR-PUSH-EXTEND (LIST T P1 P2) S))) (LET ((S (MAKE-ARRAY 10 :ADJUSTABLE T :FILL-POINTER 0))) (MC-TEST-W-ARGS 1 2 S) S))
WARNING: in MC-TEST-W-ARGS-<EMF-2>-1 : variable ARG1 is not used.
Misspelled or missing IGNORE declaration?
WARNING: in MC-TEST-W-ARGS-<EMF-2>-1 : variable ARG2 is not used.
Misspelled or missing IGNORE declaration?
WARNING: in MC-TEST-W-ARGS-<EMF-2>-1 : variable EXTRA is not used.
Misspelled or missing IGNORE declaration?
EQUALP-OK: #((NUMBER 1 2) (T 1 2))
(DEFINE-METHOD-COMBINATION MC11 NIL)
[SIMPLE-SOURCE-PROGRAM-ERROR]: DEFINE-METHOD-COMBINATION MC11: invalid syntax for long form: #1=(DEFINE-METHOD-COMBINATION MC11 . #2=(NIL))
EQL-OK: ERROR
(DEFINE-METHOD-COMBINATION MC12 NIL NIL)
EQL-OK: MC12
(DEFINE-METHOD-COMBINATION MC13 NIL NIL (:ARGUMENTS ORDER &AUX &KEY))
[SIMPLE-SOURCE-PROGRAM-ERROR]: DEFINE-METHOD-COMBINATION MC13: invalid :ARGUMENTS lambda-list: Lambda list marker &KEY not allowed here.
EQL-OK: ERROR
(DEFINE-METHOD-COMBINATION MC14 NIL NIL (:ARGUMENTS &WHOLE))
[SIMPLE-SOURCE-PROGRAM-ERROR]: DEFINE-METHOD-COMBINATION MC14: invalid :ARGUMENTS lambda-list: Missing &WHOLE parameter in lambda list (&WHOLE)
EQL-OK: ERROR
(DEFINE-METHOD-COMBINATION MC15 NIL NIL (:ARGUMENTS ORDER))
EQL-OK: MC15
(DEFINE-METHOD-COMBINATION MC16 NIL NIL (:GENERIC-FUNCTION))
[SIMPLE-SOURCE-PROGRAM-ERROR]: DEFINE-METHOD-COMBINATION MC16: Invalid syntax for :GENERIC-FUNCTION option: #1=(:GENERIC-FUNCTION)
EQL-OK: ERROR
(DEFINE-METHOD-COMBINATION MC17 NIL NIL (:GENERIC-FUNCTION GF1 GF2))
[SIMPLE-SOURCE-PROGRAM-ERROR]: DEFINE-METHOD-COMBINATION MC17: Invalid syntax for :GENERIC-FUNCTION option: #1=(:GENERIC-FUNCTION GF1 GF2)
EQL-OK: ERROR
(DEFINE-METHOD-COMBINATION MC18 NIL NIL (:GENERIC-FUNCTION (GF)))
[SIMPLE-SOURCE-PROGRAM-ERROR]: DEFINE-METHOD-COMBINATION MC18: Invalid syntax for :GENERIC-FUNCTION option: #1=(:GENERIC-FUNCTION (GF))
EQL-OK: ERROR
(DEFINE-METHOD-COMBINATION MC19 NIL NIL (:GENERIC-FUNCTION GF))
EQL-OK: MC19
(DEFINE-METHOD-COMBINATION MC20 NIL (A))
[SIMPLE-SOURCE-PROGRAM-ERROR]: DEFINE-METHOD-COMBINATION MC20: invalid method group specifier A: Not a list of length at least 2
EQL-OK: ERROR
(DEFINE-METHOD-COMBINATION MC21 NIL ((3)))
[SIMPLE-SOURCE-PROGRAM-ERROR]: DEFINE-METHOD-COMBINATION MC21: invalid method group specifier #1=(3): Not a list of length at least 2
EQL-OK: ERROR
(DEFINE-METHOD-COMBINATION MC22 NIL ((A)))
[SIMPLE-SOURCE-PROGRAM-ERROR]: DEFINE-METHOD-COMBINATION MC22: invalid method group specifier #1=(A): Not a list of length at least 2
EQL-OK: ERROR
(DEFINE-METHOD-COMBINATION MC23 NIL ((A *)))
EQL-OK: MC23
(DEFINE-METHOD-COMBINATION MC24 NIL ((A *) (B *)) `(PROGN (CALL-METHOD ,(FIRST A)) (CALL-METHOD ,(FIRST B))))
EQL-OK: MC24
(PROGN (DEFINE-METHOD-COMBINATION MC25 NIL ((ALL NIL)) `(LIST 'RESULT ,@(MAPCAR #'(LAMBDA (METHOD) `(CALL-METHOD ,METHOD)) ALL))) (DEFGENERIC TEST-MC25 (X) (:METHOD-COMBINATION MC25)) (TEST-MC25 7))
[METHOD-CALL-ERROR]: NO-APPLICABLE-METHOD: When calling #1=#<STANDARD-GENERIC-FUNCTION TEST-MC25> with arguments #2=(7), no method is applicable.
EQL-OK: ERROR
(PROGN (DEFINE-METHOD-COMBINATION MC26 NIL ((NORMAL NIL) (IGNORED (:IGNORE))) `(LIST 'RESULT ,@(MAPCAR #'(LAMBDA (METHOD) `(CALL-METHOD ,METHOD)) NORMAL))) (DEFGENERIC TEST-MC26 (X) (:METHOD-COMBINATION MC26) (:METHOD :IGNORE ((X NUMBER)) (/ 0))) (TEST-MC26 7))
EQUAL-OK: (RESULT)
(PROGN (DEFINE-METHOD-COMBINATION MC27 NIL ((NORMAL NIL) (IGNORED (:IGNORE :UNUSED))) `(LIST 'RESULT ,@(MAPCAR #'(LAMBDA (METHOD) `(CALL-METHOD ,METHOD)) NORMAL))) (DEFGENERIC TEST-MC27 (X) (:METHOD-COMBINATION MC27) (:METHOD :IGNORE ((X NUMBER)) (/ 0))) (TEST-MC27 7))
[SIMPLE-PROGRAM-ERROR]: MC27 method combination, used by #<STANDARD-GENERIC-FUNCTION TEST-MC27>, does not allow the method qualifiers #1=(:IGNORE): #<STANDARD-METHOD :IGNORE (#2=#<BUILT-IN-CLASS NUMBER>)>
EQL-OK: ERROR
(PROGN (DEFINE-METHOD-COMBINATION MC28 NIL ((NORMAL NIL) (IGNORED (:IGNORE) (:UNUSED))) `(LIST 'RESULT ,@(MAPCAR #'(LAMBDA (METHOD) `(CALL-METHOD ,METHOD)) NORMAL))) (DEFGENERIC TEST-MC28 (X) (:METHOD-COMBINATION MC28) (:METHOD :IGNORE ((X NUMBER)) (/ 0))) (TEST-MC28 7))
EQUAL-OK: (RESULT)
(PROGN (DEFINE-METHOD-COMBINATION MC29 NIL ((IGNORED (:IGNORE) (:UNUSED)) (OTHER *)) `(LIST 'RESULT ,@(MAPCAR #'(LAMBDA (METHOD) `(CALL-METHOD ,METHOD)) OTHER))) (DEFGENERIC TEST-MC29 (X) (:METHOD-COMBINATION MC29) (:METHOD :IGNORE ((X NUMBER)) (/ 0))) (TEST-MC29 7))
EQUAL-OK: (RESULT)
(DEFINE-METHOD-COMBINATION MC50 (OPT1 OPT2) ((ALL *)) (:ARGUMENTS &WHOLE WHOLE ARG1 ARG2 &REST MORE-ARGS) `(LIST ',OPT1 ',OPT2 'RESULT ,WHOLE ,ARG1 ,ARG2 ,MORE-ARGS))
EQL-OK: MC50
(DEFGENERIC TEST-MC50-1 (X) (:METHOD-COMBINATION MC50 XYZ))
[SIMPLE-PROGRAM-ERROR]: DEFGENERIC TEST-MC50-1: Invalid method-combination options (XYZ) for #<METHOD-COMBINATION MC50 #x1A10185D>: EVAL/APPLY: Too few arguments (1 instead of at least 2) given to CLOS::METHOD-COMBINATION-OPTION-CHECKER
EQL-OK: ERROR
(PROGN (DEFGENERIC TEST-MC50-2 (X) (:METHOD-COMBINATION MC50 XYZ "foo") (:METHOD ((X INTEGER)) (/ 0))) (TEST-MC50-2 7))
EQUAL-OK: (XYZ "foo" RESULT (7) 7 NIL NIL)
(PROGN (DEFGENERIC TEST-MC50-3 (X Y Z) (:METHOD-COMBINATION MC50 XYZ "bar") (:METHOD ((X T) (Y T) (Z T)) (/ 0))) (TEST-MC50-3 'A 'B 'C))
EQUAL-OK: (XYZ "bar" RESULT (A B C) A B NIL)
(DEFINE-METHOD-COMBINATION MC51 (OPT1 &OPTIONAL OPT2 &REST MORE-OPTS) ((ALL *)) (:ARGUMENTS &WHOLE WHOLE ARG1 &KEY TEST TEST-NOT) `(LIST ',OPT1 ',OPT2 ',MORE-OPTS 'RESULT ,WHOLE ,ARG1 ,TEST ,TEST-NOT))
EQL-OK: MC51
(DEFGENERIC TEST-MC51-1 (X) (:METHOD-COMBINATION MC51))
[SIMPLE-PROGRAM-ERROR]: DEFGENERIC TEST-MC51-1: Invalid method-combination options NIL for #<METHOD-COMBINATION MC51 #x1A11FEC5>: EVAL/APPLY: Too few arguments (0 instead of at least 1) given to CLOS::METHOD-COMBINATION-OPTION-CHECKER
EQL-OK: ERROR
(PROGN (DEFGENERIC TEST-MC51-2 (X) (:METHOD-COMBINATION MC51 "xyz") (:METHOD ((X INTEGER)) (/ 0))) (TEST-MC51-2 7))
EQUAL-OK: ("xyz" NIL NIL RESULT (7) 7 NIL NIL)
(PROGN (DEFGENERIC TEST-MC51-3 (X) (:METHOD-COMBINATION MC51 "xyz" "uvw") (:METHOD ((X INTEGER)) (/ 0))) (TEST-MC51-3 7))
EQUAL-OK: ("xyz" "uvw" NIL RESULT (7) 7 NIL NIL)
(PROGN (DEFGENERIC TEST-MC51-4 (X) (:METHOD-COMBINATION MC51 "xyz" "uvw" :FOO :BAR) (:METHOD ((X INTEGER)) (/ 0))) (TEST-MC51-4 7))
EQUAL-OK: ("xyz" "uvw" (:FOO :BAR) RESULT (7) 7 NIL NIL)
(PROGN (DEFGENERIC TEST-MC51-5 (X &KEY TEST TEST-NOT KEY PREDICATE) (:METHOD-COMBINATION MC51 "xyz" "uvw" :FOO :BAR) (:METHOD ((X INTEGER) &KEY PREDICATE TEST TEST-NOT KEY) (/ 0))) (TEST-MC51-5 7 :KEY 'FIRST :TEST-NOT 'EQUAL))
EQUAL-OK: ("xyz" "uvw" (:FOO :BAR) RESULT (7 :KEY FIRST :TEST-NOT EQUAL) 7 NIL EQUAL)
(DEFINE-METHOD-COMBINATION MC60 (OPT1 &OPTIONAL (OPT2 "def")) ((ALL *)) (:ARGUMENTS) `(LIST ',OPT1 ',OPT2 'RESULT (CALL-METHOD ,(FIRST ALL))))
EQL-OK: MC60
(PROGN (DEFGENERIC TEST-MC60-1 NIL (:METHOD-COMBINATION MC60 "xyz") (:METHOD NIL 'NIL)) (TEST-MC60-1))
EQUAL-OK: ("xyz" "def" RESULT NIL)
(PROGN (DEFGENERIC TEST-MC60-2 (X Y) (:METHOD-COMBINATION MC60 "xyz") (:METHOD (X Y) (LIST X Y))) (TEST-MC60-2 'A 'B))
EQUAL-OK: ("xyz" "def" RESULT (A B))
(PROGN (DEFGENERIC TEST-MC60-3 (&OPTIONAL X Y) (:METHOD-COMBINATION MC60 "xyz") (:METHOD (&OPTIONAL X Y) (LIST X Y))) (TEST-MC60-3 'A))
EQUAL-OK: ("xyz" "def" RESULT (A NIL))
(PROGN (DEFGENERIC TEST-MC60-4 (&REST X) (:METHOD-COMBINATION MC60 "xyz") (:METHOD (&REST X) X)) (TEST-MC60-4 'A 'B))
EQUAL-OK: ("xyz" "def" RESULT (A B))
(DEFINE-METHOD-COMBINATION MC61 (OPT1 &OPTIONAL (OPT2 "def")) ((ALL *)) (:ARGUMENTS A1 A2) `(LIST ',OPT1 ',OPT2 'RESULT ,A1 ,A2 (CALL-METHOD ,(FIRST ALL))))
EQL-OK: MC61
(PROGN (DEFGENERIC TEST-MC61-1 (X) (:METHOD-COMBINATION MC61 "xyz") (:METHOD (X) (LIST X))) (TEST-MC61-1 'A))
EQUAL-OK: ("xyz" "def" RESULT A NIL (A))
(PROGN (DEFGENERIC TEST-MC61-2 (X Y) (:METHOD-COMBINATION MC61 "xyz") (:METHOD (X Y) (LIST X Y))) (TEST-MC61-2 'A 'B))
EQUAL-OK: ("xyz" "def" RESULT A B (A B))
(PROGN (DEFGENERIC TEST-MC61-3 (X Y Z) (:METHOD-COMBINATION MC61 "xyz") (:METHOD (X Y Z) (LIST X Y Z))) (TEST-MC61-3 'A 'B 'C))
EQUAL-OK: ("xyz" "def" RESULT A B (A B C))
(PROGN (DEFGENERIC TEST-MC61-4 (X &OPTIONAL Y Z) (:METHOD-COMBINATION MC61 "xyz") (:METHOD (X &OPTIONAL Y Z) (LIST X Y Z))) (LIST (TEST-MC61-4 'A) (TEST-MC61-4 'A 'B) (TEST-MC61-4 'A 'B 'C)))
EQUAL-OK: (("xyz" "def" RESULT A NIL (A NIL NIL)) ("xyz" "def" RESULT A NIL (A B NIL)) ("xyz" "def" RESULT A NIL (A B C)))
(PROGN (DEFGENERIC TEST-MC61-5 (X Y &OPTIONAL Z U) (:METHOD-COMBINATION MC61 "xyz") (:METHOD (X Y &OPTIONAL Z U) (LIST X Y Z U))) (LIST (TEST-MC61-5 'A 'B) (TEST-MC61-5 'A 'B 'C) (TEST-MC61-5 'A 'B 'C 'D)))
EQUAL-OK: (("xyz" "def" RESULT A B (A B NIL NIL)) ("xyz" "def" RESULT A B (A B C NIL)) ("xyz" "def" RESULT A B (A B C D)))
(PROGN (DEFGENERIC TEST-MC61-6 (X Y Z &OPTIONAL U V) (:METHOD-COMBINATION MC61 "xyz") (:METHOD (X Y Z &OPTIONAL U V) (LIST X Y Z U V))) (LIST (TEST-MC61-6 'A 'B 'C) (TEST-MC61-6 'A 'B 'C 'D) (TEST-MC61-6 'A 'B 'C 'D 'E)))
EQUAL-OK: (("xyz" "def" RESULT A B (A B C NIL NIL)) ("xyz" "def" RESULT A B (A B C D NIL)) ("xyz" "def" RESULT A B (A B C D E)))
(PROGN (DEFGENERIC TEST-MC61-7 (X &REST Y) (:METHOD-COMBINATION MC61 "xyz") (:METHOD (X &REST Y) (LIST* X Y))) (LIST (TEST-MC61-7 'A) (TEST-MC61-7 'A 'B) (TEST-MC61-7 'A 'B 'C)))
EQUAL-OK: (("xyz" "def" RESULT A NIL (A)) ("xyz" "def" RESULT A NIL (A B)) ("xyz" "def" RESULT A NIL (A B C)))
(PROGN (DEFGENERIC TEST-MC61-8 (X Y &REST Z) (:METHOD-COMBINATION MC61 "xyz") (:METHOD (X Y &REST Z) (LIST* X Y Z))) (LIST (TEST-MC61-8 'A 'B) (TEST-MC61-8 'A 'B 'C) (TEST-MC61-8 'A 'B 'C 'D)))
EQUAL-OK: (("xyz" "def" RESULT A B (A B)) ("xyz" "def" RESULT A B (A B C)) ("xyz" "def" RESULT A B (A B C D)))
(PROGN (DEFGENERIC TEST-MC61-9 (X Y Z &REST U) (:METHOD-COMBINATION MC61 "xyz") (:METHOD (X Y Z &REST U) (LIST* X Y Z U))) (LIST (TEST-MC61-9 'A 'B 'C) (TEST-MC61-9 'A 'B 'C 'D) (TEST-MC61-9 'A 'B 'C 'D 'E)))
EQUAL-OK: (("xyz" "def" RESULT A B (A B C)) ("xyz" "def" RESULT A B (A B C D)) ("xyz" "def" RESULT A B (A B C D E)))
(DEFINE-METHOD-COMBINATION MC62 (OPT1 &OPTIONAL (OPT2 "def")) ((ALL *)) (:ARGUMENTS &OPTIONAL (O1 'DEF1) (O2 'DEF2)) `(LIST ',OPT1 ',OPT2 'RESULT ,O1 ,O2 (CALL-METHOD ,(FIRST ALL))))
EQL-OK: MC62
(PROGN (DEFGENERIC TEST-MC62-1 (X) (:METHOD-COMBINATION MC62 "xyz") (:METHOD (X) (LIST X))) (TEST-MC62-1 'A))
EQUAL-OK: ("xyz" "def" RESULT DEF1 DEF2 (A))
(PROGN (DEFGENERIC TEST-MC62-2 (X &OPTIONAL Y) (:METHOD-COMBINATION MC62 "xyz") (:METHOD (X &OPTIONAL Y) (LIST X Y))) (LIST (TEST-MC62-2 'A) (TEST-MC62-2 'A 'B)))
EQUAL-OK: (("xyz" "def" RESULT DEF1 DEF2 (A NIL)) ("xyz" "def" RESULT B DEF2 (A B)))
(PROGN (DEFGENERIC TEST-MC62-3 (X &OPTIONAL Y Z) (:METHOD-COMBINATION MC62 "xyz") (:METHOD (X &OPTIONAL Y Z) (LIST X Y Z))) (LIST (TEST-MC62-3 'A) (TEST-MC62-3 'A 'B) (TEST-MC62-3 'A 'B 'C)))
EQUAL-OK: (("xyz" "def" RESULT DEF1 DEF2 (A NIL NIL)) ("xyz" "def" RESULT B DEF2 (A B NIL)) ("xyz" "def" RESULT B C (A B C)))
(PROGN (DEFGENERIC TEST-MC62-4 (X &OPTIONAL Y Z U) (:METHOD-COMBINATION MC62 "xyz") (:METHOD (X &OPTIONAL Y Z U) (LIST X Y Z U))) (LIST (TEST-MC62-4 'A) (TEST-MC62-4 'A 'B) (TEST-MC62-4 'A 'B 'C) (TEST-MC62-4 'A 'B 'C 'D)))
EQUAL-OK: (("xyz" "def" RESULT DEF1 DEF2 (A NIL NIL NIL)) ("xyz" "def" RESULT B DEF2 (A B NIL NIL)) ("xyz" "def" RESULT B C (A B C NIL)) ("xyz" "def" RESULT B C (A B C D)))
(PROGN (DEFGENERIC TEST-MC62-5 (X &REST Y) (:METHOD-COMBINATION MC62 "xyz") (:METHOD (X &REST Y) (LIST* X Y))) (LIST (TEST-MC62-5 'A) (TEST-MC62-5 'A 'B) (TEST-MC62-5 'A 'B 'C)))
EQUAL-OK: (("xyz" "def" RESULT DEF1 DEF2 (A)) ("xyz" "def" RESULT DEF1 DEF2 (A B)) ("xyz" "def" RESULT DEF1 DEF2 (A B C)))
(PROGN (DEFGENERIC TEST-MC62-6 (X &OPTIONAL Y &REST Z) (:METHOD-COMBINATION MC62 "xyz") (:METHOD (X &OPTIONAL Y &REST Z) (LIST* X Y Z))) (LIST (TEST-MC62-6 'A) (TEST-MC62-6 'A 'B) (TEST-MC62-6 'A 'B 'C)))
EQUAL-OK: (("xyz" "def" RESULT DEF1 DEF2 (A NIL)) ("xyz" "def" RESULT B DEF2 (A B)) ("xyz" "def" RESULT B DEF2 (A B C)))
(PROGN (DEFGENERIC TEST-MC62-7 (X &OPTIONAL Y Z &REST U) (:METHOD-COMBINATION MC62 "xyz") (:METHOD (X &OPTIONAL Y Z &REST U) (LIST* X Y Z U))) (LIST (TEST-MC62-7 'A) (TEST-MC62-7 'A 'B) (TEST-MC62-7 'A 'B 'C) (TEST-MC62-7 'A 'B 'C 'D)))
EQUAL-OK: (("xyz" "def" RESULT DEF1 DEF2 (A NIL NIL)) ("xyz" "def" RESULT B DEF2 (A B NIL)) ("xyz" "def" RESULT B C (A B C)) ("xyz" "def" RESULT B C (A B C D)))
(DEFINE-METHOD-COMBINATION MC63 (OPT1 &OPTIONAL (OPT2 "def")) ((ALL *)) (:ARGUMENTS &REST R) `(LIST ',OPT1 ',OPT2 'RESULT ,R (CALL-METHOD ,(FIRST ALL))))
EQL-OK: MC63
(PROGN (DEFGENERIC TEST-MC63-1 NIL (:METHOD-COMBINATION MC63 "xyz") (:METHOD NIL 'NIL)) (TEST-MC63-1))
EQUAL-OK: ("xyz" "def" RESULT NIL NIL)
(PROGN (DEFGENERIC TEST-MC63-2 (X Y) (:METHOD-COMBINATION MC63 "xyz") (:METHOD (X Y) (LIST X Y))) (TEST-MC63-2 'A 'B))
EQUAL-OK: ("xyz" "def" RESULT NIL (A B))
(PROGN (DEFGENERIC TEST-MC63-3 (&OPTIONAL X Y) (:METHOD-COMBINATION MC63 "xyz") (:METHOD (&OPTIONAL X Y) (LIST X Y))) (TEST-MC63-3 'A))
EQUAL-OK: ("xyz" "def" RESULT NIL (A NIL))
(PROGN (DEFGENERIC TEST-MC63-4 (&REST X) (:METHOD-COMBINATION MC63 "xyz") (:METHOD (&REST X) X)) (TEST-MC63-4 'A 'B))
EQUAL-OK: ("xyz" "def" RESULT (A B) (A B))
(DEFINE-METHOD-COMBINATION MC64 (OPT1 &OPTIONAL (OPT2 "def")) ((ALL *)) (:ARGUMENTS A1 A2 &OPTIONAL (O1 'DEF1) (O2 'DEF2)) `(LIST ',OPT1 ',OPT2 'RESULT ,A1 ,A2 ,O1 ,O2 (CALL-METHOD ,(FIRST ALL))))
EQL-OK: MC64
(PROGN (DEFGENERIC TEST-MC64-1 NIL (:METHOD-COMBINATION MC64 "xyz") (:METHOD NIL 'NIL)) (TEST-MC64-1))
EQUAL-OK: ("xyz" "def" RESULT NIL NIL DEF1 DEF2 NIL)
(PROGN (DEFGENERIC TEST-MC64-2 (X) (:METHOD-COMBINATION MC64 "xyz") (:METHOD (X) (LIST X))) (TEST-MC64-2 'A))
EQUAL-OK: ("xyz" "def" RESULT A NIL DEF1 DEF2 (A))
(PROGN (DEFGENERIC TEST-MC64-3 (X Y) (:METHOD-COMBINATION MC64 "xyz") (:METHOD (X Y) (LIST X Y))) (TEST-MC64-3 'A 'B))
EQUAL-OK: ("xyz" "def" RESULT A B DEF1 DEF2 (A B))
(PROGN (DEFGENERIC TEST-MC64-4 (X Y Z) (:METHOD-COMBINATION MC64 "xyz") (:METHOD (X Y Z) (LIST X Y Z))) (TEST-MC64-4 'A 'B 'C))
EQUAL-OK: ("xyz" "def" RESULT A B DEF1 DEF2 (A B C))
(PROGN (DEFGENERIC TEST-MC64-5 (X &OPTIONAL Y) (:METHOD-COMBINATION MC64 "xyz") (:METHOD (X &OPTIONAL Y) (LIST X Y))) (LIST (TEST-MC64-5 'A) (TEST-MC64-5 'A 'B)))
EQUAL-OK: (("xyz" "def" RESULT A NIL DEF1 DEF2 (A NIL)) ("xyz" "def" RESULT A NIL B DEF2 (A B)))
(PROGN (DEFGENERIC TEST-MC64-6 (X Y &OPTIONAL Z) (:METHOD-COMBINATION MC64 "xyz") (:METHOD (X Y &OPTIONAL Z) (LIST X Y Z))) (LIST (TEST-MC64-6 'A 'B) (TEST-MC64-6 'A 'B 'C)))
EQUAL-OK: (("xyz" "def" RESULT A B DEF1 DEF2 (A B NIL)) ("xyz" "def" RESULT A B C DEF2 (A B C)))
(PROGN (DEFGENERIC TEST-MC64-7 (X Y Z &OPTIONAL U) (:METHOD-COMBINATION MC64 "xyz") (:METHOD (X Y Z &OPTIONAL U) (LIST X Y Z U))) (LIST (TEST-MC64-7 'A 'B 'C) (TEST-MC64-7 'A 'B 'C 'D)))
EQUAL-OK: (("xyz" "def" RESULT A B DEF1 DEF2 (A B C NIL)) ("xyz" "def" RESULT A B D DEF2 (A B C D)))
(PROGN (DEFGENERIC TEST-MC64-8 (X &OPTIONAL Y Z) (:METHOD-COMBINATION MC64 "xyz") (:METHOD (X &OPTIONAL Y Z) (LIST X Y Z))) (LIST (TEST-MC64-8 'A) (TEST-MC64-8 'A 'B) (TEST-MC64-8 'A 'B 'C)))
EQUAL-OK: (("xyz" "def" RESULT A NIL DEF1 DEF2 (A NIL NIL)) ("xyz" "def" RESULT A NIL B DEF2 (A B NIL)) ("xyz" "def" RESULT A NIL B C (A B C)))
(PROGN (DEFGENERIC TEST-MC64-9 (X Y &OPTIONAL Z U) (:METHOD-COMBINATION MC64 "xyz") (:METHOD (X Y &OPTIONAL Z U) (LIST X Y Z U))) (LIST (TEST-MC64-9 'A 'B) (TEST-MC64-9 'A 'B 'C) (TEST-MC64-9 'A 'B 'C 'D)))
EQUAL-OK: (("xyz" "def" RESULT A B DEF1 DEF2 (A B NIL NIL)) ("xyz" "def" RESULT A B C DEF2 (A B C NIL)) ("xyz" "def" RESULT A B C D (A B C D)))
(PROGN (DEFGENERIC TEST-MC64-10 (X Y Z &OPTIONAL U V) (:METHOD-COMBINATION MC64 "xyz") (:METHOD (X Y Z &OPTIONAL U V) (LIST X Y Z U V))) (LIST (TEST-MC64-10 'A 'B 'C) (TEST-MC64-10 'A 'B 'C 'D) (TEST-MC64-10 'A 'B 'C 'D 'E)))
EQUAL-OK: (("xyz" "def" RESULT A B DEF1 DEF2 (A B C NIL NIL)) ("xyz" "def" RESULT A B D DEF2 (A B C D NIL)) ("xyz" "def" RESULT A B D E (A B C D E)))
(PROGN (DEFGENERIC TEST-MC64-11 (X &OPTIONAL Y Z U) (:METHOD-COMBINATION MC64 "xyz") (:METHOD (X &OPTIONAL Y Z U) (LIST X Y Z U))) (LIST (TEST-MC64-11 'A) (TEST-MC64-11 'A 'B) (TEST-MC64-11 'A 'B 'C) (TEST-MC64-11 'A 'B 'C 'D)))
EQUAL-OK: (("xyz" "def" RESULT A NIL DEF1 DEF2 (A NIL NIL NIL)) ("xyz" "def" RESULT A NIL B DEF2 (A B NIL NIL)) ("xyz" "def" RESULT A NIL B C (A B C NIL)) ("xyz" "def" RESULT A NIL B C (A B C D)))
(PROGN (DEFGENERIC TEST-MC64-12 (X Y &OPTIONAL Z U V) (:METHOD-COMBINATION MC64 "xyz") (:METHOD (X Y &OPTIONAL Z U V) (LIST X Y Z U V))) (LIST (TEST-MC64-12 'A 'B) (TEST-MC64-12 'A 'B 'C) (TEST-MC64-12 'A 'B 'C 'D) (TEST-MC64-12 'A 'B 'C 'D 'E)))
EQUAL-OK: (("xyz" "def" RESULT A B DEF1 DEF2 (A B NIL NIL NIL)) ("xyz" "def" RESULT A B C DEF2 (A B C NIL NIL)) ("xyz" "def" RESULT A B C D (A B C D NIL)) ("xyz" "def" RESULT A B C D (A B C D E)))
(PROGN (DEFGENERIC TEST-MC64-13 (X Y Z &OPTIONAL U V W) (:METHOD-COMBINATION MC64 "xyz") (:METHOD (X Y Z &OPTIONAL U V W) (LIST X Y Z U V W))) (LIST (TEST-MC64-13 'A 'B 'C) (TEST-MC64-13 'A 'B 'C 'D) (TEST-MC64-13 'A 'B 'C 'D 'E) (TEST-MC64-13 'A 'B 'C 'D 'E 'F)))
EQUAL-OK: (("xyz" "def" RESULT A B DEF1 DEF2 (A B C NIL NIL NIL)) ("xyz" "def" RESULT A B D DEF2 (A B C D NIL NIL)) ("xyz" "def" RESULT A B D E (A B C D E NIL)) ("xyz" "def" RESULT A B D E (A B C D E F)))
(PROGN (DEFGENERIC TEST-MC64-14 (X &REST Y) (:METHOD-COMBINATION MC64 "xyz") (:METHOD (X &REST Y) (LIST* X Y))) (LIST (TEST-MC64-14 'A) (TEST-MC64-14 'A 'B) (TEST-MC64-14 'A 'B 'C)))
EQUAL-OK: (("xyz" "def" RESULT A NIL DEF1 DEF2 (A)) ("xyz" "def" RESULT A NIL DEF1 DEF2 (A B)) ("xyz" "def" RESULT A NIL DEF1 DEF2 (A B C)))
(PROGN (DEFGENERIC TEST-MC64-15 (X Y &REST Z) (:METHOD-COMBINATION MC64 "xyz") (:METHOD (X Y &REST Z) (LIST* X Y Z))) (LIST (TEST-MC64-15 'A 'B) (TEST-MC64-15 'A 'B 'C) (TEST-MC64-15 'A 'B 'C 'D)))
EQUAL-OK: (("xyz" "def" RESULT A B DEF1 DEF2 (A B)) ("xyz" "def" RESULT A B DEF1 DEF2 (A B C)) ("xyz" "def" RESULT A B DEF1 DEF2 (A B C D)))
(PROGN (DEFGENERIC TEST-MC64-16 (X Y Z &REST U) (:METHOD-COMBINATION MC64 "xyz") (:METHOD (X Y Z &REST U) (LIST* X Y Z U))) (LIST (TEST-MC64-16 'A 'B 'C) (TEST-MC64-16 'A 'B 'C 'D) (TEST-MC64-16 'A 'B 'C 'D 'E)))
EQUAL-OK: (("xyz" "def" RESULT A B DEF1 DEF2 (A B C)) ("xyz" "def" RESULT A B DEF1 DEF2 (A B C D)) ("xyz" "def" RESULT A B DEF1 DEF2 (A B C D E)))
(PROGN (DEFGENERIC TEST-MC64-17 (X &OPTIONAL Y &REST Z) (:METHOD-COMBINATION MC64 "xyz") (:METHOD (X &OPTIONAL Y &REST Z) (LIST* X Y Z))) (LIST (TEST-MC64-17 'A) (TEST-MC64-17 'A 'B) (TEST-MC64-17 'A 'B 'C) (TEST-MC64-17 'A 'B 'C 'D)))
EQUAL-OK: (("xyz" "def" RESULT A NIL DEF1 DEF2 (A NIL)) ("xyz" "def" RESULT A NIL B DEF2 (A B)) ("xyz" "def" RESULT A NIL B DEF2 (A B C)) ("xyz" "def" RESULT A NIL B DEF2 (A B C D)))
(PROGN (DEFGENERIC TEST-MC64-18 (X &OPTIONAL Y Z &REST U) (:METHOD-COMBINATION MC64 "xyz") (:METHOD (X &OPTIONAL Y Z &REST U) (LIST* X Y Z U))) (LIST (TEST-MC64-18 'A) (TEST-MC64-18 'A 'B) (TEST-MC64-18 'A 'B 'C) (TEST-MC64-18 'A 'B 'C 'D) (TEST-MC64-18 'A 'B 'C 'D 'E)))
EQUAL-OK: (("xyz" "def" RESULT A NIL DEF1 DEF2 (A NIL NIL)) ("xyz" "def" RESULT A NIL B DEF2 (A B NIL)) ("xyz" "def" RESULT A NIL B C (A B C)) ("xyz" "def" RESULT A NIL B C (A B C D)) ("xyz" "def" RESULT A NIL B C (A B C D E)))
(PROGN (DEFGENERIC TEST-MC64-19 (X &OPTIONAL Y Z U &REST V) (:METHOD-COMBINATION MC64 "xyz") (:METHOD (X &OPTIONAL Y Z U &REST V) (LIST* X Y Z U V))) (LIST (TEST-MC64-19 'A) (TEST-MC64-19 'A 'B) (TEST-MC64-19 'A 'B 'C) (TEST-MC64-19 'A 'B 'C 'D) (TEST-MC64-19 'A 'B 'C 'D 'E) (TEST-MC64-19 'A 'B 'C 'D 'E 'F)))
EQUAL-OK: (("xyz" "def" RESULT A NIL DEF1 DEF2 (A NIL NIL NIL)) ("xyz" "def" RESULT A NIL B DEF2 (A B NIL NIL)) ("xyz" "def" RESULT A NIL B C (A B C NIL)) ("xyz" "def" RESULT A NIL B C (A B C D)) ("xyz" "def" RESULT A NIL B C (A B C D E)) ("xyz" "def" RESULT A NIL B C (A B C D E F)))
(DEFINE-METHOD-COMBINATION MC65 (OPT1 &OPTIONAL (OPT2 "def")) ((ALL *)) (:ARGUMENTS A1 A2 &REST R) `(LIST ',OPT1 ',OPT2 'RESULT ,A1 ,A2 ,R (CALL-METHOD ,(FIRST ALL))))
EQL-OK: MC65
(PROGN (DEFGENERIC TEST-MC65-1 NIL (:METHOD-COMBINATION MC65 "xyz") (:METHOD NIL 'NIL)) (TEST-MC65-1))
EQUAL-OK: ("xyz" "def" RESULT NIL NIL NIL NIL)
(PROGN (DEFGENERIC TEST-MC65-2 (X) (:METHOD-COMBINATION MC65 "xyz") (:METHOD (X) (LIST X))) (TEST-MC65-2 'A))
EQUAL-OK: ("xyz" "def" RESULT A NIL NIL (A))
(PROGN (DEFGENERIC TEST-MC65-3 (X Y) (:METHOD-COMBINATION MC65 "xyz") (:METHOD (X Y) (LIST X Y))) (TEST-MC65-3 'A 'B))
EQUAL-OK: ("xyz" "def" RESULT A B NIL (A B))
(PROGN (DEFGENERIC TEST-MC65-4 (X Y Z) (:METHOD-COMBINATION MC65 "xyz") (:METHOD (X Y Z) (LIST X Y Z))) (TEST-MC65-4 'A 'B 'C))
EQUAL-OK: ("xyz" "def" RESULT A B NIL (A B C))
(PROGN (DEFGENERIC TEST-MC65-5 (X &OPTIONAL Y) (:METHOD-COMBINATION MC65 "xyz") (:METHOD (X &OPTIONAL Y) (LIST X Y))) (LIST (TEST-MC65-5 'A) (TEST-MC65-5 'A 'B)))
EQUAL-OK: (("xyz" "def" RESULT A NIL NIL (A NIL)) ("xyz" "def" RESULT A NIL NIL (A B)))
(PROGN (DEFGENERIC TEST-MC65-6 (X Y &OPTIONAL Z) (:METHOD-COMBINATION MC65 "xyz") (:METHOD (X Y &OPTIONAL Z) (LIST X Y Z))) (LIST (TEST-MC65-6 'A 'B) (TEST-MC65-6 'A 'B 'C)))
EQUAL-OK: (("xyz" "def" RESULT A B NIL (A B NIL)) ("xyz" "def" RESULT A B NIL (A B C)))
(PROGN (DEFGENERIC TEST-MC65-7 (X Y Z &OPTIONAL U) (:METHOD-COMBINATION MC65 "xyz") (:METHOD (X Y Z &OPTIONAL U) (LIST X Y Z U))) (LIST (TEST-MC65-7 'A 'B 'C) (TEST-MC65-7 'A 'B 'C 'D)))
EQUAL-OK: (("xyz" "def" RESULT A B NIL (A B C NIL)) ("xyz" "def" RESULT A B NIL (A B C D)))
(PROGN (DEFGENERIC TEST-MC65-8 (X &OPTIONAL Y Z) (:METHOD-COMBINATION MC65 "xyz") (:METHOD (X &OPTIONAL Y Z) (LIST X Y Z))) (LIST (TEST-MC65-8 'A) (TEST-MC65-8 'A 'B) (TEST-MC65-8 'A 'B 'C)))
EQUAL-OK: (("xyz" "def" RESULT A NIL NIL (A NIL NIL)) ("xyz" "def" RESULT A NIL NIL (A B NIL)) ("xyz" "def" RESULT A NIL NIL (A B C)))
(PROGN (DEFGENERIC TEST-MC65-9 (X Y &OPTIONAL Z U) (:METHOD-COMBINATION MC65 "xyz") (:METHOD (X Y &OPTIONAL Z U) (LIST X Y Z U))) (LIST (TEST-MC65-9 'A 'B) (TEST-MC65-9 'A 'B 'C) (TEST-MC65-9 'A 'B 'C 'D)))
EQUAL-OK: (("xyz" "def" RESULT A B NIL (A B NIL NIL)) ("xyz" "def" RESULT A B NIL (A B C NIL)) ("xyz" "def" RESULT A B NIL (A B C D)))
(PROGN (DEFGENERIC TEST-MC65-10 (X Y Z &OPTIONAL U V) (:METHOD-COMBINATION MC65 "xyz") (:METHOD (X Y Z &OPTIONAL U V) (LIST X Y Z U V))) (LIST (TEST-MC65-10 'A 'B 'C) (TEST-MC65-10 'A 'B 'C 'D) (TEST-MC65-10 'A 'B 'C 'D 'E)))
EQUAL-OK: (("xyz" "def" RESULT A B NIL (A B C NIL NIL)) ("xyz" "def" RESULT A B NIL (A B C D NIL)) ("xyz" "def" RESULT A B NIL (A B C D E)))
(PROGN (DEFGENERIC TEST-MC65-11 (X &OPTIONAL Y Z U) (:METHOD-COMBINATION MC65 "xyz") (:METHOD (X &OPTIONAL Y Z U) (LIST X Y Z U))) (LIST (TEST-MC65-11 'A) (TEST-MC65-11 'A 'B) (TEST-MC65-11 'A 'B 'C) (TEST-MC65-11 'A 'B 'C 'D)))
EQUAL-OK: (("xyz" "def" RESULT A NIL NIL (A NIL NIL NIL)) ("xyz" "def" RESULT A NIL NIL (A B NIL NIL)) ("xyz" "def" RESULT A NIL NIL (A B C NIL)) ("xyz" "def" RESULT A NIL NIL (A B C D)))
(PROGN (DEFGENERIC TEST-MC65-12 (X Y &OPTIONAL Z U V) (:METHOD-COMBINATION MC65 "xyz") (:METHOD (X Y &OPTIONAL Z U V) (LIST X Y Z U V))) (LIST (TEST-MC65-12 'A 'B) (TEST-MC65-12 'A 'B 'C) (TEST-MC65-12 'A 'B 'C 'D) (TEST-MC65-12 'A 'B 'C 'D 'E)))
EQUAL-OK: (("xyz" "def" RESULT A B NIL (A B NIL NIL NIL)) ("xyz" "def" RESULT A B NIL (A B C NIL NIL)) ("xyz" "def" RESULT A B NIL (A B C D NIL)) ("xyz" "def" RESULT A B NIL (A B C D E)))
(PROGN (DEFGENERIC TEST-MC65-13 (X Y Z &OPTIONAL U V W) (:METHOD-COMBINATION MC65 "xyz") (:METHOD (X Y Z &OPTIONAL U V W) (LIST X Y Z U V W))) (LIST (TEST-MC65-13 'A 'B 'C) (TEST-MC65-13 'A 'B 'C 'D) (TEST-MC65-13 'A 'B 'C 'D 'E) (TEST-MC65-13 'A 'B 'C 'D 'E 'F)))
EQUAL-OK: (("xyz" "def" RESULT A B NIL (A B C NIL NIL NIL)) ("xyz" "def" RESULT A B NIL (A B C D NIL NIL)) ("xyz" "def" RESULT A B NIL (A B C D E NIL)) ("xyz" "def" RESULT A B NIL (A B C D E F)))
(PROGN (DEFGENERIC TEST-MC65-14 (X &REST Y) (:METHOD-COMBINATION MC65 "xyz") (:METHOD (X &REST Y) (LIST* X Y))) (LIST (TEST-MC65-14 'A) (TEST-MC65-14 'A 'B) (TEST-MC65-14 'A 'B 'C)))
EQUAL-OK: (("xyz" "def" RESULT A NIL NIL (A)) ("xyz" "def" RESULT A NIL (B) (A B)) ("xyz" "def" RESULT A NIL (B C) (A B C)))
(PROGN (DEFGENERIC TEST-MC65-15 (X Y &REST Z) (:METHOD-COMBINATION MC65 "xyz") (:METHOD (X Y &REST Z) (LIST* X Y Z))) (LIST (TEST-MC65-15 'A 'B) (TEST-MC65-15 'A 'B 'C) (TEST-MC65-15 'A 'B 'C 'D)))
EQUAL-OK: (("xyz" "def" RESULT A B NIL (A B)) ("xyz" "def" RESULT A B (C) (A B C)) ("xyz" "def" RESULT A B (C D) (A B C D)))
(PROGN (DEFGENERIC TEST-MC65-16 (X Y Z &REST U) (:METHOD-COMBINATION MC65 "xyz") (:METHOD (X Y Z &REST U) (LIST* X Y Z U))) (LIST (TEST-MC65-16 'A 'B 'C) (TEST-MC65-16 'A 'B 'C 'D) (TEST-MC65-16 'A 'B 'C 'D 'E)))
EQUAL-OK: (("xyz" "def" RESULT A B NIL (A B C)) ("xyz" "def" RESULT A B (D) (A B C D)) ("xyz" "def" RESULT A B (D E) (A B C D E)))
(PROGN (DEFGENERIC TEST-MC65-17 (X &OPTIONAL Y &REST Z) (:METHOD-COMBINATION MC65 "xyz") (:METHOD (X &OPTIONAL Y &REST Z) (LIST* X Y Z))) (LIST (TEST-MC65-17 'A) (TEST-MC65-17 'A 'B) (TEST-MC65-17 'A 'B 'C) (TEST-MC65-17 'A 'B 'C 'D)))
EQUAL-OK: (("xyz" "def" RESULT A NIL NIL (A NIL)) ("xyz" "def" RESULT A NIL NIL (A B)) ("xyz" "def" RESULT A NIL (C) (A B C)) ("xyz" "def" RESULT A NIL (C D) (A B C D)))
(PROGN (DEFGENERIC TEST-MC65-18 (X &OPTIONAL Y Z &REST U) (:METHOD-COMBINATION MC65 "xyz") (:METHOD (X &OPTIONAL Y Z &REST U) (LIST* X Y Z U))) (LIST (TEST-MC65-18 'A) (TEST-MC65-18 'A 'B) (TEST-MC65-18 'A 'B 'C) (TEST-MC65-18 'A 'B 'C 'D) (TEST-MC65-18 'A 'B 'C 'D 'E)))
EQUAL-OK: (("xyz" "def" RESULT A NIL NIL (A NIL NIL)) ("xyz" "def" RESULT A NIL NIL (A B NIL)) ("xyz" "def" RESULT A NIL NIL (A B C)) ("xyz" "def" RESULT A NIL (D) (A B C D)) ("xyz" "def" RESULT A NIL (D E) (A B C D E)))
(PROGN (DEFGENERIC TEST-MC65-19 (X &OPTIONAL Y Z U &REST V) (:METHOD-COMBINATION MC65 "xyz") (:METHOD (X &OPTIONAL Y Z U &REST V) (LIST* X Y Z U V))) (LIST (TEST-MC65-19 'A) (TEST-MC65-19 'A 'B) (TEST-MC65-19 'A 'B 'C) (TEST-MC65-19 'A 'B 'C 'D) (TEST-MC65-19 'A 'B 'C 'D 'E) (TEST-MC65-19 'A 'B 'C 'D 'E 'F)))
EQUAL-OK: (("xyz" "def" RESULT A NIL NIL (A NIL NIL NIL)) ("xyz" "def" RESULT A NIL NIL (A B NIL NIL)) ("xyz" "def" RESULT A NIL NIL (A B C NIL)) ("xyz" "def" RESULT A NIL NIL (A B C D)) ("xyz" "def" RESULT A NIL (E) (A B C D E)) ("xyz" "def" RESULT A NIL (E F) (A B C D E F)))
(DEFINE-METHOD-COMBINATION MC66 (OPT1 &OPTIONAL (OPT2 "def")) ((ALL *)) (:ARGUMENTS &OPTIONAL (O1 'DEF1) (O2 'DEF2) &REST R) `(LIST ',OPT1 ',OPT2 'RESULT ,O1 ,O2 ,R (CALL-METHOD ,(FIRST ALL))))
EQL-OK: MC66
(PROGN (DEFGENERIC TEST-MC66-1 NIL (:METHOD-COMBINATION MC66 "xyz") (:METHOD NIL 'NIL)) (TEST-MC66-1))
EQUAL-OK: ("xyz" "def" RESULT DEF1 DEF2 NIL NIL)
(PROGN (DEFGENERIC TEST-MC66-2 (X) (:METHOD-COMBINATION MC66 "xyz") (:METHOD (X) (LIST X))) (TEST-MC66-2 'A))
EQUAL-OK: ("xyz" "def" RESULT DEF1 DEF2 NIL (A))
(PROGN (DEFGENERIC TEST-MC66-3 (X Y) (:METHOD-COMBINATION MC66 "xyz") (:METHOD (X Y) (LIST X Y))) (TEST-MC66-3 'A 'B))
EQUAL-OK: ("xyz" "def" RESULT DEF1 DEF2 NIL (A B))
(PROGN (DEFGENERIC TEST-MC66-4 (X Y Z) (:METHOD-COMBINATION MC66 "xyz") (:METHOD (X Y Z) (LIST X Y Z))) (TEST-MC66-4 'A 'B 'C))
EQUAL-OK: ("xyz" "def" RESULT DEF1 DEF2 NIL (A B C))
(PROGN (DEFGENERIC TEST-MC66-5 (X &OPTIONAL Y) (:METHOD-COMBINATION MC66 "xyz") (:METHOD (X &OPTIONAL Y) (LIST X Y))) (LIST (TEST-MC66-5 'A) (TEST-MC66-5 'A 'B)))
EQUAL-OK: (("xyz" "def" RESULT DEF1 DEF2 NIL (A NIL)) ("xyz" "def" RESULT B DEF2 NIL (A B)))
(PROGN (DEFGENERIC TEST-MC66-6 (X Y &OPTIONAL Z) (:METHOD-COMBINATION MC66 "xyz") (:METHOD (X Y &OPTIONAL Z) (LIST X Y Z))) (LIST (TEST-MC66-6 'A 'B) (TEST-MC66-6 'A 'B 'C)))
EQUAL-OK: (("xyz" "def" RESULT DEF1 DEF2 NIL (A B NIL)) ("xyz" "def" RESULT C DEF2 NIL (A B C)))
(PROGN (DEFGENERIC TEST-MC66-7 (X Y Z &OPTIONAL U) (:METHOD-COMBINATION MC66 "xyz") (:METHOD (X Y Z &OPTIONAL U) (LIST X Y Z U))) (LIST (TEST-MC66-7 'A 'B 'C) (TEST-MC66-7 'A 'B 'C 'D)))
EQUAL-OK: (("xyz" "def" RESULT DEF1 DEF2 NIL (A B C NIL)) ("xyz" "def" RESULT D DEF2 NIL (A B C D)))
(PROGN (DEFGENERIC TEST-MC66-8 (X &OPTIONAL Y Z) (:METHOD-COMBINATION MC66 "xyz") (:METHOD (X &OPTIONAL Y Z) (LIST X Y Z))) (LIST (TEST-MC66-8 'A) (TEST-MC66-8 'A 'B) (TEST-MC66-8 'A 'B 'C)))
EQUAL-OK: (("xyz" "def" RESULT DEF1 DEF2 NIL (A NIL NIL)) ("xyz" "def" RESULT B DEF2 NIL (A B NIL)) ("xyz" "def" RESULT B C NIL (A B C)))
(PROGN (DEFGENERIC TEST-MC66-9 (X Y &OPTIONAL Z U) (:METHOD-COMBINATION MC66 "xyz") (:METHOD (X Y &OPTIONAL Z U) (LIST X Y Z U))) (LIST (TEST-MC66-9 'A 'B) (TEST-MC66-9 'A 'B 'C) (TEST-MC66-9 'A 'B 'C 'D)))
EQUAL-OK: (("xyz" "def" RESULT DEF1 DEF2 NIL (A B NIL NIL)) ("xyz" "def" RESULT C DEF2 NIL (A B C NIL)) ("xyz" "def" RESULT C D NIL (A B C D)))
(PROGN (DEFGENERIC TEST-MC66-10 (X Y Z &OPTIONAL U V) (:METHOD-COMBINATION MC66 "xyz") (:METHOD (X Y Z &OPTIONAL U V) (LIST X Y Z U V))) (LIST (TEST-MC66-10 'A 'B 'C) (TEST-MC66-10 'A 'B 'C 'D) (TEST-MC66-10 'A 'B 'C 'D 'E)))
EQUAL-OK: (("xyz" "def" RESULT DEF1 DEF2 NIL (A B C NIL NIL)) ("xyz" "def" RESULT D DEF2 NIL (A B C D NIL)) ("xyz" "def" RESULT D E NIL (A B C D E)))
(PROGN (DEFGENERIC TEST-MC66-11 (X &OPTIONAL Y Z U) (:METHOD-COMBINATION MC66 "xyz") (:METHOD (X &OPTIONAL Y Z U) (LIST X Y Z U))) (LIST (TEST-MC66-11 'A) (TEST-MC66-11 'A 'B) (TEST-MC66-11 'A 'B 'C) (TEST-MC66-11 'A 'B 'C 'D)))
EQUAL-OK: (("xyz" "def" RESULT DEF1 DEF2 NIL (A NIL NIL NIL)) ("xyz" "def" RESULT B DEF2 NIL (A B NIL NIL)) ("xyz" "def" RESULT B C NIL (A B C NIL)) ("xyz" "def" RESULT B C NIL (A B C D)))
(PROGN (DEFGENERIC TEST-MC66-12 (X Y &OPTIONAL Z U V) (:METHOD-COMBINATION MC66 "xyz") (:METHOD (X Y &OPTIONAL Z U V) (LIST X Y Z U V))) (LIST (TEST-MC66-12 'A 'B) (TEST-MC66-12 'A 'B 'C) (TEST-MC66-12 'A 'B 'C 'D) (TEST-MC66-12 'A 'B 'C 'D 'E)))
EQUAL-OK: (("xyz" "def" RESULT DEF1 DEF2 NIL (A B NIL NIL NIL)) ("xyz" "def" RESULT C DEF2 NIL (A B C NIL NIL)) ("xyz" "def" RESULT C D NIL (A B C D NIL)) ("xyz" "def" RESULT C D NIL (A B C D E)))
(PROGN (DEFGENERIC TEST-MC66-13 (X Y Z &OPTIONAL U V W) (:METHOD-COMBINATION MC66 "xyz") (:METHOD (X Y Z &OPTIONAL U V W) (LIST X Y Z U V W))) (LIST (TEST-MC66-13 'A 'B 'C) (TEST-MC66-13 'A 'B 'C 'D) (TEST-MC66-13 'A 'B 'C 'D 'E) (TEST-MC66-13 'A 'B 'C 'D 'E 'F)))
EQUAL-OK: (("xyz" "def" RESULT DEF1 DEF2 NIL (A B C NIL NIL NIL)) ("xyz" "def" RESULT D DEF2 NIL (A B C D NIL NIL)) ("xyz" "def" RESULT D E NIL (A B C D E NIL)) ("xyz" "def" RESULT D E NIL (A B C D E F)))
(PROGN (DEFGENERIC TEST-MC66-14 (X &REST Y) (:METHOD-COMBINATION MC66 "xyz") (:METHOD (X &REST Y) (LIST* X Y))) (LIST (TEST-MC66-14 'A) (TEST-MC66-14 'A 'B) (TEST-MC66-14 'A 'B 'C)))
EQUAL-OK: (("xyz" "def" RESULT DEF1 DEF2 NIL (A)) ("xyz" "def" RESULT DEF1 DEF2 (B) (A B)) ("xyz" "def" RESULT DEF1 DEF2 (B C) (A B C)))
(PROGN (DEFGENERIC TEST-MC66-15 (X Y &REST Z) (:METHOD-COMBINATION MC66 "xyz") (:METHOD (X Y &REST Z) (LIST* X Y Z))) (LIST (TEST-MC66-15 'A 'B) (TEST-MC66-15 'A 'B 'C) (TEST-MC66-15 'A 'B 'C 'D)))
EQUAL-OK: (("xyz" "def" RESULT DEF1 DEF2 NIL (A B)) ("xyz" "def" RESULT DEF1 DEF2 (C) (A B C)) ("xyz" "def" RESULT DEF1 DEF2 (C D) (A B C D)))
(PROGN (DEFGENERIC TEST-MC66-16 (X Y Z &REST U) (:METHOD-COMBINATION MC66 "xyz") (:METHOD (X Y Z &REST U) (LIST* X Y Z U))) (LIST (TEST-MC66-16 'A 'B 'C) (TEST-MC66-16 'A 'B 'C 'D) (TEST-MC66-16 'A 'B 'C 'D 'E)))
EQUAL-OK: (("xyz" "def" RESULT DEF1 DEF2 NIL (A B C)) ("xyz" "def" RESULT DEF1 DEF2 (D) (A B C D)) ("xyz" "def" RESULT DEF1 DEF2 (D E) (A B C D E)))
(PROGN (DEFGENERIC TEST-MC66-17 (X &OPTIONAL Y &REST Z) (:METHOD-COMBINATION MC66 "xyz") (:METHOD (X &OPTIONAL Y &REST Z) (LIST* X Y Z))) (LIST (TEST-MC66-17 'A) (TEST-MC66-17 'A 'B) (TEST-MC66-17 'A 'B 'C) (TEST-MC66-17 'A 'B 'C 'D)))
EQUAL-OK: (("xyz" "def" RESULT DEF1 DEF2 NIL (A NIL)) ("xyz" "def" RESULT B DEF2 NIL (A B)) ("xyz" "def" RESULT B DEF2 (C) (A B C)) ("xyz" "def" RESULT B DEF2 (C D) (A B C D)))
(PROGN (DEFGENERIC TEST-MC66-18 (X &OPTIONAL Y Z &REST U) (:METHOD-COMBINATION MC66 "xyz") (:METHOD (X &OPTIONAL Y Z &REST U) (LIST* X Y Z U))) (LIST (TEST-MC66-18 'A) (TEST-MC66-18 'A 'B) (TEST-MC66-18 'A 'B 'C) (TEST-MC66-18 'A 'B 'C 'D) (TEST-MC66-18 'A 'B 'C 'D 'E)))
EQUAL-OK: (("xyz" "def" RESULT DEF1 DEF2 NIL (A NIL NIL)) ("xyz" "def" RESULT B DEF2 NIL (A B NIL)) ("xyz" "def" RESULT B C NIL (A B C)) ("xyz" "def" RESULT B C (D) (A B C D)) ("xyz" "def" RESULT B C (D E) (A B C D E)))
(PROGN (DEFGENERIC TEST-MC66-19 (X &OPTIONAL Y Z U &REST V) (:METHOD-COMBINATION MC66 "xyz") (:METHOD (X &OPTIONAL Y Z U &REST V) (LIST* X Y Z U V))) (LIST (TEST-MC66-19 'A) (TEST-MC66-19 'A 'B) (TEST-MC66-19 'A 'B 'C) (TEST-MC66-19 'A 'B 'C 'D) (TEST-MC66-19 'A 'B 'C 'D 'E) (TEST-MC66-19 'A 'B 'C 'D 'E 'F)))
EQUAL-OK: (("xyz" "def" RESULT DEF1 DEF2 NIL (A NIL NIL NIL)) ("xyz" "def" RESULT B DEF2 NIL (A B NIL NIL)) ("xyz" "def" RESULT B C NIL (A B C NIL)) ("xyz" "def" RESULT B C NIL (A B C D)) ("xyz" "def" RESULT B C (E) (A B C D E)) ("xyz" "def" RESULT B C (E F) (A B C D E F)))
(DEFINE-METHOD-COMBINATION MC67 (OPT1 &OPTIONAL (OPT2 "def")) ((ALL *)) (:ARGUMENTS A1 A2 &OPTIONAL (O1 'DEF1) (O2 'DEF2) &REST R) `(LIST ',OPT1 ',OPT2 'RESULT ,A1 ,A2 ,O1 ,O2 ,R (CALL-METHOD ,(FIRST ALL))))
EQL-OK: MC67
(PROGN (DEFGENERIC TEST-MC67-1 NIL (:METHOD-COMBINATION MC67 "xyz") (:METHOD NIL 'NIL)) (TEST-MC67-1))
EQUAL-OK: ("xyz" "def" RESULT NIL NIL DEF1 DEF2 NIL NIL)
(PROGN (DEFGENERIC TEST-MC67-2 (X) (:METHOD-COMBINATION MC67 "xyz") (:METHOD (X) (LIST X))) (TEST-MC67-2 'A))
EQUAL-OK: ("xyz" "def" RESULT A NIL DEF1 DEF2 NIL (A))
(PROGN (DEFGENERIC TEST-MC67-3 (X Y) (:METHOD-COMBINATION MC67 "xyz") (:METHOD (X Y) (LIST X Y))) (TEST-MC67-3 'A 'B))
EQUAL-OK: ("xyz" "def" RESULT A B DEF1 DEF2 NIL (A B))
(PROGN (DEFGENERIC TEST-MC67-4 (X Y Z) (:METHOD-COMBINATION MC67 "xyz") (:METHOD (X Y Z) (LIST X Y Z))) (TEST-MC67-4 'A 'B 'C))
EQUAL-OK: ("xyz" "def" RESULT A B DEF1 DEF2 NIL (A B C))
(PROGN (DEFGENERIC TEST-MC67-5 (X &OPTIONAL Y) (:METHOD-COMBINATION MC67 "xyz") (:METHOD (X &OPTIONAL Y) (LIST X Y))) (LIST (TEST-MC67-5 'A) (TEST-MC67-5 'A 'B)))
EQUAL-OK: (("xyz" "def" RESULT A NIL DEF1 DEF2 NIL (A NIL)) ("xyz" "def" RESULT A NIL B DEF2 NIL (A B)))
(PROGN (DEFGENERIC TEST-MC67-6 (X Y &OPTIONAL Z) (:METHOD-COMBINATION MC67 "xyz") (:METHOD (X Y &OPTIONAL Z) (LIST X Y Z))) (LIST (TEST-MC67-6 'A 'B) (TEST-MC67-6 'A 'B 'C)))
EQUAL-OK: (("xyz" "def" RESULT A B DEF1 DEF2 NIL (A B NIL)) ("xyz" "def" RESULT A B C DEF2 NIL (A B C)))
(PROGN (DEFGENERIC TEST-MC67-7 (X Y Z &OPTIONAL U) (:METHOD-COMBINATION MC67 "xyz") (:METHOD (X Y Z &OPTIONAL U) (LIST X Y Z U))) (LIST (TEST-MC67-7 'A 'B 'C) (TEST-MC67-7 'A 'B 'C 'D)))
EQUAL-OK: (("xyz" "def" RESULT A B DEF1 DEF2 NIL (A B C NIL)) ("xyz" "def" RESULT A B D DEF2 NIL (A B C D)))
(PROGN (DEFGENERIC TEST-MC67-8 (X &OPTIONAL Y Z) (:METHOD-COMBINATION MC67 "xyz") (:METHOD (X &OPTIONAL Y Z) (LIST X Y Z))) (LIST (TEST-MC67-8 'A) (TEST-MC67-8 'A 'B) (TEST-MC67-8 'A 'B 'C)))
EQUAL-OK: (("xyz" "def" RESULT A NIL DEF1 DEF2 NIL (A NIL NIL)) ("xyz" "def" RESULT A NIL B DEF2 NIL (A B NIL)) ("xyz" "def" RESULT A NIL B C NIL (A B C)))
(PROGN (DEFGENERIC TEST-MC67-9 (X Y &OPTIONAL Z U) (:METHOD-COMBINATION MC67 "xyz") (:METHOD (X Y &OPTIONAL Z U) (LIST X Y Z U))) (LIST (TEST-MC67-9 'A 'B) (TEST-MC67-9 'A 'B 'C) (TEST-MC67-9 'A 'B 'C 'D)))
EQUAL-OK: (("xyz" "def" RESULT A B DEF1 DEF2 NIL (A B NIL NIL)) ("xyz" "def" RESULT A B C DEF2 NIL (A B C NIL)) ("xyz" "def" RESULT A B C D NIL (A B C D)))
(PROGN (DEFGENERIC TEST-MC67-10 (X Y Z &OPTIONAL U V) (:METHOD-COMBINATION MC67 "xyz") (:METHOD (X Y Z &OPTIONAL U V) (LIST X Y Z U V))) (LIST (TEST-MC67-10 'A 'B 'C) (TEST-MC67-10 'A 'B 'C 'D) (TEST-MC67-10 'A 'B 'C 'D 'E)))
EQUAL-OK: (("xyz" "def" RESULT A B DEF1 DEF2 NIL (A B C NIL NIL)) ("xyz" "def" RESULT A B D DEF2 NIL (A B C D NIL)) ("xyz" "def" RESULT A B D E NIL (A B C D E)))
(PROGN (DEFGENERIC TEST-MC67-11 (X &OPTIONAL Y Z U) (:METHOD-COMBINATION MC67 "xyz") (:METHOD (X &OPTIONAL Y Z U) (LIST X Y Z U))) (LIST (TEST-MC67-11 'A) (TEST-MC67-11 'A 'B) (TEST-MC67-11 'A 'B 'C) (TEST-MC67-11 'A 'B 'C 'D)))
EQUAL-OK: (("xyz" "def" RESULT A NIL DEF1 DEF2 NIL (A NIL NIL NIL)) ("xyz" "def" RESULT A NIL B DEF2 NIL (A B NIL NIL)) ("xyz" "def" RESULT A NIL B C NIL (A B C NIL)) ("xyz" "def" RESULT A NIL B C NIL (A B C D)))
(PROGN (DEFGENERIC TEST-MC67-12 (X Y &OPTIONAL Z U V) (:METHOD-COMBINATION MC67 "xyz") (:METHOD (X Y &OPTIONAL Z U V) (LIST X Y Z U V))) (LIST (TEST-MC67-12 'A 'B) (TEST-MC67-12 'A 'B 'C) (TEST-MC67-12 'A 'B 'C 'D) (TEST-MC67-12 'A 'B 'C 'D 'E)))
EQUAL-OK: (("xyz" "def" RESULT A B DEF1 DEF2 NIL (A B NIL NIL NIL)) ("xyz" "def" RESULT A B C DEF2 NIL (A B C NIL NIL)) ("xyz" "def" RESULT A B C D NIL (A B C D NIL)) ("xyz" "def" RESULT A B C D NIL (A B C D E)))
(PROGN (DEFGENERIC TEST-MC67-13 (X Y Z &OPTIONAL U V W) (:METHOD-COMBINATION MC67 "xyz") (:METHOD (X Y Z &OPTIONAL U V W) (LIST X Y Z U V W))) (LIST (TEST-MC67-13 'A 'B 'C) (TEST-MC67-13 'A 'B 'C 'D) (TEST-MC67-13 'A 'B 'C 'D 'E) (TEST-MC67-13 'A 'B 'C 'D 'E 'F)))
EQUAL-OK: (("xyz" "def" RESULT A B DEF1 DEF2 NIL (A B C NIL NIL NIL)) ("xyz" "def" RESULT A B D DEF2 NIL (A B C D NIL NIL)) ("xyz" "def" RESULT A B D E NIL (A B C D E NIL)) ("xyz" "def" RESULT A B D E NIL (A B C D E F)))
(PROGN (DEFGENERIC TEST-MC67-14 (X &REST Y) (:METHOD-COMBINATION MC67 "xyz") (:METHOD (X &REST Y) (LIST* X Y))) (LIST (TEST-MC67-14 'A) (TEST-MC67-14 'A 'B) (TEST-MC67-14 'A 'B 'C)))
EQUAL-OK: (("xyz" "def" RESULT A NIL DEF1 DEF2 NIL (A)) ("xyz" "def" RESULT A NIL DEF1 DEF2 (B) (A B)) ("xyz" "def" RESULT A NIL DEF1 DEF2 (B C) (A B C)))
(PROGN (DEFGENERIC TEST-MC67-15 (X Y &REST Z) (:METHOD-COMBINATION MC67 "xyz") (:METHOD (X Y &REST Z) (LIST* X Y Z))) (LIST (TEST-MC67-15 'A 'B) (TEST-MC67-15 'A 'B 'C) (TEST-MC67-15 'A 'B 'C 'D)))
EQUAL-OK: (("xyz" "def" RESULT A B DEF1 DEF2 NIL (A B)) ("xyz" "def" RESULT A B DEF1 DEF2 (C) (A B C)) ("xyz" "def" RESULT A B DEF1 DEF2 (C D) (A B C D)))
(PROGN (DEFGENERIC TEST-MC67-16 (X Y Z &REST U) (:METHOD-COMBINATION MC67 "xyz") (:METHOD (X Y Z &REST U) (LIST* X Y Z U))) (LIST (TEST-MC67-16 'A 'B 'C) (TEST-MC67-16 'A 'B 'C 'D) (TEST-MC67-16 'A 'B 'C 'D 'E)))
EQUAL-OK: (("xyz" "def" RESULT A B DEF1 DEF2 NIL (A B C)) ("xyz" "def" RESULT A B DEF1 DEF2 (D) (A B C D)) ("xyz" "def" RESULT A B DEF1 DEF2 (D E) (A B C D E)))
(PROGN (DEFGENERIC TEST-MC67-17 (X &OPTIONAL Y &REST Z) (:METHOD-COMBINATION MC67 "xyz") (:METHOD (X &OPTIONAL Y &REST Z) (LIST* X Y Z))) (LIST (TEST-MC67-17 'A) (TEST-MC67-17 'A 'B) (TEST-MC67-17 'A 'B 'C) (TEST-MC67-17 'A 'B 'C 'D)))
EQUAL-OK: (("xyz" "def" RESULT A NIL DEF1 DEF2 NIL (A NIL)) ("xyz" "def" RESULT A NIL B DEF2 NIL (A B)) ("xyz" "def" RESULT A NIL B DEF2 (C) (A B C)) ("xyz" "def" RESULT A NIL B DEF2 (C D) (A B C D)))
(PROGN (DEFGENERIC TEST-MC67-18 (X &OPTIONAL Y Z &REST U) (:METHOD-COMBINATION MC67 "xyz") (:METHOD (X &OPTIONAL Y Z &REST U) (LIST* X Y Z U))) (LIST (TEST-MC67-18 'A) (TEST-MC67-18 'A 'B) (TEST-MC67-18 'A 'B 'C) (TEST-MC67-18 'A 'B 'C 'D) (TEST-MC67-18 'A 'B 'C 'D 'E)))
EQUAL-OK: (("xyz" "def" RESULT A NIL DEF1 DEF2 NIL (A NIL NIL)) ("xyz" "def" RESULT A NIL B DEF2 NIL (A B NIL)) ("xyz" "def" RESULT A NIL B C NIL (A B C)) ("xyz" "def" RESULT A NIL B C (D) (A B C D)) ("xyz" "def" RESULT A NIL B C (D E) (A B C D E)))
(PROGN (DEFGENERIC TEST-MC67-19 (X &OPTIONAL Y Z U &REST V) (:METHOD-COMBINATION MC67 "xyz") (:METHOD (X &OPTIONAL Y Z U &REST V) (LIST* X Y Z U V))) (LIST (TEST-MC67-19 'A) (TEST-MC67-19 'A 'B) (TEST-MC67-19 'A 'B 'C) (TEST-MC67-19 'A 'B 'C 'D) (TEST-MC67-19 'A 'B 'C 'D 'E) (TEST-MC67-19 'A 'B 'C 'D 'E 'F)))
EQUAL-OK: (("xyz" "def" RESULT A NIL DEF1 DEF2 NIL (A NIL NIL NIL)) ("xyz" "def" RESULT A NIL B DEF2 NIL (A B NIL NIL)) ("xyz" "def" RESULT A NIL B C NIL (A B C NIL)) ("xyz" "def" RESULT A NIL B C NIL (A B C D)) ("xyz" "def" RESULT A NIL B C (E) (A B C D E)) ("xyz" "def" RESULT A NIL B C (E F) (A B C D E F)))
(DEFINE-METHOD-COMBINATION MC68 (OPT1 &OPTIONAL (OPT2 "def")) ((ALL *)) (:ARGUMENTS A1 A2 &OPTIONAL (O1 'DEF1) (O2 'DEF2) &KEY (TEST 'EQ) (TEST-NOT 'NEQ)) `(LIST ',OPT1 ',OPT2 'RESULT ,A1 ,A2 ,O1 ,O2 ,TEST ,TEST-NOT (CALL-METHOD ,(FIRST ALL))))
EQL-OK: MC68
(PROGN (DEFGENERIC TEST-MC68-1 (X &OPTIONAL Y) (:METHOD-COMBINATION MC68 "xyz") (:METHOD (X &OPTIONAL Y) (LIST X Y))) (LIST (TEST-MC68-1 'A) (TEST-MC68-1 'A 'B)))
EQUAL-OK: (("xyz" "def" RESULT A NIL DEF1 DEF2 EQ NEQ (A NIL)) ("xyz" "def" RESULT A NIL B DEF2 EQ NEQ (A B)))
(PROGN (DEFGENERIC TEST-MC68-2 (X Y Z &OPTIONAL U V W) (:METHOD-COMBINATION MC68 "xyz") (:METHOD (X Y Z &OPTIONAL U V W) (LIST X Y Z U V W))) (LIST (TEST-MC68-2 'A 'B 'C) (TEST-MC68-2 'A 'B 'C 'D) (TEST-MC68-2 'A 'B 'C 'D 'E) (TEST-MC68-2 'A 'B 'C 'D 'E 'F)))
EQUAL-OK: (("xyz" "def" RESULT A B DEF1 DEF2 EQ NEQ (A B C NIL NIL NIL)) ("xyz" "def" RESULT A B D DEF2 EQ NEQ (A B C D NIL NIL)) ("xyz" "def" RESULT A B D E EQ NEQ (A B C D E NIL)) ("xyz" "def" RESULT A B D E EQ NEQ (A B C D E F)))
(PROGN (DEFGENERIC TEST-MC68-3 (X &REST Y) (:METHOD-COMBINATION MC68 "xyz") (:METHOD (X &REST Y) (LIST* X Y))) (LIST (TEST-MC68-3 'A) (TEST-MC68-3 'A 'B 'C) (TEST-MC68-3 'A :TEST-NOT 'NEQUAL :TEST 'EQL :TEST-NOT 'NEQUALP)))
EQUAL-OK: (("xyz" "def" RESULT A NIL DEF1 DEF2 EQ NEQ (A)) ("xyz" "def" RESULT A NIL DEF1 DEF2 EQ NEQ (A B C)) ("xyz" "def" RESULT A NIL DEF1 DEF2 EQL NEQUAL (A :TEST-NOT NEQUAL :TEST EQL :TEST-NOT NEQUALP)))
(PROGN (DEFGENERIC TEST-MC68-4 (X &REST Y) (:METHOD-COMBINATION MC68 "xyz") (:METHOD (X &REST Y) (LIST* X Y))) (TEST-MC68-4 'A 'B))
[SIMPLE-PROGRAM-ERROR]: TEST-MC68-4-<EMF-1>-1-1: keyword arguments in (B) should occur pairwise
EQL-OK: ERROR
(PROGN (DEFGENERIC TEST-MC68-5 (X Y Z &REST U) (:METHOD-COMBINATION MC68 "xyz") (:METHOD (X Y Z &REST U) (LIST* X Y Z U))) (LIST (TEST-MC68-5 'A :TEST 'EQ) (TEST-MC68-5 'A :TEST 'EQ 'D 'E) (TEST-MC68-5 'A :TEST 'EQ :TEST-NOT 'NEQUAL :TEST 'EQL :TEST-NOT 'NEQUALP)))
EQUAL-OK: (("xyz" "def" RESULT A :TEST DEF1 DEF2 EQ NEQ (A :TEST EQ)) ("xyz" "def" RESULT A :TEST DEF1 DEF2 EQ NEQ (A :TEST EQ D E)) ("xyz" "def" RESULT A :TEST DEF1 DEF2 EQL NEQUAL (A :TEST EQ :TEST-NOT NEQUAL :TEST EQL :TEST-NOT NEQUALP)))
(PROGN (DEFGENERIC TEST-MC68-6 (X &OPTIONAL Y Z U &REST V) (:METHOD-COMBINATION MC68 "xyz") (:METHOD (X &OPTIONAL Y Z U &REST V) (LIST* X Y Z U V))) (LIST (TEST-MC68-6 'A) (TEST-MC68-6 'A 'B 'C) (TEST-MC68-6 'A :TEST 'EQ 'D :TEST-NOT 'NEQUAL :TEST 'EQL :TEST-NOT 'NEQUALP)))
EQUAL-OK: (("xyz" "def" RESULT A NIL DEF1 DEF2 EQ NEQ (A NIL NIL NIL)) ("xyz" "def" RESULT A NIL B C EQ NEQ (A B C NIL)) ("xyz" "def" RESULT A NIL :TEST EQ EQL NEQUAL (A :TEST EQ D :TEST-NOT NEQUAL :TEST EQL :TEST-NOT NEQUALP)))
(DEFINE-METHOD-COMBINATION MC69 (OPT1 &OPTIONAL (OPT2 "def")) ((ALL *)) (:ARGUMENTS &WHOLE WHOLE) `(LIST ',OPT1 ',OPT2 'RESULT ,WHOLE (CALL-METHOD ,(FIRST ALL))))
EQL-OK: MC69
(PROGN (DEFGENERIC TEST-MC69-1 NIL (:METHOD-COMBINATION MC69 "xyz") (:METHOD NIL 'NIL)) (TEST-MC69-1))
EQUAL-OK: ("xyz" "def" RESULT NIL NIL)
(PROGN (DEFGENERIC TEST-MC69-2 (X) (:METHOD-COMBINATION MC69 "xyz") (:METHOD (X) (LIST X))) (TEST-MC69-2 'A))
EQUAL-OK: ("xyz" "def" RESULT (A) (A))
(PROGN (DEFGENERIC TEST-MC69-3 (X Y) (:METHOD-COMBINATION MC69 "xyz") (:METHOD (X Y) (LIST X Y))) (TEST-MC69-3 'A 'B))
EQUAL-OK: ("xyz" "def" RESULT (A B) (A B))
(PROGN (DEFGENERIC TEST-MC69-4 (X Y Z) (:METHOD-COMBINATION MC69 "xyz") (:METHOD (X Y Z) (LIST X Y Z))) (TEST-MC69-4 'A 'B 'C))
EQUAL-OK: ("xyz" "def" RESULT (A B C) (A B C))
(PROGN (DEFGENERIC TEST-MC69-5 (X &OPTIONAL Y) (:METHOD-COMBINATION MC69 "xyz") (:METHOD (X &OPTIONAL Y) (LIST X Y))) (LIST (TEST-MC69-5 'A) (TEST-MC69-5 'A 'B)))
EQUAL-OK: (("xyz" "def" RESULT (A) (A NIL)) ("xyz" "def" RESULT (A B) (A B)))
(PROGN (DEFGENERIC TEST-MC69-6 (X Y &OPTIONAL Z) (:METHOD-COMBINATION MC69 "xyz") (:METHOD (X Y &OPTIONAL Z) (LIST X Y Z))) (LIST (TEST-MC69-6 'A 'B) (TEST-MC69-6 'A 'B 'C)))
EQUAL-OK: (("xyz" "def" RESULT (A B) (A B NIL)) ("xyz" "def" RESULT (A B C) (A B C)))
(PROGN (DEFGENERIC TEST-MC69-7 (X Y Z &OPTIONAL U) (:METHOD-COMBINATION MC69 "xyz") (:METHOD (X Y Z &OPTIONAL U) (LIST X Y Z U))) (LIST (TEST-MC69-7 'A 'B 'C) (TEST-MC69-7 'A 'B 'C 'D)))
EQUAL-OK: (("xyz" "def" RESULT (A B C) (A B C NIL)) ("xyz" "def" RESULT (A B C D) (A B C D)))
(PROGN (DEFGENERIC TEST-MC69-8 (X &OPTIONAL Y Z) (:METHOD-COMBINATION MC69 "xyz") (:METHOD (X &OPTIONAL Y Z) (LIST X Y Z))) (LIST (TEST-MC69-8 'A) (TEST-MC69-8 'A 'B) (TEST-MC69-8 'A 'B 'C)))
EQUAL-OK: (("xyz" "def" RESULT (A) (A NIL NIL)) ("xyz" "def" RESULT (A B) (A B NIL)) ("xyz" "def" RESULT (A B C) (A B C)))
(PROGN (DEFGENERIC TEST-MC69-9 (X Y &OPTIONAL Z U) (:METHOD-COMBINATION MC69 "xyz") (:METHOD (X Y &OPTIONAL Z U) (LIST X Y Z U))) (LIST (TEST-MC69-9 'A 'B) (TEST-MC69-9 'A 'B 'C) (TEST-MC69-9 'A 'B 'C 'D)))
EQUAL-OK: (("xyz" "def" RESULT (A B) (A B NIL NIL)) ("xyz" "def" RESULT (A B C) (A B C NIL)) ("xyz" "def" RESULT (A B C D) (A B C D)))
(PROGN (DEFGENERIC TEST-MC69-10 (X Y Z &OPTIONAL U V) (:METHOD-COMBINATION MC69 "xyz") (:METHOD (X Y Z &OPTIONAL U V) (LIST X Y Z U V))) (LIST (TEST-MC69-10 'A 'B 'C) (TEST-MC69-10 'A 'B 'C 'D) (TEST-MC69-10 'A 'B 'C 'D 'E)))
EQUAL-OK: (("xyz" "def" RESULT (A B C) (A B C NIL NIL)) ("xyz" "def" RESULT (A B C D) (A B C D NIL)) ("xyz" "def" RESULT (A B C D E) (A B C D E)))
(PROGN (DEFGENERIC TEST-MC69-11 (X &OPTIONAL Y Z U) (:METHOD-COMBINATION MC69 "xyz") (:METHOD (X &OPTIONAL Y Z U) (LIST X Y Z U))) (LIST (TEST-MC69-11 'A) (TEST-MC69-11 'A 'B) (TEST-MC69-11 'A 'B 'C) (TEST-MC69-11 'A 'B 'C 'D)))
EQUAL-OK: (("xyz" "def" RESULT (A) (A NIL NIL NIL)) ("xyz" "def" RESULT (A B) (A B NIL NIL)) ("xyz" "def" RESULT (A B C) (A B C NIL)) ("xyz" "def" RESULT (A B C D) (A B C D)))
(PROGN (DEFGENERIC TEST-MC69-12 (X Y &OPTIONAL Z U V) (:METHOD-COMBINATION MC69 "xyz") (:METHOD (X Y &OPTIONAL Z U V) (LIST X Y Z U V))) (LIST (TEST-MC69-12 'A 'B) (TEST-MC69-12 'A 'B 'C) (TEST-MC69-12 'A 'B 'C 'D) (TEST-MC69-12 'A 'B 'C 'D 'E)))
EQUAL-OK: (("xyz" "def" RESULT (A B) (A B NIL NIL NIL)) ("xyz" "def" RESULT (A B C) (A B C NIL NIL)) ("xyz" "def" RESULT (A B C D) (A B C D NIL)) ("xyz" "def" RESULT (A B C D E) (A B C D E)))
(PROGN (DEFGENERIC TEST-MC69-13 (X Y Z &OPTIONAL U V W) (:METHOD-COMBINATION MC69 "xyz") (:METHOD (X Y Z &OPTIONAL U V W) (LIST X Y Z U V W))) (LIST (TEST-MC69-13 'A 'B 'C) (TEST-MC69-13 'A 'B 'C 'D) (TEST-MC69-13 'A 'B 'C 'D 'E) (TEST-MC69-13 'A 'B 'C 'D 'E 'F)))
EQUAL-OK: (("xyz" "def" RESULT (A B C) (A B C NIL NIL NIL)) ("xyz" "def" RESULT (A B C D) (A B C D NIL NIL)) ("xyz" "def" RESULT (A B C D E) (A B C D E NIL)) ("xyz" "def" RESULT (A B C D E F) (A B C D E F)))
(PROGN (DEFGENERIC TEST-MC69-14 (X &REST Y) (:METHOD-COMBINATION MC69 "xyz") (:METHOD (X &REST Y) (LIST* X Y))) (LIST (TEST-MC69-14 'A) (TEST-MC69-14 'A 'B) (TEST-MC69-14 'A 'B 'C)))
EQUAL-OK: (("xyz" "def" RESULT (A) (A)) ("xyz" "def" RESULT (A B) (A B)) ("xyz" "def" RESULT (A B C) (A B C)))
(PROGN (DEFGENERIC TEST-MC69-15 (X Y &REST Z) (:METHOD-COMBINATION MC69 "xyz") (:METHOD (X Y &REST Z) (LIST* X Y Z))) (LIST (TEST-MC69-15 'A 'B) (TEST-MC69-15 'A 'B 'C) (TEST-MC69-15 'A 'B 'C 'D)))
EQUAL-OK: (("xyz" "def" RESULT (A B) (A B)) ("xyz" "def" RESULT (A B C) (A B C)) ("xyz" "def" RESULT (A B C D) (A B C D)))
(PROGN (DEFGENERIC TEST-MC69-16 (X Y Z &REST U) (:METHOD-COMBINATION MC69 "xyz") (:METHOD (X Y Z &REST U) (LIST* X Y Z U))) (LIST (TEST-MC69-16 'A 'B 'C) (TEST-MC69-16 'A 'B 'C 'D) (TEST-MC69-16 'A 'B 'C 'D 'E)))
EQUAL-OK: (("xyz" "def" RESULT (A B C) (A B C)) ("xyz" "def" RESULT (A B C D) (A B C D)) ("xyz" "def" RESULT (A B C D E) (A B C D E)))
(PROGN (DEFGENERIC TEST-MC69-17 (X &OPTIONAL Y &REST Z) (:METHOD-COMBINATION MC69 "xyz") (:METHOD (X &OPTIONAL Y &REST Z) (LIST* X Y Z))) (LIST (TEST-MC69-17 'A) (TEST-MC69-17 'A 'B) (TEST-MC69-17 'A 'B 'C) (TEST-MC69-17 'A 'B 'C 'D)))
EQUAL-OK: (("xyz" "def" RESULT (A) (A NIL)) ("xyz" "def" RESULT (A B) (A B)) ("xyz" "def" RESULT (A B C) (A B C)) ("xyz" "def" RESULT (A B C D) (A B C D)))
(PROGN (DEFGENERIC TEST-MC69-18 (X &OPTIONAL Y Z &REST U) (:METHOD-COMBINATION MC69 "xyz") (:METHOD (X &OPTIONAL Y Z &REST U) (LIST* X Y Z U))) (LIST (TEST-MC69-18 'A) (TEST-MC69-18 'A 'B) (TEST-MC69-18 'A 'B 'C) (TEST-MC69-18 'A 'B 'C 'D) (TEST-MC69-18 'A 'B 'C 'D 'E)))
EQUAL-OK: (("xyz" "def" RESULT (A) (A NIL NIL)) ("xyz" "def" RESULT (A B) (A B NIL)) ("xyz" "def" RESULT (A B C) (A B C)) ("xyz" "def" RESULT (A B C D) (A B C D)) ("xyz" "def" RESULT (A B C D E) (A B C D E)))
(PROGN (DEFGENERIC TEST-MC69-19 (X &OPTIONAL Y Z U &REST V) (:METHOD-COMBINATION MC69 "xyz") (:METHOD (X &OPTIONAL Y Z U &REST V) (LIST* X Y Z U V))) (LIST (TEST-MC69-19 'A) (TEST-MC69-19 'A 'B) (TEST-MC69-19 'A 'B 'C) (TEST-MC69-19 'A 'B 'C 'D) (TEST-MC69-19 'A 'B 'C 'D 'E) (TEST-MC69-19 'A 'B 'C 'D 'E 'F)))
EQUAL-OK: (("xyz" "def" RESULT (A) (A NIL NIL NIL)) ("xyz" "def" RESULT (A B) (A B NIL NIL)) ("xyz" "def" RESULT (A B C) (A B C NIL)) ("xyz" "def" RESULT (A B C D) (A B C D)) ("xyz" "def" RESULT (A B C D E) (A B C D E)) ("xyz" "def" RESULT (A B C D E F) (A B C D E F)))
(DEFINE-METHOD-COMBINATION MC70 (OPT1 &OPTIONAL (OPT2 "def")) ((ALL *)) (:ARGUMENTS &WHOLE WHOLE A1 A2 &OPTIONAL (O1 'DEF1) (O2 'DEF2) &REST R) `(LIST ',OPT1 ',OPT2 'RESULT ,WHOLE ,A1 ,A2 ,O1 ,O2 ,R (CALL-METHOD ,(FIRST ALL))))
EQL-OK: MC70
(PROGN (DEFGENERIC TEST-MC70-1 NIL (:METHOD-COMBINATION MC70 "xyz") (:METHOD NIL 'NIL)) (TEST-MC70-1))
EQUAL-OK: ("xyz" "def" RESULT NIL NIL NIL DEF1 DEF2 NIL NIL)
(PROGN (DEFGENERIC TEST-MC70-2 (X) (:METHOD-COMBINATION MC70 "xyz") (:METHOD (X) (LIST X))) (TEST-MC70-2 'A))
EQUAL-OK: ("xyz" "def" RESULT (A) A NIL DEF1 DEF2 NIL (A))
(PROGN (DEFGENERIC TEST-MC70-3 (X Y) (:METHOD-COMBINATION MC70 "xyz") (:METHOD (X Y) (LIST X Y))) (TEST-MC70-3 'A 'B))
EQUAL-OK: ("xyz" "def" RESULT (A B) A B DEF1 DEF2 NIL (A B))
(PROGN (DEFGENERIC TEST-MC70-4 (X Y Z) (:METHOD-COMBINATION MC70 "xyz") (:METHOD (X Y Z) (LIST X Y Z))) (TEST-MC70-4 'A 'B 'C))
EQUAL-OK: ("xyz" "def" RESULT (A B C) A B DEF1 DEF2 NIL (A B C))
(PROGN (DEFGENERIC TEST-MC70-5 (X &OPTIONAL Y) (:METHOD-COMBINATION MC70 "xyz") (:METHOD (X &OPTIONAL Y) (LIST X Y))) (LIST (TEST-MC70-5 'A) (TEST-MC70-5 'A 'B)))
EQUAL-OK: (("xyz" "def" RESULT (A) A NIL DEF1 DEF2 NIL (A NIL)) ("xyz" "def" RESULT (A B) A NIL B DEF2 NIL (A B)))
(PROGN (DEFGENERIC TEST-MC70-6 (X Y &OPTIONAL Z) (:METHOD-COMBINATION MC70 "xyz") (:METHOD (X Y &OPTIONAL Z) (LIST X Y Z))) (LIST (TEST-MC70-6 'A 'B) (TEST-MC70-6 'A 'B 'C)))
EQUAL-OK: (("xyz" "def" RESULT (A B) A B DEF1 DEF2 NIL (A B NIL)) ("xyz" "def" RESULT (A B C) A B C DEF2 NIL (A B C)))
(PROGN (DEFGENERIC TEST-MC70-7 (X Y Z &OPTIONAL U) (:METHOD-COMBINATION MC70 "xyz") (:METHOD (X Y Z &OPTIONAL U) (LIST X Y Z U))) (LIST (TEST-MC70-7 'A 'B 'C) (TEST-MC70-7 'A 'B 'C 'D)))
EQUAL-OK: (("xyz" "def" RESULT (A B C) A B DEF1 DEF2 NIL (A B C NIL)) ("xyz" "def" RESULT (A B C D) A B D DEF2 NIL (A B C D)))
(PROGN (DEFGENERIC TEST-MC70-8 (X &OPTIONAL Y Z) (:METHOD-COMBINATION MC70 "xyz") (:METHOD (X &OPTIONAL Y Z) (LIST X Y Z))) (LIST (TEST-MC70-8 'A) (TEST-MC70-8 'A 'B) (TEST-MC70-8 'A 'B 'C)))
EQUAL-OK: (("xyz" "def" RESULT (A) A NIL DEF1 DEF2 NIL (A NIL NIL)) ("xyz" "def" RESULT (A B) A NIL B DEF2 NIL (A B NIL)) ("xyz" "def" RESULT (A B C) A NIL B C NIL (A B C)))
(PROGN (DEFGENERIC TEST-MC70-9 (X Y &OPTIONAL Z U) (:METHOD-COMBINATION MC70 "xyz") (:METHOD (X Y &OPTIONAL Z U) (LIST X Y Z U))) (LIST (TEST-MC70-9 'A 'B) (TEST-MC70-9 'A 'B 'C) (TEST-MC70-9 'A 'B 'C 'D)))
EQUAL-OK: (("xyz" "def" RESULT (A B) A B DEF1 DEF2 NIL (A B NIL NIL)) ("xyz" "def" RESULT (A B C) A B C DEF2 NIL (A B C NIL)) ("xyz" "def" RESULT (A B C D) A B C D NIL (A B C D)))
(PROGN (DEFGENERIC TEST-MC70-10 (X Y Z &OPTIONAL U V) (:METHOD-COMBINATION MC70 "xyz") (:METHOD (X Y Z &OPTIONAL U V) (LIST X Y Z U V))) (LIST (TEST-MC70-10 'A 'B 'C) (TEST-MC70-10 'A 'B 'C 'D) (TEST-MC70-10 'A 'B 'C 'D 'E)))
EQUAL-OK: (("xyz" "def" RESULT (A B C) A B DEF1 DEF2 NIL (A B C NIL NIL)) ("xyz" "def" RESULT (A B C D) A B D DEF2 NIL (A B C D NIL)) ("xyz" "def" RESULT (A B C D E) A B D E NIL (A B C D E)))
(PROGN (DEFGENERIC TEST-MC70-11 (X &OPTIONAL Y Z U) (:METHOD-COMBINATION MC70 "xyz") (:METHOD (X &OPTIONAL Y Z U) (LIST X Y Z U))) (LIST (TEST-MC70-11 'A) (TEST-MC70-11 'A 'B) (TEST-MC70-11 'A 'B 'C) (TEST-MC70-11 'A 'B 'C 'D)))
EQUAL-OK: (("xyz" "def" RESULT (A) A NIL DEF1 DEF2 NIL (A NIL NIL NIL)) ("xyz" "def" RESULT (A B) A NIL B DEF2 NIL (A B NIL NIL)) ("xyz" "def" RESULT (A B C) A NIL B C NIL (A B C NIL)) ("xyz" "def" RESULT (A B C D) A NIL B C NIL (A B C D)))
(PROGN (DEFGENERIC TEST-MC70-12 (X Y &OPTIONAL Z U V) (:METHOD-COMBINATION MC70 "xyz") (:METHOD (X Y &OPTIONAL Z U V) (LIST X Y Z U V))) (LIST (TEST-MC70-12 'A 'B) (TEST-MC70-12 'A 'B 'C) (TEST-MC70-12 'A 'B 'C 'D) (TEST-MC70-12 'A 'B 'C 'D 'E)))
EQUAL-OK: (("xyz" "def" RESULT (A B) A B DEF1 DEF2 NIL (A B NIL NIL NIL)) ("xyz" "def" RESULT (A B C) A B C DEF2 NIL (A B C NIL NIL)) ("xyz" "def" RESULT (A B C D) A B C D NIL (A B C D NIL)) ("xyz" "def" RESULT (A B C D E) A B C D NIL (A B C D E)))
(PROGN (DEFGENERIC TEST-MC70-13 (X Y Z &OPTIONAL U V W) (:METHOD-COMBINATION MC70 "xyz") (:METHOD (X Y Z &OPTIONAL U V W) (LIST X Y Z U V W))) (LIST (TEST-MC70-13 'A 'B 'C) (TEST-MC70-13 'A 'B 'C 'D) (TEST-MC70-13 'A 'B 'C 'D 'E) (TEST-MC70-13 'A 'B 'C 'D 'E 'F)))
EQUAL-OK: (("xyz" "def" RESULT (A B C) A B DEF1 DEF2 NIL (A B C NIL NIL NIL)) ("xyz" "def" RESULT (A B C D) A B D DEF2 NIL (A B C D NIL NIL)) ("xyz" "def" RESULT (A B C D E) A B D E NIL (A B C D E NIL)) ("xyz" "def" RESULT (A B C D E F) A B D E NIL (A B C D E F)))
(PROGN (DEFGENERIC TEST-MC70-14 (X &REST Y) (:METHOD-COMBINATION MC70 "xyz") (:METHOD (X &REST Y) (LIST* X Y))) (LIST (TEST-MC70-14 'A) (TEST-MC70-14 'A 'B) (TEST-MC70-14 'A 'B 'C)))
EQUAL-OK: (("xyz" "def" RESULT (A) A NIL DEF1 DEF2 NIL (A)) ("xyz" "def" RESULT (A B) A NIL DEF1 DEF2 (B) (A B)) ("xyz" "def" RESULT (A B C) A NIL DEF1 DEF2 (B C) (A B C)))
(PROGN (DEFGENERIC TEST-MC70-15 (X Y &REST Z) (:METHOD-COMBINATION MC70 "xyz") (:METHOD (X Y &REST Z) (LIST* X Y Z))) (LIST (TEST-MC70-15 'A 'B) (TEST-MC70-15 'A 'B 'C) (TEST-MC70-15 'A 'B 'C 'D)))
EQUAL-OK: (("xyz" "def" RESULT (A B) A B DEF1 DEF2 NIL (A B)) ("xyz" "def" RESULT (A B C) A B DEF1 DEF2 (C) (A B C)) ("xyz" "def" RESULT (A B C D) A B DEF1 DEF2 (C D) (A B C D)))
(PROGN (DEFGENERIC TEST-MC70-16 (X Y Z &REST U) (:METHOD-COMBINATION MC70 "xyz") (:METHOD (X Y Z &REST U) (LIST* X Y Z U))) (LIST (TEST-MC70-16 'A 'B 'C) (TEST-MC70-16 'A 'B 'C 'D) (TEST-MC70-16 'A 'B 'C 'D 'E)))
EQUAL-OK: (("xyz" "def" RESULT (A B C) A B DEF1 DEF2 NIL (A B C)) ("xyz" "def" RESULT (A B C D) A B DEF1 DEF2 (D) (A B C D)) ("xyz" "def" RESULT (A B C D E) A B DEF1 DEF2 (D E) (A B C D E)))
(PROGN (DEFGENERIC TEST-MC70-17 (X &OPTIONAL Y &REST Z) (:METHOD-COMBINATION MC70 "xyz") (:METHOD (X &OPTIONAL Y &REST Z) (LIST* X Y Z))) (LIST (TEST-MC70-17 'A) (TEST-MC70-17 'A 'B) (TEST-MC70-17 'A 'B 'C) (TEST-MC70-17 'A 'B 'C 'D)))
EQUAL-OK: (("xyz" "def" RESULT (A) A NIL DEF1 DEF2 NIL (A NIL)) ("xyz" "def" RESULT (A B) A NIL B DEF2 NIL (A B)) ("xyz" "def" RESULT (A B C) A NIL B DEF2 (C) (A B C)) ("xyz" "def" RESULT (A B C D) A NIL B DEF2 (C D) (A B C D)))
(PROGN (DEFGENERIC TEST-MC70-18 (X &OPTIONAL Y Z &REST U) (:METHOD-COMBINATION MC70 "xyz") (:METHOD (X &OPTIONAL Y Z &REST U) (LIST* X Y Z U))) (LIST (TEST-MC70-18 'A) (TEST-MC70-18 'A 'B) (TEST-MC70-18 'A 'B 'C) (TEST-MC70-18 'A 'B 'C 'D) (TEST-MC70-18 'A 'B 'C 'D 'E)))
EQUAL-OK: (("xyz" "def" RESULT (A) A NIL DEF1 DEF2 NIL (A NIL NIL)) ("xyz" "def" RESULT (A B) A NIL B DEF2 NIL (A B NIL)) ("xyz" "def" RESULT (A B C) A NIL B C NIL (A B C)) ("xyz" "def" RESULT (A B C D) A NIL B C (D) (A B C D)) ("xyz" "def" RESULT (A B C D E) A NIL B C (D E) (A B C D E)))
(PROGN (DEFGENERIC TEST-MC70-19 (X &OPTIONAL Y Z U &REST V) (:METHOD-COMBINATION MC70 "xyz") (:METHOD (X &OPTIONAL Y Z U &REST V) (LIST* X Y Z U V))) (LIST (TEST-MC70-19 'A) (TEST-MC70-19 'A 'B) (TEST-MC70-19 'A 'B 'C) (TEST-MC70-19 'A 'B 'C 'D) (TEST-MC70-19 'A 'B 'C 'D 'E) (TEST-MC70-19 'A 'B 'C 'D 'E 'F)))
EQUAL-OK: (("xyz" "def" RESULT (A) A NIL DEF1 DEF2 NIL (A NIL NIL NIL)) ("xyz" "def" RESULT (A B) A NIL B DEF2 NIL (A B NIL NIL)) ("xyz" "def" RESULT (A B C) A NIL B C NIL (A B C NIL)) ("xyz" "def" RESULT (A B C D) A NIL B C NIL (A B C D)) ("xyz" "def" RESULT (A B C D E) A NIL B C (E) (A B C D E)) ("xyz" "def" RESULT (A B C D E F) A NIL B C (E F) (A B C D E F)))
(DEFINE-METHOD-COMBINATION MC71 (OPT1 &OPTIONAL (OPT2 "def")) ((ALL *)) (:ARGUMENTS &OPTIONAL (O1 'DEF1 OS1) (O2 'DEF2 OS2)) `(LIST ',OPT1 ',OPT2 'RESULT ,O1 ,O2 ,OS1 ,OS2 (CALL-METHOD ,(FIRST ALL))))
EQL-OK: MC71
(PROGN (DEFGENERIC TEST-MC71-1 (X) (:METHOD-COMBINATION MC71 "xyz") (:METHOD (X) (LIST X))) (TEST-MC71-1 'A))
EQUAL-OK: ("xyz" "def" RESULT DEF1 DEF2 NIL NIL (A))
(PROGN (DEFGENERIC TEST-MC71-2 (X &OPTIONAL Y) (:METHOD-COMBINATION MC71 "xyz") (:METHOD (X &OPTIONAL Y) (LIST X Y))) (LIST (TEST-MC71-2 'A) (TEST-MC71-2 'A 'B)))
EQUAL-OK: (("xyz" "def" RESULT DEF1 DEF2 NIL NIL (A NIL)) ("xyz" "def" RESULT B DEF2 T NIL (A B)))
(PROGN (DEFGENERIC TEST-MC71-3 (X &OPTIONAL Y Z) (:METHOD-COMBINATION MC71 "xyz") (:METHOD (X &OPTIONAL Y Z) (LIST X Y Z))) (LIST (TEST-MC71-3 'A) (TEST-MC71-3 'A 'B) (TEST-MC71-3 'A 'B 'C)))
EQUAL-OK: (("xyz" "def" RESULT DEF1 DEF2 NIL NIL (A NIL NIL)) ("xyz" "def" RESULT B DEF2 T NIL (A B NIL)) ("xyz" "def" RESULT B C T T (A B C)))
(PROGN (DEFGENERIC TEST-MC71-4 (X &OPTIONAL Y Z U) (:METHOD-COMBINATION MC71 "xyz") (:METHOD (X &OPTIONAL Y Z U) (LIST X Y Z U))) (LIST (TEST-MC71-4 'A) (TEST-MC71-4 'A 'B) (TEST-MC71-4 'A 'B 'C) (TEST-MC71-4 'A 'B 'C 'D)))
EQUAL-OK: (("xyz" "def" RESULT DEF1 DEF2 NIL NIL (A NIL NIL NIL)) ("xyz" "def" RESULT B DEF2 T NIL (A B NIL NIL)) ("xyz" "def" RESULT B C T T (A B C NIL)) ("xyz" "def" RESULT B C T T (A B C D)))
(PROGN (DEFGENERIC TEST-MC71-5 (X &REST Y) (:METHOD-COMBINATION MC71 "xyz") (:METHOD (X &REST Y) (LIST* X Y))) (LIST (TEST-MC71-5 'A) (TEST-MC71-5 'A 'B) (TEST-MC71-5 'A 'B 'C)))
EQUAL-OK: (("xyz" "def" RESULT DEF1 DEF2 NIL NIL (A)) ("xyz" "def" RESULT DEF1 DEF2 NIL NIL (A B)) ("xyz" "def" RESULT DEF1 DEF2 NIL NIL (A B C)))
(PROGN (DEFGENERIC TEST-MC71-6 (X &OPTIONAL Y &REST Z) (:METHOD-COMBINATION MC71 "xyz") (:METHOD (X &OPTIONAL Y &REST Z) (LIST* X Y Z))) (LIST (TEST-MC71-6 'A) (TEST-MC71-6 'A 'B) (TEST-MC71-6 'A 'B 'C)))
EQUAL-OK: (("xyz" "def" RESULT DEF1 DEF2 NIL NIL (A NIL)) ("xyz" "def" RESULT B DEF2 T NIL (A B)) ("xyz" "def" RESULT B DEF2 T NIL (A B C)))
(PROGN (DEFGENERIC TEST-MC71-7 (X &OPTIONAL Y Z &REST U) (:METHOD-COMBINATION MC71 "xyz") (:METHOD (X &OPTIONAL Y Z &REST U) (LIST* X Y Z U))) (LIST (TEST-MC71-7 'A) (TEST-MC71-7 'A 'B) (TEST-MC71-7 'A 'B 'C) (TEST-MC71-7 'A 'B 'C 'D)))
EQUAL-OK: (("xyz" "def" RESULT DEF1 DEF2 NIL NIL (A NIL NIL)) ("xyz" "def" RESULT B DEF2 T NIL (A B NIL)) ("xyz" "def" RESULT B C T T (A B C)) ("xyz" "def" RESULT B C T T (A B C D)))
(DEFINE-METHOD-COMBINATION MC72 (OPT1 &OPTIONAL (OPT2 "def")) ((ALL *)) (:ARGUMENTS A1 A2 &OPTIONAL (O1 'DEF1) (O2 'DEF2) &KEY (TEST 'EQ TEST-P) (TEST-NOT 'NEQ TEST-NOT-P)) `(LIST ',OPT1 ',OPT2 'RESULT ,A1 ,A2 ,O1 ,O2 ,TEST ,TEST-NOT ,TEST-P ,TEST-NOT-P (CALL-METHOD ,(FIRST ALL))))
EQL-OK: MC72
(PROGN (DEFGENERIC TEST-MC72-1 (X &OPTIONAL Y) (:METHOD-COMBINATION MC72 "xyz") (:METHOD (X &OPTIONAL Y) (LIST X Y))) (LIST (TEST-MC72-1 'A) (TEST-MC72-1 'A 'B)))
EQUAL-OK: (("xyz" "def" RESULT A NIL DEF1 DEF2 EQ NEQ NIL NIL (A NIL)) ("xyz" "def" RESULT A NIL B DEF2 EQ NEQ NIL NIL (A B)))
(PROGN (DEFGENERIC TEST-MC72-2 (X Y Z &OPTIONAL U V W) (:METHOD-COMBINATION MC72 "xyz") (:METHOD (X Y Z &OPTIONAL U V W) (LIST X Y Z U V W))) (LIST (TEST-MC72-2 'A 'B 'C) (TEST-MC72-2 'A 'B 'C 'D) (TEST-MC72-2 'A 'B 'C 'D 'E) (TEST-MC72-2 'A 'B 'C 'D 'E 'F)))
EQUAL-OK: (("xyz" "def" RESULT A B DEF1 DEF2 EQ NEQ NIL NIL (A B C NIL NIL NIL)) ("xyz" "def" RESULT A B D DEF2 EQ NEQ NIL NIL (A B C D NIL NIL)) ("xyz" "def" RESULT A B D E EQ NEQ NIL NIL (A B C D E NIL)) ("xyz" "def" RESULT A B D E EQ NEQ NIL NIL (A B C D E F)))
(PROGN (DEFGENERIC TEST-MC72-3 (X &REST Y) (:METHOD-COMBINATION MC72 "xyz") (:METHOD (X &REST Y) (LIST* X Y))) (LIST (TEST-MC72-3 'A) (TEST-MC72-3 'A 'B 'C) (TEST-MC72-3 'A :TEST-NOT 'NEQUAL) (TEST-MC72-3 'A :TEST 'EQ :TEST-NOT 'NEQUAL) (TEST-MC72-3 'A :TEST-NOT 'NEQUAL :TEST 'EQL :TEST-NOT 'NEQUALP)))
EQUAL-OK: (("xyz" "def" RESULT A NIL DEF1 DEF2 EQ NEQ NIL NIL (A)) ("xyz" "def" RESULT A NIL DEF1 DEF2 EQ NEQ NIL NIL (A B C)) ("xyz" "def" RESULT A NIL DEF1 DEF2 EQ NEQUAL NIL T (A :TEST-NOT NEQUAL)) ("xyz" "def" RESULT A NIL DEF1 DEF2 EQ NEQUAL T T (A :TEST EQ :TEST-NOT NEQUAL)) ("xyz" "def" RESULT A NIL DEF1 DEF2 EQL NEQUAL T T (A :TEST-NOT NEQUAL :TEST EQL :TEST-NOT NEQUALP)))
(PROGN (DEFGENERIC TEST-MC72-4 (X &REST Y) (:METHOD-COMBINATION MC72 "xyz") (:METHOD (X &REST Y) (LIST* X Y))) (TEST-MC72-4 'A 'B))
[SIMPLE-PROGRAM-ERROR]: TEST-MC72-4-<EMF-1>-1-1: keyword arguments in (B) should occur pairwise
EQL-OK: ERROR
(PROGN (DEFGENERIC TEST-MC72-5 (X Y Z &REST U) (:METHOD-COMBINATION MC72 "xyz") (:METHOD (X Y Z &REST U) (LIST* X Y Z U))) (LIST (TEST-MC72-5 'A :TEST 'EQ) (TEST-MC72-5 'A :TEST 'EQ 'D 'E) (TEST-MC72-5 'A :TEST 'EQ :TEST-NOT 'NEQUAL) (TEST-MC72-5 'A :TEST 'EQ :TEST 'EQ :TEST-NOT 'NEQUAL) (TEST-MC72-5 'A :TEST 'EQ :TEST-NOT 'NEQUAL :TEST 'EQL :TEST-NOT 'NEQUALP)))
EQUAL-OK: (("xyz" "def" RESULT A :TEST DEF1 DEF2 EQ NEQ NIL NIL (A :TEST EQ)) ("xyz" "def" RESULT A :TEST DEF1 DEF2 EQ NEQ NIL NIL (A :TEST EQ D E)) ("xyz" "def" RESULT A :TEST DEF1 DEF2 EQ NEQUAL NIL T (A :TEST EQ :TEST-NOT NEQUAL)) ("xyz" "def" RESULT A :TEST DEF1 DEF2 EQ NEQUAL T T (A :TEST EQ :TEST EQ :TEST-NOT NEQUAL)) ("xyz" "def" RESULT A :TEST DEF1 DEF2 EQL NEQUAL T T (A :TEST EQ :TEST-NOT NEQUAL :TEST EQL :TEST-NOT NEQUALP)))
(PROGN (DEFGENERIC TEST-MC72-6 (X &OPTIONAL Y Z U &REST V) (:METHOD-COMBINATION MC72 "xyz") (:METHOD (X &OPTIONAL Y Z U &REST V) (LIST* X Y Z U V))) (LIST (TEST-MC72-6 'A) (TEST-MC72-6 'A 'B 'C) (TEST-MC72-6 'A :TEST 'EQ 'D :TEST-NOT 'NEQUAL) (TEST-MC72-6 'A :TEST 'EQ 'D :TEST 'EQ :TEST-NOT 'NEQUAL) (TEST-MC72-6 'A :TEST 'EQ 'D :TEST-NOT 'NEQUAL :TEST 'EQL :TEST-NOT 'NEQUALP)))
EQUAL-OK: (("xyz" "def" RESULT A NIL DEF1 DEF2 EQ NEQ NIL NIL (A NIL NIL NIL)) ("xyz" "def" RESULT A NIL B C EQ NEQ NIL NIL (A B C NIL)) ("xyz" "def" RESULT A NIL :TEST EQ EQ NEQUAL NIL T (A :TEST EQ D :TEST-NOT NEQUAL)) ("xyz" "def" RESULT A NIL :TEST EQ EQ NEQUAL T T (A :TEST EQ D :TEST EQ :TEST-NOT NEQUAL)) ("xyz" "def" RESULT A NIL :TEST EQ EQL NEQUAL T T (A :TEST EQ D :TEST-NOT NEQUAL :TEST EQL :TEST-NOT NEQUALP)))
(PROGN (DEFUN PROMPT-FOR-NEW-VALUES NIL (FORMAT *DEBUG-IO* "~&New values: ") (LIST (READ *DEBUG-IO*))) (DEFUN ADD-METHOD-RESTARTS (FORM METHOD) (LET ((BLOCK (GENSYM)) (TAG (GENSYM))) `(BLOCK ,BLOCK (TAGBODY ,TAG (RETURN-FROM ,BLOCK (RESTART-CASE ,FORM (METHOD-REDO NIL :REPORT (LAMBDA (STREAM) (FORMAT STREAM "Try calling ~S again." ,METHOD)) (GO ,TAG)) (METHOD-RETURN (L) :REPORT (LAMBDA (STREAM) (FORMAT STREAM "Specify return values for ~S call." ,METHOD)) :INTERACTIVE (LAMBDA NIL (PROMPT-FOR-NEW-VALUES)) (RETURN-FROM ,BLOCK (VALUES-LIST L))))))))) (DEFUN CONVERT-EFFECTIVE-METHOD (EFM) (IF (CONSP EFM) (IF (EQ (CAR EFM) 'CALL-METHOD) (LET ((METHOD-LIST (THIRD EFM))) (IF (OR (TYPEP (FIRST METHOD-LIST) 'METHOD) (REST METHOD-LIST)) (CONVERT-EFFECTIVE-METHOD `(CALL-METHOD ,(SECOND EFM) ((MAKE-METHOD (CALL-METHOD ,(FIRST METHOD-LIST) ,(REST METHOD-LIST)))))) (IF (TYPEP (SECOND EFM) 'METHOD) (ADD-METHOD-RESTARTS (CONS (CONVERT-EFFECTIVE-METHOD (CAR EFM)) (CONVERT-EFFECTIVE-METHOD (CDR EFM))) (SECOND EFM)) (CONS (CONVERT-EFFECTIVE-METHOD (CAR EFM)) (CONVERT-EFFECTIVE-METHOD (CDR EFM)))))) (CONS (CONVERT-EFFECTIVE-METHOD (CAR EFM)) (CONVERT-EFFECTIVE-METHOD (CDR EFM)))) EFM)) (DEFINE-METHOD-COMBINATION STANDARD-WITH-RESTARTS NIL ((AROUND (:AROUND)) (BEFORE (:BEFORE)) (PRIMARY NIL :REQUIRED T) (AFTER (:AFTER))) (FLET ((CALL-METHODS-SEQUENTIALLY (METHODS) (MAPCAR #'(LAMBDA (METHOD) `(CALL-METHOD ,METHOD)) METHODS))) (LET ((FORM (IF (OR BEFORE AFTER (REST PRIMARY)) `(MULTIPLE-VALUE-PROG1 (PROGN ,@(CALL-METHODS-SEQUENTIALLY BEFORE) (CALL-METHOD ,(FIRST PRIMARY) ,(REST PRIMARY))) ,@(CALL-METHODS-SEQUENTIALLY (REVERSE AFTER))) `(CALL-METHOD ,(FIRST PRIMARY))))) (WHEN AROUND (SETQ FORM `(CALL-METHOD ,(FIRST AROUND) (,@(REST AROUND) (MAKE-METHOD ,FORM))))) (CONVERT-EFFECTIVE-METHOD FORM)))) (DEFGENERIC TESTGF16 (X) (:METHOD-COMBINATION STANDARD-WITH-RESTARTS)) (DEFCLASS TESTCLASS16A NIL NIL) (DEFCLASS TESTCLASS16B (TESTCLASS16A) NIL) (DEFCLASS TESTCLASS16C (TESTCLASS16A) NIL) (DEFCLASS TESTCLASS16D (TESTCLASS16B TESTCLASS16C) NIL) (DEFMETHOD TESTGF16 ((X TESTCLASS16A)) (LIST 'A (NOT (NULL (FIND-RESTART 'METHOD-REDO))) (NOT (NULL (FIND-RESTART 'METHOD-RETURN))))) (DEFMETHOD TESTGF16 ((X TESTCLASS16B)) (CONS 'B (CALL-NEXT-METHOD))) (DEFMETHOD TESTGF16 ((X TESTCLASS16C)) (CONS 'C (CALL-NEXT-METHOD))) (DEFMETHOD TESTGF16 ((X TESTCLASS16D)) (CONS 'D (CALL-NEXT-METHOD))) (TESTGF16 (MAKE-INSTANCE 'TESTCLASS16D)))
EQUAL-OK: (D B C A T T)
(PROGN (DEFCLASS USER-METHOD (STANDARD-METHOD) (MYSLOT)) T)
EQL-OK: T
(DEFMACRO DEF-USER-METHOD (NAME &REST REST) (LET* ((LAMBDALIST-POSITION (POSITION-IF #'LISTP REST)) (QUALIFIERS (SUBSEQ REST 0 LAMBDALIST-POSITION)) (LAMBDALIST (ELT REST LAMBDALIST-POSITION)) (BODY (SUBSEQ REST (+ LAMBDALIST-POSITION 1))) (REQUIRED-PART (SUBSEQ LAMBDALIST 0 (OR (POSITION-IF #'(LAMBDA (X) (MEMBER X LAMBDA-LIST-KEYWORDS)) LAMBDALIST) (LENGTH LAMBDALIST)))) (SPECIALIZERS (MAPCAR #'FIND-CLASS (MAPCAR #'(LAMBDA (X) (IF (CONSP X) (SECOND X) 'T)) REQUIRED-PART))) (UNSPECIALIZED-REQUIRED-PART (MAPCAR #'(LAMBDA (X) (IF (CONSP X) (FIRST X) X)) REQUIRED-PART)) (UNSPECIALIZED-LAMBDALIST (APPEND UNSPECIALIZED-REQUIRED-PART (SUBSEQ LAMBDALIST (LENGTH REQUIRED-PART))))) `(PROGN (ADD-METHOD #',NAME (MAKE-INSTANCE 'USER-METHOD :QUALIFIERS ',QUALIFIERS :LAMBDA-LIST ',UNSPECIALIZED-LAMBDALIST :SPECIALIZERS ',SPECIALIZERS :FUNCTION #'(LAMBDA (ARGUMENTS NEXT-METHODS-LIST) (FLET ((NEXT-METHOD-P NIL NEXT-METHODS-LIST) (CALL-NEXT-METHOD (&REST NEW-ARGUMENTS) (UNLESS NEW-ARGUMENTS (SETQ NEW-ARGUMENTS ARGUMENTS)) (IF (NULL NEXT-METHODS-LIST) (ERROR "no next method for arguments ~:S" ARGUMENTS) (FUNCALL (METHOD-FUNCTION (FIRST NEXT-METHODS-LIST)) NEW-ARGUMENTS (REST NEXT-METHODS-LIST))))) (APPLY #'(LAMBDA ,UNSPECIALIZED-LAMBDALIST , at BODY) ARGUMENTS))))) ',NAME)))
EQL-OK: DEF-USER-METHOD
(PROGN (DEFGENERIC TEST-UM01 (X Y)) (DEF-USER-METHOD TEST-UM01 ((X SYMBOL) (Y SYMBOL)) (LIST X Y (NEXT-METHOD-P))) (TEST-UM01 'A 'B))
EQUAL-OK: (A B NIL)
(PROGN (DEFGENERIC TEST-UM02 (X)) (DEF-USER-METHOD TEST-UM02 ((X INTEGER)) (LIST* 'INTEGER X (NOT (NULL (NEXT-METHOD-P))) (CALL-NEXT-METHOD))) (DEFMETHOD TEST-UM02 ((X RATIONAL)) (LIST* 'RATIONAL X (NOT (NULL (NEXT-METHOD-P))) (CALL-NEXT-METHOD))) (DEFMETHOD TEST-UM02 ((X REAL)) (LIST 'REAL X (NOT (NULL (NEXT-METHOD-P))))) (TEST-UM02 17))
EQUAL-OK: (INTEGER 17 T RATIONAL 17 T REAL 17 NIL)
(PROGN (DEFGENERIC TEST-UM03 (X)) (DEFMETHOD TEST-UM03 ((X INTEGER)) (LIST* 'INTEGER X (NOT (NULL (NEXT-METHOD-P))) (CALL-NEXT-METHOD))) (DEF-USER-METHOD TEST-UM03 ((X RATIONAL)) (LIST* 'RATIONAL X (NOT (NULL (NEXT-METHOD-P))) (CALL-NEXT-METHOD))) (DEFMETHOD TEST-UM03 ((X REAL)) (LIST 'REAL X (NOT (NULL (NEXT-METHOD-P))))) (TEST-UM03 17))
EQUAL-OK: (INTEGER 17 T RATIONAL 17 T REAL 17 NIL)
(PROGN (DEFGENERIC TEST-UM04 (X)) (DEFMETHOD TEST-UM04 ((X INTEGER)) (LIST* 'INTEGER X (NOT (NULL (NEXT-METHOD-P))) (CALL-NEXT-METHOD))) (DEFMETHOD TEST-UM04 ((X RATIONAL)) (LIST* 'RATIONAL X (NOT (NULL (NEXT-METHOD-P))) (CALL-NEXT-METHOD))) (DEF-USER-METHOD TEST-UM04 ((X REAL)) (LIST 'REAL X (NOT (NULL (NEXT-METHOD-P))))) (TEST-UM04 17))
EQUAL-OK: (INTEGER 17 T RATIONAL 17 T REAL 17 NIL)
(LET ((RESULTS NIL)) (DEFGENERIC TEST-UM05 (X)) (DEFMETHOD TEST-UM05 (X) (PUSH 'PRIMARY RESULTS) (PUSH X RESULTS)) (DEF-USER-METHOD TEST-UM05 :BEFORE ((X INTEGER)) (PUSH 'BEFORE-INTEGER RESULTS) (PUSH X RESULTS)) (DEFMETHOD TEST-UM05 :BEFORE ((X REAL)) (PUSH 'BEFORE-REAL RESULTS) (PUSH X RESULTS)) (TEST-UM05 17) (NREVERSE RESULTS))
EQUAL-OK: (BEFORE-INTEGER 17 BEFORE-REAL 17 PRIMARY 17)
(LET ((RESULTS NIL)) (DEFGENERIC TEST-UM06 (X)) (DEFMETHOD TEST-UM06 (X) (PUSH 'PRIMARY RESULTS) (PUSH X RESULTS)) (DEFMETHOD TEST-UM06 :BEFORE ((X INTEGER)) (PUSH 'BEFORE-INTEGER RESULTS) (PUSH X RESULTS)) (DEF-USER-METHOD TEST-UM06 :BEFORE ((X REAL)) (PUSH 'BEFORE-REAL RESULTS) (PUSH X RESULTS)) (TEST-UM06 17) (NREVERSE RESULTS))
EQUAL-OK: (BEFORE-INTEGER 17 BEFORE-REAL 17 PRIMARY 17)
(LET ((RESULTS NIL)) (DEFGENERIC TEST-UM07 (X)) (DEFMETHOD TEST-UM07 (X) (PUSH 'PRIMARY RESULTS) (PUSH X RESULTS)) (DEFMETHOD TEST-UM07 :AFTER ((X INTEGER)) (PUSH 'AFTER-INTEGER RESULTS) (PUSH X RESULTS)) (DEF-USER-METHOD TEST-UM07 :AFTER ((X REAL)) (PUSH 'AFTER-REAL RESULTS) (PUSH X RESULTS)) (TEST-UM07 17) (NREVERSE RESULTS))
EQUAL-OK: (PRIMARY 17 AFTER-REAL 17 AFTER-INTEGER 17)
(LET ((RESULTS NIL)) (DEFGENERIC TEST-UM08 (X)) (DEFMETHOD TEST-UM08 (X) (PUSH 'PRIMARY RESULTS) (PUSH X RESULTS)) (DEF-USER-METHOD TEST-UM08 :AFTER ((X INTEGER)) (PUSH 'AFTER-INTEGER RESULTS) (PUSH X RESULTS)) (DEFMETHOD TEST-UM08 :AFTER ((X REAL)) (PUSH 'AFTER-REAL RESULTS) (PUSH X RESULTS)) (TEST-UM08 17) (NREVERSE RESULTS))
EQUAL-OK: (PRIMARY 17 AFTER-REAL 17 AFTER-INTEGER 17)
(PROGN (DEFGENERIC TEST-UM10 (X)) (DEFMETHOD TEST-UM10 ((X INTEGER)) (LIST* 'INTEGER X (NOT (NULL (NEXT-METHOD-P))) (CALL-NEXT-METHOD))) (DEFMETHOD TEST-UM10 ((X RATIONAL)) (LIST* 'RATIONAL X (NOT (NULL (NEXT-METHOD-P))) (CALL-NEXT-METHOD))) (DEFMETHOD TEST-UM10 ((X REAL)) (LIST 'REAL X (NOT (NULL (NEXT-METHOD-P))))) (DEFMETHOD TEST-UM10 :AFTER ((X REAL))) (DEF-USER-METHOD TEST-UM10 :AROUND ((X INTEGER)) (LIST* 'AROUND-INTEGER X (NOT (NULL (NEXT-METHOD-P))) (CALL-NEXT-METHOD))) (DEFMETHOD TEST-UM10 :AROUND ((X RATIONAL)) (LIST* 'AROUND-RATIONAL X (NOT (NULL (NEXT-METHOD-P))) (CALL-NEXT-METHOD))) (DEFMETHOD TEST-UM10 :AROUND ((X REAL)) (LIST* 'AROUND-REAL X (NOT (NULL (NEXT-METHOD-P))) (CALL-NEXT-METHOD))) (TEST-UM10 17))
EQUAL-OK: (AROUND-INTEGER 17 T AROUND-RATIONAL 17 T AROUND-REAL 17 T INTEGER 17 T RATIONAL 17 T REAL 17 NIL)
(PROGN (DEFGENERIC TEST-UM11 (X)) (DEFMETHOD TEST-UM11 ((X INTEGER)) (LIST* 'INTEGER X (NOT (NULL (NEXT-METHOD-P))) (CALL-NEXT-METHOD))) (DEFMETHOD TEST-UM11 ((X RATIONAL)) (LIST* 'RATIONAL X (NOT (NULL (NEXT-METHOD-P))) (CALL-NEXT-METHOD))) (DEFMETHOD TEST-UM11 ((X REAL)) (LIST 'REAL X (NOT (NULL (NEXT-METHOD-P))))) (DEFMETHOD TEST-UM11 :AFTER ((X REAL))) (DEFMETHOD TEST-UM11 :AROUND ((X INTEGER)) (LIST* 'AROUND-INTEGER X (NOT (NULL (NEXT-METHOD-P))) (CALL-NEXT-METHOD))) (DEF-USER-METHOD TEST-UM11 :AROUND ((X RATIONAL)) (LIST* 'AROUND-RATIONAL X (NOT (NULL (NEXT-METHOD-P))) (CALL-NEXT-METHOD))) (DEFMETHOD TEST-UM11 :AROUND ((X REAL)) (LIST* 'AROUND-REAL X (NOT (NULL (NEXT-METHOD-P))) (CALL-NEXT-METHOD))) (TEST-UM11 17))
EQUAL-OK: (AROUND-INTEGER 17 T AROUND-RATIONAL 17 T AROUND-REAL 17 T INTEGER 17 T RATIONAL 17 T REAL 17 NIL)
(PROGN (DEFGENERIC TEST-UM12 (X)) (DEFMETHOD TEST-UM12 ((X INTEGER)) (LIST* 'INTEGER X (NOT (NULL (NEXT-METHOD-P))) (CALL-NEXT-METHOD))) (DEFMETHOD TEST-UM12 ((X RATIONAL)) (LIST* 'RATIONAL X (NOT (NULL (NEXT-METHOD-P))) (CALL-NEXT-METHOD))) (DEFMETHOD TEST-UM12 ((X REAL)) (LIST 'REAL X (NOT (NULL (NEXT-METHOD-P))))) (DEFMETHOD TEST-UM12 :AFTER ((X REAL))) (DEFMETHOD TEST-UM12 :AROUND ((X INTEGER)) (LIST* 'AROUND-INTEGER X (NOT (NULL (NEXT-METHOD-P))) (CALL-NEXT-METHOD))) (DEFMETHOD TEST-UM12 :AROUND ((X RATIONAL)) (LIST* 'AROUND-RATIONAL X (NOT (NULL (NEXT-METHOD-P))) (CALL-NEXT-METHOD))) (DEF-USER-METHOD TEST-UM12 :AROUND ((X REAL)) (LIST* 'AROUND-REAL X (NOT (NULL (NEXT-METHOD-P))) (CALL-NEXT-METHOD))) (TEST-UM12 17))
EQUAL-OK: (AROUND-INTEGER 17 T AROUND-RATIONAL 17 T AROUND-REAL 17 T INTEGER 17 T RATIONAL 17 T REAL 17 NIL)
(PROGN (DEFGENERIC TEST-UM13 (X)) (DEFMETHOD TEST-UM13 ((X INTEGER)) (LIST* 'INTEGER X (NOT (NULL (NEXT-METHOD-P))) (CALL-NEXT-METHOD))) (DEF-USER-METHOD TEST-UM13 ((X RATIONAL)) (LIST* 'RATIONAL X (NOT (NULL (NEXT-METHOD-P))) (CALL-NEXT-METHOD))) (DEFMETHOD TEST-UM13 ((X REAL)) (LIST 'REAL X (NOT (NULL (NEXT-METHOD-P))))) (DEFMETHOD TEST-UM13 :AFTER ((X REAL))) (DEFMETHOD TEST-UM13 :AROUND ((X INTEGER)) (LIST* 'AROUND-INTEGER X (NOT (NULL (NEXT-METHOD-P))) (CALL-NEXT-METHOD))) (DEF-USER-METHOD TEST-UM13 :AROUND ((X RATIONAL)) (LIST* 'AROUND-RATIONAL X (NOT (NULL (NEXT-METHOD-P))) (CALL-NEXT-METHOD))) (DEFMETHOD TEST-UM13 :AROUND ((X REAL)) (LIST* 'AROUND-REAL X (NOT (NULL (NEXT-METHOD-P))) (CALL-NEXT-METHOD))) (TEST-UM13 17))
EQUAL-OK: (AROUND-INTEGER 17 T AROUND-RATIONAL 17 T AROUND-REAL 17 T INTEGER 17 T RATIONAL 17 T REAL 17 NIL)
(PROGN (DEFCLASS FOO129 NIL ((X :INITARG :X))) (DEFPARAMETER *FOO129-COUNTER* 0) (DEFMETHOD INITIALIZE-INSTANCE ((INSTANCE FOO129) &REST INITARGS &KEY (X 'NIL)) (INCF *FOO129-COUNTER*) (APPLY #'CALL-NEXT-METHOD INSTANCE :X (CONS 'A X) INITARGS)) (MAKE-INSTANCE 'FOO129) *FOO129-COUNTER*)
EQL-OK: 1
(PROGN (DEFCLASS FOO130 NIL ((X :INITARG :X))) (DEFPARAMETER *FOO130-COUNTER* 0) (LOCALLY (DECLARE (COMPILE)) (DEFMETHOD INITIALIZE-INSTANCE ((INSTANCE FOO130) &REST INITARGS &KEY (X 'NIL)) (INCF *FOO130-COUNTER*) (APPLY #'CALL-NEXT-METHOD INSTANCE :X (CONS 'A X) INITARGS))) (MAKE-INSTANCE 'FOO130) *FOO130-COUNTER*)
EQL-OK: 1
(PROGN (SETQ *FORWARD-REFERENCED-CLASS-MISDESIGN* T) (DEFCLASS FOO131 (FORWARDCLASS01) NIL) T)
WARNING: (SETF FIND-CLASS): redefining class CLASS in top-level, was defined in /home/christoph/clisp/src/clos-custom.fas
WARNING: (SETF FIND-CLASS): redefining class FORWARD-REFERENCED-CLASS in top-level, was defined in /home/christoph/clisp/src/clos-custom.fas
EQL-OK: T
(FIND-CLASS 'FORWARDCLASS01)
[SIMPLE-ERROR]: FIND-CLASS: FORWARDCLASS01 does not name a class
EQL-OK: ERROR
(FIND-CLASS 'FORWARDCLASS01 NIL)
EQL-OK: NIL
(TYPEP 1 'FORWARDCLASS01)
[SIMPLE-ERROR]: TYPEP: invalid type specification FORWARDCLASS01
EQL-OK: ERROR
(LOCALLY (DECLARE (COMPILE)) (TYPEP 1 'FORWARDCLASS01))
[SIMPLE-ERROR]: TYPEP: invalid type specification FORWARDCLASS01
EQL-OK: ERROR
(TYPE-EXPAND 'FORWARDCLASS01)
[SIMPLE-ERROR]: TYPE-EXPAND: invalid type specification FORWARDCLASS01
EQL-OK: ERROR
(SUBTYPEP 'FORWARDCLASS01 'T)
[SIMPLE-ERROR]: SUBTYPEP: invalid type specification FORWARDCLASS01
EQL-OK: ERROR
(SUBTYPEP 'NIL 'FORWARDCLASS01)
[SIMPLE-ERROR]: SUBTYPEP: invalid type specification FORWARDCLASS01
EQL-OK: ERROR
(SYSTEM::SUBTYPE-INTEGER 'FORWARDCLASS01)
EQL-OK: NIL
(SYSTEM::SUBTYPE-SEQUENCE 'FORWARDCLASS01)
EQL-OK: NIL
(DEFSTRUCT (FOO131A (:INCLUDE FORWARDCLASS01)))
[SIMPLE-SOURCE-PROGRAM-ERROR]: DEFSTRUCT FOO131A: included structure FORWARDCLASS01 has not been defined.
EQL-OK: ERROR
(DEFMETHOD FOO131B ((X FORWARDCLASS01)))
[SIMPLE-ERROR]: FIND-CLASS: FORWARDCLASS01 does not name a class
EQL-OK: ERROR
(PROGN (SETQ *FORWARD-REFERENCED-CLASS-MISDESIGN* NIL) (DEFCLASS FOO132 (FORWARDCLASS02) NIL) T)
EQL-OK: T
(FIND-CLASS 'FORWARDCLASS02)
[SIMPLE-ERROR]: FIND-CLASS: FORWARDCLASS02 does not name a class
EQL-OK: ERROR
(FIND-CLASS 'FORWARDCLASS02 NIL)
EQL-OK: NIL
(TYPEP 1 'FORWARDCLASS02)
[SIMPLE-ERROR]: TYPEP: invalid type specification FORWARDCLASS02
EQL-OK: ERROR
(LOCALLY (DECLARE (COMPILE)) (TYPEP 1 'FORWARDCLASS02))
[SIMPLE-ERROR]: TYPEP: invalid type specification FORWARDCLASS02
EQL-OK: ERROR
(TYPE-EXPAND 'FORWARDCLASS02)
[SIMPLE-ERROR]: TYPE-EXPAND: invalid type specification FORWARDCLASS02
EQL-OK: ERROR
(SUBTYPEP 'FORWARDCLASS02 'T)
[SIMPLE-ERROR]: SUBTYPEP: invalid type specification FORWARDCLASS02
EQL-OK: ERROR
(SUBTYPEP 'NIL 'FORWARDCLASS02)
[SIMPLE-ERROR]: SUBTYPEP: invalid type specification FORWARDCLASS02
EQL-OK: ERROR
(SYSTEM::SUBTYPE-INTEGER 'FORWARDCLASS02)
EQL-OK: NIL
(SYSTEM::SUBTYPE-SEQUENCE 'FORWARDCLASS02)
EQL-OK: NIL
(DEFSTRUCT (FOO132A (:INCLUDE FORWARDCLASS02)))
[SIMPLE-SOURCE-PROGRAM-ERROR]: DEFSTRUCT FOO132A: included structure FORWARDCLASS02 has not been defined.
EQL-OK: ERROR
(DEFMETHOD FOO132B ((X FORWARDCLASS02)))
[SIMPLE-ERROR]: FIND-CLASS: FORWARDCLASS02 does not name a class
EQL-OK: ERROR
(PROGN (DEFCLASS INCOMPLETE147 (UNDEFINED147) NIL) T)
EQL-OK: T
(FIND-CLASS 'UNDEFINED147)
[SIMPLE-ERROR]: FIND-CLASS: UNDEFINED147 does not name a class
EQL-OK: ERROR
(TYPEP 42 'UNDEFINED147)
[SIMPLE-ERROR]: TYPEP: invalid type specification UNDEFINED147
EQL-OK: ERROR
(SUBTYPEP 'UNDEFINED147 'NUMBER)
[SIMPLE-ERROR]: SUBTYPEP: invalid type specification UNDEFINED147
EQL-OK: ERROR
(SUBTYPEP 'UNDEFINED147 'STANDARD-OBJECT)
[SIMPLE-ERROR]: SUBTYPEP: invalid type specification UNDEFINED147
EQL-OK: ERROR
(NULL (FIND-CLASS 'INCOMPLETE147))
EQL-OK: NIL
(TYPEP 42 'INCOMPLETE147)
EQL-OK: NIL
(MULTIPLE-VALUE-LIST (SUBTYPEP 'INCOMPLETE147 'NUMBER))
EQUAL-OK: (NIL T)
(MULTIPLE-VALUE-LIST (SUBTYPEP 'INCOMPLETE147 'STANDARD-OBJECT))
EQUAL-OK: (NIL T)
(LET ((RET 'NIL)) (DEFCLASS MIXIN-FOO-144 NIL NIL) (DEFCLASS CLASS-FOO-144 (MIXIN-FOO-144) NIL) (DEFGENERIC FUN-144 (X)) (DEFMETHOD FUN-144 ((X CLASS-FOO-144)) (PUSH 'CLASS-FOO-144 RET)) (DEFCLASS CLASS-BAR-144 NIL NIL) (DEFMETHOD FUN-144 :AFTER ((X CLASS-BAR-144)) (PUSH 'CLASS-BAR-144-AFTER RET)) (DEFCLASS MIXIN-FOO-144 (CLASS-BAR-144) NIL) (FUN-144 (MAKE-INSTANCE 'CLASS-FOO-144)) (NREVERSE RET))
EQUAL-OK: (CLASS-FOO-144 CLASS-BAR-144-AFTER)
(LET ((RET NIL)) (DEFCLASS MIXIN-FOO-145 NIL NIL) (DEFCLASS CLASS-FOO-145 (MIXIN-FOO-145) NIL) (DEFGENERIC FUN-145 (X)) (DEFMETHOD FUN-145 ((X CLASS-FOO-145)) (PUSH 'CLASS-FOO-145 RET)) (DEFCLASS CLASS-BAR-145 NIL NIL) (DEFMETHOD FUN-145 :AFTER ((X CLASS-BAR-145)) (PUSH 'CLASS-BAR-145-AFTER RET)) (LET ((INST (MAKE-INSTANCE 'CLASS-FOO-145))) (FUN-145 INST) (SETQ RET 'NIL) (DEFCLASS MIXIN-FOO-145 (CLASS-BAR-145) NIL) (FUN-145 INST) (NREVERSE RET)))
WARNING: DEFCLASS: Class CLASS-FOO-145 (or one of its ancestors) is being redefined, instances are obsolete
EQUAL-OK: (CLASS-FOO-145 CLASS-BAR-145-AFTER)
(PROGN (DEFCLASS FOO146 NIL (SLOT1)) (MAKE-INSTANCE 'FOO146) (DEFCLASS FOO146 NIL ((SLOT1 :INITARG :FOO))) (MAKE-INSTANCE 'FOO146 :FOO 'ANY) T)
WARNING: DEFCLASS: Class FOO146 (or one of its ancestors) is being redefined, instances are obsolete
EQL-OK: T
(PROGN (DEFCLASS FOO147 NIL (SLOT1)) (DEFCLASS FOOSUB147 (FOO147) (SLOT2)) (MAKE-INSTANCE 'FOOSUB147) (DEFCLASS FOO147 NIL ((SLOT1 :INITARG :FOO))) (MAKE-INSTANCE 'FOOSUB147 :FOO 'ANY) T)
WARNING: DEFCLASS: Class FOOSUB147 (or one of its ancestors) is being redefined, instances are obsolete
EQL-OK: T
(PROGN (LOAD (MAKE-PATHNAME :NAME "listeners" :TYPE NIL :DEFAULTS *RUN-TEST-TRUENAME*)) (WITH-OPEN-STREAM (S1 (MAKE-STRING-INPUT-STREAM "(")) (WITH-OPEN-STREAM (S2 (MAKE-STRING-INPUT-STREAM "())")) (WITH-OPEN-STREAM (L (MAKE-INSTANCE 'LISTENER-INPUT-STREAM :STREAM S2)) (WITH-OPEN-STREAM (C (MAKE-CONCATENATED-STREAM S1 L)) (READ C))))))
;; Loading file /home/christoph/clisp/tests/listeners.lisp ...
WARNING: The generic function #<STANDARD-GENERIC-FUNCTION CLOSE> is being modified, but has already been called.
;; Loaded file /home/christoph/clisp/tests/listeners.lisp
EQUAL-OK: (NIL)
(MAKE-INSTANCE (MAKE-INSTANCE 'STANDARD-CLASS :NAME 3))
[SIMPLE-SOURCE-PROGRAM-ERROR]: (SETF CLASS-NAME): 3 is not a symbol
EQL-OK: ERROR
(DECLAIM (NOTSPECIAL A B C))
EQL-OK: NIL
RUN-TEST: finished "clos" (0 errors out of 495 tests)
RUN-TEST: started #<INPUT BUFFERED FILE-STREAM CHARACTER #P"defhash.tst" @1>
(DEFINE-HASH-TABLE-TEST STRING-EQ STRING= SXHASH)
EQL-OK: STRING-EQ
(LET ((H (MAKE-HASH-TABLE :TEST 'STRING-EQ))) (LIST (SETF (GETHASH "foo" H) 10) (GETHASH "zot" H) (GETHASH "foo" H) (GETHASH "FOO" H)))
EQUAL-OK: (10 NIL 10 NIL)
(LET ((H (MAKE-HASH-TABLE :TEST '(STRING= . SXHASH)))) (LIST (SETF (GETHASH "foo" H) 10) (GETHASH "zot" H) (GETHASH "foo" H) (GETHASH "FOO" H)))
EQUAL-OK: (10 NIL 10 NIL)
(LET ((H (MAKE-HASH-TABLE :TEST `(,(LAMBDA (A B) (PRINT (LIST '= A B)) (= A B)) . ,(LAMBDA (X) (LET ((Z (SXHASH (COERCE X 'DOUBLE-FLOAT)))) (PRINT (LIST X Z)) Z)))))) (LIST (SETF (GETHASH 100 H) "foo") (GETHASH 10 H) (SETF (GETHASH 10 H) "bar") (GETHASH 100 H) (GETHASH 100.0d0 H) (GETHASH 10.0 H)))
(100 5832768)
(10 2359360)
(10 2359360)
(10 2359360)
(100 5832768)
(100 5832768)
(= 100 100)
(100.0d0 5832768)
(= 100 100.0d0)
(10.0 2359360)
(= 10 10.0)
EQUAL-OK: ("foo" NIL "bar" "foo" "foo" "bar")
(LET ((H (MAKE-HASH-TABLE :TEST `(= . ,(LAMBDA (X) (SXHASH (COERCE X 'SHORT-FLOAT))))))) (LOOP :FOR I :FROM 0 :TO 1000 :DO (SETF (GETHASH I H) (FORMAT NIL "~r" I))) (LOOP :FOR I :FROM 0 :TO 1000 :UNLESS (STRING= (GETHASH (FLOAT I 1.0d0) H) (GETHASH (FLOAT I 1.0s0) H)) :COLLECT I))
EQL-OK: NIL
(LET ((H (MAKE-HASH-TABLE :TEST `(,(LAMBDA (A B) (LIST (LIST '= A B)) (= A B)) . ,(LAMBDA (X) (LET ((Z (SXHASH (COERCE X 'DOUBLE-FLOAT)))) (LIST `((HASH ,X) => ,Z)) Z)))))) (LOOP :FOR I :FROM 0 :TO 1000 :DO (SETF (GETHASH I H) (FORMAT NIL "~r" I))) (LOOP :FOR I :FROM 0 :TO 1000 :UNLESS (STRING= (GETHASH (FLOAT I 1.0d0) H) (GETHASH (FLOAT I 1.0s0) H)) :COLLECT I))
EQL-OK: NIL
RUN-TEST: finished "defhash" (0 errors out of 6 tests)
RUN-TEST: started #<INPUT BUFFERED FILE-STREAM CHARACTER #P"encoding.tst" @1>
(STRING= (CONVERT-STRING-FROM-BYTES '#(0 65 0 13) CHARSET:UCS-2) (MAP 'STRING #'CODE-CHAR '(65 13)))
EQL-OK: T
(CONVERT-STRING-FROM-BYTES '#(0 65 0) (MAKE-ENCODING :CHARSET CHARSET:UCS-2 :INPUT-ERROR-ACTION :ERROR))
[SIMPLE-CHARSET-TYPE-ERROR]: CONVERT-STRING-FROM-BYTES: Incomplete byte sequence at end of buffer for CHARSET:UNICODE-16-BIG-ENDIAN
EQL-OK: ERROR
(CONVERT-STRING-FROM-BYTES '#(0 65 0) (MAKE-ENCODING :CHARSET CHARSET:UCS-2 :INPUT-ERROR-ACTION #\Z))
EQUAL-OK: "AZ"
(STRING= (CONVERT-STRING-FROM-BYTES '#(0 0 0 65 0 0 0 13) CHARSET:UCS-4) (MAP 'STRING #'CODE-CHAR '(65 13)))
EQL-OK: T
(CONVERT-STRING-FROM-BYTES '#(0 0 0 65 0 0) (MAKE-ENCODING :CHARSET CHARSET:UCS-4 :INPUT-ERROR-ACTION :ERROR))
[SIMPLE-CHARSET-TYPE-ERROR]: CONVERT-STRING-FROM-BYTES: Incomplete byte sequence at end of buffer for CHARSET:UNICODE-32-BIG-ENDIAN
EQL-OK: ERROR
(CONVERT-STRING-FROM-BYTES '#(0 0 0 65 0 0 0) (MAKE-ENCODING :CHARSET CHARSET:UCS-4 :INPUT-ERROR-ACTION #\Z))
EQUAL-OK: "AZ"
(DEFPARAMETER *NO-ICONV-P* (WITH-IGNORED-ERRORS (NOT (MAKE-ENCODING :CHARSET "utf-16"))))
EQL-OK: *NO-ICONV-P*
(IF *NO-ICONV-P* T (STRING= (CONVERT-STRING-FROM-BYTES '#(255 254 65 0 13 0) (MAKE-ENCODING :CHARSET "utf-16")) (MAP 'STRING #'CODE-CHAR '(65 13))))
EQL-OK: T
(CONVERT-STRING-FROM-BYTES '#(255 254 65 0 13) (MAKE-ENCODING :CHARSET "utf-16" :INPUT-ERROR-ACTION :ERROR))
[SIMPLE-OS-ERROR]: UNIX error 84 (EILSEQ): Invalid multibyte or wide character
EQL-OK: ERROR
(IF *NO-ICONV-P* "AZ" (CONVERT-STRING-FROM-BYTES '#(255 254 65 0 13) (MAKE-ENCODING :CHARSET "utf-16" :INPUT-ERROR-ACTION #\Z)))
EQUAL-OK: "AZ"
(IF *NO-ICONV-P* #(65) (CONVERT-STRING-TO-BYTES (MAP 'STRING #'CODE-CHAR '(129 65)) (MAKE-ENCODING :CHARSET "cp1252" :OUTPUT-ERROR-ACTION :IGNORE)))
EQUALP-OK: #(65)
(LET ((Z (COERCE #(97 98 99) '(VECTOR (UNSIGNED-BYTE 8))))) (LIST (CONVERT-STRING-FROM-BYTES Z CHARSET:ASCII :START 0 :END 2) (CONVERT-STRING-FROM-BYTES Z CHARSET:ASCII :START 0 :END 3) (CONVERT-STRING-FROM-BYTES Z CHARSET:ASCII :START 1 :END 3) (CONVERT-STRING-FROM-BYTES Z CHARSET:ASCII :START 1 :END 2)))
EQUAL-OK: ("ab" "abc" "bc" "b")
(LET ((Z "abc")) (LIST (CONVERT-STRING-TO-BYTES Z CHARSET:ASCII :START 0 :END 2) (CONVERT-STRING-TO-BYTES Z CHARSET:ASCII :START 0 :END 3) (CONVERT-STRING-TO-BYTES Z CHARSET:ASCII :START 1 :END 3) (CONVERT-STRING-TO-BYTES Z CHARSET:ASCII :START 1 :END 2)))
EQUALP-OK: (#(97 98) #(97 98 99) #(98 99) #(98))
(LET ((VEC (MAKE-ARRAY 1000 :ADJUSTABLE T :FILL-POINTER 0 :ELEMENT-TYPE '(UNSIGNED-BYTE 8)))) (MAP-INTO VEC 'IDENTITY (CONVERT-STRING-TO-BYTES "Hello" CHARSET:UTF-8)) (CONVERT-STRING-FROM-BYTES VEC CHARSET:UTF-8))
EQUAL-OK: "Hello"
(MAPCAR (LAMBDA (S) (CONVERT-STRING-TO-BYTES (STRING (CODE-CHAR S)) CHARSET:UTF-8)) '(128 2047 2048 65533 1114111))
EQUALP-OK: (#(194 128) #(223 191) #(224 160 128) #(239 191 189) #(244 143 191 191))
(LOOP FOR I BELOW 55296 AS C = (CODE-CHAR I) AS S = (CONVERT-STRING-TO-BYTES (STRING C) CHARSET:UTF-8) AS LP = 1 THEN L AS L = (LENGTH S) ALWAYS (<= 1 LP L 4))
EQL-OK: T
(LOOP FOR I FROM 57344 BELOW CHAR-CODE-LIMIT AS C = (CODE-CHAR I) AS S = (CONVERT-STRING-TO-BYTES (STRING C) CHARSET:UTF-8) AS LP = 3 THEN L AS L = (LENGTH S) ALWAYS (<= 3 LP L 4))
EQL-OK: T
(LIST (SYSTEM::CHARSET-RANGE CHARSET:BASE64 #\+ #\+ 2) (SYSTEM::CHARSET-RANGE CHARSET:BASE64 #\+ #\/ 10) (SYSTEM::CHARSET-RANGE CHARSET:BASE64 #\A #\Z 2) (SYSTEM::CHARSET-RANGE CHARSET:BASE64 (CODE-CHAR 0) (CODE-CHAR 10000) 1000))
EQUAL-OK: ("++" "++//" "AZ" "++/9AZaz")
(LET ((LIST NIL)) (DO-EXTERNAL-SYMBOLS (SYM (FIND-PACKAGE "CHARSET")) (PUSH (LIST SYM (ASH (LENGTH (SYSTEM::GET-CHARSET-RANGE (ENCODING-CHARSET (SYMBOL-VALUE SYM)))) -1)) LIST)) (SETQ LIST (SORT LIST #'< :KEY #'SECOND)) (FORMAT T "~& ~:D encoding~:P:~%~:{~25 at A: ~5:D~%~}" (LENGTH LIST) LIST))
117 encodings:
UCS-2: 1
UCS-4: 1
JAVA: 1
UNICODE-32-BIG-ENDIAN: 1
UNICODE-16-LITTLE-ENDIAN: 1
UNICODE-16: 1
UNICODE-32-LITTLE-ENDIAN: 1
UNICODE-32: 1
UNICODE-16-BIG-ENDIAN: 1
ISO-8859-1: 1
UTF-8: 1
UTF-7: 1
ASCII: 1
UTF-16: 2
BASE64: 4
TIS-620: 4
JIS_X0201: 6
ISO-8859-9: 8
ISO-8859-5: 8
ISO-8859-6: 8
ISO-8859-8: 9
CP874-IBM: 9
CP874: 10
ARMSCII-8: 10
ISO-8859-15: 12
HP-ROMAN8: 17
CP1252: 18
ISO-8859-7: 18
WINDOWS-1252: 18
MAC-THAI: 18
GEORGIAN-ACADEMY: 21
GEORGIAN-PS: 21
CP1254: 23
CP1133: 23
CP1253: 23
WINDOWS-1253: 23
WINDOWS-1254: 23
CP1251: 24
WINDOWS-1251: 24
MAC-HEBREW: 25
ISO-8859-14: 25
VISCII: 26
ISO-8859-3: 29
MAC-DINGBAT: 30
MAC-CYRILLIC: 31
MAC-UKRAINE: 31
CP850: 31
KOI8-R: 32
CP1255: 34
CP737: 34
ISO-8859-16: 34
WINDOWS-1255: 34
CP866: 34
CP857: 35
MAC-ICELAND: 35
ISO-8859-10: 36
MAC-ARABIC: 37
CP855: 38
MAC-GREEK: 39
CP869-IBM: 40
ISO-8859-4: 40
ISO-8859-13: 40
MAC-ROMAN: 41
MACINTOSH: 41
MAC-TURKISH: 41
CP869: 42
KOI8-U: 43
CP1256: 44
WINDOWS-1256: 44
ISO-8859-2: 45
MAC-CROATIAN: 45
MAC-ROMANIA: 46
CP1257: 47
WINDOWS-1257: 47
TCVN: 52
CP1250: 55
WINDOWS-1250: 55
CP860-IBM: 57
CP862-IBM: 57
CP862: 57
CP860: 57
MAC-CENTRAL-EUROPE: 59
CP437-IBM: 59
CP437: 59
CP865: 60
CP865-IBM: 60
CP863: 60
CP1258: 61
WINDOWS-1258: 61
CP863-IBM: 62
MAC-SYMBOL: 64
CP861-IBM: 64
CP861: 64
CP775: 69
CP852: 73
CP852-IBM: 74
CP864: 82
CP864-IBM: 82
GBK: 140
CP936: 140
GB18030: 350
CP949: 3,389
JOHAB: 3,391
EUC-CN: 3,632
CP950: 3,806
BIG5: 3,806
ISO-2022-CN: 3,906
ISO-2022-JP: 4,125
SHIFT-JIS: 4,127
CP932: 4,253
EUC-JP: 4,315
BIG5-HKSCS: 4,800
ISO-2022-KR: 5,001
EUC-KR: 5,002
ISO-2022-JP-2: 5,847
ISO-2022-CN-EXT: 6,450
EUC-TW: 6,690
EQL-OK: NIL
(CONVERT-STRING-FROM-BYTES #(97) CHARSET:BASE64)
EQUAL-OK: "YQ=="
(CONVERT-STRING-TO-BYTES "YQ==" CHARSET:BASE64)
EQUALP-OK: #(97)
(CONVERT-STRING-FROM-BYTES #(97 98) CHARSET:BASE64)
EQUAL-OK: "YWI="
(CONVERT-STRING-TO-BYTES "YWI=" CHARSET:BASE64)
EQUALP-OK: #(97 98)
(CONVERT-STRING-FROM-BYTES #(97 98 99) CHARSET:BASE64)
EQUAL-OK: "YWJj"
(CONVERT-STRING-TO-BYTES "YWJj" CHARSET:BASE64)
EQUALP-OK: #(97 98 99)
(CONVERT-STRING-FROM-BYTES #(108 105 115 112 32 115 116 114 105 110 103) CHARSET:BASE64)
EQUAL-OK: "bGlzcCBzdHJpbmc="
(CONVERT-STRING-TO-BYTES "bGlzcCBzdHJpbmc=" CHARSET:BASE64)
EQUALP-OK: #(108 105 115 112 32 115 116 114 105 110 103)
(CONVERT-STRING-FROM-BYTES #(108 105 115 112 32 115 116 114 105 110 103 115) CHARSET:BASE64)
EQUAL-OK: "bGlzcCBzdHJpbmdz"
(CONVERT-STRING-TO-BYTES "bGlzcCBzdHJpbmdz" CHARSET:BASE64)
EQUALP-OK: #(108 105 115 112 32 115 116 114 105 110 103 115)
(CONVERT-STRING-FROM-BYTES #(99 108 105 115 112 32 115 116 114 105 110 103 115) CHARSET:BASE64)
EQUAL-OK: "Y2xpc3Agc3RyaW5ncw=="
(CONVERT-STRING-TO-BYTES "Y2xpc3Agc3RyaW5ncw==" CHARSET:BASE64)
EQUALP-OK: #(99 108 105 115 112 32 115 116 114 105 110 103 115)
(LOOP :WITH S :AND V2 :REPEAT 1000 :FOR V1 = (MAKE-ARRAY (RANDOM 300)) :DO (LOOP :FOR I :FROM 0 :BELOW (LENGTH V1) :DO (SETF (AREF V1 I) (RANDOM 256))) (SETQ S (CONVERT-STRING-FROM-BYTES V1 CHARSET:BASE64) V2 (CONVERT-STRING-TO-BYTES S CHARSET:BASE64)) :UNLESS (EQUALP V1 V2) :COLLECT (LIST V1 S V2))
EQL-OK: NIL
(LOOP :FOR I :FROM 0 :TO CHAR-CODE-LIMIT :FOR C = (CODE-CHAR I) :ALWAYS (OR (NOT (TYPEP C CHARSET:ISO-8859-1)) (EQUALP (CONVERT-STRING-TO-BYTES (STRING C) CHARSET:ISO-8859-1) (VECTOR I))))
EQL-OK: T
(LET ((FILE "encoding-tst")) (UNWIND-PROTECT (PROGN (WITH-OPEN-FILE (OUT FILE :DIRECTION :OUTPUT :ELEMENT-TYPE '(UNSIGNED-BYTE 8)) (WRITE-SEQUENCE (CONVERT-STRING-TO-BYTES (CONCATENATE 'STRING "foo" (STRING #\Newline) "bar" (STRING #\Return) (STRING #\Newline)) CHARSET:ASCII) OUT)) (WITH-OPEN-FILE (IN FILE :DIRECTION :INPUT :ELEMENT-TYPE 'CHARACTER :EXTERNAL-FORMAT :DOS) (LIST (READ-LINE IN NIL :EOF) (READ-LINE IN NIL :EOF) (READ-LINE IN NIL :EOF)))) (DELETE-FILE FILE)))
EQUAL-OK: ("foo" "bar" :EOF)
(LET* ((F "encoding-tst-crlf-test-file") (L1 "line1") (L2 "line2") (ALL (LIST F L1 L2))) (UNWIND-PROTECT (LOOP :FOR S :BEING :EACH :EXTERNAL-SYMBOL :IN "CHARSET" :FOR E-DOS = (MAKE-ENCODING :CHARSET S :LINE-TERMINATOR :DOS) :FOR E-UNIX = (MAKE-ENCODING :CHARSET S :LINE-TERMINATOR :UNIX) :FOR E-MAC = (MAKE-ENCODING :CHARSET S :LINE-TERMINATOR :MAC) :WHEN (IGNORE-ERRORS (WITH-OPEN-FILE (O F :DIRECTION :OUTPUT :EXTERNAL-FORMAT E-DOS) (WRITE-LINE F O) (SETF (STREAM-EXTERNAL-FORMAT O) E-MAC) (WRITE-LINE L1 O) (SETF (STREAM-EXTERNAL-FORMAT O) E-UNIX) (WRITE-LINE L2 O))) :NCONC (LOOP :FOR B :IN '(NIL T) :NCONC (WITH-OPEN-FILE (I F :DIRECTION :INPUT :EXTERNAL-FORMAT E-DOS :BUFFERED B) (DOLIST (LL ALL) (HANDLER-CASE (LET ((L (READ-LINE I))) (IF (STRING= LL L) NIL (LIST (LIST S B 'READ-LINE LL L)))) (ERROR (C) (LIST (LIST S B 'READ-LINE LL (PRINC-TO-STRING C)))))) (HANDLER-CASE (LET ((C (READ-CHAR I NIL NIL))) (AND C (LIST (LIST S B 'READ-CHAR C)))) (ERROR (C) (LIST (LIST S B 'READ-CHAR (PRINC-TO-STRING C)))))))) (DELETE-FILE F)))
EQL-OK: NIL
(CONVERT-STRING-FROM-BYTES #(195) CHARSET:UTF-8)
[SIMPLE-CHARSET-TYPE-ERROR]: CONVERT-STRING-FROM-BYTES: Incomplete byte sequence at end of buffer for CHARSET:UTF-8
EQL-OK: ERROR
RUN-TEST: finished "encoding" (0 errors out of 36 tests)
RUN-TEST: started #<INPUT BUFFERED FILE-STREAM CHARACTER #P"eval20.tst" @1>
(EVAL (LIST 'CDR (CAR '('(A . B) C))))
EQL-OK: B
(MAKUNBOUND 'X)
EQL-OK: X
(EVAL 'X)
[SIMPLE-UNBOUND-VARIABLE]: EVAL: variable X has no value
EQL-OK: ERROR
(SETF X 3)
EQL-OK: 3
(EVAL 'X)
EQL-OK: 3
(LET ((FF "eval20-tst-eval-when-test.lisp")) (WITH-OPEN-FILE (FOO FF :DIRECTION :OUTPUT) (FORMAT FOO "~%(eval-when (compile eval)
;; note that LAMBDA is not externalizable
(defvar *junk* #.(lambda (x) (+ 15 x))))~%")) (UNWIND-PROTECT (COMPILE-FILE FF) (POST-COMPILE-FILE-CLEANUP FF)) NIL)
;; Compiling file /home/christoph/clisp/src/tests/eval20-tst-eval-when-test.lisp ...
;; Wrote file /home/christoph/clisp/src/tests/eval20-tst-eval-when-test.fas
0 errors, 0 warnings
EQL-OK: NIL
(DEFVAR *COLLECTOR*)
EQL-OK: *COLLECTOR*
(LET ((FORMS NIL) ALL (FF "eval20-tst-eval-when-test.lisp")) (DOLIST (C '(NIL (:COMPILE-TOPLEVEL))) (DOLIST (L '(NIL (:LOAD-TOPLEVEL))) (DOLIST (X '(NIL (:EXECUTE))) (PUSH `(EVAL-WHEN (, at C , at L , at X) (PUSH '(, at C , at L , at X) *COLLECTOR*)) FORMS)))) (DOLIST (C '(NIL (:COMPILE-TOPLEVEL))) (DOLIST (L '(NIL (:LOAD-TOPLEVEL))) (DOLIST (X '(NIL (:EXECUTE))) (PUSH `(LET NIL (EVAL-WHEN (, at C , at L , at X) (PUSH '(LET , at C , at L , at X) *COLLECTOR*))) FORMS)))) (WITH-OPEN-FILE (O FF :DIRECTION :OUTPUT) (DOLIST (F FORMS) (PRIN1 F O) (TERPRI O))) (LET ((*COLLECTOR* NIL)) (LOAD FF) (PUSH (CONS "load source" *COLLECTOR*) ALL)) (LET ((*COLLECTOR* NIL)) (COMPILE-FILE FF) (PUSH (CONS "compile source" *COLLECTOR*) ALL)) (LET ((*COLLECTOR* NIL)) (LOAD (COMPILE-FILE-PATHNAME FF)) (PUSH (CONS "load compiled" *COLLECTOR*) ALL)) (POST-COMPILE-FILE-CLEANUP FF) (NREVERSE ALL))
;; Loading file eval20-tst-eval-when-test.lisp ...
;; Loaded file eval20-tst-eval-when-test.lisp
;; Compiling file /home/christoph/clisp/src/tests/eval20-tst-eval-when-test.lisp ...
;; Wrote file /home/christoph/clisp/src/tests/eval20-tst-eval-when-test.fas
0 errors, 0 warnings
;; Loading file /home/christoph/clisp/src/tests/eval20-tst-eval-when-test.fas ...
;; Loaded file /home/christoph/clisp/src/tests/eval20-tst-eval-when-test.fas
EQUAL-OK: (("load source" (:EXECUTE) (:LOAD-TOPLEVEL :EXECUTE) (:COMPILE-TOPLEVEL :EXECUTE) (:COMPILE-TOPLEVEL :LOAD-TOPLEVEL :EXECUTE) (LET :EXECUTE) (LET :LOAD-TOPLEVEL :EXECUTE) (LET :COMPILE-TOPLEVEL :EXECUTE) (LET :COMPILE-TOPLEVEL :LOAD-TOPLEVEL :EXECUTE)) ("compile source" (:COMPILE-TOPLEVEL) (:COMPILE-TOPLEVEL :EXECUTE) (:COMPILE-TOPLEVEL :LOAD-TOPLEVEL) (:COMPILE-TOPLEVEL :LOAD-TOPLEVEL :EXECUTE)) ("load compiled" (:LOAD-TOPLEVEL) (:LOAD-TOPLEVEL :EXECUTE) (:COMPILE-TOPLEVEL :LOAD-TOPLEVEL) (:COMPILE-TOPLEVEL :LOAD-TOPLEVEL :EXECUTE) (LET :EXECUTE) (LET :LOAD-TOPLEVEL :EXECUTE) (LET :COMPILE-TOPLEVEL :EXECUTE) (LET :COMPILE-TOPLEVEL :LOAD-TOPLEVEL :EXECUTE)))
(LET ((F "eval20-tst-eval-when-test.lisp") (RET NIL)) (DOLIST (SITUATION '(LOAD :LOAD-TOPLEVEL) (NREVERSE RET)) (LET ((*COLLECTOR* NIL)) (WITH-OPEN-FILE (O F :DIRECTION :OUTPUT) (PRIN1 `(LET ((X :LET)) (PUSH (LIST (EVAL-WHEN (,SITUATION) (SETQ X :EVAL-WHEN)) X) *COLLECTOR*)) O)) (LOAD F) (LOAD (COMPILE-FILE F)) (POST-COMPILE-FILE-CLEANUP F) (PUSH (NREVERSE *COLLECTOR*) RET))))
;; Loading file eval20-tst-eval-when-test.lisp ...
;; Loaded file eval20-tst-eval-when-test.lisp
;; Compiling file /home/christoph/clisp/src/tests/eval20-tst-eval-when-test.lisp ...
;; Wrote file /home/christoph/clisp/src/tests/eval20-tst-eval-when-test.fas
0 errors, 0 warnings
;; Loading file /home/christoph/clisp/src/tests/eval20-tst-eval-when-test.fas ...
;; Loaded file /home/christoph/clisp/src/tests/eval20-tst-eval-when-test.fas
;; Loading file eval20-tst-eval-when-test.lisp ...
;; Loaded file eval20-tst-eval-when-test.lisp
;; Compiling file /home/christoph/clisp/src/tests/eval20-tst-eval-when-test.lisp ...
;; Wrote file /home/christoph/clisp/src/tests/eval20-tst-eval-when-test.fas
0 errors, 0 warnings
;; Loading file /home/christoph/clisp/src/tests/eval20-tst-eval-when-test.fas ...
;; Loaded file /home/christoph/clisp/src/tests/eval20-tst-eval-when-test.fas
EQUAL-OK: (((NIL :LET) (:EVAL-WHEN :EVAL-WHEN)) ((NIL :LET) (NIL :LET)))
(LET ((F "eval20-tst-eval-when-test.lisp") (RET NIL)) (DOLIST (SITUATION '(EVAL :EXECUTE) (NREVERSE RET)) (LET ((*COLLECTOR* NIL)) (WITH-OPEN-FILE (O F :DIRECTION :OUTPUT) (PRIN1 `(LET ((X :LET)) (PUSH (LIST (EVAL-WHEN (,SITUATION) (SETQ X :EVAL-WHEN)) X) *COLLECTOR*)) O)) (LOAD F) (LOAD (COMPILE-FILE F)) (POST-COMPILE-FILE-CLEANUP F) (PUSH (NREVERSE *COLLECTOR*) RET))))
;; Loading file eval20-tst-eval-when-test.lisp ...
;; Loaded file eval20-tst-eval-when-test.lisp
;; Compiling file /home/christoph/clisp/src/tests/eval20-tst-eval-when-test.lisp ...
;; Wrote file /home/christoph/clisp/src/tests/eval20-tst-eval-when-test.fas
0 errors, 0 warnings
;; Loading file /home/christoph/clisp/src/tests/eval20-tst-eval-when-test.fas ...
;; Loaded file /home/christoph/clisp/src/tests/eval20-tst-eval-when-test.fas
;; Loading file eval20-tst-eval-when-test.lisp ...
;; Loaded file eval20-tst-eval-when-test.lisp
;; Compiling file /home/christoph/clisp/src/tests/eval20-tst-eval-when-test.lisp ...
;; Wrote file /home/christoph/clisp/src/tests/eval20-tst-eval-when-test.fas
0 errors, 0 warnings
;; Loading file /home/christoph/clisp/src/tests/eval20-tst-eval-when-test.fas ...
;; Loaded file /home/christoph/clisp/src/tests/eval20-tst-eval-when-test.fas
EQUAL-OK: (((:EVAL-WHEN :EVAL-WHEN) (NIL :LET)) ((:EVAL-WHEN :EVAL-WHEN) (:EVAL-WHEN :EVAL-WHEN)))
(CONSTANTP 2)
EQL-OK: T
(CONSTANTP #\r)
EQL-OK: T
(CONSTANTP "max")
EQL-OK: T
(CONSTANTP '#(110))
EQL-OK: T
(CONSTANTP :MAX)
EQL-OK: T
(CONSTANTP T)
EQL-OK: T
(CONSTANTP NIL)
EQL-OK: T
(CONSTANTP 'PI)
EQL-OK: NIL
(CONSTANTP ''FOO)
EQL-OK: T
(CONSTANTP '(+ 3 4))
EQL-OK: T
(CONSTANTP '((SETF CONS) 3 4))
EQL-OK: NIL
(LET ((SRC "eval20-tst.lisp") (ZZ (CONS 1 2))) (DEFUN SETF-FOO (U V) (SETF (CAR U) V)) (WITH-OPEN-FILE (S SRC :DIRECTION :OUTPUT) (FORMAT S "(progn~% (defsetf foo setf-foo)
(defun bar (u v) (setf (foo u) v)))~%")) (LOAD SRC :COMPILING T) (DELETE-FILE SRC) (BAR ZZ 12) ZZ)
;; Loading file eval20-tst.lisp ...
0 errors, 0 warnings
;; Loaded file eval20-tst.lisp
EQUAL-OK: (12 . 2)
(DEFPARAMETER X 1)
EQL-OK: X
(HANDLER-BIND ((UNBOUND-VARIABLE (LAMBDA (C) (PRINC-ERROR C) (STORE-VALUE 10)))) (LIST (LET (X) (MAKUNBOUND 'X) X) X))
[SIMPLE-UNBOUND-VARIABLE]: LET: variable X has no value
EQUAL-OK: (10 1)
(HANDLER-BIND ((UNBOUND-VARIABLE (LAMBDA (C) (PRINC-ERROR C) (STORE-VALUE 11)))) (LIST (LET (X) (MAKUNBOUND 'X) (SYMBOL-VALUE 'X)) X))
[SIMPLE-UNBOUND-VARIABLE]: SYMBOL-VALUE: variable X has no value
EQUAL-OK: (11 1)
(HANDLER-BIND ((UNBOUND-VARIABLE (LAMBDA (C) (PRINC-ERROR C) (STORE-VALUE 12)))) (LIST (LET (X) (MAKUNBOUND 'X) (LIST X (SYMBOL-VALUE 'X))) X))
[SIMPLE-UNBOUND-VARIABLE]: LET: variable X has no value
EQUAL-OK: ((12 12) 1)
(HANDLER-BIND ((UNBOUND-VARIABLE (LAMBDA (C) (PRINC-ERROR C) (STORE-VALUE 13)))) (LIST (LET (X) (MAKUNBOUND 'X) (LIST (SYMBOL-VALUE 'X) X)) X))
[SIMPLE-UNBOUND-VARIABLE]: SYMBOL-VALUE: variable X has no value
EQUAL-OK: ((13 13) 1)
(LET ((COUNT 140)) (HANDLER-BIND ((UNBOUND-VARIABLE (LAMBDA (C) (PRINC-ERROR C) (USE-VALUE (INCF COUNT))))) (LIST (LET (X) (MAKUNBOUND 'X) (LIST X (SYMBOL-VALUE 'X))) X)))
[SIMPLE-UNBOUND-VARIABLE]: LET: variable X has no value
[SIMPLE-UNBOUND-VARIABLE]: SYMBOL-VALUE: variable X has no value
EQUAL-OK: ((141 142) 1)
(LET ((COUNT 150)) (HANDLER-BIND ((UNBOUND-VARIABLE (LAMBDA (C) (PRINC-ERROR C) (USE-VALUE (INCF COUNT))))) (LIST (LET (X) (MAKUNBOUND 'X) (LIST (SYMBOL-VALUE 'X) X)) X)))
[SIMPLE-UNBOUND-VARIABLE]: SYMBOL-VALUE: variable X has no value
[SIMPLE-UNBOUND-VARIABLE]: LET: variable X has no value
EQUAL-OK: ((151 152) 1)
(LET ((Y 1)) (LIST (LET ((Y 20)) (MAKUNBOUND 'Y) Y) Y))
EQUAL-OK: (20 1)
(LET ((Y 1)) (HANDLER-BIND ((UNBOUND-VARIABLE (LAMBDA (C) (PRINC-ERROR C) (STORE-VALUE 21)))) (LIST (LET (Y) (MAKUNBOUND 'Y) (SYMBOL-VALUE 'Y)) Y)))
[SIMPLE-UNBOUND-VARIABLE]: SYMBOL-VALUE: variable Y has no value
EQUAL-OK: (21 1)
(LET ((Y 1)) (HANDLER-BIND ((UNBOUND-VARIABLE (LAMBDA (C) (PRINC-ERROR C) (STORE-VALUE 220)))) (LIST (LET ((Y 22)) (MAKUNBOUND 'Y) (LIST Y (SYMBOL-VALUE 'Y))) Y)))
[SIMPLE-UNBOUND-VARIABLE]: SYMBOL-VALUE: variable Y has no value
EQUAL-OK: ((22 220) 1)
(LET ((Y 1)) (HANDLER-BIND ((UNBOUND-VARIABLE (LAMBDA (C) (PRINC-ERROR C) (STORE-VALUE 230)))) (LIST (LET ((Y 23)) (MAKUNBOUND 'Y) (LIST (SYMBOL-VALUE 'Y) Y)) Y)))
[SIMPLE-UNBOUND-VARIABLE]: SYMBOL-VALUE: variable Y has no value
EQUAL-OK: ((230 23) 1)
(LET ((Y 1) (COUNT 240)) (HANDLER-BIND ((UNBOUND-VARIABLE (LAMBDA (C) (PRINC-ERROR C) (USE-VALUE (INCF COUNT))))) (LIST (LET ((Y 24)) (MAKUNBOUND 'Y) (LIST Y (SYMBOL-VALUE 'Y))) Y)))
[SIMPLE-UNBOUND-VARIABLE]: SYMBOL-VALUE: variable Y has no value
EQUAL-OK: ((24 241) 1)
(LET ((Y 1) (COUNT 250)) (HANDLER-BIND ((UNBOUND-VARIABLE (LAMBDA (C) (PRINC-ERROR C) (USE-VALUE (INCF COUNT))))) (LIST (LET ((Y 25)) (MAKUNBOUND 'Y) (LIST (SYMBOL-VALUE 'Y) Y)) Y)))
[SIMPLE-UNBOUND-VARIABLE]: SYMBOL-VALUE: variable Y has no value
EQUAL-OK: ((251 25) 1)
(FLET ((FLET1 (N) (+ N N))) (FLET ((FLET1 (N) (+ 2 (FLET1 N)))) (FLET1 2)))
EQL-OK: 6
(PROGN (DEFUN DUMMY-FUNCTION NIL 'TOP-LEVEL) (LIST (FUNCALL #'DUMMY-FUNCTION) (FLET ((DUMMY-FUNCTION NIL 'SHADOW)) (FUNCALL #'DUMMY-FUNCTION)) (EQ (FUNCALL #'DUMMY-FUNCTION) (FUNCALL 'DUMMY-FUNCTION)) (FLET ((DUMMY-FUNCTION NIL 'SHADOW)) (EQ (FUNCALL #'DUMMY-FUNCTION) (FUNCALL 'DUMMY-FUNCTION)))))
EQUAL-OK: (TOP-LEVEL SHADOW T NIL)
(PROGN (DEFUN RECURSIVE-TIMES (K N) (LABELS ((TEMP (N) (IF (ZEROP N) 0 (+ K (TEMP (1- N)))))) (TEMP N))) (RECURSIVE-TIMES 2 3))
EQL-OK: 6
(PROGN (DEFMACRO MLETS (X &ENVIRONMENT ENV) (LET ((FORM `(BABBIT ,X))) (MACROEXPAND FORM ENV))) (MACROLET ((BABBIT (Z) `(+ ,Z ,Z))) (MLETS 5)))
EQL-OK: 10
(FLET ((SAFESQRT (X) (SQRT (ABS X)))) (SAFESQRT (APPLY #'+ (MAP 'LIST #'SAFESQRT '(1 2 3 4 5 6)))))
EQL-OK: 3.2911735
(PROGN (DEFUN INTEGER-POWER (N K) (DECLARE (INTEGER N)) (DECLARE (TYPE (INTEGER 0 *) K)) (LABELS ((EXPT0 (X K A) (DECLARE (INTEGER X A) (TYPE (INTEGER 0 *) K)) (COND ((ZEROP K) A) ((EVENP K) (EXPT1 (* X X) (FLOOR K 2) A)) (T (EXPT0 (* X X) (FLOOR K 2) (* X A))))) (EXPT1 (X K A) (DECLARE (INTEGER X A) (TYPE (INTEGER 0 *) K)) (COND ((EVENP K) (EXPT1 (* X X) (FLOOR K 2) A)) (T (EXPT0 (* X X) (FLOOR K 2) (* X A)))))) (EXPT0 N K 1))) (INTEGER-POWER 3 5))
EQL-OK: 243
(PROGN (DEFUN EXAMPLE (Y L) (FLET ((ATTACH (X) (SETQ L (APPEND L (LIST X))))) (DECLARE (INLINE ATTACH)) (DOLIST (X Y) (UNLESS (NULL (CDR X)) (ATTACH X))) L)) (EXAMPLE '((A APPLE APRICOT) (B BANANA) (C CHERRY) (D) (E)) '((1) (2) (3) (4 2) (5) (6 3 2))))
EQUAL-OK: ((1) (2) (3) (4 2) (5) (6 3 2) (A APPLE APRICOT) (B BANANA) (C CHERRY))
(WITH-OUTPUT-TO-STRING (*ERROR-OUTPUT*) (DECLAIM (OPTIMIZE ZOT)))
EQUAL-OK: "WARNING: ZOT is not a valid OPTIMIZE quality.
"
(PROGN (SYMBOL-CLEANUP 'SETF-FOO) (SYMBOL-CLEANUP 'BAR) (SYMBOL-CLEANUP 'X) (SYMBOL-CLEANUP '*COLLECTOR*) (SYMBOL-CLEANUP 'DUMMY-FUNCTION) (SYMBOL-CLEANUP 'RECURSIVE-TIMES) (SYMBOL-CLEANUP 'MLETS) (SYMBOL-CLEANUP 'INTEGER-POWER) (SYMBOL-CLEANUP 'EXAMPLE))
EQL-OK: T
RUN-TEST: finished "eval20" (0 errors out of 44 tests)
RUN-TEST: started #<INPUT BUFFERED FILE-STREAM CHARACTER #P"ext-clisp.tst" @1>
(MAPCAR (LAMBDA (X &AUX A B) (LIST (SETF (IF X A B) 2) A B)) '(T NIL))
EQUAL-OK: ((2 2 NIL) (2 NIL 2))
(LOOP WITH A AND B FOR X BELOW 2 COLLECT (MULTIPLE-VALUE-LIST (SETF (IF (ZEROP X) (VALUES A B) (VALUES B A)) (FLOOR 7 5))) COLLECT (CONS A B))
EQUAL-OK: ((1 2) (1 . 2) (1 2) (2 . 1))
(LET (X A B C) (SETF (IF (ZEROP X) (VALUES A B) C) X))
[SIMPLE-SOURCE-PROGRAM-ERROR]: SETF place (IF #1=(ZEROP X) #2=(VALUES A B) C) expects different numbers of values in the true and false branches (2 vs. 1 values).
EQL-OK: ERROR
(FCASE STRING= (LET ((FOO "two third")) (SUBSEQ FOO 0 (POSITION #\Space FOO))) ("first" 1) (("second" "two") 2) (("true" "yes") T) (OTHERWISE NIL))
EQL-OK: 2
(MULTIPLE-VALUE-LIST (XOR NIL NIL NIL))
EQUAL-OK: (NIL)
(MULTIPLE-VALUE-LIST (XOR NIL (BLOCK NIL (RETURN 'A)) NIL))
EQUAL-OK: (A 2)
(! 10)
EQL-OK: 3628800
(! 11)
EQL-OK: 39916800
(! 0)
EQL-OK: 1
(! 3/2)
[SIMPLE-TYPE-ERROR]: !: argument #1=3/2 is not a nonnegative fixnum
EQL-OK: ERROR
(MULTIPLE-VALUE-LIST (LET (A B) (PUSH (VALUES 1 2) (VALUES A B))))
EQUAL-OK: ((1) (2))
(LET (A B) (LIST (MULTIPLE-VALUE-LIST (PUSHNEW (VALUES 1 2) (VALUES A B))) A B))
EQUAL-OK: (((1) (2)) (1) (2))
(LET ((A '(1)) (B '(2 3))) (LIST (MULTIPLE-VALUE-LIST (POP (VALUES A B))) A B))
EQUAL-OK: ((1 2) NIL (3))
(DEFUN TEST-DOHASH (HASH-TABLE) (LET ((ALL-ENTRIES 'NIL) (GENERATED-ENTRIES 'NIL) (UNIQUE (LIST NIL))) (MAPHASH #'(LAMBDA (KEY VALUE) (PUSH (LIST KEY VALUE) ALL-ENTRIES)) HASH-TABLE) (DOHASH (KEY VALUE HASH-TABLE) (DECLARE (OPTIMIZE SAFETY)) (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 "MAPHASH and EXT:DOHASH entries don't correspond")) T))
EQL-OK: TEST-DOHASH
(LET ((TAB (MAKE-HASH-TABLE :TEST #'EQUAL))) (SETF (GETHASH "Richard" TAB) "Gabriel") (SETF (GETHASH "Bruno" TAB) "Haible") (SETF (GETHASH "Michael" TAB) "Stoll") (SETF (GETHASH "Linus" TAB) "Torvalds") (SETF (GETHASH "Richard" TAB) "Stallman") (TEST-DOHASH TAB))
EQL-OK: T
(LET ((HASH-TABLE (MAKE-HASH-TABLE)) (ENTRIES 'NIL)) (SETF (GETHASH 1 HASH-TABLE) 100) (SETF (GETHASH 2 HASH-TABLE) 200) (SORT (DOHASH (KEY VALUE HASH-TABLE ENTRIES) (DECLARE (IGNORE KEY)) (PUSH VALUE ENTRIES)) #'<))
EQUAL-OK: (100 200)
(LET ((HASH-TABLE (MAKE-HASH-TABLE :INITIAL-CONTENTS '((1 . 100) (2 . 200)))) (ENTRIES 'NIL)) (SORT (DOHASH (KEY VALUE HASH-TABLE ENTRIES) (PUSH VALUE ENTRIES) (GO SKIP) (PUSH KEY ENTRIES) SKIP) #'<))
EQUAL-OK: (100 200)
(LET ((X (LIST 1))) (LIST (LETF (((CAR X) 3)) (LIST X (COPY-LIST X))) X))
EQUAL-OK: (((1) (3)) (1))
(LET ((X (LIST 1))) (LIST (LETF (((CAR X) 3) ((CDR X) (COPY-LIST X))) (LIST X (COPY-LIST X))) X))
EQUAL-OK: (((1) (3 1)) (1))
(LET (A B) (LIST (LETF (((VALUES A B) (VALUES 1 2))) (LIST A B)) (LIST A B)))
EQUAL-OK: ((1 2) (NIL NIL))
(LET ((X (LIST 2))) (LIST (LETF* (((CAR X) 3)) (LIST X (COPY-LIST X))) X))
EQUAL-OK: (((2) (3)) (2))
(LET ((X (LIST 1))) (LIST (LETF* (((CAR X) 3) ((CDR X) (COPY-LIST X))) (LIST X (COPY-LIST X))) X))
EQUAL-OK: (((1) (3 3)) (1))
(LET (A B) (LIST (LETF* (((VALUES A B) (VALUES 1 2))) (LIST A B)) (LIST A B)))
EQUAL-OK: ((1 2) (NIL NIL))
(LET ((X (LIST 1))) (BLOCK NIL (LETF (((CAR X) 2) ((CDR (PROGN (RETURN) X)) 3)) X)) X)
EQUAL-OK: (1)
(LET ((X (LIST 11184810))) (LETF (((LDB (BYTE 5 9) (FIRST X)) -1)) (SETF (FIRST X) 0)) X)
EQUAL-OK: (10752)
(LET ((X (LIST 1))) (LETF (((FIRST X) 3))))
EQL-OK: NIL
(LET ((X (LIST 1))) (MACROLET ((FROB NIL '(FIRST X))) (LETF (((FROB) 2)) (COPY-LIST X))))
EQUAL-OK: (2)
(LET ((X (LIST 1))) (MACROLET ((FROB NIL '(FIRST X))) (LETF* (((FROB) 2)) (COPY-LIST X))))
EQUAL-OK: (2)
(SYMBOL-MACROLET ((A *PRINT-BASE*)) (LETF ((A 36)) (PRINC-TO-STRING 20)))
EQUAL-OK: "K"
(SYMBOL-MACROLET ((A *PRINT-BASE*)) (LETF* ((A 36)) (PRINC-TO-STRING 20)))
EQUAL-OK: "K"
(LET (A B C) (SYMBOL-MACROLET ((A *PRINT-BASE*)) (LETF (((VALUES A B C) 36)) (PRINC-TO-STRING 20))))
EQUAL-OK: "K"
(LET (A B C) (SYMBOL-MACROLET ((A *PRINT-BASE*)) (LETF* (((VALUES A B C) 36)) (PRINC-TO-STRING 20))))
EQUAL-OK: "K"
(LET ((A (VECTOR 0 0))) (LETF (((VALUES (AREF A 0) (AREF A 1)) (FLOOR 7 5))) (COPY-SEQ A)))
EQUALP-OK: #(1 2)
(LET ((A (VECTOR 0 0))) (LETF* (((VALUES (AREF A 0) (AREF A 1)) (FLOOR 7 5))) (COPY-SEQ A)))
EQUALP-OK: #(1 2)
(LETF (((VALUES) 1)) 2)
EQL-OK: 2
(LETF* (((VALUES) 1)) 2)
EQL-OK: 2
(MAKUNBOUND 'XX)
EQL-OK: XX
(LETF (((SYMBOL-VALUE 'XX) 3)) (DECLARE (SPECIAL XX)) XX)
[SIMPLE-UNBOUND-VARIABLE]: SYMBOL-VALUE: variable XX has no value
EQL-OK: ERROR
(MULTIPLE-VALUE-LIST (GETHASH 1 (LETF* ((H (MAKE-HASH-TABLE)) ((GETHASH 1 H) 'A)) H) 2))
EQUAL-OK: (NIL T)
(MULTIPLE-VALUE-LIST (GETHASH 1 (LETF* ((H (MAKE-HASH-TABLE)) ((GETHASH 1 H 'B) 'A)) H) 2))
EQUAL-OK: (B T)
(LET ((A 'NIL)) (LETF* (((GETF A :KEY) 1))) A)
EQUAL-OK: (:KEY NIL)
(LET ((A 'NIL)) (LETF* (((GETF A :KEY :DEFAULT) 1))) A)
EQUAL-OK: (:KEY :DEFAULT)
(LET ((A 'NIL)) (LETF (((GETF A :KEY :DEFAULT) 1))) A)
EQUAL-OK: (:KEY :DEFAULT)
(LET* ((X 9) (F (LAMBDA NIL X))) (LETF (((VALUES X Y) (FLOOR 7 5))) (LIST X (FUNCALL F))))
EQUAL-OK: (1 9)
(LET* ((X 9) (F (LAMBDA NIL X))) (LETF* (((VALUES X Y) (FLOOR 7 5))) (LIST X (FUNCALL F))))
EQUAL-OK: (1 9)
(LET* ((X 9) (FX (LAMBDA NIL X)) (Y 3) (FY (LAMBDA NIL Y))) (LETF* (((VALUES (VALUES X) Y) (FLOOR 7 5))) (LIST X (FUNCALL FX) Y (FUNCALL FY))))
EQUAL-OK: (1 1 2 2)
(LET* ((X (LIST 9)) (Y 8) (FY (LAMBDA NIL Y))) (LETF* (((VALUES (CAR X) Y) (FLOOR 7 5))) (LIST Y (FUNCALL FY))))
EQUAL-OK: (2 2)
(EVERY #'FEATUREP *FEATURES*)
EQL-OK: T
(NOTANY (LAMBDA (X) (FEATUREP `(NOT ,X))) *FEATURES*)
EQL-OK: T
((LAMBDA (X) (DECLARE (COMPILE)) (ETHE INTEGER X)) 3)
EQL-OK: 3
((LAMBDA (X) (DECLARE (COMPILE)) (ETHE INTEGER X)) T)
[SIMPLE-ERROR]: The form X yielded T ,
that's not of type INTEGER.
EQL-OK: ERROR
(LOCALLY (DECLARE (COMPILE)) (MULTIPLE-VALUE-LIST (ETHE (VALUES INTEGER FLOAT) (TRUNCATE 3.2 2))))
EQUAL-OK: (1 1.2)
(LOCALLY (DECLARE (COMPILE)) (ETHE (VALUES FLOAT INTEGER) (TRUNCATE 3.2 2)))
[SIMPLE-ERROR]: The form (TRUNCATE 3.2 2) yielded 1 ; 1.2 ,
that's not of type (VALUES FLOAT INTEGER).
EQL-OK: ERROR
(CANONICALIZE 1 `(,#'1+))
[SIMPLE-ERROR]: CANONICALIZE(1 (#<SYSTEM-FUNCTION 1+>)): maximum number of iterations exceeded 1,024, last two values were 1025 and 1026
EQL-OK: ERROR
(CANONICALIZE "foo" `(,#'STRING-UPCASE) :TEST 'EQUAL)
EQUAL-OK: "FOO"
(CANONICALIZE "iso1234" `(,(LAMBDA (S) (IF (AND (<= 4 (LENGTH S)) (STRING-EQUAL S "iso" :END1 3) (NOT (CHAR= #\- (CHAR S 3)))) (CONCATENATE 'STRING "ISO-" (SUBSEQ S 3)) S))) :TEST 'EQUAL)
EQUAL-OK: "ISO-1234"
(DEFUN CHECK-LOAD (FILE) (LET* ((DIR (STRING-CONCAT (SECOND (PATHNAME-DIRECTORY FILE)) "/")) (*LOAD-PATHS* (LIST '#P"" (PATHNAME (STRING-CONCAT DIR "**/"))))) (UNWIND-PROTECT (PROGN (PREPARE-DIRECTORY FILE) (WITH-OPEN-FILE (S FILE :DIRECTION :OUTPUT) (PRIN1 '(SETF (CDR *LOAD-PATHS*) NIL) S)) (LOAD (PATHNAME-NAME FILE)) *LOAD-PATHS*) (RMRF DIR))))
EQL-OK: CHECK-LOAD
(CHECK-LOAD "ext-clisp-tst/foo/bar/baz/zot.lisp")
Creating directory: /home/christoph/clisp/src/tests/ext-clisp-tst/
Creating directory: /home/christoph/clisp/src/tests/ext-clisp-tst/foo/
Creating directory: /home/christoph/clisp/src/tests/ext-clisp-tst/foo/bar/
Creating directory: /home/christoph/clisp/src/tests/ext-clisp-tst/foo/bar/baz/
;; Loading file /home/christoph/clisp/src/tests/ext-clisp-tst/foo/bar/baz/zot.lisp ...
;; Loaded file /home/christoph/clisp/src/tests/ext-clisp-tst/foo/bar/baz/zot.lisp
/home/christoph/clisp/src/tests/ext-clisp-tst/foo/bar/baz/zot.lisp 29 2011-04-03 13:42:02
/home/christoph/clisp/src/tests/ext-clisp-tst/ 4096 2011-04-03 13:42:02
/home/christoph/clisp/src/tests/ext-clisp-tst/foo/ 4096 2011-04-03 13:42:02
/home/christoph/clisp/src/tests/ext-clisp-tst/foo/bar/ 4096 2011-04-03 13:42:02
/home/christoph/clisp/src/tests/ext-clisp-tst/foo/bar/baz/ 4096 2011-04-03 13:42:02
removing file #P"/home/christoph/clisp/src/tests/ext-clisp-tst/foo/bar/baz/zot.lisp"
removing directory #P"/home/christoph/clisp/src/tests/ext-clisp-tst/foo/bar/baz/"
removing directory #P"/home/christoph/clisp/src/tests/ext-clisp-tst/foo/bar/"
removing directory #P"/home/christoph/clisp/src/tests/ext-clisp-tst/foo/"
removing directory #P"/home/christoph/clisp/src/tests/ext-clisp-tst/"
EQUAL-OK: (#P"")
(CHECK-LOAD "ext-clisp-tst/foo/bar/baz/zot")
Creating directory: /home/christoph/clisp/src/tests/ext-clisp-tst/
Creating directory: /home/christoph/clisp/src/tests/ext-clisp-tst/foo/
Creating directory: /home/christoph/clisp/src/tests/ext-clisp-tst/foo/bar/
Creating directory: /home/christoph/clisp/src/tests/ext-clisp-tst/foo/bar/baz/
;; Loading file /home/christoph/clisp/src/tests/ext-clisp-tst/foo/bar/baz/zot ...
;; Loaded file /home/christoph/clisp/src/tests/ext-clisp-tst/foo/bar/baz/zot
/home/christoph/clisp/src/tests/ext-clisp-tst/foo/bar/baz/zot 29 2011-04-03 13:42:02
/home/christoph/clisp/src/tests/ext-clisp-tst/ 4096 2011-04-03 13:42:02
/home/christoph/clisp/src/tests/ext-clisp-tst/foo/ 4096 2011-04-03 13:42:02
/home/christoph/clisp/src/tests/ext-clisp-tst/foo/bar/ 4096 2011-04-03 13:42:02
/home/christoph/clisp/src/tests/ext-clisp-tst/foo/bar/baz/ 4096 2011-04-03 13:42:02
removing file #P"/home/christoph/clisp/src/tests/ext-clisp-tst/foo/bar/baz/zot"
removing directory #P"/home/christoph/clisp/src/tests/ext-clisp-tst/foo/bar/baz/"
removing directory #P"/home/christoph/clisp/src/tests/ext-clisp-tst/foo/bar/"
removing directory #P"/home/christoph/clisp/src/tests/ext-clisp-tst/foo/"
removing directory #P"/home/christoph/clisp/src/tests/ext-clisp-tst/"
EQUAL-OK: (#P"")
(DEFPARAMETER *S1* (OPEN "ext-clisp-tst-abazonk" :DIRECTION :OUTPUT))
EQL-OK: *S1*
(OPEN "ext-clisp-tst-abazonk" :DIRECTION :OUTPUT)
[SIMPLE-FILE-ERROR]: OPEN: #<OUTPUT BUFFERED FILE-STREAM CHARACTER #P"ext-clisp-tst-abazonk"> already points to file #1="/home/christoph/clisp/src/tests/ext-clisp-tst-abazonk", opening the file again for :OUTPUT may produce unexpected results
EQL-OK: ERROR
(DEFPARAMETER *S2* (APPEASE-CERRORS (OPEN "ext-clisp-tst-abazonk")))
WARNING: OPEN: #<OUTPUT BUFFERED FILE-STREAM CHARACTER #P"ext-clisp-tst-abazonk"> already points to file
"/home/christoph/clisp/src/tests/ext-clisp-tst-abazonk", opening the file again for :INPUT may produce unexpected results
Open the file anyway
EQL-OK: *S2*
(EQUAL (TRUENAME *S1*) (TRUENAME *S2*))
EQL-OK: T
(OPEN-STREAM-P *S1*)
EQL-OK: T
(OPEN-STREAM-P *S2*)
EQL-OK: T
(DEFPARAMETER *S3* (LET ((*REOPEN-OPEN-FILE* 'WARN)) (OPEN "ext-clisp-tst-abazonk")))
WARNING: OPEN: #<OUTPUT BUFFERED FILE-STREAM CHARACTER #P"ext-clisp-tst-abazonk"> already points to file
"/home/christoph/clisp/src/tests/ext-clisp-tst-abazonk", opening the file again for :INPUT may produce unexpected results
EQL-OK: *S3*
(OPEN-STREAM-P *S1*)
EQL-OK: T
(OPEN-STREAM-P *S2*)
EQL-OK: T
(OPEN-STREAM-P *S3*)
EQL-OK: T
(EQUAL (TRUENAME *S1*) (TRUENAME *S3*))
EQL-OK: T
(DEFPARAMETER *S4* (LET ((*REOPEN-OPEN-FILE* 'CLOSE)) (OPEN "ext-clisp-tst-abazonk")))
EQL-OK: *S4*
(OPEN-STREAM-P *S1*)
EQL-OK: NIL
(OPEN-STREAM-P *S2*)
EQL-OK: T
(OPEN-STREAM-P *S3*)
EQL-OK: T
(OPEN-STREAM-P *S4*)
EQL-OK: T
(EQUAL (TRUENAME *S1*) (TRUENAME *S4*))
EQL-OK: T
(DEFPARAMETER *S1* (LET ((*REOPEN-OPEN-FILE* 'CLOSE)) (OPEN "ext-clisp-tst-abazonk" :DIRECTION :OUTPUT)))
EQL-OK: *S1*
(OPEN-STREAM-P *S1*)
EQL-OK: T
(OPEN-STREAM-P *S2*)
EQL-OK: NIL
(OPEN-STREAM-P *S3*)
EQL-OK: NIL
(OPEN-STREAM-P *S4*)
EQL-OK: NIL
(EQUAL (TRUENAME *S1*) (TRUENAME *S4*))
EQL-OK: T
(LET ((*REOPEN-OPEN-FILE* 0)) (OPEN "ext-clisp-tst-abazonk"))
WARNING: OPEN: The value of *REOPEN-OPEN-FILE* should be one of ERROR, WARN, CLOSE, or NIL, not 0. It has been changed to ERROR.
[SIMPLE-FILE-ERROR]: OPEN: #<OUTPUT BUFFERED FILE-STREAM CHARACTER #P"ext-clisp-tst-abazonk"> already points to file #1="/home/christoph/clisp/src/tests/ext-clisp-tst-abazonk", opening the file again for :INPUT may produce unexpected results
EQL-OK: ERROR
(CLOSE *S1*)
EQL-OK: T
(PATHNAMEP (DELETE-FILE *S1*))
EQL-OK: T
(MULTIPLE-VALUE-BIND (CMD ARGS) (CMD-ARGS) (LIST (RUN-PROGRAM CMD :ARGUMENTS (APPEND ARGS '("-x" "(exit 42)"))) (RUN-PROGRAM CMD :ARGUMENTS (APPEND ARGS '("-x" "(exit)")))))
EQUAL-OK: (42 NIL)
(MULTIPLE-VALUE-BIND (CMD ARGS) (CMD-ARGS) (WITH-OPEN-STREAM (S (MAKE-PIPE-INPUT-STREAM (WITH-OUTPUT-TO-STRING (S) (PRINC CMD S) (DOLIST (A ARGS) (PRINC #\Space S) (PRINC A S)) (PRINC " -x \"(quote hello)\"" S)))) (READ-LINE S)))
EQUAL-OK: "HELLO"
(MULTIPLE-VALUE-BIND (CMD ARGS) (CMD-ARGS) (WITH-OPEN-STREAM (S (MAKE-PIPE-OUTPUT-STREAM (WITH-OUTPUT-TO-STRING (S) (PRINC CMD S) (DOLIST (A ARGS) (PRINC #\Space S) (PRINC A S))))) (WRITE-LINE "(quit)" S)))
EQUAL-OK: "(quit)"
[1]> (MULTIPLE-VALUE-BIND (CMD ARGS) (CMD-ARGS) (MULTIPLE-VALUE-BIND (PID IN OUT ERR) (EXT::LAUNCH CMD :ARGUMENTS ARGS :INPUT :PIPE :OUTPUT :PIPE :ERROR :PIPE) (UNWIND-PROTECT (LIST (INTEGERP (SHOW PID)) (OUTPUT-STREAM-P IN) (INPUT-STREAM-P OUT) (INPUT-STREAM-P ERR) (WRITE-LINE "(quit)" IN) (FORCE-OUTPUT IN) (READ-LINE OUT)) (CLOSE IN) (CLOSE OUT) (CLOSE ERR))))
26920
EQUAL-OK: (T T T T "(quit)" NIL "[1]> ")
(LET ((ARGS (LIST (CODE-CHAR (RANDOM CHAR-CODE-LIMIT)) (USER-HOMEDIR-PATHNAME) 'ARGS))) (LOOP :FOR L :IN '((LAMBDA (A B C) (CONCATENATE 'STRING "[" (SYMBOL-NAME C) " " (NAMESTRING B) " " (CHAR-NAME A) "]"))) :FOR C = (COMPILE NIL L) :DO (DISASSEMBLE C) :ALWAYS (STRING= (APPLY (COERCE L 'FUNCTION) ARGS) (SHOW (APPLY C ARGS)))))
Disassembly of function NIL
(CONST 0) = "["
(CONST 1) = " "
(CONST 2) = " "
(CONST 3) = "]"
3 required arguments
0 optional arguments
No rest parameter
No keyword parameters
12 byte-code instructions:
0 (CONST&PUSH 0) ; "["
1 (LOAD&PUSH 2)
2 (CALLS2&PUSH 166) ; SYMBOL-NAME
4 (CONST&PUSH 1) ; " "
5 (LOAD&PUSH 5)
6 (CALLS2&PUSH 6) ; NAMESTRING
8 (CONST&PUSH 2) ; " "
9 (LOAD&PUSH 8)
10 (CALLS1&PUSH 48) ; CHAR-NAME
12 (CONST&PUSH 3) ; "]"
13 (CALLSR 7 19) ; STRING-CONCAT
16 (SKIP&RET 4)
"[ARGS /home/christoph/ U0005B678]"
EQL-OK: T
(TYPE-OF (LAMBDA (X) (DECLARE (COMPILE IDENT)) X))
EQL-OK: COMPILED-FUNCTION
(SYSTEM::CLOSURE-NAME (LAMBDA (X) (DECLARE (COMPILE IDENT)) X))
EQL-OK: IDENT
(LET ((L (LET ((X 12)) (DECLARE (COMPILE INCREMENT)) (LIST (LAMBDA NIL (INCF X)) (LAMBDA NIL (DECF X)))))) (LIST (EVERY #'COMPILED-FUNCTION-P L) (MAPCAR #'SYSTEM::CLOSURE-NAME L) (MAPCAR #'FUNCALL L)))
EQUAL-OK: (T (INCREMENT-1 INCREMENT-2) (13 12))
(MULTIPLE-VALUE-BIND (MYPUSH MYPOP) (LET ((ACC NIL)) (VALUES (LAMBDA (X) (PUSH X ACC)) (LAMBDA NIL (POP ACC)))) (LIST (LIST (FUNCALL MYPOP) (FUNCALL MYPUSH 1) (FUNCALL MYPOP) (FUNCALL MYPOP) (FUNCALL MYPUSH 2) (FUNCALL MYPUSH 3) (FUNCALL MYPOP) (FUNCALL MYPOP) (FUNCALL MYPOP)) (LET ((PAIR (READ-FROM-STRING (WITH-STANDARD-IO-SYNTAX (LET ((*PRINT-CLOSURE* T)) (PRIN1-TO-STRING (CONS MYPUSH MYPOP))))))) (LIST (FUNCALL (CDR PAIR)) (FUNCALL (CAR PAIR) 1) (FUNCALL (CDR PAIR)) (FUNCALL (CDR PAIR)) (FUNCALL (CAR PAIR) 2) (FUNCALL (CAR PAIR) 3) (FUNCALL (CDR PAIR)) (FUNCALL (CDR PAIR)) (FUNCALL (CDR PAIR))))))
EQUAL-OK: ((NIL (1) 1 NIL (2) (3 2) 3 2 NIL) (NIL (1) 1 NIL (2) (3 2) 3 2 NIL))
(PROGN (SYMBOL-CLEANUP 'CHECK-LOAD) (SYMBOL-CLEANUP 'TEST-DOHASH) (SYMBOL-CLEANUP '*S1*) (SYMBOL-CLEANUP '*S2*) (SYMBOL-CLEANUP '*S3*) (SYMBOL-CLEANUP '*S4*))
EQL-OK: T
RUN-TEST: finished "ext-clisp" (0 errors out of 95 tests)
RUN-TEST: started #<INPUT BUFFERED FILE-STREAM CHARACTER #P"ffi.tst" @1>
(ENCODING-CHARSET *DEFAULT-FILE-ENCODING*)
EQL-OK: CHARSET:UTF-8
(USE-PACKAGE "FFI")
EQL-OK: T
(MULTIPLE-VALUE-LIST (SIZEOF 'UINT8))
EQUAL-OK: (1 1)
(BITSIZEOF 'SINT32)
EQL-OK: 32
(MULTIPLE-VALUE-LIST (SIZEOF '(C-POINTER INT)))
EQUAL-OK: (4 4)
(FOREIGN-ADDRESS-UNSIGNED (UNSIGNED-FOREIGN-ADDRESS 3))
EQL-OK: 3
(HANDLER-CASE (PROGN (DEF-CALL-OUT STRERROR (:ARGUMENTS (ERRNUM INT)) (:LANGUAGE :STDC) (:LIBRARY :DEFAULT) (:RETURN-TYPE C-STRING :NONE)) (LOOP :FOR I :FROM 0 :TO 100 :DO (SHOW (STRERROR I))) (DEF-C-VAR ERRNO (:TYPE INT) (:LIBRARY :DEFAULT)) (DEFUN OS-ERROR (WHERE) (ERROR "~S failed: errno=~D: ~S" WHERE ERRNO (STRERROR ERRNO)))) (ERROR (C) (PRINC-ERROR C) (DEFUN OS-ERROR (WHERE) (ERROR "~S failed" WHERE))))
"Success"
"Operation not permitted"
"No such file or directory"
"No such process"
"Interrupted system call"
"Input/output error"
"No such device or address"
"Argument list too long"
"Exec format error"
"Bad file descriptor"
"No child processes"
"Resource temporarily unavailable"
"Cannot allocate memory"
"Permission denied"
"Bad address"
"Block device required"
"Device or resource busy"
"File exists"
"Invalid cross-device link"
"No such device"
"Not a directory"
"Is a directory"
"Invalid argument"
"Too many open files in system"
"Too many open files"
"Inappropriate ioctl for device"
"Text file busy"
"File too large"
"No space left on device"
"Illegal seek"
"Read-only file system"
"Too many links"
"Broken pipe"
"Numerical argument out of domain"
"Numerical result out of range"
"Resource deadlock avoided"
"File name too long"
"No locks available"
"Function not implemented"
"Directory not empty"
"Too many levels of symbolic links"
"Unknown error 41"
"No message of desired type"
"Identifier removed"
"Channel number out of range"
"Level 2 not synchronized"
"Level 3 halted"
"Level 3 reset"
"Link number out of range"
"Protocol driver not attached"
"No CSI structure available"
"Level 2 halted"
"Invalid exchange"
"Invalid request descriptor"
"Exchange full"
"No anode"
"Invalid request code"
"Invalid slot"
"Unknown error 58"
"Bad font file format"
"Device not a stream"
"No data available"
"Timer expired"
"Out of streams resources"
"Machine is not on the network"
"Package not installed"
"Object is remote"
"Link has been severed"
"Advertise error"
"Srmount error"
"Communication error on send"
"Protocol error"
"Multihop attempted"
"RFS specific error"
"Bad message"
"Value too large for defined data type"
"Name not unique on network"
"File descriptor in bad state"
"Remote address changed"
"Can not access a needed shared library"
"Accessing a corrupted shared library"
".lib section in a.out corrupted"
"Attempting to link in too many shared libraries"
"Cannot exec a shared library directly"
"Invalid or incomplete multibyte or wide character"
"Interrupted system call should be restarted"
"Streams pipe error"
"Too many users"
"Socket operation on non-socket"
"Destination address required"
"Message too long"
"Protocol wrong type for socket"
"Protocol not available"
"Protocol not supported"
"Socket type not supported"
"Operation not supported"
"Protocol family not supported"
"Address family not supported by protocol"
"Address already in use"
"Cannot assign requested address"
"Network is down"
EQL-OK: OS-ERROR
(DEF-CALL-OUT GETHOSTNAME1 (:NAME "gethostname") (:ARGUMENTS (NAME (C-PTR (C-ARRAY-MAX CHARACTER 256)) :OUT :ALLOCA) (LEN INT)) (:RETURN-TYPE INT) (:LANGUAGE :STDC) (:LIBRARY :DEFAULT))
EQL-OK: GETHOSTNAME1
(DEFUN MYHOSTNAME1 NIL (MULTIPLE-VALUE-BIND (SUCCESS NAME) (GETHOSTNAME1 256) (IF (ZEROP SUCCESS) NAME (OS-ERROR 'MYHOSTNAME1))))
EQL-OK: MYHOSTNAME1
(DEF-CALL-OUT GETHOSTNAME2 (:NAME "gethostname") (:ARGUMENTS (NAME (C-PTR (C-ARRAY-MAX CHAR 256)) :OUT :ALLOCA) (LEN INT)) (:RETURN-TYPE INT) (:LANGUAGE :STDC) (:LIBRARY :DEFAULT))
EQL-OK: GETHOSTNAME2
(DEFUN MYHOSTNAME2 NIL (MULTIPLE-VALUE-BIND (SUCCESS NAME) (GETHOSTNAME2 256) (IF (ZEROP SUCCESS) NAME (OS-ERROR 'MYHOSTNAME2))))
EQL-OK: MYHOSTNAME2
(DEF-CALL-OUT GETHOSTNAME3 (:NAME "gethostname") (:ARGUMENTS (NAME C-POINTER) (LEN INT)) (:RETURN-TYPE INT) (:LANGUAGE :STDC) (:LIBRARY :DEFAULT))
EQL-OK: GETHOSTNAME3
(DEFUN MYHOSTNAME3 NIL (WITH-FOREIGN-OBJECT (NAME '(C-ARRAY-MAX CHARACTER 256)) (LET ((SUCCESS (GETHOSTNAME3 NAME 256))) (IF (ZEROP SUCCESS) (FOREIGN-VALUE NAME) (OS-ERROR 'MYHOSTNAME3)))))
EQL-OK: MYHOSTNAME3
(DEFUN MYHOSTNAME4 NIL (WITH-FOREIGN-OBJECT (NAME '(C-ARRAY-MAX CHAR 256)) (LET ((SUCCESS (GETHOSTNAME3 NAME 256))) (IF (ZEROP SUCCESS) (FOREIGN-VALUE NAME) (OS-ERROR 'MYHOSTNAME4)))))
EQL-OK: MYHOSTNAME4
(STRING= (MYHOSTNAME1) (MYHOSTNAME3))
EQL-OK: T
(EQUALP (MYHOSTNAME2) (MYHOSTNAME4))
EQL-OK: T
(LET ((N1 (SHOW (MYHOSTNAME1))) (MI (SHOW (MACHINE-INSTANCE)))) (OR (AND (>= (LENGTH MI) (LENGTH N1)) (STRING= N1 MI :END2 (LENGTH N1))) (PROGN (DEF-CALL-OUT GETHOSTBYNAME (:NAME "gethostbyname") (:ARGUMENTS (NAME C-STRING)) (:LANGUAGE :STDC) (:LIBRARY :DEFAULT) (:RETURN-TYPE (C-PTR (C-STRUCT LIST (NAME C-STRING))))) (SETQ N1 (FIRST (SHOW (GETHOSTBYNAME N1)))) (STRING= N1 MI :END2 (LENGTH N1)))))
"zelenka"
"zelenka.debian.org [80.245.147.40]"
EQL-OK: T
(STRING= (MYHOSTNAME1) (CONVERT-STRING-FROM-BYTES (MYHOSTNAME2) CHARSET:UTF-8))
EQL-OK: T
(DEF-CALL-OUT C-SELF (:NAME "ffi_identity") (:DOCUMENTATION "return the pointer argument as is") (:ARGUMENTS (OBJ C-POINTER)) (:RETURN-TYPE C-POINTER) (:LANGUAGE :STDC))
EQL-OK: C-SELF
(SYSTEM::GET-SIGNATURE #'C-SELF)
EQUALP-OK: #(1 0 NIL NIL NIL NIL)
(DESCRIBE #'C-SELF)
#<FOREIGN-FUNCTION "ffi_identity" #x00516AF4> is a foreign function of foreign type
(C-FUNCTION (:ARGUMENTS ((:|arg1| C-POINTER :IN :NONE))) (:RETURN-TYPE C-POINTER :NONE) (:LANGUAGE :STDC)).
EQL-OK: NIL
(DOCUMENTATION 'C-SELF 'FUNCTION)
EQUAL-OK: "return the pointer argument as is"
(SETF (DOCUMENTATION 'C-SELF 'FUNCTION) "junk")
EQUAL-OK: "junk"
(DOCUMENTATION 'C-SELF 'FUNCTION)
EQUAL-OK: "junk"
(SETF (DOCUMENTATION 'C-SELF 'FUNCTION) NIL)
EQL-OK: NIL
(DOCUMENTATION 'C-SELF 'FUNCTION)
EQL-OK: NIL
(SETF (DOCUMENTATION 'C-SELF 'FUNCTION) "return argument")
EQUAL-OK: "return argument"
(DOCUMENTATION 'C-SELF 'FUNCTION)
EQUAL-OK: "return argument"
(TYPEP #'C-SELF 'FUNCTION)
EQL-OK: T
(TYPEP #'C-SELF 'FOREIGN-FUNCTION)
EQL-OK: T
(SUBTYPEP 'FOREIGN-FUNCTION 'FUNCTION)
EQL-OK: T
(CHECK-TYPE #'C-SELF FOREIGN-FUNCTION)
EQL-OK: NIL
(INTEGERP (FOREIGN-ADDRESS-UNSIGNED #'C-SELF))
EQL-OK: T
(EQL (FOREIGN-ADDRESS-UNSIGNED #'C-SELF) (SYSTEM::CODE-ADDRESS-OF #'C-SELF))
EQL-OK: T
(FUNCTIONP (SETQ PARSE-C-TYPE-OPTIMIZER (COMPILER-MACRO-FUNCTION 'PARSE-C-TYPE)))
EQL-OK: T
(FUNCALL PARSE-C-TYPE-OPTIMIZER '(PARSE-C-TYPE 'C-POINTER) NIL)
EQUAL-OK: 'C-POINTER
(FUNCALL PARSE-C-TYPE-OPTIMIZER '(PARSE-C-TYPE 'C-POINTER 'OPAQUE) NIL)
EQUAL-OK: (PARSE-C-TYPE 'C-POINTER 'OPAQUE)
(DEF-C-TYPE OPAQUE C-POINTER)
EQL-OK: OPAQUE
(FUNCALL PARSE-C-TYPE-OPTIMIZER '(PARSE-C-TYPE 'OPAQUE) NIL)
EQUAL-OK: 'C-POINTER
(FUNCALL PARSE-C-TYPE-OPTIMIZER '(PARSE-C-TYPE '(C-PTR UINT8)) NIL)
EQUAL-OK: (PARSE-C-TYPE '(C-PTR UINT8))
(CAR (FUNCALL PARSE-C-TYPE-OPTIMIZER '(PARSE-C-TYPE `(C-ARRAY UINT8 ,L)) NIL))
EQL-OK: VECTOR
(CAR (FUNCALL PARSE-C-TYPE-OPTIMIZER '(PARSE-C-TYPE `(C-ARRAY ,TYPE ,L)) NIL))
EQL-OK: PARSE-C-TYPE
(LET NIL (DECLARE (COMPILE)) (WITH-C-VAR (PLACE 'LONG -12345678) PLACE))
EQL-OK: -12345678
(LET NIL (DECLARE (COMPILE)) (WITH-FOREIGN-OBJECT (FV 'LONG -12345678) (FOREIGN-VALUE FV)))
EQL-OK: -12345678
(WITH-C-VAR (PLACE '(C-ARRAY SINT8 (2 3)) #2A((-1 -2 -3) (-9 -8 -7))) PLACE)
EQUALP-OK: #2A((-1 -2 -3) (-9 -8 -7))
(WITH-C-VAR (PLACE '(C-ARRAY SINT8 (2 3)) #(#(-1 -2 -3) #(-9 -8 -7))) PLACE)
[SIMPLE-ERROR]: FFI::EXEC-ON-STACK: #(#(-1 -2 -3) #(-9 -8 -7)) cannot be converted to the foreign type #(C-ARRAY SINT8 2 3)
EQL-OK: ERROR
(WITH-C-VAR (PLACE '(C-ARRAY SINT8 (2 3)) #2A((-1 -2 -3) (-9 -8 -7))) (CAST PLACE '(C-ARRAY SINT8 (3 2))))
EQUALP-OK: #2A((-1 -2) (-3 -9) (-8 -7))
(WITH-FOREIGN-OBJECT (A '(C-ARRAY SINT32 4) #(122222 928389716 -1987234239 -123141)) (MEMORY-AS A 'SINT32 8))
EQL-OK: -1987234239
(WITH-C-VAR (A '(C-ARRAY SINT32 4) #(122222 928389716 -19 -123141)) (SETF (MEMORY-AS (C-VAR-ADDRESS A) 'SINT32 8) 478798798) A)
EQUALP-OK: #(122222 928389716 478798798 -123141)
(WITH-C-VAR (A '(C-ARRAY SINT32 4) #(122222 928389716 -19 -123141)) (SETF (MEMORY-AS (C-VAR-ADDRESS A) 'SINT32 8) 478798798))
EQL-OK: 478798798
(WITH-FOREIGN-OBJECT (A '(C-ARRAY DOUBLE-FLOAT 2) #(9.05d12 -1.2765d-12)) (MEMORY-AS A 'DOUBLE-FLOAT 0))
EQL-OK: 9.05d12
(WITH-FOREIGN-OBJECT (A '(C-ARRAY SINGLE-FLOAT 2) #(9.05E12 -1.2765E-12)) (MEMORY-AS A 'SINGLE-FLOAT 0))
EQL-OK: 9.05E12
(WITH-FOREIGN-OBJECT (X 'SINGLE-FLOAT) (LIST (SETF (MEMORY-AS X 'SINGLE-FLOAT) -2.823E-14) (FOREIGN-VALUE X)))
EQUAL-OK: (-2.823E-14 -2.823E-14)
(WITH-C-VAR (P '(C-PTR SINT32) -823498) (= (FOREIGN-ADDRESS-UNSIGNED (MEMORY-AS (C-VAR-ADDRESS P) 'C-POINTER)) (FOREIGN-ADDRESS-UNSIGNED (C-VAR-ADDRESS (DEREF P)))))
EQL-OK: T
(WITH-FOREIGN-OBJECT (P '(C-PTR SINT32) -823498) (= (FOREIGN-ADDRESS-UNSIGNED (MEMORY-AS P 'C-POINTER)) (FOREIGN-ADDRESS-UNSIGNED P)))
EQL-OK: NIL
(WITH-FOREIGN-OBJECT (P '(C-PTR SINT16)) (WITH-FOREIGN-OBJECT (I 'SINT16 -32765) (LIST (EQ (SETF (MEMORY-AS P 'C-POINTER) I) I) (FOREIGN-VALUE P))))
EQUAL-OK: (T -32765)
(PROGN (DEF-CALL-OUT C-SELF (:NAME "ffi_identity") (:ARGUMENTS (OBJ (C-POINTER SHORT))) (:RETURN-TYPE (C-PTR-NULL SHORT)) (:LANGUAGE :STDC)) (C-SELF NIL))
EQL-OK: NIL
(WITH-FOREIGN-OBJECT (X 'SHORT -29876) (C-SELF X))
EQL-OK: -29876
(WITH-FOREIGN-OBJECT (X 'SHORT -19635) (C-SELF (FOREIGN-ADDRESS X)))
EQL-OK: -19635
(WITH-FOREIGN-OBJECT (X 'CHARACTER #\t) (C-SELF X))
[SIMPLE-ERROR]: FFI::FOREIGN-CALL-OUT: #<FOREIGN-VARIABLE "EXEC-ON-STACK" #x7FF3CF10> cannot be converted to the foreign type SHORT
EQL-OK: ERROR
(TYPE-OF (FOREIGN-FUNCTION #'C-SELF (PARSE-C-TYPE '(C-FUNCTION (:ARGUMENTS (OBJ (C-POINTER SHORT))) (:RETURN-TYPE (C-PTR-NULL SHORT)) (:LANGUAGE :STDC)))))
EQL-OK: FOREIGN-FUNCTION
(FUNCALL (FOREIGN-FUNCTION #'C-SELF (PARSE-C-TYPE '(C-FUNCTION (:ARGUMENTS (OBJ LONG)) (:RETURN-TYPE LONG) (:LANGUAGE :STDC))) :NAME "foo1") 1734829927)
EQL-OK: 1734829927
(FUNCALL (FOREIGN-FUNCTION (FOREIGN-ADDRESS #'C-SELF) (PARSE-C-TYPE '(C-FUNCTION (:ARGUMENTS (OBJ LONG)) (:RETURN-TYPE LONG) (:LANGUAGE :STDC))) :NAME "foo2") 1987475062)
EQL-OK: 1987475062
(PROGN (DEF-CALL-OUT C-SELF (:NAME "ffi_identity") (:ARGUMENTS (OBJ C-POINTER)) (:RETURN-TYPE (C-POINTER CHAR)) (:LANGUAGE :STDC)) (C-SELF NIL))
EQL-OK: NIL
(WITH-C-VAR (X 'CHAR -112) (LET ((REF (C-SELF (C-VAR-ADDRESS X)))) (LIST (TYPEP REF 'FOREIGN-VARIABLE) (FOREIGN-VALUE REF))))
EQUAL-OK: (T -112)
(DEF-C-STRUCT TRIV (I INT))
EQL-OK: TRIV
(DEF-CALL-OUT TRIGGER (:ARGUMENTS (STRUCT_ARRAY (C-ARRAY-PTR (C-PTR TRIV)))) (:NAME "ffi_identity") (:LANGUAGE :STDC) (:RETURN-TYPE (C-ARRAY-PTR (C-PTR TRIV))))
EQL-OK: TRIGGER
(TRIGGER (VECTOR (MAKE-TRIV :I 0) (MAKE-TRIV :I 1) (MAKE-TRIV :I 3) (MAKE-TRIV :I 4) (MAKE-TRIV :I 5) (MAKE-TRIV :I 6)))
EQUALP-OK: #(#S(TRIV :I 0) #S(TRIV :I 1) #S(TRIV :I 3) #S(TRIV :I 4) #S(TRIV :I 5) #S(TRIV :I 6))
(WITH-FOREIGN-OBJECT (X '(C-ARRAY-PTR INT) (VECTOR -4 6 7)) (FOREIGN-VALUE X))
EQUALP-OK: #(-4 6 7)
(LET ((V (ALLOCATE-DEEP 'TRIV (MAKE-TRIV :I 42)))) (PROG1 (LIST (TYPEOF (FOREIGN-VALUE V)) (SLOT (FOREIGN-VALUE V) 'I)) (FOREIGN-FREE V)))
EQUAL-OK: ((C-STRUCT TRIV (I INT)) 42)
(DEF-CALL-OUT C-SELF (:NAME "ffi_identity") (:ARGUMENTS (OBJ C-POINTER)) (:RETURN-TYPE (C-POINTER TRIV)) (:LANGUAGE :STDC))
EQL-OK: C-SELF
(WITH-C-VAR (V 'TRIV (MAKE-TRIV :I 8476272)) (WITH-C-PLACE (W (C-SELF (C-VAR-OBJECT V))) (SETF (SLOT V 'I) -74590302) (LIST (TYPEOF W) (SLOT W 'I))))
EQUAL-OK: ((C-STRUCT TRIV (I INT)) -74590302)
(LIST (DEF-CALL-OUT C-SELF (:NAME "ffi_identity") (:ARGUMENTS (OBJ (C-POINTER TRIV))) (:RETURN-TYPE C-POINTER) (:LANGUAGE :STDC)) (C-SELF NIL))
EQUAL-OK: (C-SELF NIL)
(TYPE-OF (SETQ ORIG-ENCODING *FOREIGN-ENCODING*))
EQL-OK: ENCODING
(TYPEP (SETF *FOREIGN-ENCODING* (MAKE-ENCODING :CHARSET 'CHARSET:ISO-8859-1)) 'ENCODING)
EQL-OK: T
(TYPEP (SETF *FOREIGN-ENCODING* (MAKE-ENCODING :CHARSET 'CHARSET:UTF-8)) 'ENCODING)
EQL-OK: T
(TYPEP (FFI::FIND-FOREIGN-VARIABLE "ffi_user_pointer" (PARSE-C-TYPE 'C-POINTER) NIL NIL NIL) 'FOREIGN-VARIABLE)
EQL-OK: T
(FFI::FIND-FOREIGN-VARIABLE "ffi_user_pointer" (PARSE-C-TYPE 'UINT) NIL NIL NIL)
[SIMPLE-ERROR]: FFI::FIND-FOREIGN-VARIABLE: type specifications for foreign variable #<FOREIGN-VARIABLE "ffi_user_pointer" #x006058B8> conflict: C-POINTER and UINT
EQL-OK: ERROR
(TYPEP (FFI::FIND-FOREIGN-VARIABLE "ffi_user_pointer" (PARSE-C-TYPE '(C-ARRAY-PTR SINT8)) NIL NIL NIL) 'FOREIGN-VARIABLE)
EQL-OK: T
(DEF-C-VAR USER-POINTER (:TYPE C-POINTER) (:NAME "ffi_user_pointer"))
EQL-OK: USER-POINTER
(DESCRIBE (GET 'USER-POINTER 'FOREIGN-VARIABLE))
#<FOREIGN-VARIABLE "ffi_user_pointer" #x006058B8> is a foreign variable of foreign type C-POINTER.
EQL-OK: NIL
(PROGN (DEF-CALL-OUT C-SELF (:NAME "ffi_identity") (:ARGUMENTS (OBJ (C-PTR-NULL (C-ARRAY CHARACTER 3)))) (:RETURN-TYPE (C-PTR (C-ARRAY UINT8 3))) (:LANGUAGE :STDC)) (C-SELF "@A0"))
EQUALP-OK: #(64 65 48)
(PROGN (DEF-CALL-OUT C-SELF (:NAME "ffi_identity") (:ARGUMENTS (OBJ (C-PTR-NULL (C-ARRAY SINT8 4)))) (:RETURN-TYPE (C-ARRAY-PTR UINT8)) (:LANGUAGE :STDC)) (LIST (C-SELF #(127 64 63 0)) (C-SELF NIL)))
EQUALP-OK: (#(127 64 63) NIL)
(PROGN (DEF-CALL-OUT C-SELF (:NAME "ffi_identity") (:ARGUMENTS (OBJ (C-PTR-NULL (C-ARRAY UINT8 5)))) (:RETURN-TYPE (C-ARRAY-PTR SINT8)) (:LANGUAGE :STDC)) (C-SELF (MAKE-ARRAY 5 :ELEMENT-TYPE '(UNSIGNED-BYTE 8) :INITIAL-CONTENTS '(127 63 64 0 6))))
EQUALP-OK: #(127 63 64)
(PROGN (DEF-CALL-OUT C-SELF (:NAME "ffi_identity") (:ARGUMENTS (OBJ C-STRING)) (:RETURN-TYPE (C-ARRAY-PTR UINT8)) (:LANGUAGE :STDC)) (C-SELF (COERCE '(#\@ #\A #\Newline #\2) 'STRING)))
EQUALP-OK: #(64 65 10 50)
(PROGN (DEF-CALL-OUT C-SELF (:NAME "ffi_identity") (:ARGUMENTS (OBJ (C-PTR (C-ARRAY-MAX UINT16 4)) :IN-OUT)) (:RETURN-TYPE NIL) (:LANGUAGE :STDC)) (C-SELF (MAKE-ARRAY 4 :ELEMENT-TYPE '(UNSIGNED-BYTE 16) :INITIAL-CONTENTS '(128 255 0 127))))
EQUALP-OK: #(128 255)
(PROGN (DEF-CALL-OUT C-SELF (:NAME "ffi_identity") (:ARGUMENTS (A1 (C-PTR (C-ARRAY-MAX UINT32 4))) (A2 (C-PTR (C-ARRAY-MAX UINT8 4))) (A3 (C-PTR (C-ARRAY-MAX UINT8 4))) (A4 (C-PTR (C-ARRAY UINT32 2)))) (:RETURN-TYPE (C-PTR (C-ARRAY-MAX SINT32 4))) (:LANGUAGE :STDC)) (C-SELF (MAKE-ARRAY 3 :ELEMENT-TYPE '(UNSIGNED-BYTE 32) :INITIAL-CONTENTS '(128 0 127)) (VECTOR 1 2 3) (MAKE-ARRAY 2 :ELEMENT-TYPE '(UNSIGNED-BYTE 8) :INITIAL-CONTENTS '(241 17)) (MAKE-ARRAY 2 :ELEMENT-TYPE '(UNSIGNED-BYTE 32) :INITIAL-CONTENTS '(1299 192225))))
EQUALP-OK: #(128)
(PROGN (DEF-CALL-OUT C-SELF (:NAME "ffi_identity") (:ARGUMENTS (OBJ (C-PTR (C-ARRAY SINT8 4)) :IN-OUT)) (:RETURN-TYPE NIL) (:LANGUAGE :STDC)) (C-SELF #(-128 -99 0 127)))
EQUALP-OK: #(-128 -99 0 127)
(PROGN (DEF-CALL-OUT C-SELF (:NAME "ffi_identity") (:ARGUMENTS (OBJ (C-PTR (C-ARRAY UINT16 4)) :IN-OUT)) (:RETURN-TYPE NIL) (:LANGUAGE :STDC)) (C-SELF (MAKE-ARRAY 4 :ELEMENT-TYPE '(UNSIGNED-BYTE 16) :INITIAL-CONTENTS '(128 255 0 127))))
EQUALP-OK: #(128 255 0 127)
(PROGN (DEF-CALL-OUT C-SELF (:NAME "ffi_identity") (:ARGUMENTS (FIRST BOOLEAN) (OBJ (C-PTR (C-ARRAY UINT16 4)) :IN-OUT)) (:RETURN-TYPE NIL) (:LANGUAGE :STDC)) (C-SELF T #(1000 255 0 127)))
EQUALP-OK: #(1000 255 0 127)
(PROGN (DEF-CALL-OUT C-SELF (:NAME "ffi_identity") (:ARGUMENTS (OBJ (C-PTR (C-UNION (C1 CHARACTER) (S (C-ARRAY-PTR CHARACTER)))))) (:RETURN-TYPE (C-PTR CHARACTER)) (:LANGUAGE :STDC)) (C-SELF #\w))
EQL-OK: #\w
(PROGN (DEF-CALL-OUT C-SELF (:NAME "ffi_identity") (:ARGUMENTS (FIRST BOOLEAN) (OBJ (C-PTR (C-UNION (C CHARACTER) (B BOOLEAN) (P C-POINTER))) :IN-OUT)) (:RETURN-TYPE NIL) (:LANGUAGE :STDC)) (C-SELF T #\j))
EQL-OK: #\j
(PROGN (DEF-CALL-OUT C-SELF (:NAME "ffi_identity") (:ARGUMENTS (FIRST C-STRING)) (:RETURN-TYPE (C-PTR (C-ARRAY CHARACTER 4))) (:LANGUAGE :STDC)) (C-SELF "zrewp"))
EQUAL-OK: "zrew"
(PROGN (DEF-CALL-OUT C-SELF (:NAME "ffi_identity") (:ARGUMENTS (FIRST (C-ARRAY-PTR UINT8))) (:RETURN-TYPE (C-PTR (C-ARRAY CHARACTER 4))) (:LANGUAGE :STDC)) (C-SELF #(64 65 66 67 68)))
EQUAL-OK: "@ABC"
(PROGN (DEF-CALL-OUT C-SELF (:NAME "ffi_identity") (:ARGUMENTS (FIRST (C-ARRAY-PTR UINT8))) (:RETURN-TYPE C-STRING) (:LANGUAGE :STDC)) (C-SELF #(230 151 165 230 156 172 232 170 158)))
EQUAL-OK: "???"
(PROGN (DEF-CALL-OUT C-SELF (:NAME "ffi_identity") (:ARGUMENTS (FIRST (C-ARRAY-PTR UINT8))) (:RETURN-TYPE (C-PTR (C-ARRAY CHARACTER 9))) (:LANGUAGE :STDC)) (C-SELF #(230 151 165 230 156 172 232 170 158)))
EQUAL-OK: "???"
(PROGN (DEF-CALL-OUT C-SELF (:NAME "ffi_identity") (:ARGUMENTS (FIRST (C-ARRAY-PTR UINT8))) (:RETURN-TYPE (C-PTR (C-ARRAY-MAX CHARACTER 20))) (:LANGUAGE :STDC)) (C-SELF #(230 151 165 230 156 172 232 170 158 0 158 170 232 172 156 230 165 151 230 10)))
EQUAL-OK: "???"
(PROGN (DEF-CALL-OUT C-SELF (:NAME "ffi_identity") (:ARGUMENTS (FIRST (C-ARRAY-PTR UINT8))) (:RETURN-TYPE (C-ARRAY-PTR CHARACTER)) (:LANGUAGE :STDC)) (C-SELF #(230 151 165 230 156 172 232 170 158 0 158 170 232 172 156 230 165 151 230 10)))
EQUAL-OK: "???"
(PROGN (DEF-CALL-OUT C-SELF (:NAME "ffi_identity") (:ARGUMENTS (FIRST UINT8)) (:RETURN-TYPE CHARACTER) (:LANGUAGE :STDC)) (C-SELF 97))
EQL-OK: #\a
(PROGN (DEF-CALL-OUT C-SELF (:NAME "ffi_identity") (:ARGUMENTS (FIRST UINT8)) (:RETURN-TYPE CHARACTER) (:LANGUAGE :STDC)) (C-SELF 158))
[SIMPLE-CHARSET-TYPE-ERROR]: FFI::FOREIGN-CALL-OUT: Invalid byte #x9E in CHARSET:ASCII conversion
EQL-OK: ERROR
(PROGN (DEF-CALL-OUT C-SELF (:NAME "ffi_identity") (:ARGUMENTS (FIRST (C-ARRAY-PTR UINT8))) (:RETURN-TYPE (C-PTR (C-ARRAY CHARACTER (3 3)))) (:LANGUAGE :STDC)) (C-SELF #(97 98 99 100 101 102 103 104 105)))
EQUALP-OK: #2A((#\a #\b #\c) (#\d #\e #\f) (#\g #\h #\i))
(PROGN (DEF-CALL-OUT C-SELF (:NAME "ffi_identity") (:ARGUMENTS (FIRST (C-ARRAY-PTR UINT8))) (:RETURN-TYPE (C-PTR (C-ARRAY CHARACTER (3 3)))) (:LANGUAGE :STDC)) (ARRAY-DIMENSIONS (C-SELF #(230 151 165 230 156 172 232 170 158))))
[SIMPLE-CHARSET-TYPE-ERROR]: FFI::FOREIGN-CALL-OUT: Invalid byte #xE6 in CHARSET:ASCII conversion
EQL-OK: ERROR
(PROGN (DEF-CALL-OUT C-SELF (:NAME "ffi_identity") (:ARGUMENTS (FIRST (C-ARRAY-PTR UINT8))) (:RETURN-TYPE (C-PTR CHARACTER)) (:LANGUAGE :STDC)) (C-SELF #(97 98 99 100 101 102 103 104 105)))
EQL-OK: #\a
(PROGN (DEF-CALL-OUT C-SELF (:NAME "ffi_identity") (:ARGUMENTS (FIRST (C-ARRAY-PTR UINT8))) (:RETURN-TYPE (C-PTR CHARACTER)) (:LANGUAGE :STDC)) (C-SELF #(230 151 165 230 156 172 232 170 158)))
[SIMPLE-CHARSET-TYPE-ERROR]: FFI::FOREIGN-CALL-OUT: Invalid byte #xE6 in CHARSET:ASCII conversion
EQL-OK: ERROR
(PROGN (DEF-CALL-OUT C-SELF (:NAME "ffi_identity") (:ARGUMENTS (FIRST (C-ARRAY-PTR UINT8))) (:RETURN-TYPE (C-PTR-NULL CHARACTER)) (:LANGUAGE :STDC)) (C-SELF #(97 98 99 100 101 102 103 104 105)))
EQL-OK: #\a
(PROGN (DEF-CALL-OUT C-SELF (:NAME "ffi_identity") (:ARGUMENTS (FIRST (C-ARRAY-PTR UINT8))) (:RETURN-TYPE (C-PTR-NULL CHARACTER)) (:LANGUAGE :STDC)) (C-SELF #(230 151 165 230 156 172 232 170 158)))
[SIMPLE-CHARSET-TYPE-ERROR]: FFI::FOREIGN-CALL-OUT: Invalid byte #xE6 in CHARSET:ASCII conversion
EQL-OK: ERROR
(PROGN (DEF-CALL-OUT C-SELF (:NAME "ffi_identity") (:ARGUMENTS (FIRST C-STRING)) (:RETURN-TYPE (C-ARRAY-PTR UINT8)) (:LANGUAGE :STDC)) (C-SELF "???"))
EQUALP-OK: #(230 151 165 230 156 172 232 170 158)
(PROGN (DEF-CALL-OUT C-SELF (:NAME "ffi_identity") (:ARGUMENTS (FIRST (C-PTR (C-ARRAY CHARACTER 9)))) (:RETURN-TYPE (C-PTR (C-ARRAY UINT8 9))) (:LANGUAGE :STDC)) (C-SELF "???"))
EQUALP-OK: #(230 151 165 230 156 172 232 170 158)
(PROGN (DEF-CALL-OUT C-SELF (:NAME "ffi_identity") (:ARGUMENTS (FIRST (C-PTR (C-ARRAY-MAX CHARACTER 20)))) (:RETURN-TYPE (C-ARRAY-PTR UINT8)) (:LANGUAGE :STDC)) (C-SELF "???"))
EQUALP-OK: #(230 151 165 230 156 172 232 170 158)
(PROGN (DEF-CALL-OUT C-SELF (:NAME "ffi_identity") (:ARGUMENTS (FIRST (C-PTR (C-ARRAY-MAX CHARACTER 7)))) (:RETURN-TYPE (C-ARRAY-PTR UINT8)) (:LANGUAGE :STDC)) (C-SELF "???"))
EQUALP-OK: #(230 151 165 230 156 172)
(PROGN (DEF-CALL-OUT C-SELF (:NAME "ffi_identity") (:ARGUMENTS (FIRST (C-ARRAY-PTR CHARACTER))) (:RETURN-TYPE (C-ARRAY-PTR UINT8)) (:LANGUAGE :STDC)) (C-SELF "???"))
EQUALP-OK: #(230 151 165 230 156 172 232 170 158)
(PROGN (DEF-CALL-OUT C-SELF (:NAME "ffi_identity") (:ARGUMENTS (FIRST CHARACTER)) (:RETURN-TYPE UINT8) (:LANGUAGE :STDC)) (C-SELF #\a))
EQL-OK: 97
(PROGN (DEF-CALL-OUT C-SELF (:NAME "ffi_identity") (:ARGUMENTS (FIRST CHARACTER)) (:RETURN-TYPE UINT8) (:LANGUAGE :STDC)) (C-SELF #\LATIN_SMALL_LETTER_O_WITH_STROKE))
[SIMPLE-CHARSET-TYPE-ERROR]: FFI::FOREIGN-CALL-OUT: Character #\u00F8 cannot be represented in the character set CHARSET:ASCII
EQL-OK: ERROR
(PROGN (DEF-CALL-OUT C-SELF (:NAME "ffi_identity") (:ARGUMENTS (FIRST (C-PTR (C-ARRAY CHARACTER (3 3))))) (:RETURN-TYPE (C-PTR (C-ARRAY UINT8 9))) (:LANGUAGE :STDC)) (C-SELF #2A("abc" "def" "ghi")))
EQUALP-OK: #(97 98 99 100 101 102 103 104 105)
(PROGN (DEF-CALL-OUT C-SELF (:NAME "ffi_identity") (:ARGUMENTS (FIRST (C-PTR (C-ARRAY CHARACTER (3 3))))) (:RETURN-TYPE (C-PTR (C-ARRAY UINT8 9))) (:LANGUAGE :STDC)) (C-SELF #2A("???" "T?r" "k?e")))
[SIMPLE-CHARSET-TYPE-ERROR]: FFI::FOREIGN-CALL-OUT: Character #\u65E5 cannot be represented in the character set CHARSET:ASCII
EQL-OK: ERROR
(PROGN (DEF-CALL-OUT C-SELF (:NAME "ffi_identity") (:ARGUMENTS (FIRST (C-PTR (C-ARRAY CHARACTER (3 3))))) (:RETURN-TYPE (C-PTR (C-ARRAY UINT8 9))) (:LANGUAGE :STDC)) (C-SELF #2A("?" "?" "?")))
[SIMPLE-ERROR]: FFI::FOREIGN-CALL-OUT: #2A("?" "?" "?") cannot be converted to the foreign type #(C-ARRAY CHARACTER 3 3)
EQL-OK: ERROR
(PROGN (DEF-CALL-OUT C-SELF (:NAME "ffi_identity") (:ARGUMENTS (FIRST (C-PTR CHARACTER))) (:RETURN-TYPE (C-PTR (C-ARRAY UINT8 1))) (:LANGUAGE :STDC)) (C-SELF #\a))
EQUALP-OK: #(97)
(PROGN (DEF-CALL-OUT C-SELF (:NAME "ffi_identity") (:ARGUMENTS (FIRST (C-PTR CHARACTER))) (:RETURN-TYPE (C-PTR (C-ARRAY UINT8 1))) (:LANGUAGE :STDC)) (C-SELF #\LATIN_SMALL_LETTER_O_WITH_STROKE))
[SIMPLE-CHARSET-TYPE-ERROR]: FFI::FOREIGN-CALL-OUT: Character #\u00F8 cannot be represented in the character set CHARSET:ASCII
EQL-OK: ERROR
(PROGN (DEF-CALL-OUT C-SELF (:NAME "ffi_identity") (:ARGUMENTS (FIRST (C-PTR-NULL CHARACTER))) (:RETURN-TYPE (C-PTR (C-ARRAY UINT8 1))) (:LANGUAGE :STDC)) (C-SELF #\a))
EQUALP-OK: #(97)
(PROGN (DEF-CALL-OUT C-SELF (:NAME "ffi_identity") (:ARGUMENTS (FIRST (C-PTR-NULL CHARACTER))) (:RETURN-TYPE (C-PTR (C-ARRAY UINT8 1))) (:LANGUAGE :STDC)) (C-SELF #\LATIN_SMALL_LETTER_O_WITH_STROKE))
[SIMPLE-CHARSET-TYPE-ERROR]: FFI::FOREIGN-CALL-OUT: Character #\u00F8 cannot be represented in the character set CHARSET:ASCII
EQL-OK: ERROR
(PROGN (DEF-CALL-OUT C-SELF (:NAME "ffi_identity") (:ARGUMENTS (FIRST C-STRING) (OBJ (C-PTR (C-ARRAY SINT16 4)) :IN-OUT)) (:RETURN-TYPE NIL) (:LANGUAGE :STDC)) (C-SELF "abc" #(-32768 -255 0 -256)))
EQUALP-OK: #(-32768 -255 0 -256)
(PROGN (DEF-CALL-OUT C-SELF (:NAME "ffi_identity") (:ARGUMENTS (FIRST C-STRING) (OBJ (C-PTR (C-ARRAY UINT32 4)) :IN-OUT)) (:RETURN-TYPE NIL) (:LANGUAGE :STDC)) (C-SELF NIL #(4294967295 16777215 0 127)))
EQUALP-OK: #(4294967295 16777215 0 127)
(PROGN (DEF-CALL-OUT C-SELF (:NAME "ffi_identity") (:ARGUMENTS (OBJ (C-PTR (C-ARRAY-MAX SINT16 17)) :OUT)) (:RETURN-TYPE NIL) (:LANGUAGE :STDC)) (C-SELF))
EQUALP-OK: #()
(WITH-FOREIGN-OBJECT (FV 'LONG -12345678) (TYPEP FV 'FOREIGN-VARIABLE))
EQL-OK: T
(PROGN (DEFPARAMETER *X* 0) (DEFUN CALLBACK (X) (SETF *X* (THE (UNSIGNED-BYTE 16) X)) (THE (UNSIGNED-BYTE 16) (1+ (* 2 X)))) *X*)
EQL-OK: 0
(DEF-C-TYPE IDFUN (C-FUNCTION (:ARGUMENTS (X UINT)) (:RETURN-TYPE UINT) (:LANGUAGE :STDC)))
EQL-OK: IDFUN
(TYPE-OF (SETQ CALLBACKF (WITH-C-VAR (X 'IDFUN #'CALLBACK) X)))
EQL-OK: FOREIGN-FUNCTION
make[1]: *** [tests] Segmentation fault
make[1]: Leaving directory `/home/christoph/clisp/src/tests'
make: *** [check-tests] Error 2
-------------- next part --------------
--
9FED 5C6C E206 B70A 5857 70CA 9655 22B9 D49A E731
Debian Developer | Lisp Hacker | CaCert Assurer
A. Because it breaks the logical sequence of discussion
Q. Why is top posting bad?
-------------- next part --------------
A non-text attachment was scrubbed...
Name: not available
Type: application/pgp-signature
Size: 835 bytes
Desc: not available
URL: <http://lists.alioth.debian.org/pipermail/pkg-common-lisp-devel/attachments/20110403/d764ecd7/attachment-0001.pgp>
More information about the pkg-common-lisp-devel
mailing list