changeset 5554:a42e686a01bf

Automated merge with file:///Sources/xemacs-21.5-checked-out
author Aidan Kehoe <kehoea@parhasard.net>
date Wed, 24 Aug 2011 11:07:26 +0100
parents 85210c453a97 (current diff) 62edcc6a11ec (diff)
children a39cd9dc92ba
files
diffstat 4 files changed, 26 insertions(+), 2 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/ChangeLog	Tue Aug 23 04:41:45 2011 +0900
+++ b/lisp/ChangeLog	Wed Aug 24 11:07:26 2011 +0100
@@ -1,3 +1,11 @@
+2011-08-24  Aidan Kehoe  <kehoea@parhasard.net>
+
+	* cl-macs.el (apply-partially):
+	Add an assertion to this compiler macro, requiring that the order
+	of the placeholders corresponding to the arguments in the
+	constants vector of the constructed compiled function be the same
+	as the order of the arguments to #'apply-partially.
+
 2011-08-12  Aidan Kehoe  <kehoea@parhasard.net>
 
 	* cl-macs.el:
--- a/lisp/cl-macs.el	Tue Aug 23 04:41:45 2011 +0900
+++ b/lisp/cl-macs.el	Wed Aug 24 11:07:26 2011 +0100
@@ -3519,6 +3519,13 @@
       (let* ((placeholders (mapcar 'quote-maybe (mapcar 'gensym args)))
              (compiled (byte-compile-sexp
                         `#'(lambda (&rest args) (apply ,@placeholders args)))))
+        (assert (equal (intersection
+                        (mapcar 'quote-maybe (compiled-function-constants
+                                              compiled))
+                        placeholders :test 'equal :stable t)
+                       placeholders)
+                t "This macro requires that the relative order is the same\
+in the constants vector and in the arguments")
         `(make-byte-code
           ',(compiled-function-arglist compiled)
           ,(compiled-function-instructions compiled)
--- a/tests/ChangeLog	Tue Aug 23 04:41:45 2011 +0900
+++ b/tests/ChangeLog	Wed Aug 24 11:07:26 2011 +0100
@@ -1,3 +1,9 @@
+2011-08-24  Aidan Kehoe  <kehoea@parhasard.net>
+
+	* automated/lisp-tests.el:
+	Add a test of apply partially that depends on the relative order
+	of its arguments.
+
 2011-08-12  Aidan Kehoe  <kehoea@parhasard.net>
 
 	* automated/lisp-tests.el:
--- a/tests/automated/lisp-tests.el	Tue Aug 23 04:41:45 2011 +0900
+++ b/tests/automated/lisp-tests.el	Wed Aug 24 11:07:26 2011 +0100
@@ -2929,10 +2929,13 @@
 ;; Basic tests of #'apply-partially.
 (let* ((four 4)
        (times-four (apply-partially '* four))
-       (plus-twelve (apply-partially '+ 6 (* 3 2))))
+       (plus-twelve (apply-partially '+ 6 (* 3 2)))
+       (construct-list (apply-partially 'list (incf four) (incf four)
+                                        (incf four))))
   (Assert (eql (funcall times-four 6) 24))
   (Assert (eql (funcall times-four 4 4) 64))
   (Assert (eql (funcall plus-twelve (funcall times-four 4) 4 4) 36))
-  (Check-Error wrong-number-of-arguments (apply-partially)))
+  (Check-Error wrong-number-of-arguments (apply-partially))
+  (Assert (equal (funcall construct-list) '(5 6 7))))
 
 ;;; end of lisp-tests.el