Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
ansi-test
Project overview
Project overview
Details
Activity
Releases
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Issues
0
Issues
0
List
Boards
Labels
Service Desk
Milestones
Merge Requests
0
Merge Requests
0
Operations
Operations
Incidents
Analytics
Analytics
Repository
Value Stream
Wiki
Wiki
Snippets
Snippets
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Create a new issue
Commits
Issue Boards
Open sidebar
Karsten Poeck
ansi-test
Commits
d366781e
Commit
d366781e
authored
Mar 04, 2003
by
pfdietz
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Tests to check that some forms with implicit progns do not also have implicit tagbodies.
parent
90a49ef2
Changes
23
Hide whitespace changes
Inline
Side-by-side
Showing
23 changed files
with
288 additions
and
7 deletions
+288
-7
ansi-tests/block.lsp
ansi-tests/block.lsp
+12
-0
ansi-tests/case.lsp
ansi-tests/case.lsp
+25
-0
ansi-tests/catch.lsp
ansi-tests/catch.lsp
+12
-0
ansi-tests/ccase.lsp
ansi-tests/ccase.lsp
+13
-3
ansi-tests/cond.lsp
ansi-tests/cond.lsp
+10
-3
ansi-tests/ctypecase.lsp
ansi-tests/ctypecase.lsp
+11
-0
ansi-tests/destructuring-bind.lsp
ansi-tests/destructuring-bind.lsp
+10
-0
ansi-tests/ecase.lsp
ansi-tests/ecase.lsp
+11
-0
ansi-tests/etypecase.lsp
ansi-tests/etypecase.lsp
+12
-0
ansi-tests/flet.lsp
ansi-tests/flet.lsp
+9
-1
ansi-tests/labels.lsp
ansi-tests/labels.lsp
+10
-0
ansi-tests/length.lsp
ansi-tests/length.lsp
+0
-0
ansi-tests/let.lsp
ansi-tests/let.lsp
+19
-0
ansi-tests/multiple-value-bind.lsp
ansi-tests/multiple-value-bind.lsp
+12
-0
ansi-tests/multiple-value-prog1.lsp
ansi-tests/multiple-value-prog1.lsp
+14
-0
ansi-tests/prog1.lsp
ansi-tests/prog1.lsp
+10
-0
ansi-tests/prog2.lsp
ansi-tests/prog2.lsp
+12
-0
ansi-tests/progn.lsp
ansi-tests/progn.lsp
+12
-0
ansi-tests/progv.lsp
ansi-tests/progv.lsp
+10
-0
ansi-tests/typecase.lsp
ansi-tests/typecase.lsp
+26
-0
ansi-tests/unless.lsp
ansi-tests/unless.lsp
+12
-0
ansi-tests/unwind-protect.lsp
ansi-tests/unwind-protect.lsp
+13
-0
ansi-tests/when.lsp
ansi-tests/when.lsp
+13
-0
No files found.
ansi-tests/block.lsp
View file @
d366781e
...
...
@@ -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
...
...
ansi-tests/case.lsp
View file @
d366781e
...
...
@@ -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)
ansi-tests/catch.lsp
View file @
d366781e
...
...
@@ -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)
ansi-tests/ccase.lsp
View file @
d366781e
...
...
@@ -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)
ansi-tests/cond.lsp
View file @
d366781e
...
...
@@ -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)
ansi-tests/ctypecase.lsp
View file @
d366781e
...
...
@@ -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)
ansi-tests/destructuring-bind.lsp
View file @
d366781e
...
...
@@ -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
#|
...
...
ansi-tests/ecase.lsp
View file @
d366781e
...
...
@@ -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)
ansi-tests/etypecase.lsp
View file @
d366781e
...
...
@@ -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)
ansi-tests/flet.lsp
View file @
d366781e
...
...
@@ -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)
ansi-tests/labels.lsp
View file @
d366781e
...
...
@@ -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
ansi-tests/length.lsp
View file @
d366781e
No preview for this file type
ansi-tests/let.lsp
View file @
d366781e
...
...
@@ -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)
ansi-tests/multiple-value-bind.lsp
View file @
d366781e
...
...
@@ -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)
...
...
ansi-tests/multiple-value-prog1.lsp
View file @
d366781e
...
...
@@ -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)
ansi-tests/prog1.lsp
View file @
d366781e
...
...
@@ -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)
ansi-tests/prog2.lsp
View file @
d366781e
...
...
@@ -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)
ansi-tests/progn.lsp
View file @
d366781e
...
...
@@ -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
ansi-tests/progv.lsp
View file @
d366781e
...
...
@@ -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)
ansi-tests/typecase.lsp
View file @
d366781e
...
...
@@ -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)
ansi-tests/unless.lsp
View file @
d366781e
...
...
@@ -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)
ansi-tests/unwind-protect.lsp
View file @
d366781e
...
...
@@ -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)
ansi-tests/when.lsp
View file @
d366781e
...
...
@@ -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)
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment