diff --git a/ansi-tests/block.lsp b/ansi-tests/block.lsp index b68d9dfff4f040b0d46ca04fe5e366e79734caa9..84321ffb7468f052880390ae282d62aa1fb8223d 100644 --- a/ansi-tests/block.lsp +++ b/ansi-tests/block.lsp @@ -64,6 +64,18 @@ 'bad) good) +;;; Block has no tagbody +(deftest block.11 + (block done + (tagbody + (block nil + (go 10) + 10 + (return-from done 'bad)) + 10 + (return-from done 'good))) + good) + #| (deftest return.error.1 (classify-error diff --git a/ansi-tests/case.lsp b/ansi-tests/case.lsp index 3118ccc7f76eccce3a0555856c8f7d34d8e930f3..0ec8b1bd3813ad70a3b4367ea128a36587811b0e 100644 --- a/ansi-tests/case.lsp +++ b/ansi-tests/case.lsp @@ -166,6 +166,31 @@ (case 'a (b 'b) (otherwise)) nil) +;;; No implicit tagbody +(deftest case.35 + (block done + (tagbody + (case 'a (a (go 10) + 10 + (return-from done 'bad))) + 10 + (return-from done 'good))) + good) + +(deftest case.36 + (block done + (tagbody + (case 'b + (a 'bad) + (otherwise (go 10) + 10 + (return-from done 'bad))) + 10 + (return-from done 'good))) + good) + + + ;;; (deftest case.error.1 ;;; (classify-error (case)) ;;; program-error) diff --git a/ansi-tests/catch.lsp b/ansi-tests/catch.lsp index 5a3732e24d409f555b0390f30c6fb97a245a7b79..2cbcadb1a21ee3b7107b35e163d68e49c1911d86 100644 --- a/ansi-tests/catch.lsp +++ b/ansi-tests/catch.lsp @@ -70,6 +70,18 @@ 'bad)) good) +;;; No implicit tagbody +(deftest catch.13 + (block done + (tagbody + (catch 'foo + (go 10) + 10 + (return-from done 'bad)) + 10 + (return-from done 'good))) + good) + (deftest throw-error (classify-error (throw (gensym) nil)) control-error) diff --git a/ansi-tests/ccase.lsp b/ansi-tests/ccase.lsp index 8bbc4455be38dd21e8d312aef0a4c7c8a6bb4110..76642a35f228a7c4fe31ad876a1bc94d873d97df 100644 --- a/ansi-tests/ccase.lsp +++ b/ansi-tests/ccase.lsp @@ -181,9 +181,19 @@ (2 nil)))) :good) +;;; No implicit tagbody +(deftest ccase.32 + (block done + (tagbody + (let ((x 'a)) + (ccase x (a (go 10) + 10 + (return-from done 'bad)))) + 10 + (return-from done 'good))) + good) + + ;;; (deftest ccase.error.1 ;;; (classify-error (ccase)) ;;; program-error) - - - diff --git a/ansi-tests/cond.lsp b/ansi-tests/cond.lsp index df3424850eeb3a16dee5d907111135616acf5eb7..1150887c2a7da605ac3563ab0db5873ef5046f2e 100644 --- a/ansi-tests/cond.lsp +++ b/ansi-tests/cond.lsp @@ -70,6 +70,13 @@ (deftest cond.14 (cond (t (values)))) - - - +;;; No implicit tagbody +(deftest cond.15 + (block done + (tagbody + (cond (t (go 10) + 10 + (return-from done 'bad))) + 10 + (return-from done 'good))) + good) diff --git a/ansi-tests/ctypecase.lsp b/ansi-tests/ctypecase.lsp index 7e7ea508a8433cea8a13cf361ee5cc1f7c9a7d74..c786a7c121725064c1912dd65e86fc22257b5062 100644 --- a/ansi-tests/ctypecase.lsp +++ b/ansi-tests/ctypecase.lsp @@ -86,3 +86,14 @@ (#.(find-class 'symbol nil) 'good)) good) +(deftest ctypecase.14 + (block done + (tagbody + (let ((x 'a)) + (ctypecase x (symbol (go 10) + 10 + (return-from done 'bad)))) + 10 + (return-from done 'good))) + good) + diff --git a/ansi-tests/destructuring-bind.lsp b/ansi-tests/destructuring-bind.lsp index d24eb5cbc7b3e66c850bb59405399f70f733153d..afa8d97defdba609802602e0c30c3c25256d2c34 100644 --- a/ansi-tests/destructuring-bind.lsp +++ b/ansi-tests/destructuring-bind.lsp @@ -80,6 +80,16 @@ (destructuring-bind ((&key a b c)) '((:c 1 :b 2)) (values a b c)) nil 2 1) +;;; Test that destructuring-bind does not have a tagbody +(deftest destructuring-bind.19 + (block nil + (tagbody + (destructuring-bind (a . b) '(1 2) (go 10) 10 (return 'bad)) + 10 + (return 'good))) + good) + + ;;; Error cases #| diff --git a/ansi-tests/ecase.lsp b/ansi-tests/ecase.lsp index ed47af863b6bd50e10fcc2d7622406753cd0336e..72c377151a740fc8885d50f9be05f1b0c1667948 100644 --- a/ansi-tests/ecase.lsp +++ b/ansi-tests/ecase.lsp @@ -147,3 +147,14 @@ (deftest ecase.32 (ecase 'a (a) (b 'b)) nil) + +;;; No implicit tagbody +(deftest ecase.33 + (block done + (tagbody + (ecase 'a (a (go 10) + 10 + (return-from done 'bad))) + 10 + (return-from done 'good))) + good) diff --git a/ansi-tests/etypecase.lsp b/ansi-tests/etypecase.lsp index 06d46ec6b5c34bdc5104b78ffaa7d59ad559d76f..189cbde75bb06a42a59676aea4a81faea5db4bee 100644 --- a/ansi-tests/etypecase.lsp +++ b/ansi-tests/etypecase.lsp @@ -59,3 +59,15 @@ (#.(find-class 'symbol nil) 'good)) good) +(deftest etypecase.13 + (block nil + (tagbody + (let ((x 'a)) + (etypecase x (symbol (go 10) + 10 + (return 'bad)))) + 10 + (return 'good))) + good) + + diff --git a/ansi-tests/flet.lsp b/ansi-tests/flet.lsp index a4691f72c1b7a7f99ea73145e27851cf80e9a6ef..0b3099fe3dbb0107ed3b9ea8de527eb37c624e19 100644 --- a/ansi-tests/flet.lsp +++ b/ansi-tests/flet.lsp @@ -428,4 +428,12 @@ collect s) nil) - +;;; Check that FLET does not have a tagbody +(deftest flet.52 + (block done + (tagbody + (flet ((%f () (go 10) 10 (return-from done 'bad))) + (%f)) + 10 + (return-from done 'good))) + good) diff --git a/ansi-tests/labels.lsp b/ansi-tests/labels.lsp index 37f88021688e08cc9df002df126a87a4e12b5a6e..466c1502d7f917e4a192a0cf6e1a7922b276030d 100644 --- a/ansi-tests/labels.lsp +++ b/ansi-tests/labels.lsp @@ -212,3 +212,13 @@ unless (eq (eval form) 'a) collect s) nil) + +;;; Check that LABELS does not have a tagbody +(deftest labels.27 + (block done + (tagbody + (labels ((%f () (go 10) 10 (return-from done 'bad))) + (%f)) + 10 + (return-from done 'good))) + good) \ No newline at end of file diff --git a/ansi-tests/length.lsp b/ansi-tests/length.lsp index 79aab2dad52374b917f84fc851513fa657fb29b6..039ee052de704d7d381156b7aeade4b1a6d05e89 100644 Binary files a/ansi-tests/length.lsp and b/ansi-tests/length.lsp differ diff --git a/ansi-tests/let.lsp b/ansi-tests/let.lsp index 14196616c9aa9d4dda08f1f9a4c44bf85b7e35e9..e661fc1292c8e8fec50e0028dc390175d697a5ad 100644 --- a/ansi-tests/let.lsp +++ b/ansi-tests/let.lsp @@ -110,6 +110,16 @@ collect s) nil) +;;; Check that LET does not have a tagbody +(deftest let.16 + (block done + (tagbody + (let () (go 10) 10 (return-from done 'bad)) + 10 + (return-from done 'good))) + good) + + ;;; Tests for LET* (deftest let*.1 @@ -208,3 +218,12 @@ unless (eql (eval form) 17) collect s) nil) + +;;; Check that LET* does not have a tagbody +(deftest let*.16 + (block done + (tagbody + (let () (go 10) 10 (return-from done 'bad)) + 10 + (return-from done 'good))) + good) diff --git a/ansi-tests/multiple-value-bind.lsp b/ansi-tests/multiple-value-bind.lsp index 9c5b85519ce92e295586cc4f7e2f631cf0f9dac8..6ffc1b8f3a953803affa11928111786fe3a01da4 100644 --- a/ansi-tests/multiple-value-bind.lsp +++ b/ansi-tests/multiple-value-bind.lsp @@ -51,6 +51,18 @@ x y z)) (1 2 0) nil nil 0) +;;; No implicit tagbody +(deftest multiple-value-bind.8 + (block nil + (tagbody + (multiple-value-bind (x) nil + (go 10) + 10 + (return 'bad)) + 10 + (return 'good))) + good) + ;;; (deftest multiple-value-bind.error.1 ;;; (classify-error (multiple-value-bind)) ;;; program-error) diff --git a/ansi-tests/multiple-value-prog1.lsp b/ansi-tests/multiple-value-prog1.lsp index d8ab80cd5b53da73cb540324bcc1e36006cbec57..8f4dfb0acc4c037cd4b304f99cbf767b716a9c83 100644 --- a/ansi-tests/multiple-value-prog1.lsp +++ b/ansi-tests/multiple-value-prog1.lsp @@ -69,3 +69,17 @@ (return-from foo 'a))) x y)) a 1 2) + +;;; No implicit tagbody +(deftest multiple-value-prog1.10 + (block nil + (tagbody + (multiple-value-prog1 + (values) + (go 10) + 10 + (return 'bad)) + 10 + (return 'good))) + good) + diff --git a/ansi-tests/prog1.lsp b/ansi-tests/prog1.lsp index 66c845977ed776a8a16cf569d2301096488acbb0..979b2c6cbbad8fc4ed7e9abefdb3cb31f58284c5 100644 --- a/ansi-tests/prog1.lsp +++ b/ansi-tests/prog1.lsp @@ -25,3 +25,13 @@ (let ((x 0)) (values (prog1 x (incf x)) x)) 0 1) + +;;; Test that prog1 doesn't have a tagbody + +(deftest prog1.6 + (block nil + (tagbody + (return (prog1 'bad (go 10) 10)) + 10 + (return 'good))) + good) diff --git a/ansi-tests/prog2.lsp b/ansi-tests/prog2.lsp index 97dbed83fac558383b92310c9e1537a7be374c8e..c3659fcab203043fc90df9d67c25d9c96c44779e 100644 --- a/ansi-tests/prog2.lsp +++ b/ansi-tests/prog2.lsp @@ -34,3 +34,15 @@ (prog2 (incf x (1+ x)) (incf x (+ 2 x)) (incf x 100)) x)) 8 108) + +;;; Test that prog2 doesn't have a tagbody + +(deftest prog2.7 + (block nil + (tagbody + (return (prog2 17 'bad (go 10) 10)) + 10 + (return 'good))) + good) + + diff --git a/ansi-tests/progn.lsp b/ansi-tests/progn.lsp index 159530c97a662ba094ab39e19bdf7bc26101853d..72965496d41bb98ccb56d67d00375fea12744c85 100644 --- a/ansi-tests/progn.lsp +++ b/ansi-tests/progn.lsp @@ -36,3 +36,15 @@ x (return 'good))) good) + +;;; No implicit tagbody +(deftest progn.8 + (block nil + (tagbody + (progn + (go 10) + 10 + (return 'bad)) + 10 + (return 'good))) + good) \ No newline at end of file diff --git a/ansi-tests/progv.lsp b/ansi-tests/progv.lsp index 5b863f0ce576d46f1279488cd1cb2153bca4ef52..74f71022f1d087a11c0678f1d631ec664bbf1d37 100644 --- a/ansi-tests/progv.lsp +++ b/ansi-tests/progv.lsp @@ -73,3 +73,13 @@ (progn (setf y (incf c)) nil) (values x y c))) 1 2 2) + +;;; No tagbody + +(deftest progv.11 + (block nil + (tagbody + (progv nil nil (go 10) 10 (return 'bad)) + 10 + (return 'good))) + good) diff --git a/ansi-tests/typecase.lsp b/ansi-tests/typecase.lsp index 2c83a42640f250b96965955f3f82ccaca0c7aafe..48f609cb6c1481049d3e9d70c300eef43530457f 100644 --- a/ansi-tests/typecase.lsp +++ b/ansi-tests/typecase.lsp @@ -70,3 +70,29 @@ (number 'bad) (#.(find-class 'symbol nil) 'good)) good) + +(deftest typecase.16 + (block done + (tagbody + (typecase 'a (symbol (go 10) + 10 + (return-from done 'bad))) + 10 + (return-from done 'good))) + good) + +(deftest typecase.17 + (block done + (tagbody + (typecase 'a + (integer 'bad) + (t (go 10) + 10 + (return-from done 'bad))) + 10 + (return-from done 'good))) + good) + + + + diff --git a/ansi-tests/unless.lsp b/ansi-tests/unless.lsp index 11a93a68b0c06edaffa42980b3b5e888ae155681..948c2c8ba52d02913ec05c1b2ba46957a0a1356f 100644 --- a/ansi-tests/unless.lsp +++ b/ansi-tests/unless.lsp @@ -44,6 +44,18 @@ x)) a 1) +;;; No implicit tagbody +(deftest unless.10 + (block done + (tagbody + (unless nil + (go 10) + 10 + (return-from done 'bad)) + 10 + (return-from done 'good))) + good) + ;;; (deftest unless.error.1 ;;; (classify-error (unless)) ;;; program-error) diff --git a/ansi-tests/unwind-protect.lsp b/ansi-tests/unwind-protect.lsp index 03d6fd3e3330301380b04ec9bb07aa41c83d606e..8b902ea5f9f352307a1d2e3af86a26e590679031 100644 --- a/ansi-tests/unwind-protect.lsp +++ b/ansi-tests/unwind-protect.lsp @@ -88,3 +88,16 @@ (push 'a x))) (type-error () x))) (a)) + +;;; No implicit tagbody +(deftest unwind-protect.10 + (block done + (tagbody + (unwind-protect + 'foo + (go 10) + 10 + (return-from done 'bad)) + 10 + (return-from done 'good))) + good) diff --git a/ansi-tests/when.lsp b/ansi-tests/when.lsp index 67840fbd7e9027f6dafbdbd6831aef3e3d4904dd..3dc179d7d48ccb27b077becc9404f0b1570ddec8 100644 --- a/ansi-tests/when.lsp +++ b/ansi-tests/when.lsp @@ -34,6 +34,19 @@ x)) a 1) +;;; No implicit tagbody +(deftest when.8 + (block done + (tagbody + (when t + (go 10) + 10 + (return-from done 'bad)) + 10 + (return-from done 'good))) + good) + + ;;; (deftest when.error.1 ;;; (classify-error (when)) ;;; program-error)