From cd158549ef56f10ef660f22cf4f9ddd96f0693c3 Mon Sep 17 00:00:00 2001 From: Anton Kovalenko <anton@sw4me.com> Date: Sun, 30 Oct 2011 00:33:42 +0300 Subject: [PATCH] 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). --- lists.lisp | 16 +++++++++------- tests.lisp | 4 ++++ 2 files changed, 13 insertions(+), 7 deletions(-) diff --git a/lists.lisp b/lists.lisp index ffe418a..6367bc7 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 b9e2277..ef7d19d 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)) -- GitLab