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