Skip to content
Snippets Groups Projects
Commit cd158549 authored by Anton Kovalenko's avatar Anton Kovalenko Committed by Nikodemus Siivola
Browse files

fix edge-case in CIRCULAR-TREE-P

  CIRCULAR-TREE-P had an unfortunate corner case, causing it to overflow
  the stack (seen and repoted at #lisp for '#1=(#1#).)

  The problem is caused by the end-test (of the outer DO) being run before the
  body has a first chance to check for (member slow seen).
parent 3eacfac8
No related branches found
No related tags found
No related merge requests found
......@@ -151,14 +151,16 @@ destructively modifying it and saves back the result into the place.")
(and (consp object)
(do ((fast (cons (car object) (cdr object)) (cddr fast))
(slow object (cdr slow)))
((or (not (consp fast)) (not (consp (cdr slow))))
(do ((tail object (cdr tail)))
((not (consp tail))
nil)
(let ((elt (car tail)))
(circularp elt (cons object seen)))))
(nil)
(when (or (eq fast slow) (member slow seen))
(return-from circular-tree-p t))))))
(return-from circular-tree-p t))
(when (or (not (consp fast)) (not (consp (cdr slow))))
(return
(do ((tail object (cdr tail)))
((not (consp tail))
nil)
(let ((elt (car tail)))
(circularp elt (cons object seen))))))))))
(circularp object nil)))
(defun proper-list-p (object)
......
......@@ -606,6 +606,10 @@
(circular-tree-p quite-dotted)))
(t t t t t t nil nil))
(deftest circular-tree-p.2
(alexandria:circular-tree-p '#1=(#1#))
t)
(deftest proper-list-p.1
(let ((l1 (list 1))
(l2 (list 1 2))
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment