[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] master 4612b2a 1/2: Implement and-let*
From: |
Mark Oteiza |
Subject: |
[Emacs-diffs] master 4612b2a 1/2: Implement and-let* |
Date: |
Tue, 12 Sep 2017 13:18:14 -0400 (EDT) |
branch: master
commit 4612b2a2b37026bef5a9b8e92878a15dabb9b261
Author: Mark Oteiza <address@hidden>
Commit: Mark Oteiza <address@hidden>
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.
---
etc/NEWS | 12 +-
lisp/emacs-lisp/subr-x.el | 108 +++++++-----
test/lisp/emacs-lisp/subr-x-tests.el | 308 ++++++++++++++++++-----------------
3 files changed, 238 insertions(+), 190 deletions(-)
diff --git a/etc/NEWS b/etc/NEWS
index af29b29..03ef05b 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -1137,6 +1137,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
things like forward-word in readline work.
@@ -1529,10 +1537,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.
diff --git a/lisp/emacs-lisp/subr-x.el b/lisp/emacs-lisp/subr-x.el
index 849ac19..3ea0106 100644
--- a/lisp/emacs-lisp/subr-x.el
+++ b/lisp/emacs-lisp/subr-x.el
@@ -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* (varlist &rest body)
+ "Bind variables according to VARLIST and conditionally eval 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.
+
+VARLIST is the same as in `if-let*'."
+ (declare (indent 1) (debug if-let*))
+ (list 'if-let* varlist (macroexp-progn body)))
-(defmacro when-let* (bindings &rest body)
+(defmacro and-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)))
-
-(defalias 'if-let 'if-let*)
-(defalias 'when-let 'when-let*)
-(defalias 'and-let* 'when-let*)
+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)."
diff --git a/test/lisp/emacs-lisp/subr-x-tests.el
b/test/lisp/emacs-lisp/subr-x-tests.el
index 2b2a5cd..111dc38 100644
--- a/test/lisp/emacs-lisp/subr-x-tests.el
+++ b/test/lisp/emacs-lisp/subr-x-tests.el
@@ -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)
- (- a)))
- '(let* ((nil (and t nil)))
- (if nil
- (- a)))))
- (should (equal
- (macroexpand
- '(when-let ((nil))
+ '(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,108 +278,171 @@
(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
(ert-deftest subr-x-test-thread-first-no-forms ()