summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorKaz Kylheku <kaz@kylheku.com>2016-11-06 19:22:11 -0800
committerKaz Kylheku <kaz@kylheku.com>2016-11-06 19:22:11 -0800
commit8077a89133b50fb6863ce0b202803d1cf41d8f39 (patch)
tree5366d44f6d2007ef6072c512eb1bf20297d5b6a7
parent64941defcd16ba61afee20ab5fb0eac6e6ea58b1 (diff)
downloadtxr-8077a89133b50fb6863ce0b202803d1cf41d8f39.tar.gz
txr-8077a89133b50fb6863ce0b202803d1cf41d8f39.tar.bz2
txr-8077a89133b50fb6863ce0b202803d1cf41d8f39.zip
Fix regression: infinite loop in place expansion.
This shows up when the anaphoric ifa is used. Test case: | (ifa (f a) | (set it (g it))) * share/txr/stdlib/place.tl (sys:pl-expand): In the origin chasing loop, use a stack to more thoroughly detect a cycle.
-rw-r--r--share/txr/stdlib/place.tl10
1 files changed, 6 insertions, 4 deletions
diff --git a/share/txr/stdlib/place.tl b/share/txr/stdlib/place.tl
index 48e0182e..12ad1b71 100644
--- a/share/txr/stdlib/place.tl
+++ b/share/txr/stdlib/place.tl
@@ -165,12 +165,14 @@
(defun sys:cp-origin (to-tree from-form : circ-check)
(unless (memq to-tree circ-check)
(tree-case to-tree
- ((a . d) (whenlet (next-orig
- (orig (macro-ancestor to-tree)))
- (while (and (neq orig from-form)
+ ((a . d) (whenlet ((next-orig nil)
+ (visited-stack (list from-form))
+ (orig (macro-ancestor to-tree)))
+ (while (and (not (memq orig visited-stack))
(sys:setq next-orig (macro-ancestor orig)))
+ (sys:setq visited-stack (cons next-orig visited-stack))
(sys:setq orig next-orig))
- (unless (eq orig from-form)
+ (unless (memq orig visited-stack)
(sys:set-macro-ancestor orig from-form)))
(sys:cp-origin a from-form (cons to-tree circ-check))
(sys:cp-origin d from-form (cons to-tree circ-check)))))