Commit 6f73c465 authored by Stefan Monnier's avatar Stefan Monnier

* 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.
parent 508049aa
2015-03-17 Stefan Monnier <monnier@iro.umontreal.ca>
* emacs-lisp/cl-macs.el (cl--transform-lambda): Refine last change
(bug#20125).
2015-03-17 Michael Albinus <michael.albinus@gmx.de> 2015-03-17 Michael Albinus <michael.albinus@gmx.de>
* net/tramp-sh.el (tramp-ssh-controlmaster-options): Change test * net/tramp-sh.el (tramp-ssh-controlmaster-options): Change test
......
...@@ -257,11 +257,7 @@ FORM is of the form (ARGS . BODY)." ...@@ -257,11 +257,7 @@ FORM is of the form (ARGS . BODY)."
(setq cl--bind-defs (cadr cl-defs)) (setq cl--bind-defs (cadr cl-defs))
;; Remove "&cl-defs DEFS" from args. ;; Remove "&cl-defs DEFS" from args.
(setcdr cl-defs (cddr cl-defs)) (setcdr cl-defs (cddr cl-defs))
(setq args (delq '&cl-defs args)) (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))))
(if (setq cl--bind-enquote (memq '&cl-quote args)) (if (setq cl--bind-enquote (memq '&cl-quote args))
(setq args (delq '&cl-quote args))) (setq args (delq '&cl-quote args)))
(if (memq '&whole args) (error "&whole not currently implemented")) (if (memq '&whole args) (error "&whole not currently implemented"))
...@@ -272,11 +268,19 @@ FORM is of the form (ARGS . BODY)." ...@@ -272,11 +268,19 @@ FORM is of the form (ARGS . BODY)."
;; Take away all the simple args whose parsing can be handled more ;; Take away all the simple args whose parsing can be handled more
;; efficiently by a plain old `lambda' than the manual parsing generated ;; efficiently by a plain old `lambda' than the manual parsing generated
;; by `cl--do-arglist'. ;; by `cl--do-arglist'.
(while (and args (symbolp (car args)) (let ((optional nil))
(not (memq (car args) '(nil &rest &body &key &aux))) (while (and args (symbolp (car args))
(not (and (eq (car args) '&optional) (not (memq (car args) '(nil &rest &body &key &aux)))
(or cl--bind-defs (consp (cadr args)))))) (or (not optional)
(push (pop args) simple-args)) ;; 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) (or (eq cl--bind-block 'cl-none)
(setq body (list `(cl-block ,cl--bind-block ,@body)))) (setq body (list `(cl-block ,cl--bind-block ,@body))))
(let* ((cl--bind-lets nil) (cl--bind-forms nil) (let* ((cl--bind-lets nil) (cl--bind-forms nil)
...@@ -292,7 +296,7 @@ FORM is of the form (ARGS . BODY)." ...@@ -292,7 +296,7 @@ FORM is of the form (ARGS . BODY)."
;; "manual" parsing. ;; "manual" parsing.
(let ((slen (length simple-args))) (let ((slen (length simple-args)))
(when (memq '&optional simple-args) (when (memq '&optional simple-args)
(push '&optional args) (cl-decf slen)) (cl-decf slen))
(setq header (setq header
;; Macro expansion can take place in the middle of ;; Macro expansion can take place in the middle of
;; apparently harmless computation, so it should not ;; apparently harmless computation, so it should not
......
2015-03-17 Stefan Monnier <monnier@iro.umontreal.ca>
* 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 <kbrown@cornell.edu> 2015-03-16 Ken Brown <kbrown@cornell.edu>
* automated/tramp-tests.el (tramp--test-special-characters): Don't * automated/tramp-tests.el (tramp--test-special-characters):
test "\t" in file names on Cygwin. (Bug#20119) Don't test "\t" in file names on Cygwin. (Bug#20119)
2015-03-10 Jackson Ray Hamilton <jackson@jacksonrayhamilton.com> 2015-03-10 Jackson Ray Hamilton <jackson@jacksonrayhamilton.com>
...@@ -78,8 +86,8 @@ ...@@ -78,8 +86,8 @@
2015-03-03 Daniel Colascione <dancol@dancol.org> 2015-03-03 Daniel Colascione <dancol@dancol.org>
* automated/generator-tests.el (cps-testcase): Use * automated/generator-tests.el (cps-testcase):
`cps-inhibit-atomic-optimization' instead of Use `cps-inhibit-atomic-optimization' instead of
`cps-disable-atomic-optimization'. `cps-disable-atomic-optimization'.
(cps-test-declarations-preserved): New test. (cps-test-declarations-preserved): New test.
...@@ -184,8 +192,8 @@ ...@@ -184,8 +192,8 @@
2015-02-07 Dmitry Gutov <dgutov@yandex.ru> 2015-02-07 Dmitry Gutov <dgutov@yandex.ru>
* automated/vc-tests.el (vc-test--working-revision): Fix * automated/vc-tests.el (vc-test--working-revision):
`vc-working-revision' checks to be compared against nil, which is Fix `vc-working-revision' checks to be compared against nil, which is
what is should return for unregistered files. what is should return for unregistered files.
2015-02-06 Nicolas Petton <nicolas@petton.fr> 2015-02-06 Nicolas Petton <nicolas@petton.fr>
......
;;; 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. ;; Copyright (C) 2013-2015 Free Software Foundation, Inc.
...@@ -204,7 +204,10 @@ ...@@ -204,7 +204,10 @@
:b :a :a 42) :b :a :a 42)
'(42 :a)))) '(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 () (ert-deftest cl-lib-struct-accessors ()
(let ((x (make-mystruct :abc 1 :def 2))) (let ((x (make-mystruct :abc 1 :def 2)))
(should (eql (cl-struct-slot-value 'mystruct 'abc x) 1)) (should (eql (cl-struct-slot-value 'mystruct 'abc x) 1))
...@@ -213,8 +216,17 @@ ...@@ -213,8 +216,17 @@
(should (eql (cl-struct-slot-value 'mystruct 'def x) -1)) (should (eql (cl-struct-slot-value 'mystruct 'def x) -1))
(should (eql (cl-struct-slot-offset 'mystruct 'abc) 1)) (should (eql (cl-struct-slot-offset 'mystruct 'abc) 1))
(should-error (cl-struct-slot-offset 'mystruct 'marypoppins)) (should-error (cl-struct-slot-offset 'mystruct 'marypoppins))
(should (equal (cl-struct-slot-info 'mystruct) (should (pcase (cl-struct-slot-info 'mystruct)
'((cl-tag-slot) (abc :readonly t) (def)))))) (`((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 () (ert-deftest cl-the ()
(should (eql (cl-the integer 42) 42)) (should (eql (cl-the integer 42) 42))
...@@ -434,14 +446,4 @@ ...@@ -434,14 +446,4 @@
(should (cl-typep '* 'cl-lib-test-type)) (should (cl-typep '* 'cl-lib-test-type))
(should-not (cl-typep 1 '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 ;;; cl-lib.el ends here
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment