tests/walk.impure.lisp

   1 ;;;; tests for the code walker
   2
   3 ;;;; This software is part of the SBCL system. See the README file for
   4 ;;;; more information.
   5
   6 ;;;; This software is derived from software originally released by Xerox
   7 ;;;; Corporation. Copyright and release statements follow. Later modifications
   8 ;;;; to the software are in the public domain and are provided with
   9 ;;;; absolutely no warranty. See the COPYING and CREDITS files for more
  10 ;;;; information.
  11
  12 ;;;; copyright information from original PCL sources:
  13 ;;;;
  14 ;;;; Copyright (c) 1985, 1986, 1987, 1988, 1989, 1990 Xerox Corporation.
  15 ;;;; All rights reserved.
  16 ;;;;
  17 ;;;; Use and copying of this software and preparation of derivative works based
  18 ;;;; upon this software are permitted. Any distribution of this software or
  19 ;;;; derivative works must comply with all applicable United States export
  20 ;;;; control laws.
  21 ;;;;
  22 ;;;; This software is made available AS IS, and Xerox Corporation makes no
  23 ;;;; warranty about the software, its performance or its conformity to any
  24 ;;;; specification.
  25
  26 (in-package :sb-walker)
  27 \f
  28 ;;;; utilities to support tests
  29
  30 ;;; string equality modulo deletion of consecutive whitespace (as a crude way
  31 ;;; of washing away irrelevant differences in indentation)
  32 (defun string-modulo-tabspace (s)
  33   (let ((s (string-trim '(#\Space) (substitute #\Space #\Newline
  34                                                (substitute #\Space #\Tab s)))))
  35     (loop (let ((p (search "  " s)))
  36             (if (not p) (return s))
  37             ;; Extremely inefficient but simple algorithm.
  38             (setq s (concatenate 'string (subseq s 0 p) (subseq s (1+ p))))))))
  39
  40 (defun string=-modulo-tabspace (x y)
  41   (string= (string-modulo-tabspace x)
  42            (string-modulo-tabspace y)))
  43 \f
  44 ;;;; tests based on stuff at the end of the original CMU CL
  45 ;;;; pcl/walk.lisp file
  46
  47 (defmacro take-it-out-for-a-test-walk (form)
  48   `(take-it-out-for-a-test-walk-1 ',form))
  49
  50 (defun take-it-out-for-a-test-walk-1 (form)
  51   (let ((copy-of-form (copy-tree form))
  52         (result (walk-form form nil
  53                   (lambda (x y env)
  54                     (format t "~&Form: ~S ~3T Context: ~A" x y)
  55                     (when (symbolp x)
  56                       (let ((lexical (var-lexical-p x env))
  57                             (special (var-special-p x env)))
  58                         (when lexical
  59                           (format t ";~3T")
  60                           (format t "lexically bound"))
  61                         (when special
  62                           (format t ";~3T")
  63                           (format t "declared special"))
  64                         (when (boundp x)
  65                           (format t ";~3T")
  66                           (format t "bound: ~S " (eval x)))))
  67                     x))))
  68     (cond ((not (equal result copy-of-form))
  69            (format t "~%Warning: Result not EQUAL to copy of start."))
  70           ((not (eq result form))
  71            (format t "~%Warning: Result not EQ to copy of start.")))
  72     (pprint result)
  73     nil))
  74
  75 (defmacro foo (&rest ignore)
  76   (declare (ignore ignore))
  77   ''global-foo)
  78
  79 (defmacro bar (&rest ignore)
  80   (declare (ignore ignore))
  81   ''global-bar)
  82
  83 (test-util:with-test (:name (:walk list))
  84   (assert (string=-modulo-tabspace
  85            (with-output-to-string (*standard-output*)
  86              (take-it-out-for-a-test-walk (list arg1 arg2 arg3)))
  87            "Form: (LIST ARG1 ARG2 ARG3)   Context: EVAL
  88 Form: ARG1   Context: EVAL
  89 Form: ARG2   Context: EVAL
  90 Form: ARG3   Context: EVAL
  91 \(LIST ARG1 ARG2 ARG3)")))
  92
  93 (test-util:with-test (:name (:walk list cons))
  94   (assert (string=-modulo-tabspace
  95            (with-output-to-string (*standard-output*)
  96              (take-it-out-for-a-test-walk (list (cons 1 2) (list 3 4 5))))
  97            "Form: (LIST (CONS 1 2) (LIST 3 4 5))   Context: EVAL
  98 Form: (CONS 1 2)   Context: EVAL
  99 Form: 1   Context: EVAL
 100 Form: 2   Context: EVAL
 101 Form: (LIST 3 4 5)   Context: EVAL
 102 Form: 3   Context: EVAL
 103 Form: 4   Context: EVAL
 104 Form: 5   Context: EVAL
 105 \(LIST (CONS 1 2) (LIST 3 4 5))")))
 106
 107 (test-util:with-test (:name (:walk progn 1))
 108   (assert (string=-modulo-tabspace
 109            (with-output-to-string (*standard-output*)
 110              (take-it-out-for-a-test-walk (progn (foo) (bar 1))))
 111            "Form: (PROGN (FOO) (BAR 1))   Context: EVAL
 112 Form: (FOO)   Context: EVAL
 113 Form: 'GLOBAL-FOO   Context: EVAL
 114 Form: (BAR 1)   Context: EVAL
 115 Form: 'GLOBAL-BAR   Context: EVAL
 116 \(PROGN (FOO) (BAR 1))")))
 117
 118 (test-util:with-test (:name (:walk block))
 119   (assert (string=-modulo-tabspace
 120            (with-output-to-string (*standard-output*)
 121              (take-it-out-for-a-test-walk (block block-name a b c)))
 122            "Form: (BLOCK BLOCK-NAME A B C)   Context: EVAL
 123 Form: A   Context: EVAL
 124 Form: B   Context: EVAL
 125 Form: C   Context: EVAL
 126 \(BLOCK BLOCK-NAME A B C)")))
 127
 128 (test-util:with-test (:name (:walk block list))
 129   (assert (string=-modulo-tabspace
 130            (with-output-to-string (*standard-output*)
 131              (take-it-out-for-a-test-walk (block block-name (list a) b c)))
 132            "Form: (BLOCK BLOCK-NAME (LIST A) B C)   Context: EVAL
 133 Form: (LIST A)   Context: EVAL
 134 Form: A   Context: EVAL
 135 Form: B   Context: EVAL
 136 Form: C   Context: EVAL
 137 \(BLOCK BLOCK-NAME (LIST A) B C)")))
 138
 139 (test-util:with-test (:name (:walk catch list))
 140   (assert (string=-modulo-tabspace
 141            (with-output-to-string (*standard-output*)
 142              (take-it-out-for-a-test-walk (catch catch-tag (list a) b c)))
 143            "Form: (CATCH CATCH-TAG (LIST A) B C)   Context: EVAL
 144 Form: CATCH-TAG   Context: EVAL
 145 Form: (LIST A)   Context: EVAL
 146 Form: A   Context: EVAL
 147 Form: B   Context: EVAL
 148 Form: C   Context: EVAL
 149 \(CATCH CATCH-TAG (LIST A) B C)")))
 150
 151 ;;; This is a fairly simple MACROLET case. While walking the body of the
 152 ;;; macro, X should be lexically bound. In the body of the MACROLET form
 153 ;;; itself, X should not be bound.
 154 (test-util:with-test (:name (:walk macrolet))
 155   (assert (string=-modulo-tabspace
 156            (with-output-to-string (*standard-output*)
 157              (take-it-out-for-a-test-walk
 158               (macrolet ((foo (x) (list x) ''inner))
 159                 x
 160                 (foo 1))))
 161            "Form: (MACROLET ((FOO (X)
 162                    (LIST X)
 163                    ''INNER))
 164         X
 165         (FOO 1))   Context: EVAL
 166 Form: (LIST X)   Context: EVAL
 167 Form: X   Context: EVAL; lexically bound
 168 Form: ''INNER   Context: EVAL
 169 Form: X   Context: EVAL
 170 Form: (FOO 1)   Context: EVAL
 171 Form: 'INNER   Context: EVAL
 172 \(MACROLET ((FOO (X)
 173              (LIST X)
 174              ''INNER))
 175   X
 176   (FOO 1))")))
 177
 178 ;;; The original PCL documentation for this test said
 179 ;;;   A slightly more complex MACROLET case. In the body of the macro
 180 ;;;   X should not be lexically bound. In the body of the macrolet
 181 ;;;   form itself X should be bound. Note that THIS CASE WILL CAUSE AN
 182 ;;;   ERROR when it tries to macroexpand the call to FOO.
 183 ;;;
 184 ;;; This test is commented out in SBCL because ANSI says, in the
 185 ;;; definition of the special operator MACROLET,
 186 ;;;    The macro-expansion functions defined by MACROLET are defined
 187 ;;;    in the lexical environment in which the MACROLET form appears.
 188 ;;;    Declarations and MACROLET and SYMBOL-MACROLET definitions affect
 189 ;;;    the local macro definitions in a MACROLET, but the consequences
 190 ;;;    are undefined if the local macro definitions reference any
 191 ;;;    local variable or function bindings that are visible in that
 192 ;;;    lexical environment.
 193 ;;; Since the behavior is undefined, anything we do conforms.:-|
 194 ;;; This is of course less than ideal; see bug 124.
 195 #+nil
 196 (multiple-value-bind (res cond)
 197     (ignore-errors
 198       (take-it-out-for-a-test-walk
 199        (let ((x 1))
 200          (macrolet ((foo () (list x) ''inner))
 201            x
 202            (foo)))))
 203   (assert (and (null res) cond)))
 204
 205 (test-util:with-test (:name (:walk flet 1))
 206   (assert (string=-modulo-tabspace
 207            (with-output-to-string (*standard-output*)
 208              (take-it-out-for-a-test-walk
 209               (flet ((foo (x) (list x y))
 210                      (bar (x) (list x y)))
 211                 (foo 1))))
 212            "Form: (FLET ((FOO (X)
 213                (LIST X Y))
 214              (BAR (X)
 215                (LIST X Y)))
 216         (FOO 1))   Context: EVAL
 217 Form: (LIST X Y)   Context: EVAL
 218 Form: X   Context: EVAL; lexically bound
 219 Form: Y   Context: EVAL
 220 Form: (LIST X Y)   Context: EVAL
 221 Form: X   Context: EVAL; lexically bound
 222 Form: Y   Context: EVAL
 223 Form: (FOO 1)   Context: EVAL
 224 Form: 1   Context: EVAL
 225 \(FLET ((FOO (X)
 226          (LIST X Y))
 227        (BAR (X)
 228          (LIST X Y)))
 229   (FOO 1))")))
 230
 231 (test-util:with-test (:name (:walk let flet))
 232   (assert (string=-modulo-tabspace
 233            (with-output-to-string (*standard-output*)
 234              (take-it-out-for-a-test-walk
 235               (let ((y 2))
 236                 (flet ((foo (x) (list x y))
 237                        (bar (x) (list x y)))
 238                   (foo 1)))))
 239            "Form: (LET ((Y 2))
 240         (FLET ((FOO (X)
 241                  (LIST X Y))
 242                (BAR (X)
 243                  (LIST X Y)))
 244           (FOO 1)))   Context: EVAL
 245 Form: 2   Context: EVAL
 246 Form: (FLET ((FOO (X)
 247                (LIST X Y))
 248              (BAR (X)
 249                (LIST X Y)))
 250         (FOO 1))   Context: EVAL
 251 Form: (LIST X Y)   Context: EVAL
 252 Form: X   Context: EVAL; lexically bound
 253 Form: Y   Context: EVAL; lexically bound
 254 Form: (LIST X Y)   Context: EVAL
 255 Form: X   Context: EVAL; lexically bound
 256 Form: Y   Context: EVAL; lexically bound
 257 Form: (FOO 1)   Context: EVAL
 258 Form: 1   Context: EVAL
 259 \(LET ((Y 2))
 260   (FLET ((FOO (X)
 261            (LIST X Y))
 262          (BAR (X)
 263            (LIST X Y)))
 264     (FOO 1)))")))
 265
 266 (test-util:with-test (:name (:walk labels))
 267   (assert (string=-modulo-tabspace
 268            (with-output-to-string (*standard-output*)
 269              (take-it-out-for-a-test-walk
 270               (labels ((foo (x) (bar x))
 271                        (bar (x) (foo x)))
 272                 (foo 1))))
 273            "Form: (LABELS ((FOO (X)
 274                  (BAR X))
 275                (BAR (X)
 276                  (FOO X)))
 277         (FOO 1))   Context: EVAL
 278 Form: (BAR X)   Context: EVAL
 279 Form: X   Context: EVAL; lexically bound
 280 Form: (FOO X)   Context: EVAL
 281 Form: X   Context: EVAL; lexically bound
 282 Form: (FOO 1)   Context: EVAL
 283 Form: 1   Context: EVAL
 284 \(LABELS ((FOO (X)
 285            (BAR X))
 286          (BAR (X)
 287            (FOO X)))
 288   (FOO 1))")))
 289
 290 (test-util:with-test (:name (:walk flet 2))
 291   (assert (string=-modulo-tabspace
 292            (with-output-to-string (*standard-output*)
 293              (take-it-out-for-a-test-walk
 294               (flet ((foo (x) (foo x)))
 295                 (foo 1))))
 296            "Form: (FLET ((FOO (X)
 297                (FOO X)))
 298         (FOO 1))   Context: EVAL
 299 Form: (FOO X)   Context: EVAL
 300 Form: 'GLOBAL-FOO   Context: EVAL
 301 Form: (FOO 1)   Context: EVAL
 302 Form: 1   Context: EVAL
 303 \(FLET ((FOO (X)
 304          (FOO X)))
 305   (FOO 1))")))
 306
 307 (test-util:with-test (:name (:walk flet 3))
 308   (assert (string=-modulo-tabspace
 309          (with-output-to-string (*standard-output*)
 310            (take-it-out-for-a-test-walk
 311             (flet ((foo (x) (foo x)))
 312               (flet ((bar (x) (foo x)))
 313                 (bar 1)))))
 314          "Form: (FLET ((FOO (X)
 315                (FOO X)))
 316         (FLET ((BAR (X)
 317                  (FOO X)))
 318           (BAR 1)))   Context: EVAL
 319 Form: (FOO X)   Context: EVAL
 320 Form: 'GLOBAL-FOO   Context: EVAL
 321 Form: (FLET ((BAR (X)
 322                (FOO X)))
 323         (BAR 1))   Context: EVAL
 324 Form: (FOO X)   Context: EVAL
 325 Form: X   Context: EVAL; lexically bound
 326 Form: (BAR 1)   Context: EVAL
 327 Form: 1   Context: EVAL
 328 \(FLET ((FOO (X)
 329          (FOO X)))
 330   (FLET ((BAR (X)
 331            (FOO X)))
 332     (BAR 1)))")))
 333
 334 (test-util:with-test (:name (:walk progn special))
 335   (assert (string=-modulo-tabspace
 336            (with-output-to-string (*standard-output*)
 337              (take-it-out-for-a-test-walk (prog () (declare (special a b)))))
 338            "Form: (PROG () (DECLARE (SPECIAL A B)))   Context: EVAL
 339 Form: (BLOCK NIL
 340         (LET ()
 341           (DECLARE (SPECIAL A B))
 342           (TAGBODY)))   Context: EVAL
 343 Form: (LET ()
 344         (DECLARE (SPECIAL A B))
 345         (TAGBODY))   Context: EVAL
 346 Form: (TAGBODY)   Context: EVAL
 347 \(PROG () (DECLARE (SPECIAL A B)))")))
 348
 349 (test-util:with-test (:name (:walk let special 1))
 350   (assert (string=-modulo-tabspace
 351            (with-output-to-string (*standard-output*)
 352              (take-it-out-for-a-test-walk (let (a b c)
 353                                             (declare (special a b))
 354                                             (foo a) b c)))
 355            "Form: (LET (A B C)
 356         (DECLARE (SPECIAL A B))
 357         (FOO A)
 358         B
 359         C)   Context: EVAL
 360 Form: (FOO A)   Context: EVAL
 361 Form: 'GLOBAL-FOO   Context: EVAL
 362 Form: B   Context: EVAL; lexically bound; declared special
 363 Form: C   Context: EVAL; lexically bound
 364 \(LET (A B C)
 365   (DECLARE (SPECIAL A B))
 366   (FOO A)
 367   B
 368   C)")))
 369
 370 (test-util:with-test (:name (:walk let special 2))
 371   (assert (string=-modulo-tabspace
 372            (with-output-to-string (*standard-output*)
 373              (take-it-out-for-a-test-walk (let (a b c)
 374                                             (declare (special a) (special b))
 375                                             (foo a) b c)))
 376            "Form: (LET (A B C)
 377         (DECLARE (SPECIAL A) (SPECIAL B))
 378         (FOO A)
 379         B
 380         C)   Context: EVAL
 381 Form: (FOO A)   Context: EVAL
 382 Form: 'GLOBAL-FOO   Context: EVAL
 383 Form: B   Context: EVAL; lexically bound; declared special
 384 Form: C   Context: EVAL; lexically bound
 385 \(LET (A B C)
 386   (DECLARE (SPECIAL A) (SPECIAL B))
 387   (FOO A)
 388   B
 389   C)")))
 390
 391 (test-util:with-test (:name (:walk let special 3))
 392   (assert (string=-modulo-tabspace
 393            (with-output-to-string (*standard-output*)
 394              (take-it-out-for-a-test-walk (let (a b c)
 395                                             (declare (special a))
 396                                             (declare (special b))
 397                                             (foo a) b c)))
 398            "Form: (LET (A B C)
 399         (DECLARE (SPECIAL A))
 400         (DECLARE (SPECIAL B))
 401         (FOO A)
 402         B
 403         C)   Context: EVAL
 404 Form: (FOO A)   Context: EVAL
 405 Form: 'GLOBAL-FOO   Context: EVAL
 406 Form: B   Context: EVAL; lexically bound; declared special
 407 Form: C   Context: EVAL; lexically bound
 408 \(LET (A B C)
 409   (DECLARE (SPECIAL A))
 410   (DECLARE (SPECIAL B))
 411   (FOO A)
 412   B
 413   C)")))
 414
 415 (test-util:with-test (:name (:walk let special 4))
 416   (assert (string=-modulo-tabspace
 417            (with-output-to-string (*standard-output*)
 418              (take-it-out-for-a-test-walk (let (a b c)
 419                                             (declare (special a))
 420                                             (declare (special b))
 421                                             (let ((a 1))
 422                                               (foo a) b c))))
 423            "Form: (LET (A B C)
 424         (DECLARE (SPECIAL A))
 425         (DECLARE (SPECIAL B))
 426         (LET ((A 1))
 427           (FOO A)
 428           B
 429           C))   Context: EVAL
 430 Form: (LET ((A 1))
 431         (FOO A)
 432         B
 433         C)   Context: EVAL
 434 Form: 1   Context: EVAL
 435 Form: (FOO A)   Context: EVAL
 436 Form: 'GLOBAL-FOO   Context: EVAL
 437 Form: B   Context: EVAL; lexically bound; declared special
 438 Form: C   Context: EVAL; lexically bound
 439 \(LET (A B C)
 440   (DECLARE (SPECIAL A))
 441   (DECLARE (SPECIAL B))
 442   (LET ((A 1))
 443     (FOO A)
 444     B
 445     C))")))
 446
 447 (test-util:with-test (:name (:walk eval-when 1))
 448   (assert (string=-modulo-tabspace
 449            (with-output-to-string (*standard-output*)
 450              (take-it-out-for-a-test-walk (eval-when ()
 451                                             a
 452                                             (foo a))))
 453            "Form: (EVAL-WHEN NIL A (FOO A))   Context: EVAL
 454 Form: A   Context: EVAL
 455 Form: (FOO A)   Context: EVAL
 456 Form: 'GLOBAL-FOO   Context: EVAL
 457 \(EVAL-WHEN NIL A (FOO A))")))
 458
 459 (test-util:with-test (:name (:walk eval-when 2))
 460   (assert (string=-modulo-tabspace
 461            (with-output-to-string (*standard-output*)
 462              (take-it-out-for-a-test-walk
 463               (eval-when (:execute :compile-toplevel :load-toplevel)
 464                 a
 465                 (foo a))))
 466          "Form: (EVAL-WHEN (:EXECUTE :COMPILE-TOPLEVEL :LOAD-TOPLEVEL) A (FOO A))   Context: EVAL
 467 Form: A   Context: EVAL
 468 Form: (FOO A)   Context: EVAL
 469 Form: 'GLOBAL-FOO   Context: EVAL
 470 \(EVAL-WHEN (:EXECUTE :COMPILE-TOPLEVEL :LOAD-TOPLEVEL) A (FOO A))")))
 471
 472 (test-util:with-test (:name (:walk multiple-value-bind))
 473   (assert (string=-modulo-tabspace
 474            (with-output-to-string (*standard-output*)
 475              (take-it-out-for-a-test-walk (multiple-value-bind (a b)
 476                                               (foo a b) (list a b))))
 477          "Form: (MULTIPLE-VALUE-BIND (A B) (FOO A B) (LIST A B))   Context: EVAL
 478 Form: (FOO A B)   Context: EVAL
 479 Form: 'GLOBAL-FOO   Context: EVAL
 480 Form: (LIST A B)   Context: EVAL
 481 Form: A   Context: EVAL; lexically bound
 482 Form: B   Context: EVAL; lexically bound
 483 \(MULTIPLE-VALUE-BIND (A B) (FOO A B) (LIST A B))")))
 484
 485 (test-util:with-test (:name (:walk multiple-value-bind special))
 486   (assert (string=-modulo-tabspace
 487            (with-output-to-string (*standard-output*)
 488              (take-it-out-for-a-test-walk (multiple-value-bind (a b)
 489                                               (foo a b)
 490                                             (declare (special a))
 491                                             (list a b))))
 492          "Form: (MULTIPLE-VALUE-BIND (A B) (FOO A B) (DECLARE (SPECIAL A)) (LIST A B))   Context: EVAL
 493 Form: (FOO A B)   Context: EVAL
 494 Form: 'GLOBAL-FOO   Context: EVAL
 495 Form: (LIST A B)   Context: EVAL
 496 Form: A   Context: EVAL; lexically bound; declared special
 497 Form: B   Context: EVAL; lexically bound
 498 \(MULTIPLE-VALUE-BIND (A B) (FOO A B) (DECLARE (SPECIAL A)) (LIST A B))")))
 499
 500 (test-util:with-test (:name (:walk progn function))
 501   (assert (string=-modulo-tabspace
 502            (with-output-to-string (*standard-output*)
 503              (take-it-out-for-a-test-walk (progn (function foo))))
 504            "Form: (PROGN #'FOO)   Context: EVAL
 505 Form: #'FOO   Context: EVAL
 506 \(PROGN #'FOO)")))
 507
 508 (test-util:with-test (:name (:walk progn go))
 509   (assert (string=-modulo-tabspace
 510            (with-output-to-string (*standard-output*)
 511              (take-it-out-for-a-test-walk (progn a b (go a))))
 512          "Form: (PROGN A B (GO A))   Context: EVAL
 513 Form: A   Context: EVAL
 514 Form: B   Context: EVAL
 515 Form: (GO A)   Context: EVAL
 516 \(PROGN A B (GO A))")))
 517
 518 (test-util:with-test (:name (:walk if 1))
 519   (assert (string=-modulo-tabspace
 520            (with-output-to-string (*standard-output*)
 521              (take-it-out-for-a-test-walk (if a b c)))
 522            "Form: (IF A B C)   Context: EVAL
 523 Form: A   Context: EVAL
 524 Form: B   Context: EVAL
 525 Form: C   Context: EVAL
 526 \(IF A B C)")))
 527
 528 (test-util:with-test (:name (:walk if 2))
 529   (assert (string=-modulo-tabspace
 530            (with-output-to-string (*standard-output*)
 531              (take-it-out-for-a-test-walk (if a b)))
 532            "Form: (IF A B)   Context: EVAL
 533 Form: A   Context: EVAL
 534 Form: B   Context: EVAL
 535 Form: NIL   Context: EVAL; bound: NIL
 536 \(IF A B)")))
 537
 538 (test-util:with-test (:name (:walk lambda))
 539   (assert (string=-modulo-tabspace
 540            (with-output-to-string (*standard-output*)
 541              (take-it-out-for-a-test-walk ((lambda (a b) (list a b)) 1 2)))
 542            "Form: ((LAMBDA (A B) (LIST A B)) 1 2)   Context: EVAL
 543 Form: (LAMBDA (A B) (LIST A B))   Context: EVAL
 544 Form: (LIST A B)   Context: EVAL
 545 Form: A   Context: EVAL; lexically bound
 546 Form: B   Context: EVAL; lexically bound
 547 Form: 1   Context: EVAL
 548 Form: 2   Context: EVAL
 549 \((LAMBDA (A B) (LIST A B)) 1 2)")))
 550
 551 (test-util:with-test (:name (:walk lambda special))
 552   (assert (string=-modulo-tabspace
 553            (with-output-to-string (*standard-output*)
 554              (take-it-out-for-a-test-walk ((lambda (a b)
 555                                              (declare (special a))
 556                                              (list a b))
 557                                            1 2)))
 558            "Form: ((LAMBDA (A B) (DECLARE (SPECIAL A)) (LIST A B)) 1 2)   Context: EVAL
 559 Form: (LAMBDA (A B) (DECLARE (SPECIAL A)) (LIST A B))   Context: EVAL
 560 Form: (LIST A B)   Context: EVAL
 561 Form: A   Context: EVAL; lexically bound; declared special
 562 Form: B   Context: EVAL; lexically bound
 563 Form: 1   Context: EVAL
 564 Form: 2   Context: EVAL
 565 \((LAMBDA (A B) (DECLARE (SPECIAL A)) (LIST A B)) 1 2)")))
 566
 567 (test-util:with-test (:name (:walk let list))
 568   (assert (string=-modulo-tabspace
 569            (with-output-to-string (*standard-output*)
 570              (take-it-out-for-a-test-walk (let ((a a) (b a) (c b))
 571                                             (list a b c))))
 572            "Form: (LET ((A A) (B A) (C B))
 573         (LIST A B C))   Context: EVAL
 574 Form: A   Context: EVAL
 575 Form: A   Context: EVAL
 576 Form: B   Context: EVAL
 577 Form: (LIST A B C)   Context: EVAL
 578 Form: A   Context: EVAL; lexically bound
 579 Form: B   Context: EVAL; lexically bound
 580 Form: C   Context: EVAL; lexically bound
 581 \(LET ((A A) (B A) (C B))
 582   (LIST A B C))")))
 583
 584 (test-util:with-test (:name (:walk let* list))
 585   (assert (string=-modulo-tabspace
 586            (with-output-to-string (*standard-output*)
 587              (take-it-out-for-a-test-walk (let* ((a a) (b a) (c b)) (list a b c))))
 588            "Form: (LET* ((A A) (B A) (C B))
 589         (LIST A B C))   Context: EVAL
 590 Form: A   Context: EVAL
 591 Form: A   Context: EVAL; lexically bound
 592 Form: B   Context: EVAL; lexically bound
 593 Form: (LIST A B C)   Context: EVAL
 594 Form: A   Context: EVAL; lexically bound
 595 Form: B   Context: EVAL; lexically bound
 596 Form: C   Context: EVAL; lexically bound
 597 \(LET* ((A A) (B A) (C B))
 598   (LIST A B C))")))
 599
 600 (test-util:with-test (:name (:walk let special list))
 601   (assert (string=-modulo-tabspace
 602            (with-output-to-string (*standard-output*)
 603              (take-it-out-for-a-test-walk (let ((a a) (b a) (c b))
 604                                             (declare (special a b))
 605                                             (list a b c))))
 606            "Form: (LET ((A A) (B A) (C B))
 607         (DECLARE (SPECIAL A B))
 608         (LIST A B C))   Context: EVAL
 609 Form: A   Context: EVAL
 610 Form: A   Context: EVAL
 611 Form: B   Context: EVAL
 612 Form: (LIST A B C)   Context: EVAL
 613 Form: A   Context: EVAL; lexically bound; declared special
 614 Form: B   Context: EVAL; lexically bound; declared special
 615 Form: C   Context: EVAL; lexically bound
 616 \(LET ((A A) (B A) (C B))
 617   (DECLARE (SPECIAL A B))
 618   (LIST A B C))")))
 619
 620 ;;;; Bug in LET* walking!
 621 (test-util:with-test (:name (:walk let* special list :hairy-specials))
 622   (assert
 623    (string=-modulo-tabspace
 624     (with-output-to-string (*standard-output*)
 625       (take-it-out-for-a-test-walk (let* ((a a) (b a) (c b))
 626                                      (declare (special a b))
 627                                      (list a b c))))
 628     "Form: (LET* ((A A) (B A) (C B))
 629              (DECLARE (SPECIAL A B))
 630              (LIST A B C))   Context: EVAL
 631      Form: A   Context: EVAL
 632      Form: A   Context: EVAL; lexically bound; declared special
 633      Form: B   Context: EVAL; lexically bound; declared special
 634      Form: (LIST A B C)   Context: EVAL
 635      Form: A   Context: EVAL; lexically bound; declared special
 636      Form: B   Context: EVAL; lexically bound; declared special
 637      Form: C   Context: EVAL; lexically bound
 638      (LET* ((A A) (B A) (C B))
 639        (DECLARE (SPECIAL A B))
 640        (LIST A B C))")))
 641
 642 (test-util:with-test (:name (:walk let special 5))
 643   (assert (string=-modulo-tabspace
 644            (with-output-to-string (*standard-output*)
 645              (take-it-out-for-a-test-walk (let ((a 1) (b 2))
 646                                             (foo bar)
 647                                             (let ()
 648                                               (declare (special a))
 649                                               (foo a b)))))
 650            "Form: (LET ((A 1) (B 2))
 651         (FOO BAR)
 652         (LET ()
 653           (DECLARE (SPECIAL A))
 654           (FOO A B)))   Context: EVAL
 655 Form: 1   Context: EVAL
 656 Form: 2   Context: EVAL
 657 Form: (FOO BAR)   Context: EVAL
 658 Form: 'GLOBAL-FOO   Context: EVAL
 659 Form: (LET ()
 660         (DECLARE (SPECIAL A))
 661         (FOO A B))   Context: EVAL
 662 Form: (FOO A B)   Context: EVAL
 663 Form: 'GLOBAL-FOO   Context: EVAL
 664 \(LET ((A 1) (B 2))
 665   (FOO BAR)
 666   (LET ()
 667     (DECLARE (SPECIAL A))
 668     (FOO A B)))")))
 669
 670 (test-util:with-test (:name (:walk multiple-value-call))
 671   (assert (string=-modulo-tabspace
 672            (with-output-to-string (*standard-output*)
 673              (take-it-out-for-a-test-walk (multiple-value-call #'foo a b c)))
 674            "Form: (MULTIPLE-VALUE-CALL #'FOO A B C)   Context: EVAL
 675 Form: #'FOO   Context: EVAL
 676 Form: A   Context: EVAL
 677 Form: B   Context: EVAL
 678 Form: C   Context: EVAL
 679 \(MULTIPLE-VALUE-CALL #'FOO A B C)")))
 680
 681 (test-util:with-test (:name (:walk multiple-value-prog1))
 682   (assert (string=-modulo-tabspace
 683            (with-output-to-string (*standard-output*)
 684              (take-it-out-for-a-test-walk (multiple-value-prog1 a b c)))
 685          "Form: (MULTIPLE-VALUE-PROG1 A B C)   Context: EVAL
 686 Form: A   Context: EVAL
 687 Form: B   Context: EVAL
 688 Form: C   Context: EVAL
 689 \(MULTIPLE-VALUE-PROG1 A B C)")))
 690
 691 (test-util:with-test (:name (:walk progn 2))
 692   (assert (string=-modulo-tabspace
 693            (with-output-to-string (*standard-output*)
 694              (take-it-out-for-a-test-walk (progn a b c)))
 695          "Form: (PROGN A B C)   Context: EVAL
 696 Form: A   Context: EVAL
 697 Form: B   Context: EVAL
 698 Form: C   Context: EVAL
 699 \(PROGN A B C)")))
 700
 701 (test-util:with-test (:name (:walk progv))
 702   (assert (string=-modulo-tabspace
 703            (with-output-to-string (*standard-output*)
 704              (take-it-out-for-a-test-walk (progv vars vals a b c)))
 705          "Form: (PROGV VARS VALS A B C)   Context: EVAL
 706 Form: VARS   Context: EVAL
 707 Form: VALS   Context: EVAL
 708 Form: A   Context: EVAL
 709 Form: B   Context: EVAL
 710 Form: C   Context: EVAL
 711 \(PROGV VARS VALS A B C)")))
 712
 713 (test-util:with-test (:name (:walk quote))
 714   (assert (string=-modulo-tabspace
 715            (with-output-to-string (*standard-output*)
 716              (take-it-out-for-a-test-walk (quote a)))
 717          "Form: 'A   Context: EVAL
 718 'A")))
 719
 720 (test-util:with-test (:name (:walk return-from))
 721   (assert (string=-modulo-tabspace
 722            (with-output-to-string (*standard-output*)
 723              (take-it-out-for-a-test-walk (return-from block-name a b c)))
 724            "Form: (RETURN-FROM BLOCK-NAME A B C)   Context: EVAL
 725 Form: A   Context: EVAL
 726 Form: B   Context: EVAL
 727 Form: C   Context: EVAL
 728 \(RETURN-FROM BLOCK-NAME A B C)")))
 729
 730
 731 (test-util:with-test (:name (:walk setq 1))
 732   (assert (string=-modulo-tabspace
 733            (with-output-to-string (*standard-output*)
 734              (take-it-out-for-a-test-walk (setq a 1)))
 735            "Form: (SETQ A 1)   Context: EVAL
 736 Form: A   Context: SET
 737 Form: 1   Context: EVAL
 738 \(SETQ A 1)")))
 739 (makunbound 'a)
 740
 741 (test-util:with-test (:name (:walk setq 2))
 742   (assert (string=-modulo-tabspace
 743            (with-output-to-string (*standard-output*)
 744              (take-it-out-for-a-test-walk (setq a (foo 1) b (bar 2) c 3)))
 745            "Form: (SETQ A (FOO 1) B (BAR 2) C 3)   Context: EVAL
 746 Form: (SETQ A (FOO 1))   Context: EVAL
 747 Form: A   Context: SET
 748 Form: (FOO 1)   Context: EVAL
 749 Form: 'GLOBAL-FOO   Context: EVAL
 750 Form: (SETQ B (BAR 2))   Context: EVAL
 751 Form: B   Context: SET
 752 Form: (BAR 2)   Context: EVAL
 753 Form: 'GLOBAL-BAR   Context: EVAL
 754 Form: (SETQ C 3)   Context: EVAL
 755 Form: C   Context: SET
 756 Form: 3   Context: EVAL
 757 \(SETQ A (FOO 1) B (BAR 2) C 3)")))
 758 (makunbound 'a)
 759 (makunbound 'b)
 760 (makunbound 'c)
 761
 762 (test-util:with-test (:name (:walk tagbody))
 763   (assert (string=-modulo-tabspace
 764            (with-output-to-string (*standard-output*)
 765              (take-it-out-for-a-test-walk (tagbody a b c (go a))))
 766            "Form: (TAGBODY A B C (GO A))   Context: EVAL
 767 Form: (GO A)   Context: EVAL
 768 \(TAGBODY A B C (GO A))")))
 769
 770 (test-util:with-test (:name (:walk the))
 771   (assert (string=-modulo-tabspace
 772            (with-output-to-string (*standard-output*)
 773              (take-it-out-for-a-test-walk (the foo (foo-form a b c))))
 774            "Form: (THE FOO (FOO-FORM A B C))   Context: EVAL
 775 Form: (FOO-FORM A B C)   Context: EVAL
 776 Form: A   Context: EVAL
 777 Form: B   Context: EVAL
 778 Form: C   Context: EVAL
 779 \(THE FOO (FOO-FORM A B C))")))
 780
 781 (test-util:with-test (:name (:walk throw))
 782   (assert (string=-modulo-tabspace
 783            (with-output-to-string (*standard-output*)
 784              (take-it-out-for-a-test-walk (throw tag-form a)))
 785            "Form: (THROW TAG-FORM A)   Context: EVAL
 786 Form: TAG-FORM   Context: EVAL
 787 Form: A   Context: EVAL
 788 \(THROW TAG-FORM A)")))
 789
 790 (test-util:with-test (:name (:walk unwind-protect))
 791   (assert (string=-modulo-tabspace
 792            (with-output-to-string (*standard-output*)
 793              (take-it-out-for-a-test-walk (unwind-protect (foo a b) d e f)))
 794            "Form: (UNWIND-PROTECT (FOO A B) D E F)   Context: EVAL
 795 Form: (FOO A B)   Context: EVAL
 796 Form: 'GLOBAL-FOO   Context: EVAL
 797 Form: D   Context: EVAL
 798 Form: E   Context: EVAL
 799 Form: F   Context: EVAL
 800 \(UNWIND-PROTECT (FOO A B) D E F)")))
 801
 802 (defmacro flet-1 (a b)
 803   (declare (ignore a b))
 804   ''outer)
 805
 806 (defmacro labels-1 (a b)
 807   (declare (ignore a b))
 808   ''outer)
 809
 810 (test-util:with-test (:name (:walk flet defmacro))
 811   (assert (string=-modulo-tabspace
 812            (with-output-to-string (*standard-output*)
 813              (take-it-out-for-a-test-walk
 814               (flet ((flet-1 (a b) () (flet-1 a b) (list a b)))
 815                 (flet-1 1 2)
 816                 (foo 1 2))))
 817            "Form: (FLET ((FLET-1 (A B)
 818                NIL
 819                (FLET-1 A B)
 820                (LIST A B)))
 821         (FLET-1 1 2)
 822         (FOO 1 2))   Context: EVAL
 823 Form: NIL   Context: EVAL; bound: NIL
 824 Form: (FLET-1 A B)   Context: EVAL
 825 Form: 'OUTER   Context: EVAL
 826 Form: (LIST A B)   Context: EVAL
 827 Form: A   Context: EVAL; lexically bound
 828 Form: B   Context: EVAL; lexically bound
 829 Form: (FLET-1 1 2)   Context: EVAL
 830 Form: 1   Context: EVAL
 831 Form: 2   Context: EVAL
 832 Form: (FOO 1 2)   Context: EVAL
 833 Form: 'GLOBAL-FOO   Context: EVAL
 834 \(FLET ((FLET-1 (A B)
 835          NIL
 836          (FLET-1 A B)
 837          (LIST A B)))
 838   (FLET-1 1 2)
 839   (FOO 1 2))")))
 840
 841 (test-util:with-test (:name (:walk labels defmacro))
 842   (assert (string=-modulo-tabspace
 843            (with-output-to-string (*standard-output*)
 844              (take-it-out-for-a-test-walk
 845               (labels ((label-1 (a b) () (label-1 a b)(list a b)))
 846                 (label-1 1 2)
 847                 (foo 1 2))))
 848            "Form: (LABELS ((LABEL-1 (A B)
 849                  NIL
 850                  (LABEL-1 A B)
 851                  (LIST A B)))
 852         (LABEL-1 1 2)
 853         (FOO 1 2))   Context: EVAL
 854 Form: NIL   Context: EVAL; bound: NIL
 855 Form: (LABEL-1 A B)   Context: EVAL
 856 Form: A   Context: EVAL; lexically bound
 857 Form: B   Context: EVAL; lexically bound
 858 Form: (LIST A B)   Context: EVAL
 859 Form: A   Context: EVAL; lexically bound
 860 Form: B   Context: EVAL; lexically bound
 861 Form: (LABEL-1 1 2)   Context: EVAL
 862 Form: 1   Context: EVAL
 863 Form: 2   Context: EVAL
 864 Form: (FOO 1 2)   Context: EVAL
 865 Form: 'GLOBAL-FOO   Context: EVAL
 866 \(LABELS ((LABEL-1 (A B)
 867            NIL
 868            (LABEL-1 A B)
 869            (LIST A B)))
 870   (LABEL-1 1 2)
 871   (FOO 1 2))")))
 872
 873 (test-util:with-test (:name (:walk macrolet 1))
 874   (assert (string=-modulo-tabspace
 875            (with-output-to-string (*standard-output*)
 876              (take-it-out-for-a-test-walk (macrolet ((macrolet-1 (a b) (list a b)))
 877                                             (macrolet-1 a b)
 878                                             (foo 1 2))))
 879            "Form: (MACROLET ((MACROLET-1 (A B)
 880                    (LIST A B)))
 881         (MACROLET-1 A B)
 882         (FOO 1 2))   Context: EVAL
 883 Form: (LIST A B)   Context: EVAL
 884 Form: A   Context: EVAL; lexically bound
 885 Form: B   Context: EVAL; lexically bound
 886 Form: (MACROLET-1 A B)   Context: EVAL
 887 Form: (A B)   Context: EVAL
 888 Form: B   Context: EVAL
 889 Form: (FOO 1 2)   Context: EVAL
 890 Form: 'GLOBAL-FOO   Context: EVAL
 891 \(MACROLET ((MACROLET-1 (A B)
 892              (LIST A B)))
 893   (MACROLET-1 A B)
 894   (FOO 1 2))")))
 895
 896 (test-util:with-test (:name (:walk macrolet 2))
 897   (assert (string=-modulo-tabspace
 898            (with-output-to-string (*standard-output*)
 899              (take-it-out-for-a-test-walk (macrolet ((foo (a) `(inner-foo-expanded ,a)))
 900                                             (foo 1))))
 901            "Form: (MACROLET ((FOO (A)
 902                    `(INNER-FOO-EXPANDED ,A)))
 903         (FOO 1))   Context: EVAL
 904 Form: `(INNER-FOO-EXPANDED ,A)   Context: EVAL
 905 Form: (LIST 'INNER-FOO-EXPANDED A)   Context: EVAL
 906 Form: 'INNER-FOO-EXPANDED   Context: EVAL
 907 Form: A   Context: EVAL; lexically bound
 908 Form: (FOO 1)   Context: EVAL
 909 Form: (INNER-FOO-EXPANDED 1)   Context: EVAL
 910 Form: 1   Context: EVAL
 911 \(MACROLET ((FOO (A)
 912              `(INNER-FOO-EXPANDED ,A)))
 913   (FOO 1))")))
 914
 915 (test-util:with-test (:name (:walk macrolet progn 1))
 916   (assert (string=-modulo-tabspace
 917            (with-output-to-string (*standard-output*)
 918              (take-it-out-for-a-test-walk (progn (bar 1)
 919                                                  (macrolet ((bar (a)
 920                                                               `(inner-bar-expanded ,a)))
 921                                                    (bar 2)))))
 922            "Form: (PROGN
 923        (BAR 1)
 924        (MACROLET ((BAR (A)
 925                     `(INNER-BAR-EXPANDED ,A)))
 926          (BAR 2)))   Context: EVAL
 927 Form: (BAR 1)   Context: EVAL
 928 Form: 'GLOBAL-BAR   Context: EVAL
 929 Form: (MACROLET ((BAR (A)
 930                    `(INNER-BAR-EXPANDED ,A)))
 931         (BAR 2))   Context: EVAL
 932 Form: `(INNER-BAR-EXPANDED ,A)   Context: EVAL
 933 Form: (LIST 'INNER-BAR-EXPANDED A)   Context: EVAL
 934 Form: 'INNER-BAR-EXPANDED   Context: EVAL
 935 Form: A   Context: EVAL; lexically bound
 936 Form: (BAR 2)   Context: EVAL
 937 Form: (INNER-BAR-EXPANDED 2)   Context: EVAL
 938 Form: 2   Context: EVAL
 939 \(PROGN
 940   (BAR 1)
 941   (MACROLET ((BAR (A)
 942                `(INNER-BAR-EXPANDED ,A)))
 943     (BAR 2)))")))
 944
 945 (test-util:with-test (:name (:walk macrolet progn 2))
 946   (assert (string=-modulo-tabspace
 947            (with-output-to-string (*standard-output*)
 948              (take-it-out-for-a-test-walk (progn (bar 1)
 949                                                  (macrolet ((bar (s)
 950                                                               (bar s)
 951                                                               `(inner-bar-expanded ,s)))
 952                                                    (bar 2)))))
 953            "Form: (PROGN
 954        (BAR 1)
 955        (MACROLET ((BAR (S)
 956                     (BAR S)
 957                     `(INNER-BAR-EXPANDED ,S)))
 958          (BAR 2)))   Context: EVAL
 959 Form: (BAR 1)   Context: EVAL
 960 Form: 'GLOBAL-BAR   Context: EVAL
 961 Form: (MACROLET ((BAR (S)
 962                    (BAR S)
 963                    `(INNER-BAR-EXPANDED ,S)))
 964         (BAR 2))   Context: EVAL
 965 Form: (BAR S)   Context: EVAL
 966 Form: 'GLOBAL-BAR   Context: EVAL
 967 Form: `(INNER-BAR-EXPANDED ,S)   Context: EVAL
 968 Form: (LIST 'INNER-BAR-EXPANDED S)   Context: EVAL
 969 Form: 'INNER-BAR-EXPANDED   Context: EVAL
 970 Form: S   Context: EVAL; lexically bound
 971 Form: (BAR 2)   Context: EVAL
 972 Form: (INNER-BAR-EXPANDED 2)   Context: EVAL
 973 Form: 2   Context: EVAL
 974 \(PROGN
 975   (BAR 1)
 976   (MACROLET ((BAR (S)
 977                (BAR S)
 978                `(INNER-BAR-EXPANDED ,S)))
 979     (BAR 2)))")))
 980
 981 (test-util:with-test (:name (:walk cond))
 982   (assert (string=-modulo-tabspace
 983            (with-output-to-string (*standard-output*)
 984              (take-it-out-for-a-test-walk (cond (a b)
 985                                                 ((foo bar) a (foo a)))))
 986            "Form: (COND (A B) ((FOO BAR) A (FOO A)))   Context: EVAL
 987 Form: (IF A B (IF (FOO BAR) (PROGN A (FOO A)) NIL))   Context: EVAL
 988 Form: A   Context: EVAL
 989 Form: B   Context: EVAL
 990 Form: (IF (FOO BAR) (PROGN A (FOO A)) NIL)   Context: EVAL
 991 Form: (FOO BAR)   Context: EVAL
 992 Form: 'GLOBAL-FOO   Context: EVAL
 993 Form: (PROGN A (FOO A))   Context: EVAL
 994 Form: A   Context: EVAL
 995 Form: (FOO A)   Context: EVAL
 996 Form: 'GLOBAL-FOO   Context: EVAL
 997 Form: NIL   Context: EVAL; bound: NIL
 998 \(COND (A B) ((FOO BAR) A (FOO A)))")))
 999
1000 (test-util:with-test (:name (:walk let lambda))
1001   (assert (string=-modulo-tabspace
1002            (with-output-to-string (*standard-output*)
1003              (let ((the-lexical-variables ()))
1004                (walk-form '(let ((a 1) (b 2))
1005                             (lambda (x) (list a b x y)))
1006                           ()
1007                           (lambda (form context env)
1008                             (declare (ignore context))
1009                             (when (and (symbolp form)
1010                                        (var-lexical-p form env))
1011                               (push form the-lexical-variables))
1012                             form))
1013                (or (and (= (length the-lexical-variables) 3)
1014                         (member 'a the-lexical-variables)
1015                         (member 'b the-lexical-variables)
1016                         (member 'x the-lexical-variables))
1017                    (error "Walker didn't do lexical variables of a closure properly."))))
1018            "")))
1019
1020 (test-util:with-test (:name (:walk setq :macro))
1021   (assert (string=-modulo-tabspace
1022            (with-output-to-string (*standard-output*)
1023              (take-it-out-for-a-test-walk
1024               (macrolet ((x () 'y))
1025                 (setq (x) 3))))
1026            "Form: (MACROLET ((X ()
1027                    'Y))
1028         (SETQ (X) 3))   Context: EVAL
1029 Form: 'Y   Context: EVAL
1030 Form: (SETQ (X) 3)   Context: EVAL
1031 Form: (X)   Context: SET
1032 Form: 3   Context: EVAL
1033 \(MACROLET ((X ()
1034              'Y))
1035   (SETQ (X) 3))"
1036 )))
1037
1038 (test-util:with-test (:name (:walk let* special list :hairier-specials))
1039   (assert
1040    (string=-modulo-tabspace
1041     (with-output-to-string (*standard-output*)
1042       (take-it-out-for-a-test-walk (let* ((a a) (b a) (c b) (b c))
1043                                      (declare (special a b))
1044                                      (list a b c))))
1045     "Form: (LET* ((A A) (B A) (C B) (B C))
1046         (DECLARE (SPECIAL A B))
1047         (LIST A B C))   Context: EVAL
1048 Form: A   Context: EVAL
1049 Form: A   Context: EVAL; lexically bound; declared special
1050 Form: B   Context: EVAL; lexically bound
1051 Form: C   Context: EVAL; lexically bound
1052 Form: (LIST A B C)   Context: EVAL
1053 Form: A   Context: EVAL; lexically bound; declared special
1054 Form: B   Context: EVAL; lexically bound; declared special
1055 Form: C   Context: EVAL; lexically bound
1056 \(LET* ((A A) (B A) (C B) (B C))
1057   (DECLARE (SPECIAL A B))
1058   (LIST A B C))")))
1059 \f
1060 ;;;; more tests
1061
1062 ;;; Old PCL hung up on this.
1063 (defmethod #:foo ()
1064   (defun #:bar ()))
1065 \f