aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorMichael Heerdegen2018-02-21 11:15:37 +0100
committerMichael Heerdegen2018-03-06 15:47:05 +0100
commitaf4697faa1f5b643f63a9ea61aa205a4c1432e23 (patch)
tree3b0e3e687d9bbcce246fc938fbd80bb398061ed9
parentec79bdc53fd75ea48c1451b0d83b0b41a0345bc6 (diff)
downloademacs-af4697faa1f5b643f63a9ea61aa205a4c1432e23.tar.gz
emacs-af4697faa1f5b643f63a9ea61aa205a4c1432e23.zip
Define if-let* and derivatives as aliases for if-let etc
This commit reverts declaring `if-let' and `when-let' obsolete in favor of the new `if-let*' and `when-let*' versions because of the compiler warning mess (Bug#30039). Instead we make foo-let* aliases for foo-let. The old single-tuple variable spec case is still supported for backward compatibility. * lisp/emacs-lisp/subr-x.el (if-let, when-let): Don't declare obsolete. Tweak edebug specs. (and-let): Renamed from `and-let*' for compatibility with the names `if-let' and `when-let'. (if-let*, when-let*, and-let*): Define as aliases for `if-let', `when-let' and `and-let'. * test/lisp/emacs-lisp/subr-x-tests.el (if-let-single-tuple-case-test) (when-let-single-tuple-case-test): New tests for the single-binding tuple case. In the whole file, prefer the names without "*".
-rw-r--r--etc/NEWS10
-rw-r--r--lisp/emacs-lisp/subr-x.el55
-rw-r--r--test/lisp/emacs-lisp/subr-x-tests.el232
3 files changed, 148 insertions, 149 deletions
diff --git a/etc/NEWS b/etc/NEWS
index eded00e6554..c88bec5a567 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -1301,12 +1301,10 @@ 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** 'if-let' and 'when-let' are subsumed by 'if-let*' and 'when-let*'. 1304** The new macro 'and-let' is an implementation of the Scheme SRFI-2
1305The incumbent 'if-let' and 'when-let' are now marked obsolete. 1305syntax. 'if-let' and 'when-let' now also accept the same binding
1306'if-let*' and 'when-let*' do not accept the single tuple special case. 1306syntax as 'and-let'. 'if-let*', 'when-let*' and 'and-let*' are new
1307New macro 'and-let*' is an implementation of the Scheme SRFI-2 syntax 1307aliases for 'if-let', 'when-let' and 'and-let'.
1308of the same name. 'if-let*' and 'when-let*' now accept the same
1309binding syntax as 'and-let*'.
1310 1308
1311--- 1309---
1312** 'C-up', 'C-down', 'C-left' and 'C-right' are now defined in term 1310** '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 21dba377bf1..b2d7f0dec4f 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.
126Each binding is evaluated in turn, and evaluation stops if a 126Each binding is evaluated in turn, and evaluation stops if a
127binding value is nil. If all are non-nil, the value of THEN is 127binding value is nil. If all are non-nil, the value of THEN is
@@ -131,10 +131,18 @@ Each element of VARLIST is a list (SYMBOL VALUEFORM) which binds
131SYMBOL to the value of VALUEFORM. An element can additionally 131SYMBOL to the value of VALUEFORM. An element can additionally
132be of the form (VALUEFORM), which is evaluated and checked for 132be of the form (VALUEFORM), which is evaluated and checked for
133nil; i.e. SYMBOL can be omitted if only the test result is of 133nil; i.e. SYMBOL can be omitted if only the test result is of
134interest." 134interest.
135
136As a special case, a VARLIST of the form (SYMBOL SOMETHING) is
137treated like ((SYMBOL SOMETHING))."
135 (declare (indent 2) 138 (declare (indent 2)
136 (debug ((&rest [&or symbolp (symbolp form) (form)]) 139 (debug ([&or (symbolp form)
140 (&rest [&or symbolp (symbolp form) (form)])]
137 form body))) 141 form body)))
142 (pcase varlist
143 (`(,(pred symbolp) ,_)
144 ;; the single-tuple syntax case, for backward compatibility
145 (cl-callf list varlist)))
138 (if varlist 146 (if varlist
139 `(let* ,(setq varlist (internal--build-bindings varlist)) 147 `(let* ,(setq varlist (internal--build-bindings varlist))
140 (if ,(caar (last varlist)) 148 (if ,(caar (last varlist))
@@ -142,23 +150,23 @@ interest."
142 ,@else)) 150 ,@else))
143 `(let* () ,then))) 151 `(let* () ,then)))
144 152
145(defmacro when-let* (varlist &rest body) 153(defmacro when-let (varlist &rest body)
146 "Bind variables according to VARLIST and conditionally eval BODY. 154 "Bind variables according to VARLIST and conditionally eval BODY.
147Each binding is evaluated in turn, and evaluation stops if a 155Each binding is evaluated in turn, and evaluation stops if a
148binding value is nil. If all are non-nil, the value of the last 156binding value is nil. If all are non-nil, the value of the last
149form in BODY is returned. 157form in BODY is returned.
150 158
151VARLIST is the same as in `if-let*'." 159VARLIST is the same as in `if-let'."
152 (declare (indent 1) (debug if-let*)) 160 (declare (indent 1) (debug ([&or (symbolp form)
153 (list 'if-let* varlist (macroexp-progn body))) 161 (&rest [&or symbolp (symbolp form) (form)])]
162 body)))
163 (list 'if-let varlist (macroexp-progn body)))
154 164
155(defmacro and-let* (varlist &rest body) 165(defmacro and-let (varlist &rest body)
156 "Bind variables according to VARLIST and conditionally eval BODY. 166 "Bind variables according to VARLIST and conditionally eval BODY.
157Like `when-let*', except if BODY is empty and all the bindings 167Like `when-let', except if BODY is empty and all the bindings
158are non-nil, then the result is non-nil." 168are non-nil, then the result is non-nil."
159 (declare (indent 1) 169 (declare (indent 1) (debug when-let))
160 (debug ((&rest [&or symbolp (symbolp form) (form)])
161 body)))
162 (let (res) 170 (let (res)
163 (if varlist 171 (if varlist
164 `(let* ,(setq varlist (internal--build-bindings varlist)) 172 `(let* ,(setq varlist (internal--build-bindings varlist))
@@ -166,26 +174,9 @@ are non-nil, then the result is non-nil."
166 ,@(or body `(,res)))) 174 ,@(or body `(,res))))
167 `(let* () ,@(or body '(t)))))) 175 `(let* () ,@(or body '(t))))))
168 176
169(defmacro if-let (spec then &rest else) 177(defalias 'if-let* #'if-let)
170 "Bind variables according to SPEC and eval THEN or ELSE. 178(defalias 'when-let* #'when-let)
171Like `if-let*' except SPEC can have the form (SYMBOL VALUEFORM)." 179(defalias 'and-let* #'and-let)
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.
185Like `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)))
189 180
190(defsubst hash-table-empty-p (hash-table) 181(defsubst hash-table-empty-p (hash-table)
191 "Check whether HASH-TABLE is empty (has 0 elements)." 182 "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 c9618f3c37f..a361718c9e2 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,14 +215,19 @@
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
218 223
219;; `when-let*' tests 224;; `when-let' tests
220 225
221(ert-deftest subr-x-test-when-let*-body-expansion () 226(ert-deftest subr-x-test-when-let-body-expansion ()
222 "Test body allows for multiple sexps wrapping with progn." 227 "Test body allows for multiple sexps wrapping with progn."
223 (should (equal 228 (should (equal
224 (macroexpand 229 (macroexpand
225 '(when-let* ((a 1)) 230 '(when-let ((a 1))
226 (message "opposite") 231 (message "opposite")
227 (- a))) 232 (- a)))
228 '(let* ((a (and t 1))) 233 '(let* ((a (and t 1)))
@@ -231,18 +236,18 @@
231 (message "opposite") 236 (message "opposite")
232 (- a))))))) 237 (- a)))))))
233 238
234(ert-deftest subr-x-test-when-let*-single-symbol-expansion () 239(ert-deftest subr-x-test-when-let-single-symbol-expansion ()
235 "Test single symbol bindings are expanded properly." 240 "Test single symbol bindings are expanded properly."
236 (should (equal 241 (should (equal
237 (macroexpand 242 (macroexpand
238 '(when-let* (a) 243 '(when-let (a)
239 (- a))) 244 (- a)))
240 '(let* ((a (and t a))) 245 '(let* ((a (and t a)))
241 (if a 246 (if a
242 (- a))))) 247 (- a)))))
243 (should (equal 248 (should (equal
244 (macroexpand 249 (macroexpand
245 '(when-let* (a b c) 250 '(when-let (a b c)
246 (- a))) 251 (- a)))
247 '(let* ((a (and t a)) 252 '(let* ((a (and t a))
248 (b (and a b)) 253 (b (and a b))
@@ -251,7 +256,7 @@
251 (- a))))) 256 (- a)))))
252 (should (equal 257 (should (equal
253 (macroexpand 258 (macroexpand
254 '(when-let* (a (b 2) c) 259 '(when-let (a (b 2) c)
255 (- a))) 260 (- a)))
256 '(let* ((a (and t a)) 261 '(let* ((a (and t a))
257 (b (and a 2)) 262 (b (and a 2))
@@ -259,18 +264,18 @@
259 (if c 264 (if c
260 (- a)))))) 265 (- a))))))
261 266
262(ert-deftest subr-x-test-when-let*-nil-related-expansion () 267(ert-deftest subr-x-test-when-let-nil-related-expansion ()
263 "Test nil is processed properly." 268 "Test nil is processed properly."
264 (should (equal 269 (should (equal
265 (macroexpand 270 (macroexpand
266 '(when-let* (nil) 271 '(when-let (nil)
267 (- a))) 272 (- a)))
268 '(let* ((nil (and t nil))) 273 '(let* ((nil (and t nil)))
269 (if nil 274 (if nil
270 (- a))))) 275 (- a)))))
271 (should (equal 276 (should (equal
272 (macroexpand 277 (macroexpand
273 '(when-let* ((a 1) nil (b 2)) 278 '(when-let ((a 1) nil (b 2))
274 (- a))) 279 (- a)))
275 '(let* ((a (and t 1)) 280 '(let* ((a (and t 1))
276 (nil (and a nil)) 281 (nil (and a nil))
@@ -278,173 +283,178 @@
278 (if b 283 (if b
279 (- a)))))) 284 (- a))))))
280 285
281(ert-deftest subr-x-test-when-let*-malformed-binding () 286(ert-deftest subr-x-test-when-let-malformed-binding ()
282 "Test malformed bindings trigger errors." 287 "Test malformed bindings trigger errors."
283 (should-error (macroexpand 288 (should-error (macroexpand
284 '(when-let* (_ (a 1 1) (b 2) (c 3) d) 289 '(when-let (_ (a 1 1) (b 2) (c 3) d)
285 (- a))) 290 (- a)))
286 :type 'error) 291 :type 'error)
287 (should-error (macroexpand 292 (should-error (macroexpand
288 '(when-let* (_ (a 1) (b 2 2) (c 3) d) 293 '(when-let (_ (a 1) (b 2 2) (c 3) d)
289 (- a))) 294 (- a)))
290 :type 'error) 295 :type 'error)
291 (should-error (macroexpand 296 (should-error (macroexpand
292 '(when-let* (_ (a 1) (b 2) (c 3 3) d) 297 '(when-let (_ (a 1) (b 2) (c 3 3) d)
293 (- a))) 298 (- a)))
294 :type 'error) 299 :type 'error)
295 (should-error (macroexpand 300 (should-error (macroexpand
296 '(when-let* ((a 1 1)) 301 '(when-let ((a 1 1))
297 (- a))) 302 (- a)))
298 :type 'error)) 303 :type 'error))
299 304
300(ert-deftest subr-x-test-when-let*-true () 305(ert-deftest subr-x-test-when-let-true ()
301 "Test `when-let' with truthy bindings." 306 "Test `when-let' with truthy bindings."
302 (should (equal 307 (should (equal
303 (when-let* ((a 1)) 308 (when-let ((a 1))
304 a) 309 a)
305 1)) 310 1))
306 (should (equal 311 (should (equal
307 (when-let* ((a 1) (b 2) (c 3)) 312 (when-let ((a 1) (b 2) (c 3))
308 (list a b c)) 313 (list a b c))
309 (list 1 2 3)))) 314 (list 1 2 3))))
310 315
311(ert-deftest subr-x-test-when-let*-false () 316(ert-deftest subr-x-test-when-let-false ()
312 "Test `when-let' with falsie bindings." 317 "Test `when-let' with falsie bindings."
313 (should (equal 318 (should (equal
314 (when-let* ((a nil)) 319 (when-let ((a nil))
315 (list a b c) 320 (list a b c)
316 "no") 321 "no")
317 nil)) 322 nil))
318 (should (equal 323 (should (equal
319 (when-let* ((a nil) (b 2) (c 3)) 324 (when-let ((a nil) (b 2) (c 3))
320 (list a b c) 325 (list a b c)
321 "no") 326 "no")
322 nil)) 327 nil))
323 (should (equal 328 (should (equal
324 (when-let* ((a 1) (b nil) (c 3)) 329 (when-let ((a 1) (b nil) (c 3))
325 (list a b c) 330 (list a b c)
326 "no") 331 "no")
327 nil)) 332 nil))
328 (should (equal 333 (should (equal
329 (when-let* ((a 1) (b 2) (c nil)) 334 (when-let ((a 1) (b 2) (c nil))
330 (list a b c) 335 (list a b c)
331 "no") 336 "no")
332 nil)) 337 nil))
333 (should (equal 338 (should (equal
334 (let (z) 339 (let (z)
335 (when-let* (z (a 1) (b 2) (c 3)) 340 (when-let (z (a 1) (b 2) (c 3))
336 (list a b c) 341 (list a b c)
337 "no")) 342 "no"))
338 nil)) 343 nil))
339 (should (equal 344 (should (equal
340 (let (d) 345 (let (d)
341 (when-let* ((a 1) (b 2) (c 3) d) 346 (when-let ((a 1) (b 2) (c 3) d)
342 (list a b c) 347 (list a b c)
343 "no")) 348 "no"))
344 nil))) 349 nil)))
345 350
346(ert-deftest subr-x-test-when-let*-bound-references () 351(ert-deftest subr-x-test-when-let-bound-references ()
347 "Test `when-let' bindings can refer to already bound symbols." 352 "Test `when-let' bindings can refer to already bound symbols."
348 (should (equal 353 (should (equal
349 (when-let* ((a (1+ 0)) (b (1+ a)) (c (1+ b))) 354 (when-let ((a (1+ 0)) (b (1+ a)) (c (1+ b)))
350 (list a b c)) 355 (list a b c))
351 (list 1 2 3)))) 356 (list 1 2 3))))
352 357
353(ert-deftest subr-x-test-when-let*-and-laziness-is-preserved () 358(ert-deftest subr-x-test-when-let-and-laziness-is-preserved ()
354 "Test `when-let' respects `and' laziness." 359 "Test `when-let' respects `and' laziness."
355 (let (a-called b-called c-called) 360 (let (a-called b-called c-called)
356 (should (equal 361 (should (equal
357 (progn 362 (progn
358 (when-let* ((a nil) 363 (when-let ((a nil)
359 (b (setq b-called t)) 364 (b (setq b-called t))
360 (c (setq c-called t))) 365 (c (setq c-called t)))
361 "yes") 366 "yes")
362 (list a-called b-called c-called)) 367 (list a-called b-called c-called))
363 (list nil nil nil)))) 368 (list nil nil nil))))
364 (let (a-called b-called c-called) 369 (let (a-called b-called c-called)
365 (should (equal 370 (should (equal
366 (progn 371 (progn
367 (when-let* ((a (setq a-called t)) 372 (when-let ((a (setq a-called t))
368 (b nil) 373 (b nil)
369 (c (setq c-called t))) 374 (c (setq c-called t)))
370 "yes") 375 "yes")
371 (list a-called b-called c-called)) 376 (list a-called b-called c-called))
372 (list t nil nil)))) 377 (list t nil nil))))
373 (let (a-called b-called c-called) 378 (let (a-called b-called c-called)
374 (should (equal 379 (should (equal
375 (progn 380 (progn
376 (when-let* ((a (setq a-called t)) 381 (when-let ((a (setq a-called t))
377 (b (setq b-called t)) 382 (b (setq b-called t))
378 (c nil) 383 (c nil)
379 (d (setq c-called t))) 384 (d (setq c-called t)))
380 "yes") 385 "yes")
381 (list a-called b-called c-called)) 386 (list a-called b-called c-called))
382 (list t t nil))))) 387 (list t t nil)))))
383 388
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
384 394
385;; `and-let*' tests 395;; `and-let' tests
386 396
387;; Adapted from the Guile tests 397;; Adapted from the Guile tests
388;; https://git.savannah.gnu.org/cgit/guile.git/tree/test-suite/tests/srfi-2.test 398;; https://git.savannah.gnu.org/cgit/guile.git/tree/test-suite/tests/srfi-2.test
389 399
390(ert-deftest subr-x-and-let*-test-empty-varlist () 400(ert-deftest subr-x-and-let-test-empty-varlist ()
391 (should (equal 1 (and-let* () 1))) 401 (should (equal 1 (and-let () 1)))
392 (should (equal 2 (and-let* () 1 2))) 402 (should (equal 2 (and-let () 1 2)))
393 (should (equal t (and-let* ())))) 403 (should (equal t (and-let ()))))
394 404
395(ert-deftest subr-x-and-let*-test-group-1 () 405(ert-deftest subr-x-and-let-test-group-1 ()
396 (should (equal nil (let ((x nil)) (and-let* (x))))) 406 (should (equal nil (let ((x nil)) (and-let (x)))))
397 (should (equal 1 (let ((x 1)) (and-let* (x))))) 407 (should (equal 1 (let ((x 1)) (and-let (x)))))
398 (should (equal nil (and-let* ((x nil))))) 408 (should (equal nil (and-let ((x nil)))))
399 (should (equal 1 (and-let* ((x 1))))) 409 (should (equal 1 (and-let ((x 1)))))
400 ;; The error doesn't trigger when compiled: the compiler will give 410 ;; The error doesn't trigger when compiled: the compiler will give
401 ;; a warning and then drop the erroneous code. Therefore, use 411 ;; a warning and then drop the erroneous code. Therefore, use
402 ;; `eval' to avoid compilation. 412 ;; `eval' to avoid compilation.
403 (should-error (eval '(and-let* (nil (x 1))) lexical-binding) 413 (should-error (eval '(and-let (nil (x 1))) lexical-binding)
404 :type 'setting-constant) 414 :type 'setting-constant)
405 (should (equal nil (and-let* ((nil) (x 1))))) 415 (should (equal nil (and-let ((nil) (x 1)))))
406 (should-error (eval '(and-let* (2 (x 1))) lexical-binding) 416 (should-error (eval '(and-let (2 (x 1))) lexical-binding)
407 :type 'wrong-type-argument) 417 :type 'wrong-type-argument)
408 (should (equal 1 (and-let* ((2) (x 1))))) 418 (should (equal 1 (and-let ((2) (x 1)))))
409 (should (equal 2 (and-let* ((x 1) (2))))) 419 (should (equal 2 (and-let ((x 1) (2)))))
410 (should (equal nil (let ((x nil)) (and-let* (x) x)))) 420 (should (equal nil (let ((x nil)) (and-let (x) x))))
411 (should (equal "" (let ((x "")) (and-let* (x) x)))) 421 (should (equal "" (let ((x "")) (and-let (x) x))))
412 (should (equal "" (let ((x "")) (and-let* (x))))) 422 (should (equal "" (let ((x "")) (and-let (x)))))
413 (should (equal 2 (let ((x 1)) (and-let* (x) (+ x 1))))) 423 (should (equal 2 (let ((x 1)) (and-let (x) (+ x 1)))))
414 (should (equal nil (let ((x nil)) (and-let* (x) (+ x 1))))) 424 (should (equal nil (let ((x nil)) (and-let (x) (+ x 1)))))
415 (should (equal 2 (let ((x 1)) (and-let* (((> x 0))) (+ x 1))))) 425 (should (equal 2 (let ((x 1)) (and-let (((> x 0))) (+ x 1)))))
416 (should (equal t (let ((x 1)) (and-let* (((> x 0))))))) 426 (should (equal t (let ((x 1)) (and-let (((> x 0)))))))
417 (should (equal nil (let ((x 0)) (and-let* (((> x 0))) (+ x 1))))) 427 (should (equal nil (let ((x 0)) (and-let (((> x 0))) (+ x 1)))))
418 (should (equal 3 428 (should (equal 3
419 (let ((x 1)) (and-let* (((> x 0)) (x (+ x 1))) (+ x 1)))))) 429 (let ((x 1)) (and-let (((> x 0)) (x (+ x 1))) (+ x 1))))))
420 430
421(ert-deftest subr-x-and-let*-test-rebind () 431(ert-deftest subr-x-and-let-test-rebind ()
422 (should 432 (should
423 (equal 4 433 (equal 4
424 (let ((x 1)) 434 (let ((x 1))
425 (and-let* (((> x 0)) (x (+ x 1)) (x (+ x 1))) (+ x 1)))))) 435 (and-let (((> x 0)) (x (+ x 1)) (x (+ x 1))) (+ x 1))))))
426 436
427(ert-deftest subr-x-and-let*-test-group-2 () 437(ert-deftest subr-x-and-let-test-group-2 ()
428 (should 438 (should
429 (equal 2 (let ((x 1)) (and-let* (x ((> x 0))) (+ x 1))))) 439 (equal 2 (let ((x 1)) (and-let (x ((> x 0))) (+ x 1)))))
430 (should 440 (should
431 (equal 2 (let ((x 1)) (and-let* (((progn x)) ((> x 0))) (+ x 1))))) 441 (equal 2 (let ((x 1)) (and-let (((progn x)) ((> x 0))) (+ x 1)))))
432 (should (equal nil (let ((x 0)) (and-let* (x ((> x 0))) (+ x 1))))) 442 (should (equal nil (let ((x 0)) (and-let (x ((> x 0))) (+ x 1)))))
433 (should (equal nil (let ((x nil)) (and-let* (x ((> x 0))) (+ x 1))))) 443 (should (equal nil (let ((x nil)) (and-let (x ((> x 0))) (+ x 1)))))
434 (should 444 (should
435 (equal nil (let ((x nil)) (and-let* (((progn x)) ((> x 0))) (+ x 1)))))) 445 (equal nil (let ((x nil)) (and-let (((progn x)) ((> x 0))) (+ x 1))))))
436 446
437(ert-deftest subr-x-and-let*-test-group-3 () 447(ert-deftest subr-x-and-let-test-group-3 ()
438 (should 448 (should
439 (equal nil (let ((x 1)) (and-let* (x (y (- x 1)) ((> y 0))) (/ x y))))) 449 (equal nil (let ((x 1)) (and-let (x (y (- x 1)) ((> y 0))) (/ x y)))))
440 (should 450 (should
441 (equal nil (let ((x 0)) (and-let* (x (y (- x 1)) ((> y 0))) (/ x y))))) 451 (equal nil (let ((x 0)) (and-let (x (y (- x 1)) ((> y 0))) (/ x y)))))
442 (should 452 (should
443 (equal nil 453 (equal nil
444 (let ((x nil)) (and-let* (x (y (- x 1)) ((> y 0))) (/ x y))))) 454 (let ((x nil)) (and-let (x (y (- x 1)) ((> y 0))) (/ x y)))))
445 (should 455 (should
446 (equal (/ 3.0 2) 456 (equal (/ 3.0 2)
447 (let ((x 3.0)) (and-let* (x (y (- x 1)) ((> y 0))) (/ x y)))))) 457 (let ((x 3.0)) (and-let (x (y (- x 1)) ((> y 0))) (/ x y))))))
448 458
449 459
450 460