diff options
Diffstat (limited to 'test/automated/subr-x-tests.el')
| -rw-r--r-- | test/automated/subr-x-tests.el | 526 |
1 files changed, 526 insertions, 0 deletions
diff --git a/test/automated/subr-x-tests.el b/test/automated/subr-x-tests.el new file mode 100644 index 00000000000..03541f173f0 --- /dev/null +++ b/test/automated/subr-x-tests.el @@ -0,0 +1,526 @@ +;;; subr-x-tests.el --- Testing the extended lisp routines + +;; Copyright (C) 2014 Free Software Foundation, Inc. + +;; Author: Fabián E. Gallina <fgallina@gnu.org> +;; Keywords: + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; + +;;; Code: + +(require 'ert) +(require 'subr-x) + + +;; if-let tests + +(ert-deftest subr-x-test-if-let-single-binding-expansion () + "Test single bindings are expanded properly." + (should (equal + (macroexpand + '(if-let (a 1) + (- a) + "no")) + '(let* ((a (and t 1))) + (if a + (- a) + "no")))) + (should (equal + (macroexpand + '(if-let (a) + (- a) + "no")) + '(let* ((a (and t nil))) + (if a + (- a) + "no"))))) + +(ert-deftest subr-x-test-if-let-single-symbol-expansion () + "Test single symbol bindings are expanded properly." + (should (equal + (macroexpand + '(if-let (a) + (- a) + "no")) + '(let* ((a (and t nil))) + (if a + (- a) + "no")))) + (should (equal + (macroexpand + '(if-let (a b c) + (- a) + "no")) + '(let* ((a (and t nil)) + (b (and a nil)) + (c (and b nil))) + (if c + (- a) + "no")))) + (should (equal + (macroexpand + '(if-let (a (b 2) c) + (- a) + "no")) + '(let* ((a (and t nil)) + (b (and a 2)) + (c (and b nil))) + (if c + (- a) + "no"))))) + +(ert-deftest subr-x-test-if-let-nil-related-expansion () + "Test nil is processed properly." + (should (equal + (macroexpand + '(if-let (nil) + (- a) + "no")) + '(let* ((nil (and t nil))) + (if nil + (- a) + "no")))) + (should (equal + (macroexpand + '(if-let ((nil)) + (- a) + "no")) + '(let* ((nil (and t nil))) + (if nil + (- a) + "no")))) + (should (equal + (macroexpand + '(if-let ((a 1) (nil) (b 2)) + (- a) + "no")) + '(let* ((a (and t 1)) + (nil (and a nil)) + (b (and nil 2))) + (if b + (- a) + "no")))) + (should (equal + (macroexpand + '(if-let ((a 1) nil (b 2)) + (- a) + "no")) + '(let* ((a (and t 1)) + (nil (and a nil)) + (b (and nil 2))) + (if b + (- a) + "no"))))) + +(ert-deftest subr-x-test-if-let-malformed-binding () + "Test malformed bindings trigger errors." + (should-error (macroexpand + '(if-let (_ (a 1 1) (b 2) (c 3) d) + (- a) + "no")) + :type 'error) + (should-error (macroexpand + '(if-let (_ (a 1) (b 2 2) (c 3) d) + (- a) + "no")) + :type 'error) + (should-error (macroexpand + '(if-let (_ (a 1) (b 2) (c 3 3) d) + (- a) + "no")) + :type 'error) + (should-error (macroexpand + '(if-let ((a 1 1)) + (- a) + "no")) + :type 'error)) + +(ert-deftest subr-x-test-if-let-true () + "Test `if-let' with truthy bindings." + (should (equal + (if-let (a 1) + a + "no") + 1)) + (should (equal + (if-let ((a 1) (b 2) (c 3)) + (list a b c) + "no") + (list 1 2 3)))) + +(ert-deftest subr-x-test-if-let-false () + "Test `if-let' with falsie bindings." + (should (equal + (if-let (a nil) + (list a b c) + "no") + "no")) + (should (equal + (if-let ((a nil) (b 2) (c 3)) + (list a b c) + "no") + "no")) + (should (equal + (if-let ((a 1) (b nil) (c 3)) + (list a b c) + "no") + "no")) + (should (equal + (if-let ((a 1) (b 2) (c nil)) + (list a b c) + "no") + "no")) + (should (equal + (if-let (z (a 1) (b 2) (c 3)) + (list a b c) + "no") + "no")) + (should (equal + (if-let ((a 1) (b 2) (c 3) d) + (list a b c) + "no") + "no"))) + +(ert-deftest subr-x-test-if-let-bound-references () + "Test `if-let' bindings can refer to already bound symbols." + (should (equal + (if-let ((a (1+ 0)) (b (1+ a)) (c (1+ b))) + (list a b c) + "no") + (list 1 2 3)))) + +(ert-deftest subr-x-test-if-let-and-laziness-is-preserved () + "Test `if-let' respects `and' laziness." + (let (a-called b-called c-called) + (should (equal + (if-let ((a nil) + (b (setq b-called t)) + (c (setq c-called t))) + "yes" + (list a-called b-called c-called)) + (list nil nil nil)))) + (let (a-called b-called c-called) + (should (equal + (if-let ((a (setq a-called t)) + (b nil) + (c (setq c-called t))) + "yes" + (list a-called b-called c-called)) + (list t nil nil)))) + (let (a-called b-called c-called) + (should (equal + (if-let ((a (setq a-called t)) + (b (setq b-called t)) + (c nil) + (d (setq c-called t))) + "yes" + (list a-called b-called c-called)) + (list t t nil))))) + + +;; when-let tests + +(ert-deftest subr-x-test-when-let-body-expansion () + "Test body allows for multiple sexps wrapping with progn." + (should (equal + (macroexpand + '(when-let (a 1) + (message "opposite") + (- a))) + '(let* ((a (and t 1))) + (if a + (progn + (message "opposite") + (- a))))))) + +(ert-deftest subr-x-test-when-let-single-binding-expansion () + "Test single bindings are expanded properly." + (should (equal + (macroexpand + '(when-let (a 1) + (- a))) + '(let* ((a (and t 1))) + (if a + (- a))))) + (should (equal + (macroexpand + '(when-let (a) + (- a))) + '(let* ((a (and t nil))) + (if a + (- a)))))) + +(ert-deftest subr-x-test-when-let-single-symbol-expansion () + "Test single symbol bindings are expanded properly." + (should (equal + (macroexpand + '(when-let (a) + (- a))) + '(let* ((a (and t nil))) + (if a + (- a))))) + (should (equal + (macroexpand + '(when-let (a b c) + (- a))) + '(let* ((a (and t nil)) + (b (and a nil)) + (c (and b nil))) + (if c + (- a))))) + (should (equal + (macroexpand + '(when-let (a (b 2) c) + (- a))) + '(let* ((a (and t nil)) + (b (and a 2)) + (c (and b nil))) + (if c + (- a)))))) + +(ert-deftest subr-x-test-when-let-nil-related-expansion () + "Test nil is processed properly." + (should (equal + (macroexpand + '(when-let (nil) + (- a))) + '(let* ((nil (and t nil))) + (if nil + (- a))))) + (should (equal + (macroexpand + '(when-let ((nil)) + (- a))) + '(let* ((nil (and t nil))) + (if nil + (- a))))) + (should (equal + (macroexpand + '(when-let ((a 1) (nil) (b 2)) + (- a))) + '(let* ((a (and t 1)) + (nil (and a nil)) + (b (and nil 2))) + (if b + (- a))))) + (should (equal + (macroexpand + '(when-let ((a 1) nil (b 2)) + (- a))) + '(let* ((a (and t 1)) + (nil (and a nil)) + (b (and nil 2))) + (if b + (- a)))))) + +(ert-deftest subr-x-test-when-let-malformed-binding () + "Test malformed bindings trigger errors." + (should-error (macroexpand + '(when-let (_ (a 1 1) (b 2) (c 3) d) + (- a))) + :type 'error) + (should-error (macroexpand + '(when-let (_ (a 1) (b 2 2) (c 3) d) + (- a))) + :type 'error) + (should-error (macroexpand + '(when-let (_ (a 1) (b 2) (c 3 3) d) + (- a))) + :type 'error) + (should-error (macroexpand + '(when-let ((a 1 1)) + (- a))) + :type 'error)) + +(ert-deftest subr-x-test-when-let-true () + "Test `when-let' with truthy bindings." + (should (equal + (when-let (a 1) + a) + 1)) + (should (equal + (when-let ((a 1) (b 2) (c 3)) + (list a b c)) + (list 1 2 3)))) + +(ert-deftest subr-x-test-when-let-false () + "Test `when-let' with falsie bindings." + (should (equal + (when-let (a nil) + (list a b c) + "no") + nil)) + (should (equal + (when-let ((a nil) (b 2) (c 3)) + (list a b c) + "no") + nil)) + (should (equal + (when-let ((a 1) (b nil) (c 3)) + (list a b c) + "no") + nil)) + (should (equal + (when-let ((a 1) (b 2) (c nil)) + (list a b c) + "no") + nil)) + (should (equal + (when-let (z (a 1) (b 2) (c 3)) + (list a b c) + "no") + nil)) + (should (equal + (when-let ((a 1) (b 2) (c 3) d) + (list a b c) + "no") + nil))) + +(ert-deftest subr-x-test-when-let-bound-references () + "Test `when-let' bindings can refer to already bound symbols." + (should (equal + (when-let ((a (1+ 0)) (b (1+ a)) (c (1+ b))) + (list a b c)) + (list 1 2 3)))) + +(ert-deftest subr-x-test-when-let-and-laziness-is-preserved () + "Test `when-let' respects `and' laziness." + (let (a-called b-called c-called) + (should (equal + (progn + (when-let ((a nil) + (b (setq b-called t)) + (c (setq c-called t))) + "yes") + (list a-called b-called c-called)) + (list nil nil nil)))) + (let (a-called b-called c-called) + (should (equal + (progn + (when-let ((a (setq a-called t)) + (b nil) + (c (setq c-called t))) + "yes") + (list a-called b-called c-called)) + (list t nil nil)))) + (let (a-called b-called c-called) + (should (equal + (progn + (when-let ((a (setq a-called t)) + (b (setq b-called t)) + (c nil) + (d (setq c-called t))) + "yes") + (list a-called b-called c-called)) + (list t t nil))))) + + +;; Thread first tests + +(ert-deftest subr-x-test-thread-first-no-forms () + "Test `thread-first' with no forms expands to the first form." + (should (equal (macroexpand '(thread-first 5)) 5)) + (should (equal (macroexpand '(thread-first (+ 1 2))) '(+ 1 2)))) + +(ert-deftest subr-x-test-thread-first-function-names-are-threaded () + "Test `thread-first' wraps single function names." + (should (equal (macroexpand + '(thread-first 5 + -)) + '(- 5))) + (should (equal (macroexpand + '(thread-first (+ 1 2) + -)) + '(- (+ 1 2))))) + +(ert-deftest subr-x-test-thread-first-expansion () + "Test `thread-first' expands correctly." + (should (equal + (macroexpand '(thread-first + 5 + (+ 20) + (/ 25) + - + (+ 40))) + '(+ (- (/ (+ 5 20) 25)) 40)))) + +(ert-deftest subr-x-test-thread-first-examples () + "Test several `thread-first' examples." + (should (equal (thread-first (+ 40 2)) 42)) + (should (equal (thread-first + 5 + (+ 20) + (/ 25) + - + (+ 40)) 39)) + (should (equal (thread-first + "this-is-a-string" + (split-string "-") + (nbutlast 2) + (append (list "good"))) + (list "this" "is" "good")))) + +;; Thread last tests + +(ert-deftest subr-x-test-thread-last-no-forms () + "Test `thread-last' with no forms expands to the first form." + (should (equal (macroexpand '(thread-last 5)) 5)) + (should (equal (macroexpand '(thread-last (+ 1 2))) '(+ 1 2)))) + +(ert-deftest subr-x-test-thread-last-function-names-are-threaded () + "Test `thread-last' wraps single function names." + (should (equal (macroexpand + '(thread-last 5 + -)) + '(- 5))) + (should (equal (macroexpand + '(thread-last (+ 1 2) + -)) + '(- (+ 1 2))))) + +(ert-deftest subr-x-test-thread-last-expansion () + "Test `thread-last' expands correctly." + (should (equal + (macroexpand '(thread-last + 5 + (+ 20) + (/ 25) + - + (+ 40))) + '(+ 40 (- (/ 25 (+ 20 5))))))) + +(ert-deftest subr-x-test-thread-last-examples () + "Test several `thread-last' examples." + (should (equal (thread-last (+ 40 2)) 42)) + (should (equal (thread-last + 5 + (+ 20) + (/ 25) + - + (+ 40)) 39)) + (should (equal (thread-last + (list 1 -2 3 -4 5) + (mapcar #'abs) + (cl-reduce #'+) + (format "abs sum is: %s")) + "abs sum is: 15"))) + + +(provide 'subr-x-tests) +;;; subr-x-tests.el ends here |