Commit f87559f5 authored by pfdietz's avatar pfdietz
Browse files

Add tests that arguments to many standardized macros are expandedin the...

Add tests that arguments to many standardized macros are expandedin the correct environment, if the macro implementation does thatexpansion itself (for example, if CONSTANTP does macro expansion)
parent c4c5f9e0
...@@ -39,6 +39,19 @@ ...@@ -39,6 +39,19 @@
(and (values nil t) t) (and (values nil t) t)
nil) 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 (deftest and.order.1
(let ((x 0)) (let ((x 0))
(values (and nil (incf x)) (values (and nil (incf x))
......
...@@ -1177,3 +1177,11 @@ the condition to go uncaught if it cannot be classified." ...@@ -1177,3 +1177,11 @@ the condition to go uncaught if it cannot be classified."
,form)) ,form))
(eq (%f) (%f))) (eq (%f) (%f)))
nil)) 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))
...@@ -88,3 +88,18 @@ ...@@ -88,3 +88,18 @@
(assert (> x 5) () 'type-error) (assert (> x 5) () 'type-error)
x)) x))
6) 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)
...@@ -189,7 +189,18 @@ ...@@ -189,7 +189,18 @@
(return-from done 'good))) (return-from done 'good)))
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 ;;; (deftest case.error.1
;;; (signals-error (case) program-error) ;;; (signals-error (case) program-error)
......
...@@ -174,6 +174,20 @@ ...@@ -174,6 +174,20 @@
(return-from done 'good))) (return-from done 'good)))
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 ;;; (deftest ccase.error.1
;;; (signals-error (ccase) program-error) ;;; (signals-error (ccase) program-error)
......
...@@ -62,3 +62,22 @@ ...@@ -62,3 +62,22 @@
(store-value 15)))) (store-value 15))))
(values (check-type x number) x))) (values (check-type x number) x)))
nil 15) 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)
...@@ -81,6 +81,26 @@ ...@@ -81,6 +81,26 @@
(return-from done 'good))) (return-from done 'good)))
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 (deftest cond.error.1
(signals-error (funcall (macro-function 'cond)) (signals-error (funcall (macro-function 'cond))
program-error) program-error)
......
...@@ -99,6 +99,28 @@ ...@@ -99,6 +99,28 @@
(return-from done 'good))) (return-from done 'good)))
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 (deftest ctypecase.error.1
(signals-error (funcall (macro-function 'ctypecase)) (signals-error (funcall (macro-function 'ctypecase))
program-error) program-error)
......
...@@ -142,6 +142,27 @@ ...@@ -142,6 +142,27 @@
(values (decf x #c(0.0l0 -2.0l0)) x)) (values (decf x #c(0.0l0 -2.0l0)) x))
#c(1.0l0 2.0l0) #c(1.0l0 2.0l0)) #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 (deftest decf.order.2
(let ((a (vector 1 2 3 4)) (let ((a (vector 1 2 3 4))
(i 0) x y z) (i 0) x y z)
......
...@@ -161,6 +161,15 @@ ...@@ -161,6 +161,15 @@
(destructuring-bind (x &aux (y (list x))) '(:foo) (values x y)) (destructuring-bind (x &aux (y (list x))) '(:foo) (values x y))
:foo (:foo)) :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 ;;; Error cases
#| #|
......
...@@ -122,3 +122,12 @@ ...@@ -122,3 +122,12 @@
(setq should-have-returned t) (setq should-have-returned t)
(return :good)))) (return :good))))
: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)
...@@ -130,6 +130,21 @@ ...@@ -130,6 +130,21 @@
(declare (special x))))) (declare (special x)))))
:good) :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 ;;; Error tests
(def-macro-test do-external-symbols.error.1 (def-macro-test do-external-symbols.error.1
......
...@@ -154,5 +154,20 @@ ...@@ -154,5 +154,20 @@
(declare (special x))))) (declare (special x)))))
:good) :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 (def-macro-test do-symbols.error.1
(do-symbols (x "CL"))) (do-symbols (x "CL")))
...@@ -161,5 +161,44 @@ ...@@ -161,5 +161,44 @@
(declare (special x))))) (declare (special x)))))
:good) :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 (def-macro-test do.error.1
(do ((i 0 (1+ i))) ((= i 5) 'a))) (do ((i 0 (1+ i))) ((= i 5) 'a)))
...@@ -131,6 +131,27 @@ ...@@ -131,6 +131,27 @@
(declare (special x))))) (declare (special x)))))
:good) :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 (def-macro-test dolist.error.1
(dolist (x nil))) (dolist (x nil)))
...@@ -161,5 +161,44 @@ ...@@ -161,5 +161,44 @@
(declare (special x))))) (declare (special x)))))
:good) :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 (def-macro-test do*.error.1
(do* ((i 0 (1+ i))) ((= i 5) 'a))) (do* ((i 0 (1+ i))) ((= i 5) 'a)))
...@@ -201,5 +201,24 @@ ...@@ -201,5 +201,24 @@
bound j)) bound j))
nil 0 4) 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 (def-macro-test dotimes.error.1
(dotimes (i 10))) (dotimes (i 10)))
...@@ -159,6 +159,18 @@ ...@@ -159,6 +159,18 @@
(return-from done 'good))) (return-from done 'good)))
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 (deftest ecase.error.1
(signals-error (funcall (macro-function 'ecase)) program-error) (signals-error (funcall (macro-function 'ecase)) program-error)
t) t)
......
...@@ -108,6 +108,27 @@ ...@@ -108,6 +108,27 @@
collect (list n my-types val i form j))) collect (list n my-types val i form j)))
nil) 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 ;;; Error cases
......
...@@ -142,6 +142,27 @@ ...@@ -142,6 +142,27 @@
(values (incf x #c(0.0l0 -2.0l0)) x)) (values (incf x #c(0.0l0 -2.0l0)) x))
#c(1.0l0 -2.0l0) #c(1.0l0 -2.0l0)) #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 (deftest incf.order.2
(let ((a (vector 1 2 3 4)) (let ((a (vector 1 2 3 4))
(i 0) x y z) (i 0) x y z)
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment