summaryrefslogtreecommitdiff
path: root/test/automated/subr-x-tests.el
diff options
context:
space:
mode:
Diffstat (limited to 'test/automated/subr-x-tests.el')
-rw-r--r--test/automated/subr-x-tests.el526
1 files changed, 0 insertions, 526 deletions
diff --git a/test/automated/subr-x-tests.el b/test/automated/subr-x-tests.el
deleted file mode 100644
index e30b5d8f549..00000000000
--- a/test/automated/subr-x-tests.el
+++ /dev/null
@@ -1,526 +0,0 @@
-;;; subr-x-tests.el --- Testing the extended lisp routines
-
-;; Copyright (C) 2014-2016 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
generated by cgit v1.2.3 (git 2.39.1) at 2025-04-23 06:12:59 +0000