diff options
| author | Mark Oteiza | 2017-09-12 12:44:45 -0400 |
|---|---|---|
| committer | Mark Oteiza | 2017-09-12 13:18:06 -0400 |
| commit | 4612b2a2b37026bef5a9b8e92878a15dabb9b261 (patch) | |
| tree | 2434bb2f510047ae9570086c424266743411a39f | |
| parent | c87331a1c04aa4be55be7b944680e4ec486f5b04 (diff) | |
| download | emacs-4612b2a2b37026bef5a9b8e92878a15dabb9b261.tar.gz emacs-4612b2a2b37026bef5a9b8e92878a15dabb9b261.zip | |
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.
| -rw-r--r-- | etc/NEWS | 12 | ||||
| -rw-r--r-- | lisp/emacs-lisp/subr-x.el | 108 | ||||
| -rw-r--r-- | test/lisp/emacs-lisp/subr-x-tests.el | 308 |
3 files changed, 238 insertions, 190 deletions
| @@ -1137,6 +1137,14 @@ be disabled by setting 'byte-compile-cond-use-jump-table' to nil. | |||
| 1137 | ** The alist 'ucs-names' is now a hash table. | 1137 | ** The alist 'ucs-names' is now a hash table. |
| 1138 | 1138 | ||
| 1139 | --- | 1139 | --- |
| 1140 | ** 'if-let' and 'when-let' are subsumed by 'if-let*' and 'when-let*'. | ||
| 1141 | The incumbent 'if-let' and 'when-let' are now marked obsolete. | ||
| 1142 | 'if-let*' and 'when-let*' do not accept the single tuple special case. | ||
| 1143 | New macro 'and-let*' is an implementation of the Scheme SRFI-2 syntax | ||
| 1144 | of the same name. 'if-let*' and 'when-let*' now accept the same | ||
| 1145 | binding syntax as 'and-let*'. | ||
| 1146 | |||
| 1147 | --- | ||
| 1140 | ** 'C-up', 'C-down', 'C-left' and 'C-right' are now defined in term | 1148 | ** 'C-up', 'C-down', 'C-left' and 'C-right' are now defined in term |
| 1141 | mode to send the same escape sequences that xterm does. This makes | 1149 | mode to send the same escape sequences that xterm does. This makes |
| 1142 | things like forward-word in readline work. | 1150 | things like forward-word in readline work. |
| @@ -1529,10 +1537,6 @@ It avoids unnecessary consing (and garbage collection). | |||
| 1529 | ** 'gensym' is now part of Elisp. | 1537 | ** 'gensym' is now part of Elisp. |
| 1530 | 1538 | ||
| 1531 | --- | 1539 | --- |
| 1532 | ** 'if-let*', 'when-let*', and 'and-let*' are new in subr-x.el. | ||
| 1533 | The incumbent 'if-let' and 'when-let' are now aliases. | ||
| 1534 | |||
| 1535 | --- | ||
| 1536 | ** Low-level list functions like 'length' and 'member' now do a better | 1540 | ** Low-level list functions like 'length' and 'member' now do a better |
| 1537 | job of signaling list cycles instead of looping indefinitely. | 1541 | job of signaling list cycles instead of looping indefinitely. |
| 1538 | 1542 | ||
diff --git a/lisp/emacs-lisp/subr-x.el b/lisp/emacs-lisp/subr-x.el index 849ac19d6a5..3ea01065c8b 100644 --- a/lisp/emacs-lisp/subr-x.el +++ b/lisp/emacs-lisp/subr-x.el | |||
| @@ -83,10 +83,15 @@ threading." | |||
| 83 | `(internal--thread-argument nil ,@forms)) | 83 | `(internal--thread-argument nil ,@forms)) |
| 84 | 84 | ||
| 85 | (defsubst internal--listify (elt) | 85 | (defsubst internal--listify (elt) |
| 86 | "Wrap ELT in a list if it is not one." | 86 | "Wrap ELT in a list if it is not one. |
| 87 | (if (not (listp elt)) | 87 | If ELT is of the form ((EXPR)), listify (EXPR) with a dummy symbol." |
| 88 | (list elt) | 88 | (cond |
| 89 | elt)) | 89 | ((symbolp elt) (list elt elt)) |
| 90 | ((and (null (cdr elt)) | ||
| 91 | (let ((form (car elt))) | ||
| 92 | (or (listp form) (atom form)))) | ||
| 93 | (list (make-symbol "s") (car elt))) | ||
| 94 | (t elt))) | ||
| 90 | 95 | ||
| 91 | (defsubst internal--check-binding (binding) | 96 | (defsubst internal--check-binding (binding) |
| 92 | "Check BINDING is properly formed." | 97 | "Check BINDING is properly formed." |
| @@ -98,7 +103,10 @@ threading." | |||
| 98 | 103 | ||
| 99 | (defsubst internal--build-binding-value-form (binding prev-var) | 104 | (defsubst internal--build-binding-value-form (binding prev-var) |
| 100 | "Build the conditional value form for BINDING using PREV-VAR." | 105 | "Build the conditional value form for BINDING using PREV-VAR." |
| 101 | `(,(car binding) (and ,prev-var ,(cadr binding)))) | 106 | (let ((var (car binding))) |
| 107 | (if (and (null (cdr binding)) (atom (car binding)) (not (symbolp (car binding)))) | ||
| 108 | `(,var (and ,prev-var ,var)) | ||
| 109 | `(,var (and ,prev-var ,(cadr binding)))))) | ||
| 102 | 110 | ||
| 103 | (defun internal--build-binding (binding prev-var) | 111 | (defun internal--build-binding (binding prev-var) |
| 104 | "Check and build a single BINDING with PREV-VAR." | 112 | "Check and build a single BINDING with PREV-VAR." |
| @@ -117,44 +125,68 @@ threading." | |||
| 117 | binding)) | 125 | binding)) |
| 118 | bindings))) | 126 | bindings))) |
| 119 | 127 | ||
| 120 | (defmacro if-let* (bindings then &rest else) | 128 | (defmacro if-let* (varlist then &rest else) |
| 121 | "Bind variables according to VARLIST and eval THEN or ELSE. | 129 | "Bind variables according to VARLIST and eval THEN or ELSE. |
| 122 | Each binding is evaluated in turn with `let*', and evaluation | 130 | Each binding is evaluated in turn, and evaluation stops if a |
| 123 | stops if a binding value is nil. If all are non-nil, the value | 131 | binding value is nil. If all are non-nil, the value of THEN is |
| 124 | of THEN is returned, or the last form in ELSE is returned. | 132 | returned, or the last form in ELSE is returned. |
| 125 | Each element of VARLIST is a symbol (which is bound to nil) | 133 | |
| 126 | or a list (SYMBOL VALUEFORM) (which binds SYMBOL to the value of VALUEFORM). | 134 | Each element of VARLIST is a list (SYMBOL VALUEFORM) which binds |
| 127 | In the special case you only want to bind a single value, | 135 | SYMBOL to the value of VALUEFORM). |
| 128 | VARLIST can just be a plain tuple. | 136 | An element can additionally be of the form (VALUEFORM), which is |
| 129 | \n(fn VARLIST THEN ELSE...)" | 137 | evaluated and checked for nil." |
| 130 | (declare (indent 2) | 138 | (declare (indent 2) |
| 131 | (debug ([&or (&rest [&or symbolp (symbolp form)]) (symbolp form)] | 139 | (debug ((&rest [&or symbolp (symbolp form) (sexp)]) |
| 132 | form body))) | 140 | form body))) |
| 133 | (when (and (<= (length bindings) 2) | 141 | (if varlist |
| 134 | (not (listp (car bindings)))) | 142 | `(let* ,(setq varlist (internal--build-bindings varlist)) |
| 135 | ;; Adjust the single binding case | 143 | (if ,(caar (last varlist)) |
| 136 | (setq bindings (list bindings))) | 144 | ,then |
| 137 | `(let* ,(internal--build-bindings bindings) | 145 | ,@else)) |
| 138 | (if ,(car (internal--listify (car (last bindings)))) | 146 | `(let* () ,@else))) |
| 139 | ,then | 147 | |
| 140 | ,@else))) | 148 | (defmacro when-let* (varlist &rest body) |
| 149 | "Bind variables according to VARLIST and conditionally eval BODY. | ||
| 150 | Each binding is evaluated in turn, and evaluation stops if a | ||
| 151 | binding value is nil. If all are non-nil, the value of the last | ||
| 152 | form in BODY is returned. | ||
| 153 | |||
| 154 | VARLIST is the same as in `if-let*'." | ||
| 155 | (declare (indent 1) (debug if-let*)) | ||
| 156 | (list 'if-let* varlist (macroexp-progn body))) | ||
| 141 | 157 | ||
| 142 | (defmacro when-let* (bindings &rest body) | 158 | (defmacro and-let* (varlist &rest body) |
| 143 | "Bind variables according to VARLIST and conditionally eval BODY. | 159 | "Bind variables according to VARLIST and conditionally eval BODY. |
| 144 | Each binding is evaluated in turn with `let*', and evaluation | 160 | Like `when-let*', except if BODY is empty and all the bindings |
| 145 | stops if a binding value is nil. If all are non-nil, the value | 161 | are non-nil, then the result is non-nil." |
| 146 | of the last form in BODY is returned. | 162 | (declare (indent 1) (debug when-let*)) |
| 147 | Each element of VARLIST is a symbol (which is bound to nil) | 163 | (let (res) |
| 148 | or a list (SYMBOL VALUEFORM) (which binds SYMBOL to the value of VALUEFORM). | 164 | (if varlist |
| 149 | In the special case you only want to bind a single value, | 165 | `(let* ,(setq varlist (internal--build-bindings varlist)) |
| 150 | VARLIST can just be a plain tuple. | 166 | (if ,(setq res (caar (last varlist))) |
| 151 | \n(fn VARLIST BODY...)" | 167 | ,@(or body `(,res)))) |
| 152 | (declare (indent 1) (debug if-let)) | 168 | `(let* () ,@(or body '(t)))))) |
| 153 | (list 'if-let bindings (macroexp-progn body))) | 169 | |
| 154 | 170 | (defmacro if-let (spec then &rest else) | |
| 155 | (defalias 'if-let 'if-let*) | 171 | "Bind variables according to SPEC and eval THEN or ELSE. |
| 156 | (defalias 'when-let 'when-let*) | 172 | Like `if-let*' except SPEC can have the form (SYMBOL VALUEFORM)." |
| 157 | (defalias 'and-let* 'when-let*) | 173 | (declare (indent 2) |
| 174 | (debug ([&or (&rest [&or symbolp (symbolp form) (sexp)]) | ||
| 175 | (symbolp form)] | ||
| 176 | form body)) | ||
| 177 | (obsolete "use `if-let*' instead." "26.1")) | ||
| 178 | (when (and (<= (length spec) 2) | ||
| 179 | (not (listp (car spec)))) | ||
| 180 | ;; Adjust the single binding case | ||
| 181 | (setq spec (list spec))) | ||
| 182 | (list 'if-let* spec then (macroexp-progn else))) | ||
| 183 | |||
| 184 | (defmacro when-let (spec &rest body) | ||
| 185 | "Bind variables according to SPEC and conditionally eval BODY. | ||
| 186 | Like `when-let*' except SPEC can have the form (SYMBOL VALUEFORM)." | ||
| 187 | (declare (indent 1) (debug if-let) | ||
| 188 | (obsolete "use `when-let*' instead." "26.1")) | ||
| 189 | (list 'if-let spec (macroexp-progn body))) | ||
| 158 | 190 | ||
| 159 | (defsubst hash-table-empty-p (hash-table) | 191 | (defsubst hash-table-empty-p (hash-table) |
| 160 | "Check whether HASH-TABLE is empty (has 0 elements)." | 192 | "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 2b2a5cd0d71..111dc38f295 100644 --- a/test/lisp/emacs-lisp/subr-x-tests.el +++ b/test/lisp/emacs-lisp/subr-x-tests.el | |||
| @@ -28,13 +28,13 @@ | |||
| 28 | (require 'subr-x) | 28 | (require 'subr-x) |
| 29 | 29 | ||
| 30 | 30 | ||
| 31 | ;; if-let tests | 31 | ;; `if-let*' tests |
| 32 | 32 | ||
| 33 | (ert-deftest subr-x-test-if-let-single-binding-expansion () | 33 | (ert-deftest subr-x-test-if-let*-single-binding-expansion () |
| 34 | "Test single bindings are expanded properly." | 34 | "Test single bindings are expanded properly." |
| 35 | (should (equal | 35 | (should (equal |
| 36 | (macroexpand | 36 | (macroexpand |
| 37 | '(if-let (a 1) | 37 | '(if-let* ((a 1)) |
| 38 | (- a) | 38 | (- a) |
| 39 | "no")) | 39 | "no")) |
| 40 | '(let* ((a (and t 1))) | 40 | '(let* ((a (and t 1))) |
| @@ -43,53 +43,53 @@ | |||
| 43 | "no")))) | 43 | "no")))) |
| 44 | (should (equal | 44 | (should (equal |
| 45 | (macroexpand | 45 | (macroexpand |
| 46 | '(if-let (a) | 46 | '(if-let* (a) |
| 47 | (- a) | 47 | (- a) |
| 48 | "no")) | 48 | "no")) |
| 49 | '(let* ((a (and t nil))) | 49 | '(let* ((a (and t a))) |
| 50 | (if a | 50 | (if a |
| 51 | (- a) | 51 | (- a) |
| 52 | "no"))))) | 52 | "no"))))) |
| 53 | 53 | ||
| 54 | (ert-deftest subr-x-test-if-let-single-symbol-expansion () | 54 | (ert-deftest subr-x-test-if-let*-single-symbol-expansion () |
| 55 | "Test single symbol bindings are expanded properly." | 55 | "Test single symbol bindings are expanded properly." |
| 56 | (should (equal | 56 | (should (equal |
| 57 | (macroexpand | 57 | (macroexpand |
| 58 | '(if-let (a) | 58 | '(if-let* (a) |
| 59 | (- a) | 59 | (- a) |
| 60 | "no")) | 60 | "no")) |
| 61 | '(let* ((a (and t nil))) | 61 | '(let* ((a (and t a))) |
| 62 | (if a | 62 | (if a |
| 63 | (- a) | 63 | (- a) |
| 64 | "no")))) | 64 | "no")))) |
| 65 | (should (equal | 65 | (should (equal |
| 66 | (macroexpand | 66 | (macroexpand |
| 67 | '(if-let (a b c) | 67 | '(if-let* (a b c) |
| 68 | (- a) | 68 | (- a) |
| 69 | "no")) | 69 | "no")) |
| 70 | '(let* ((a (and t nil)) | 70 | '(let* ((a (and t a)) |
| 71 | (b (and a nil)) | 71 | (b (and a b)) |
| 72 | (c (and b nil))) | 72 | (c (and b c))) |
| 73 | (if c | 73 | (if c |
| 74 | (- a) | 74 | (- a) |
| 75 | "no")))) | 75 | "no")))) |
| 76 | (should (equal | 76 | (should (equal |
| 77 | (macroexpand | 77 | (macroexpand |
| 78 | '(if-let (a (b 2) c) | 78 | '(if-let* (a (b 2) c) |
| 79 | (- a) | 79 | (- a) |
| 80 | "no")) | 80 | "no")) |
| 81 | '(let* ((a (and t nil)) | 81 | '(let* ((a (and t a)) |
| 82 | (b (and a 2)) | 82 | (b (and a 2)) |
| 83 | (c (and b nil))) | 83 | (c (and b c))) |
| 84 | (if c | 84 | (if c |
| 85 | (- a) | 85 | (- a) |
| 86 | "no"))))) | 86 | "no"))))) |
| 87 | 87 | ||
| 88 | (ert-deftest subr-x-test-if-let-nil-related-expansion () | 88 | (ert-deftest subr-x-test-if-let*-nil-related-expansion () |
| 89 | "Test nil is processed properly." | 89 | "Test nil is processed properly." |
| 90 | (should (equal | 90 | (should (equal |
| 91 | (macroexpand | 91 | (macroexpand |
| 92 | '(if-let (nil) | 92 | '(if-let* (nil) |
| 93 | (- a) | 93 | (- a) |
| 94 | "no")) | 94 | "no")) |
| 95 | '(let* ((nil (and t nil))) | 95 | '(let* ((nil (and t nil))) |
| @@ -98,27 +98,7 @@ | |||
| 98 | "no")))) | 98 | "no")))) |
| 99 | (should (equal | 99 | (should (equal |
| 100 | (macroexpand | 100 | (macroexpand |
| 101 | '(if-let ((nil)) | 101 | '(if-let* ((a 1) nil (b 2)) |
| 102 | (- a) | ||
| 103 | "no")) | ||
| 104 | '(let* ((nil (and t nil))) | ||
| 105 | (if nil | ||
| 106 | (- a) | ||
| 107 | "no")))) | ||
| 108 | (should (equal | ||
| 109 | (macroexpand | ||
| 110 | '(if-let ((a 1) (nil) (b 2)) | ||
| 111 | (- a) | ||
| 112 | "no")) | ||
| 113 | '(let* ((a (and t 1)) | ||
| 114 | (nil (and a nil)) | ||
| 115 | (b (and nil 2))) | ||
| 116 | (if b | ||
| 117 | (- a) | ||
| 118 | "no")))) | ||
| 119 | (should (equal | ||
| 120 | (macroexpand | ||
| 121 | '(if-let ((a 1) nil (b 2)) | ||
| 122 | (- a) | 102 | (- a) |
| 123 | "no")) | 103 | "no")) |
| 124 | '(let* ((a (and t 1)) | 104 | '(let* ((a (and t 1)) |
| @@ -128,104 +108,106 @@ | |||
| 128 | (- a) | 108 | (- a) |
| 129 | "no"))))) | 109 | "no"))))) |
| 130 | 110 | ||
| 131 | (ert-deftest subr-x-test-if-let-malformed-binding () | 111 | (ert-deftest subr-x-test-if-let*-malformed-binding () |
| 132 | "Test malformed bindings trigger errors." | 112 | "Test malformed bindings trigger errors." |
| 133 | (should-error (macroexpand | 113 | (should-error (macroexpand |
| 134 | '(if-let (_ (a 1 1) (b 2) (c 3) d) | 114 | '(if-let* (_ (a 1 1) (b 2) (c 3) d) |
| 135 | (- a) | 115 | (- a) |
| 136 | "no")) | 116 | "no")) |
| 137 | :type 'error) | 117 | :type 'error) |
| 138 | (should-error (macroexpand | 118 | (should-error (macroexpand |
| 139 | '(if-let (_ (a 1) (b 2 2) (c 3) d) | 119 | '(if-let* (_ (a 1) (b 2 2) (c 3) d) |
| 140 | (- a) | 120 | (- a) |
| 141 | "no")) | 121 | "no")) |
| 142 | :type 'error) | 122 | :type 'error) |
| 143 | (should-error (macroexpand | 123 | (should-error (macroexpand |
| 144 | '(if-let (_ (a 1) (b 2) (c 3 3) d) | 124 | '(if-let* (_ (a 1) (b 2) (c 3 3) d) |
| 145 | (- a) | 125 | (- a) |
| 146 | "no")) | 126 | "no")) |
| 147 | :type 'error) | 127 | :type 'error) |
| 148 | (should-error (macroexpand | 128 | (should-error (macroexpand |
| 149 | '(if-let ((a 1 1)) | 129 | '(if-let* ((a 1 1)) |
| 150 | (- a) | 130 | (- a) |
| 151 | "no")) | 131 | "no")) |
| 152 | :type 'error)) | 132 | :type 'error)) |
| 153 | 133 | ||
| 154 | (ert-deftest subr-x-test-if-let-true () | 134 | (ert-deftest subr-x-test-if-let*-true () |
| 155 | "Test `if-let' with truthy bindings." | 135 | "Test `if-let' with truthy bindings." |
| 156 | (should (equal | 136 | (should (equal |
| 157 | (if-let (a 1) | 137 | (if-let* ((a 1)) |
| 158 | a | 138 | a |
| 159 | "no") | 139 | "no") |
| 160 | 1)) | 140 | 1)) |
| 161 | (should (equal | 141 | (should (equal |
| 162 | (if-let ((a 1) (b 2) (c 3)) | 142 | (if-let* ((a 1) (b 2) (c 3)) |
| 163 | (list a b c) | 143 | (list a b c) |
| 164 | "no") | 144 | "no") |
| 165 | (list 1 2 3)))) | 145 | (list 1 2 3)))) |
| 166 | 146 | ||
| 167 | (ert-deftest subr-x-test-if-let-false () | 147 | (ert-deftest subr-x-test-if-let*-false () |
| 168 | "Test `if-let' with falsie bindings." | 148 | "Test `if-let' with falsie bindings." |
| 169 | (should (equal | 149 | (should (equal |
| 170 | (if-let (a nil) | 150 | (if-let* ((a nil)) |
| 171 | (list a b c) | 151 | (list a b c) |
| 172 | "no") | 152 | "no") |
| 173 | "no")) | 153 | "no")) |
| 174 | (should (equal | 154 | (should (equal |
| 175 | (if-let ((a nil) (b 2) (c 3)) | 155 | (if-let* ((a nil) (b 2) (c 3)) |
| 176 | (list a b c) | 156 | (list a b c) |
| 177 | "no") | 157 | "no") |
| 178 | "no")) | 158 | "no")) |
| 179 | (should (equal | 159 | (should (equal |
| 180 | (if-let ((a 1) (b nil) (c 3)) | 160 | (if-let* ((a 1) (b nil) (c 3)) |
| 181 | (list a b c) | 161 | (list a b c) |
| 182 | "no") | 162 | "no") |
| 183 | "no")) | 163 | "no")) |
| 184 | (should (equal | 164 | (should (equal |
| 185 | (if-let ((a 1) (b 2) (c nil)) | 165 | (if-let* ((a 1) (b 2) (c nil)) |
| 186 | (list a b c) | 166 | (list a b c) |
| 187 | "no") | 167 | "no") |
| 188 | "no")) | 168 | "no")) |
| 189 | (should (equal | 169 | (should (equal |
| 190 | (if-let (z (a 1) (b 2) (c 3)) | 170 | (let (z) |
| 191 | (list a b c) | 171 | (if-let* (z (a 1) (b 2) (c 3)) |
| 192 | "no") | 172 | (list a b c) |
| 173 | "no")) | ||
| 193 | "no")) | 174 | "no")) |
| 194 | (should (equal | 175 | (should (equal |
| 195 | (if-let ((a 1) (b 2) (c 3) d) | 176 | (let (d) |
| 196 | (list a b c) | 177 | (if-let* ((a 1) (b 2) (c 3) d) |
| 197 | "no") | 178 | (list a b c) |
| 179 | "no")) | ||
| 198 | "no"))) | 180 | "no"))) |
| 199 | 181 | ||
| 200 | (ert-deftest subr-x-test-if-let-bound-references () | 182 | (ert-deftest subr-x-test-if-let*-bound-references () |
| 201 | "Test `if-let' bindings can refer to already bound symbols." | 183 | "Test `if-let' bindings can refer to already bound symbols." |
| 202 | (should (equal | 184 | (should (equal |
| 203 | (if-let ((a (1+ 0)) (b (1+ a)) (c (1+ b))) | 185 | (if-let* ((a (1+ 0)) (b (1+ a)) (c (1+ b))) |
| 204 | (list a b c) | 186 | (list a b c) |
| 205 | "no") | 187 | "no") |
| 206 | (list 1 2 3)))) | 188 | (list 1 2 3)))) |
| 207 | 189 | ||
| 208 | (ert-deftest subr-x-test-if-let-and-laziness-is-preserved () | 190 | (ert-deftest subr-x-test-if-let*-and-laziness-is-preserved () |
| 209 | "Test `if-let' respects `and' laziness." | 191 | "Test `if-let' respects `and' laziness." |
| 210 | (let (a-called b-called c-called) | 192 | (let (a-called b-called c-called) |
| 211 | (should (equal | 193 | (should (equal |
| 212 | (if-let ((a nil) | 194 | (if-let* ((a nil) |
| 213 | (b (setq b-called t)) | 195 | (b (setq b-called t)) |
| 214 | (c (setq c-called t))) | 196 | (c (setq c-called t))) |
| 215 | "yes" | 197 | "yes" |
| 216 | (list a-called b-called c-called)) | 198 | (list a-called b-called c-called)) |
| 217 | (list nil nil nil)))) | 199 | (list nil nil nil)))) |
| 218 | (let (a-called b-called c-called) | 200 | (let (a-called b-called c-called) |
| 219 | (should (equal | 201 | (should (equal |
| 220 | (if-let ((a (setq a-called t)) | 202 | (if-let* ((a (setq a-called t)) |
| 221 | (b nil) | 203 | (b nil) |
| 222 | (c (setq c-called t))) | 204 | (c (setq c-called t))) |
| 223 | "yes" | 205 | "yes" |
| 224 | (list a-called b-called c-called)) | 206 | (list a-called b-called c-called)) |
| 225 | (list t nil nil)))) | 207 | (list t nil nil)))) |
| 226 | (let (a-called b-called c-called) | 208 | (let (a-called b-called c-called) |
| 227 | (should (equal | 209 | (should (equal |
| 228 | (if-let ((a (setq a-called t)) | 210 | (if-let* ((a (setq a-called t)) |
| 229 | (b (setq b-called t)) | 211 | (b (setq b-called t)) |
| 230 | (c nil) | 212 | (c nil) |
| 231 | (d (setq c-called t))) | 213 | (d (setq c-called t))) |
| @@ -234,13 +216,13 @@ | |||
| 234 | (list t t nil))))) | 216 | (list t t nil))))) |
| 235 | 217 | ||
| 236 | 218 | ||
| 237 | ;; when-let tests | 219 | ;; `when-let*' tests |
| 238 | 220 | ||
| 239 | (ert-deftest subr-x-test-when-let-body-expansion () | 221 | (ert-deftest subr-x-test-when-let*-body-expansion () |
| 240 | "Test body allows for multiple sexps wrapping with progn." | 222 | "Test body allows for multiple sexps wrapping with progn." |
| 241 | (should (equal | 223 | (should (equal |
| 242 | (macroexpand | 224 | (macroexpand |
| 243 | '(when-let (a 1) | 225 | '(when-let* ((a 1)) |
| 244 | (message "opposite") | 226 | (message "opposite") |
| 245 | (- a))) | 227 | (- a))) |
| 246 | '(let* ((a (and t 1))) | 228 | '(let* ((a (and t 1))) |
| @@ -249,79 +231,46 @@ | |||
| 249 | (message "opposite") | 231 | (message "opposite") |
| 250 | (- a))))))) | 232 | (- a))))))) |
| 251 | 233 | ||
| 252 | (ert-deftest subr-x-test-when-let-single-binding-expansion () | 234 | (ert-deftest subr-x-test-when-let*-single-symbol-expansion () |
| 253 | "Test single bindings are expanded properly." | ||
| 254 | (should (equal | ||
| 255 | (macroexpand | ||
| 256 | '(when-let (a 1) | ||
| 257 | (- a))) | ||
| 258 | '(let* ((a (and t 1))) | ||
| 259 | (if a | ||
| 260 | (- a))))) | ||
| 261 | (should (equal | ||
| 262 | (macroexpand | ||
| 263 | '(when-let (a) | ||
| 264 | (- a))) | ||
| 265 | '(let* ((a (and t nil))) | ||
| 266 | (if a | ||
| 267 | (- a)))))) | ||
| 268 | |||
| 269 | (ert-deftest subr-x-test-when-let-single-symbol-expansion () | ||
| 270 | "Test single symbol bindings are expanded properly." | 235 | "Test single symbol bindings are expanded properly." |
| 271 | (should (equal | 236 | (should (equal |
| 272 | (macroexpand | 237 | (macroexpand |
| 273 | '(when-let (a) | 238 | '(when-let* (a) |
| 274 | (- a))) | 239 | (- a))) |
| 275 | '(let* ((a (and t nil))) | 240 | '(let* ((a (and t a))) |
| 276 | (if a | 241 | (if a |
| 277 | (- a))))) | 242 | (- a))))) |
| 278 | (should (equal | 243 | (should (equal |
| 279 | (macroexpand | 244 | (macroexpand |
| 280 | '(when-let (a b c) | 245 | '(when-let* (a b c) |
| 281 | (- a))) | 246 | (- a))) |
| 282 | '(let* ((a (and t nil)) | 247 | '(let* ((a (and t a)) |
| 283 | (b (and a nil)) | 248 | (b (and a b)) |
| 284 | (c (and b nil))) | 249 | (c (and b c))) |
| 285 | (if c | 250 | (if c |
| 286 | (- a))))) | 251 | (- a))))) |
| 287 | (should (equal | 252 | (should (equal |
| 288 | (macroexpand | 253 | (macroexpand |
| 289 | '(when-let (a (b 2) c) | 254 | '(when-let* (a (b 2) c) |
| 290 | (- a))) | 255 | (- a))) |
| 291 | '(let* ((a (and t nil)) | 256 | '(let* ((a (and t a)) |
| 292 | (b (and a 2)) | 257 | (b (and a 2)) |
| 293 | (c (and b nil))) | 258 | (c (and b c))) |
| 294 | (if c | 259 | (if c |
| 295 | (- a)))))) | 260 | (- a)))))) |
| 296 | 261 | ||
| 297 | (ert-deftest subr-x-test-when-let-nil-related-expansion () | 262 | (ert-deftest subr-x-test-when-let*-nil-related-expansion () |
| 298 | "Test nil is processed properly." | 263 | "Test nil is processed properly." |
| 299 | (should (equal | 264 | (should (equal |
| 300 | (macroexpand | 265 | (macroexpand |
| 301 | '(when-let (nil) | 266 | '(when-let* (nil) |
| 302 | (- a))) | ||
| 303 | '(let* ((nil (and t nil))) | ||
| 304 | (if nil | ||
| 305 | (- a))))) | ||
| 306 | (should (equal | ||
| 307 | (macroexpand | ||
| 308 | '(when-let ((nil)) | ||
| 309 | (- a))) | 267 | (- a))) |
| 310 | '(let* ((nil (and t nil))) | 268 | '(let* ((nil (and t nil))) |
| 311 | (if nil | 269 | (if nil |
| 312 | (- a))))) | 270 | (- a))))) |
| 313 | (should (equal | 271 | (should (equal |
| 314 | (macroexpand | 272 | (macroexpand |
| 315 | '(when-let ((a 1) (nil) (b 2)) | 273 | '(when-let* ((a 1) nil (b 2)) |
| 316 | (- a))) | ||
| 317 | '(let* ((a (and t 1)) | ||
| 318 | (nil (and a nil)) | ||
| 319 | (b (and nil 2))) | ||
| 320 | (if b | ||
| 321 | (- a))))) | ||
| 322 | (should (equal | ||
| 323 | (macroexpand | ||
| 324 | '(when-let ((a 1) nil (b 2)) | ||
| 325 | (- a))) | 274 | (- a))) |
| 326 | '(let* ((a (and t 1)) | 275 | '(let* ((a (and t 1)) |
| 327 | (nil (and a nil)) | 276 | (nil (and a nil)) |
| @@ -329,108 +278,171 @@ | |||
| 329 | (if b | 278 | (if b |
| 330 | (- a)))))) | 279 | (- a)))))) |
| 331 | 280 | ||
| 332 | (ert-deftest subr-x-test-when-let-malformed-binding () | 281 | (ert-deftest subr-x-test-when-let*-malformed-binding () |
| 333 | "Test malformed bindings trigger errors." | 282 | "Test malformed bindings trigger errors." |
| 334 | (should-error (macroexpand | 283 | (should-error (macroexpand |
| 335 | '(when-let (_ (a 1 1) (b 2) (c 3) d) | 284 | '(when-let* (_ (a 1 1) (b 2) (c 3) d) |
| 336 | (- a))) | 285 | (- a))) |
| 337 | :type 'error) | 286 | :type 'error) |
| 338 | (should-error (macroexpand | 287 | (should-error (macroexpand |
| 339 | '(when-let (_ (a 1) (b 2 2) (c 3) d) | 288 | '(when-let* (_ (a 1) (b 2 2) (c 3) d) |
| 340 | (- a))) | 289 | (- a))) |
| 341 | :type 'error) | 290 | :type 'error) |
| 342 | (should-error (macroexpand | 291 | (should-error (macroexpand |
| 343 | '(when-let (_ (a 1) (b 2) (c 3 3) d) | 292 | '(when-let* (_ (a 1) (b 2) (c 3 3) d) |
| 344 | (- a))) | 293 | (- a))) |
| 345 | :type 'error) | 294 | :type 'error) |
| 346 | (should-error (macroexpand | 295 | (should-error (macroexpand |
| 347 | '(when-let ((a 1 1)) | 296 | '(when-let* ((a 1 1)) |
| 348 | (- a))) | 297 | (- a))) |
| 349 | :type 'error)) | 298 | :type 'error)) |
| 350 | 299 | ||
| 351 | (ert-deftest subr-x-test-when-let-true () | 300 | (ert-deftest subr-x-test-when-let*-true () |
| 352 | "Test `when-let' with truthy bindings." | 301 | "Test `when-let' with truthy bindings." |
| 353 | (should (equal | 302 | (should (equal |
| 354 | (when-let (a 1) | 303 | (when-let* ((a 1)) |
| 355 | a) | 304 | a) |
| 356 | 1)) | 305 | 1)) |
| 357 | (should (equal | 306 | (should (equal |
| 358 | (when-let ((a 1) (b 2) (c 3)) | 307 | (when-let* ((a 1) (b 2) (c 3)) |
| 359 | (list a b c)) | 308 | (list a b c)) |
| 360 | (list 1 2 3)))) | 309 | (list 1 2 3)))) |
| 361 | 310 | ||
| 362 | (ert-deftest subr-x-test-when-let-false () | 311 | (ert-deftest subr-x-test-when-let*-false () |
| 363 | "Test `when-let' with falsie bindings." | 312 | "Test `when-let' with falsie bindings." |
| 364 | (should (equal | 313 | (should (equal |
| 365 | (when-let (a nil) | 314 | (when-let* ((a nil)) |
| 366 | (list a b c) | 315 | (list a b c) |
| 367 | "no") | 316 | "no") |
| 368 | nil)) | 317 | nil)) |
| 369 | (should (equal | 318 | (should (equal |
| 370 | (when-let ((a nil) (b 2) (c 3)) | 319 | (when-let* ((a nil) (b 2) (c 3)) |
| 371 | (list a b c) | 320 | (list a b c) |
| 372 | "no") | 321 | "no") |
| 373 | nil)) | 322 | nil)) |
| 374 | (should (equal | 323 | (should (equal |
| 375 | (when-let ((a 1) (b nil) (c 3)) | 324 | (when-let* ((a 1) (b nil) (c 3)) |
| 376 | (list a b c) | 325 | (list a b c) |
| 377 | "no") | 326 | "no") |
| 378 | nil)) | 327 | nil)) |
| 379 | (should (equal | 328 | (should (equal |
| 380 | (when-let ((a 1) (b 2) (c nil)) | 329 | (when-let* ((a 1) (b 2) (c nil)) |
| 381 | (list a b c) | 330 | (list a b c) |
| 382 | "no") | 331 | "no") |
| 383 | nil)) | 332 | nil)) |
| 384 | (should (equal | 333 | (should (equal |
| 385 | (when-let (z (a 1) (b 2) (c 3)) | 334 | (let (z) |
| 386 | (list a b c) | 335 | (when-let* (z (a 1) (b 2) (c 3)) |
| 387 | "no") | 336 | (list a b c) |
| 337 | "no")) | ||
| 388 | nil)) | 338 | nil)) |
| 389 | (should (equal | 339 | (should (equal |
| 390 | (when-let ((a 1) (b 2) (c 3) d) | 340 | (let (d) |
| 391 | (list a b c) | 341 | (when-let* ((a 1) (b 2) (c 3) d) |
| 392 | "no") | 342 | (list a b c) |
| 343 | "no")) | ||
| 393 | nil))) | 344 | nil))) |
| 394 | 345 | ||
| 395 | (ert-deftest subr-x-test-when-let-bound-references () | 346 | (ert-deftest subr-x-test-when-let*-bound-references () |
| 396 | "Test `when-let' bindings can refer to already bound symbols." | 347 | "Test `when-let' bindings can refer to already bound symbols." |
| 397 | (should (equal | 348 | (should (equal |
| 398 | (when-let ((a (1+ 0)) (b (1+ a)) (c (1+ b))) | 349 | (when-let* ((a (1+ 0)) (b (1+ a)) (c (1+ b))) |
| 399 | (list a b c)) | 350 | (list a b c)) |
| 400 | (list 1 2 3)))) | 351 | (list 1 2 3)))) |
| 401 | 352 | ||
| 402 | (ert-deftest subr-x-test-when-let-and-laziness-is-preserved () | 353 | (ert-deftest subr-x-test-when-let*-and-laziness-is-preserved () |
| 403 | "Test `when-let' respects `and' laziness." | 354 | "Test `when-let' respects `and' laziness." |
| 404 | (let (a-called b-called c-called) | 355 | (let (a-called b-called c-called) |
| 405 | (should (equal | 356 | (should (equal |
| 406 | (progn | 357 | (progn |
| 407 | (when-let ((a nil) | 358 | (when-let* ((a nil) |
| 408 | (b (setq b-called t)) | 359 | (b (setq b-called t)) |
| 409 | (c (setq c-called t))) | 360 | (c (setq c-called t))) |
| 410 | "yes") | 361 | "yes") |
| 411 | (list a-called b-called c-called)) | 362 | (list a-called b-called c-called)) |
| 412 | (list nil nil nil)))) | 363 | (list nil nil nil)))) |
| 413 | (let (a-called b-called c-called) | 364 | (let (a-called b-called c-called) |
| 414 | (should (equal | 365 | (should (equal |
| 415 | (progn | 366 | (progn |
| 416 | (when-let ((a (setq a-called t)) | 367 | (when-let* ((a (setq a-called t)) |
| 417 | (b nil) | 368 | (b nil) |
| 418 | (c (setq c-called t))) | 369 | (c (setq c-called t))) |
| 419 | "yes") | 370 | "yes") |
| 420 | (list a-called b-called c-called)) | 371 | (list a-called b-called c-called)) |
| 421 | (list t nil nil)))) | 372 | (list t nil nil)))) |
| 422 | (let (a-called b-called c-called) | 373 | (let (a-called b-called c-called) |
| 423 | (should (equal | 374 | (should (equal |
| 424 | (progn | 375 | (progn |
| 425 | (when-let ((a (setq a-called t)) | 376 | (when-let* ((a (setq a-called t)) |
| 426 | (b (setq b-called t)) | 377 | (b (setq b-called t)) |
| 427 | (c nil) | 378 | (c nil) |
| 428 | (d (setq c-called t))) | 379 | (d (setq c-called t))) |
| 429 | "yes") | 380 | "yes") |
| 430 | (list a-called b-called c-called)) | 381 | (list a-called b-called c-called)) |
| 431 | (list t t nil))))) | 382 | (list t t nil))))) |
| 432 | 383 | ||
| 433 | 384 | ||
| 385 | ;; `and-let*' tests | ||
| 386 | |||
| 387 | ;; Adapted from the Guile tests | ||
| 388 | ;; https://git.savannah.gnu.org/cgit/guile.git/tree/test-suite/tests/srfi-2.test | ||
| 389 | |||
| 390 | (ert-deftest subr-x-and-let*-test-empty-varlist () | ||
| 391 | (should (equal 1 (and-let* () 1))) | ||
| 392 | (should (equal 2 (and-let* () 1 2))) | ||
| 393 | (should (equal t (and-let* ())))) | ||
| 394 | |||
| 395 | (ert-deftest subr-x-and-let*-test-group-1 () | ||
| 396 | (should (equal nil (let ((x nil)) (and-let* (x))))) | ||
| 397 | (should (equal 1 (let ((x 1)) (and-let* (x))))) | ||
| 398 | (should (equal nil (and-let* ((x nil))))) | ||
| 399 | (should (equal 1 (and-let* ((x 1))))) | ||
| 400 | (should-error (and-let* (nil (x 1))) :type 'setting-constant) | ||
| 401 | (should (equal nil (and-let* ((nil) (x 1))))) | ||
| 402 | (should-error (and-let* (2 (x 1))) :type 'wrong-type-argument) | ||
| 403 | (should (equal 1 (and-let* ((2) (x 1))))) | ||
| 404 | (should (equal 2 (and-let* ((x 1) (2))))) | ||
| 405 | (should (equal nil (let ((x nil)) (and-let* (x) x)))) | ||
| 406 | (should (equal "" (let ((x "")) (and-let* (x) x)))) | ||
| 407 | (should (equal "" (let ((x "")) (and-let* (x))))) | ||
| 408 | (should (equal 2 (let ((x 1)) (and-let* (x) (+ x 1))))) | ||
| 409 | (should (equal nil (let ((x nil)) (and-let* (x) (+ x 1))))) | ||
| 410 | (should (equal 2 (let ((x 1)) (and-let* (((> x 0))) (+ x 1))))) | ||
| 411 | (should (equal t (let ((x 1)) (and-let* (((> x 0))))))) | ||
| 412 | (should (equal nil (let ((x 0)) (and-let* (((> x 0))) (+ x 1))))) | ||
| 413 | (should (equal 3 | ||
| 414 | (let ((x 1)) (and-let* (((> x 0)) (x (+ x 1))) (+ x 1)))))) | ||
| 415 | |||
| 416 | (ert-deftest subr-x-and-let*-test-rebind () | ||
| 417 | (should | ||
| 418 | (equal 4 | ||
| 419 | (let ((x 1)) | ||
| 420 | (and-let* (((> x 0)) (x (+ x 1)) (x (+ x 1))) (+ x 1)))))) | ||
| 421 | |||
| 422 | (ert-deftest subr-x-and-let*-test-group-2 () | ||
| 423 | (should | ||
| 424 | (equal 2 (let ((x 1)) (and-let* (x ((> x 0))) (+ x 1))))) | ||
| 425 | (should | ||
| 426 | (equal 2 (let ((x 1)) (and-let* (((progn x)) ((> x 0))) (+ x 1))))) | ||
| 427 | (should (equal nil (let ((x 0)) (and-let* (x ((> x 0))) (+ x 1))))) | ||
| 428 | (should (equal nil (let ((x nil)) (and-let* (x ((> x 0))) (+ x 1))))) | ||
| 429 | (should | ||
| 430 | (equal nil (let ((x nil)) (and-let* (((progn x)) ((> x 0))) (+ x 1)))))) | ||
| 431 | |||
| 432 | (ert-deftest subr-x-and-let*-test-group-3 () | ||
| 433 | (should | ||
| 434 | (equal nil (let ((x 1)) (and-let* (x (y (- x 1)) ((> y 0))) (/ x y))))) | ||
| 435 | (should | ||
| 436 | (equal nil (let ((x 0)) (and-let* (x (y (- x 1)) ((> y 0))) (/ x y))))) | ||
| 437 | (should | ||
| 438 | (equal nil | ||
| 439 | (let ((x nil)) (and-let* (x (y (- x 1)) ((> y 0))) (/ x y))))) | ||
| 440 | (should | ||
| 441 | (equal (/ 3.0 2) | ||
| 442 | (let ((x 3.0)) (and-let* (x (y (- x 1)) ((> y 0))) (/ x y)))))) | ||
| 443 | |||
| 444 | |||
| 445 | |||
| 434 | ;; Thread first tests | 446 | ;; Thread first tests |
| 435 | 447 | ||
| 436 | (ert-deftest subr-x-test-thread-first-no-forms () | 448 | (ert-deftest subr-x-test-thread-first-no-forms () |