contrib/sb-cltl2/tests.lisp

   1 (defpackage :sb-cltl2-tests
   2   (:use :sb-cltl2 :cl :sb-rt))
   3 (in-package :sb-cltl2-tests)
   4
   5 (rem-all-tests)
   6
   7 (defmacro *x*-value ()
   8   (declare (special *x*))
   9   *x*)
  10
  11 (deftest compiler-let.1
  12     (let ((*x* :outer))
  13       (compiler-let ((*x* :inner))
  14         (list *x* (*x*-value))))
  15   (:outer :inner))
  16
  17 (defvar *expansions* nil)
  18 (defmacro macroexpand-macro (arg)
  19   (push arg *expansions*)
  20   arg)
  21
  22 (deftest macroexpand-all.1
  23     (progn
  24       (macroexpand-all '(defmethod foo ((x fixnum)) (1+ x)))
  25       t)
  26   t)
  27
  28 (deftest macroexpand-all.2
  29     (let ((*expansions* nil))
  30       (macroexpand-all '(list (macroexpand-macro 1)
  31                          (let (macroexpand-macro :no)
  32                            (macroexpand-macro 2))))
  33       (remove-duplicates (sort *expansions* #'<)))
  34   (1 2))
  35
  36 (deftest macroexpand-all.3
  37     (let ((*expansions* nil))
  38       (compile nil '(lambda ()
  39                      (macrolet ((foo (key &environment env)
  40                                   (macroexpand-all `(bar ,key) env)))
  41                        (foo
  42                         (macrolet ((bar (key)
  43                                      (push key *expansions*)
  44                                      key))
  45                           (foo 1))))))
  46       (remove-duplicates *expansions*))
  47   (1))
  48
  49 (defun smv (env)
  50   (multiple-value-bind (expansion macro-p)
  51       (macroexpand 'srlt env)
  52     (when macro-p (eval expansion))))
  53 (defmacro testr (&environment env)
  54   `',(getf (smv env) nil))
  55
  56 (deftest macroexpand-all.4
  57     (macroexpand-all '(symbol-macrolet ((srlt '(nil zool))) (testr)))
  58   (symbol-macrolet ((srlt '(nil zool))) 'zool))