aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorMichael Heerdegen2018-03-06 18:28:51 +0100
committerMichael Heerdegen2018-03-06 18:32:04 +0100
commitf6bd7e06861142371994ff9ce54dd62573809fa5 (patch)
tree7d75a0b4aba2f82cd6bde0686760e3a1b49345c6
parentaf4697faa1f5b643f63a9ea61aa205a4c1432e23 (diff)
downloademacs-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/NEWS10
-rw-r--r--lisp/emacs-lisp/subr-x.el55
-rw-r--r--test/lisp/emacs-lisp/subr-x-tests.el232
3 files changed, 149 insertions, 148 deletions
diff --git a/etc/NEWS b/etc/NEWS
index c88bec5a567..eded00e6554 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -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*'.
1305syntax. 'if-let' and 'when-let' now also accept the same binding 1305The incumbent 'if-let' and 'when-let' are now marked obsolete.
1306syntax 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.
1307aliases for 'if-let', 'when-let' and 'and-let'. 1307New macro 'and-let*' is an implementation of the Scheme SRFI-2 syntax
1308of the same name. 'if-let*' and 'when-let*' now accept the same
1309binding 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.
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,18 +131,10 @@ 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))."
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.
155Each binding is evaluated in turn, and evaluation stops if a 147Each binding is evaluated in turn, and evaluation stops if a
156binding value is nil. If all are non-nil, the value of the last 148binding value is nil. If all are non-nil, the value of the last
157form in BODY is returned. 149form in BODY is returned.
158 150
159VARLIST is the same as in `if-let'." 151VARLIST 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.
167Like `when-let', except if BODY is empty and all the bindings 157Like `when-let*', except if BODY is empty and all the bindings
168are non-nil, then the result is non-nil." 158are 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) 171Like `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.
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)))
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