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