diff options
| author | Michael Heerdegen | 2018-03-06 18:28:51 +0100 |
|---|---|---|
| committer | Michael Heerdegen | 2018-03-06 18:32:04 +0100 |
| commit | f6bd7e06861142371994ff9ce54dd62573809fa5 (patch) | |
| tree | 7d75a0b4aba2f82cd6bde0686760e3a1b49345c6 | |
| parent | af4697faa1f5b643f63a9ea61aa205a4c1432e23 (diff) | |
| download | emacs-f6bd7e06861142371994ff9ce54dd62573809fa5.tar.gz emacs-f6bd7e06861142371994ff9ce54dd62573809fa5.zip | |
Revert last commit
This reverts commit af4697faa1f5b643f63a9ea61aa205a4c1432e23. It's
too late for this to be in the release.
| -rw-r--r-- | etc/NEWS | 10 | ||||
| -rw-r--r-- | lisp/emacs-lisp/subr-x.el | 55 | ||||
| -rw-r--r-- | test/lisp/emacs-lisp/subr-x-tests.el | 232 |
3 files changed, 149 insertions, 148 deletions
| @@ -1301,10 +1301,12 @@ current buffer or the self-insertion takes place within a comment. | |||
| 1301 | ** The alist 'ucs-names' is now a hash table. | 1301 | ** The alist 'ucs-names' is now a hash table. |
| 1302 | 1302 | ||
| 1303 | --- | 1303 | --- |
| 1304 | ** The new macro 'and-let' is an implementation of the Scheme SRFI-2 | 1304 | ** 'if-let' and 'when-let' are subsumed by 'if-let*' and 'when-let*'. |
| 1305 | syntax. 'if-let' and 'when-let' now also accept the same binding | 1305 | The incumbent 'if-let' and 'when-let' are now marked obsolete. |
| 1306 | syntax as 'and-let'. 'if-let*', 'when-let*' and 'and-let*' are new | 1306 | 'if-let*' and 'when-let*' do not accept the single tuple special case. |
| 1307 | aliases for 'if-let', 'when-let' and 'and-let'. | 1307 | New macro 'and-let*' is an implementation of the Scheme SRFI-2 syntax |
| 1308 | of the same name. 'if-let*' and 'when-let*' now accept the same | ||
| 1309 | binding syntax as 'and-let*'. | ||
| 1308 | 1310 | ||
| 1309 | --- | 1311 | --- |
| 1310 | ** 'C-up', 'C-down', 'C-left' and 'C-right' are now defined in term | 1312 | ** 'C-up', 'C-down', 'C-left' and 'C-right' are now defined in term |
diff --git a/lisp/emacs-lisp/subr-x.el b/lisp/emacs-lisp/subr-x.el index b2d7f0dec4f..21dba377bf1 100644 --- a/lisp/emacs-lisp/subr-x.el +++ b/lisp/emacs-lisp/subr-x.el | |||
| @@ -121,7 +121,7 @@ If ELT is of the form ((EXPR)), listify (EXPR) with a dummy symbol." | |||
| 121 | binding)) | 121 | binding)) |
| 122 | bindings))) | 122 | bindings))) |
| 123 | 123 | ||
| 124 | (defmacro if-let (varlist then &rest else) | 124 | (defmacro if-let* (varlist then &rest else) |
| 125 | "Bind variables according to VARLIST and eval THEN or ELSE. | 125 | "Bind variables according to VARLIST and eval THEN or ELSE. |
| 126 | Each binding is evaluated in turn, and evaluation stops if a | 126 | Each binding is evaluated in turn, and evaluation stops if a |
| 127 | binding value is nil. If all are non-nil, the value of THEN is | 127 | binding value is nil. If all are non-nil, the value of THEN is |
| @@ -131,18 +131,10 @@ Each element of VARLIST is a list (SYMBOL VALUEFORM) which binds | |||
| 131 | SYMBOL to the value of VALUEFORM. An element can additionally | 131 | SYMBOL to the value of VALUEFORM. An element can additionally |
| 132 | be of the form (VALUEFORM), which is evaluated and checked for | 132 | be of the form (VALUEFORM), which is evaluated and checked for |
| 133 | nil; i.e. SYMBOL can be omitted if only the test result is of | 133 | nil; i.e. SYMBOL can be omitted if only the test result is of |
| 134 | interest. | 134 | interest." |
| 135 | |||
| 136 | As a special case, a VARLIST of the form (SYMBOL SOMETHING) is | ||
| 137 | treated like ((SYMBOL SOMETHING))." | ||
| 138 | (declare (indent 2) | 135 | (declare (indent 2) |
| 139 | (debug ([&or (symbolp form) | 136 | (debug ((&rest [&or symbolp (symbolp form) (form)]) |
| 140 | (&rest [&or symbolp (symbolp form) (form)])] | ||
| 141 | form body))) | 137 | form body))) |
| 142 | (pcase varlist | ||
| 143 | (`(,(pred symbolp) ,_) | ||
| 144 | ;; the single-tuple syntax case, for backward compatibility | ||
| 145 | (cl-callf list varlist))) | ||
| 146 | (if varlist | 138 | (if varlist |
| 147 | `(let* ,(setq varlist (internal--build-bindings varlist)) | 139 | `(let* ,(setq varlist (internal--build-bindings varlist)) |
| 148 | (if ,(caar (last varlist)) | 140 | (if ,(caar (last varlist)) |
| @@ -150,23 +142,23 @@ treated like ((SYMBOL SOMETHING))." | |||
| 150 | ,@else)) | 142 | ,@else)) |
| 151 | `(let* () ,then))) | 143 | `(let* () ,then))) |
| 152 | 144 | ||
| 153 | (defmacro when-let (varlist &rest body) | 145 | (defmacro when-let* (varlist &rest body) |
| 154 | "Bind variables according to VARLIST and conditionally eval BODY. | 146 | "Bind variables according to VARLIST and conditionally eval BODY. |
| 155 | Each binding is evaluated in turn, and evaluation stops if a | 147 | Each binding is evaluated in turn, and evaluation stops if a |
| 156 | binding value is nil. If all are non-nil, the value of the last | 148 | binding value is nil. If all are non-nil, the value of the last |
| 157 | form in BODY is returned. | 149 | form in BODY is returned. |
| 158 | 150 | ||
| 159 | VARLIST is the same as in `if-let'." | 151 | VARLIST is the same as in `if-let*'." |
| 160 | (declare (indent 1) (debug ([&or (symbolp form) | 152 | (declare (indent 1) (debug if-let*)) |
| 161 | (&rest [&or symbolp (symbolp form) (form)])] | 153 | (list 'if-let* varlist (macroexp-progn body))) |
| 162 | body))) | ||
| 163 | (list 'if-let varlist (macroexp-progn body))) | ||
| 164 | 154 | ||
| 165 | (defmacro and-let (varlist &rest body) | 155 | (defmacro and-let* (varlist &rest body) |
| 166 | "Bind variables according to VARLIST and conditionally eval BODY. | 156 | "Bind variables according to VARLIST and conditionally eval BODY. |
| 167 | Like `when-let', except if BODY is empty and all the bindings | 157 | Like `when-let*', except if BODY is empty and all the bindings |
| 168 | are non-nil, then the result is non-nil." | 158 | are non-nil, then the result is non-nil." |
| 169 | (declare (indent 1) (debug when-let)) | 159 | (declare (indent 1) |
| 160 | (debug ((&rest [&or symbolp (symbolp form) (form)]) | ||
| 161 | body))) | ||
| 170 | (let (res) | 162 | (let (res) |
| 171 | (if varlist | 163 | (if varlist |
| 172 | `(let* ,(setq varlist (internal--build-bindings varlist)) | 164 | `(let* ,(setq varlist (internal--build-bindings varlist)) |
| @@ -174,9 +166,26 @@ are non-nil, then the result is non-nil." | |||
| 174 | ,@(or body `(,res)))) | 166 | ,@(or body `(,res)))) |
| 175 | `(let* () ,@(or body '(t)))))) | 167 | `(let* () ,@(or body '(t)))))) |
| 176 | 168 | ||
| 177 | (defalias 'if-let* #'if-let) | 169 | (defmacro if-let (spec then &rest else) |
| 178 | (defalias 'when-let* #'when-let) | 170 | "Bind variables according to SPEC and eval THEN or ELSE. |
| 179 | (defalias 'and-let* #'and-let) | 171 | Like `if-let*' except SPEC can have the form (SYMBOL VALUEFORM)." |
| 172 | (declare (indent 2) | ||
| 173 | (debug ([&or (&rest [&or symbolp (symbolp form) (form)]) | ||
| 174 | (symbolp form)] | ||
| 175 | form body)) | ||
| 176 | (obsolete "use `if-let*' instead." "26.1")) | ||
| 177 | (when (and (<= (length spec) 2) | ||
| 178 | (not (listp (car spec)))) | ||
| 179 | ;; Adjust the single binding case | ||
| 180 | (setq spec (list spec))) | ||
| 181 | (list 'if-let* spec then (macroexp-progn else))) | ||
| 182 | |||
| 183 | (defmacro when-let (spec &rest body) | ||
| 184 | "Bind variables according to SPEC and conditionally eval BODY. | ||
| 185 | Like `when-let*' except SPEC can have the form (SYMBOL VALUEFORM)." | ||
| 186 | (declare (indent 1) (debug if-let) | ||
| 187 | (obsolete "use `when-let*' instead." "26.1")) | ||
| 188 | (list 'if-let spec (macroexp-progn body))) | ||
| 180 | 189 | ||
| 181 | (defsubst hash-table-empty-p (hash-table) | 190 | (defsubst hash-table-empty-p (hash-table) |
| 182 | "Check whether HASH-TABLE is empty (has 0 elements)." | 191 | "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 a361718c9e2..c9618f3c37f 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,7 +43,7 @@ | |||
| 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 a))) | 49 | '(let* ((a (and t a))) |
| @@ -51,11 +51,11 @@ | |||
| 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 a))) | 61 | '(let* ((a (and t a))) |
| @@ -64,7 +64,7 @@ | |||
| 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 a)) | 70 | '(let* ((a (and t a)) |
| @@ -75,7 +75,7 @@ | |||
| 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 a)) | 81 | '(let* ((a (and t a)) |
| @@ -85,11 +85,11 @@ | |||
| 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,7 +98,7 @@ | |||
| 98 | "no")))) | 98 | "no")))) |
| 99 | (should (equal | 99 | (should (equal |
| 100 | (macroexpand | 100 | (macroexpand |
| 101 | '(if-let ((a 1) nil (b 2)) | 101 | '(if-let* ((a 1) nil (b 2)) |
| 102 | (- a) | 102 | (- a) |
| 103 | "no")) | 103 | "no")) |
| 104 | '(let* ((a (and t 1)) | 104 | '(let* ((a (and t 1)) |
| @@ -108,106 +108,106 @@ | |||
| 108 | (- a) | 108 | (- a) |
| 109 | "no"))))) | 109 | "no"))))) |
| 110 | 110 | ||
| 111 | (ert-deftest subr-x-test-if-let-malformed-binding () | 111 | (ert-deftest subr-x-test-if-let*-malformed-binding () |
| 112 | "Test malformed bindings trigger errors." | 112 | "Test malformed bindings trigger errors." |
| 113 | (should-error (macroexpand | 113 | (should-error (macroexpand |
| 114 | '(if-let (_ (a 1 1) (b 2) (c 3) d) | 114 | '(if-let* (_ (a 1 1) (b 2) (c 3) d) |
| 115 | (- a) | 115 | (- a) |
| 116 | "no")) | 116 | "no")) |
| 117 | :type 'error) | 117 | :type 'error) |
| 118 | (should-error (macroexpand | 118 | (should-error (macroexpand |
| 119 | '(if-let (_ (a 1) (b 2 2) (c 3) d) | 119 | '(if-let* (_ (a 1) (b 2 2) (c 3) d) |
| 120 | (- a) | 120 | (- a) |
| 121 | "no")) | 121 | "no")) |
| 122 | :type 'error) | 122 | :type 'error) |
| 123 | (should-error (macroexpand | 123 | (should-error (macroexpand |
| 124 | '(if-let (_ (a 1) (b 2) (c 3 3) d) | 124 | '(if-let* (_ (a 1) (b 2) (c 3 3) d) |
| 125 | (- a) | 125 | (- a) |
| 126 | "no")) | 126 | "no")) |
| 127 | :type 'error) | 127 | :type 'error) |
| 128 | (should-error (macroexpand | 128 | (should-error (macroexpand |
| 129 | '(if-let ((a 1 1)) | 129 | '(if-let* ((a 1 1)) |
| 130 | (- a) | 130 | (- a) |
| 131 | "no")) | 131 | "no")) |
| 132 | :type 'error)) | 132 | :type 'error)) |
| 133 | 133 | ||
| 134 | (ert-deftest subr-x-test-if-let-true () | 134 | (ert-deftest subr-x-test-if-let*-true () |
| 135 | "Test `if-let' with truthy bindings." | 135 | "Test `if-let' with truthy bindings." |
| 136 | (should (equal | 136 | (should (equal |
| 137 | (if-let ((a 1)) | 137 | (if-let* ((a 1)) |
| 138 | a | 138 | a |
| 139 | "no") | 139 | "no") |
| 140 | 1)) | 140 | 1)) |
| 141 | (should (equal | 141 | (should (equal |
| 142 | (if-let ((a 1) (b 2) (c 3)) | 142 | (if-let* ((a 1) (b 2) (c 3)) |
| 143 | (list a b c) | 143 | (list a b c) |
| 144 | "no") | 144 | "no") |
| 145 | (list 1 2 3)))) | 145 | (list 1 2 3)))) |
| 146 | 146 | ||
| 147 | (ert-deftest subr-x-test-if-let-false () | 147 | (ert-deftest subr-x-test-if-let*-false () |
| 148 | "Test `if-let' with falsie bindings." | 148 | "Test `if-let' with falsie bindings." |
| 149 | (should (equal | 149 | (should (equal |
| 150 | (if-let ((a nil)) | 150 | (if-let* ((a nil)) |
| 151 | (list a b c) | 151 | (list a b c) |
| 152 | "no") | 152 | "no") |
| 153 | "no")) | 153 | "no")) |
| 154 | (should (equal | 154 | (should (equal |
| 155 | (if-let ((a nil) (b 2) (c 3)) | 155 | (if-let* ((a nil) (b 2) (c 3)) |
| 156 | (list a b c) | 156 | (list a b c) |
| 157 | "no") | 157 | "no") |
| 158 | "no")) | 158 | "no")) |
| 159 | (should (equal | 159 | (should (equal |
| 160 | (if-let ((a 1) (b nil) (c 3)) | 160 | (if-let* ((a 1) (b nil) (c 3)) |
| 161 | (list a b c) | 161 | (list a b c) |
| 162 | "no") | 162 | "no") |
| 163 | "no")) | 163 | "no")) |
| 164 | (should (equal | 164 | (should (equal |
| 165 | (if-let ((a 1) (b 2) (c nil)) | 165 | (if-let* ((a 1) (b 2) (c nil)) |
| 166 | (list a b c) | 166 | (list a b c) |
| 167 | "no") | 167 | "no") |
| 168 | "no")) | 168 | "no")) |
| 169 | (should (equal | 169 | (should (equal |
| 170 | (let (z) | 170 | (let (z) |
| 171 | (if-let (z (a 1) (b 2) (c 3)) | 171 | (if-let* (z (a 1) (b 2) (c 3)) |
| 172 | (list a b c) | 172 | (list a b c) |
| 173 | "no")) | 173 | "no")) |
| 174 | "no")) | 174 | "no")) |
| 175 | (should (equal | 175 | (should (equal |
| 176 | (let (d) | 176 | (let (d) |
| 177 | (if-let ((a 1) (b 2) (c 3) d) | 177 | (if-let* ((a 1) (b 2) (c 3) d) |
| 178 | (list a b c) | 178 | (list a b c) |
| 179 | "no")) | 179 | "no")) |
| 180 | "no"))) | 180 | "no"))) |
| 181 | 181 | ||
| 182 | (ert-deftest subr-x-test-if-let-bound-references () | 182 | (ert-deftest subr-x-test-if-let*-bound-references () |
| 183 | "Test `if-let' bindings can refer to already bound symbols." | 183 | "Test `if-let' bindings can refer to already bound symbols." |
| 184 | (should (equal | 184 | (should (equal |
| 185 | (if-let ((a (1+ 0)) (b (1+ a)) (c (1+ b))) | 185 | (if-let* ((a (1+ 0)) (b (1+ a)) (c (1+ b))) |
| 186 | (list a b c) | 186 | (list a b c) |
| 187 | "no") | 187 | "no") |
| 188 | (list 1 2 3)))) | 188 | (list 1 2 3)))) |
| 189 | 189 | ||
| 190 | (ert-deftest subr-x-test-if-let-and-laziness-is-preserved () | 190 | (ert-deftest subr-x-test-if-let*-and-laziness-is-preserved () |
| 191 | "Test `if-let' respects `and' laziness." | 191 | "Test `if-let' respects `and' laziness." |
| 192 | (let (a-called b-called c-called) | 192 | (let (a-called b-called c-called) |
| 193 | (should (equal | 193 | (should (equal |
| 194 | (if-let ((a nil) | 194 | (if-let* ((a nil) |
| 195 | (b (setq b-called t)) | 195 | (b (setq b-called t)) |
| 196 | (c (setq c-called t))) | 196 | (c (setq c-called t))) |
| 197 | "yes" | 197 | "yes" |
| 198 | (list a-called b-called c-called)) | 198 | (list a-called b-called c-called)) |
| 199 | (list nil nil nil)))) | 199 | (list nil nil nil)))) |
| 200 | (let (a-called b-called c-called) | 200 | (let (a-called b-called c-called) |
| 201 | (should (equal | 201 | (should (equal |
| 202 | (if-let ((a (setq a-called t)) | 202 | (if-let* ((a (setq a-called t)) |
| 203 | (b nil) | 203 | (b nil) |
| 204 | (c (setq c-called t))) | 204 | (c (setq c-called t))) |
| 205 | "yes" | 205 | "yes" |
| 206 | (list a-called b-called c-called)) | 206 | (list a-called b-called c-called)) |
| 207 | (list t nil nil)))) | 207 | (list t nil nil)))) |
| 208 | (let (a-called b-called c-called) | 208 | (let (a-called b-called c-called) |
| 209 | (should (equal | 209 | (should (equal |
| 210 | (if-let ((a (setq a-called t)) | 210 | (if-let* ((a (setq a-called t)) |
| 211 | (b (setq b-called t)) | 211 | (b (setq b-called t)) |
| 212 | (c nil) | 212 | (c nil) |
| 213 | (d (setq c-called t))) | 213 | (d (setq c-called t))) |
| @@ -215,19 +215,14 @@ | |||
| 215 | (list a-called b-called c-called)) | 215 | (list a-called b-called c-called)) |
| 216 | (list t t nil))))) | 216 | (list t t nil))))) |
| 217 | 217 | ||
| 218 | (defun if-let-single-tuple-case-test () | ||
| 219 | "Test the BINDING-SPEC == (SYMBOL SOMETHING) case." | ||
| 220 | (should (equal (if-let (a 1) (1+ a)) 2)) | ||
| 221 | (should (equal (let ((b 2)) (if-let (a b) a)) 2))) | ||
| 222 | |||
| 223 | 218 | ||
| 224 | ;; `when-let' tests | 219 | ;; `when-let*' tests |
| 225 | 220 | ||
| 226 | (ert-deftest subr-x-test-when-let-body-expansion () | 221 | (ert-deftest subr-x-test-when-let*-body-expansion () |
| 227 | "Test body allows for multiple sexps wrapping with progn." | 222 | "Test body allows for multiple sexps wrapping with progn." |
| 228 | (should (equal | 223 | (should (equal |
| 229 | (macroexpand | 224 | (macroexpand |
| 230 | '(when-let ((a 1)) | 225 | '(when-let* ((a 1)) |
| 231 | (message "opposite") | 226 | (message "opposite") |
| 232 | (- a))) | 227 | (- a))) |
| 233 | '(let* ((a (and t 1))) | 228 | '(let* ((a (and t 1))) |
| @@ -236,18 +231,18 @@ | |||
| 236 | (message "opposite") | 231 | (message "opposite") |
| 237 | (- a))))))) | 232 | (- a))))))) |
| 238 | 233 | ||
| 239 | (ert-deftest subr-x-test-when-let-single-symbol-expansion () | 234 | (ert-deftest subr-x-test-when-let*-single-symbol-expansion () |
| 240 | "Test single symbol bindings are expanded properly." | 235 | "Test single symbol bindings are expanded properly." |
| 241 | (should (equal | 236 | (should (equal |
| 242 | (macroexpand | 237 | (macroexpand |
| 243 | '(when-let (a) | 238 | '(when-let* (a) |
| 244 | (- a))) | 239 | (- a))) |
| 245 | '(let* ((a (and t a))) | 240 | '(let* ((a (and t a))) |
| 246 | (if a | 241 | (if a |
| 247 | (- a))))) | 242 | (- a))))) |
| 248 | (should (equal | 243 | (should (equal |
| 249 | (macroexpand | 244 | (macroexpand |
| 250 | '(when-let (a b c) | 245 | '(when-let* (a b c) |
| 251 | (- a))) | 246 | (- a))) |
| 252 | '(let* ((a (and t a)) | 247 | '(let* ((a (and t a)) |
| 253 | (b (and a b)) | 248 | (b (and a b)) |
| @@ -256,7 +251,7 @@ | |||
| 256 | (- a))))) | 251 | (- a))))) |
| 257 | (should (equal | 252 | (should (equal |
| 258 | (macroexpand | 253 | (macroexpand |
| 259 | '(when-let (a (b 2) c) | 254 | '(when-let* (a (b 2) c) |
| 260 | (- a))) | 255 | (- a))) |
| 261 | '(let* ((a (and t a)) | 256 | '(let* ((a (and t a)) |
| 262 | (b (and a 2)) | 257 | (b (and a 2)) |
| @@ -264,18 +259,18 @@ | |||
| 264 | (if c | 259 | (if c |
| 265 | (- a)))))) | 260 | (- a)))))) |
| 266 | 261 | ||
| 267 | (ert-deftest subr-x-test-when-let-nil-related-expansion () | 262 | (ert-deftest subr-x-test-when-let*-nil-related-expansion () |
| 268 | "Test nil is processed properly." | 263 | "Test nil is processed properly." |
| 269 | (should (equal | 264 | (should (equal |
| 270 | (macroexpand | 265 | (macroexpand |
| 271 | '(when-let (nil) | 266 | '(when-let* (nil) |
| 272 | (- a))) | 267 | (- a))) |
| 273 | '(let* ((nil (and t nil))) | 268 | '(let* ((nil (and t nil))) |
| 274 | (if nil | 269 | (if nil |
| 275 | (- a))))) | 270 | (- a))))) |
| 276 | (should (equal | 271 | (should (equal |
| 277 | (macroexpand | 272 | (macroexpand |
| 278 | '(when-let ((a 1) nil (b 2)) | 273 | '(when-let* ((a 1) nil (b 2)) |
| 279 | (- a))) | 274 | (- a))) |
| 280 | '(let* ((a (and t 1)) | 275 | '(let* ((a (and t 1)) |
| 281 | (nil (and a nil)) | 276 | (nil (and a nil)) |
| @@ -283,178 +278,173 @@ | |||
| 283 | (if b | 278 | (if b |
| 284 | (- a)))))) | 279 | (- a)))))) |
| 285 | 280 | ||
| 286 | (ert-deftest subr-x-test-when-let-malformed-binding () | 281 | (ert-deftest subr-x-test-when-let*-malformed-binding () |
| 287 | "Test malformed bindings trigger errors." | 282 | "Test malformed bindings trigger errors." |
| 288 | (should-error (macroexpand | 283 | (should-error (macroexpand |
| 289 | '(when-let (_ (a 1 1) (b 2) (c 3) d) | 284 | '(when-let* (_ (a 1 1) (b 2) (c 3) d) |
| 290 | (- a))) | 285 | (- a))) |
| 291 | :type 'error) | 286 | :type 'error) |
| 292 | (should-error (macroexpand | 287 | (should-error (macroexpand |
| 293 | '(when-let (_ (a 1) (b 2 2) (c 3) d) | 288 | '(when-let* (_ (a 1) (b 2 2) (c 3) d) |
| 294 | (- a))) | 289 | (- a))) |
| 295 | :type 'error) | 290 | :type 'error) |
| 296 | (should-error (macroexpand | 291 | (should-error (macroexpand |
| 297 | '(when-let (_ (a 1) (b 2) (c 3 3) d) | 292 | '(when-let* (_ (a 1) (b 2) (c 3 3) d) |
| 298 | (- a))) | 293 | (- a))) |
| 299 | :type 'error) | 294 | :type 'error) |
| 300 | (should-error (macroexpand | 295 | (should-error (macroexpand |
| 301 | '(when-let ((a 1 1)) | 296 | '(when-let* ((a 1 1)) |
| 302 | (- a))) | 297 | (- a))) |
| 303 | :type 'error)) | 298 | :type 'error)) |
| 304 | 299 | ||
| 305 | (ert-deftest subr-x-test-when-let-true () | 300 | (ert-deftest subr-x-test-when-let*-true () |
| 306 | "Test `when-let' with truthy bindings." | 301 | "Test `when-let' with truthy bindings." |
| 307 | (should (equal | 302 | (should (equal |
| 308 | (when-let ((a 1)) | 303 | (when-let* ((a 1)) |
| 309 | a) | 304 | a) |
| 310 | 1)) | 305 | 1)) |
| 311 | (should (equal | 306 | (should (equal |
| 312 | (when-let ((a 1) (b 2) (c 3)) | 307 | (when-let* ((a 1) (b 2) (c 3)) |
| 313 | (list a b c)) | 308 | (list a b c)) |
| 314 | (list 1 2 3)))) | 309 | (list 1 2 3)))) |
| 315 | 310 | ||
| 316 | (ert-deftest subr-x-test-when-let-false () | 311 | (ert-deftest subr-x-test-when-let*-false () |
| 317 | "Test `when-let' with falsie bindings." | 312 | "Test `when-let' with falsie bindings." |
| 318 | (should (equal | 313 | (should (equal |
| 319 | (when-let ((a nil)) | 314 | (when-let* ((a nil)) |
| 320 | (list a b c) | 315 | (list a b c) |
| 321 | "no") | 316 | "no") |
| 322 | nil)) | 317 | nil)) |
| 323 | (should (equal | 318 | (should (equal |
| 324 | (when-let ((a nil) (b 2) (c 3)) | 319 | (when-let* ((a nil) (b 2) (c 3)) |
| 325 | (list a b c) | 320 | (list a b c) |
| 326 | "no") | 321 | "no") |
| 327 | nil)) | 322 | nil)) |
| 328 | (should (equal | 323 | (should (equal |
| 329 | (when-let ((a 1) (b nil) (c 3)) | 324 | (when-let* ((a 1) (b nil) (c 3)) |
| 330 | (list a b c) | 325 | (list a b c) |
| 331 | "no") | 326 | "no") |
| 332 | nil)) | 327 | nil)) |
| 333 | (should (equal | 328 | (should (equal |
| 334 | (when-let ((a 1) (b 2) (c nil)) | 329 | (when-let* ((a 1) (b 2) (c nil)) |
| 335 | (list a b c) | 330 | (list a b c) |
| 336 | "no") | 331 | "no") |
| 337 | nil)) | 332 | nil)) |
| 338 | (should (equal | 333 | (should (equal |
| 339 | (let (z) | 334 | (let (z) |
| 340 | (when-let (z (a 1) (b 2) (c 3)) | 335 | (when-let* (z (a 1) (b 2) (c 3)) |
| 341 | (list a b c) | 336 | (list a b c) |
| 342 | "no")) | 337 | "no")) |
| 343 | nil)) | 338 | nil)) |
| 344 | (should (equal | 339 | (should (equal |
| 345 | (let (d) | 340 | (let (d) |
| 346 | (when-let ((a 1) (b 2) (c 3) d) | 341 | (when-let* ((a 1) (b 2) (c 3) d) |
| 347 | (list a b c) | 342 | (list a b c) |
| 348 | "no")) | 343 | "no")) |
| 349 | nil))) | 344 | nil))) |
| 350 | 345 | ||
| 351 | (ert-deftest subr-x-test-when-let-bound-references () | 346 | (ert-deftest subr-x-test-when-let*-bound-references () |
| 352 | "Test `when-let' bindings can refer to already bound symbols." | 347 | "Test `when-let' bindings can refer to already bound symbols." |
| 353 | (should (equal | 348 | (should (equal |
| 354 | (when-let ((a (1+ 0)) (b (1+ a)) (c (1+ b))) | 349 | (when-let* ((a (1+ 0)) (b (1+ a)) (c (1+ b))) |
| 355 | (list a b c)) | 350 | (list a b c)) |
| 356 | (list 1 2 3)))) | 351 | (list 1 2 3)))) |
| 357 | 352 | ||
| 358 | (ert-deftest subr-x-test-when-let-and-laziness-is-preserved () | 353 | (ert-deftest subr-x-test-when-let*-and-laziness-is-preserved () |
| 359 | "Test `when-let' respects `and' laziness." | 354 | "Test `when-let' respects `and' laziness." |
| 360 | (let (a-called b-called c-called) | 355 | (let (a-called b-called c-called) |
| 361 | (should (equal | 356 | (should (equal |
| 362 | (progn | 357 | (progn |
| 363 | (when-let ((a nil) | 358 | (when-let* ((a nil) |
| 364 | (b (setq b-called t)) | 359 | (b (setq b-called t)) |
| 365 | (c (setq c-called t))) | 360 | (c (setq c-called t))) |
| 366 | "yes") | 361 | "yes") |
| 367 | (list a-called b-called c-called)) | 362 | (list a-called b-called c-called)) |
| 368 | (list nil nil nil)))) | 363 | (list nil nil nil)))) |
| 369 | (let (a-called b-called c-called) | 364 | (let (a-called b-called c-called) |
| 370 | (should (equal | 365 | (should (equal |
| 371 | (progn | 366 | (progn |
| 372 | (when-let ((a (setq a-called t)) | 367 | (when-let* ((a (setq a-called t)) |
| 373 | (b nil) | 368 | (b nil) |
| 374 | (c (setq c-called t))) | 369 | (c (setq c-called t))) |
| 375 | "yes") | 370 | "yes") |
| 376 | (list a-called b-called c-called)) | 371 | (list a-called b-called c-called)) |
| 377 | (list t nil nil)))) | 372 | (list t nil nil)))) |
| 378 | (let (a-called b-called c-called) | 373 | (let (a-called b-called c-called) |
| 379 | (should (equal | 374 | (should (equal |
| 380 | (progn | 375 | (progn |
| 381 | (when-let ((a (setq a-called t)) | 376 | (when-let* ((a (setq a-called t)) |
| 382 | (b (setq b-called t)) | 377 | (b (setq b-called t)) |
| 383 | (c nil) | 378 | (c nil) |
| 384 | (d (setq c-called t))) | 379 | (d (setq c-called t))) |
| 385 | "yes") | 380 | "yes") |
| 386 | (list a-called b-called c-called)) | 381 | (list a-called b-called c-called)) |
| 387 | (list t t nil))))) | 382 | (list t t nil))))) |
| 388 | 383 | ||
| 389 | (defun when-let-single-tuple-case-test () | ||
| 390 | "Test the BINDING-SPEC == (SYMBOL SOMETHING) case." | ||
| 391 | (should (equal (when-let (a 1) (1+ a)) 2)) | ||
| 392 | (should (equal (let ((b 2)) (when-let (a b) a)) 2))) | ||
| 393 | |||
| 394 | 384 | ||
| 395 | ;; `and-let' tests | 385 | ;; `and-let*' tests |
| 396 | 386 | ||
| 397 | ;; Adapted from the Guile tests | 387 | ;; Adapted from the Guile tests |
| 398 | ;; https://git.savannah.gnu.org/cgit/guile.git/tree/test-suite/tests/srfi-2.test | 388 | ;; https://git.savannah.gnu.org/cgit/guile.git/tree/test-suite/tests/srfi-2.test |
| 399 | 389 | ||
| 400 | (ert-deftest subr-x-and-let-test-empty-varlist () | 390 | (ert-deftest subr-x-and-let*-test-empty-varlist () |
| 401 | (should (equal 1 (and-let () 1))) | 391 | (should (equal 1 (and-let* () 1))) |
| 402 | (should (equal 2 (and-let () 1 2))) | 392 | (should (equal 2 (and-let* () 1 2))) |
| 403 | (should (equal t (and-let ())))) | 393 | (should (equal t (and-let* ())))) |
| 404 | 394 | ||
| 405 | (ert-deftest subr-x-and-let-test-group-1 () | 395 | (ert-deftest subr-x-and-let*-test-group-1 () |
| 406 | (should (equal nil (let ((x nil)) (and-let (x))))) | 396 | (should (equal nil (let ((x nil)) (and-let* (x))))) |
| 407 | (should (equal 1 (let ((x 1)) (and-let (x))))) | 397 | (should (equal 1 (let ((x 1)) (and-let* (x))))) |
| 408 | (should (equal nil (and-let ((x nil))))) | 398 | (should (equal nil (and-let* ((x nil))))) |
| 409 | (should (equal 1 (and-let ((x 1))))) | 399 | (should (equal 1 (and-let* ((x 1))))) |
| 410 | ;; The error doesn't trigger when compiled: the compiler will give | 400 | ;; The error doesn't trigger when compiled: the compiler will give |
| 411 | ;; a warning and then drop the erroneous code. Therefore, use | 401 | ;; a warning and then drop the erroneous code. Therefore, use |
| 412 | ;; `eval' to avoid compilation. | 402 | ;; `eval' to avoid compilation. |
| 413 | (should-error (eval '(and-let (nil (x 1))) lexical-binding) | 403 | (should-error (eval '(and-let* (nil (x 1))) lexical-binding) |
| 414 | :type 'setting-constant) | 404 | :type 'setting-constant) |
| 415 | (should (equal nil (and-let ((nil) (x 1))))) | 405 | (should (equal nil (and-let* ((nil) (x 1))))) |
| 416 | (should-error (eval '(and-let (2 (x 1))) lexical-binding) | 406 | (should-error (eval '(and-let* (2 (x 1))) lexical-binding) |
| 417 | :type 'wrong-type-argument) | 407 | :type 'wrong-type-argument) |
| 418 | (should (equal 1 (and-let ((2) (x 1))))) | 408 | (should (equal 1 (and-let* ((2) (x 1))))) |
| 419 | (should (equal 2 (and-let ((x 1) (2))))) | 409 | (should (equal 2 (and-let* ((x 1) (2))))) |
| 420 | (should (equal nil (let ((x nil)) (and-let (x) x)))) | 410 | (should (equal nil (let ((x nil)) (and-let* (x) x)))) |
| 421 | (should (equal "" (let ((x "")) (and-let (x) x)))) | 411 | (should (equal "" (let ((x "")) (and-let* (x) x)))) |
| 422 | (should (equal "" (let ((x "")) (and-let (x))))) | 412 | (should (equal "" (let ((x "")) (and-let* (x))))) |
| 423 | (should (equal 2 (let ((x 1)) (and-let (x) (+ x 1))))) | 413 | (should (equal 2 (let ((x 1)) (and-let* (x) (+ x 1))))) |
| 424 | (should (equal nil (let ((x nil)) (and-let (x) (+ x 1))))) | 414 | (should (equal nil (let ((x nil)) (and-let* (x) (+ x 1))))) |
| 425 | (should (equal 2 (let ((x 1)) (and-let (((> x 0))) (+ x 1))))) | 415 | (should (equal 2 (let ((x 1)) (and-let* (((> x 0))) (+ x 1))))) |
| 426 | (should (equal t (let ((x 1)) (and-let (((> x 0))))))) | 416 | (should (equal t (let ((x 1)) (and-let* (((> x 0))))))) |
| 427 | (should (equal nil (let ((x 0)) (and-let (((> x 0))) (+ x 1))))) | 417 | (should (equal nil (let ((x 0)) (and-let* (((> x 0))) (+ x 1))))) |
| 428 | (should (equal 3 | 418 | (should (equal 3 |
| 429 | (let ((x 1)) (and-let (((> x 0)) (x (+ x 1))) (+ x 1)))))) | 419 | (let ((x 1)) (and-let* (((> x 0)) (x (+ x 1))) (+ x 1)))))) |
| 430 | 420 | ||
| 431 | (ert-deftest subr-x-and-let-test-rebind () | 421 | (ert-deftest subr-x-and-let*-test-rebind () |
| 432 | (should | 422 | (should |
| 433 | (equal 4 | 423 | (equal 4 |
| 434 | (let ((x 1)) | 424 | (let ((x 1)) |
| 435 | (and-let (((> x 0)) (x (+ x 1)) (x (+ x 1))) (+ x 1)))))) | 425 | (and-let* (((> x 0)) (x (+ x 1)) (x (+ x 1))) (+ x 1)))))) |
| 436 | 426 | ||
| 437 | (ert-deftest subr-x-and-let-test-group-2 () | 427 | (ert-deftest subr-x-and-let*-test-group-2 () |
| 438 | (should | 428 | (should |
| 439 | (equal 2 (let ((x 1)) (and-let (x ((> x 0))) (+ x 1))))) | 429 | (equal 2 (let ((x 1)) (and-let* (x ((> x 0))) (+ x 1))))) |
| 440 | (should | 430 | (should |
| 441 | (equal 2 (let ((x 1)) (and-let (((progn x)) ((> x 0))) (+ x 1))))) | 431 | (equal 2 (let ((x 1)) (and-let* (((progn x)) ((> x 0))) (+ x 1))))) |
| 442 | (should (equal nil (let ((x 0)) (and-let (x ((> x 0))) (+ x 1))))) | 432 | (should (equal nil (let ((x 0)) (and-let* (x ((> x 0))) (+ x 1))))) |
| 443 | (should (equal nil (let ((x nil)) (and-let (x ((> x 0))) (+ x 1))))) | 433 | (should (equal nil (let ((x nil)) (and-let* (x ((> x 0))) (+ x 1))))) |
| 444 | (should | 434 | (should |
| 445 | (equal nil (let ((x nil)) (and-let (((progn x)) ((> x 0))) (+ x 1)))))) | 435 | (equal nil (let ((x nil)) (and-let* (((progn x)) ((> x 0))) (+ x 1)))))) |
| 446 | 436 | ||
| 447 | (ert-deftest subr-x-and-let-test-group-3 () | 437 | (ert-deftest subr-x-and-let*-test-group-3 () |
| 448 | (should | 438 | (should |
| 449 | (equal nil (let ((x 1)) (and-let (x (y (- x 1)) ((> y 0))) (/ x y))))) | 439 | (equal nil (let ((x 1)) (and-let* (x (y (- x 1)) ((> y 0))) (/ x y))))) |
| 450 | (should | 440 | (should |
| 451 | (equal nil (let ((x 0)) (and-let (x (y (- x 1)) ((> y 0))) (/ x y))))) | 441 | (equal nil (let ((x 0)) (and-let* (x (y (- x 1)) ((> y 0))) (/ x y))))) |
| 452 | (should | 442 | (should |
| 453 | (equal nil | 443 | (equal nil |
| 454 | (let ((x nil)) (and-let (x (y (- x 1)) ((> y 0))) (/ x y))))) | 444 | (let ((x nil)) (and-let* (x (y (- x 1)) ((> y 0))) (/ x y))))) |
| 455 | (should | 445 | (should |
| 456 | (equal (/ 3.0 2) | 446 | (equal (/ 3.0 2) |
| 457 | (let ((x 3.0)) (and-let (x (y (- x 1)) ((> y 0))) (/ x y)))))) | 447 | (let ((x 3.0)) (and-let* (x (y (- x 1)) ((> y 0))) (/ x y)))))) |
| 458 | 448 | ||
| 459 | 449 | ||
| 460 | 450 | ||