* lisp/emacs-lisp/cl-macs.el (cl-expr-contains): Handle cons cells

whose cdr is not a cons cell correctly.

Fixes: debbugs:11038

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 929451a85edd7eada2e309a8ddb1ddf8cf91c87a..afa4ae803f956d34d7d4476aa7440487545b431f 100644 (file)
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,18 +1,23 @@
+2012-05-06  Christopher Schmidt  <christopher@ch.ristopher.com>
+
+       * emacs-lisp/cl-macs.el (cl-expr-contains): Handle cons cells
+       whose cdr is not a cons cell correctly (bug#11038).
+
 2012-05-06  Chong Yidong  <cyd@gnu.org>
 
-       * emacs-lisp/tabulated-list.el (tabulated-list-format): Accept
-       additional plist in column descriptors.
+       * emacs-lisp/tabulated-list.el (tabulated-list-format):
+       Accept additional plist in column descriptors.
        (tabulated-list-init-header): Obey it.
        (tabulated-list-get-entry): New function.
        (tabulated-list-put-tag): Use it.  Use string-width instead of
        length.
        (tabulated-list--column-number): New function.
        (tabulated-list-print): Use it.
-       (tabulated-list-print-col): New function.  Set
-       `tabulated-list-column-name' property on each column's text.
+       (tabulated-list-print-col): New function.
+       Set `tabulated-list-column-name' property on each column's text.
        (tabulated-list-print-entry): Use it.
-       (tabulated-list-delete-entry, tabulated-list-set-col): New
-       functions.
+       (tabulated-list-delete-entry, tabulated-list-set-col):
+       New functions.
        (tabulated-list-sort-column): New command (Bug#11337).
 
        * buff-menu.el (list-buffers): Move C-x C-b binding from

diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el
index 35cda8cfcf6db36906dbb908528de7195ec3fada..8050da400fe69e4415cf950d9c6dfe3fa0b388a3 100644 (file)
--- a/lisp/emacs-lisp/cl-macs.el
+++ b/lisp/emacs-lisp/cl-macs.el
@@ -143,11 +143,16 @@
 
 ;;; Count number of times X refers to Y.  Return nil for 0 times.
 (defun cl-expr-contains (x y)
+  ;; FIXME: This is naive, and it will count Y as referred twice in
+  ;; (let ((Y 1)) Y) even though it should be 0.  Also it is often called on
+  ;; non-macroexpanded code, so it may also miss some occurrences that would
+  ;; only appear in the expanded code.
   (cond ((equal y x) 1)
        ((and (consp x) (not (memq (car-safe x) '(quote function function*))))
         (let ((sum 0))
-          (while x
+          (while (consp x)
             (setq sum (+ sum (or (cl-expr-contains (pop x) y) 0))))
+          (setq sum (+ sum (or (cl-expr-contains x y) 0)))
           (and (> sum 0) sum)))
        (t nil)))