[Emacs-diffs] /srv/bzr/emacs/trunk r108142: * lisp/emacs-lisp/cl-macs.el (cl-expr-contains): Handle cons cells

[Stefan Monnier]

------------------------------------------------------------
revno: 108142
fixes bug(s): http://debbugs.gnu.org/cgi/bugreport.cgi?bug=11038
author: Christopher Schmidt <address@hidden>
committer: Stefan Monnier <address@hidden>
branch nick: trunk
timestamp: Sun 2012-05-06 11:38:30 -0400
message:
  * lisp/emacs-lisp/cl-macs.el (cl-expr-contains): Handle cons cells
  whose cdr is not a cons cell correctly.
modified:
  lisp/ChangeLog
  lisp/emacs-lisp/cl-macs.el

=== modified file 'lisp/ChangeLog'
--- a/lisp/ChangeLog    2012-05-06 08:43:46 +0000
+++ b/lisp/ChangeLog    2012-05-06 15:38:30 +0000
@@ -1,18 +1,23 @@
+2012-05-06  Christopher Schmidt  <address@hidden>
+
+       * 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  <address@hidden>
 
-       * 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

=== modified file 'lisp/emacs-lisp/cl-macs.el'
--- a/lisp/emacs-lisp/cl-macs.el        2012-04-26 03:18:47 +0000
+++ b/lisp/emacs-lisp/cl-macs.el        2012-05-06 15:38:30 +0000
@@ -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)))