diff --git a/ansi-tests/and.lsp b/ansi-tests/and.lsp index 290007e6d003de33b7245da64905dd9d2df25b9d..6924d211f3f460319ebd5e56664ea233357fb6b2 100644 --- a/ansi-tests/and.lsp +++ b/ansi-tests/and.lsp @@ -39,6 +39,19 @@ (and (values nil t) t) nil) +;;; Test that explicit calls to macroexpand in subforms +;;; are done in the correct environment + +(deftest and.10 + (macrolet + ((%m (z) z)) + (and (expand-in-current-env (%m :a)) + (expand-in-current-env (%m :b)) + (expand-in-current-env (%m :c)))) + :c) + +;;; Error tests + (deftest and.order.1 (let ((x 0)) (values (and nil (incf x)) diff --git a/ansi-tests/ansi-aux.lsp b/ansi-tests/ansi-aux.lsp index 18f0a9dc521d6800cb39a6c8c480e9c3a265d11d..2da83c5b9dfb6e4c55eb48a575bec0c845a960ae 100644 --- a/ansi-tests/ansi-aux.lsp +++ b/ansi-tests/ansi-aux.lsp @@ -1177,3 +1177,11 @@ the condition to go uncaught if it cannot be classified." ,form)) (eq (%f) (%f))) nil)) + +;;; Macro used in tests of environments in system macros +;;; This was inspired by a bug in ACL 8.0 beta where CONSTANTP +;;; was being called in some system macros without the proper +;;; environment argument + +(defmacro expand-in-current-env (macro-form &environment env) + (macroexpand macro-form env)) diff --git a/ansi-tests/assert.lsp b/ansi-tests/assert.lsp index 4d90b0a556b3a7fbb74241dcbcc919551d7e4907..706447bb67c5442f7b2ce1ea7bb4fd7845f6e4ce 100644 --- a/ansi-tests/assert.lsp +++ b/ansi-tests/assert.lsp @@ -88,3 +88,18 @@ (assert (> x 5) () 'type-error) x)) 6) + +;;; Test that explicit calls to macroexpand in subforms +;;; are done in the correct environment + +(deftest assert.10 + (macrolet + ((%m (z) z)) + (assert (expand-in-current-env (%m t)))) + nil) + +(deftest assert.11 + (macrolet + ((%m (z) z)) + (assert (expand-in-current-env (%m t)) () "Foo!")) + nil) diff --git a/ansi-tests/case.lsp b/ansi-tests/case.lsp index 8570c49ffabd18de7576c69c425ec0bdf147aa1a..8b24d08f2d13afe97972fd4faf7a21c1b703d231 100644 --- a/ansi-tests/case.lsp +++ b/ansi-tests/case.lsp @@ -189,7 +189,18 @@ (return-from done 'good))) good) - +;;; Test that explicit calls to macroexpand in subforms +;;; are done in the correct environment + +(deftest case.37 + (macrolet + ((%m (z) z)) + (case (expand-in-current-env (%m :b)) + (:a :bad1) + (:b :good) + (:c :bad2) + (t :bad3))) + :good) ;;; (deftest case.error.1 ;;; (signals-error (case) program-error) diff --git a/ansi-tests/ccase.lsp b/ansi-tests/ccase.lsp index 24e75d7817aab340ef486cbc9800ec0a83c2a55c..68710519db517cc64c273995a94f81285f83492f 100644 --- a/ansi-tests/ccase.lsp +++ b/ansi-tests/ccase.lsp @@ -174,6 +174,20 @@ (return-from done 'good))) good) +;;; Test that explicit calls to macroexpand in subforms +;;; are done in the correct environment + +(deftest ccase.33 + (let ((x :b)) + (macrolet + ((%m (z) z)) + (ccase (expand-in-current-env (%m x)) + (:a :bad1) + (:b :good) + (:c :bad2)))) + :good) + + ;;; (deftest ccase.error.1 ;;; (signals-error (ccase) program-error) diff --git a/ansi-tests/check-type.lsp b/ansi-tests/check-type.lsp index 4b448594c26f8248832fef77ce3ddc6c7a5b0f67..02feec94c1bb1e4a35a5e0c848ea3d658e1cb567 100644 --- a/ansi-tests/check-type.lsp +++ b/ansi-tests/check-type.lsp @@ -62,3 +62,22 @@ (store-value 15)))) (values (check-type x number) x))) nil 15) + +;;; Test that explicit calls to macroexpand in subforms +;;; are done in the correct environment + +(deftest check-type.8 + (let ((x 10)) + (macrolet + ((%m (z) z)) + (check-type (expand-in-current-env (%m x)) + (integer 8 13)))) + nil) + +(deftest check-type.9 + (let ((x 10)) + (macrolet + ((%m (z) z)) + (check-type x (integer 9 12) (expand-in-current-env (%m "Foo!"))))) + nil) + diff --git a/ansi-tests/cond.lsp b/ansi-tests/cond.lsp index 76245a69fc07bd418176ffb4251abf4e6b1b0ab3..02b91901010f17d4c21a38afc98d125e8fd3eeb0 100644 --- a/ansi-tests/cond.lsp +++ b/ansi-tests/cond.lsp @@ -81,6 +81,26 @@ (return-from done 'good))) good) +;;; Test that explicit calls to macroexpand in subforms +;;; are done in the correct environment + +(deftest cond.16 + (macrolet + ((%m (z) z)) + (cond ((expand-in-current-env (%m nil)) :bad) + (t :good))) + :good) + +(deftest cond.17 + (macrolet + ((%m (z) z)) + (cond (nil :bad1) + ((expand-in-current-env (%m :good))) + (t :bad2))) + :good) + +;;; Error tests + (deftest cond.error.1 (signals-error (funcall (macro-function 'cond)) program-error) diff --git a/ansi-tests/ctypecase.lsp b/ansi-tests/ctypecase.lsp index 0916f4d60e3cd2a8deff8f6e398f335f61653017..e432cbc00a8bd6f800841dcc8043a156e5541323 100644 --- a/ansi-tests/ctypecase.lsp +++ b/ansi-tests/ctypecase.lsp @@ -99,6 +99,28 @@ (return-from done 'good))) good) +;;; Test that explicit calls to macroexpand in subforms +;;; are done in the correct environment + +(deftest ctypecase.15 + (macrolet + ((%m (z) z)) + (ctypecase + (expand-in-current-env (%m :foo)) + (integer :bad1) + (keyword :good) + (symbol :bad2))) + :good) + +(deftest ctypecase.16 + (macrolet + ((%m (z) z)) + (ctypecase :foo + (integer (expand-in-current-env (%m :bad1))) + (keyword (expand-in-current-env (%m :good))) + (symbol (expand-in-current-env (%m :bad2))))) + :good) + (deftest ctypecase.error.1 (signals-error (funcall (macro-function 'ctypecase)) program-error) diff --git a/ansi-tests/decf.lsp b/ansi-tests/decf.lsp index 6a961470bced88b946258b7e5113e6006c16bc97..f74caa696759b5a847f230f3d265240fcfea5cb8 100644 --- a/ansi-tests/decf.lsp +++ b/ansi-tests/decf.lsp @@ -142,6 +142,27 @@ (values (decf x #c(0.0l0 -2.0l0)) x)) #c(1.0l0 2.0l0) #c(1.0l0 2.0l0)) +;;; Test that explicit calls to macroexpand in subforms +;;; are done in the correct environment + +(deftest decf.22 + (macrolet + ((%m (z) z)) + (let ((x 10)) + (values + (decf (expand-in-current-env (%m x))) + x))) + 9 9) + +(deftest decf.23 + (macrolet + ((%m (z) z)) + (let ((x 5)) + (values + (decf x (expand-in-current-env (%m 3))) + x))) + 2 2) + (deftest decf.order.2 (let ((a (vector 1 2 3 4)) (i 0) x y z) diff --git a/ansi-tests/destructuring-bind.lsp b/ansi-tests/destructuring-bind.lsp index f44077514246a710d291ef8e13643a576712be41..7c61ee559e147d1d0e91e5b237d7efcbe10bbd8f 100644 --- a/ansi-tests/destructuring-bind.lsp +++ b/ansi-tests/destructuring-bind.lsp @@ -161,6 +161,15 @@ (destructuring-bind (x &aux (y (list x))) '(:foo) (values x y)) :foo (:foo)) +;;; Test that explicit calls to macroexpand in subforms +;;; are done in the correct environment + +(deftest destructuring-bind.31 + (macrolet + ((%m (z) z)) + (destructuring-bind (a b c) (expand-in-current-env (%m '(1 2 3))) (values a b c))) + 1 2 3) + ;;; Error cases #| diff --git a/ansi-tests/do-all-symbols.lsp b/ansi-tests/do-all-symbols.lsp index 8deac96dcbefe28d8a57af5765723db9bf4edb28..25da273eb6a7f60bae5da21e92ebf321c5fd4737 100644 --- a/ansi-tests/do-all-symbols.lsp +++ b/ansi-tests/do-all-symbols.lsp @@ -122,3 +122,12 @@ (setq should-have-returned t) (return :good)))) :good) + +;;; Test that explicit calls to macroexpand in subforms +;;; are done in the correct environment + +(deftest do-all-symbols.13 + (macrolet + ((%m (z) z)) + (do-all-symbols (s (expand-in-current-env (%m :good))))) + :good) diff --git a/ansi-tests/do-external-symbols.lsp b/ansi-tests/do-external-symbols.lsp index 4d0e337c84413466b9997791ffe80b84190f0666..80ffc186ea7bc4f951c25e9b4b2fcf8bb399cb08 100644 --- a/ansi-tests/do-external-symbols.lsp +++ b/ansi-tests/do-external-symbols.lsp @@ -130,6 +130,21 @@ (declare (special x))))) :good) +;;; Test that explicit calls to macroexpand in subforms +;;; are done in the correct environment + +(deftest do-external-symbols.18 + (macrolet + ((%m (z) z)) + (do-external-symbols (s (expand-in-current-env (%m "CL-TEST")) :good))) + :good) + +(deftest do-external-symbols.19 + (macrolet + ((%m (z) z)) + (do-external-symbols (s "CL-TEST" (expand-in-current-env (%m :good))))) + :good) + ;;; Error tests (def-macro-test do-external-symbols.error.1 diff --git a/ansi-tests/do-symbols.lsp b/ansi-tests/do-symbols.lsp index 34f3868c95869afcc1d1626473b982f7609c2d15..53dcee2e9f0c3869f48c59bafa5d0a0fb5b62d2c 100644 --- a/ansi-tests/do-symbols.lsp +++ b/ansi-tests/do-symbols.lsp @@ -154,5 +154,20 @@ (declare (special x))))) :good) +;;; Test that explicit calls to macroexpand in subforms +;;; are done in the correct environment + +(deftest do-symbols.18 + (macrolet + ((%m (z) z)) + (do-symbols (s (expand-in-current-env (%m "CL-TEST")) :good))) + :good) + +(deftest do-symbols.19 + (macrolet + ((%m (z) z)) + (do-symbols (s "CL-TEST" (expand-in-current-env (%m :good))))) + :good) + (def-macro-test do-symbols.error.1 (do-symbols (x "CL"))) diff --git a/ansi-tests/do.lsp b/ansi-tests/do.lsp index 5a7b29b028404d8dbaabd280c56e12827b47f0ac..bafb0c239cc4d9d213969c30654183e268d3ca86 100644 --- a/ansi-tests/do.lsp +++ b/ansi-tests/do.lsp @@ -161,5 +161,44 @@ (declare (special x))))) :good) +;;; Test that explicit calls to macroexpand in subforms +;;; are done in the correct environment + +(deftest do.20 + (let ((result nil)) + (macrolet + ((%m (z) z)) + (do ((x (expand-in-current-env (%m 0)) (+ x 2))) + ((> x 10) result) + (push x result)))) + (10 8 6 4 2 0)) + +(deftest do.21 + (let ((result nil)) + (macrolet + ((%m (z) z)) + (do ((x 0 (expand-in-current-env (%m (+ x 2))))) + ((> x 10) result) + (push x result)))) + (10 8 6 4 2 0)) + +(deftest do.22 + (let ((result nil)) + (macrolet + ((%m (z) z)) + (do ((x 0 (+ x 2))) + ((expand-in-current-env (%m (> x 10))) result) + (push x result)))) + (10 8 6 4 2 0)) + +(deftest do.23 + (let ((result nil)) + (macrolet + ((%m (z) z)) + (do ((x 0 (+ x 2))) + ((> x 10) (expand-in-current-env (%m result))) + (push x result)))) + (10 8 6 4 2 0)) + (def-macro-test do.error.1 (do ((i 0 (1+ i))) ((= i 5) 'a))) diff --git a/ansi-tests/dolist.lsp b/ansi-tests/dolist.lsp index 307d6bc41002a9d81f3fc8cccc44a1e5bf890f6f..269d2f7be028771c8710cd39e225a3f4a035e332 100644 --- a/ansi-tests/dolist.lsp +++ b/ansi-tests/dolist.lsp @@ -131,6 +131,27 @@ (declare (special x))))) :good) +;;; Test that explicit calls to macroexpand in subforms +;;; are done in the correct environment + +(deftest dolist.18 + (let ((result nil)) + (macrolet + ((%m (z) z)) + (dolist (x (expand-in-current-env (%m '(a b c))) result) + (push x result)))) + (c b a)) + +(deftest dolist.19 + (let ((result nil)) + (macrolet + ((%m (z) z)) + (dolist (x '(a b c) (expand-in-current-env (%m result))) + (push x result)))) + (c b a)) + +;;; Error tests + (def-macro-test dolist.error.1 (dolist (x nil))) diff --git a/ansi-tests/dostar.lsp b/ansi-tests/dostar.lsp index f426af90d4e4891b7074db96648e61e3ebd9f26c..221799dab6883857226c6fc9f38812c0b494f83b 100644 --- a/ansi-tests/dostar.lsp +++ b/ansi-tests/dostar.lsp @@ -161,5 +161,44 @@ (declare (special x))))) :good) +;;; Test that explicit calls to macroexpand in subforms +;;; are done in the correct environment + +(deftest do*.20 + (let ((result 0)) + (macrolet + ((%m (z) z)) + (do* ((x (expand-in-current-env (%m 1)) (1+ x))) + ((> x 10) result) + (incf result x)))) + 55) + +(deftest do*.21 + (let ((result 0)) + (macrolet + ((%m (z) z)) + (do* ((x 1 (expand-in-current-env (%m (1+ x))))) + ((> x 10) result) + (incf result x)))) + 55) + +(deftest do*.22 + (let ((result 0)) + (macrolet + ((%m (z) z)) + (do* ((x 1 (1+ x))) + ((expand-in-current-env (%m (> x 10))) result) + (incf result x)))) + 55) + +(deftest do*.23 + (let ((result 0)) + (macrolet + ((%m (z) z)) + (do* ((x 1 (1+ x))) + ((> x 10) (expand-in-current-env (%m result))) + (incf result x)))) + 55) + (def-macro-test do*.error.1 (do* ((i 0 (1+ i))) ((= i 5) 'a))) diff --git a/ansi-tests/dotimes.lsp b/ansi-tests/dotimes.lsp index 389039e201734c536d94ce1b558806b7c9462dcb..c6d9c703b6bf6f91fa2b77a1be1dd717cce27ed5 100644 --- a/ansi-tests/dotimes.lsp +++ b/ansi-tests/dotimes.lsp @@ -201,5 +201,24 @@ bound j)) nil 0 4) +;;; Test that explicit calls to macroexpand in subforms +;;; are done in the correct environment + +(deftest dotimes.25 + (macrolet + ((%m (z) z)) + (let (result) + (dotimes (i (expand-in-current-env (%m 4)) result) + (push i result)))) + (3 2 1 0)) + +(deftest dotimes.26 + (macrolet + ((%m (z) z)) + (let (result) + (dotimes (i 4 (expand-in-current-env (%m result))) + (push i result)))) + (3 2 1 0)) + (def-macro-test dotimes.error.1 (dotimes (i 10))) diff --git a/ansi-tests/ecase.lsp b/ansi-tests/ecase.lsp index 3684848476d5f620188bde951e4af9ba7722e517..26759162acf1113b42a995f3c295473ccf4ec7e1 100644 --- a/ansi-tests/ecase.lsp +++ b/ansi-tests/ecase.lsp @@ -159,6 +159,18 @@ (return-from done 'good))) good) +;;; Test that explicit calls to macroexpand in subforms +;;; are done in the correct environment + +(deftest ecase.34 + (macrolet + ((%m (z) z)) + (ecase (expand-in-current-env (%m :b)) + (:a :bad1) + (:b :good) + (:c :bad2))) + :good) + (deftest ecase.error.1 (signals-error (funcall (macro-function 'ecase)) program-error) t) diff --git a/ansi-tests/etypecase.lsp b/ansi-tests/etypecase.lsp index 9a6337e4944e108a775a7261a8a661e90779ed3d..2b7bea5e72c114f11f32e7d433f794f5c2e81972 100644 --- a/ansi-tests/etypecase.lsp +++ b/ansi-tests/etypecase.lsp @@ -108,6 +108,27 @@ collect (list n my-types val i form j))) nil) +;;; Test that explicit calls to macroexpand in subforms +;;; are done in the correct environment + +(deftest etypecase.16 + (macrolet + ((%m (z) z)) + (etypecase + (expand-in-current-env (%m :foo)) + (integer :bad1) + (keyword :good) + (symbol :bad2))) + :good) + +(deftest etypecase.17 + (macrolet + ((%m (z) z)) + (etypecase :foo + (integer (expand-in-current-env (%m :bad1))) + (keyword (expand-in-current-env (%m :good))) + (symbol (expand-in-current-env (%m :bad2))))) + :good) ;;; Error cases diff --git a/ansi-tests/incf.lsp b/ansi-tests/incf.lsp index a8a35b4cf5113126d2c821170e49faeb541cbf04..fbe79eaba7e9568c1e54902f3e082a4119a295e7 100644 --- a/ansi-tests/incf.lsp +++ b/ansi-tests/incf.lsp @@ -142,6 +142,27 @@ (values (incf x #c(0.0l0 -2.0l0)) x)) #c(1.0l0 -2.0l0) #c(1.0l0 -2.0l0)) +;;; Test that explicit calls to macroexpand in subforms +;;; are done in the correct environment + +(deftest incf.22 + (macrolet + ((%m (z) z)) + (let ((x 2)) + (values + (incf (expand-in-current-env (%m x))) + x))) + 3 3) + +(deftest incf.23 + (macrolet + ((%m (z) z)) + (let ((x 2)) + (values + (incf x (expand-in-current-env (%m 4))) + x))) + 6 6) + (deftest incf.order.2 (let ((a (vector 1 2 3 4)) (i 0) x y z) diff --git a/ansi-tests/loop1.lsp b/ansi-tests/loop1.lsp index 8b40115b8b1653d2dfb8e52e0b5bd43acd5ad76d..8cd6355e4bb1f2549670ad6b3799f97373652864 100644 --- a/ansi-tests/loop1.lsp +++ b/ansi-tests/loop1.lsp @@ -293,4 +293,69 @@ (loop for nil from 5 above 0 collect (incf i))) (1 2 3 4 5)) +;;; Test that explicit calls to macroexpand in subforms +;;; are done in the correct environment +(deftest loop.1.57 + (macrolet + ((%m (z) z)) + (loop for i from (expand-in-current-env (%m 1)) to 5 collect i)) + (1 2 3 4 5)) + +(deftest loop.1.58 + (macrolet + ((%m (z) z)) + (loop for i from 1 to (expand-in-current-env (%m 5)) collect i)) + (1 2 3 4 5)) + +(deftest loop.1.59 + (macrolet + ((%m (z) z)) + (loop for i from 1 to 5 by (expand-in-current-env (%m 2)) collect i)) + (1 3 5)) + +(deftest loop.1.60 + (macrolet + ((%m (z) z)) + (loop for i downfrom (expand-in-current-env (%m 10)) + to 3 + collect i)) + (10 9 8 7 6 5 4 3)) + +(deftest loop.1.61 + (macrolet + ((%m (z) z)) + (loop for i downfrom 10 + to (expand-in-current-env (%m 3)) + collect i)) + (10 9 8 7 6 5 4 3)) + +(deftest loop.1.62 + (macrolet + ((%m (z) z)) + (loop for i from (expand-in-current-env (%m 10)) + downto 3 + collect i)) + (10 9 8 7 6 5 4 3)) + +(deftest loop.1.63 + (macrolet + ((%m (z) z)) + (loop for i from 10 + downto (expand-in-current-env (%m 3)) + collect i)) + (10 9 8 7 6 5 4 3)) + +(deftest loop.1.64 + (macrolet + ((%m (z) z)) + (loop for i from (expand-in-current-env (%m 1)) below 5 collect i)) + (1 2 3 4)) + +(deftest loop.1.65 + (macrolet + ((%m (z) z)) + (loop for i from 1 below (expand-in-current-env (%m 5)) collect i)) + (1 2 3 4)) + + diff --git a/ansi-tests/loop10.lsp b/ansi-tests/loop10.lsp index 74a6ffb9a1c3e8449587462238d52d2b2b1fa7fc..5e000d4e553d7e0497b0e0bf08292d86a31e94cc 100644 --- a/ansi-tests/loop10.lsp +++ b/ansi-tests/loop10.lsp @@ -500,3 +500,60 @@ (deftest loop.10.104 (loop for i in nil sum i of-type long-float) 0.0l0) + +;;; Test that explicit calls to macroexpand in subforms +;;; are done in the correct environment + +(deftest loop.10.105 + (macrolet + ((%m (z) z)) + (loop for x from 1 to 10 count (expand-in-current-env (%m (< x 5))))) + 4) + +(deftest loop.10.106 + (macrolet + ((%m (z) z)) + (loop for x from 1 to 10 counting (expand-in-current-env (%m t)))) + 10) + +(deftest loop.10.106 + (macrolet + ((%m (z) z)) + (loop for x from 1 to 10 count (expand-in-current-env (%m nil)))) + 0) + +(deftest loop.10.107 + (macrolet + ((%m (z) z)) + (loop for x in '(1 4 10 5 7 9) maximize (expand-in-current-env (%m x)))) + 10) + +(deftest loop.10.108 + (macrolet + ((%m (z) z)) + (loop for x in '(1 4 10 5 7 9) maximizing (expand-in-current-env (%m 17)))) + 17) + +(deftest loop.10.109 + (macrolet + ((%m (z) z)) + (loop for x in '(5 4 10 1 7 9) minimize (expand-in-current-env (%m x)))) + 1) + +(deftest loop.10.110 + (macrolet + ((%m (z) z)) + (loop for x in '(5 4 10 1 7 9) minimizing (expand-in-current-env (%m 3)))) + 3) + +(deftest loop.10.111 + (macrolet + ((%m (z) z)) + (loop for x in '(1 4 10 5 7 9) sum (expand-in-current-env (%m x)))) + 36) + +(deftest loop.10.112 + (macrolet + ((%m (z) z)) + (loop for x in '(1 4 10 5 7 9) summing (expand-in-current-env (%m 2)))) + 12) diff --git a/ansi-tests/loop11.lsp b/ansi-tests/loop11.lsp index cd71b8bd12b4f081532874c329d5a567b00414e9..2175c018ee279ae8d48f1a3f7f6c4902bcd741ca 100644 --- a/ansi-tests/loop11.lsp +++ b/ansi-tests/loop11.lsp @@ -206,4 +206,11 @@ until (> i 12) collect i) :good) - +;;; Test that explicit calls to macroexpand in subforms +;;; are done in the correct environment + +(deftest loop.11.35 + (macrolet + ((%m (z) z)) + (loop repeat (expand-in-current-env (%m 5)) collect 'x)) + (x x x x x)) diff --git a/ansi-tests/loop12.lsp b/ansi-tests/loop12.lsp index 4069c67d39709fee55b8173b9e29fab0f23a94a6..1aca66e81c8efb1b84a748a950ef4ce24c30a6dd 100644 --- a/ansi-tests/loop12.lsp +++ b/ansi-tests/loop12.lsp @@ -237,4 +237,38 @@ collect i into foo) 1) +;;; Test that explicit calls to macroexpand in subforms +;;; are done in the correct environment + +(deftest loop.12.56 + (macrolet + ((%m (z) z)) + (loop for i in '(1 2 3 4) always (expand-in-current-env (%m (< i 10))))) + t) + +(deftest loop.12.57 + (macrolet + ((%m (z) z)) + (loop for i in '(1 2 3 4) always (expand-in-current-env (%m t)))) + t) + +(deftest loop.12.58 + (macrolet + ((%m (z) z)) + (loop for i in '(1 2 3 4) never (expand-in-current-env (%m (>= i 10))))) + t) + +(deftest loop.12.59 + (macrolet + ((%m (z) z)) + (loop for i in '(1 2 3 4) never (expand-in-current-env (%m t)))) + nil) + +(deftest loop.12.60 + (macrolet + ((%m (z) z)) + (loop for i in '(1 2 3 4) + thereis (expand-in-current-env (%m (and (>= i 2) (+ i 1)))))) + 3) + diff --git a/ansi-tests/loop13.lsp b/ansi-tests/loop13.lsp index a42f8d459e37f31db31cb74a51a10ed0342ae595..73ca72c7698b7ba25e3eeb068d40d3f8a04e8e14 100644 --- a/ansi-tests/loop13.lsp +++ b/ansi-tests/loop13.lsp @@ -431,4 +431,24 @@ :bad) :good) +;;; Test that explicit calls to macroexpand in subforms +;;; are done in the correct environment +(deftest loop.13.88 + (macrolet + ((%m (z) z)) + (loop do (expand-in-current-env (%m (return 10))))) + 10) + +(deftest loop.13.89 + (macrolet + ((%m (z) z)) + (loop for i from 0 below 100 by 7 + when (> i 50) return (expand-in-current-env (%m i)))) + 56) + +(deftest loop.13.90 + (macrolet + ((%m (z) z)) + (loop return (expand-in-current-env (%m 'a)))) + a) diff --git a/ansi-tests/loop14.lsp b/ansi-tests/loop14.lsp index f22fa3cc2361ef9e0a2c405e495452721e860845..76e5d6f83849f3bcc436e4b093c3e05a6cb6940c 100644 --- a/ansi-tests/loop14.lsp +++ b/ansi-tests/loop14.lsp @@ -331,3 +331,38 @@ (loop for x in '(1 2 nil 3 4 nil 6 nil) when x summing it) 16) + +;;; Test that explicit calls to macroexpand in subforms +;;; are done in the correct environment + +(deftest loop.14.46 + (macrolet + ((%m (z) z)) + (loop for x from 1 to 6 + when (expand-in-current-env (%m (evenp x))) + collect x)) + (2 4 6)) + +(deftest loop.14.47 + (macrolet + ((%m (z) z)) + (loop for x from 1 to 6 + unless (expand-in-current-env (%m (evenp x))) + collect x)) + (1 3 5)) + +(deftest loop.14.48 + (macrolet + ((%m (z) z)) + (loop for x from 1 to 6 + when (expand-in-current-env (%m t)) + sum x)) + 21) + +(deftest loop.14.49 + (macrolet + ((%m (z) z)) + (loop for x from 1 to 10 + if (expand-in-current-env (%m (evenp x))) + collect x end)) + (2 4 6 8 10)) diff --git a/ansi-tests/loop17.lsp b/ansi-tests/loop17.lsp index 2297099d0d75aa2664bbe453fa781812968e5eb7..6ec68869d8a4e3c7dec105ed2e678952bd0aed6e 100644 --- a/ansi-tests/loop17.lsp +++ b/ansi-tests/loop17.lsp @@ -131,3 +131,15 @@ and j = 0 then (+ j i) collect j) (0 1 3 6 10)) + +;;; Test that explicit calls to macroexpand in subforms +;;; are done in the correct environment + +(deftest loop.17.22 + (macrolet + ((%m (z) z)) + (loop with x = 0 + initially (expand-in-current-env (%m (incf x))) + until t + finally (expand-in-current-env (%m (return x))))) + 1) diff --git a/ansi-tests/loop2.lsp b/ansi-tests/loop2.lsp index 79f739757f083f97682d029ccbb921f432fc3a3c..5ec87da05ae9cf754f2d780a659fb77a9b7cda4c 100644 --- a/ansi-tests/loop2.lsp +++ b/ansi-tests/loop2.lsp @@ -140,3 +140,24 @@ 1 2 2) +;;; Test that explicit calls to macroexpand in subforms +;;; are done in the correct environment + +(deftest loop.2.24 + (macrolet + ((%m (z) z)) + (loop for x in (expand-in-current-env (%m '(1 2 3))) sum x)) + 6) + +(deftest loop.2.25 + (macrolet + ((%m (z) z)) + (loop for (x . y) in (expand-in-current-env (%m '((a . b) (c . d) (e . f)))) + collect (list x y))) + ((a b) (c d) (e f))) + +(deftest loop.2.26 + (macrolet + ((%m (z) z)) + (loop as x in (expand-in-current-env (%m '(1 2 3))) sum x)) + 6) \ No newline at end of file diff --git a/ansi-tests/loop3.lsp b/ansi-tests/loop3.lsp index 7b7a0d8d3b509bb6c7b3b63409f9a37ca679aec5..eca484df65527c5338c9630aafeb874d78f6a0bb 100644 --- a/ansi-tests/loop3.lsp +++ b/ansi-tests/loop3.lsp @@ -135,3 +135,33 @@ a b i)) (a c e g) 1 2 2) + +;;; Test that explicit calls to macroexpand in subforms +;;; are done in the correct environment + +(deftest loop.3.24 + (macrolet + ((%m (z) z)) + (loop for x on (expand-in-current-env (%m '(1 2 3))) sum (car x))) + 6) + +(deftest loop.3.25 + (macrolet + ((%m (z) z)) + (loop for e on (expand-in-current-env (%m '(a b c d e f))) by #'cddr + collect (car e))) + (a c e)) + +(deftest loop.3.26 + (macrolet + ((%m (z) z)) + (loop for e on '(a b c d e f) + by (expand-in-current-env (%m #'cddr)) + collect (car e))) + (a c e)) + +(deftest loop.3.27 + (macrolet + ((%m (z) z)) + (loop as x on (expand-in-current-env (%m '(1 2 3))) sum (car x))) + 6) diff --git a/ansi-tests/loop4.lsp b/ansi-tests/loop4.lsp index 5edc3b2ee50fc473356b92d406e327e5256dafa3..82b15c2c579ef9a6c77f4f1bf4985f1df63e7667 100644 --- a/ansi-tests/loop4.lsp +++ b/ansi-tests/loop4.lsp @@ -58,3 +58,51 @@ for x = 1 count x until t)) program-error) t) + +;;; Test that explicit calls to macroexpand in subforms +;;; are done in the correct environment + +(deftest loop.4.9 + (macrolet + ((%m (z) z)) + (loop + for x = (expand-in-current-env (%m 1)) then (1+ x) + until (> x 5) + collect x)) + (1 2 3 4 5)) + +(deftest loop.4.10 + (macrolet + ((%m (z) z)) + (loop + for x = 1 then (expand-in-current-env (%m (1+ x))) + until (> x 5) + collect x)) + (1 2 3 4 5)) + +(deftest loop.4.11 + (macrolet + ((%m (z) z)) + (loop + for x = 1 then (1+ x) + until (expand-in-current-env (%m (> x 5))) + collect x)) + (1 2 3 4 5)) + +(deftest loop.4.12 + (macrolet + ((%m (z) z)) + (loop + for x = 1 then (1+ x) + while (expand-in-current-env (%m (<= x 5))) + collect x)) + (1 2 3 4 5)) + +(deftest loop.4.13 + (macrolet + ((%m (z) z)) + (loop + for x = 1 then (1+ x) + until (> x 5) + collect (expand-in-current-env (%m x)))) + (1 2 3 4 5)) diff --git a/ansi-tests/loop5.lsp b/ansi-tests/loop5.lsp index 01673320ceff3ac4cf9b9069d9de55580c749f96..95dba886ca85335db8eabb8906d6384f7a8a4bca 100644 --- a/ansi-tests/loop5.lsp +++ b/ansi-tests/loop5.lsp @@ -190,6 +190,24 @@ collect (list fvals r))) nil) +;;; Test that explicit calls to macroexpand in subforms +;;; are done in the correct environment + +(deftest loop.5.44 + (macrolet + ((%m (z) z)) + (loop for x across (expand-in-current-env (%m "148X")) collect x)) + (#\1 #\4 #\8 #\X)) + +(deftest loop.5.45 + (macrolet + ((%m (z) z)) + (loop as x across (expand-in-current-env (%m #*00110110)) collect x)) + (0 0 1 1 0 1 1 0)) + +;;; FIXME +;;; Add tests for other specialized array types (integer types, floats, complex) + ;;; Error cases (deftest loop.5.error.1 @@ -219,5 +237,3 @@ for e from 1 to 5 collect e)) program-error) t) - - diff --git a/ansi-tests/loop6.lsp b/ansi-tests/loop6.lsp index f84d99328fdeb4d0db4c355caeb7720529e77f78..386fe982089e77df78d537f69005aa6b9157dd95 100644 --- a/ansi-tests/loop6.lsp +++ b/ansi-tests/loop6.lsp @@ -253,6 +253,24 @@ #'symbol<) (a b c)) +;;; Test that explicit calls to macroexpand in subforms +;;; are done in the correct environment + +(deftest loop.6.41 + (macrolet + ((%m (z) z)) + (loop for x being the hash-value of + (expand-in-current-env (%m *loop.6.hash.1*)) sum x)) + 6) + +(deftest loop.6.42 + (macrolet + ((%m (z) z)) + (sort (loop for x being the hash-key of + (expand-in-current-env (%m *loop.6.hash.1*)) collect x) + #'symbol<)) + (a b c)) + ;;; Error tests (deftest loop.6.error.1 diff --git a/ansi-tests/loop7.lsp b/ansi-tests/loop7.lsp index cabe2408f1b313ce9c5be0b3754b7a5561c16ad4..73915247b01b97baecd27f16fc51181090bd0b8a 100644 --- a/ansi-tests/loop7.lsp +++ b/ansi-tests/loop7.lsp @@ -209,3 +209,35 @@ #'string<) ("A" "B" "BAR" "BAZ" "C" "FOO")) +;;; Test that explicit calls to macroexpand in subforms +;;; are done in the correct environment + +(deftest loop.7.33 + (macrolet + ((%m (z) z)) + (sort (mapcar #'symbol-name + (loop for x being the symbols of + (expand-in-current-env (%m "LOOP.CL-TEST.1")) + collect x)) + #'string<)) + ("A" "B" "BAR" "BAZ" "C" "FOO")) + +(deftest loop.7.34 + (macrolet + ((%m (z) z)) + (sort (mapcar #'symbol-name + (loop for x being the external-symbols of + (expand-in-current-env (%m "LOOP.CL-TEST.1")) + collect x)) + #'string<)) + ("A" "B" "C")) + +(deftest loop.7.35 + (macrolet + ((%m (z) z)) + (sort (mapcar #'symbol-name + (loop for x being the present-symbols of + (expand-in-current-env (%m "LOOP.CL-TEST.2")) + collect x)) + #'string<)) + ("X" "Y" "Z")) diff --git a/ansi-tests/loop8.lsp b/ansi-tests/loop8.lsp index 22e8df30134431606707c467a70c307296a24a14..700e5244750fa288c6c949ed8a25a765e161db95 100644 --- a/ansi-tests/loop8.lsp +++ b/ansi-tests/loop8.lsp @@ -116,6 +116,15 @@ return 3) 2) +;;; Test that explicit calls to macroexpand in subforms +;;; are done in the correct environment + +(deftest loop.8.24 + (macrolet + ((%m (z) z)) + (loop with x = (expand-in-current-env (%m 1)) do (return x))) + 1) + ;;; Error cases ;;; The spec says (in section 6.1.1.7) that: diff --git a/ansi-tests/loop9.lsp b/ansi-tests/loop9.lsp index e4b3376e6a70c83b0e4743f66ed3adc6ce70b4b3..a59840eb0f392a797b608fe01830599e09f87efa 100644 --- a/ansi-tests/loop9.lsp +++ b/ansi-tests/loop9.lsp @@ -226,3 +226,40 @@ (deftest loop.9.42 (loop for x in '(a b c d e) nconc (cons x 'foo)) (a b c d e . foo)) + +;;; Test that explicit calls to macroexpand in subforms +;;; are done in the correct environment + +(deftest loop.9.43 + (macrolet + ((%m (z) z)) + (loop for x in '(1 2 3) collect (expand-in-current-env (%m (- x))))) + (-1 -2 -3)) + +(deftest loop.9.44 + (macrolet + ((%m (z) z)) + (loop for x in '(1 2 3) collecting (expand-in-current-env (%m (list x))))) + ((1) (2) (3))) + +(deftest loop.9.45 + (macrolet + ((%m (z) z)) + (loop for x in '(a b c) + collect (expand-in-current-env (%m (list x))) into foo + finally (return (reverse foo)))) + ((c) (b) (a))) + +(deftest loop.9.46 + (macrolet + ((%m (z) z)) + (loop for x in '((a b) (c d) (e f g) () (i)) + append (expand-in-current-env (%m x)))) + (a b c d e f g i)) + +(deftest loop.9.47 + (macrolet + ((%m (z) z)) + (loop for x in '((a b) (c d) (e f g) () (i)) + nconc (expand-in-current-env (%m (copy-seq x))))) + (a b c d e f g i)) diff --git a/ansi-tests/multiple-value-bind.lsp b/ansi-tests/multiple-value-bind.lsp index e88cfec137c3ca5070791fd10399a8131b79d480..ca27c366dde07fe0601b8a7caf396d2443b32eb0 100644 --- a/ansi-tests/multiple-value-bind.lsp +++ b/ansi-tests/multiple-value-bind.lsp @@ -84,6 +84,17 @@ (multiple-value-bind () (values 1 2 3 4 5)) nil) +;;; Test that explicit calls to macroexpand in subforms +;;; are done in the correct environment + +(deftest multiple-value-bind.14 + (macrolet + ((%m (z) z)) + (multiple-value-bind (x y z) + (expand-in-current-env (%m (values 1 2 3))) + (list x y z))) + (1 2 3)) + ;;; Error cases (deftest multiple-value-bind.error.1 diff --git a/ansi-tests/multiple-value-list.lsp b/ansi-tests/multiple-value-list.lsp index e470949c99828f3bb1bae8deac90cc0ed1a9430c..ffb2ba0de40e0d319dc5c300fd1983be98ea85c2 100644 --- a/ansi-tests/multiple-value-list.lsp +++ b/ansi-tests/multiple-value-list.lsp @@ -37,12 +37,30 @@ always (equal x (multiple-value-list (values-list x))))) nil) +;;; Test that explicit calls to macroexpand in subforms +;;; are done in the correct environment + +(deftest multiple-value-list.8 + (macrolet + ((%m (z) z)) + (multiple-value-list (expand-in-current-env (%m 1)))) + (1)) + +(deftest multiple-value-list.9 + (macrolet + ((%m (z) z)) + (multiple-value-list (expand-in-current-env (%m (values 1 2 3))))) + (1 2 3)) + +;;; Test that the argument is evaluated just once (deftest multiple-value-list.order.1 (let ((i 0)) (values (multiple-value-list (incf i)) i)) (1) 1) +;;; Error tests + (deftest multiple-value-list.error.1 (signals-error (funcall (macro-function 'multiple-value-list)) program-error) diff --git a/ansi-tests/multiple-value-setq.lsp b/ansi-tests/multiple-value-setq.lsp index 62fe5edbe16266d697cbaa417c19043270327e66..a7a989eb3cfd92aaf20ca8add4ecbce711dbe48e 100644 --- a/ansi-tests/multiple-value-setq.lsp +++ b/ansi-tests/multiple-value-setq.lsp @@ -119,6 +119,27 @@ (multiple-value-setq nil (values 'a 'b)) a) +;;; Test that explicit calls to macroexpand in subforms +;;; are done in the correct environment + +(deftest multiple-value-setq.16 + (macrolet + ((%m (z) z)) + (let ((x :bad)) + (symbol-macrolet ((z (expand-in-current-env (%m x)))) + (multiple-value-setq (z) :good)) + x)) + :good) + +(deftest multiple-value-setq.17 + (macrolet + ((%m (z) z)) + (let ((x :bad)) + (values + (multiple-value-setq (x) (expand-in-current-env (%m :good))) + x))) + :good :good) + ;;; Error tests (deftest multiple-value-setq.error.1 diff --git a/ansi-tests/nth-value.lsp b/ansi-tests/nth-value.lsp index fbbd5585b62e2967a117a6fe3ac6422361e2c608..216601a26b43c5de01a47e1a64f7209114e17455 100644 --- a/ansi-tests/nth-value.lsp +++ b/ansi-tests/nth-value.lsp @@ -27,6 +27,23 @@ (nth-value 100 'a) nil) +;;; Test that explicit calls to macroexpand in subforms +;;; are done in the correct environment + +(deftest nth-value.6 + (macrolet + ((%m (z) z)) + (nth-value (expand-in-current-env (%m 1)) (values 'a 'b 'c))) + b) + +(deftest nth-value.7 + (macrolet + ((%m (z) z)) + (nth-value 1 (expand-in-current-env (%m (values 'a 'b 'c))))) + b) + +;;; Order of evaluation test + (deftest nth-value.order.1 (let ((i 0) x y) (values @@ -35,6 +52,8 @@ i x y)) d 2 1 2) +;;; Error tests + (deftest nth-value.error.1 (signals-error (funcall (macro-function 'nth-value)) program-error) diff --git a/ansi-tests/or.lsp b/ansi-tests/or.lsp index 9a3ce48a659fa5511ec6fdf2928c9a607cbe9a51..577409c9690ff8475c9cba31b097d8cde89bbb62 100644 --- a/ansi-tests/or.lsp +++ b/ansi-tests/or.lsp @@ -41,6 +41,28 @@ (or (values nil 1 2) (values 1 nil 2)) 1 nil 2) +;;; Test that explicit calls to macroexpand in subforms +;;; are done in the correct environment + +(deftest or.10 + (macrolet + ((%m (z) z)) + (or (expand-in-current-env (%m 'x)) + (expand-in-current-env (%m nil)) + (expand-in-current-env (%m 'y)) + t)) + x) + +(deftest or.11 + (macrolet + ((%m (z) z)) + (or (expand-in-current-env (%m nil)) + (expand-in-current-env (%m 'a)) + nil)) + a) + +;;; Error tests + (deftest or.error.1 (signals-error (funcall (macro-function 'or)) program-error) t) diff --git a/ansi-tests/places.lsp b/ansi-tests/places.lsp index 439ba755d9efe79ed54d1ca6188e3813ea2502a4..06426cd5588e62e19452a174518b0983e9cab730 100644 --- a/ansi-tests/places.lsp +++ b/ansi-tests/places.lsp @@ -269,3 +269,20 @@ (declare (special *x*)) (setf *x* 1)) 1) + +;;; Test that explicit calls to macroexpand in subforms +;;; are done in the correct environment + +(deftest setf.7 + (macrolet + ((%m (z) z)) + (let ((x nil)) + (values x (setf (expand-in-current-env (%m x)) t) x))) + nil t t) + +(deftest setf.8 + (macrolet + ((%m (z) z)) + (let ((x nil)) + (values x (setf x (expand-in-current-env (%m t))) x))) + nil t t) diff --git a/ansi-tests/pop.lsp b/ansi-tests/pop.lsp index f33d9cd8b6bd7e4a2ebd6d47bccae09dda680505..5f1cf71a3223b5cdb38e5aecd1cd2fe833dbc575 100644 --- a/ansi-tests/pop.lsp +++ b/ansi-tests/pop.lsp @@ -19,6 +19,18 @@ (list x y))) (nil nil)) +;;; Test that explicit calls to macroexpand in subforms +;;; are done in the correct environment + +(deftest pop.3 + (macrolet + ((%m (z) z)) + (let ((x (list 'a 'b 'c))) + (values + (pop (expand-in-current-env (%m x))) + x))) + a (b c)) + ;;; Confirm argument is executed just once. (deftest pop.order.1 (let ((i 0) diff --git a/ansi-tests/prog.lsp b/ansi-tests/prog.lsp index 30050f71ad95c46401ab0af7eb2ba66d14450e22..784c877b0e621255b2cace0611791de1eb92d0ce 100644 --- a/ansi-tests/prog.lsp +++ b/ansi-tests/prog.lsp @@ -80,6 +80,15 @@ (return y)))) :good) +;;; Test that explicit calls to macroexpand in subforms +;;; are done in the correct environment + +(deftest prog.12 + (macrolet + ((%m (z) z)) + (prog ((x (expand-in-current-env (%m :good)))) (return x))) + :good) + (def-macro-test prog.error.1 (prog nil)) ;;; Tests of PROG* @@ -159,4 +168,13 @@ (return y)))) :good) +;;; Test that explicit calls to macroexpand in subforms +;;; are done in the correct environment + +(deftest prog*.12 + (macrolet + ((%m (z) z)) + (prog* ((x (expand-in-current-env (%m :good)))) (return x))) + :good) + (def-macro-test prog*.error.1 (prog* nil)) diff --git a/ansi-tests/prog1.lsp b/ansi-tests/prog1.lsp index 57fe441577906f9fbc515030f3ab9d79d3fcc318..5383f68874fc60afe5e8c5c8ca02f0f61e7ed972 100644 --- a/ansi-tests/prog1.lsp +++ b/ansi-tests/prog1.lsp @@ -36,4 +36,13 @@ (return 'good))) good) +;;; Test that explicit calls to macroexpand in subforms +;;; are done in the correct environment + +(deftest prog1.7 + (macrolet + ((%m (z) z)) + (prog1 (expand-in-current-env (%m 'good)))) + good) + (def-macro-test prog1.error.1 (prog1 nil)) diff --git a/ansi-tests/prog2.lsp b/ansi-tests/prog2.lsp index 5da6e28a63223a94b3ef0193d3181e336752577c..c80086c323983fc955c7690c0a2c3720d3e7aab2 100644 --- a/ansi-tests/prog2.lsp +++ b/ansi-tests/prog2.lsp @@ -45,4 +45,16 @@ (return 'good))) good) +;;; Test that explicit calls to macroexpand in subforms +;;; are done in the correct environment + +(deftest prog2.8 + (macrolet + ((%m (z) z)) + (prog2 + (expand-in-current-env (%m 'bad1)) + (expand-in-current-env (%m 'good)) + (expand-in-current-env (%m 'bad2)))) + good) + (def-macro-test prog2.error.1 (prog2 nil nil)) diff --git a/ansi-tests/psetf.lsp b/ansi-tests/psetf.lsp index daf546f75d94b4b314f6d823e6f83b0cad6b926f..d4c081531623d4f38298e5c9a51f74ef6aed6508 100644 --- a/ansi-tests/psetf.lsp +++ b/ansi-tests/psetf.lsp @@ -387,4 +387,27 @@ #2a((a b u)(d e f)) #2a((1 2 3 4)(5 v 7 8)(9 10 11 12))) +;;; Test that explicit calls to macroexpand in subforms +;;; are done in the correct environment + +(deftest psetf.39 + (macrolet + ((%m (z) z)) + (let ((x 1) (y 2)) + (values + (psetf (expand-in-current-env (%m x)) y + y x) + x y))) + nil 2 1) + +(deftest psetf.40 + (macrolet + ((%m (z) z)) + (let ((x 1) (y 2)) + (values + (psetf x (expand-in-current-env (%m y)) + y x) + x y))) + nil 2 1) + ;;; TODO: logical-pathname-translations, readtable-case diff --git a/ansi-tests/psetq.lsp b/ansi-tests/psetq.lsp index 3efed9744b8af06773b0b7ff4401599c4ec914bc..f6a1c49ce7abf7400a99e62a1312816f2775c201 100644 --- a/ansi-tests/psetq.lsp +++ b/ansi-tests/psetq.lsp @@ -78,7 +78,18 @@ *x* *y*)) 0 10 nil 10 0) - +;;; Test that explicit calls to macroexpand in subforms +;;; are done in the correct environment + +(deftest psetq.10 + (macrolet + ((%m (z) z)) + (let ((x nil) (y nil)) + (values + (psetq x (expand-in-current-env (%m 1)) + y (expand-in-current-env (%m 2))) + x y))) + nil 1 2) (deftest psetq.error.1 (signals-error (funcall (macro-function 'psetq)) program-error) diff --git a/ansi-tests/push.lsp b/ansi-tests/push.lsp index 0c2640f6d5864f4b4989450037cb9f316a1600ba..04bb131f6dcac793ce31283bcd15cf87e39ac45d 100644 --- a/ansi-tests/push.lsp +++ b/ansi-tests/push.lsp @@ -28,6 +28,27 @@ x)) ((a) a)) +;;; Test that explicit calls to macroexpand in subforms +;;; are done in the correct environment + +(deftest push.4 + (macrolet + ((%m (z) z)) + (let ((x nil)) + (values + (push (expand-in-current-env (%m 1)) x) + x))) + (1) (1)) + +(deftest push.5 + (macrolet + ((%m (z) z)) + (let ((x nil)) + (values + (push 1 (expand-in-current-env (%m x))) + x))) + (1) (1)) + (deftest push.order.1 (let ((x (list nil)) (i 0) a b) (values diff --git a/ansi-tests/pushnew.lsp b/ansi-tests/pushnew.lsp index 5cb481316f8d5eb4929993002617983adf9ee7e8..e11a624b8e214703030503585d4c3f16ef1f3388 100644 --- a/ansi-tests/pushnew.lsp +++ b/ansi-tests/pushnew.lsp @@ -187,6 +187,54 @@ (1 2 3) (1 2 3)) +;;; Test that explicit calls to macroexpand in subforms +;;; are done in the correct environment + +(deftest pushnew.20 + (macrolet + ((%m (z) z)) + (let ((x nil)) + (values + (pushnew (expand-in-current-env (%m 1)) x) + x))) + (1) (1)) + +(deftest pushnew.21 + (macrolet + ((%m (z) z)) + (let ((x nil)) + (values + (pushnew 1 (expand-in-current-env (%m x))) + x))) + (1) (1)) + +(deftest pushnew.22 + (macrolet + ((%m (z) z)) + (let ((x '(a b))) + (values + (pushnew 1 x :test (expand-in-current-env (%m #'eql))) + x))) + (1 a b) (1 a b)) + +(deftest pushnew.23 + (macrolet + ((%m (z) z)) + (let ((x '(1))) + (values + (pushnew 1 x :test-not (expand-in-current-env (%m #'eql))) + x))) + (1 1) (1 1)) + +(deftest pushnew.24 + (macrolet + ((%m (z) z)) + (let ((x '(3))) + (values + (pushnew 1 x :key (expand-in-current-env (%m #'evenp))) + x))) + (3) (3)) + (defharmless pushnew.test-and-test-not.1 (let ((x '(b c))) (pushnew 'a x :test #'eql :test-not #'eql))) diff --git a/ansi-tests/remf.lsp b/ansi-tests/remf.lsp index 86de2240e71637d8bad64a2e3a1981757567e8b3..876cecd612999f8ec758a7c814a16878c69438f9 100644 --- a/ansi-tests/remf.lsp +++ b/ansi-tests/remf.lsp @@ -31,6 +31,38 @@ (not (eqt (car ptr) 'a))))) t 0) +;;; Test that explicit calls to macroexpand in subforms +;;; are done in the correct environment + +(deftest remf.5 + (macrolet + ((%m (z) z)) + (let ((x nil)) + (values + (remf (expand-in-current-env (%m x)) 'a) + x))) + nil nil) + +(deftest remf.6 + (macrolet + ((%m (z) z)) + (let ((x (list 'a 'b))) + (values + (notnot (remf (expand-in-current-env (%m x)) 'a)) + x))) + t nil) + +(deftest remf.7 + (macrolet + ((%m (z) z)) + (let ((x (list 'a 'b 'c 'd))) + (values + (notnot (remf x (expand-in-current-env (%m 'a)))) + x))) + t (c d)) + + + (deftest remf.order.1 (let ((i 0) x y (p (make-array 1 :initial-element (copy-list '(a b c d e f))))) diff --git a/ansi-tests/return.lsp b/ansi-tests/return.lsp index ce7006e81c5bbefc6de95d7b5a09ec02c0126eff..bc033c623a0922e227f067b951273e1de90de58d 100644 --- a/ansi-tests/return.lsp +++ b/ansi-tests/return.lsp @@ -32,3 +32,11 @@ (block nil (return :good) :bad) :good) +;;; Test that explicit calls to macroexpand in subforms +;;; are done in the correct environment + +(deftest return.3 + (macrolet + ((%m (z) z)) + (block nil (return (expand-in-current-env (%m :good))) :bad)) + :good) diff --git a/ansi-tests/rotatef.lsp b/ansi-tests/rotatef.lsp index d943439dd16971a375c6dcaad9504b955e1c02f5..bc226629a6d7764272532f4fcb94d7706ae43124 100644 --- a/ansi-tests/rotatef.lsp +++ b/ansi-tests/rotatef.lsp @@ -348,5 +348,24 @@ (eqlt (find-class n2) (find-class n3)))) t t) +;;; Test that explicit calls to macroexpand in subforms +;;; are done in the correct environment + +(deftest rotatef.36 + (macrolet + ((%m (z) z)) + (let ((x 1) (y 2)) + (rotatef (expand-in-current-env (%m x)) y) + (values x y))) + 2 1) + +(deftest rotatef.37 + (macrolet + ((%m (z) z)) + (let ((x 1) (y 2)) + (rotatef x (expand-in-current-env (%m y))) + (values x y))) + 2 1) + ;;; TODO: macro-function, mask-field, row-major-aref, ;;; logical-pathname-translations, readtable-case diff --git a/ansi-tests/shiftf.lsp b/ansi-tests/shiftf.lsp index 853361a334b6161275bb5c19111c6284da89e794..40fa848ec68b3ab4e86a8cd26e5515495b5bafaa 100644 --- a/ansi-tests/shiftf.lsp +++ b/ansi-tests/shiftf.lsp @@ -48,6 +48,35 @@ #(0 1 2 3) 0 #(1 2 3 foo)) - + +;;; Test that explicit calls to macroexpand in subforms +;;; are done in the correct environment + +(deftest shiftf.4 + (macrolet + ((%m (z) z)) + (let ((x 1) (y 2)) + (values + (shiftf (expand-in-current-env (%m x)) y 'foo) + x y))) + 1 2 foo) + +(deftest shiftf.5 + (macrolet + ((%m (z) z)) + (let ((x 1) (y 2)) + (values + (shiftf x (expand-in-current-env (%m y)) 'foo) + x y))) + 1 2 foo) + +(deftest shiftf.6 + (macrolet + ((%m (z) z)) + (let ((x 1) (y 2)) + (values + (shiftf x y (expand-in-current-env (%m 'foo))) + x y))) + 1 2 foo) ;;; Need to add more shiftf tests here diff --git a/ansi-tests/typecase.lsp b/ansi-tests/typecase.lsp index 7cb53e3d2aec82aa251ac2b2cf9cb3f50751b8ed..777e0f7ab54f5599959873365c2aade8fceb93df 100644 --- a/ansi-tests/typecase.lsp +++ b/ansi-tests/typecase.lsp @@ -121,6 +121,27 @@ collect (list n my-types val i form j))) nil) +;;; Test that explicit calls to macroexpand in subforms +;;; are done in the correct environment + +(deftest typecase.20 + (macrolet + ((%m (z) z)) + (typecase (expand-in-current-env (%m 2)) + ((integer 0 1) :bad1) + ((integer 2 10) :good) + (t :bad2))) + :good) + +(deftest typecase.21 + (macrolet + ((%m (z) z)) + (typecase 2 + ((integer 0 1) (expand-in-current-env (%m :bad1))) + ((integer 2 10) (expand-in-current-env (%m :good))) + (t (expand-in-current-env (%m :bad2))))) + :good) + ;;; Error cases (deftest typecase.error.1 diff --git a/ansi-tests/unless.lsp b/ansi-tests/unless.lsp index d7af1ed991a57706cc46190007018158389b2459..d005c9aa282209379dd5120f9f4548865f46257c 100644 --- a/ansi-tests/unless.lsp +++ b/ansi-tests/unless.lsp @@ -56,6 +56,30 @@ (return-from done 'good))) good) +;;; Test that explicit calls to macroexpand in subforms +;;; are done in the correct environment + +(deftest unless.11 + (macrolet + ((%m (z) z)) + (unless (expand-in-current-env (%m nil)) :good)) + :good) + +(deftest unless.12 + (macrolet + ((%m (z) z)) + (unless (expand-in-current-env (%m t)) :bad)) + nil) + +(deftest unless.13 + (macrolet + ((%m (z) z)) + (let ((x 1) (p nil)) + (values + (unless p (expand-in-current-env (%m (incf x)))) + x))) + 2 2) + (deftest unless.error.1 (signals-error (funcall (macro-function 'unless)) program-error) t) @@ -70,4 +94,4 @@ (signals-error (funcall (macro-function 'unless) '(unless t) nil nil) program-error) - t) \ No newline at end of file + t) diff --git a/ansi-tests/when.lsp b/ansi-tests/when.lsp index d4843d41e1c35e10036bb0e26c29a0a60cc38fd7..7bd2042e307a8ab75169620a0e0d6123b635fd50 100644 --- a/ansi-tests/when.lsp +++ b/ansi-tests/when.lsp @@ -46,6 +46,28 @@ (return-from done 'good))) good) +;;; Test that explicit calls to macroexpand in subforms +;;; are done in the correct environment + +(deftest when.9 + (macrolet + ((%m (z) z)) + (when (expand-in-current-env (%m t)) :good)) + :good) + +(deftest when.10 + (macrolet + ((%m (z) z)) + (when (expand-in-current-env (%m nil)) :bad)) + nil) + +(deftest when.11 + (macrolet + ((%m (z) z)) + (let ((x t)) + (values (when x (expand-in-current-env (%m (setf x 'foo)))) x))) + foo foo) + ;;; Error tests (deftest when.error.1 @@ -62,4 +84,4 @@ (signals-error (funcall (macro-function 'when) '(when t) nil nil) program-error) - t) \ No newline at end of file + t) diff --git a/ansi-tests/with-accessors.lsp b/ansi-tests/with-accessors.lsp index 0f3e66d83f8372fa3844b3adf3b4f15519b2446c..d79b6f0deeafd52671c2cc0021d86e8714ade8b0 100644 --- a/ansi-tests/with-accessors.lsp +++ b/ansi-tests/with-accessors.lsp @@ -124,3 +124,15 @@ (declare (special x)))))) :good) +;;; Test that explicit calls to macroexpand in subforms +;;; are done in the correct environment + +(deftest with-accessors.15 + (macrolet + ((%m (z) z)) + (let ((obj (make-with-accessors-struct-02 :a 'x :b 'y :c 'z))) + (with-accessors ((a wa-2-a) (b wa-2-b) (c wa-2-c)) + (expand-in-current-env (%m obj)) + (values a b c)))) + x y z) + diff --git a/ansi-tests/with-input-from-string.lsp b/ansi-tests/with-input-from-string.lsp index c6eafc059a227357f703277f8bce3a2d1ee1942d..a66f3fc3163adac49f9c641200453717db1ab39a 100644 --- a/ansi-tests/with-input-from-string.lsp +++ b/ansi-tests/with-input-from-string.lsp @@ -215,5 +215,31 @@ i)) #\a nil) +;;; Test that explicit calls to macroexpand in subforms +;;; are done in the correct environment + +(deftest with-input-from-string.23 + (macrolet + ((%m (z) z)) + (with-input-from-string (s (expand-in-current-env (%m "123"))) + (read-char s))) + #\1) + +(deftest with-input-from-string.24 + (macrolet + ((%m (z) z)) + (with-input-from-string (s "123" :start (expand-in-current-env (%m 1))) + (read-char s))) + #\2) + +(deftest with-input-from-string.25 + (macrolet + ((%m (z) z)) + (with-input-from-string (s "123" :start 0 + :end (expand-in-current-env (%m 0))) + (read-char s nil nil))) + nil) + + ;;; FIXME: Add more tests on specialized strings. diff --git a/ansi-tests/with-open-file.lsp b/ansi-tests/with-open-file.lsp index c6c183b3d23c255354a1ff73434d1b80a967b779..a138d82ac0f3a6852987bfdf39832be225d2dbe3 100644 --- a/ansi-tests/with-open-file.lsp +++ b/ansi-tests/with-open-file.lsp @@ -84,3 +84,15 @@ (with-open-file (s "with-open-file.lsp" :direction (return-from done x)) (declare (special x)))))) :good) + +;;; Test that explicit calls to macroexpand in subforms +;;; are done in the correct environment + +(deftest with-open-file.10 + (macrolet + ((%m (z) z)) + (let ((pn #p"tmp.dat")) + (delete-all-versions pn) + (with-open-file (s (expand-in-current-env (%m pn)) + :direction :output)))) + nil)