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 @@
;; Allegro (correctly) won't compile when a tag (typically NIL) is used more than once in a tagbody.
(labels ((find-tagbody (form)
(cond
((and (listp form)
((and (consp form)
(eq (first form)
'tagbody))
form)
((listp form)
((consp form)
(iter (for x in (rest form))
(for y = (find-tagbody x))
(when y
(return y))
(until y)))
(thereis (find-tagbody x))))
(t nil)))
(all-tagbody-tags (form)
(iter (for tag-or-form in (rest (find-tagbody form)))
......@@ -1755,15 +1752,24 @@
(problem-because-i-return-nil)
(+ x x)
(problem-because-i-return-nil))))
(tags (all-tagbody-tags form))
(test-result t))
(iter (for tag in tags)
(when (not (= 1 (funcall #'count tag tags)))
(setf test-result nil)
(format t "Tag ~a is used more than once in the tagbody ~a" tag (find-tagbody form))))
test-result))
(tags (all-tagbody-tags form)))
(iter (for tag in tags)
;; invoke cl:count, not the Iterate clause:
(always (= 1 (funcall #'count tag tags :from-end nil))))))
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
......@@ -31,5 +31,3 @@
,(if doc
`(defconstant ,name ,value ,doc)
`(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