procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Merge branch 'emacs-26' of git.savannah.gnu.org:/srv/git/emacs into emacs-26

Browse source
This commit is contained in:
Eli Zaretskii 2018-03-06 22:45:33 +02:00
commit c797bc90f5
4 changed files with 152 additions and 148 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

10
etc/NEWS
View file

@ -1301,10 +1301,12 @@ current buffer or the self-insertion takes place within a comment.
** The alist 'ucs-names' is now a hash table. ** The alist 'ucs-names' is now a hash table.
--- ---
** The new macro 'and-let' is an implementation of the Scheme SRFI-2 ** 'if-let' and 'when-let' are subsumed by 'if-let*' and 'when-let*'.
syntax. 'if-let' and 'when-let' now also accept the same binding The incumbent 'if-let' and 'when-let' are now marked obsolete.
syntax as 'and-let'. 'if-let*', 'when-let*' and 'and-let*' are new 'if-let*' and 'when-let*' do not accept the single tuple special case.
aliases for 'if-let', 'when-let' and 'and-let'. New macro 'and-let*' is an implementation of the Scheme SRFI-2 syntax
of the same name. 'if-let*' and 'when-let*' now accept the same
binding syntax as 'and-let*'.
--- ---
** 'C-up', 'C-down', 'C-left' and 'C-right' are now defined in term ** 'C-up', 'C-down', 'C-left' and 'C-right' are now defined in term

55
lisp/emacs-lisp/subr-x.el
View file

@ -121,7 +121,7 @@ If ELT is of the form ((EXPR)), listify (EXPR) with a dummy symbol."
binding)) binding))
bindings))) bindings)))
(defmacro if-let (varlist then &rest else) (defmacro if-let* (varlist then &rest else)
"Bind variables according to VARLIST and eval THEN or ELSE. "Bind variables according to VARLIST and eval THEN or ELSE.
Each binding is evaluated in turn, and evaluation stops if a Each binding is evaluated in turn, and evaluation stops if a
binding value is nil. If all are non-nil, the value of THEN is binding value is nil. If all are non-nil, the value of THEN is
@ -131,18 +131,10 @@ Each element of VARLIST is a list (SYMBOL VALUEFORM) which binds
SYMBOL to the value of VALUEFORM. An element can additionally SYMBOL to the value of VALUEFORM. An element can additionally
be of the form (VALUEFORM), which is evaluated and checked for be of the form (VALUEFORM), which is evaluated and checked for
nil; i.e. SYMBOL can be omitted if only the test result is of nil; i.e. SYMBOL can be omitted if only the test result is of
interest. interest."
As a special case, a VARLIST of the form (SYMBOL SOMETHING) is
treated like ((SYMBOL SOMETHING))."
(declare (indent 2) (declare (indent 2)
(debug ([&or (symbolp form) (debug ((&rest [&or symbolp (symbolp form) (form)])
(&rest [&or symbolp (symbolp form) (form)])]
form body))) form body)))
(pcase varlist
(`(,(pred symbolp) ,_)
;; the single-tuple syntax case, for backward compatibility
(cl-callf list varlist)))
(if varlist (if varlist
`(let* ,(setq varlist (internal--build-bindings varlist)) `(let* ,(setq varlist (internal--build-bindings varlist))
(if ,(caar (last varlist)) (if ,(caar (last varlist))
@ -150,23 +142,23 @@ treated like ((SYMBOL SOMETHING))."
,@else)) ,@else))
`(let* () ,then))) `(let* () ,then)))
(defmacro when-let (varlist &rest body) (defmacro when-let* (varlist &rest body)
"Bind variables according to VARLIST and conditionally eval BODY. "Bind variables according to VARLIST and conditionally eval BODY.
Each binding is evaluated in turn, and evaluation stops if a Each binding is evaluated in turn, and evaluation stops if a
binding value is nil. If all are non-nil, the value of the last binding value is nil. If all are non-nil, the value of the last
form in BODY is returned. form in BODY is returned.
VARLIST is the same as in `if-let'." VARLIST is the same as in `if-let*'."
(declare (indent 1) (debug ([&or (symbolp form) (declare (indent 1) (debug if-let*))
(&rest [&or symbolp (symbolp form) (form)])] (list 'if-let* varlist (macroexp-progn body)))
body)))
(list 'if-let varlist (macroexp-progn body)))
(defmacro and-let (varlist &rest body) (defmacro and-let* (varlist &rest body)
"Bind variables according to VARLIST and conditionally eval BODY. "Bind variables according to VARLIST and conditionally eval BODY.
Like `when-let', except if BODY is empty and all the bindings Like `when-let*', except if BODY is empty and all the bindings
are non-nil, then the result is non-nil." are non-nil, then the result is non-nil."
(declare (indent 1) (debug when-let)) (declare (indent 1)
(debug ((&rest [&or symbolp (symbolp form) (form)])
body)))
(let (res) (let (res)
(if varlist (if varlist
`(let* ,(setq varlist (internal--build-bindings varlist)) `(let* ,(setq varlist (internal--build-bindings varlist))
@ -174,9 +166,26 @@ are non-nil, then the result is non-nil."
,@(or body `(,res)))) ,@(or body `(,res))))
`(let* () ,@(or body '(t)))))) `(let* () ,@(or body '(t))))))
(defalias 'if-let* #'if-let) (defmacro if-let (spec then &rest else)
(defalias 'when-let* #'when-let) "Bind variables according to SPEC and eval THEN or ELSE.
(defalias 'and-let* #'and-let) Like `if-let*' except SPEC can have the form (SYMBOL VALUEFORM)."
(declare (indent 2)
(debug ([&or (&rest [&or symbolp (symbolp form) (form)])
(symbolp form)]
form body))
(obsolete "use `if-let*' instead." "26.1"))
(when (and (<= (length spec) 2)
(not (listp (car spec))))
;; Adjust the single binding case
(setq spec (list spec)))
(list 'if-let* spec then (macroexp-progn else)))
(defmacro when-let (spec &rest body)
"Bind variables according to SPEC and conditionally eval BODY.
Like `when-let*' except SPEC can have the form (SYMBOL VALUEFORM)."
(declare (indent 1) (debug if-let)
(obsolete "use `when-let*' instead." "26.1"))
(list 'if-let spec (macroexp-progn body)))
(defsubst hash-table-empty-p (hash-table) (defsubst hash-table-empty-p (hash-table)
"Check whether HASH-TABLE is empty (has 0 elements)." "Check whether HASH-TABLE is empty (has 0 elements)."

3
lisp/eshell/em-cmpl.el
View file

@ -167,6 +167,9 @@ to writing a completion function."
(eshell-cmpl--custom-variable-docstring 'pcomplete-suffix-list) (eshell-cmpl--custom-variable-docstring 'pcomplete-suffix-list)
:type (get 'pcomplete-suffix-list 'custom-type) :type (get 'pcomplete-suffix-list 'custom-type)
:group 'pcomplete) :group 'pcomplete)
;; Only labelled obsolete in 26.1, but all it does it set
;; pcomplete-suffix-list, which is itself obsolete since 24.1.
(make-obsolete-variable 'eshell-cmpl-suffix-list nil "24.1")
(defcustom eshell-cmpl-recexact nil (defcustom eshell-cmpl-recexact nil
(eshell-cmpl--custom-variable-docstring 'pcomplete-recexact) (eshell-cmpl--custom-variable-docstring 'pcomplete-recexact)

210
test/lisp/emacs-lisp/subr-x-tests.el
View file

@ -28,13 +28,13 @@
(require 'subr-x) (require 'subr-x)
;; `if-let' tests ;; `if-let*' tests
(ert-deftest subr-x-test-if-let-single-binding-expansion () (ert-deftest subr-x-test-if-let*-single-binding-expansion ()
"Test single bindings are expanded properly." "Test single bindings are expanded properly."
(should (equal (should (equal
(macroexpand (macroexpand
'(if-let ((a 1)) '(if-let* ((a 1))
(- a) (- a)
"no")) "no"))
'(let* ((a (and t 1))) '(let* ((a (and t 1)))
@ -43,7 +43,7 @@
"no")))) "no"))))
(should (equal (should (equal
(macroexpand (macroexpand
'(if-let (a) '(if-let* (a)
(- a) (- a)
"no")) "no"))
'(let* ((a (and t a))) '(let* ((a (and t a)))
@ -51,11 +51,11 @@
(- a) (- a)
"no"))))) "no")))))
(ert-deftest subr-x-test-if-let-single-symbol-expansion () (ert-deftest subr-x-test-if-let*-single-symbol-expansion ()
"Test single symbol bindings are expanded properly." "Test single symbol bindings are expanded properly."
(should (equal (should (equal
(macroexpand (macroexpand
'(if-let (a) '(if-let* (a)
(- a) (- a)
"no")) "no"))
'(let* ((a (and t a))) '(let* ((a (and t a)))
@ -64,7 +64,7 @@
"no")))) "no"))))
(should (equal (should (equal
(macroexpand (macroexpand
'(if-let (a b c) '(if-let* (a b c)
(- a) (- a)
"no")) "no"))
'(let* ((a (and t a)) '(let* ((a (and t a))
@ -75,7 +75,7 @@
"no")))) "no"))))
(should (equal (should (equal
(macroexpand (macroexpand
'(if-let (a (b 2) c) '(if-let* (a (b 2) c)
(- a) (- a)
"no")) "no"))
'(let* ((a (and t a)) '(let* ((a (and t a))
@ -85,11 +85,11 @@
(- a) (- a)
"no"))))) "no")))))
(ert-deftest subr-x-test-if-let-nil-related-expansion () (ert-deftest subr-x-test-if-let*-nil-related-expansion ()
"Test nil is processed properly." "Test nil is processed properly."
(should (equal (should (equal
(macroexpand (macroexpand
'(if-let (nil) '(if-let* (nil)
(- a) (- a)
"no")) "no"))
'(let* ((nil (and t nil))) '(let* ((nil (and t nil)))
@ -98,7 +98,7 @@
"no")))) "no"))))
(should (equal (should (equal
(macroexpand (macroexpand
'(if-let ((a 1) nil (b 2)) '(if-let* ((a 1) nil (b 2))
(- a) (- a)
"no")) "no"))
'(let* ((a (and t 1)) '(let* ((a (and t 1))
@ -108,90 +108,90 @@
(- a) (- a)
"no"))))) "no")))))
(ert-deftest subr-x-test-if-let-malformed-binding () (ert-deftest subr-x-test-if-let*-malformed-binding ()
"Test malformed bindings trigger errors." "Test malformed bindings trigger errors."
(should-error (macroexpand (should-error (macroexpand
'(if-let (_ (a 1 1) (b 2) (c 3) d) '(if-let* (_ (a 1 1) (b 2) (c 3) d)
(- a) (- a)
"no")) "no"))
:type 'error) :type 'error)
(should-error (macroexpand (should-error (macroexpand
'(if-let (_ (a 1) (b 2 2) (c 3) d) '(if-let* (_ (a 1) (b 2 2) (c 3) d)
(- a) (- a)
"no")) "no"))
:type 'error) :type 'error)
(should-error (macroexpand (should-error (macroexpand
'(if-let (_ (a 1) (b 2) (c 3 3) d) '(if-let* (_ (a 1) (b 2) (c 3 3) d)
(- a) (- a)
"no")) "no"))
:type 'error) :type 'error)
(should-error (macroexpand (should-error (macroexpand
'(if-let ((a 1 1)) '(if-let* ((a 1 1))
(- a) (- a)
"no")) "no"))
:type 'error)) :type 'error))
(ert-deftest subr-x-test-if-let-true () (ert-deftest subr-x-test-if-let*-true ()
"Test `if-let' with truthy bindings." "Test `if-let' with truthy bindings."
(should (equal (should (equal
(if-let ((a 1)) (if-let* ((a 1))
a a
"no") "no")
1)) 1))
(should (equal (should (equal
(if-let ((a 1) (b 2) (c 3)) (if-let* ((a 1) (b 2) (c 3))
(list a b c) (list a b c)
"no") "no")
(list 1 2 3)))) (list 1 2 3))))
(ert-deftest subr-x-test-if-let-false () (ert-deftest subr-x-test-if-let*-false ()
"Test `if-let' with falsie bindings." "Test `if-let' with falsie bindings."
(should (equal (should (equal
(if-let ((a nil)) (if-let* ((a nil))
(list a b c) (list a b c)
"no") "no")
"no")) "no"))
(should (equal (should (equal
(if-let ((a nil) (b 2) (c 3)) (if-let* ((a nil) (b 2) (c 3))
(list a b c) (list a b c)
"no") "no")
"no")) "no"))
(should (equal (should (equal
(if-let ((a 1) (b nil) (c 3)) (if-let* ((a 1) (b nil) (c 3))
(list a b c) (list a b c)
"no") "no")
"no")) "no"))
(should (equal (should (equal
(if-let ((a 1) (b 2) (c nil)) (if-let* ((a 1) (b 2) (c nil))
(list a b c) (list a b c)
"no") "no")
"no")) "no"))
(should (equal (should (equal
(let (z) (let (z)
(if-let (z (a 1) (b 2) (c 3)) (if-let* (z (a 1) (b 2) (c 3))
(list a b c) (list a b c)
"no")) "no"))
"no")) "no"))
(should (equal (should (equal
(let (d) (let (d)
(if-let ((a 1) (b 2) (c 3) d) (if-let* ((a 1) (b 2) (c 3) d)
(list a b c) (list a b c)
"no")) "no"))
"no"))) "no")))
(ert-deftest subr-x-test-if-let-bound-references () (ert-deftest subr-x-test-if-let*-bound-references ()
"Test `if-let' bindings can refer to already bound symbols." "Test `if-let' bindings can refer to already bound symbols."
(should (equal (should (equal
(if-let ((a (1+ 0)) (b (1+ a)) (c (1+ b))) (if-let* ((a (1+ 0)) (b (1+ a)) (c (1+ b)))
(list a b c) (list a b c)
"no") "no")
(list 1 2 3)))) (list 1 2 3))))
(ert-deftest subr-x-test-if-let-and-laziness-is-preserved () (ert-deftest subr-x-test-if-let*-and-laziness-is-preserved ()
"Test `if-let' respects `and' laziness." "Test `if-let' respects `and' laziness."
(let (a-called b-called c-called) (let (a-called b-called c-called)
(should (equal (should (equal
(if-let ((a nil) (if-let* ((a nil)
(b (setq b-called t)) (b (setq b-called t))
(c (setq c-called t))) (c (setq c-called t)))
"yes" "yes"
@ -199,7 +199,7 @@
(list nil nil nil)))) (list nil nil nil))))
(let (a-called b-called c-called) (let (a-called b-called c-called)
(should (equal (should (equal
(if-let ((a (setq a-called t)) (if-let* ((a (setq a-called t))
(b nil) (b nil)
(c (setq c-called t))) (c (setq c-called t)))
"yes" "yes"
@ -207,7 +207,7 @@
(list t nil nil)))) (list t nil nil))))
(let (a-called b-called c-called) (let (a-called b-called c-called)
(should (equal (should (equal
(if-let ((a (setq a-called t)) (if-let* ((a (setq a-called t))
(b (setq b-called t)) (b (setq b-called t))
(c nil) (c nil)
(d (setq c-called t))) (d (setq c-called t)))
@ -215,19 +215,14 @@
(list a-called b-called c-called)) (list a-called b-called c-called))
(list t t nil))))) (list t t nil)))))
(defun if-let-single-tuple-case-test ()
"Test the BINDING-SPEC == (SYMBOL SOMETHING) case."
(should (equal (if-let (a 1) (1+ a)) 2))
(should (equal (let ((b 2)) (if-let (a b) a)) 2)))
;; `when-let' tests ;; `when-let*' tests
(ert-deftest subr-x-test-when-let-body-expansion () (ert-deftest subr-x-test-when-let*-body-expansion ()
"Test body allows for multiple sexps wrapping with progn." "Test body allows for multiple sexps wrapping with progn."
(should (equal (should (equal
(macroexpand (macroexpand
'(when-let ((a 1)) '(when-let* ((a 1))
(message "opposite") (message "opposite")
(- a))) (- a)))
'(let* ((a (and t 1))) '(let* ((a (and t 1)))
@ -236,18 +231,18 @@
(message "opposite") (message "opposite")
(- a))))))) (- a)))))))
(ert-deftest subr-x-test-when-let-single-symbol-expansion () (ert-deftest subr-x-test-when-let*-single-symbol-expansion ()
"Test single symbol bindings are expanded properly." "Test single symbol bindings are expanded properly."
(should (equal (should (equal
(macroexpand (macroexpand
'(when-let (a) '(when-let* (a)
(- a))) (- a)))
'(let* ((a (and t a))) '(let* ((a (and t a)))
(if a (if a
(- a))))) (- a)))))
(should (equal (should (equal
(macroexpand (macroexpand
'(when-let (a b c) '(when-let* (a b c)
(- a))) (- a)))
'(let* ((a (and t a)) '(let* ((a (and t a))
(b (and a b)) (b (and a b))
@ -256,7 +251,7 @@
(- a))))) (- a)))))
(should (equal (should (equal
(macroexpand (macroexpand
'(when-let (a (b 2) c) '(when-let* (a (b 2) c)
(- a))) (- a)))
'(let* ((a (and t a)) '(let* ((a (and t a))
(b (and a 2)) (b (and a 2))
@ -264,18 +259,18 @@
(if c (if c
(- a)))))) (- a))))))
(ert-deftest subr-x-test-when-let-nil-related-expansion () (ert-deftest subr-x-test-when-let*-nil-related-expansion ()
"Test nil is processed properly." "Test nil is processed properly."
(should (equal (should (equal
(macroexpand (macroexpand
'(when-let (nil) '(when-let* (nil)
(- a))) (- a)))
'(let* ((nil (and t nil))) '(let* ((nil (and t nil)))
(if nil (if nil
(- a))))) (- a)))))
(should (equal (should (equal
(macroexpand (macroexpand
'(when-let ((a 1) nil (b 2)) '(when-let* ((a 1) nil (b 2))
(- a))) (- a)))
'(let* ((a (and t 1)) '(let* ((a (and t 1))
(nil (and a nil)) (nil (and a nil))
@ -283,84 +278,84 @@
(if b (if b
(- a)))))) (- a))))))
(ert-deftest subr-x-test-when-let-malformed-binding () (ert-deftest subr-x-test-when-let*-malformed-binding ()
"Test malformed bindings trigger errors." "Test malformed bindings trigger errors."
(should-error (macroexpand (should-error (macroexpand
'(when-let (_ (a 1 1) (b 2) (c 3) d) '(when-let* (_ (a 1 1) (b 2) (c 3) d)
(- a))) (- a)))
:type 'error) :type 'error)
(should-error (macroexpand (should-error (macroexpand
'(when-let (_ (a 1) (b 2 2) (c 3) d) '(when-let* (_ (a 1) (b 2 2) (c 3) d)
(- a))) (- a)))
:type 'error) :type 'error)
(should-error (macroexpand (should-error (macroexpand
'(when-let (_ (a 1) (b 2) (c 3 3) d) '(when-let* (_ (a 1) (b 2) (c 3 3) d)
(- a))) (- a)))
:type 'error) :type 'error)
(should-error (macroexpand (should-error (macroexpand
'(when-let ((a 1 1)) '(when-let* ((a 1 1))
(- a))) (- a)))
:type 'error)) :type 'error))
(ert-deftest subr-x-test-when-let-true () (ert-deftest subr-x-test-when-let*-true ()
"Test `when-let' with truthy bindings." "Test `when-let' with truthy bindings."
(should (equal (should (equal
(when-let ((a 1)) (when-let* ((a 1))
a) a)
1)) 1))
(should (equal (should (equal
(when-let ((a 1) (b 2) (c 3)) (when-let* ((a 1) (b 2) (c 3))
(list a b c)) (list a b c))
(list 1 2 3)))) (list 1 2 3))))
(ert-deftest subr-x-test-when-let-false () (ert-deftest subr-x-test-when-let*-false ()
"Test `when-let' with falsie bindings." "Test `when-let' with falsie bindings."
(should (equal (should (equal
(when-let ((a nil)) (when-let* ((a nil))
(list a b c) (list a b c)
"no") "no")
nil)) nil))
(should (equal (should (equal
(when-let ((a nil) (b 2) (c 3)) (when-let* ((a nil) (b 2) (c 3))
(list a b c) (list a b c)
"no") "no")
nil)) nil))
(should (equal (should (equal
(when-let ((a 1) (b nil) (c 3)) (when-let* ((a 1) (b nil) (c 3))
(list a b c) (list a b c)
"no") "no")
nil)) nil))
(should (equal (should (equal
(when-let ((a 1) (b 2) (c nil)) (when-let* ((a 1) (b 2) (c nil))
(list a b c) (list a b c)
"no") "no")
nil)) nil))
(should (equal (should (equal
(let (z) (let (z)
(when-let (z (a 1) (b 2) (c 3)) (when-let* (z (a 1) (b 2) (c 3))
(list a b c) (list a b c)
"no")) "no"))
nil)) nil))
(should (equal (should (equal
(let (d) (let (d)
(when-let ((a 1) (b 2) (c 3) d) (when-let* ((a 1) (b 2) (c 3) d)
(list a b c) (list a b c)
"no")) "no"))
nil))) nil)))
(ert-deftest subr-x-test-when-let-bound-references () (ert-deftest subr-x-test-when-let*-bound-references ()
"Test `when-let' bindings can refer to already bound symbols." "Test `when-let' bindings can refer to already bound symbols."
(should (equal (should (equal
(when-let ((a (1+ 0)) (b (1+ a)) (c (1+ b))) (when-let* ((a (1+ 0)) (b (1+ a)) (c (1+ b)))
(list a b c)) (list a b c))
(list 1 2 3)))) (list 1 2 3))))
(ert-deftest subr-x-test-when-let-and-laziness-is-preserved () (ert-deftest subr-x-test-when-let*-and-laziness-is-preserved ()
"Test `when-let' respects `and' laziness." "Test `when-let' respects `and' laziness."
(let (a-called b-called c-called) (let (a-called b-called c-called)
(should (equal (should (equal
(progn (progn
(when-let ((a nil) (when-let* ((a nil)
(b (setq b-called t)) (b (setq b-called t))
(c (setq c-called t))) (c (setq c-called t)))
"yes") "yes")
@ -369,7 +364,7 @@
(let (a-called b-called c-called) (let (a-called b-called c-called)
(should (equal (should (equal
(progn (progn
(when-let ((a (setq a-called t)) (when-let* ((a (setq a-called t))
(b nil) (b nil)
(c (setq c-called t))) (c (setq c-called t)))
"yes") "yes")
@ -378,7 +373,7 @@
(let (a-called b-called c-called) (let (a-called b-called c-called)
(should (equal (should (equal
(progn (progn
(when-let ((a (setq a-called t)) (when-let* ((a (setq a-called t))
(b (setq b-called t)) (b (setq b-called t))
(c nil) (c nil)
(d (setq c-called t))) (d (setq c-called t)))
@ -386,75 +381,70 @@
(list a-called b-called c-called)) (list a-called b-called c-called))
(list t t nil))))) (list t t nil)))))
(defun when-let-single-tuple-case-test ()
"Test the BINDING-SPEC == (SYMBOL SOMETHING) case."
(should (equal (when-let (a 1) (1+ a)) 2))
(should (equal (let ((b 2)) (when-let (a b) a)) 2)))
;; `and-let' tests ;; `and-let*' tests
;; Adapted from the Guile tests ;; Adapted from the Guile tests
;; https://git.savannah.gnu.org/cgit/guile.git/tree/test-suite/tests/srfi-2.test ;; https://git.savannah.gnu.org/cgit/guile.git/tree/test-suite/tests/srfi-2.test
(ert-deftest subr-x-and-let-test-empty-varlist () (ert-deftest subr-x-and-let*-test-empty-varlist ()
(should (equal 1 (and-let () 1))) (should (equal 1 (and-let* () 1)))
(should (equal 2 (and-let () 1 2))) (should (equal 2 (and-let* () 1 2)))
(should (equal t (and-let ())))) (should (equal t (and-let* ()))))
(ert-deftest subr-x-and-let-test-group-1 () (ert-deftest subr-x-and-let*-test-group-1 ()
(should (equal nil (let ((x nil)) (and-let (x))))) (should (equal nil (let ((x nil)) (and-let* (x)))))
(should (equal 1 (let ((x 1)) (and-let (x))))) (should (equal 1 (let ((x 1)) (and-let* (x)))))
(should (equal nil (and-let ((x nil))))) (should (equal nil (and-let* ((x nil)))))
(should (equal 1 (and-let ((x 1))))) (should (equal 1 (and-let* ((x 1)))))
;; The error doesn't trigger when compiled: the compiler will give ;; The error doesn't trigger when compiled: the compiler will give
;; a warning and then drop the erroneous code. Therefore, use ;; a warning and then drop the erroneous code. Therefore, use
;; `eval' to avoid compilation. ;; `eval' to avoid compilation.
(should-error (eval '(and-let (nil (x 1))) lexical-binding) (should-error (eval '(and-let* (nil (x 1))) lexical-binding)
:type 'setting-constant) :type 'setting-constant)
(should (equal nil (and-let ((nil) (x 1))))) (should (equal nil (and-let* ((nil) (x 1)))))
(should-error (eval '(and-let (2 (x 1))) lexical-binding) (should-error (eval '(and-let* (2 (x 1))) lexical-binding)
:type 'wrong-type-argument) :type 'wrong-type-argument)
(should (equal 1 (and-let ((2) (x 1))))) (should (equal 1 (and-let* ((2) (x 1)))))
(should (equal 2 (and-let ((x 1) (2))))) (should (equal 2 (and-let* ((x 1) (2)))))
(should (equal nil (let ((x nil)) (and-let (x) x)))) (should (equal nil (let ((x nil)) (and-let* (x) x))))
(should (equal "" (let ((x "")) (and-let (x) x)))) (should (equal "" (let ((x "")) (and-let* (x) x))))
(should (equal "" (let ((x "")) (and-let (x))))) (should (equal "" (let ((x "")) (and-let* (x)))))
(should (equal 2 (let ((x 1)) (and-let (x) (+ x 1))))) (should (equal 2 (let ((x 1)) (and-let* (x) (+ x 1)))))
(should (equal nil (let ((x nil)) (and-let (x) (+ x 1))))) (should (equal nil (let ((x nil)) (and-let* (x) (+ x 1)))))
(should (equal 2 (let ((x 1)) (and-let (((> x 0))) (+ x 1))))) (should (equal 2 (let ((x 1)) (and-let* (((> x 0))) (+ x 1)))))
(should (equal t (let ((x 1)) (and-let (((> x 0))))))) (should (equal t (let ((x 1)) (and-let* (((> x 0)))))))
(should (equal nil (let ((x 0)) (and-let (((> x 0))) (+ x 1))))) (should (equal nil (let ((x 0)) (and-let* (((> x 0))) (+ x 1)))))
(should (equal 3 (should (equal 3
(let ((x 1)) (and-let (((> x 0)) (x (+ x 1))) (+ x 1)))))) (let ((x 1)) (and-let* (((> x 0)) (x (+ x 1))) (+ x 1))))))
(ert-deftest subr-x-and-let-test-rebind () (ert-deftest subr-x-and-let*-test-rebind ()
(should (should
(equal 4 (equal 4
(let ((x 1)) (let ((x 1))
(and-let (((> x 0)) (x (+ x 1)) (x (+ x 1))) (+ x 1)))))) (and-let* (((> x 0)) (x (+ x 1)) (x (+ x 1))) (+ x 1))))))
(ert-deftest subr-x-and-let-test-group-2 () (ert-deftest subr-x-and-let*-test-group-2 ()
(should (should
(equal 2 (let ((x 1)) (and-let (x ((> x 0))) (+ x 1))))) (equal 2 (let ((x 1)) (and-let* (x ((> x 0))) (+ x 1)))))
(should (should
(equal 2 (let ((x 1)) (and-let (((progn x)) ((> x 0))) (+ x 1))))) (equal 2 (let ((x 1)) (and-let* (((progn x)) ((> x 0))) (+ x 1)))))
(should (equal nil (let ((x 0)) (and-let (x ((> x 0))) (+ x 1))))) (should (equal nil (let ((x 0)) (and-let* (x ((> x 0))) (+ x 1)))))
(should (equal nil (let ((x nil)) (and-let (x ((> x 0))) (+ x 1))))) (should (equal nil (let ((x nil)) (and-let* (x ((> x 0))) (+ x 1)))))
(should (should
(equal nil (let ((x nil)) (and-let (((progn x)) ((> x 0))) (+ x 1)))))) (equal nil (let ((x nil)) (and-let* (((progn x)) ((> x 0))) (+ x 1))))))
(ert-deftest subr-x-and-let-test-group-3 () (ert-deftest subr-x-and-let*-test-group-3 ()
(should (should
(equal nil (let ((x 1)) (and-let (x (y (- x 1)) ((> y 0))) (/ x y))))) (equal nil (let ((x 1)) (and-let* (x (y (- x 1)) ((> y 0))) (/ x y)))))
(should (should
(equal nil (let ((x 0)) (and-let (x (y (- x 1)) ((> y 0))) (/ x y))))) (equal nil (let ((x 0)) (and-let* (x (y (- x 1)) ((> y 0))) (/ x y)))))
(should (should
(equal nil (equal nil
(let ((x nil)) (and-let (x (y (- x 1)) ((> y 0))) (/ x y))))) (let ((x nil)) (and-let* (x (y (- x 1)) ((> y 0))) (/ x y)))))
(should (should
(equal (/ 3.0 2) (equal (/ 3.0 2)
(let ((x 3.0)) (and-let (x (y (- x 1)) ((> y 0))) (/ x y)))))) (let ((x 3.0)) (and-let* (x (y (- x 1)) ((> y 0))) (/ x y))))))