diff --git a/ansi-tests/block.lsp b/ansi-tests/block.lsp index 2f61a3457eef34492e37c6a494566d05d0c64490..793010fb0ef1e6e02f1a3a3716d4d0ce97771682 100644 --- a/ansi-tests/block.lsp +++ b/ansi-tests/block.lsp @@ -76,6 +76,13 @@ (return-from done 'good))) good) +;;; Macros are expanded in the appropriate environment + +(deftest block.12 + (macrolet ((%m (z) z)) + (block foo (expand-in-current-env (%m :good)))) + :good) + #| (deftest return.error.1 (signals-error diff --git a/ansi-tests/catch.lsp b/ansi-tests/catch.lsp index 206fb407108e342585884d171593cb1a499c7e1c..8c5ca53595dd3811afb764452629fdbe27da529a 100644 --- a/ansi-tests/catch.lsp +++ b/ansi-tests/catch.lsp @@ -82,6 +82,23 @@ (return-from done 'good))) good) +;;; Macros are expanded in the appropriate environment + +(deftest catch.14 + (macrolet ((%m (z) z)) + (catch 'foo (expand-in-current-env (%m :good)))) + :good) + +(deftest catch.15 + (macrolet ((%m (z) z)) + (catch 'foo (throw (expand-in-current-env (%m 'foo)) :good) :bad)) + :good) + +(deftest catch.16 + (macrolet ((%m (z) z)) + (catch 'foo (throw 'foo (expand-in-current-env (%m :good))) :bad)) + :good) + (deftest throw-error (signals-error (throw (gensym) nil) control-error) t) diff --git a/ansi-tests/eval-when.lsp b/ansi-tests/eval-when.lsp index 03a927e6e8b16c322b8e4e1106a24fd5634014bc..dd3d7e1cf185b03db3335bd6265329447e0e3a5f 100644 --- a/ansi-tests/eval-when.lsp +++ b/ansi-tests/eval-when.lsp @@ -133,3 +133,9 @@ (values (eval-when (eval) (setq x :good)) x)) :good :good) +;;; Macros are expanded in the appropriate environment + +(deftest eval-when.18 + (macrolet ((%m (z) z)) + (eval-when (:execute) (expand-in-current-env (%m :good)))) + :good) diff --git a/ansi-tests/flet.lsp b/ansi-tests/flet.lsp index 036641873c445b57074feb94b2fefbfb4da35f76..3c037227f4b7f76c62271452c4e791d63a700a97 100644 --- a/ansi-tests/flet.lsp +++ b/ansi-tests/flet.lsp @@ -545,3 +545,18 @@ (mapcar (%f 2) '(a b c))))) (1 2 3) (5 7 9)) + +;;; Macros are expanded in the appropriate environment + +(deftest flet.70 + (macrolet ((%m (z) z)) + (flet () (expand-in-current-env (%m :good)))) + :good) + +(deftest flet.71 + (macrolet ((%m (z) z)) + (flet ((%f () (expand-in-current-env (%m :good)))) + (%f))) + :good) + + diff --git a/ansi-tests/if.lsp b/ansi-tests/if.lsp index 764e287c62264ca8ad575faafeed979414383394..b4fe98e56a39cfc092cccc2ae9c455df1fb3af84 100644 --- a/ansi-tests/if.lsp +++ b/ansi-tests/if.lsp @@ -29,6 +29,44 @@ (deftest if.7 (if nil 'a (values))) +;;; Macros are expanded in the appropriate environment + +(deftest if.8 + (macrolet ((%m (z) z)) + (if (expand-in-current-env (%m t)) :good :bad)) + :good) + +(deftest if.9 + (macrolet ((%m (z) z)) + (if (expand-in-current-env (%m nil)) :bad)) + nil) + +(deftest if.10 + (macrolet ((%m (z) z)) + (if (expand-in-current-env (%m t)) :good)) + :good) + +(deftest if.11 + (macrolet ((%m (z) z)) + (if (expand-in-current-env (%m nil)) :bad :good)) + :good) + +(deftest if.12 + (macrolet + ((%m (z) z)) + (flet ((%f (x y) (if x (expand-in-current-env (%m y))))) + (declare (notinline %f)) + (values (%f t :good) (%f nil :bad)))) + :good nil) + +(deftest if.13 + (macrolet + ((%m (z) z)) + (flet ((%f (x y z) (if x y (expand-in-current-env (%m z))))) + (declare (notinline %f)) + (values (%f t :good :bad) (%f nil :bad :good)))) + :good :good) + (deftest if.order.1 (let ((i 0)) (values (if (= (incf i) 1) 't nil) i)) diff --git a/ansi-tests/labels.lsp b/ansi-tests/labels.lsp index f8c0a73c768db82efb43417cdfcbbeeb0197af78..b2020ef480c03f3d92d1c7d6083424368fd47dc4 100644 --- a/ansi-tests/labels.lsp +++ b/ansi-tests/labels.lsp @@ -390,4 +390,17 @@ (labels ((%f () x)) (declare (special x)) (%f)))) - :good) \ No newline at end of file + :good) + +;;; Macros are expanded in the appropriate environment + +(deftest labels.48 + (macrolet ((%m (z) z)) + (labels () (expand-in-current-env (%m :good)))) + :good) + +(deftest labels.49 + (macrolet ((%m (z) z)) + (labels ((%f () (expand-in-current-env (%m :good)))) + (%f))) + :good) diff --git a/ansi-tests/let.lsp b/ansi-tests/let.lsp index 7e4874658aa629982ca1deeec645bbddf91b7521..0121404be4aa37ceb0c3a2db1d15ff11dadddb7e 100644 --- a/ansi-tests/let.lsp +++ b/ansi-tests/let.lsp @@ -156,3 +156,15 @@ unless (eql (eval `(let ((,k :foo)) ,k)) :foo) collect k) nil) + +;;; Macros are expanded in the appropriate environment + +(deftest let.20 + (macrolet ((%m (z) z)) + (let () (expand-in-current-env (%m :good)))) + :good) + +(deftest let.21 + (macrolet ((%m (z) z)) + (let ((x (expand-in-current-env (%m 1)))) (+ x x x))) + 3) diff --git a/ansi-tests/letstar.lsp b/ansi-tests/letstar.lsp index 37eca99979e3f511e2dcbb141df38c028aea2a96..6237731c246994ba51f0cb5ce499dc55561265e6 100644 --- a/ansi-tests/letstar.lsp +++ b/ansi-tests/letstar.lsp @@ -161,3 +161,25 @@ unless (eql (eval `(let* ((,k :foo)) ,k)) :foo) collect k) nil) + +;;; Macros are expanded in the appropriate environment + +(deftest let*.21 + (macrolet ((%m (z) z)) + (let* () (expand-in-current-env (%m :good)))) + :good) + +(deftest let*.22 + (macrolet ((%m (z) z)) + (let* ((x (expand-in-current-env (%m 1)))) (+ x x x))) + 3) + +(deftest let*.23 + (macrolet ((%m (z) z)) + (let* ((x (expand-in-current-env (%m 1))) + (y (expand-in-current-env (%m 2)))) + (+ x y))) + 3) + + + diff --git a/ansi-tests/locally.lsp b/ansi-tests/locally.lsp index bc0c4efa293f637a511e10cc5847ce9b953d8322..7466fc2b41ebd3fe7a7784b903c46b4263d17e99 100644 --- a/ansi-tests/locally.lsp +++ b/ansi-tests/locally.lsp @@ -37,3 +37,10 @@ (deftest locally.7 (locally (declare)) nil) + +;;; Macros are expanded in the appropriate environment + +(deftest locally.8 + (macrolet ((%m (z) z)) + (locally (expand-in-current-env (%m :good)))) + :good) diff --git a/ansi-tests/macrolet.lsp b/ansi-tests/macrolet.lsp index cb1d74ffd1a7e15d1cfe179836db4f0c73c8fd29..f5927d1ae5db012108d85c848731eba3d1402bce 100644 --- a/ansi-tests/macrolet.lsp +++ b/ansi-tests/macrolet.lsp @@ -22,7 +22,6 @@ y z)))) 6 a (6 2) (a 4)) - ;;; Inner definitions shadow outer ones (deftest macrolet.3 (macrolet ((%m (w) `(cadr ,w))) @@ -414,4 +413,12 @@ (%m (t)))))) t) +;;; Macros are expanded in the appropriate environment + +(deftest macrolet.46 + (macrolet ((%m (z) z)) + (macrolet () (expand-in-current-env (%m :good)))) + :good) + + ;;; TODO: more special declarations for other macrolet arguments diff --git a/ansi-tests/multiple-value-call.lsp b/ansi-tests/multiple-value-call.lsp index 0fd0ae5e3ada2cf303fbb4c2ef310dd1fccb1af0..ab374ceef0826f47bbd1713a9ece7cd3877677a8 100644 --- a/ansi-tests/multiple-value-call.lsp +++ b/ansi-tests/multiple-value-call.lsp @@ -16,3 +16,19 @@ (deftest multiple-value-call.3 (multiple-value-call 'list (floor 13 4)) (3 1)) + +;;; Macros are expanded in the appropriate environment + +(deftest multiple-value-call.4 + (macrolet + ((%m (z) z)) + (multiple-value-call (expand-in-current-env (%m #'list)) (values 1 2))) + (1 2)) + +(deftest multiple-value-call.5 + (macrolet + ((%m (z) z)) + (multiple-value-call 'list (expand-in-current-env (%m (values 1 2))))) + (1 2)) + + diff --git a/ansi-tests/multiple-value-prog1.lsp b/ansi-tests/multiple-value-prog1.lsp index 8f4dfb0acc4c037cd4b304f99cbf767b716a9c83..2d57476179dc764ba5d3668c3bed090c9d8917ee 100644 --- a/ansi-tests/multiple-value-prog1.lsp +++ b/ansi-tests/multiple-value-prog1.lsp @@ -83,3 +83,16 @@ (return 'good))) good) +;;; Macros are expanded in the appropriate environment + +(deftest multiple-value-prog1.11 + (macrolet + ((%m (z) z)) + (multiple-value-prog1 (expand-in-current-env (%m :good)))) + :good) + +(deftest multiple-value-prog1.12 + (macrolet + ((%m (z) z)) + (multiple-value-prog1 :good (expand-in-current-env (%m :foo)))) + :good) diff --git a/ansi-tests/places.lsp b/ansi-tests/places.lsp index 06426cd5588e62e19452a174518b0983e9cab730..c9f5e14ec1904d170251ac4070e7a6b28274f494 100644 --- a/ansi-tests/places.lsp +++ b/ansi-tests/places.lsp @@ -238,7 +238,19 @@ (declare (special *x*)) (setq *x* 1)) 1) - + +;;; Test that explicit calls to macroexpand in subforms +;;; are done in the correct environment + +(deftest setq.7 + (macrolet + ((%m (z) z)) + (let ((x nil)) + (values (setq x (expand-in-current-env (%m :good))) + x))) + :good :good) + +;;; Tests of SETF (deftest setf.1 (setf) diff --git a/ansi-tests/progn.lsp b/ansi-tests/progn.lsp index 72965496d41bb98ccb56d67d00375fea12744c85..902fc1030ef6e89cec503d1c71d70bfea93499e9 100644 --- a/ansi-tests/progn.lsp +++ b/ansi-tests/progn.lsp @@ -47,4 +47,21 @@ (return 'bad)) 10 (return 'good))) - good) \ No newline at end of file + good) + +;;; Macros are expanded in the appropriate environment + +(deftest progn.9 + (macrolet + ((%m (z) z)) + (progn (expand-in-current-env (%m :good)))) + :good) + +(deftest progn.10 + (macrolet + ((%m (z) z)) + (progn (expand-in-current-env (%m :bad)) + (expand-in-current-env (%m :good)))) + :good) + + diff --git a/ansi-tests/progv.lsp b/ansi-tests/progv.lsp index ca0e700ecb8f9bc9b87af02644104d85d981fa63..83a53cfe3ed54b9d1a2f06208725b66c9a07c5b4 100644 --- a/ansi-tests/progv.lsp +++ b/ansi-tests/progv.lsp @@ -93,3 +93,43 @@ x (boundp 'y)))) 1 nil) + +;;; Macros are expanded in the appropriate environment + +(deftest progv.13 + (macrolet + ((%m (z) z)) + (progv (expand-in-current-env (%m '(x))) + '(:good) + (locally (declare (special x)) x))) + :good) + +(deftest progv.14 + (macrolet + ((%m (z) z)) + (progv (list (expand-in-current-env (%m 'x))) + '(:good) + (locally (declare (special x)) x))) + :good) + +(deftest progv.15 + (macrolet + ((%m (z) z)) + (progv '(x) + (expand-in-current-env (%m '(:good))) + (locally (declare (special x)) x))) + :good) + +(deftest progv.16 + (macrolet + ((%m (z) z)) + (progv '(x) + (list (expand-in-current-env (%m :good))) + (locally (declare (special x)) x))) + :good) + +(deftest progv.17 + (macrolet + ((%m (z) z)) + (progv nil nil (expand-in-current-env (%m :good)))) + :good) diff --git a/ansi-tests/return-from.lsp b/ansi-tests/return-from.lsp index c90409e3d1ff5b599716fb25f5ea3f90c9c31975..5bf7698b38dbb257e6d84f26ba5a0cc78e97b29f 100644 --- a/ansi-tests/return-from.lsp +++ b/ansi-tests/return-from.lsp @@ -15,4 +15,10 @@ (block nil (return-from nil :good) :bad) :good) +;;; Macros are expanded in the appropriate environment +(deftest return-from.3 + (macrolet + ((%m (z) z)) + (block foo (return-from foo (expand-in-current-env (%m :good))))) + :good) diff --git a/ansi-tests/symbol-macrolet.lsp b/ansi-tests/symbol-macrolet.lsp index 036e24ce77e722ce1e4c0f9c5c3126543eb86d87..9dde62ffd4e011fc1616f73753b0db36cf04b89a 100644 --- a/ansi-tests/symbol-macrolet.lsp +++ b/ansi-tests/symbol-macrolet.lsp @@ -74,3 +74,12 @@ (signals-error (symbol-macrolet ((*pathnames* 19)) *pathnames*) program-error) t) + +;;; Test that explicit calls to macroexpand in subforms +;;; are done in the correct environment + +(deftest symbol-macrolet.9 + (macrolet + ((%m (z) z)) + (symbol-macrolet () (expand-in-current-env (%m :good)))) + :good) diff --git a/ansi-tests/tagbody.lsp b/ansi-tests/tagbody.lsp index 5f43df3e1a19aaa427045c5c6843c477510f0145..cea5ba3de554fc9b9859676e388733bf7b7a20a6 100644 --- a/ansi-tests/tagbody.lsp +++ b/ansi-tests/tagbody.lsp @@ -161,6 +161,7 @@ ;;; Check that macros are not expanded before finding tags ;;; Test for issue TAGBODY-TAG-EXPANSION + (deftest tagbody.17 (block done (tagbody @@ -174,4 +175,11 @@ (return-from done :good))) :good) - +;;; Test that explicit calls to macroexpand in subforms +;;; are done in the correct environment + +(deftest tagbody.18 + (macrolet ((%m (z) z)) + (tagbody + (expand-in-current-env (%m :foo)))) + nil) diff --git a/ansi-tests/the.lsp b/ansi-tests/the.lsp index a62de8b596944f336e644d3043856d68a093594d..a292d08dfab61fe87b6222725ccb2eca41c216fb 100644 --- a/ansi-tests/the.lsp +++ b/ansi-tests/the.lsp @@ -126,4 +126,18 @@ (the (values symbol integer &optional fixnum) (eval '(values 'a 1)))) (a 1)) +;;; Test that explicit calls to macroexpand in subforms +;;; are done in the correct environment + +(deftest the.24 + (macrolet + ((%m (z) z)) + (the (integer 0 10) (expand-in-current-env (%m 4)))) + 4) + +(deftest the.25 + (macrolet + ((%m (z) z)) + (the (values t t) (expand-in-current-env (%m (values 1 2))))) + 1 2) diff --git a/ansi-tests/unwind-protect.lsp b/ansi-tests/unwind-protect.lsp index 359539b819b2747e4f6f136595b2eca5bb44906d..43df795f4aa0e9e66eb7851127c1231bac6c8536 100644 --- a/ansi-tests/unwind-protect.lsp +++ b/ansi-tests/unwind-protect.lsp @@ -113,3 +113,19 @@ x y)) a b c) +;;; Test that explicit calls to macroexpand in subforms +;;; are done in the correct environment + +(deftest unwind-protect.12 + (macrolet + ((%m (z) z)) + (unwind-protect (expand-in-current-env (%m :good)) :bad)) + :good) + +(deftest unwind-protect.13 + (macrolet + ((%m (z) z)) + (unwind-protect :good (expand-in-current-env (%m :bad)))) + :good) + +