Implement and-let*
This also includes changes to if-let and when-let. The single tuple special case is ambiguous, and binding a symbol to nil is not as useful as binding it to its value outside the lexical scope of the binding. (Bug#28254) * etc/NEWS: Mention. * lisp/emacs-lisp/subr-x.el (internal--listify): (internal--build-binding-value-form): Extend to account for solitary symbols and (EXPR) items in binding varlist. (if-let*, when-let*): Nix single tuple case and incumbent bind-symbol-to-nil behavior. (and-let*): New macro. (if-let, when-let): Mark obsolete. Redefine in terms of if-let*, so they implicitly gain the new features without breaking existing code. * test/lisp/emacs-lisp/subr-x-tests.el: Adjust tests for: lack of single-tuple special case, lack of binding solitary symbols to nil, and the introduction of uninterned symbols for (EXPR) bindings. Add SRFI-2 test suite adapted to Elisp.
This commit is contained in:
Mark Oteiza
parent
c87331a1c0
commit
4612b2a2b3
3 changed files with 237 additions and 189 deletions
12
etc/NEWS
12
etc/NEWS
|
|
@ -1136,6 +1136,14 @@ be disabled by setting 'byte-compile-cond-use-jump-table' to nil.
|
|||
---
|
||||
** The alist 'ucs-names' is now a hash table.
|
||||
|
||||
---
|
||||
** 'if-let' and 'when-let' are subsumed by 'if-let*' and 'when-let*'.
|
||||
The incumbent 'if-let' and 'when-let' are now marked obsolete.
|
||||
'if-let*' and 'when-let*' do not accept the single tuple special case.
|
||||
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
|
||||
mode to send the same escape sequences that xterm does. This makes
|
||||
|
|
@ -1528,10 +1536,6 @@ It avoids unnecessary consing (and garbage collection).
|
|||
+++
|
||||
** 'gensym' is now part of Elisp.
|
||||
|
||||
---
|
||||
** 'if-let*', 'when-let*', and 'and-let*' are new in subr-x.el.
|
||||
The incumbent 'if-let' and 'when-let' are now aliases.
|
||||
|
||||
---
|
||||
** Low-level list functions like 'length' and 'member' now do a better
|
||||
job of signaling list cycles instead of looping indefinitely.
|
||||
|
|
|
|||
|
|
@ -83,10 +83,15 @@ threading."
|
|||
`(internal--thread-argument nil ,@forms))
|
||||
|
||||
(defsubst internal--listify (elt)
|
||||
"Wrap ELT in a list if it is not one."
|
||||
(if (not (listp elt))
|
||||
(list elt)
|
||||
elt))
|
||||
"Wrap ELT in a list if it is not one.
|
||||
If ELT is of the form ((EXPR)), listify (EXPR) with a dummy symbol."
|
||||
(cond
|
||||
((symbolp elt) (list elt elt))
|
||||
((and (null (cdr elt))
|
||||
(let ((form (car elt)))
|
||||
(or (listp form) (atom form))))
|
||||
(list (make-symbol "s") (car elt)))
|
||||
(t elt)))
|
||||
|
||||
(defsubst internal--check-binding (binding)
|
||||
"Check BINDING is properly formed."
|
||||
|
|
@ -98,7 +103,10 @@ threading."
|
|||
|
||||
(defsubst internal--build-binding-value-form (binding prev-var)
|
||||
"Build the conditional value form for BINDING using PREV-VAR."
|
||||
`(,(car binding) (and ,prev-var ,(cadr binding))))
|
||||
(let ((var (car binding)))
|
||||
(if (and (null (cdr binding)) (atom (car binding)) (not (symbolp (car binding))))
|
||||
`(,var (and ,prev-var ,var))
|
||||
`(,var (and ,prev-var ,(cadr binding))))))
|
||||
|
||||
(defun internal--build-binding (binding prev-var)
|
||||
"Check and build a single BINDING with PREV-VAR."
|
||||
|
|
@ -117,44 +125,68 @@ threading."
|
|||
binding))
|
||||
bindings)))
|
||||
|
||||
(defmacro if-let* (bindings then &rest else)
|
||||
(defmacro if-let* (varlist then &rest else)
|
||||
"Bind variables according to VARLIST and eval THEN or ELSE.
|
||||
Each binding is evaluated in turn with `let*', and evaluation
|
||||
stops if a binding value is nil. If all are non-nil, the value
|
||||
of THEN is returned, or the last form in ELSE is returned.
|
||||
Each element of VARLIST is a symbol (which is bound to nil)
|
||||
or a list (SYMBOL VALUEFORM) (which binds SYMBOL to the value of VALUEFORM).
|
||||
In the special case you only want to bind a single value,
|
||||
VARLIST can just be a plain tuple.
|
||||
\n(fn VARLIST THEN ELSE...)"
|
||||
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
|
||||
returned, or the last form in ELSE is returned.
|
||||
|
||||
Each element of VARLIST is a list (SYMBOL VALUEFORM) which binds
|
||||
SYMBOL to the value of VALUEFORM).
|
||||
An element can additionally be of the form (VALUEFORM), which is
|
||||
evaluated and checked for nil."
|
||||
(declare (indent 2)
|
||||
(debug ([&or (&rest [&or symbolp (symbolp form)]) (symbolp form)]
|
||||
(debug ((&rest [&or symbolp (symbolp form) (sexp)])
|
||||
form body)))
|
||||
(when (and (<= (length bindings) 2)
|
||||
(not (listp (car bindings))))
|
||||
;; Adjust the single binding case
|
||||
(setq bindings (list bindings)))
|
||||
`(let* ,(internal--build-bindings bindings)
|
||||
(if ,(car (internal--listify (car (last bindings))))
|
||||
,then
|
||||
,@else)))
|
||||
(if varlist
|
||||
`(let* ,(setq varlist (internal--build-bindings varlist))
|
||||
(if ,(caar (last varlist))
|
||||
,then
|
||||
,@else))
|
||||
`(let* () ,@else)))
|
||||
|
||||
(defmacro when-let* (bindings &rest body)
|
||||
(defmacro when-let* (varlist &rest body)
|
||||
"Bind variables according to VARLIST and conditionally eval BODY.
|
||||
Each binding is evaluated in turn with `let*', and evaluation
|
||||
stops if a binding value is nil. If all are non-nil, the value
|
||||
of the last form in BODY is returned.
|
||||
Each element of VARLIST is a symbol (which is bound to nil)
|
||||
or a list (SYMBOL VALUEFORM) (which binds SYMBOL to the value of VALUEFORM).
|
||||
In the special case you only want to bind a single value,
|
||||
VARLIST can just be a plain tuple.
|
||||
\n(fn VARLIST BODY...)"
|
||||
(declare (indent 1) (debug if-let))
|
||||
(list 'if-let bindings (macroexp-progn body)))
|
||||
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
|
||||
form in BODY is returned.
|
||||
|
||||
(defalias 'if-let 'if-let*)
|
||||
(defalias 'when-let 'when-let*)
|
||||
(defalias 'and-let* 'when-let*)
|
||||
VARLIST is the same as in `if-let*'."
|
||||
(declare (indent 1) (debug if-let*))
|
||||
(list 'if-let* varlist (macroexp-progn body)))
|
||||
|
||||
(defmacro and-let* (varlist &rest body)
|
||||
"Bind variables according to VARLIST and conditionally eval BODY.
|
||||
Like `when-let*', except if BODY is empty and all the bindings
|
||||
are non-nil, then the result is non-nil."
|
||||
(declare (indent 1) (debug when-let*))
|
||||
(let (res)
|
||||
(if varlist
|
||||
`(let* ,(setq varlist (internal--build-bindings varlist))
|
||||
(if ,(setq res (caar (last varlist)))
|
||||
,@(or body `(,res))))
|
||||
`(let* () ,@(or body '(t))))))
|
||||
|
||||
(defmacro if-let (spec then &rest else)
|
||||
"Bind variables according to SPEC and eval THEN or ELSE.
|
||||
Like `if-let*' except SPEC can have the form (SYMBOL VALUEFORM)."
|
||||
(declare (indent 2)
|
||||
(debug ([&or (&rest [&or symbolp (symbolp form) (sexp)])
|
||||
(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)
|
||||
"Check whether HASH-TABLE is empty (has 0 elements)."
|
||||
|
|
|
|||
|
|
@ -28,13 +28,13 @@
|
|||
(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."
|
||||
(should (equal
|
||||
(macroexpand
|
||||
'(if-let (a 1)
|
||||
'(if-let* ((a 1))
|
||||
(- a)
|
||||
"no"))
|
||||
'(let* ((a (and t 1)))
|
||||
|
|
@ -43,53 +43,53 @@
|
|||
"no"))))
|
||||
(should (equal
|
||||
(macroexpand
|
||||
'(if-let (a)
|
||||
'(if-let* (a)
|
||||
(- a)
|
||||
"no"))
|
||||
'(let* ((a (and t nil)))
|
||||
'(let* ((a (and t a)))
|
||||
(if a
|
||||
(- a)
|
||||
"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."
|
||||
(should (equal
|
||||
(macroexpand
|
||||
'(if-let (a)
|
||||
'(if-let* (a)
|
||||
(- a)
|
||||
"no"))
|
||||
'(let* ((a (and t nil)))
|
||||
'(let* ((a (and t a)))
|
||||
(if a
|
||||
(- a)
|
||||
"no"))))
|
||||
(should (equal
|
||||
(macroexpand
|
||||
'(if-let (a b c)
|
||||
'(if-let* (a b c)
|
||||
(- a)
|
||||
"no"))
|
||||
'(let* ((a (and t nil))
|
||||
(b (and a nil))
|
||||
(c (and b nil)))
|
||||
'(let* ((a (and t a))
|
||||
(b (and a b))
|
||||
(c (and b c)))
|
||||
(if c
|
||||
(- a)
|
||||
"no"))))
|
||||
(should (equal
|
||||
(macroexpand
|
||||
'(if-let (a (b 2) c)
|
||||
'(if-let* (a (b 2) c)
|
||||
(- a)
|
||||
"no"))
|
||||
'(let* ((a (and t nil))
|
||||
'(let* ((a (and t a))
|
||||
(b (and a 2))
|
||||
(c (and b nil)))
|
||||
(c (and b c)))
|
||||
(if c
|
||||
(- a)
|
||||
"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."
|
||||
(should (equal
|
||||
(macroexpand
|
||||
'(if-let (nil)
|
||||
'(if-let* (nil)
|
||||
(- a)
|
||||
"no"))
|
||||
'(let* ((nil (and t nil)))
|
||||
|
|
@ -98,27 +98,7 @@
|
|||
"no"))))
|
||||
(should (equal
|
||||
(macroexpand
|
||||
'(if-let ((nil))
|
||||
(- a)
|
||||
"no"))
|
||||
'(let* ((nil (and t nil)))
|
||||
(if nil
|
||||
(- a)
|
||||
"no"))))
|
||||
(should (equal
|
||||
(macroexpand
|
||||
'(if-let ((a 1) (nil) (b 2))
|
||||
(- a)
|
||||
"no"))
|
||||
'(let* ((a (and t 1))
|
||||
(nil (and a nil))
|
||||
(b (and nil 2)))
|
||||
(if b
|
||||
(- a)
|
||||
"no"))))
|
||||
(should (equal
|
||||
(macroexpand
|
||||
'(if-let ((a 1) nil (b 2))
|
||||
'(if-let* ((a 1) nil (b 2))
|
||||
(- a)
|
||||
"no"))
|
||||
'(let* ((a (and t 1))
|
||||
|
|
@ -128,104 +108,106 @@
|
|||
(- a)
|
||||
"no")))))
|
||||
|
||||
(ert-deftest subr-x-test-if-let-malformed-binding ()
|
||||
(ert-deftest subr-x-test-if-let*-malformed-binding ()
|
||||
"Test malformed bindings trigger errors."
|
||||
(should-error (macroexpand
|
||||
'(if-let (_ (a 1 1) (b 2) (c 3) d)
|
||||
'(if-let* (_ (a 1 1) (b 2) (c 3) d)
|
||||
(- a)
|
||||
"no"))
|
||||
:type 'error)
|
||||
(should-error (macroexpand
|
||||
'(if-let (_ (a 1) (b 2 2) (c 3) d)
|
||||
'(if-let* (_ (a 1) (b 2 2) (c 3) d)
|
||||
(- a)
|
||||
"no"))
|
||||
:type 'error)
|
||||
(should-error (macroexpand
|
||||
'(if-let (_ (a 1) (b 2) (c 3 3) d)
|
||||
'(if-let* (_ (a 1) (b 2) (c 3 3) d)
|
||||
(- a)
|
||||
"no"))
|
||||
:type 'error)
|
||||
(should-error (macroexpand
|
||||
'(if-let ((a 1 1))
|
||||
'(if-let* ((a 1 1))
|
||||
(- a)
|
||||
"no"))
|
||||
:type 'error))
|
||||
|
||||
(ert-deftest subr-x-test-if-let-true ()
|
||||
(ert-deftest subr-x-test-if-let*-true ()
|
||||
"Test `if-let' with truthy bindings."
|
||||
(should (equal
|
||||
(if-let (a 1)
|
||||
(if-let* ((a 1))
|
||||
a
|
||||
"no")
|
||||
1))
|
||||
(should (equal
|
||||
(if-let ((a 1) (b 2) (c 3))
|
||||
(if-let* ((a 1) (b 2) (c 3))
|
||||
(list a b c)
|
||||
"no")
|
||||
(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."
|
||||
(should (equal
|
||||
(if-let (a nil)
|
||||
(if-let* ((a nil))
|
||||
(list a b c)
|
||||
"no")
|
||||
"no"))
|
||||
(should (equal
|
||||
(if-let ((a nil) (b 2) (c 3))
|
||||
(if-let* ((a nil) (b 2) (c 3))
|
||||
(list a b c)
|
||||
"no")
|
||||
"no"))
|
||||
(should (equal
|
||||
(if-let ((a 1) (b nil) (c 3))
|
||||
(if-let* ((a 1) (b nil) (c 3))
|
||||
(list a b c)
|
||||
"no")
|
||||
"no"))
|
||||
(should (equal
|
||||
(if-let ((a 1) (b 2) (c nil))
|
||||
(if-let* ((a 1) (b 2) (c nil))
|
||||
(list a b c)
|
||||
"no")
|
||||
"no"))
|
||||
(should (equal
|
||||
(if-let (z (a 1) (b 2) (c 3))
|
||||
(list a b c)
|
||||
"no")
|
||||
(let (z)
|
||||
(if-let* (z (a 1) (b 2) (c 3))
|
||||
(list a b c)
|
||||
"no"))
|
||||
"no"))
|
||||
(should (equal
|
||||
(if-let ((a 1) (b 2) (c 3) d)
|
||||
(list a b c)
|
||||
"no")
|
||||
(let (d)
|
||||
(if-let* ((a 1) (b 2) (c 3) d)
|
||||
(list a b c)
|
||||
"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."
|
||||
(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)
|
||||
"no")
|
||||
(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."
|
||||
(let (a-called b-called c-called)
|
||||
(should (equal
|
||||
(if-let ((a nil)
|
||||
(b (setq b-called t))
|
||||
(c (setq c-called t)))
|
||||
(if-let* ((a nil)
|
||||
(b (setq b-called t))
|
||||
(c (setq c-called t)))
|
||||
"yes"
|
||||
(list a-called b-called c-called))
|
||||
(list nil nil nil))))
|
||||
(let (a-called b-called c-called)
|
||||
(should (equal
|
||||
(if-let ((a (setq a-called t))
|
||||
(b nil)
|
||||
(c (setq c-called t)))
|
||||
(if-let* ((a (setq a-called t))
|
||||
(b nil)
|
||||
(c (setq c-called t)))
|
||||
"yes"
|
||||
(list a-called b-called c-called))
|
||||
(list t nil nil))))
|
||||
(let (a-called b-called c-called)
|
||||
(should (equal
|
||||
(if-let ((a (setq a-called t))
|
||||
(if-let* ((a (setq a-called t))
|
||||
(b (setq b-called t))
|
||||
(c nil)
|
||||
(d (setq c-called t)))
|
||||
|
|
@ -234,13 +216,13 @@
|
|||
(list t t nil)))))
|
||||
|
||||
|
||||
;; 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."
|
||||
(should (equal
|
||||
(macroexpand
|
||||
'(when-let (a 1)
|
||||
'(when-let* ((a 1))
|
||||
(message "opposite")
|
||||
(- a)))
|
||||
'(let* ((a (and t 1)))
|
||||
|
|
@ -249,79 +231,46 @@
|
|||
(message "opposite")
|
||||
(- a)))))))
|
||||
|
||||
(ert-deftest subr-x-test-when-let-single-binding-expansion ()
|
||||
"Test single bindings are expanded properly."
|
||||
(should (equal
|
||||
(macroexpand
|
||||
'(when-let (a 1)
|
||||
(- a)))
|
||||
'(let* ((a (and t 1)))
|
||||
(if a
|
||||
(- a)))))
|
||||
(should (equal
|
||||
(macroexpand
|
||||
'(when-let (a)
|
||||
(- a)))
|
||||
'(let* ((a (and t nil)))
|
||||
(if 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."
|
||||
(should (equal
|
||||
(macroexpand
|
||||
'(when-let (a)
|
||||
'(when-let* (a)
|
||||
(- a)))
|
||||
'(let* ((a (and t nil)))
|
||||
'(let* ((a (and t a)))
|
||||
(if a
|
||||
(- a)))))
|
||||
(should (equal
|
||||
(macroexpand
|
||||
'(when-let (a b c)
|
||||
'(when-let* (a b c)
|
||||
(- a)))
|
||||
'(let* ((a (and t nil))
|
||||
(b (and a nil))
|
||||
(c (and b nil)))
|
||||
'(let* ((a (and t a))
|
||||
(b (and a b))
|
||||
(c (and b c)))
|
||||
(if c
|
||||
(- a)))))
|
||||
(should (equal
|
||||
(macroexpand
|
||||
'(when-let (a (b 2) c)
|
||||
'(when-let* (a (b 2) c)
|
||||
(- a)))
|
||||
'(let* ((a (and t nil))
|
||||
'(let* ((a (and t a))
|
||||
(b (and a 2))
|
||||
(c (and b nil)))
|
||||
(c (and b c)))
|
||||
(if c
|
||||
(- 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."
|
||||
(should (equal
|
||||
(macroexpand
|
||||
'(when-let (nil)
|
||||
'(when-let* (nil)
|
||||
(- a)))
|
||||
'(let* ((nil (and t nil)))
|
||||
(if nil
|
||||
(- a)))))
|
||||
(should (equal
|
||||
(macroexpand
|
||||
'(when-let ((nil))
|
||||
(- a)))
|
||||
'(let* ((nil (and t nil)))
|
||||
(if nil
|
||||
(- a)))))
|
||||
(should (equal
|
||||
(macroexpand
|
||||
'(when-let ((a 1) (nil) (b 2))
|
||||
(- a)))
|
||||
'(let* ((a (and t 1))
|
||||
(nil (and a nil))
|
||||
(b (and nil 2)))
|
||||
(if b
|
||||
(- a)))))
|
||||
(should (equal
|
||||
(macroexpand
|
||||
'(when-let ((a 1) nil (b 2))
|
||||
'(when-let* ((a 1) nil (b 2))
|
||||
(- a)))
|
||||
'(let* ((a (and t 1))
|
||||
(nil (and a nil))
|
||||
|
|
@ -329,107 +278,170 @@
|
|||
(if b
|
||||
(- a))))))
|
||||
|
||||
(ert-deftest subr-x-test-when-let-malformed-binding ()
|
||||
(ert-deftest subr-x-test-when-let*-malformed-binding ()
|
||||
"Test malformed bindings trigger errors."
|
||||
(should-error (macroexpand
|
||||
'(when-let (_ (a 1 1) (b 2) (c 3) d)
|
||||
'(when-let* (_ (a 1 1) (b 2) (c 3) d)
|
||||
(- a)))
|
||||
:type 'error)
|
||||
(should-error (macroexpand
|
||||
'(when-let (_ (a 1) (b 2 2) (c 3) d)
|
||||
'(when-let* (_ (a 1) (b 2 2) (c 3) d)
|
||||
(- a)))
|
||||
:type 'error)
|
||||
(should-error (macroexpand
|
||||
'(when-let (_ (a 1) (b 2) (c 3 3) d)
|
||||
'(when-let* (_ (a 1) (b 2) (c 3 3) d)
|
||||
(- a)))
|
||||
:type 'error)
|
||||
(should-error (macroexpand
|
||||
'(when-let ((a 1 1))
|
||||
'(when-let* ((a 1 1))
|
||||
(- a)))
|
||||
:type 'error))
|
||||
|
||||
(ert-deftest subr-x-test-when-let-true ()
|
||||
(ert-deftest subr-x-test-when-let*-true ()
|
||||
"Test `when-let' with truthy bindings."
|
||||
(should (equal
|
||||
(when-let (a 1)
|
||||
(when-let* ((a 1))
|
||||
a)
|
||||
1))
|
||||
(should (equal
|
||||
(when-let ((a 1) (b 2) (c 3))
|
||||
(when-let* ((a 1) (b 2) (c 3))
|
||||
(list a b c))
|
||||
(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."
|
||||
(should (equal
|
||||
(when-let (a nil)
|
||||
(when-let* ((a nil))
|
||||
(list a b c)
|
||||
"no")
|
||||
nil))
|
||||
(should (equal
|
||||
(when-let ((a nil) (b 2) (c 3))
|
||||
(when-let* ((a nil) (b 2) (c 3))
|
||||
(list a b c)
|
||||
"no")
|
||||
nil))
|
||||
(should (equal
|
||||
(when-let ((a 1) (b nil) (c 3))
|
||||
(when-let* ((a 1) (b nil) (c 3))
|
||||
(list a b c)
|
||||
"no")
|
||||
nil))
|
||||
(should (equal
|
||||
(when-let ((a 1) (b 2) (c nil))
|
||||
(when-let* ((a 1) (b 2) (c nil))
|
||||
(list a b c)
|
||||
"no")
|
||||
nil))
|
||||
(should (equal
|
||||
(when-let (z (a 1) (b 2) (c 3))
|
||||
(list a b c)
|
||||
"no")
|
||||
(let (z)
|
||||
(when-let* (z (a 1) (b 2) (c 3))
|
||||
(list a b c)
|
||||
"no"))
|
||||
nil))
|
||||
(should (equal
|
||||
(when-let ((a 1) (b 2) (c 3) d)
|
||||
(list a b c)
|
||||
"no")
|
||||
(let (d)
|
||||
(when-let* ((a 1) (b 2) (c 3) d)
|
||||
(list a b c)
|
||||
"no"))
|
||||
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."
|
||||
(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 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."
|
||||
(let (a-called b-called c-called)
|
||||
(should (equal
|
||||
(progn
|
||||
(when-let ((a nil)
|
||||
(b (setq b-called t))
|
||||
(c (setq c-called t)))
|
||||
(when-let* ((a nil)
|
||||
(b (setq b-called t))
|
||||
(c (setq c-called t)))
|
||||
"yes")
|
||||
(list a-called b-called c-called))
|
||||
(list nil nil nil))))
|
||||
(let (a-called b-called c-called)
|
||||
(should (equal
|
||||
(progn
|
||||
(when-let ((a (setq a-called t))
|
||||
(b nil)
|
||||
(c (setq c-called t)))
|
||||
(when-let* ((a (setq a-called t))
|
||||
(b nil)
|
||||
(c (setq c-called t)))
|
||||
"yes")
|
||||
(list a-called b-called c-called))
|
||||
(list t nil nil))))
|
||||
(let (a-called b-called c-called)
|
||||
(should (equal
|
||||
(progn
|
||||
(when-let ((a (setq a-called t))
|
||||
(b (setq b-called t))
|
||||
(c nil)
|
||||
(d (setq c-called t)))
|
||||
(when-let* ((a (setq a-called t))
|
||||
(b (setq b-called t))
|
||||
(c nil)
|
||||
(d (setq c-called t)))
|
||||
"yes")
|
||||
(list a-called b-called c-called))
|
||||
(list t t nil)))))
|
||||
|
||||
|
||||
;; `and-let*' tests
|
||||
|
||||
;; Adapted from the Guile tests
|
||||
;; https://git.savannah.gnu.org/cgit/guile.git/tree/test-suite/tests/srfi-2.test
|
||||
|
||||
(ert-deftest subr-x-and-let*-test-empty-varlist ()
|
||||
(should (equal 1 (and-let* () 1)))
|
||||
(should (equal 2 (and-let* () 1 2)))
|
||||
(should (equal t (and-let* ()))))
|
||||
|
||||
(ert-deftest subr-x-and-let*-test-group-1 ()
|
||||
(should (equal nil (let ((x nil)) (and-let* (x)))))
|
||||
(should (equal 1 (let ((x 1)) (and-let* (x)))))
|
||||
(should (equal nil (and-let* ((x nil)))))
|
||||
(should (equal 1 (and-let* ((x 1)))))
|
||||
(should-error (and-let* (nil (x 1))) :type 'setting-constant)
|
||||
(should (equal nil (and-let* ((nil) (x 1)))))
|
||||
(should-error (and-let* (2 (x 1))) :type 'wrong-type-argument)
|
||||
(should (equal 1 (and-let* ((2) (x 1)))))
|
||||
(should (equal 2 (and-let* ((x 1) (2)))))
|
||||
(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)))))
|
||||
(should (equal 2 (let ((x 1)) (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 t (let ((x 1)) (and-let* (((> x 0)))))))
|
||||
(should (equal nil (let ((x 0)) (and-let* (((> x 0))) (+ x 1)))))
|
||||
(should (equal 3
|
||||
(let ((x 1)) (and-let* (((> x 0)) (x (+ x 1))) (+ x 1))))))
|
||||
|
||||
(ert-deftest subr-x-and-let*-test-rebind ()
|
||||
(should
|
||||
(equal 4
|
||||
(let ((x 1))
|
||||
(and-let* (((> x 0)) (x (+ x 1)) (x (+ x 1))) (+ x 1))))))
|
||||
|
||||
(ert-deftest subr-x-and-let*-test-group-2 ()
|
||||
(should
|
||||
(equal 2 (let ((x 1)) (and-let* (x ((> x 0))) (+ x 1)))))
|
||||
(should
|
||||
(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 nil)) (and-let* (x ((> x 0))) (+ x 1)))))
|
||||
(should
|
||||
(equal nil (let ((x nil)) (and-let* (((progn x)) ((> x 0))) (+ x 1))))))
|
||||
|
||||
(ert-deftest subr-x-and-let*-test-group-3 ()
|
||||
(should
|
||||
(equal nil (let ((x 1)) (and-let* (x (y (- x 1)) ((> y 0))) (/ x y)))))
|
||||
(should
|
||||
(equal nil (let ((x 0)) (and-let* (x (y (- x 1)) ((> y 0))) (/ x y)))))
|
||||
(should
|
||||
(equal nil
|
||||
(let ((x nil)) (and-let* (x (y (- x 1)) ((> y 0))) (/ x y)))))
|
||||
(should
|
||||
(equal (/ 3.0 2)
|
||||
(let ((x 3.0)) (and-let* (x (y (- x 1)) ((> y 0))) (/ x y))))))
|
||||
|
||||
|
||||
|
||||
;; Thread first tests
|
||||
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue