From 1bead9316d51106046a041a4415744a33c723039 Mon Sep 17 00:00:00 2001
From: Bart Botta <00003b@gmail.com>
Date: Wed, 17 Dec 2008 10:51:49 -0600
Subject: [PATCH] fix LIST-LENGTH

---
 lib/cl-conses2.lisp | 19 +++++++++++--------
 test/test.lisp      |  1 +
 2 files changed, 12 insertions(+), 8 deletions(-)

diff --git a/lib/cl-conses2.lisp b/lib/cl-conses2.lisp
index 2037859..e74681e 100644
--- a/lib/cl-conses2.lisp
+++ b/lib/cl-conses2.lisp
@@ -40,14 +40,17 @@
 
 
 
-  (swf-defun list-length (list)
-    (let ((fast list)
-          (length 0))
-      (dolist (slow list)
-        (when (endp fast) (return  length))
-        (when (endp (cdr fast)) (return  (+ length 1)))
-        (when (and (eq fast slow) (> length 0)) (return nil))
-        (setf fast (cddr fast)))))
+  (swf-defmemfun list-length (list)
+    (if (endp list)
+        0
+        (let ((fast list)
+              (length 0))
+          (dolist (slow list)
+            (when (endp fast) (return length))
+            (when (endp (cdr fast)) (return  (+ length 1)))
+            (when (and (eq fast slow) (> length 0)) (return nil))
+            (incf length 2)
+            (setf fast (cddr fast))))))
 
   ;; LISTP
   (swf-defmemfun listp (a)
diff --git a/test/test.lisp b/test/test.lisp
index cadfc91..9c9ee3a 100644
--- a/test/test.lisp
+++ b/test/test.lisp
@@ -264,6 +264,7 @@
             (incf str (+ " || do test: 4,3,2=" (do/do*-tests)))
             (incf str (+ " || unused args: " (unused-args-test 1 2 3)))
             (incf str (+ " || pi: " %flash:+pi+))
+            (incf str (+ " || length '(1 2 3): " (list-length '(1 2 3))))
             (%flash:trace (+ " || unused args: " (unused-args-test 1 2 3)))
 )
 
-- 
2.11.4.GIT