diff --git a/lists.lisp b/lists.lisp index ffe418ad0f42c10891eaaec769bf17e67331d4ee..6367bc7932f809f36d1599e8aa9f9f3da17bc03e 100644 --- a/lists.lisp +++ b/lists.lisp @@ -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) diff --git a/tests.lisp b/tests.lisp index b9e2277bc2d0b9a6b2bd8575c3ca61c506c90226..ef7d19d38c1b74fbd9be55f38e661bc8aa2a6c51 100644 --- a/tests.lisp +++ b/tests.lisp @@ -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))