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

whose cdr is not a cons cell correctly.

Fixes: debbugs:11038

2 files changed, 17 insertions, 7 deletions

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 929451a85ed..afa4ae803f9 100644
--- 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 35cda8cfcf6..8050da400fe 100644
--- 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)))