Commit 899026ca authored by Joerg-Cyril Hoehle's avatar Joerg-Cyril Hoehle
Browse files

walk-tagbody: more testcases

darcs-hash:0a41a0f97d7b6d96454f41c0f79e560bc5c74cd0
parent 68810b06
...@@ -1735,16 +1735,13 @@ ...@@ -1735,16 +1735,13 @@
;; Allegro (correctly) won't compile when a tag (typically NIL) is used more than once in a tagbody. ;; Allegro (correctly) won't compile when a tag (typically NIL) is used more than once in a tagbody.
(labels ((find-tagbody (form) (labels ((find-tagbody (form)
(cond (cond
((and (listp form) ((and (consp form)
(eq (first form) (eq (first form)
'tagbody)) 'tagbody))
form) form)
((listp form) ((consp form)
(iter (for x in (rest form)) (iter (for x in (rest form))
(for y = (find-tagbody x)) (thereis (find-tagbody x))))
(when y
(return y))
(until y)))
(t nil))) (t nil)))
(all-tagbody-tags (form) (all-tagbody-tags (form)
(iter (for tag-or-form in (rest (find-tagbody form))) (iter (for tag-or-form in (rest (find-tagbody form)))
...@@ -1755,15 +1752,24 @@ ...@@ -1755,15 +1752,24 @@
(problem-because-i-return-nil) (problem-because-i-return-nil)
(+ x x) (+ x x)
(problem-because-i-return-nil)))) (problem-because-i-return-nil))))
(tags (all-tagbody-tags form)) (tags (all-tagbody-tags form)))
(test-result t)) (iter (for tag in tags)
(iter (for tag in tags) ;; invoke cl:count, not the Iterate clause:
(when (not (= 1 (funcall #'count tag tags))) (always (= 1 (funcall #'count tag tags :from-end nil))))))
(setf test-result nil)
(format t "Tag ~a is used more than once in the tagbody ~a" tag (find-tagbody form))))
test-result))
t) t)
(deftest walk.tagbody.1
(iter (tagbody
(problem-because-i-return-nil)
3
(problem-because-i-return-nil)
(leave 2)))
2)
(deftest walk.tagbody.2
(symbol-macrolet ((error-out (error "do not expand me")))
(iter (tagbody error-out
(leave 2))))
2)
;;; eof ;;; eof
...@@ -31,5 +31,3 @@ ...@@ -31,5 +31,3 @@
,(if doc ,(if doc
`(defconstant ,name ,value ,doc) `(defconstant ,name ,value ,doc)
`(defconstant ,name ,value))))) `(defconstant ,name ,value)))))
;;; arch-tag: "b8bb0bb6-313c-11d8-abb9-000c76244c24"
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