aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorFabián Ezequiel Gallina2014-06-30 01:11:43 -0300
committerFabián Ezequiel Gallina2014-06-30 01:11:43 -0300
commitc08f8be29f4f6d107da5cc38d614519df7a6ab11 (patch)
tree1aa7c297a73c23b8c0dccc1242601c1eb02033dc
parentf8e16324a038417f0180b76c77c60313c880e74c (diff)
downloademacs-c08f8be29f4f6d107da5cc38d614519df7a6ab11.tar.gz
emacs-c08f8be29f4f6d107da5cc38d614519df7a6ab11.zip
New if-let, when-let, thread-first and thread-last macros.
* lisp/emacs-lisp/subr-x.el (internal--listify, internal--check-binding) (internal--build-binding-value-form, internal--build-binding) (internal--build-bindings): New functions. (internal--thread-argument, thread-first, thread-last) (if-let, when-let): New macros. * test/automated/subr-x-tests.el (subr-x-test-if-let-single-binding-expansion) (subr-x-test-if-let-single-symbol-expansion) (subr-x-test-if-let-nil-related-expansion) (subr-x-test-if-let-malformed-binding, subr-x-test-if-let-true) (subr-x-test-if-let-false, subr-x-test-if-let-bound-references) (subr-x-test-if-let-and-lazyness-is-preserved) (subr-x-test-when-let-body-expansion) (subr-x-test-when-let-single-binding-expansion) (subr-x-test-when-let-single-symbol-expansion) (subr-x-test-when-let-nil-related-expansion) (subr-x-test-when-let-malformed-binding) (subr-x-test-when-let-true, subr-x-test-when-let-false) (subr-x-test-when-let-bound-references) (subr-x-test-when-let-and-lazyness-is-preserved) (subr-x-test-thread-first-no-forms) (subr-x-test-thread-first-function-names-are-threaded) (subr-x-test-thread-first-expansion) (subr-x-test-thread-last-no-forms) (subr-x-test-thread-last-function-names-are-threaded) (subr-x-test-thread-last-expansion): New tests.
-rw-r--r--etc/NEWS8
-rw-r--r--lisp/ChangeLog11
-rw-r--r--lisp/emacs-lisp/subr-x.el107
-rw-r--r--test/ChangeLog24
-rw-r--r--test/automated/subr-x-tests.el526
5 files changed, 676 insertions, 0 deletions
diff --git a/etc/NEWS b/etc/NEWS
index 1fc4a218d76..85f996f8486 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -178,6 +178,14 @@ permissions set to temporary values (e.g., for creating private files).
178** Functions `rmail-delete-forward' and `rmail-delete-backward' take an 178** Functions `rmail-delete-forward' and `rmail-delete-backward' take an
179optional repeat-count argument. 179optional repeat-count argument.
180 180
181---
182** New macros `if-let' and `when-let' allow defining bindings and to
183 execute code depending whether all values are a true.
184
185---
186** New macros `thread-first' and `thread-last' allow threading a form
187 as the first or last argument of subsequent forms.
188
181 189
182* Changes in Emacs 24.5 on Non-Free Operating Systems 190* Changes in Emacs 24.5 on Non-Free Operating Systems
183 191
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 3e9e6f3ee27..56e53ee673c 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,14 @@
12014-06-30 Fabián Ezequiel Gallina <fgallina@gnu.org>
2
3 New if-let, when-let, thread-first and thread-last macros.
4
5 * emacs-lisp/subr-x.el
6 (internal--listify, internal--check-binding)
7 (internal--build-binding-value-form, internal--build-binding)
8 (internal--build-bindings): New functions.
9 (internal--thread-argument, thread-first, thread-last)
10 (if-let, when-let): New macros.
11
12014-06-30 Grégoire Jadi <daimrod@gmail.com> 122014-06-30 Grégoire Jadi <daimrod@gmail.com>
2 13
3 * net/rcirc.el (rcirc-buffer-process): Restore previous 14 * net/rcirc.el (rcirc-buffer-process): Restore previous
diff --git a/lisp/emacs-lisp/subr-x.el b/lisp/emacs-lisp/subr-x.el
index 505a556b65f..60cd7b8995b 100644
--- a/lisp/emacs-lisp/subr-x.el
+++ b/lisp/emacs-lisp/subr-x.el
@@ -32,6 +32,113 @@
32 32
33;;; Code: 33;;; Code:
34 34
35(require 'pcase)
36
37
38(defmacro internal--thread-argument (first? &rest forms)
39 "Internal implementation for `thread-first' and `thread-last'.
40When Argument FIRST? is non-nil argument is threaded first, else
41last. FORMS are the expressions to be threaded."
42 (pcase forms
43 (`(,x (,f . ,args) . ,rest)
44 `(internal--thread-argument
45 ,first? ,(if first? `(,f ,x ,@args) `(,f ,@args ,x)) ,@rest))
46 (`(,x ,f . ,rest) `(internal--thread-argument ,first? (,f ,x) ,@rest))
47 (_ (car forms))))
48
49(defmacro thread-first (&rest forms)
50 "Thread FORMS elements as the first argument of their succesor.
51Example:
52 (thread-first
53 5
54 (+ 20)
55 (/ 25)
56 -
57 (+ 40))
58Is equivalent to:
59 (+ (- (/ (+ 5 20) 25)) 40)
60Note how the single `-' got converted into a list before
61threading."
62 (declare (indent 1)
63 (debug (form &rest [&or symbolp (sexp &rest form)])))
64 `(internal--thread-argument t ,@forms))
65
66(defmacro thread-last (&rest forms)
67 "Thread FORMS elements as the last argument of their succesor.
68Example:
69 (thread-last
70 5
71 (+ 20)
72 (/ 25)
73 -
74 (+ 40))
75Is equivalent to:
76 (+ 40 (- (/ 25 (+ 20 5))))
77Note how the single `-' got converted into a list before
78threading."
79 (declare (indent 1) (debug thread-first))
80 `(internal--thread-argument nil ,@forms))
81
82(defsubst internal--listify (elt)
83 "Wrap ELT in a list if it is not one."
84 (if (not (listp elt))
85 (list elt)
86 elt))
87
88(defsubst internal--check-binding (binding)
89 "Check BINDING is properly formed."
90 (when (> (length binding) 2)
91 (signal
92 'error
93 (cons "`let' bindings can have only one value-form" binding)))
94 binding)
95
96(defsubst internal--build-binding-value-form (binding prev-var)
97 "Build the conditional value form for BINDING using PREV-VAR."
98 `(,(car binding) (and ,prev-var ,(cadr binding))))
99
100(defun internal--build-binding (binding prev-var)
101 "Check and build a single BINDING with PREV-VAR."
102 (thread-first
103 binding
104 internal--listify
105 internal--check-binding
106 (internal--build-binding-value-form prev-var)))
107
108(defun internal--build-bindings (bindings)
109 "Check and build conditional value forms for BINDINGS."
110 (let ((prev-var t))
111 (mapcar (lambda (binding)
112 (let ((binding (internal--build-binding binding prev-var)))
113 (setq prev-var (car binding))
114 binding))
115 bindings)))
116
117(defmacro if-let (bindings then &rest else)
118 "Process BINDINGS and if all values are non-nil eval THEN, else ELSE.
119Argument BINDINGS is a list of tuples whose car is a symbol to be
120bound and (optionally) used in THEN, and its cadr is a sexp to be
121evaled to set symbol's value. In the special case you only want
122to bind a single value, BINDINGS can just be a plain tuple."
123 (declare (indent 2) (debug ((&rest (symbolp form)) form body)))
124 (when (and (<= (length bindings) 2)
125 (not (listp (car bindings))))
126 ;; Adjust the single binding case
127 (setq bindings (list bindings)))
128 `(let* ,(internal--build-bindings bindings)
129 (if ,(car (internal--listify (car (last bindings))))
130 ,then
131 ,@else)))
132
133(defmacro when-let (bindings &rest body)
134 "Process BINDINGS and if all values are non-nil eval BODY.
135Argument BINDINGS is a list of tuples whose car is a symbol to be
136bound and (optionally) used in BODY, and its cadr is a sexp to be
137evaled to set symbol's value. In the special case you only want
138to bind a single value, BINDINGS can just be a plain tuple."
139 (declare (indent 1) (debug if-let))
140 (list 'if-let bindings (macroexp-progn body)))
141
35(defsubst hash-table-keys (hash-table) 142(defsubst hash-table-keys (hash-table)
36 "Return a list of keys in HASH-TABLE." 143 "Return a list of keys in HASH-TABLE."
37 (let ((keys '())) 144 (let ((keys '()))
diff --git a/test/ChangeLog b/test/ChangeLog
index 9b0f3ab1b04..34807205e0f 100644
--- a/test/ChangeLog
+++ b/test/ChangeLog
@@ -1,3 +1,27 @@
12014-06-30 Fabián Ezequiel Gallina <fgallina@gnu.org>
2
3 * automated/subr-x-tests.el
4 (subr-x-test-if-let-single-binding-expansion)
5 (subr-x-test-if-let-single-symbol-expansion)
6 (subr-x-test-if-let-nil-related-expansion)
7 (subr-x-test-if-let-malformed-binding, subr-x-test-if-let-true)
8 (subr-x-test-if-let-false, subr-x-test-if-let-bound-references)
9 (subr-x-test-if-let-and-lazyness-is-preserved)
10 (subr-x-test-when-let-body-expansion)
11 (subr-x-test-when-let-single-binding-expansion)
12 (subr-x-test-when-let-single-symbol-expansion)
13 (subr-x-test-when-let-nil-related-expansion)
14 (subr-x-test-when-let-malformed-binding)
15 (subr-x-test-when-let-true, subr-x-test-when-let-false)
16 (subr-x-test-when-let-bound-references)
17 (subr-x-test-when-let-and-lazyness-is-preserved)
18 (subr-x-test-thread-first-no-forms)
19 (subr-x-test-thread-first-function-names-are-threaded)
20 (subr-x-test-thread-first-expansion)
21 (subr-x-test-thread-last-no-forms)
22 (subr-x-test-thread-last-function-names-are-threaded)
23 (subr-x-test-thread-last-expansion): New tests.
24
12014-06-29 Michael Albinus <michael.albinus@gmx.de> 252014-06-29 Michael Albinus <michael.albinus@gmx.de>
2 26
3 * automated/tramp-tests.el (tramp--instrument-test-case): 27 * automated/tramp-tests.el (tramp--instrument-test-case):
diff --git a/test/automated/subr-x-tests.el b/test/automated/subr-x-tests.el
new file mode 100644
index 00000000000..cb4d3686bb2
--- /dev/null
+++ b/test/automated/subr-x-tests.el
@@ -0,0 +1,526 @@
1;;; subr-x-tests.el --- Testing the extended lisp routines
2
3;; Copyright (C) 2011-2014 Free Software Foundation, Inc.
4
5;; Author: Fabián E. Gallina <fgallina@gnu.org>
6;; Keywords:
7
8;; This program is free software; you can redistribute it and/or modify
9;; it under the terms of the GNU General Public License as published by
10;; the Free Software Foundation, either version 3 of the License, or
11;; (at your option) any later version.
12
13;; This program is distributed in the hope that it will be useful,
14;; but WITHOUT ANY WARRANTY; without even the implied warranty of
15;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16;; GNU General Public License for more details.
17
18;; You should have received a copy of the GNU General Public License
19;; along with this program. If not, see <http://www.gnu.org/licenses/>.
20
21;;; Commentary:
22
23;;
24
25;;; Code:
26
27(require 'ert)
28(require 'subr-x)
29
30
31;; if-let tests
32
33(ert-deftest subr-x-test-if-let-single-binding-expansion ()
34 "Test single bindings are expanded properly."
35 (should (equal
36 (macroexpand
37 '(if-let (a 1)
38 (- a)
39 "no"))
40 '(let* ((a (and t 1)))
41 (if a
42 (- a)
43 "no"))))
44 (should (equal
45 (macroexpand
46 '(if-let (a)
47 (- a)
48 "no"))
49 '(let* ((a (and t nil)))
50 (if a
51 (- a)
52 "no")))))
53
54(ert-deftest subr-x-test-if-let-single-symbol-expansion ()
55 "Test single symbol bindings are expanded properly."
56 (should (equal
57 (macroexpand
58 '(if-let (a)
59 (- a)
60 "no"))
61 '(let* ((a (and t nil)))
62 (if a
63 (- a)
64 "no"))))
65 (should (equal
66 (macroexpand
67 '(if-let (a b c)
68 (- a)
69 "no"))
70 '(let* ((a (and t nil))
71 (b (and a nil))
72 (c (and b nil)))
73 (if c
74 (- a)
75 "no"))))
76 (should (equal
77 (macroexpand
78 '(if-let (a (b 2) c)
79 (- a)
80 "no"))
81 '(let* ((a (and t nil))
82 (b (and a 2))
83 (c (and b nil)))
84 (if c
85 (- a)
86 "no")))))
87
88(ert-deftest subr-x-test-if-let-nil-related-expansion ()
89 "Test nil is processed properly."
90 (should (equal
91 (macroexpand
92 '(if-let (nil)
93 (- a)
94 "no"))
95 '(let* ((nil (and t nil)))
96 (if nil
97 (- a)
98 "no"))))
99 (should (equal
100 (macroexpand
101 '(if-let ((nil))
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)
123 "no"))
124 '(let* ((a (and t 1))
125 (nil (and a nil))
126 (b (and nil 2)))
127 (if b
128 (- a)
129 "no")))))
130
131(ert-deftest subr-x-test-if-let-malformed-binding ()
132 "Test malformed bindings trigger errors."
133 (should-error (macroexpand
134 '(if-let (_ (a 1 1) (b 2) (c 3) d)
135 (- a)
136 "no"))
137 :type 'error)
138 (should-error (macroexpand
139 '(if-let (_ (a 1) (b 2 2) (c 3) d)
140 (- a)
141 "no"))
142 :type 'error)
143 (should-error (macroexpand
144 '(if-let (_ (a 1) (b 2) (c 3 3) d)
145 (- a)
146 "no"))
147 :type 'error)
148 (should-error (macroexpand
149 '(if-let ((a 1 1))
150 (- a)
151 "no"))
152 :type 'error))
153
154(ert-deftest subr-x-test-if-let-true ()
155 "Test `if-let' with truthy bindings."
156 (should (equal
157 (if-let (a 1)
158 a
159 "no")
160 1))
161 (should (equal
162 (if-let ((a 1) (b 2) (c 3))
163 (list a b c)
164 "no")
165 (list 1 2 3))))
166
167(ert-deftest subr-x-test-if-let-false ()
168 "Test `if-let' with falsey bindings."
169 (should (equal
170 (if-let (a nil)
171 (list a b c)
172 "no")
173 "no"))
174 (should (equal
175 (if-let ((a nil) (b 2) (c 3))
176 (list a b c)
177 "no")
178 "no"))
179 (should (equal
180 (if-let ((a 1) (b nil) (c 3))
181 (list a b c)
182 "no")
183 "no"))
184 (should (equal
185 (if-let ((a 1) (b 2) (c nil))
186 (list a b c)
187 "no")
188 "no"))
189 (should (equal
190 (if-let (z (a 1) (b 2) (c 3))
191 (list a b c)
192 "no")
193 "no"))
194 (should (equal
195 (if-let ((a 1) (b 2) (c 3) d)
196 (list a b c)
197 "no")
198 "no")))
199
200(ert-deftest subr-x-test-if-let-bound-references ()
201 "Test `if-let' bindings can refer to already bound symbols."
202 (should (equal
203 (if-let ((a (1+ 0)) (b (1+ a)) (c (1+ b)))
204 (list a b c)
205 "no")
206 (list 1 2 3))))
207
208(ert-deftest subr-x-test-if-let-and-lazyness-is-preserved ()
209 "Test `if-let' respects `and' lazyness."
210 (let (a-called b-called c-called)
211 (should (equal
212 (if-let ((a nil)
213 (b (setq b-called t))
214 (c (setq c-called t)))
215 "yes"
216 (list a-called b-called c-called))
217 (list nil nil nil))))
218 (let (a-called b-called c-called)
219 (should (equal
220 (if-let ((a (setq a-called t))
221 (b nil)
222 (c (setq c-called t)))
223 "yes"
224 (list a-called b-called c-called))
225 (list t nil nil))))
226 (let (a-called b-called c-called)
227 (should (equal
228 (if-let ((a (setq a-called t))
229 (b (setq b-called t))
230 (c nil)
231 (d (setq c-called t)))
232 "yes"
233 (list a-called b-called c-called))
234 (list t t nil)))))
235
236
237;; when-let tests
238
239(ert-deftest subr-x-test-when-let-body-expansion ()
240 "Test body allows for multiple sexps wrapping with progn."
241 (should (equal
242 (macroexpand
243 '(when-let (a 1)
244 (message "opposite")
245 (- a)))
246 '(let* ((a (and t 1)))
247 (if a
248 (progn
249 (message "opposite")
250 (- a)))))))
251
252(ert-deftest subr-x-test-when-let-single-binding-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."
271 (should (equal
272 (macroexpand
273 '(when-let (a)
274 (- a)))
275 '(let* ((a (and t nil)))
276 (if a
277 (- a)))))
278 (should (equal
279 (macroexpand
280 '(when-let (a b c)
281 (- a)))
282 '(let* ((a (and t nil))
283 (b (and a nil))
284 (c (and b nil)))
285 (if c
286 (- a)))))
287 (should (equal
288 (macroexpand
289 '(when-let (a (b 2) c)
290 (- a)))
291 '(let* ((a (and t nil))
292 (b (and a 2))
293 (c (and b nil)))
294 (if c
295 (- a))))))
296
297(ert-deftest subr-x-test-when-let-nil-related-expansion ()
298 "Test nil is processed properly."
299 (should (equal
300 (macroexpand
301 '(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)))
310 '(let* ((nil (and t nil)))
311 (if nil
312 (- a)))))
313 (should (equal
314 (macroexpand
315 '(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)))
326 '(let* ((a (and t 1))
327 (nil (and a nil))
328 (b (and nil 2)))
329 (if b
330 (- a))))))
331
332(ert-deftest subr-x-test-when-let-malformed-binding ()
333 "Test malformed bindings trigger errors."
334 (should-error (macroexpand
335 '(when-let (_ (a 1 1) (b 2) (c 3) d)
336 (- a)))
337 :type 'error)
338 (should-error (macroexpand
339 '(when-let (_ (a 1) (b 2 2) (c 3) d)
340 (- a)))
341 :type 'error)
342 (should-error (macroexpand
343 '(when-let (_ (a 1) (b 2) (c 3 3) d)
344 (- a)))
345 :type 'error)
346 (should-error (macroexpand
347 '(when-let ((a 1 1))
348 (- a)))
349 :type 'error))
350
351(ert-deftest subr-x-test-when-let-true ()
352 "Test `when-let' with truthy bindings."
353 (should (equal
354 (when-let (a 1)
355 a)
356 1))
357 (should (equal
358 (when-let ((a 1) (b 2) (c 3))
359 (list a b c))
360 (list 1 2 3))))
361
362(ert-deftest subr-x-test-when-let-false ()
363 "Test `when-let' with falsey bindings."
364 (should (equal
365 (when-let (a nil)
366 (list a b c)
367 "no")
368 nil))
369 (should (equal
370 (when-let ((a nil) (b 2) (c 3))
371 (list a b c)
372 "no")
373 nil))
374 (should (equal
375 (when-let ((a 1) (b nil) (c 3))
376 (list a b c)
377 "no")
378 nil))
379 (should (equal
380 (when-let ((a 1) (b 2) (c nil))
381 (list a b c)
382 "no")
383 nil))
384 (should (equal
385 (when-let (z (a 1) (b 2) (c 3))
386 (list a b c)
387 "no")
388 nil))
389 (should (equal
390 (when-let ((a 1) (b 2) (c 3) d)
391 (list a b c)
392 "no")
393 nil)))
394
395(ert-deftest subr-x-test-when-let-bound-references ()
396 "Test `when-let' bindings can refer to already bound symbols."
397 (should (equal
398 (when-let ((a (1+ 0)) (b (1+ a)) (c (1+ b)))
399 (list a b c))
400 (list 1 2 3))))
401
402(ert-deftest subr-x-test-when-let-and-lazyness-is-preserved ()
403 "Test `when-let' respects `and' lazyness."
404 (let (a-called b-called c-called)
405 (should (equal
406 (progn
407 (when-let ((a nil)
408 (b (setq b-called t))
409 (c (setq c-called t)))
410 "yes")
411 (list a-called b-called c-called))
412 (list nil nil nil))))
413 (let (a-called b-called c-called)
414 (should (equal
415 (progn
416 (when-let ((a (setq a-called t))
417 (b nil)
418 (c (setq c-called t)))
419 "yes")
420 (list a-called b-called c-called))
421 (list t nil nil))))
422 (let (a-called b-called c-called)
423 (should (equal
424 (progn
425 (when-let ((a (setq a-called t))
426 (b (setq b-called t))
427 (c nil)
428 (d (setq c-called t)))
429 "yes")
430 (list a-called b-called c-called))
431 (list t t nil)))))
432
433
434;; Thread first tests
435
436(ert-deftest subr-x-test-thread-first-no-forms ()
437 "Test `thread-first' with no forms expands to the first form."
438 (should (equal (macroexpand '(thread-first 5)) 5))
439 (should (equal (macroexpand '(thread-first (+ 1 2))) '(+ 1 2))))
440
441(ert-deftest subr-x-test-thread-first-function-names-are-threaded ()
442 "Test `thread-first' wraps single function names."
443 (should (equal (macroexpand
444 '(thread-first 5
445 -))
446 '(- 5)))
447 (should (equal (macroexpand
448 '(thread-first (+ 1 2)
449 -))
450 '(- (+ 1 2)))))
451
452(ert-deftest subr-x-test-thread-first-expansion ()
453 "Test `thread-first' expands correctly."
454 (should (equal
455 (macroexpand '(thread-first
456 5
457 (+ 20)
458 (/ 25)
459 -
460 (+ 40)))
461 '(+ (- (/ (+ 5 20) 25)) 40))))
462
463(ert-deftest subr-x-test-thread-first-examples ()
464 "Test several `thread-first' examples."
465 (should (equal (thread-first (+ 40 2)) 42))
466 (should (equal (thread-first
467 5
468 (+ 20)
469 (/ 25)
470 -
471 (+ 40)) 39))
472 (should (equal (thread-first
473 "this-is-a-string"
474 (split-string "-")
475 (nbutlast 2)
476 (append (list "good")))
477 (list "this" "is" "good"))))
478
479;; Thread last tests
480
481(ert-deftest subr-x-test-thread-last-no-forms ()
482 "Test `thread-last' with no forms expands to the first form."
483 (should (equal (macroexpand '(thread-last 5)) 5))
484 (should (equal (macroexpand '(thread-last (+ 1 2))) '(+ 1 2))))
485
486(ert-deftest subr-x-test-thread-last-function-names-are-threaded ()
487 "Test `thread-last' wraps single function names."
488 (should (equal (macroexpand
489 '(thread-last 5
490 -))
491 '(- 5)))
492 (should (equal (macroexpand
493 '(thread-last (+ 1 2)
494 -))
495 '(- (+ 1 2)))))
496
497(ert-deftest subr-x-test-thread-last-expansion ()
498 "Test `thread-last' expands correctly."
499 (should (equal
500 (macroexpand '(thread-last
501 5
502 (+ 20)
503 (/ 25)
504 -
505 (+ 40)))
506 '(+ 40 (- (/ 25 (+ 20 5)))))))
507
508(ert-deftest subr-x-test-thread-last-examples ()
509 "Test several `thread-last' examples."
510 (should (equal (thread-last (+ 40 2)) 42))
511 (should (equal (thread-last
512 5
513 (+ 20)
514 (/ 25)
515 -
516 (+ 40)) 39))
517 (should (equal (thread-last
518 (list 1 -2 3 -4 5)
519 (mapcar #'abs)
520 (cl-reduce #'+)
521 (format "abs sum is: %s"))
522 "abs sum is: 15")))
523
524
525(provide 'subr-x-tests)
526;;; subr-x-tests.el ends here