Commit 91fc7832 authored by pfdietz's avatar pfdietz

Add tests that subforms are macroexpanded in the local environment

parent 1d84bb97
......@@ -76,6 +76,13 @@
(return-from done 'good)))
good)
;;; Macros are expanded in the appropriate environment
(deftest block.12
(macrolet ((%m (z) z))
(block foo (expand-in-current-env (%m :good))))
:good)
#|
(deftest return.error.1
(signals-error
......
......@@ -82,6 +82,23 @@
(return-from done 'good)))
good)
;;; Macros are expanded in the appropriate environment
(deftest catch.14
(macrolet ((%m (z) z))
(catch 'foo (expand-in-current-env (%m :good))))
:good)
(deftest catch.15
(macrolet ((%m (z) z))
(catch 'foo (throw (expand-in-current-env (%m 'foo)) :good) :bad))
:good)
(deftest catch.16
(macrolet ((%m (z) z))
(catch 'foo (throw 'foo (expand-in-current-env (%m :good))) :bad))
:good)
(deftest throw-error
(signals-error (throw (gensym) nil) control-error)
t)
......@@ -133,3 +133,9 @@
(values (eval-when (eval) (setq x :good)) x))
:good :good)
;;; Macros are expanded in the appropriate environment
(deftest eval-when.18
(macrolet ((%m (z) z))
(eval-when (:execute) (expand-in-current-env (%m :good))))
:good)
......@@ -545,3 +545,18 @@
(mapcar (%f 2) '(a b c)))))
(1 2 3)
(5 7 9))
;;; Macros are expanded in the appropriate environment
(deftest flet.70
(macrolet ((%m (z) z))
(flet () (expand-in-current-env (%m :good))))
:good)
(deftest flet.71
(macrolet ((%m (z) z))
(flet ((%f () (expand-in-current-env (%m :good))))
(%f)))
:good)
......@@ -29,6 +29,44 @@
(deftest if.7 (if nil 'a (values)))
;;; Macros are expanded in the appropriate environment
(deftest if.8
(macrolet ((%m (z) z))
(if (expand-in-current-env (%m t)) :good :bad))
:good)
(deftest if.9
(macrolet ((%m (z) z))
(if (expand-in-current-env (%m nil)) :bad))
nil)
(deftest if.10
(macrolet ((%m (z) z))
(if (expand-in-current-env (%m t)) :good))
:good)
(deftest if.11
(macrolet ((%m (z) z))
(if (expand-in-current-env (%m nil)) :bad :good))
:good)
(deftest if.12
(macrolet
((%m (z) z))
(flet ((%f (x y) (if x (expand-in-current-env (%m y)))))
(declare (notinline %f))
(values (%f t :good) (%f nil :bad))))
:good nil)
(deftest if.13
(macrolet
((%m (z) z))
(flet ((%f (x y z) (if x y (expand-in-current-env (%m z)))))
(declare (notinline %f))
(values (%f t :good :bad) (%f nil :bad :good))))
:good :good)
(deftest if.order.1
(let ((i 0))
(values (if (= (incf i) 1) 't nil) i))
......
......@@ -390,4 +390,17 @@
(labels ((%f () x))
(declare (special x))
(%f))))
:good)
\ No newline at end of file
:good)
;;; Macros are expanded in the appropriate environment
(deftest labels.48
(macrolet ((%m (z) z))
(labels () (expand-in-current-env (%m :good))))
:good)
(deftest labels.49
(macrolet ((%m (z) z))
(labels ((%f () (expand-in-current-env (%m :good))))
(%f)))
:good)
......@@ -156,3 +156,15 @@
unless (eql (eval `(let ((,k :foo)) ,k)) :foo)
collect k)
nil)
;;; Macros are expanded in the appropriate environment
(deftest let.20
(macrolet ((%m (z) z))
(let () (expand-in-current-env (%m :good))))
:good)
(deftest let.21
(macrolet ((%m (z) z))
(let ((x (expand-in-current-env (%m 1)))) (+ x x x)))
3)
......@@ -161,3 +161,25 @@
unless (eql (eval `(let* ((,k :foo)) ,k)) :foo)
collect k)
nil)
;;; Macros are expanded in the appropriate environment
(deftest let*.21
(macrolet ((%m (z) z))
(let* () (expand-in-current-env (%m :good))))
:good)
(deftest let*.22
(macrolet ((%m (z) z))
(let* ((x (expand-in-current-env (%m 1)))) (+ x x x)))
3)
(deftest let*.23
(macrolet ((%m (z) z))
(let* ((x (expand-in-current-env (%m 1)))
(y (expand-in-current-env (%m 2))))
(+ x y)))
3)
......@@ -37,3 +37,10 @@
(deftest locally.7
(locally (declare))
nil)
;;; Macros are expanded in the appropriate environment
(deftest locally.8
(macrolet ((%m (z) z))
(locally (expand-in-current-env (%m :good))))
:good)
......@@ -22,7 +22,6 @@
y z))))
6 a (6 2) (a 4))
;;; Inner definitions shadow outer ones
(deftest macrolet.3
(macrolet ((%m (w) `(cadr ,w)))
......@@ -414,4 +413,12 @@
(%m (t))))))
t)
;;; Macros are expanded in the appropriate environment
(deftest macrolet.46
(macrolet ((%m (z) z))
(macrolet () (expand-in-current-env (%m :good))))
:good)
;;; TODO: more special declarations for other macrolet arguments
......@@ -16,3 +16,19 @@
(deftest multiple-value-call.3
(multiple-value-call 'list (floor 13 4))
(3 1))
;;; Macros are expanded in the appropriate environment
(deftest multiple-value-call.4
(macrolet
((%m (z) z))
(multiple-value-call (expand-in-current-env (%m #'list)) (values 1 2)))
(1 2))
(deftest multiple-value-call.5
(macrolet
((%m (z) z))
(multiple-value-call 'list (expand-in-current-env (%m (values 1 2)))))
(1 2))
......@@ -83,3 +83,16 @@
(return 'good)))
good)
;;; Macros are expanded in the appropriate environment
(deftest multiple-value-prog1.11
(macrolet
((%m (z) z))
(multiple-value-prog1 (expand-in-current-env (%m :good))))
:good)
(deftest multiple-value-prog1.12
(macrolet
((%m (z) z))
(multiple-value-prog1 :good (expand-in-current-env (%m :foo))))
:good)
......@@ -238,7 +238,19 @@
(declare (special *x*))
(setq *x* 1))
1)
;;; Test that explicit calls to macroexpand in subforms
;;; are done in the correct environment
(deftest setq.7
(macrolet
((%m (z) z))
(let ((x nil))
(values (setq x (expand-in-current-env (%m :good)))
x)))
:good :good)
;;; Tests of SETF
(deftest setf.1
(setf)
......
......@@ -47,4 +47,21 @@
(return 'bad))
10
(return 'good)))
good)
\ No newline at end of file
good)
;;; Macros are expanded in the appropriate environment
(deftest progn.9
(macrolet
((%m (z) z))
(progn (expand-in-current-env (%m :good))))
:good)
(deftest progn.10
(macrolet
((%m (z) z))
(progn (expand-in-current-env (%m :bad))
(expand-in-current-env (%m :good))))
:good)
......@@ -93,3 +93,43 @@
x
(boundp 'y))))
1 nil)
;;; Macros are expanded in the appropriate environment
(deftest progv.13
(macrolet
((%m (z) z))
(progv (expand-in-current-env (%m '(x)))
'(:good)
(locally (declare (special x)) x)))
:good)
(deftest progv.14
(macrolet
((%m (z) z))
(progv (list (expand-in-current-env (%m 'x)))
'(:good)
(locally (declare (special x)) x)))
:good)
(deftest progv.15
(macrolet
((%m (z) z))
(progv '(x)
(expand-in-current-env (%m '(:good)))
(locally (declare (special x)) x)))
:good)
(deftest progv.16
(macrolet
((%m (z) z))
(progv '(x)
(list (expand-in-current-env (%m :good)))
(locally (declare (special x)) x)))
:good)
(deftest progv.17
(macrolet
((%m (z) z))
(progv nil nil (expand-in-current-env (%m :good))))
:good)
......@@ -15,4 +15,10 @@
(block nil (return-from nil :good) :bad)
:good)
;;; Macros are expanded in the appropriate environment
(deftest return-from.3
(macrolet
((%m (z) z))
(block foo (return-from foo (expand-in-current-env (%m :good)))))
:good)
......@@ -74,3 +74,12 @@
(signals-error (symbol-macrolet ((*pathnames* 19)) *pathnames*)
program-error)
t)
;;; Test that explicit calls to macroexpand in subforms
;;; are done in the correct environment
(deftest symbol-macrolet.9
(macrolet
((%m (z) z))
(symbol-macrolet () (expand-in-current-env (%m :good))))
:good)
......@@ -161,6 +161,7 @@
;;; Check that macros are not expanded before finding tags
;;; Test for issue TAGBODY-TAG-EXPANSION
(deftest tagbody.17
(block done
(tagbody
......@@ -174,4 +175,11 @@
(return-from done :good)))
:good)
;;; Test that explicit calls to macroexpand in subforms
;;; are done in the correct environment
(deftest tagbody.18
(macrolet ((%m (z) z))
(tagbody
(expand-in-current-env (%m :foo))))
nil)
......@@ -126,4 +126,18 @@
(the (values symbol integer &optional fixnum) (eval '(values 'a 1))))
(a 1))
;;; Test that explicit calls to macroexpand in subforms
;;; are done in the correct environment
(deftest the.24
(macrolet
((%m (z) z))
(the (integer 0 10) (expand-in-current-env (%m 4))))
4)
(deftest the.25
(macrolet
((%m (z) z))
(the (values t t) (expand-in-current-env (%m (values 1 2)))))
1 2)
......@@ -113,3 +113,19 @@
x y))
a b c)
;;; Test that explicit calls to macroexpand in subforms
;;; are done in the correct environment
(deftest unwind-protect.12
(macrolet
((%m (z) z))
(unwind-protect (expand-in-current-env (%m :good)) :bad))
:good)
(deftest unwind-protect.13
(macrolet
((%m (z) z))
(unwind-protect :good (expand-in-current-env (%m :bad))))
:good)
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