;;; subr-x-tests.el --- Testing the extended lisp routines -*- lexical-binding:t -*-
;; Copyright (C) 2014-2024 Free Software Foundation, Inc.
;; Author: Fabián E. Gallina <fgallina@gnu.org>
;; Keywords:
;; This file is part of GNU Emacs.
;; GNU Emacs 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.
;; GNU Emacs 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 GNU Emacs. If not, see <https://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 a)))
(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 a)))
(if a
(- a)
"no"))))
(should (equal
(macroexpand
'(if-let* (a b c)
(- a)
"no"))
'(let* ((a (and t a))
(b (and a b))
(c (and b c)))
(if c
(- a)
"no"))))
(should (equal
(macroexpand
'(if-let* (a (b 2) c)
(- a)
"no"))
'(let* ((a (and t a))
(b (and a 2))
(c (and b c)))
(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* ((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))
"yes"
"no")
"no"))
(should (equal
(if-let* ((a nil) (b 2) (c 3))
"yes"
"no")
"no"))
(should (equal
(if-let* ((a 1) (b nil) (c 3))
"yes"
"no")
"no"))
(should (equal
(if-let* ((a 1) (b 2) (c nil))
"yes"
"no")
"no"))
(should (equal
(let ((z nil))
(if-let* (z (a 1) (b 2) (c 3))
"yes"
"no"))
"no"))
(should (equal
(let ((d nil))
(if-let* ((a 1) (b 2) (c 3) d)
"yes"
"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 nil) (b-called nil) 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 nil) (b-called nil) 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 nil) (b-called nil) 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-symbol-expansion ()
"Test single symbol bindings are expanded properly."
(should (equal
(macroexpand
'(when-let* (a)
(- a)))
'(let* ((a (and t a)))
(if a
(- a)))))
(should (equal
(macroexpand
'(when-let* (a b c)
(- a)))
'(let* ((a (and t a))
(b (and a b))
(c (and b c)))
(if c
(- a)))))
(should (equal
(macroexpand
'(when-let* (a (b 2) c)
(- a)))
'(let* ((a (and t a))
(b (and a 2))
(c (and b c)))
(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* ((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))
"no")
nil))
(should (equal
(when-let* ((a nil) (b 2) (c 3))
"no")
nil))
(should (equal
(when-let* ((a 1) (b nil) (c 3))
"no")
nil))
(should (equal
(when-let* ((a 1) (b 2) (c nil))
"no")
nil))
(should (equal
(let ((z nil))
(when-let* (z (a 1) (b 2) (c 3))
"no"))
nil))
(should (equal
(let ((d nil))
(when-let* ((a 1) (b 2) (c 3) d)
"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 nil) (b-called nil) (c-called nil))
(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 nil) (b-called nil) (c-called nil))
(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 nil) (b-called nil) (c-called nil))
(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)))))
;; `and-let*' tests
;; Adapted from the Guile tests
;; https://git.savannah.gnu.org/cgit/guile.git/tree/test-suite/tests/srfi-2.test
(ert-deftest subr-x-and-let*-test-empty-varlist ()
(should (equal 1 (and-let* () 1)))
(should (equal 2 (and-let* () 1 2)))
(should (equal t (and-let* ()))))
(ert-deftest subr-x-and-let*-test-group-1 ()
(should (equal nil (let ((x nil)) (and-let* (x)))))
(should (equal 1 (let ((x 1)) (and-let* (x)))))
(should (equal nil (and-let* ((x nil)))))
(should (equal 1 (and-let* ((x 1)))))
;; The error doesn't trigger when compiled: the compiler will give
;; a warning and then drop the erroneous code. Therefore, use
;; `eval' to avoid compilation.
(should-error (eval '(and-let* (nil (x 1))) lexical-binding)
:type 'setting-constant)
(should (equal nil (and-let* ((nil) (x 1)))))
(should-error (eval '(and-let* (2 (x 1))) lexical-binding)
:type 'wrong-type-argument)
(should (equal 1 (and-let* ((2) (x 1)))))
(should (equal 2 (and-let* ((x 1) (2)))))
(should (equal nil (let ((x nil)) (and-let* (x) x))))
(should (equal "" (let ((x "")) (and-let* (x) x))))
(should (equal "" (let ((x "")) (and-let* (x)))))
(should (equal 2 (let ((x 1)) (and-let* (x) (+ x 1)))))
(should (equal nil (let ((x nil)) (and-let* (x) (+ x 1)))))
(should (equal 2 (let ((x 1)) (and-let* (((> x 0))) (+ x 1)))))
(should (equal t (let ((x 1)) (and-let* (((> x 0)))))))
(should (equal nil (let ((x 0)) (and-let* (((> x 0))) (+ x 1)))))
(should (equal 3
(let ((x 1)) (and-let* (((> x 0)) (x (+ x 1))) (+ x 1))))))
(ert-deftest subr-x-and-let*-test-rebind ()
(should
(equal 4
(let ((x 1))
(and-let* (((> x 0)) (x (+ x 1)) (x (+ x 1))) (+ x 1))))))
(ert-deftest subr-x-and-let*-test-group-2 ()
(should
(equal 2 (let ((x 1)) (and-let* (x ((> x 0))) (+ x 1)))))
(should
(equal 2 (let ((x 1)) (and-let* (((progn x)) ((> x 0))) (+ x 1)))))
(should (equal nil (let ((x 0)) (and-let* (x ((> x 0))) (+ x 1)))))
(should (equal nil (let ((x nil)) (and-let* (x ((> x 0))) (+ x 1)))))
(should
(equal nil (let ((x nil)) (and-let* (((progn x)) ((> x 0))) (+ x 1))))))
(ert-deftest subr-x-and-let*-test-group-3 ()
(should
(equal nil (let ((x 1)) (and-let* (x (y (- x 1)) ((> y 0))) (/ x y)))))
(should
(equal nil (let ((x 0)) (and-let* (x (y (- x 1)) ((> y 0))) (/ x y)))))
(should
(equal nil
(let ((x nil)) (and-let* (x (y (- x 1)) ((> y 0))) (/ x y)))))
(should
(equal (/ 3.0 2)
(let ((x 3.0)) (and-let* (x (y (- x 1)) ((> y 0))) (/ x y))))))
;; 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")))
;; Substring tests
(ert-deftest subr-x-test-string-trim-left ()
"Test `string-trim-left' behavior."
(should (equal (string-trim-left "") ""))
(should (equal (string-trim-left " \t\n\r") ""))
(should (equal (string-trim-left " \t\n\ra") "a"))
(should (equal (string-trim-left "a \t\n\r") "a \t\n\r"))
(should (equal (string-trim-left "" "") ""))
(should (equal (string-trim-left "a" "") "a"))
(should (equal (string-trim-left "aa" "a*") ""))
(should (equal (string-trim-left "ba" "a*") "ba"))
(should (equal (string-trim-left "aa" "a*?") "aa"))
(should (equal (string-trim-left "aa" "a+?") "a")))
(ert-deftest subr-x-test-string-trim-right ()
"Test `string-trim-right' behavior."
(should (equal (string-trim-right "") ""))
(should (equal (string-trim-right " \t\n\r") ""))
(should (equal (string-trim-right " \t\n\ra") " \t\n\ra"))
(should (equal (string-trim-right "a \t\n\r") "a"))
(should (equal (string-trim-right "" "") ""))
(should (equal (string-trim-right "a" "") "a"))
(should (equal (string-trim-right "aa" "a*") ""))
(should (equal (string-trim-right "ab" "a*") "ab"))
(should (equal (string-trim-right "aa" "a*?") "")))
(ert-deftest subr-x-test-string-remove-prefix ()
"Test `string-remove-prefix' behavior."
(should (equal (string-remove-prefix "" "") ""))
(should (equal (string-remove-prefix "" "a") "a"))
(should (equal (string-remove-prefix "a" "") ""))
(should (equal (string-remove-prefix "a" "b") "b"))
(should (equal (string-remove-prefix "a" "a") ""))
(should (equal (string-remove-prefix "a" "aa") "a"))
(should (equal (string-remove-prefix "a" "ab") "b")))
(ert-deftest subr-x-test-string-remove-suffix ()
"Test `string-remove-suffix' behavior."
(should (equal (string-remove-suffix "" "") ""))
(should (equal (string-remove-suffix "" "a") "a"))
(should (equal (string-remove-suffix "a" "") ""))
(should (equal (string-remove-suffix "a" "b") "b"))
(should (equal (string-remove-suffix "a" "a") ""))
(should (equal (string-remove-suffix "a" "aa") "a"))
(should (equal (string-remove-suffix "a" "ba") "b")))
(ert-deftest subr-clean-whitespace ()
(should (equal (string-clean-whitespace " foo ") "foo"))
(should (equal (string-clean-whitespace " foo \r\n\t Bar") "foo Bar")))
(ert-deftest subr-string-fill ()
(should (equal (string-fill "foo" 10) "foo"))
(should (equal (string-fill "foobar" 5) "foobar"))
(should (equal (string-fill "foo bar zot" 5) "foo\nbar\nzot"))
(should (equal (string-fill "foo bar zot" 7) "foo bar\nzot")))
(ert-deftest subr-string-limit ()
(should (equal (string-limit "foo" 10) "foo"))
(should (equal (string-limit "foo" 2) "fo"))
(should (equal (string-limit "foo" 2 t) "oo"))
(should (equal (string-limit "abc" 10 t) "abc"))
(should (equal (string-limit "foo" 0) ""))
(should-error (string-limit "foo" -1)))
(ert-deftest subr-string-limit-coding ()
(should (not (multibyte-string-p (string-limit "foó" 10 nil 'utf-8))))
(should (equal (string-limit "foó" 10 nil 'utf-8) "fo\303\263"))
(should (equal (string-limit "foó" 3 nil 'utf-8) "fo"))
(should (equal (string-limit "foó" 4 nil 'utf-8) "fo\303\263"))
(should (equal (string-limit "foóa" 4 nil 'utf-8) "fo\303\263"))
(should (equal (string-limit "foóá" 4 nil 'utf-8) "fo\303\263"))
(should (equal (string-limit "foóá" 2 nil 'utf-8-with-signature)
""))
(should (equal (string-limit "foóá" 4 nil 'utf-8-with-signature)
"\357\273\277f"))
(should (equal (string-limit "foóa" 4 nil 'iso-8859-1) "fo\363a"))
(should (equal (string-limit "foóá" 4 nil 'iso-8859-1) "fo\363\341"))
(should (equal (string-limit "foóá" 3 nil 'utf-16) ""))
(should (equal (string-limit "foóá" 6 nil 'utf-16) "\376\377\000f\000o"))
(should (equal (string-limit "foó" 10 t 'utf-8) "fo\303\263"))
(should (equal (string-limit "foó" 3 t 'utf-8) "o\303\263"))
(should (equal (string-limit "foó" 4 t 'utf-8) "fo\303\263"))
(should (equal (string-limit "foóa" 4 t 'utf-8) "o\303\263a"))
(should (equal (string-limit "foóá" 4 t 'utf-8) "\303\263\303\241"))
(should (equal (string-limit "foóá" 2 t 'utf-8-with-signature)
""))
(should (equal (string-limit "foóa" 4 t 'iso-8859-1) "fo\363a"))
(should (equal (string-limit "foóá" 4 t 'iso-8859-1) "fo\363\341"))
(should (equal (string-limit "foóá" 6 t 'utf-16) "\376\377\000\363\000\341")))
(ert-deftest subr-string-limit-glyphs ()
(should (equal (encode-coding-string "Hello, 👼🏻🧑🏼🤝🧑🏻" 'utf-8)
"Hello, \360\237\221\274\360\237\217\273\360\237\247\221\360\237\217\274\342\200\215\360\237\244\235\342\200\215\360\237\247\221\360\237\217\273"))
(should (= (length (encode-coding-string "Hello, 👼🏻🧑🏼🤝🧑🏻" 'utf-8)) 41))
(should (equal (string-limit "Hello, 👼🏻🧑🏼🤝🧑🏻" 100 nil 'utf-8)
"Hello, \360\237\221\274\360\237\217\273\360\237\247\221\360\237\217\274\342\200\215\360\237\244\235\342\200\215\360\237\247\221\360\237\217\273"))
(should (equal (string-limit "Hello, 👼🏻🧑🏼🤝🧑🏻" 15 nil 'utf-8)
"Hello, \360\237\221\274\360\237\217\273"))
(should (equal (string-limit "Hello, 👼🏻🧑🏼🤝🧑🏻" 10 nil 'utf-8)
"Hello, ")))
(ert-deftest subr-string-lines ()
(should (equal (string-lines "foo") '("foo")))
(should (equal (string-lines "foo \nbar") '("foo " "bar"))))
(ert-deftest subr-string-pad ()
(should (equal (string-pad "foo" 5) "foo "))
(should (equal (string-pad "foo" 5 ?-) "foo--"))
(should (equal (string-pad "foo" 5 ?- t) "--foo"))
(should (equal (string-pad "foo" 2 ?-) "foo")))
(ert-deftest subr-string-chop-newline ()
(should (equal (string-chop-newline "foo\n") "foo"))
(should (equal (string-chop-newline "foo\nbar\n") "foo\nbar"))
(should (equal (string-chop-newline "foo\nbar") "foo\nbar")))
(ert-deftest subr-ensure-empty-lines ()
(should
(equal
(with-temp-buffer
(insert "foo")
(goto-char (point-min))
(ensure-empty-lines 2)
(buffer-string))
"\n\nfoo"))
(should
(equal
(with-temp-buffer
(insert "foo")
(ensure-empty-lines 2)
(buffer-string))
"foo\n\n\n"))
(should
(equal
(with-temp-buffer
(insert "foo\n")
(ensure-empty-lines 2)
(buffer-string))
"foo\n\n\n"))
(should
(equal
(with-temp-buffer
(insert "foo\n\n\n\n\n")
(ensure-empty-lines 2)
(buffer-string))
"foo\n\n\n"))
(should
(equal
(with-temp-buffer
(insert "foo\n\n\n")
(ensure-empty-lines 0)
(buffer-string))
"foo\n")))
(ert-deftest subr-x-test-add-display-text-property ()
(with-temp-buffer
(insert "Foo bar zot gazonk")
(add-display-text-property 4 8 'height 2.0)
(add-display-text-property 2 12 'raise 0.5)
(should (equal (get-text-property 2 'display) '(raise 0.5)))
(should (equal (get-text-property 5 'display)
'((raise 0.5) (height 2.0))))
(should (equal (get-text-property 9 'display) '(raise 0.5))))
(with-temp-buffer
(insert "Foo bar zot gazonk")
(put-text-property 4 8 'display [(height 2.0)])
(add-display-text-property 2 12 'raise 0.5)
(should (equal (get-text-property 2 'display) '(raise 0.5)))
(should (equal (get-text-property 5 'display)
[(raise 0.5) (height 2.0)]))
(should (equal (get-text-property 9 'display) '(raise 0.5))))
(with-temp-buffer
(should (equal (let ((str "some useless string"))
(add-display-text-property 4 8 'height 2.0 str)
(add-display-text-property 2 12 'raise 0.5 str)
str)
#("some useless string"
2 4 (display (raise 0.5))
4 8 (display ((raise 0.5) (height 2.0)))
8 12 (display (raise 0.5)))))))
(ert-deftest subr-x-named-let ()
(let ((funs ()))
(named-let loop
((rest '(1 42 3))
(sum 0))
(when rest
;; Here, we make sure that the variables are distinct in every
;; iteration, since a naive tail-call optimization would tend to end up
;; with a single `sum' variable being shared by all the closures.
(push (lambda () sum) funs)
;; Here we add a dummy `sum' variable which shadows the `sum' iteration
;; variable since a naive tail-call optimization could also trip here
;; thinking it can `(setq sum ...)' to set the iteration
;; variable's value.
(let ((sum sum))
(loop (cdr rest) (+ sum (car rest))))))
(should (equal (mapcar #'funcall funs) '(43 1 0)))))
(ert-deftest test-with-buffer-unmodified-if-unchanged ()
(with-temp-buffer
(with-buffer-unmodified-if-unchanged
(insert "t"))
(should (buffer-modified-p)))
(with-temp-buffer
(with-buffer-unmodified-if-unchanged
(insert "t")
(delete-char -1))
(should-not (buffer-modified-p)))
;; Shouldn't error.
(should
(with-temp-buffer
(with-buffer-unmodified-if-unchanged
(insert "t")
(delete-char -1)
(kill-buffer))))
(with-temp-buffer
(let ((outer (current-buffer)))
(with-temp-buffer
(let ((inner (current-buffer)))
(with-buffer-unmodified-if-unchanged
(insert "t")
(delete-char -1)
(set-buffer outer))
(with-current-buffer inner
(should-not (buffer-modified-p))))))))
(ert-deftest subr-x--hash-table-keys-and-values ()
(let ((h (make-hash-table)))
(puthash 'a 1 h)
(puthash 'c 3 h)
(puthash 'b 2 h)
(should (equal (sort (hash-table-keys h) #'string<) '(a b c)))
(should (equal (sort (hash-table-values h) #'<) '(1 2 3)))))
(ert-deftest test-string-truncate-left ()
(should (equal (string-truncate-left "band" 3) "...d"))
(should (equal (string-truncate-left "band" 2) "...d"))
(should (equal (string-truncate-left "longstring" 8) "...tring")))
(provide 'subr-x-tests)
;;; subr-x-tests.el ends here