Commit d366781e authored by pfdietz's avatar pfdietz

Tests to check that some forms with implicit progns do not also have implicit tagbodies.

parent 90a49ef2
......@@ -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
......
......@@ -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)
......@@ -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)
......@@ -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)
......@@ -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)
......@@ -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)
......@@ -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
#|
......
......@@ -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)
......@@ -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)
......@@ -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)
......@@ -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
No preview for this file type
......@@ -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)
......@@ -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)
......
......@@ -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)
......@@ -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)
......@@ -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)
......@@ -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
......@@ -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)
......@@ -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)
......@@ -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)
......@@ -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)
......@@ -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)
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