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

Define if-let* and derivatives as aliases for if-let etc

Browse source 
This commit reverts declaring `if-let' and `when-let' obsolete in
favor of the new `if-let*' and `when-let*' versions because of the
compiler warning mess (Bug#30039).  Instead we make foo-let* aliases
for foo-let.  The old single-tuple variable spec case is still
supported for backward compatibility.
* lisp/emacs-lisp/subr-x.el (if-let, when-let): Don't declare
obsolete.  Tweak edebug specs.
(and-let): Renamed from `and-let*' for compatibility with the names
`if-let' and `when-let'.
(if-let*, when-let*, and-let*): Define as aliases for `if-let',
`when-let' and `and-let'.
* test/lisp/emacs-lisp/subr-x-tests.el (if-let-single-tuple-case-test)
(when-let-single-tuple-case-test): New tests for the single-binding
tuple case.
In the whole file, prefer the names without "*".
This commit is contained in:
Michael Heerdegen 2018-02-21 11:15:37 +01:00
parent ec79bdc53f
commit af4697faa1
3 changed files with 149 additions and 150 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

10
etc/NEWS
View file

@ -1301,12 +1301,10 @@ 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.
--- ---
** 'if-let' and 'when-let' are subsumed by 'if-let*' and 'when-let*'. ** The new macro 'and-let' is an implementation of the Scheme SRFI-2
The incumbent 'if-let' and 'when-let' are now marked obsolete. syntax. 'if-let' and 'when-let' now also accept the same binding
'if-let*' and 'when-let*' do not accept the single tuple special case. syntax as 'and-let'. 'if-let*', 'when-let*' and 'and-let*' are new
New macro 'and-let*' is an implementation of the Scheme SRFI-2 syntax aliases for 'if-let', 'when-let' and 'and-let'.
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,10 +131,18 @@ 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 ((&rest [&or symbolp (symbolp form) (form)]) (debug ([&or (symbolp 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))
@ -142,23 +150,23 @@ interest."
,@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 if-let*)) (declare (indent 1) (debug ([&or (symbolp form)
(list 'if-let* varlist (macroexp-progn body))) (&rest [&or symbolp (symbolp form) (form)])]
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) (declare (indent 1) (debug when-let))
(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))
@ -166,26 +174,9 @@ are non-nil, then the result is non-nil."
,@(or body `(,res)))) ,@(or body `(,res))))
`(let* () ,@(or body '(t)))))) `(let* () ,@(or body '(t))))))
(defmacro if-let (spec then &rest else) (defalias 'if-let* #'if-let)
"Bind variables according to SPEC and eval THEN or ELSE. (defalias 'when-let* #'when-let)
Like `if-let*' except SPEC can have the form (SYMBOL VALUEFORM)." (defalias 'and-let* #'and-let)
(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)."

234
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,106 +108,106 @@
(- 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"
(list a-called b-called c-called)) (list a-called b-called c-called))
(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"
(list a-called b-called c-called)) (list a-called b-called c-called))
(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,14 +215,19 @@
(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 ()
;; `when-let*' tests "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)))
(ert-deftest subr-x-test-when-let*-body-expansion ()
;; `when-let' tests
(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)))
@ -231,18 +236,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))
@ -251,7 +256,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))
@ -259,18 +264,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))
@ -278,173 +283,178 @@
(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")
(list a-called b-called c-called)) (list a-called b-called c-called))
(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
(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")
(list a-called b-called c-called)) (list a-called b-called c-called))
(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
(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)))
"yes") "yes")
(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))))))