From 91fc7832f8176795eb2dfa904cca9ed6d8bd1e1d Mon Sep 17 00:00:00 2001 From: pfdietz <pfdietz@localhost> Date: Fri, 13 Jan 2006 04:25:48 +0000 Subject: [PATCH] Add tests that subforms are macroexpanded in the local environment --- ansi-tests/block.lsp | 7 +++++ ansi-tests/catch.lsp | 17 ++++++++++++ ansi-tests/eval-when.lsp | 6 +++++ ansi-tests/flet.lsp | 15 +++++++++++ ansi-tests/if.lsp | 38 +++++++++++++++++++++++++++ ansi-tests/labels.lsp | 15 ++++++++++- ansi-tests/let.lsp | 12 +++++++++ ansi-tests/letstar.lsp | 22 ++++++++++++++++ ansi-tests/locally.lsp | 7 +++++ ansi-tests/macrolet.lsp | 9 ++++++- ansi-tests/multiple-value-call.lsp | 16 ++++++++++++ ansi-tests/multiple-value-prog1.lsp | 13 ++++++++++ ansi-tests/places.lsp | 14 +++++++++- ansi-tests/progn.lsp | 19 +++++++++++++- ansi-tests/progv.lsp | 40 +++++++++++++++++++++++++++++ ansi-tests/return-from.lsp | 6 +++++ ansi-tests/symbol-macrolet.lsp | 9 +++++++ ansi-tests/tagbody.lsp | 10 +++++++- ansi-tests/the.lsp | 14 ++++++++++ ansi-tests/unwind-protect.lsp | 16 ++++++++++++ 20 files changed, 300 insertions(+), 5 deletions(-) diff --git a/ansi-tests/block.lsp b/ansi-tests/block.lsp index 2f61a345..793010fb 100644 --- a/ansi-tests/block.lsp +++ b/ansi-tests/block.lsp @@ -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 diff --git a/ansi-tests/catch.lsp b/ansi-tests/catch.lsp index 206fb407..8c5ca535 100644 --- a/ansi-tests/catch.lsp +++ b/ansi-tests/catch.lsp @@ -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) diff --git a/ansi-tests/eval-when.lsp b/ansi-tests/eval-when.lsp index 03a927e6..dd3d7e1c 100644 --- a/ansi-tests/eval-when.lsp +++ b/ansi-tests/eval-when.lsp @@ -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) diff --git a/ansi-tests/flet.lsp b/ansi-tests/flet.lsp index 03664187..3c037227 100644 --- a/ansi-tests/flet.lsp +++ b/ansi-tests/flet.lsp @@ -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) + + diff --git a/ansi-tests/if.lsp b/ansi-tests/if.lsp index 764e287c..b4fe98e5 100644 --- a/ansi-tests/if.lsp +++ b/ansi-tests/if.lsp @@ -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)) diff --git a/ansi-tests/labels.lsp b/ansi-tests/labels.lsp index f8c0a73c..b2020ef4 100644 --- a/ansi-tests/labels.lsp +++ b/ansi-tests/labels.lsp @@ -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) diff --git a/ansi-tests/let.lsp b/ansi-tests/let.lsp index 7e487465..0121404b 100644 --- a/ansi-tests/let.lsp +++ b/ansi-tests/let.lsp @@ -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) diff --git a/ansi-tests/letstar.lsp b/ansi-tests/letstar.lsp index 37eca999..6237731c 100644 --- a/ansi-tests/letstar.lsp +++ b/ansi-tests/letstar.lsp @@ -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) + + + diff --git a/ansi-tests/locally.lsp b/ansi-tests/locally.lsp index bc0c4efa..7466fc2b 100644 --- a/ansi-tests/locally.lsp +++ b/ansi-tests/locally.lsp @@ -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) diff --git a/ansi-tests/macrolet.lsp b/ansi-tests/macrolet.lsp index cb1d74ff..f5927d1a 100644 --- a/ansi-tests/macrolet.lsp +++ b/ansi-tests/macrolet.lsp @@ -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 diff --git a/ansi-tests/multiple-value-call.lsp b/ansi-tests/multiple-value-call.lsp index 0fd0ae5e..ab374cee 100644 --- a/ansi-tests/multiple-value-call.lsp +++ b/ansi-tests/multiple-value-call.lsp @@ -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)) + + diff --git a/ansi-tests/multiple-value-prog1.lsp b/ansi-tests/multiple-value-prog1.lsp index 8f4dfb0a..2d574761 100644 --- a/ansi-tests/multiple-value-prog1.lsp +++ b/ansi-tests/multiple-value-prog1.lsp @@ -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) diff --git a/ansi-tests/places.lsp b/ansi-tests/places.lsp index 06426cd5..c9f5e14e 100644 --- a/ansi-tests/places.lsp +++ b/ansi-tests/places.lsp @@ -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) diff --git a/ansi-tests/progn.lsp b/ansi-tests/progn.lsp index 72965496..902fc103 100644 --- a/ansi-tests/progn.lsp +++ b/ansi-tests/progn.lsp @@ -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) + + diff --git a/ansi-tests/progv.lsp b/ansi-tests/progv.lsp index ca0e700e..83a53cfe 100644 --- a/ansi-tests/progv.lsp +++ b/ansi-tests/progv.lsp @@ -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) diff --git a/ansi-tests/return-from.lsp b/ansi-tests/return-from.lsp index c90409e3..5bf7698b 100644 --- a/ansi-tests/return-from.lsp +++ b/ansi-tests/return-from.lsp @@ -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) diff --git a/ansi-tests/symbol-macrolet.lsp b/ansi-tests/symbol-macrolet.lsp index 036e24ce..9dde62ff 100644 --- a/ansi-tests/symbol-macrolet.lsp +++ b/ansi-tests/symbol-macrolet.lsp @@ -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) diff --git a/ansi-tests/tagbody.lsp b/ansi-tests/tagbody.lsp index 5f43df3e..cea5ba3d 100644 --- a/ansi-tests/tagbody.lsp +++ b/ansi-tests/tagbody.lsp @@ -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) diff --git a/ansi-tests/the.lsp b/ansi-tests/the.lsp index a62de8b5..a292d08d 100644 --- a/ansi-tests/the.lsp +++ b/ansi-tests/the.lsp @@ -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) diff --git a/ansi-tests/unwind-protect.lsp b/ansi-tests/unwind-protect.lsp index 359539b8..43df795f 100644 --- a/ansi-tests/unwind-protect.lsp +++ b/ansi-tests/unwind-protect.lsp @@ -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) + + -- GitLab