From: Stefan Monnier Date: Tue, 17 Mar 2015 18:30:42 +0000 (-0400) Subject: * cl-macs.el (cl--transform-lambda): Refine last change. X-Git-Tag: emacs-25.0.90~2564^2~147^2 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=6f73c465a8990560fedb1c9897c893056b4b04ef;p=emacs.git * cl-macs.el (cl--transform-lambda): Refine last change. Fixes: debbugs:20125 * test/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. --- diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 96478223d49..b7062bb5c66 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,8 @@ +2015-03-17 Stefan Monnier + + * emacs-lisp/cl-macs.el (cl--transform-lambda): Refine last change + (bug#20125). + 2015-03-17 Michael Albinus * 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 712a7485167..56fbcf0b2fd 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 a7d1dfdceae..e150aba2874 100644 --- a/test/ChangeLog +++ b/test/ChangeLog @@ -1,7 +1,15 @@ +2015-03-17 Stefan Monnier + + * 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 - * 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 @@ -78,8 +86,8 @@ 2015-03-03 Daniel Colascione - * 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 - * 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 diff --git a/test/automated/cl-lib-tests.el b/test/automated/cl-lib-tests.el index 2c188a40059..ce0e5918653 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