Mercurial > hg > xemacs-beta

changeset 5548:b90c153730c7

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Do the quoted-lambda check when functions take :if, :test, :key arguments, too. lisp/ChangeLog addition: 2011-08-10 Aidan Kehoe <kehoea@parhasard.net> * bytecomp.el (byte-compile-normal-call): When a function takes :if, :if-not, :test, :test-not or :key arguments, do the quoted-lambda check there too.
author Aidan Kehoe <kehoea@parhasard.net>
date Wed, 10 Aug 2011 15:55:53 +0100
parents a46c5c8d6564
children 493c487cbc3f
files lisp/ChangeLog lisp/bytecomp.el
diffstat 2 files changed, 28 insertions(+), 14 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/ChangeLog	Tue Aug 09 17:17:44 2011 +0100
+++ b/lisp/ChangeLog	Wed Aug 10 15:55:53 2011 +0100
@@ -1,3 +1,9 @@
+2011-08-10  Aidan Kehoe  <kehoea@parhasard.net>
+
+	* bytecomp.el (byte-compile-normal-call):
+	When a function takes :if, :if-not, :test, :test-not or :key
+	arguments, do the quoted-lambda check there too.
+
 2011-08-04  Stephen J. Turnbull  <stephen@xemacs.org>
 
 	* test-harness.el (test-harness-bug-expected):
--- a/lisp/bytecomp.el	Tue Aug 09 17:17:44 2011 +0100
+++ b/lisp/bytecomp.el	Wed Aug 10 15:55:53 2011 +0100
@@ -2880,20 +2880,28 @@
 	      (map nil
 		   (function*
 		    (lambda ((function . nargs))
-		      (and (setq function (plist-get plist function
-						     not-present))
-			   (not (eq function not-present))
-			   (byte-compile-constp function)
-			   (byte-compile-callargs-warn
-			    (cons (eval function)
-				  (member*
-				   nargs
-				   ;; Dummy arguments. There's no need for
-				   ;; it to be longer than even 2, now, but
-				   ;; very little harm in it.
-				   '(9 8 7 6 5 4 3 2 1)))))))
-		   '((:key . 1) (:test . 2) (:test-not . 2)
-		     (:if . 1) (:if-not . 1))))))))
+                      (let ((value (plist-get plist function not-present)))
+                        (when (and (not (eq value not-present))
+                                   (byte-compile-constp value))
+                          (byte-compile-callargs-warn
+                           (cons (eval value)
+                                 (member*
+                                  nargs
+                                  ;; Dummy arguments. There's no need for
+                                  ;; it to be longer than even 2, now, but
+                                  ;; very little harm in it.
+                                  '(9 8 7 6 5 4 3 2 1))))
+                          (when (and (eq (car-safe value) 'quote)
+                                     (eq (car-safe (nth 1 value)) 'lambda)
+                                     (or
+                                      (null (memq 'quoted-lambda
+                                                  byte-compile-warnings))
+                                      (byte-compile-warn
+                                       "Passing a quoted lambda to #'%s, \
+keyword %s, forcing function quoting" (car form) function)))
+                            (setcar value 'function))))))
+                   '((:key . 1) (:test . 2) (:test-not . 2) (:if . 1)
+                     (:if-not . 1))))))))
   (if byte-compile-generate-call-tree
       (byte-compile-annotate-call-tree form))
   (byte-compile-push-constant (car form))