X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=tests%2Fwalk.impure.lisp;h=2fefd8fc9c6656723a2d7ddcdece5e2b818650b0;hb=1cba0af01f5107ab384d0d8b94b1f6330b3d0ef4;hp=6ce7968e2bc6a2f20210b7a4fa0d0a78ac7369c6;hpb=853b48ca4085b8ad9831edb9b06935a0977c0800;p=sbcl.git diff --git a/tests/walk.impure.lisp b/tests/walk.impure.lisp index 6ce7968..2fefd8f 100644 --- a/tests/walk.impure.lisp +++ b/tests/walk.impure.lisp @@ -25,7 +25,25 @@ (in-package :sb-walker) -;;;; stuff based on the tests at the end of the original CMU CL +;;;; utilities to support tests + +;;; string equality modulo deletion of TABs and SPACEs (as a crude way +;;; of washing away irrelevant differences in indentation) +(defun string-modulo-tabspace (s) + (remove-if (lambda (c) + (or (char= c #\space) + (char= c #\tab) + (char= c #\newline))) + s)) +(defun string=-modulo-tabspace (x y) + (if (string= (string-modulo-tabspace x) + (string-modulo-tabspace y)) + t + (progn + (print (list :want y :got x)) + nil))) + +;;;; tests based on stuff at the end of the original CMU CL ;;;; pcl/walk.lisp file (defmacro take-it-out-for-a-test-walk (form) @@ -33,26 +51,26 @@ (defun take-it-out-for-a-test-walk-1 (form) (let ((copy-of-form (copy-tree form)) - (result (walk-form form nil - #'(lambda (x y env) - (format t "~&Form: ~S ~3T Context: ~A" x y) - (when (symbolp x) - (let ((lexical (variable-lexical-p x env)) - (special (variable-special-p x env))) - (when lexical - (format t ";~3T") - (format t "lexically bound")) - (when special - (format t ";~3T") - (format t "declared special")) - (when (boundp x) - (format t ";~3T") - (format t "bound: ~S " (eval x))))) - x)))) + (result (walk-form form nil + (lambda (x y env) + (format t "~&Form: ~S ~3T Context: ~A" x y) + (when (symbolp x) + (let ((lexical (var-lexical-p x env)) + (special (var-special-p x env))) + (when lexical + (format t ";~3T") + (format t "lexically bound")) + (when special + (format t ";~3T") + (format t "declared special")) + (when (boundp x) + (format t ";~3T") + (format t "bound: ~S " (eval x))))) + x)))) (cond ((not (equal result copy-of-form)) - (format t "~%Warning: Result not EQUAL to copy of start.")) - ((not (eq result form)) - (format t "~%Warning: Result not EQ to copy of start."))) + (format t "~%Warning: Result not EQUAL to copy of start.")) + ((not (eq result form)) + (format t "~%Warning: Result not EQ to copy of start."))) (pprint result) nil)) @@ -64,7 +82,7 @@ (declare (ignore ignore)) ''global-bar) -(assert (equal +(assert (string=-modulo-tabspace (with-output-to-string (*standard-output*) (take-it-out-for-a-test-walk (list arg1 arg2 arg3))) "Form: (LIST ARG1 ARG2 ARG3) Context: EVAL @@ -73,7 +91,7 @@ Form: ARG2 Context: EVAL Form: ARG3 Context: EVAL (LIST ARG1 ARG2 ARG3)")) -(assert (equal +(assert (string=-modulo-tabspace (with-output-to-string (*standard-output*) (take-it-out-for-a-test-walk (list (cons 1 2) (list 3 4 5)))) "Form: (LIST (CONS 1 2) (LIST 3 4 5)) Context: EVAL @@ -86,7 +104,7 @@ Form: 4 Context: EVAL Form: 5 Context: EVAL (LIST (CONS 1 2) (LIST 3 4 5))")) -(assert (equal +(assert (string=-modulo-tabspace (with-output-to-string (*standard-output*) (take-it-out-for-a-test-walk (progn (foo) (bar 1)))) "Form: (PROGN (FOO) (BAR 1)) Context: EVAL @@ -96,7 +114,7 @@ Form: (BAR 1) Context: EVAL Form: 'GLOBAL-BAR Context: EVAL (PROGN (FOO) (BAR 1))")) -(assert (equal +(assert (string=-modulo-tabspace (with-output-to-string (*standard-output*) (take-it-out-for-a-test-walk (block block-name a b c))) "Form: (BLOCK BLOCK-NAME A B C) Context: EVAL @@ -105,7 +123,7 @@ Form: B Context: EVAL Form: C Context: EVAL (BLOCK BLOCK-NAME A B C)")) -(assert (equal +(assert (string=-modulo-tabspace (with-output-to-string (*standard-output*) (take-it-out-for-a-test-walk (block block-name (list a) b c))) "Form: (BLOCK BLOCK-NAME (LIST A) B C) Context: EVAL @@ -115,7 +133,7 @@ Form: B Context: EVAL Form: C Context: EVAL (BLOCK BLOCK-NAME (LIST A) B C)")) -(assert (equal +(assert (string=-modulo-tabspace (with-output-to-string (*standard-output*) (take-it-out-for-a-test-walk (catch catch-tag (list a) b c))) "Form: (CATCH CATCH-TAG (LIST A) B C) Context: EVAL @@ -129,7 +147,7 @@ Form: C Context: EVAL ;;; This is a fairly simple MACROLET case. While walking the body of the ;;; macro, X should be lexically bound. In the body of the MACROLET form ;;; itself, X should not be bound. -(assert (equal +(assert (string=-modulo-tabspace (with-output-to-string (*standard-output*) (take-it-out-for-a-test-walk (macrolet ((foo (x) (list x) ''inner)) @@ -153,11 +171,24 @@ Form: 'INNER Context: EVAL (FOO 1))")) -;;; A slightly more complex MACROLET case. In the body of the macro X -;;; should not be lexically bound. In the body of the macrolet form itself -;;; X should be bound. Note that THIS CASE WILL CAUSE AN ERROR when it -;;; tries to macroexpand the call to FOO. - +;;; The original PCL documentation for this test said +;;; A slightly more complex MACROLET case. In the body of the macro +;;; X should not be lexically bound. In the body of the macrolet +;;; form itself X should be bound. Note that THIS CASE WILL CAUSE AN +;;; ERROR when it tries to macroexpand the call to FOO. +;;; +;;; This test is commented out in SBCL because ANSI says, in the +;;; definition of the special operator MACROLET, +;;; The macro-expansion functions defined by MACROLET are defined +;;; in the lexical environment in which the MACROLET form appears. +;;; Declarations and MACROLET and SYMBOL-MACROLET definitions affect +;;; the local macro definitions in a MACROLET, but the consequences +;;; are undefined if the local macro definitions reference any +;;; local variable or function bindings that are visible in that +;;; lexical environment. +;;; Since the behavior is undefined, anything we do conforms.:-| +;;; This is of course less than ideal; see bug 124. +#+nil (multiple-value-bind (res cond) (ignore-errors (take-it-out-for-a-test-walk @@ -167,7 +198,7 @@ Form: 'INNER Context: EVAL (foo))))) (assert (and (null res) cond))) -(assert (equal +(assert (string=-modulo-tabspace (with-output-to-string (*standard-output*) (take-it-out-for-a-test-walk (flet ((foo (x) (list x y)) @@ -192,7 +223,7 @@ Form: 1 Context: EVAL (LIST X Y))) (FOO 1))")) -(assert (equal +(assert (string=-modulo-tabspace (with-output-to-string (*standard-output*) (take-it-out-for-a-test-walk (let ((y 2)) @@ -226,7 +257,7 @@ Form: 1 Context: EVAL (LIST X Y))) (FOO 1)))")) -(assert (equal +(assert (string=-modulo-tabspace (with-output-to-string (*standard-output*) (take-it-out-for-a-test-walk (labels ((foo (x) (bar x)) @@ -249,7 +280,7 @@ Form: 1 Context: EVAL (FOO X))) (FOO 1))")) -(assert (equal +(assert (string=-modulo-tabspace (with-output-to-string (*standard-output*) (take-it-out-for-a-test-walk (flet ((foo (x) (foo x))) @@ -265,7 +296,7 @@ Form: 1 Context: EVAL (FOO X))) (FOO 1))")) -(assert (equal +(assert (string=-modulo-tabspace (with-output-to-string (*standard-output*) (take-it-out-for-a-test-walk (flet ((foo (x) (foo x))) @@ -291,7 +322,7 @@ Form: 1 Context: EVAL (FOO X))) (BAR 1)))")) -(assert (equal +(assert (string=-modulo-tabspace (with-output-to-string (*standard-output*) (take-it-out-for-a-test-walk (prog () (declare (special a b))))) "Form: (PROG () (DECLARE (SPECIAL A B))) Context: EVAL @@ -305,7 +336,7 @@ Form: (LET () Form: (TAGBODY) Context: EVAL (PROG () (DECLARE (SPECIAL A B)))")) -(assert (equal +(assert (string=-modulo-tabspace (with-output-to-string (*standard-output*) (take-it-out-for-a-test-walk (let (a b c) (declare (special a b)) @@ -317,7 +348,7 @@ Form: (TAGBODY) Context: EVAL C) Context: EVAL Form: (FOO A) Context: EVAL Form: 'GLOBAL-FOO Context: EVAL -Form: B Context: EVAL; lexically bound +Form: B Context: EVAL; lexically bound; declared special Form: C Context: EVAL; lexically bound (LET (A B C) (DECLARE (SPECIAL A B)) @@ -325,7 +356,7 @@ Form: C Context: EVAL; lexically bound B C)")) -(assert (equal +(assert (string=-modulo-tabspace (with-output-to-string (*standard-output*) (take-it-out-for-a-test-walk (let (a b c) (declare (special a) (special b)) @@ -345,7 +376,7 @@ Form: C Context: EVAL; lexically bound B C)")) -(assert (equal +(assert (string=-modulo-tabspace (with-output-to-string (*standard-output*) (take-it-out-for-a-test-walk (let (a b c) (declare (special a)) @@ -368,7 +399,7 @@ Form: C Context: EVAL; lexically bound B C)")) -(assert (equal +(assert (string=-modulo-tabspace (with-output-to-string (*standard-output*) (take-it-out-for-a-test-walk (let (a b c) (declare (special a)) @@ -398,8 +429,8 @@ Form: C Context: EVAL; lexically bound (FOO A) B C))")) - -(assert (equal + +(assert (string=-modulo-tabspace (with-output-to-string (*standard-output*) (take-it-out-for-a-test-walk (eval-when () a @@ -410,7 +441,7 @@ Form: (FOO A) Context: EVAL Form: 'GLOBAL-FOO Context: EVAL (EVAL-WHEN NIL A (FOO A))")) -(assert (equal +(assert (string=-modulo-tabspace (with-output-to-string (*standard-output*) (take-it-out-for-a-test-walk (eval-when (:execute :compile-toplevel :load-toplevel) @@ -422,7 +453,7 @@ Form: (FOO A) Context: EVAL Form: 'GLOBAL-FOO Context: EVAL (EVAL-WHEN (:EXECUTE :COMPILE-TOPLEVEL :LOAD-TOPLEVEL) A (FOO A))")) -(assert (equal +(assert (string=-modulo-tabspace (with-output-to-string (*standard-output*) (take-it-out-for-a-test-walk (multiple-value-bind (a b) (foo a b) (list a b)))) @@ -434,7 +465,7 @@ Form: A Context: EVAL; lexically bound Form: B Context: EVAL; lexically bound (MULTIPLE-VALUE-BIND (A B) (FOO A B) (LIST A B))")) -(assert (equal +(assert (string=-modulo-tabspace (with-output-to-string (*standard-output*) (take-it-out-for-a-test-walk (multiple-value-bind (a b) (foo a b) @@ -444,18 +475,18 @@ Form: B Context: EVAL; lexically bound Form: (FOO A B) Context: EVAL Form: 'GLOBAL-FOO Context: EVAL Form: (LIST A B) Context: EVAL -Form: A Context: EVAL; lexically bound +Form: A Context: EVAL; lexically bound; declared special Form: B Context: EVAL; lexically bound (MULTIPLE-VALUE-BIND (A B) (FOO A B) (DECLARE (SPECIAL A)) (LIST A B))")) -(assert (equal +(assert (string=-modulo-tabspace (with-output-to-string (*standard-output*) (take-it-out-for-a-test-walk (progn (function foo)))) "Form: (PROGN #'FOO) Context: EVAL Form: #'FOO Context: EVAL (PROGN #'FOO)")) -(assert (equal +(assert (string=-modulo-tabspace (with-output-to-string (*standard-output*) (take-it-out-for-a-test-walk (progn a b (go a)))) "Form: (PROGN A B (GO A)) Context: EVAL @@ -464,7 +495,7 @@ Form: B Context: EVAL Form: (GO A) Context: EVAL (PROGN A B (GO A))")) -(assert (equal +(assert (string=-modulo-tabspace (with-output-to-string (*standard-output*) (take-it-out-for-a-test-walk (if a b c))) "Form: (IF A B C) Context: EVAL @@ -473,16 +504,16 @@ Form: B Context: EVAL Form: C Context: EVAL (IF A B C)")) -(assert (equal +(assert (string=-modulo-tabspace (with-output-to-string (*standard-output*) (take-it-out-for-a-test-walk (if a b))) "Form: (IF A B) Context: EVAL Form: A Context: EVAL Form: B Context: EVAL -Form: NIL Context: EVAL; bound: NIL +Form: NIL Context: EVAL; bound: NIL (IF A B)")) -(assert (equal +(assert (string=-modulo-tabspace (with-output-to-string (*standard-output*) (take-it-out-for-a-test-walk ((lambda (a b) (list a b)) 1 2))) "Form: ((LAMBDA (A B) (LIST A B)) 1 2) Context: EVAL @@ -494,7 +525,7 @@ Form: 1 Context: EVAL Form: 2 Context: EVAL ((LAMBDA (A B) (LIST A B)) 1 2)")) -(assert (equal +(assert (string=-modulo-tabspace (with-output-to-string (*standard-output*) (take-it-out-for-a-test-walk ((lambda (a b) (declare (special a)) @@ -509,7 +540,7 @@ Form: 1 Context: EVAL Form: 2 Context: EVAL ((LAMBDA (A B) (DECLARE (SPECIAL A)) (LIST A B)) 1 2)")) -(assert (equal +(assert (string=-modulo-tabspace (with-output-to-string (*standard-output*) (take-it-out-for-a-test-walk (let ((a a) (b a) (c b)) (list a b c)))) @@ -525,7 +556,7 @@ Form: C Context: EVAL; lexically bound (LET ((A A) (B A) (C B)) (LIST A B C))")) -(assert (equal +(assert (string=-modulo-tabspace (with-output-to-string (*standard-output*) (take-it-out-for-a-test-walk (let* ((a a) (b a) (c b)) (list a b c)))) "Form: (LET* ((A A) (B A) (C B)) @@ -540,7 +571,7 @@ Form: C Context: EVAL; lexically bound (LET* ((A A) (B A) (C B)) (LIST A B C))")) -(assert (equal +(assert (string=-modulo-tabspace (with-output-to-string (*standard-output*) (take-it-out-for-a-test-walk (let ((a a) (b a) (c b)) (declare (special a b)) @@ -553,32 +584,36 @@ Form: A Context: EVAL Form: B Context: EVAL Form: (LIST A B C) Context: EVAL Form: A Context: EVAL; lexically bound; declared special -Form: B Context: EVAL; lexically bound +Form: B Context: EVAL; lexically bound; declared special Form: C Context: EVAL; lexically bound (LET ((A A) (B A) (C B)) (DECLARE (SPECIAL A B)) (LIST A B C))")) -(assert (equal +;;;; Bug in LET* walking! +(test-util:with-test (:name (:walk-let* :hairy-specials) + :fails-on :sbcl) + (assert + (string=-modulo-tabspace (with-output-to-string (*standard-output*) (take-it-out-for-a-test-walk (let* ((a a) (b a) (c b)) (declare (special a b)) (list a b c)))) "Form: (LET* ((A A) (B A) (C B)) - (DECLARE (SPECIAL A B)) - (LIST A B C)) Context: EVAL -Form: A Context: EVAL -Form: A Context: EVAL; lexically bound -Form: B Context: EVAL; lexically bound -Form: (LIST A B C) Context: EVAL -Form: A Context: EVAL; lexically bound; declared special -Form: B Context: EVAL; lexically bound -Form: C Context: EVAL; lexically bound -(LET* ((A A) (B A) (C B)) - (DECLARE (SPECIAL A B)) - (LIST A B C))")) - -(assert (equal + (DECLARE (SPECIAL A B)) + (LIST A B C)) Context: EVAL + Form: A Context: EVAL + Form: A Context: EVAL; lexically bound; declared special + Form: B Context: EVAL; lexically bound; declared special + Form: (LIST A B C) Context: EVAL + Form: A Context: EVAL; lexically bound; declared special + Form: B Context: EVAL; lexically bound; declared special + Form: C Context: EVAL; lexically bound + (LET* ((A A) (B A) (C B)) + (DECLARE (SPECIAL A B)) + (LIST A B C))"))) + +(assert (string=-modulo-tabspace (with-output-to-string (*standard-output*) (take-it-out-for-a-test-walk (let ((a 1) (b 2)) (foo bar) @@ -605,7 +640,7 @@ Form: 'GLOBAL-FOO Context: EVAL (DECLARE (SPECIAL A)) (FOO A B)))")) -(assert (equal +(assert (string=-modulo-tabspace (with-output-to-string (*standard-output*) (take-it-out-for-a-test-walk (multiple-value-call #'foo a b c))) "Form: (MULTIPLE-VALUE-CALL #'FOO A B C) Context: EVAL @@ -615,7 +650,7 @@ Form: B Context: EVAL Form: C Context: EVAL (MULTIPLE-VALUE-CALL #'FOO A B C)")) -(assert (equal +(assert (string=-modulo-tabspace (with-output-to-string (*standard-output*) (take-it-out-for-a-test-walk (multiple-value-prog1 a b c))) "Form: (MULTIPLE-VALUE-PROG1 A B C) Context: EVAL @@ -624,7 +659,7 @@ Form: B Context: EVAL Form: C Context: EVAL (MULTIPLE-VALUE-PROG1 A B C)")) -(assert (equal +(assert (string=-modulo-tabspace (with-output-to-string (*standard-output*) (take-it-out-for-a-test-walk (progn a b c))) "Form: (PROGN A B C) Context: EVAL @@ -633,7 +668,7 @@ Form: B Context: EVAL Form: C Context: EVAL (PROGN A B C)")) -(assert (equal +(assert (string=-modulo-tabspace (with-output-to-string (*standard-output*) (take-it-out-for-a-test-walk (progv vars vals a b c))) "Form: (PROGV VARS VALS A B C) Context: EVAL @@ -644,13 +679,13 @@ Form: B Context: EVAL Form: C Context: EVAL (PROGV VARS VALS A B C)")) -(assert (equal +(assert (string=-modulo-tabspace (with-output-to-string (*standard-output*) (take-it-out-for-a-test-walk (quote a))) "Form: 'A Context: EVAL 'A")) -(assert (equal +(assert (string=-modulo-tabspace (with-output-to-string (*standard-output*) (take-it-out-for-a-test-walk (return-from block-name a b c))) "Form: (RETURN-FROM BLOCK-NAME A B C) Context: EVAL @@ -659,7 +694,7 @@ Form: B Context: EVAL Form: C Context: EVAL (RETURN-FROM BLOCK-NAME A B C)")) -(assert (equal +(assert (string=-modulo-tabspace (with-output-to-string (*standard-output*) (take-it-out-for-a-test-walk (setq a 1))) "Form: (SETQ A 1) Context: EVAL @@ -668,7 +703,7 @@ Form: 1 Context: EVAL (SETQ A 1)")) (makunbound 'a) -(assert (equal +(assert (string=-modulo-tabspace (with-output-to-string (*standard-output*) (take-it-out-for-a-test-walk (setq a (foo 1) b (bar 2) c 3))) "Form: (SETQ A (FOO 1) B (BAR 2) C 3) Context: EVAL @@ -688,7 +723,7 @@ Form: 3 Context: EVAL (makunbound 'b) (makunbound 'c) -(assert (equal +(assert (string=-modulo-tabspace (with-output-to-string (*standard-output*) (take-it-out-for-a-test-walk (tagbody a b c (go a)))) "Form: (TAGBODY A B C (GO A)) Context: EVAL @@ -698,7 +733,7 @@ Form: C Context: QUOTE Form: (GO A) Context: EVAL (TAGBODY A B C (GO A))")) -(assert (equal +(assert (string=-modulo-tabspace (with-output-to-string (*standard-output*) (take-it-out-for-a-test-walk (the foo (foo-form a b c)))) "Form: (THE FOO (FOO-FORM A B C)) Context: EVAL @@ -708,7 +743,7 @@ Form: B Context: EVAL Form: C Context: EVAL (THE FOO (FOO-FORM A B C))")) -(assert (equal +(assert (string=-modulo-tabspace (with-output-to-string (*standard-output*) (take-it-out-for-a-test-walk (throw tag-form a))) "Form: (THROW TAG-FORM A) Context: EVAL @@ -716,7 +751,7 @@ Form: TAG-FORM Context: EVAL Form: A Context: EVAL (THROW TAG-FORM A)")) -(assert (equal +(assert (string=-modulo-tabspace (with-output-to-string (*standard-output*) (take-it-out-for-a-test-walk (unwind-protect (foo a b) d e f))) "Form: (UNWIND-PROTECT (FOO A B) D E F) Context: EVAL @@ -735,7 +770,7 @@ Form: F Context: EVAL (declare (ignore a b)) ''outer) -(assert (equal +(assert (string=-modulo-tabspace (with-output-to-string (*standard-output*) (take-it-out-for-a-test-walk (flet ((flet-1 (a b) () (flet-1 a b) (list a b))) @@ -747,7 +782,7 @@ Form: F Context: EVAL (LIST A B))) (FLET-1 1 2) (FOO 1 2)) Context: EVAL -Form: NIL Context: EVAL; bound: NIL +Form: NIL Context: EVAL; bound: NIL Form: (FLET-1 A B) Context: EVAL Form: 'OUTER Context: EVAL Form: (LIST A B) Context: EVAL @@ -765,7 +800,7 @@ Form: 'GLOBAL-FOO Context: EVAL (FLET-1 1 2) (FOO 1 2))")) -(assert (equal +(assert (string=-modulo-tabspace (with-output-to-string (*standard-output*) (take-it-out-for-a-test-walk (labels ((label-1 (a b) () (label-1 a b)(list a b))) @@ -777,7 +812,7 @@ Form: 'GLOBAL-FOO Context: EVAL (LIST A B))) (LABEL-1 1 2) (FOO 1 2)) Context: EVAL -Form: NIL Context: EVAL; bound: NIL +Form: NIL Context: EVAL; bound: NIL Form: (LABEL-1 A B) Context: EVAL Form: A Context: EVAL; lexically bound Form: B Context: EVAL; lexically bound @@ -796,7 +831,7 @@ Form: 'GLOBAL-FOO Context: EVAL (LABEL-1 1 2) (FOO 1 2))")) -(assert (equal +(assert (string=-modulo-tabspace (with-output-to-string (*standard-output*) (take-it-out-for-a-test-walk (macrolet ((macrolet-1 (a b) (list a b))) (macrolet-1 a b) @@ -818,7 +853,7 @@ Form: 'GLOBAL-FOO Context: EVAL (MACROLET-1 A B) (FOO 1 2))")) -(assert (equal +(assert (string=-modulo-tabspace (with-output-to-string (*standard-output*) (take-it-out-for-a-test-walk (macrolet ((foo (a) `(inner-foo-expanded ,a))) (foo 1)))) @@ -835,7 +870,7 @@ Form: 1 Context: EVAL `(INNER-FOO-EXPANDED ,A))) (FOO 1))")) -(assert (equal +(assert (string=-modulo-tabspace (with-output-to-string (*standard-output*) (take-it-out-for-a-test-walk (progn (bar 1) (macrolet ((bar (a) @@ -863,7 +898,7 @@ Form: 2 Context: EVAL `(INNER-BAR-EXPANDED ,A))) (BAR 2)))")) -(assert (equal +(assert (string=-modulo-tabspace (with-output-to-string (*standard-output*) (take-it-out-for-a-test-walk (progn (bar 1) (macrolet ((bar (s) @@ -897,7 +932,7 @@ Form: 2 Context: EVAL `(INNER-BAR-EXPANDED ,S))) (BAR 2)))")) -(assert (equal +(assert (string=-modulo-tabspace (with-output-to-string (*standard-output*) (take-it-out-for-a-test-walk (cond (a b) ((foo bar) a (foo a))))) @@ -907,29 +942,28 @@ Form: A Context: EVAL Form: (PROGN B) Context: EVAL Form: B Context: EVAL Form: (COND ((FOO BAR) A (FOO A))) Context: EVAL -Form: (IF (FOO BAR) (PROGN A (FOO A)) (COND)) Context: EVAL +Form: (IF (FOO BAR) (PROGN A (FOO A)) NIL) Context: EVAL Form: (FOO BAR) Context: EVAL Form: 'GLOBAL-FOO Context: EVAL Form: (PROGN A (FOO A)) Context: EVAL Form: A Context: EVAL Form: (FOO A) Context: EVAL Form: 'GLOBAL-FOO Context: EVAL -Form: (COND) Context: EVAL -Form: NIL Context: EVAL; bound: NIL +Form: NIL Context: EVAL; bound: NIL (COND (A B) ((FOO BAR) A (FOO A)))")) -(assert (equal +(assert (string=-modulo-tabspace (with-output-to-string (*standard-output*) (let ((the-lexical-variables ())) (walk-form '(let ((a 1) (b 2)) - #'(lambda (x) (list a b x y))) + (lambda (x) (list a b x y))) () - #'(lambda (form context env) - (declare (ignore context)) - (when (and (symbolp form) - (variable-lexical-p form env)) - (push form the-lexical-variables)) - form)) + (lambda (form context env) + (declare (ignore context)) + (when (and (symbolp form) + (var-lexical-p form env)) + (push form the-lexical-variables)) + form)) (or (and (= (length the-lexical-variables) 3) (member 'a the-lexical-variables) (member 'b the-lexical-variables) @@ -937,4 +971,9 @@ Form: NIL Context: EVAL; bound: NIL (error "Walker didn't do lexical variables of a closure properly.")))) "")) -(quit :unix-status 104) +;;;; more tests + +;;; Old PCL hung up on this. +(defmethod #:foo () + (defun #:bar ())) + \ No newline at end of file