[Emacs-diffs] master 0fe787e 2/2: Merge branch 'master' of git.savannah.gnu.org:/srv/git/emacs

[Eli Zaretskii]

branch: master
commit 0fe787e21ccc1051fab5597b7f5d5b4c325d3258
Merge: 330cf1a 6f73c46
Author: Eli Zaretskii <address@hidden>
Commit: Eli Zaretskii <address@hidden>

    Merge branch 'master' of git.savannah.gnu.org:/srv/git/emacs
---
 lisp/ChangeLog                 |    5 +++++
 lisp/emacs-lisp/cl-macs.el     |   26 +++++++++++++++-----------
 test/ChangeLog                 |   20 ++++++++++++++------
 test/automated/cl-lib-tests.el |   30 ++++++++++++++++--------------
 4 files changed, 50 insertions(+), 31 deletions(-)

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index b29694b..b734aaa 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -9,6 +9,11 @@
        the next time the menu is requested.
        (w32-fixed-font-alist): Fix to use correct names of Courier fonts.
 
+2015-03-17  Stefan Monnier  <address@hidden>
+
+       * emacs-lisp/cl-macs.el (cl--transform-lambda): Refine last change
+       (bug#20125).
+
 2015-03-17  Michael Albinus  <address@hidden>
 
        * net/tramp-sh.el (tramp-ssh-controlmaster-options): Change test
diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el
index 712a748..56fbcf0 100644
--- a/lisp/emacs-lisp/cl-macs.el
+++ b/lisp/emacs-lisp/cl-macs.el
@@ -257,11 +257,7 @@ FORM is of the form (ARGS . BODY)."
         (setq cl--bind-defs (cadr cl-defs))
        ;; Remove "&cl-defs DEFS" from args.
         (setcdr cl-defs (cddr cl-defs))
-       (setq args (delq '&cl-defs args))
-       ;; Optimize away trivial &cl-defs.
-       (if (and (null (car cl--bind-defs))
-                (cl-every (lambda (x) (null (cadr x))) (cdr cl--bind-defs)))
-           (setq cl--bind-defs nil))))
+       (setq args (delq '&cl-defs args))))
     (if (setq cl--bind-enquote (memq '&cl-quote args))
        (setq args (delq '&cl-quote args)))
     (if (memq '&whole args) (error "&whole not currently implemented"))
@@ -272,11 +268,19 @@ FORM is of the form (ARGS . BODY)."
     ;; Take away all the simple args whose parsing can be handled more
     ;; efficiently by a plain old `lambda' than the manual parsing generated
     ;; by `cl--do-arglist'.
-    (while (and args (symbolp (car args))
-               (not (memq (car args) '(nil &rest &body &key &aux)))
-               (not (and (eq (car args) '&optional)
-                         (or cl--bind-defs (consp (cadr args))))))
-      (push (pop args) simple-args))
+    (let ((optional nil))
+      (while (and args (symbolp (car args))
+                  (not (memq (car args) '(nil &rest &body &key &aux)))
+                  (or (not optional)
+                      ;; Optional args whose default is nil are simple.
+                      (null (nth 1 (assq (car args) (cdr cl--bind-defs)))))
+                  (not (and (eq (car args) '&optional) (setq optional t)
+                            (car cl--bind-defs))))
+        (push (pop args) simple-args))
+      (when optional
+        (if args (push '&optional args))
+        ;; Don't keep a dummy trailing &optional without actual optional args.
+        (if (eq '&optional (car simple-args)) (pop simple-args))))
     (or (eq cl--bind-block 'cl-none)
        (setq body (list `(cl-block ,cl--bind-block ,@body))))
     (let* ((cl--bind-lets nil) (cl--bind-forms nil)
@@ -292,7 +296,7 @@ FORM is of the form (ARGS . BODY)."
               ;; "manual" parsing.
               (let ((slen (length simple-args)))
                 (when (memq '&optional simple-args)
-                  (push '&optional args) (cl-decf slen))
+                  (cl-decf slen))
                 (setq header
                       ;; Macro expansion can take place in the middle of
                       ;; apparently harmless computation, so it should not
diff --git a/test/ChangeLog b/test/ChangeLog
index a7d1dfd..e150aba 100644
--- a/test/ChangeLog
+++ b/test/ChangeLog
@@ -1,7 +1,15 @@
+2015-03-17  Stefan Monnier  <address@hidden>
+
+       * automated/cl-lib-tests.el: Use lexical-binding.
+       (cl-lib-arglist-performance): Refine test to the case where one of the
+       fields has a non-nil default value.  Use existing `mystruct' defstruct.
+       (cl-lib-struct-accessors): Use `pcase' to be a bit more flexible in the
+       accepted outputs.
+
 2015-03-16  Ken Brown  <address@hidden>
 
-       * automated/tramp-tests.el (tramp--test-special-characters): Don't
-       test "\t" in file names on Cygwin.  (Bug#20119)
+       * automated/tramp-tests.el (tramp--test-special-characters):
+       Don't test "\t" in file names on Cygwin.  (Bug#20119)
 
 2015-03-10  Jackson Ray Hamilton  <address@hidden>
 
@@ -78,8 +86,8 @@
 
 2015-03-03  Daniel Colascione  <address@hidden>
 
-       * automated/generator-tests.el (cps-testcase): Use
-       `cps-inhibit-atomic-optimization' instead of
+       * automated/generator-tests.el (cps-testcase):
+       Use `cps-inhibit-atomic-optimization' instead of
        `cps-disable-atomic-optimization'.
        (cps-test-declarations-preserved): New test.
 
@@ -184,8 +192,8 @@
 
 2015-02-07  Dmitry Gutov  <address@hidden>
 
-       * automated/vc-tests.el (vc-test--working-revision): Fix
-       `vc-working-revision' checks to be compared against nil, which is
+       * automated/vc-tests.el (vc-test--working-revision):
+       Fix `vc-working-revision' checks to be compared against nil, which is
        what is should return for unregistered files.
 
 2015-02-06 Nicolas Petton <address@hidden>
diff --git a/test/automated/cl-lib-tests.el b/test/automated/cl-lib-tests.el
index 2c188a4..ce0e591 100644
--- a/test/automated/cl-lib-tests.el
+++ b/test/automated/cl-lib-tests.el
@@ -1,4 +1,4 @@
-;;; cl-lib.el --- tests for emacs-lisp/cl-lib.el
+;;; cl-lib.el --- tests for emacs-lisp/cl-lib.el  -*- lexical-binding:t -*-
 
 ;; Copyright (C) 2013-2015 Free Software Foundation, Inc.
 
@@ -204,7 +204,10 @@
                     :b :a :a 42)
            '(42 :a))))
 
-(cl-defstruct mystruct (abc :readonly t) def)
+(cl-defstruct (mystruct
+               (:constructor cl-lib--con-1 (&aux (abc 1)))
+               (:constructor cl-lib--con-2 (&optional def)))
+  (abc 5 :readonly t) (def nil))
 (ert-deftest cl-lib-struct-accessors ()
   (let ((x (make-mystruct :abc 1 :def 2)))
     (should (eql (cl-struct-slot-value 'mystruct 'abc x) 1))
@@ -213,8 +216,17 @@
     (should (eql (cl-struct-slot-value 'mystruct 'def x) -1))
     (should (eql (cl-struct-slot-offset 'mystruct 'abc) 1))
     (should-error (cl-struct-slot-offset 'mystruct 'marypoppins))
-    (should (equal (cl-struct-slot-info 'mystruct)
-                   '((cl-tag-slot) (abc :readonly t) (def))))))
+    (should (pcase (cl-struct-slot-info 'mystruct)
+              (`((cl-tag-slot) (abc 5 :readonly t)
+                 (def . ,(or `nil `(nil))))
+               t)))))
+
+(ert-deftest cl-lib-arglist-performance ()
+  ;; An `&aux' should not cause lambda's arglist to be turned into an &rest
+  ;; that's parsed by hand.
+  (should (equal () (help-function-arglist 'cl-lib--con-1)))
+  (should (pcase (help-function-arglist 'cl-lib--con-2)
+            (`(&optional ,_) t))))
 
 (ert-deftest cl-the ()
   (should (eql (cl-the integer 42) 42))
@@ -434,14 +446,4 @@
   (should (cl-typep '* 'cl-lib-test-type))
   (should-not (cl-typep 1 'cl-lib-test-type)))
 
-(ert-deftest cl-lib-arglist-performance ()
-  ;; An `&aux' should not cause lambda's arglist to be turned into an &rest
-  ;; that's parsed by hand.
-  (should (eq () (nth 1 (nth 1 (macroexpand
-                                '(cl-function (lambda (&aux (x 1)) x)))))))
-  (cl-defstruct (cl-lib--s (:constructor cl-lib--s-make (&optional a))) a)
-  ;; Similarly the &cl-defs thingy shouldn't cause fallback to manual parsing
-  ;; of args if the default for optional args is nil.
-  (should (equal '(&optional a) (help-function-arglist 'cl-lib--s-make))))
-
 ;;; cl-lib.el ends here