Skip to content
Snippets Groups Projects
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
No related branches found
No related tags found
No related merge requests found
Showing
with 364 additions and 1 deletion
......@@ -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))
......
......@@ -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))
......@@ -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)
......@@ -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)
......
......@@ -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)
......
......@@ -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)
......@@ -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)
......
......@@ -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)
......
......@@ -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)
......
......@@ -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
#|
......
......@@ -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)
......@@ -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
......
......@@ -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")))
......@@ -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)))
......@@ -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)))
......@@ -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)))
......@@ -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)))
......@@ -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)
......
......@@ -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
......
......@@ -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)
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment