contrib/sb-cltl2/tests.lisp

   1 ;;;; This software is part of the SBCL system. See the README file for
   2 ;;;; more information.
   3 ;;;;
   4 ;;;; The software is in the public domain and is provided with
   5 ;;;; absolutely no warranty. See the COPYING and CREDITS files for
   6 ;;;; more information.
   7
   8 (defpackage :sb-cltl2-tests
   9   (:use :sb-cltl2 :cl :sb-rt :sb-ext :sb-kernel :sb-int))
  10
  11 (in-package :sb-cltl2-tests)
  12
  13 (rem-all-tests)
  14
  15 (defmacro *x*-value ()
  16   (declare (special *x*))
  17   *x*)
  18
  19 (deftest compiler-let.1
  20     (let ((*x* :outer))
  21       (compiler-let ((*x* :inner))
  22         (list *x* (*x*-value))))
  23   ;; See the X3J13 writeup for why the interpreter
  24   ;; might return (and does return) a different answer.
  25   #.(if (eq sb-ext:*evaluator-mode* :compile)
  26         '(:outer :inner)
  27         '(:inner :inner)))
  28
  29 (defvar *expansions* nil)
  30 (defmacro macroexpand-macro (arg)
  31   (push arg *expansions*)
  32   arg)
  33
  34 (deftest macroexpand-all.1
  35     (progn
  36       (macroexpand-all '(defmethod foo ((x fixnum)) (1+ x)))
  37       t)
  38   t)
  39
  40 (deftest macroexpand-all.2
  41     (let ((*expansions* nil))
  42       (macroexpand-all '(list (macroexpand-macro 1)
  43                          (let (macroexpand-macro :no)
  44                            (macroexpand-macro 2))))
  45       (remove-duplicates (sort *expansions* #'<)))
  46   (1 2))
  47
  48 (deftest macroexpand-all.3
  49     (let ((*expansions* nil))
  50       (compile nil '(lambda ()
  51                      (declare (muffle-conditions style-warning))
  52                      (macrolet ((foo (key &environment env)
  53                                   (macroexpand-all `(bar ,key) env)))
  54                        (foo
  55                         (macrolet ((bar (key)
  56                                      (push key *expansions*)
  57                                      key))
  58                           (foo 1))))))
  59       (remove-duplicates *expansions*))
  60   (1))
  61
  62 (defun smv (env)
  63   (multiple-value-bind (expansion macro-p)
  64       (macroexpand 'srlt env)
  65     (when macro-p (eval expansion))))
  66 (defmacro testr (&environment env)
  67   `',(getf (smv env) nil))
  68
  69 (deftest macroexpand-all.4
  70     (macroexpand-all '(symbol-macrolet ((srlt '(nil zool))) (testr)))
  71   (symbol-macrolet ((srlt '(nil zool))) 'zool))
  72
  73 ;; Quasiquotation
  74 (deftest macroexpand-all.5
  75     ;; The second use of (W) is expanded to X, the first is untouched.
  76     ;; Use EQUALP explicitly because the RT tester's EQUALP-WITH-CASE
  77     ;; is not quite EQUALP with regard to structures.
  78     (equalp (macroexpand-all '(macrolet ((w () 'x))
  79                `(let ((y `(z ,(w) ,,(w)))) (g))))
  80             '(macrolet ((w () 'x)) `(let ((y `(z ,(w) ,,x))) (g))))
  81   t)
  82
  83 (deftest macroexpand-all.6
  84     ;; The subform (AND Z) in (PROGN `(F ,(WHEN X Y) . `(,B ,,(AND Z))))
  85     ;; is evaluable though unlikely to appear in real code. Unless F is a
  86     ;; macro, this form when evaluated does not comprise a well-formed sexpr.
  87     (equalp (macroexpand-all '(progn `(f ,(when x y) . `(,b ,,(and z)))))
  88             '(progn `(f ,(if x y) . `(,b ,,(the t z)))))
  89   t)
  90
  91 ;;; Symbol macros
  92 (define-symbol-macro global-symbol-macro xxx)
  93
  94 (deftest macroexpand-all.7
  95     (equalp (macroexpand-all 'global-symbol-macro) 'xxx)
  96   t)
  97 (deftest macroexpand-all.8
  98     (symbol-macrolet ((global-symbol-macro yyy))
  99       (macrolet ((frob (&environment env form)
 100                    `',(macroexpand-all form env)))
 101         (equalp (frob global-symbol-macro) 'yyy)))
 102   t)
 103 (deftest macroexpand-all.9
 104     (let ((global-symbol-macro 3))
 105       (macrolet ((frob (&environment env form)
 106                    `',(macroexpand-all form env)))
 107         (equalp (frob global-symbol-macro) 'global-symbol-macro)))
 108   t)
 109 (deftest macroexpand-all.10
 110     (macrolet ((frob (&environment env form)
 111                  `',(macroexpand-all form env)))
 112       (equalp (frob (let ((anything 1)) global-symbol-macro))
 113               '(let ((anything 1)) xxx)))
 114   t)
 115 (deftest macroexpand-all.11
 116     (macrolet ((frob (&environment env form)
 117                  `',(macroexpand-all form env)))
 118       (equalp (frob (let ((global-symbol-macro global-symbol-macro))
 119                       global-symbol-macro))
 120               '(let ((global-symbol-macro xxx)) global-symbol-macro)))
 121   t)
 122 (deftest macroexpand-all.12
 123     (macrolet ((frob (&environment env form)
 124                  `',(macroexpand-all form env)))
 125       (equalp (frob (symbol-macrolet ((global-symbol-macro 3))
 126                       global-symbol-macro))
 127               '(symbol-macrolet ((global-symbol-macro 3)) 3)))
 128   t)
 129 (deftest macroexpand-all.13
 130     (symbol-macrolet ((x y))
 131       (macrolet ((frob (&environment env form)
 132                    `',(macroexpand-all form env)))
 133         (equalp (frob (+ x x))
 134                 '(+ y y))))
 135   t)
 136 ;;;; DECLARATION-INFORMATION
 137
 138 (defmacro dinfo (thing &environment env)
 139   `',(declaration-information thing env))
 140
 141 (macrolet ((def (x)
 142                `(macrolet ((frob (suffix answer &optional declaration)
 143                             `(deftest ,(intern (concatenate 'string
 144                                                             "DECLARATION-INFORMATION."
 145                                                             (symbol-name ',x)
 146                                                             suffix))
 147                                (locally (declare ,@(when declaration
 148                                                          (list declaration)))
 149                                  (cadr (assoc ',',x (dinfo optimize))))
 150                               ,answer)))
 151                  (frob ".DEFAULT" 1)
 152                  (frob ".0" 0 (optimize (,x 0)))
 153                  (frob ".1" 1 (optimize (,x 1)))
 154                  (frob ".2" 2 (optimize (,x 2)))
 155                  (frob ".3" 3 (optimize (,x 3)))
 156                  (frob ".IMPLICIT" 3 (optimize ,x)))))
 157   (def speed)
 158   (def safety)
 159   (def debug)
 160   (def compilation-speed)
 161   (def space))
 162
 163
 164 (deftest declaration-information.restrict-compiler-policy.1
 165     (with-compilation-unit (:policy '(optimize) :override t)
 166       (restrict-compiler-policy 'speed 3)
 167       (eval '(cadr (assoc 'speed (dinfo optimize)))))
 168   3)
 169
 170 ;; This usage is esoteric, and the expected answer differs based on whether the
 171 ;; code is interpreted or compiled. Compiling RESTRICT-COMPILER-POLICY doesn't
 172 ;; actually do anything to affect the compiler since it is not a toplevel form
 173 ;; in an eval-when. (I suspect that it wouldn't normally be used this way)
 174 ;; But the interpreter calls it, which has an immediate visible effect.
 175 (deftest declaration-information.restrict-compiler-policy.2
 176     (with-compilation-unit (:policy '(optimize) :override t)
 177       (restrict-compiler-policy 'speed 3)
 178       (locally (declare (optimize (speed 2)))
 179         (cadr (assoc 'speed (dinfo optimize)))))
 180   ;; sb-rt doesn't eval the "expected result" form.
 181   #.(if (eq sb-ext:*evaluator-mode* :compile) 2 3))
 182
 183 (deftest declaration-information.restrict-compiler-policy.3
 184     (locally (declare (optimize (speed 2)))
 185       (with-compilation-unit (:policy '(optimize) :override t)
 186         (restrict-compiler-policy 'speed 3)
 187         (cadr (assoc 'speed (dinfo optimize)))))
 188   #.(if (eq sb-ext:*evaluator-mode* :compile) 2 3))
 189
 190 (deftest declaration-information.muffle-conditions.default
 191   (dinfo sb-ext:muffle-conditions)
 192   nil)
 193 (deftest declaration-information.muffle-conditions.1
 194   (locally (declare (sb-ext:muffle-conditions warning))
 195     (dinfo sb-ext:muffle-conditions))
 196   warning)
 197 (deftest declaration-information.muffle-conditions.2
 198   (let ((junk (dinfo sb-ext:muffle-conditions)))
 199     (declare (sb-ext:muffle-conditions warning))
 200     (locally (declare (sb-ext:unmuffle-conditions style-warning))
 201       (let ((dinfo (dinfo sb-ext:muffle-conditions)))
 202         (not
 203          (not
 204           (and (subtypep dinfo `(or (and warning (not style-warning))
 205                                     (and ,junk (not style-warning))))
 206                (subtypep '(and warning (not style-warning)) dinfo)))))))
 207   t)
 208
 209
 210 (declaim (declaration fubar))
 211
 212 (deftest declaration-information.declaration
 213     (if (member 'fubar (declaration-information 'declaration)) 'yay)
 214   yay)
 215
 216 ;;;; VARIABLE-INFORMATION
 217
 218 (defvar *foo*)
 219
 220 (defmacro var-info (var &environment env)
 221   (list 'quote (multiple-value-list (variable-information var env))))
 222
 223 (deftest variable-info.global-special/unbound
 224     (var-info *foo*)
 225   (:special nil nil))
 226
 227 (defvar *variable-info.global-special/unbound.deprecation*)
 228 (declaim (sb-ext:deprecated :early ("SBCL" "1.2.3")
 229           (variable *variable-info.global-special/unbound.deprecation* :replacement foo)))
 230 (deftest variable-info.global-special/unbound.deprecation
 231     (var-info *variable-info.global-special/unbound.deprecation*)
 232   (:special nil ((sb-ext:deprecated . (:state        :early
 233                                        :since        ("SBCL" "1.2.3")
 234                                        :replacements (foo))))))
 235
 236 (deftest variable-info.global-special/unbound/extra-decl
 237     (locally (declare (special *foo*))
 238       (var-info *foo*))
 239   (:special nil nil))
 240
 241 (deftest variable-info.global-special/bound
 242     (let ((*foo* t))
 243       (var-info *foo*))
 244   (:special nil nil))
 245
 246 (deftest variable-info.global-special/bound/extra-decl
 247     (let ((*foo* t))
 248       (declare (special *foo*))
 249       (var-info *foo*))
 250   (:special nil nil))
 251
 252 (deftest variable-info.local-special/unbound
 253     (locally (declare (special x))
 254       (var-info x))
 255   (:special nil nil))
 256
 257 (deftest variable-info.local-special/bound
 258     (let ((x 13))
 259       (declare (special x))
 260       (var-info x))
 261   (:special nil nil))
 262
 263 (deftest variable-info.local-special/shadowed
 264     (let ((x 3))
 265       (declare (special x))
 266       x
 267       (let ((x 3))
 268         x
 269         (var-info x)))
 270   (:lexical t nil))
 271
 272 (deftest variable-info.local-special/shadows-lexical
 273     (let ((x 3))
 274       (let ((x 3))
 275         (declare (special x))
 276         (var-info x)))
 277   (:special nil nil))
 278
 279 (deftest variable-info.lexical
 280     (let ((x 8))
 281       (var-info x))
 282   (:lexical t nil))
 283
 284 (deftest variable-info.lexical.type
 285     (let ((x 42))
 286       (declare (fixnum x))
 287       (var-info x))
 288   (:lexical t ((type . fixnum))))
 289
 290 (deftest variable-info.lexical.type.2
 291     (let ((x 42))
 292       (prog1
 293           (var-info x)
 294         (locally (declare (fixnum x))
 295           (assert (plusp x)))))
 296   (:lexical t nil))
 297
 298 (deftest variable-info.lexical.type.3
 299     (let ((x 42))
 300       (locally (declare (fixnum x))
 301         (var-info x)))
 302   (:lexical t ((type . fixnum))))
 303
 304 (deftest variable-info.ignore
 305     (let ((x 8))
 306       (declare (ignore x))
 307       (var-info x))
 308   (:lexical t ((ignore . t))))
 309
 310 (deftest variable-info.symbol-macro/local
 311     (symbol-macrolet ((x 8))
 312       (var-info x))
 313   (:symbol-macro t nil))
 314
 315 (define-symbol-macro my-symbol-macro t)
 316
 317 (deftest variable-info.symbol-macro/global
 318     (var-info my-symbol-macro)
 319   (:symbol-macro nil nil))
 320
 321 (deftest variable-info.undefined
 322     (var-info #:undefined)
 323   (nil nil nil))
 324
 325 (declaim (sb-ext:deprecated :early ("SBCL" "1.2.3")
 326           (variable *variable-info.undefined.deprecation* :replacement foo)))
 327 (deftest variable-info.undefined.deprecation
 328     (var-info *variable-info.undefined.deprecation*)
 329   (nil nil ((sb-ext:deprecated . (:state        :early
 330                                   :since        ("SBCL" "1.2.3")
 331                                   :replacements (foo))))))
 332
 333 (declaim (global this-is-global))
 334 (deftest global-variable
 335     (var-info this-is-global)
 336   (:global nil nil))
 337
 338 (defglobal this-is-global-too 42)
 339 (deftest global-variable.2
 340     (var-info this-is-global-too)
 341   (:global nil ((always-bound . t))))
 342
 343 (sb-alien:define-alien-variable "errno" sb-alien:int)
 344 (deftest alien-variable
 345     (var-info errno)
 346   (:alien nil nil))
 347
 348 (defglobal *variable-info.global.deprecation* 1)
 349 (declaim (sb-ext:deprecated :early ("SBCL" "1.2.3")
 350           (variable *variable-info.global.deprecation* :replacement foo)))
 351 (deftest variable-info.global.deprecation
 352     (var-info *variable-info.global.deprecation*)
 353   (:global nil ((always-bound . t)
 354                 (sb-ext:deprecated . (:state        :early
 355                                       :since        ("SBCL" "1.2.3")
 356                                       :replacements (foo))))))
 357
 358 ;;;; FUNCTION-INFORMATION
 359
 360 (defmacro fun-info (var &environment env)
 361   (list 'quote (multiple-value-list (function-information var env))))
 362
 363 (defun my-global-fun (x) x)
 364
 365 (deftest function-info.global/no-ftype
 366     (fun-info my-global-fun)
 367   (:function nil nil))
 368
 369 (declaim (ftype (function (cons) (values t &optional)) my-global-fun-2))
 370
 371 (defun my-global-fun-2 (x) x)
 372
 373 (deftest function-info.global/ftype
 374     (fun-info my-global-fun-2)
 375   (:function nil ((ftype . (function (cons) (values t &optional))))))
 376
 377 (defun function-info.global.deprecation ())
 378 (declaim (sb-ext:deprecated :early "1.2.3"
 379           (function function-info.global.deprecation :replacement foo)))
 380 (deftest function-info.global.deprecation
 381     (fun-info function-info.global.deprecation)
 382   (:function nil ((sb-ext:deprecated . (:state        :early
 383                                         :since        (nil "1.2.3")
 384                                         :replacements (foo))))))
 385
 386 (deftest function-info.global.deprecation.lexically-shadowed
 387     (flet ((function-info.global.deprecation ()))
 388       (fun-info function-info.global.deprecation))
 389   (:function t nil))
 390
 391 (defmacro my-macro (x) x)
 392
 393 (deftest function-info.macro
 394     (fun-info my-macro)
 395   (:macro nil nil))
 396
 397 (deftest function-info.macrolet
 398     (macrolet ((thingy () nil))
 399       (fun-info thingy))
 400   (:macro t nil))
 401
 402 (deftest function-info.special-form
 403     (fun-info progn)
 404   (:special-form  nil nil))
 405
 406 (deftest function-info.notinline/local
 407     (flet ((x (y) y))
 408       (declare (notinline x))
 409       (x 1)
 410       (fun-info x))
 411   (:function t ((inline . notinline))))
 412
 413 (declaim (notinline my-notinline))
 414 (defun my-notinline (x) x)
 415
 416 (deftest function-info.notinline/global
 417     (fun-info my-notinline)
 418   (:function nil ((inline . notinline))))
 419
 420 (declaim (inline my-inline))
 421 (defun my-inline (x) x)
 422
 423 (deftest function-info.inline/global
 424     (fun-info my-inline)
 425   (:function nil ((inline . inline))))
 426
 427 (deftest function-information.known-inline
 428     (locally (declare (inline identity))
 429       (fun-info identity))
 430   (:function nil ((inline . inline)
 431                   (ftype function (t) (values t &optional)))))
 432
 433 (deftest function-information.ftype
 434     (flet ((foo (x) x))
 435       (declare (ftype (sfunction (integer) integer) foo))
 436       (fun-info foo))
 437   (:function
 438    t
 439    ((ftype function (integer) (values integer &optional)))))
 440
 441 ;;;;; AUGMENT-ENVIRONMENT
 442
 443 (defmacro ct (form &environment env)
 444   (let ((toeval `(let ((lexenv (quote ,env)))
 445                    ,form)))
 446     `(quote ,(eval toeval))))
 447
 448
 449 (deftest augment-environment.variable1
 450     (multiple-value-bind (kind local alist)
 451         (variable-information
 452          'x
 453          (augment-environment nil :variable (list 'x) :declare '((type integer x))))
 454       (list kind local (cdr (assoc 'type alist))))
 455   (:lexical t integer))
 456
 457 (defvar *foo*)
 458
 459 (deftest augment-environment.variable2
 460     (identity (variable-information '*foo* (augment-environment nil :variable '(*foo*))))
 461   :lexical)
 462
 463 (deftest augment-environment.variable3
 464     (identity (variable-information 'foo (augment-environment nil :variable '(foo))))
 465   :lexical)
 466
 467 (deftest augment-environment.variable.special1
 468     (identity (variable-information 'x (augment-environment nil :variable '(x) :declare '((special x)))))
 469   :special)
 470
 471 (deftest augment-environment.variable.special12
 472     (locally (declare (special x))
 473       (ct
 474        (variable-information
 475         'x
 476         (identity (augment-environment lexenv :variable '(x))))))
 477   :lexical)
 478
 479 (deftest augment-environment.variable.special13
 480     (let* ((e1 (augment-environment nil :variable '(x) :declare '((special x))))
 481            (e2 (augment-environment e1  :variable '(x))))
 482       (identity (variable-information 'x e2)))
 483   :lexical)
 484
 485 (deftest augment-environment.variable.special.mask
 486     (let* ((e1 (augment-environment nil :variable '(x) :declare '((ignore x))))
 487            (e2 (augment-environment e1  :variable '(x))))
 488       (assoc 'ignore
 489              (nth 2 (multiple-value-list
 490                      (variable-information 'x e2)))))
 491   nil)
 492
 493 (deftest augment-environment.variable.ignore
 494     (variable-information
 495      'x
 496      (augment-environment nil
 497                           :variable '(x)
 498                           :declare  '((ignore x))))
 499   :lexical
 500   t
 501   ((ignore . t)))
 502
 503 (deftest augment-environment.function
 504     (function-information
 505      'foo
 506      (augment-environment nil
 507                           :function '(foo)
 508                           :declare  '((ftype (sfunction (integer) integer) foo))))
 509   :function
 510   t
 511   ((ftype function (integer) (values integer &optional))))
 512
 513
 514 (deftest augment-environment.macro
 515     (macroexpand '(mac feh)
 516                  (augment-environment
 517                   nil
 518                   :macro (list (list 'mac #'(lambda (form benv)
 519                                               (declare (ignore env))
 520                                               `(quote ,form ,form ,form))))))
 521   (quote (mac feh) (mac feh) (mac feh))
 522   t)
 523
 524 (deftest augment-environment.symbol-macro
 525     (macroexpand 'sym
 526                  (augment-environment
 527                   nil
 528                   :symbol-macro (list (list 'sym '(foo bar baz)))))
 529   (foo bar baz)
 530   t)
 531
 532 (deftest augment-environment.macro2
 533     (eval (macroexpand '(newcond
 534                          ((= 1 2) 'foo)
 535                          ((= 1 1) 'bar))
 536                        (augment-environment nil :macro (list (list 'newcond (macro-function 'cond))))))
 537   bar)
 538
 539
 540 (deftest augment-environment.nest
 541     (let ((x 1))
 542       (ct
 543        (let* ((e (augment-environment lexenv :variable '(y))))
 544          (list
 545           (variable-information 'x e)
 546           (variable-information 'y e)))))
 547   (:lexical :lexical))
 548
 549 (deftest augment-environment.nest2
 550     (symbol-macrolet ((x "x"))
 551       (ct
 552        (let* ((e (augment-environment lexenv :variable '(y))))
 553          (list
 554           (macroexpand 'x e)
 555           (variable-information 'y e)))))
 556   ("x" :lexical))
 557
 558 (deftest augment-environment.symbol-macro-var
 559     (let ((e (augment-environment
 560               nil
 561               :symbol-macro (list (list 'sym '(foo bar baz)))
 562               :variable '(x))))
 563       (list (macroexpand 'sym e)
 564             (variable-information 'x e)))
 565   ((foo bar baz)
 566    :lexical))
 567
 568 ;;;;; DEFINE-DECLARATION
 569
 570 (defmacro third-value (form)
 571   (sb-int::with-unique-names (a b c)
 572     `(multiple-value-bind (,a ,b ,c) ,form
 573        (declare (ignore ,a ,b))
 574        ,c)))
 575
 576 (deftest define-declaration.declare
 577     (progn
 578       (define-declaration zaphod (spec env)
 579         (declare (ignore env))
 580         (values :declare (cons 'zaphod spec)))
 581       (locally (declare (zaphod beblebrox))
 582          (locally (declare (zaphod and ford))
 583            (ct (declaration-information 'zaphod lexenv)))))
 584   (zaphod and ford))
 585
 586
 587 (deftest define-declaration.declare2
 588     (progn
 589       (define-declaration zaphod (spec env)
 590         (declare (ignore env))
 591         (values :declare (cons 'zaphod spec)))
 592       (locally
 593            (declare (zaphod beblebrox)
 594                     (special x))
 595          (ct (declaration-information 'zaphod lexenv))))
 596   (zaphod beblebrox))
 597
 598 (deftest define-declaration.variable
 599     (progn
 600       (define-declaration vogon (spec env)
 601         (declare (ignore env))
 602         (values :variable `((,(cadr spec) vogon-key vogon-value))))
 603       (locally (declare (vogon poetry))
 604         (ct
 605          (assoc 'vogon-key
 606                 (third-value
 607                  (variable-information
 608                   'poetry
 609                   lexenv))))))
 610   (vogon-key . vogon-value))
 611
 612
 613 (deftest define-declaration.variable.special
 614     (progn
 615       (define-declaration vogon (spec env)
 616         (declare (ignore env))
 617         (values :variable `((,(cadr spec) vogon-key vogon-value))))
 618       (let (x)
 619         (declare (vogon x))
 620         (declare (special x))
 621         (ct
 622          (assoc 'vogon-key
 623                 (third-value
 624                  (variable-information 'x lexenv))))))
 625   (vogon-key . vogon-value))
 626
 627 (deftest define-declaration.variable.special2
 628     (progn
 629       (define-declaration vogon (spec env)
 630         (declare (ignore env))
 631         (values :variable `((,(cadr spec) vogon-key vogon-value))))
 632       (let (x)
 633         (declare (special x))
 634         (declare (vogon x))
 635         (ct
 636          (assoc 'vogon-key
 637                 (third-value
 638                  (variable-information 'x lexenv))))))
 639   (vogon-key . vogon-value))
 640
 641 (deftest define-declaration.variable.mask
 642     (progn
 643       (define-declaration vogon (spec env)
 644         (declare (ignore env))
 645         (values :variable `((,(cadr spec) vogon-key vogon-value))))
 646       (let (x)
 647         (declare (vogon x))
 648         (let (x)
 649           (ct
 650            (assoc
 651             'vogon-key
 652             (third (multiple-value-list (variable-information 'x lexenv))))))))
 653   nil)
 654
 655 (deftest define-declaration.variable.macromask
 656     (progn
 657       (define-declaration vogon (spec env)
 658         (declare (ignore env))
 659         (values :variable `((,(cadr spec) vogon-key vogon-value))))
 660       (let (x)
 661         (declare (vogon x))
 662         (symbol-macrolet ((x 42))
 663           (ct
 664            (assoc
 665             'vogon-key
 666             (third (multiple-value-list (variable-information 'x lexenv))))))))
 667   nil)
 668
 669 (deftest define-declaration.variable.macromask2
 670     (progn
 671       (define-declaration vogon (spec env)
 672         (declare (ignore env))
 673         (values :variable `((,(cadr spec) vogon-key vogon-value))))
 674       (symbol-macrolet ((x 42))
 675         (declare (vogon x))
 676         (list
 677          (let (x)
 678            (ct
 679             (assoc
 680              'vogon-key
 681              (third (multiple-value-list (variable-information 'x lexenv))))))
 682          (ct
 683           (assoc
 684            'vogon-key
 685            (third (multiple-value-list (variable-information 'x lexenv))))))))
 686   (nil (vogon-key . vogon-value)))
 687
 688 (deftest define-declaration.variable.mask2
 689     (progn
 690       (define-declaration vogon-a (spec env)
 691         (declare (ignore env))
 692         (values :variable `((,(cadr spec) vogon-key a))))
 693       (define-declaration vogon-b (spec env)
 694         (declare (ignore env))
 695         (values :variable `((,(cadr spec) vogon-key b))))
 696       (let (x)
 697         (declare (vogon-a x))
 698         (let (x)
 699           (declare (vogon-b x)))
 700         (ct
 701          (assoc
 702           'vogon-key
 703           (third (multiple-value-list (variable-information 'x lexenv)))))))
 704   (vogon-key . a))
 705
 706 (deftest define-declaration.variable.specialmask
 707     (progn
 708       (define-declaration vogon (spec env)
 709         (declare (ignore env))
 710         (values :variable `((,(cadr spec) vogon-key vogon-value))))
 711       (locally
 712           (declare (vogon *foo*))
 713         (let (*foo*)
 714           (ct
 715            (assoc
 716             'vogon-key
 717             (third (multiple-value-list (variable-information '*foo* lexenv))))))))
 718   (vogon-key . vogon-value))
 719
 720
 721
 722 (deftest define-declaration.function
 723     (progn
 724       (define-declaration sad (spec env)
 725         (declare (ignore env))
 726         (values :function `((,(cadr spec) emotional-state sad))))
 727       (locally (declare (zaphod beblebrox))
 728         (locally (declare (sad robot))
 729           (ct
 730            (assoc 'emotional-state
 731                   (third-value (function-information
 732                                 'robot
 733                                 lexenv)))))))
 734   (emotional-state . sad))
 735
 736 (deftest define-declaration.function.lexical
 737     (progn
 738       (define-declaration sad (spec env)
 739         (declare (ignore env))
 740         (values :function `((,(cadr spec) emotional-state sad))))
 741       (flet ((robot nil))
 742         (locally (declare (sad robot))
 743           (ct
 744            (assoc 'emotional-state
 745                   (third-value (function-information
 746                                 'robot
 747                                 lexenv)))))))
 748   (emotional-state . sad))
 749
 750
 751 (deftest define-declaration.function.lexical2
 752     (progn
 753       (define-declaration sad (spec env)
 754         (declare (ignore env))
 755         (values :function `((,(cadr spec) emotional-state sad))))
 756       (labels ((robot nil))
 757         (declare (sad robot))
 758         (ct
 759          (assoc 'emotional-state
 760                 (third-value (function-information
 761                               'robot
 762                               lexenv))))))
 763   (emotional-state . sad))
 764
 765 (deftest define-declaration.function.mask
 766     (progn
 767       (define-declaration sad (spec env)
 768         (declare (ignore env))
 769         (values :function `((,(cadr spec) emotional-state sad))))
 770       (labels ((robot nil))
 771         (declare (sad robot))
 772         (labels ((robot nil))
 773           (ct
 774            (assoc 'emotional-state
 775                   (third-value (function-information
 776                                 'robot
 777                                 lexenv)))))))
 778   nil)
 779
 780
 781 (deftest define-declaration.function.mask2
 782     (progn
 783       (define-declaration sad (spec env)
 784         (declare (ignore env))
 785         (values :function `((,(cadr spec) emotional-state sad))))
 786       (locally
 787           (declare (sad robot))
 788         (labels ((robot nil))
 789           (ct
 790            (assoc 'emotional-state
 791                   (third-value (function-information
 792                                 'robot
 793                                 lexenv)))))))
 794   nil)
 795
 796 (deftest define-declaration.function2
 797     (progn
 798       (define-declaration happy (spec env)
 799         (declare (ignore env))
 800         (values :function `((,(cadr spec) emotional-state happy))))
 801       (locally (declare (zaphod beblebrox))
 802         (locally (declare (sad robot))
 803           (locally (declare (happy robot))
 804             (ct
 805              (assoc 'emotional-state
 806                     (third-value (function-information
 807                                   'robot
 808                                   lexenv))))))))
 809   (emotional-state . happy))
 810
 811 (deftest macroexpand-all.special-binding
 812     (let ((form '(macrolet ((v (x &environment env)
 813                              (sb-cltl2:variable-information x env)))
 814                   (let* ((x :foo)
 815                          (y (v x)))
 816                     (declare (special x))
 817                     (list y (v x))))))
 818       (list (eval form)
 819             (eval (sb-cltl2:macroexpand-all form))))
 820   ((:special :special) (:special :special)))
 821
 822 (deftest macroexpand-all.symbol-macro-shadowed
 823     (let ((form '(macrolet ((v (x &environment env)
 824                              (macroexpand x env)))
 825                   (symbol-macrolet ((x :bad))
 826                     (let* ((x :good)
 827                            (y (v x)))
 828                       y)))))
 829       (list (eval form)
 830             (eval (sb-cltl2:macroexpand-all form))))
 831   (:good :good))