Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Menu
Open sidebar
Steve Losh
iterate
Commits
899026ca
Commit
899026ca
authored
May 03, 2007
by
Joerg-Cyril Hoehle
Browse files
walk-tagbody: more testcases
darcs-hash:0a41a0f97d7b6d96454f41c0f79e560bc5c74cd0
parent
68810b06
Changes
2
Hide whitespace changes
Inline
Side-by-side
iterate-test.lisp
View file @
899026ca
...
...
@@ -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
(
list
p
form
)
((
and
(
cons
p
form
)
(
eq
(
first
form
)
'tagbody
))
form
)
((
list
p
form
)
((
cons
p
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
package.lisp
View file @
899026ca
...
...
@@ -31,5 +31,3 @@
,
(
if
doc
`
(
defconstant
,
name
,
value
,
doc
)
`
(
defconstant
,
name
,
value
)))))
;;; arch-tag: "b8bb0bb6-313c-11d8-abb9-000c76244c24"
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new 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