Commit f87559f5 authored by pfdietz's avatar pfdietz

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 @@
(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)
......
......@@ -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))
......@@ -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)
......@@ -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))
......@@ -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)
......@@ -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)
......@@ -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))
......@@ -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