changeset: 5548:b90c153730c7
tag: tip
user: Aidan Kehoe <kehoea(a)parhasard.net>
date: Wed Aug 10 15:55:53 2011 +0100
files: lisp/ChangeLog lisp/bytecomp.el
description:
Do the quoted-lambda check when functions take :if, :test, :key arguments, too.
lisp/ChangeLog addition:
2011-08-10 Aidan Kehoe <kehoea(a)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.
diff -r a46c5c8d6564 -r b90c153730c7 lisp/ChangeLog
--- 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(a)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(a)xemacs.org>
* test-harness.el (test-harness-bug-expected):
diff -r a46c5c8d6564 -r b90c153730c7 lisp/bytecomp.el
--- 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))
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://lists.xemacs.org/mailman/listinfo/xemacs-patches