1 ;;; subr-x-tests.el --- Testing the extended lisp routines
3 ;; Copyright (C) 2014-2015 Free Software Foundation, Inc.
5 ;; Author: Fabián E. Gallina <fgallina@gnu.org>
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.
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.
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/>.
33 (ert-deftest subr-x-test-if-let-single-binding-expansion ()
34 "Test single bindings are expanded properly."
40 '(let* ((a (and t 1)))
49 '(let* ((a (and t nil)))
54 (ert-deftest subr-x-test-if-let-single-symbol-expansion ()
55 "Test single symbol bindings are expanded properly."
61 '(let* ((a (and t nil)))
70 '(let* ((a (and t nil))
81 '(let* ((a (and t nil))
88 (ert-deftest subr-x-test-if-let-nil-related-expansion ()
89 "Test nil is processed properly."
95 '(let* ((nil (and t nil)))
104 '(let* ((nil (and t nil)))
110 '(if-let ((a 1) (nil) (b 2))
113 '(let* ((a (and t 1))
121 '(if-let ((a 1) nil (b 2))
124 '(let* ((a (and t 1))
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)
138 (should-error (macroexpand
139 '(if-let (_ (a 1) (b 2 2) (c 3) d)
143 (should-error (macroexpand
144 '(if-let (_ (a 1) (b 2) (c 3 3) d)
148 (should-error (macroexpand
154 (ert-deftest subr-x-test-if-let-true ()
155 "Test `if-let' with truthy bindings."
162 (if-let ((a 1) (b 2) (c 3))
167 (ert-deftest subr-x-test-if-let-false ()
168 "Test `if-let' with falsie bindings."
175 (if-let ((a nil) (b 2) (c 3))
180 (if-let ((a 1) (b nil) (c 3))
185 (if-let ((a 1) (b 2) (c nil))
190 (if-let (z (a 1) (b 2) (c 3))
195 (if-let ((a 1) (b 2) (c 3) d)
200 (ert-deftest subr-x-test-if-let-bound-references ()
201 "Test `if-let' bindings can refer to already bound symbols."
203 (if-let ((a (1+ 0)) (b (1+ a)) (c (1+ b)))
208 (ert-deftest subr-x-test-if-let-and-laziness-is-preserved ()
209 "Test `if-let' respects `and' laziness."
210 (let (a-called b-called c-called)
213 (b (setq b-called t))
214 (c (setq c-called t)))
216 (list a-called b-called c-called))
217 (list nil nil nil))))
218 (let (a-called b-called c-called)
220 (if-let ((a (setq a-called t))
222 (c (setq c-called t)))
224 (list a-called b-called c-called))
226 (let (a-called b-called c-called)
228 (if-let ((a (setq a-called t))
229 (b (setq b-called t))
231 (d (setq c-called t)))
233 (list a-called b-called c-called))
239 (ert-deftest subr-x-test-when-let-body-expansion ()
240 "Test body allows for multiple sexps wrapping with progn."
246 '(let* ((a (and t 1)))
252 (ert-deftest subr-x-test-when-let-single-binding-expansion ()
253 "Test single bindings are expanded properly."
258 '(let* ((a (and t 1)))
265 '(let* ((a (and t nil)))
269 (ert-deftest subr-x-test-when-let-single-symbol-expansion ()
270 "Test single symbol bindings are expanded properly."
275 '(let* ((a (and t nil)))
282 '(let* ((a (and t nil))
289 '(when-let (a (b 2) c)
291 '(let* ((a (and t nil))
297 (ert-deftest subr-x-test-when-let-nil-related-expansion ()
298 "Test nil is processed properly."
303 '(let* ((nil (and t nil)))
310 '(let* ((nil (and t nil)))
315 '(when-let ((a 1) (nil) (b 2))
317 '(let* ((a (and t 1))
324 '(when-let ((a 1) nil (b 2))
326 '(let* ((a (and t 1))
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)
338 (should-error (macroexpand
339 '(when-let (_ (a 1) (b 2 2) (c 3) d)
342 (should-error (macroexpand
343 '(when-let (_ (a 1) (b 2) (c 3 3) d)
346 (should-error (macroexpand
351 (ert-deftest subr-x-test-when-let-true ()
352 "Test `when-let' with truthy bindings."
358 (when-let ((a 1) (b 2) (c 3))
362 (ert-deftest subr-x-test-when-let-false ()
363 "Test `when-let' with falsie bindings."
370 (when-let ((a nil) (b 2) (c 3))
375 (when-let ((a 1) (b nil) (c 3))
380 (when-let ((a 1) (b 2) (c nil))
385 (when-let (z (a 1) (b 2) (c 3))
390 (when-let ((a 1) (b 2) (c 3) d)
395 (ert-deftest subr-x-test-when-let-bound-references ()
396 "Test `when-let' bindings can refer to already bound symbols."
398 (when-let ((a (1+ 0)) (b (1+ a)) (c (1+ b)))
402 (ert-deftest subr-x-test-when-let-and-laziness-is-preserved ()
403 "Test `when-let' respects `and' laziness."
404 (let (a-called b-called c-called)
408 (b (setq b-called t))
409 (c (setq c-called t)))
411 (list a-called b-called c-called))
412 (list nil nil nil))))
413 (let (a-called b-called c-called)
416 (when-let ((a (setq a-called t))
418 (c (setq c-called t)))
420 (list a-called b-called c-called))
422 (let (a-called b-called c-called)
425 (when-let ((a (setq a-called t))
426 (b (setq b-called t))
428 (d (setq c-called t)))
430 (list a-called b-called c-called))
434 ;; Thread first tests
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))))
441 (ert-deftest subr-x-test-thread-first-function-names-are-threaded ()
442 "Test `thread-first' wraps single function names."
443 (should (equal (macroexpand
447 (should (equal (macroexpand
448 '(thread-first (+ 1 2)
452 (ert-deftest subr-x-test-thread-first-expansion ()
453 "Test `thread-first' expands correctly."
455 (macroexpand '(thread-first
461 '(+ (- (/ (+ 5 20) 25)) 40))))
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
472 (should (equal (thread-first
476 (append (list "good")))
477 (list "this" "is" "good"))))
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))))
486 (ert-deftest subr-x-test-thread-last-function-names-are-threaded ()
487 "Test `thread-last' wraps single function names."
488 (should (equal (macroexpand
492 (should (equal (macroexpand
493 '(thread-last (+ 1 2)
497 (ert-deftest subr-x-test-thread-last-expansion ()
498 "Test `thread-last' expands correctly."
500 (macroexpand '(thread-last
506 '(+ 40 (- (/ 25 (+ 20 5)))))))
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
517 (should (equal (thread-last
521 (format "abs sum is: %s"))
525 (provide 'subr-x-tests)
526 ;;; subr-x-tests.el ends here