summaryrefslogtreecommitdiff
path: root/test/lisp/subr-tests.el
diff options
context:
space:
mode:
Diffstat (limited to 'test/lisp/subr-tests.el')
-rw-r--r--test/lisp/subr-tests.el281
1 files changed, 247 insertions, 34 deletions
diff --git a/test/lisp/subr-tests.el b/test/lisp/subr-tests.el
index 81cb24f5ba1..2f5b38d05d9 100644
--- a/test/lisp/subr-tests.el
+++ b/test/lisp/subr-tests.el
@@ -1,4 +1,4 @@
-;;; subr-tests.el --- Tests for subr.el
+;;; subr-tests.el --- Tests for subr.el -*- lexical-binding:t -*-
;; Copyright (C) 2015-2021 Free Software Foundation, Inc.
@@ -172,27 +172,28 @@
(should (equal (version-to-list "6.9.30Beta") '(6 9 30 -2)))
(should (equal (version-to-list "6.9.30_Beta") '(6 9 30 -2)))
- (should (equal
- (error-message-string (should-error (version-to-list "OTP-18.1.5")))
- "Invalid version syntax: `OTP-18.1.5' (must start with a number)"))
- (should (equal
- (error-message-string (should-error (version-to-list "")))
- "Invalid version syntax: `' (must start with a number)"))
- (should (equal
- (error-message-string (should-error (version-to-list "1.0..7.5")))
- "Invalid version syntax: `1.0..7.5'"))
- (should (equal
- (error-message-string (should-error (version-to-list "1.0prepre2")))
- "Invalid version syntax: `1.0prepre2'"))
- (should (equal
- (error-message-string (should-error (version-to-list "22.8X3")))
- "Invalid version syntax: `22.8X3'"))
- (should (equal
- (error-message-string (should-error (version-to-list "beta22.8alpha3")))
- "Invalid version syntax: `beta22.8alpha3' (must start with a number)"))
- (should (equal
- (error-message-string (should-error (version-to-list "honk")))
- "Invalid version syntax: `honk' (must start with a number)"))
+ (let ((text-quoting-style 'grave))
+ (should (equal
+ (error-message-string (should-error (version-to-list "OTP-18.1.5")))
+ "Invalid version syntax: `OTP-18.1.5' (must start with a number)"))
+ (should (equal
+ (error-message-string (should-error (version-to-list "")))
+ "Invalid version syntax: `' (must start with a number)"))
+ (should (equal
+ (error-message-string (should-error (version-to-list "1.0..7.5")))
+ "Invalid version syntax: `1.0..7.5'"))
+ (should (equal
+ (error-message-string (should-error (version-to-list "1.0prepre2")))
+ "Invalid version syntax: `1.0prepre2'"))
+ (should (equal
+ (error-message-string (should-error (version-to-list "22.8X3")))
+ "Invalid version syntax: `22.8X3'"))
+ (should (equal
+ (error-message-string (should-error (version-to-list "beta22.8alpha3")))
+ "Invalid version syntax: `beta22.8alpha3' (must start with a number)"))
+ (should (equal
+ (error-message-string (should-error (version-to-list "honk")))
+ "Invalid version syntax: `honk' (must start with a number)")))
(should (equal
(error-message-string (should-error (version-to-list 9)))
"Version must be a string"))
@@ -231,18 +232,40 @@
(should (equal (version-to-list "6_9_30.Beta") '(6 9 30 -2)))
(should (equal (version-to-list "6_9_30Beta") '(6 9 30 -2)))
- (should (equal
- (error-message-string (should-error (version-to-list "1_0__7_5")))
- "Invalid version syntax: `1_0__7_5'"))
- (should (equal
- (error-message-string (should-error (version-to-list "1_0prepre2")))
- "Invalid version syntax: `1_0prepre2'"))
- (should (equal
- (error-message-string (should-error (version-to-list "22.8X3")))
- "Invalid version syntax: `22.8X3'"))
- (should (equal
- (error-message-string (should-error (version-to-list "beta22_8alpha3")))
- "Invalid version syntax: `beta22_8alpha3' (must start with a number)"))))
+ (let ((text-quoting-style 'grave))
+ (should (equal
+ (error-message-string (should-error (version-to-list "1_0__7_5")))
+ "Invalid version syntax: `1_0__7_5'"))
+ (should (equal
+ (error-message-string (should-error (version-to-list "1_0prepre2")))
+ "Invalid version syntax: `1_0prepre2'"))
+ (should (equal
+ (error-message-string (should-error (version-to-list "22.8X3")))
+ "Invalid version syntax: `22.8X3'"))
+ (should (equal
+ (error-message-string (should-error (version-to-list "beta22_8alpha3")))
+ "Invalid version syntax: `beta22_8alpha3' (must start with a number)")))))
+
+(ert-deftest subr-test-version-list-< ()
+ (should (version-list-< '(0) '(1)))
+ (should (version-list-< '(0 9) '(1 0)))
+ (should (version-list-< '(1 -1) '(1 0)))
+ (should (version-list-< '(1 -2) '(1 -1)))
+ (should (not (version-list-< '(1) '(0))))
+ (should (not (version-list-< '(1 1) '(1 0))))
+ (should (not (version-list-< '(1) '(1 0))))
+ (should (not (version-list-< '(1 0) '(1 0 0)))))
+
+(ert-deftest subr-test-version-list-= ()
+ (should (version-list-= '(1) '(1)))
+ (should (version-list-= '(1 0) '(1)))
+ (should (not (version-list-= '(0) '(1)))))
+
+(ert-deftest subr-test-version-list-<= ()
+ (should (version-list-<= '(0) '(1)))
+ (should (version-list-<= '(1) '(1)))
+ (should (version-list-<= '(1 0) '(1)))
+ (should (not (version-list-<= '(1) '(0)))))
(defun subr-test--backtrace-frames-with-backtrace-frame (base)
"Reference implementation of `backtrace-frames'."
@@ -417,5 +440,195 @@ See https://debbugs.gnu.org/cgi/bugreport.cgi?bug=19350."
(should-error (ignore-error foo
(read ""))))
+(ert-deftest string-replace ()
+ (should (equal (string-replace "foo" "bar" "zot")
+ "zot"))
+ (should (equal (string-replace "foo" "bar" "foozot")
+ "barzot"))
+ (should (equal (string-replace "foo" "bar" "barfoozot")
+ "barbarzot"))
+ (should (equal (string-replace "zot" "bar" "barfoozot")
+ "barfoobar"))
+ (should (equal (string-replace "z" "bar" "barfoozot")
+ "barfoobarot"))
+ (should (equal (string-replace "zot" "bar" "zat")
+ "zat"))
+ (should (equal (string-replace "azot" "bar" "zat")
+ "zat"))
+ (should (equal (string-replace "azot" "bar" "azot")
+ "bar"))
+
+ (should (equal (string-replace "azot" "bar" "foozotbar")
+ "foozotbar"))
+
+ (should (equal (string-replace "fo" "bar" "lafofofozot")
+ "labarbarbarzot"))
+
+ (should (equal (string-replace "\377" "x" "a\377b")
+ "axb"))
+ (should (equal (string-replace "\377" "x" "a\377ø")
+ "axø"))
+ (should (equal (string-replace (string-to-multibyte "\377") "x" "a\377b")
+ "axb"))
+ (should (equal (string-replace (string-to-multibyte "\377") "x" "a\377ø")
+ "axø"))
+
+ (should (equal (string-replace "ana" "ANA" "ananas") "ANAnas"))
+
+ (should (equal (string-replace "a" "" "") ""))
+ (should (equal (string-replace "a" "" "aaaaa") ""))
+ (should (equal (string-replace "ab" "" "ababab") ""))
+ (should (equal (string-replace "ab" "" "abcabcabc") "ccc"))
+ (should (equal (string-replace "a" "aa" "aaa") "aaaaaa"))
+ (should (equal (string-replace "abc" "defg" "abc") "defg"))
+
+ (should-error (string-replace "" "x" "abc")))
+
+(ert-deftest subr-replace-regexp-in-string ()
+ (should (equal (replace-regexp-in-string "a+" "xy" "abaabbabaaba")
+ "xybxybbxybxybxy"))
+ ;; FIXEDCASE
+ (let ((case-fold-search t))
+ (should (equal (replace-regexp-in-string "a+" "xy" "ABAABBABAABA")
+ "XYBXYBBXYBXYBXY"))
+ (should (equal (replace-regexp-in-string "a+" "xy" "ABAABBABAABA" t)
+ "xyBxyBBxyBxyBxy"))
+ (should (equal (replace-regexp-in-string
+ "a[bc]*" "xyz"
+ "a A ab AB Ab aB abc ABC Abc AbC aBc")
+ "xyz XYZ xyz XYZ Xyz xyz xyz XYZ Xyz Xyz xyz"))
+ (should (equal (replace-regexp-in-string
+ "a[bc]*" "xyz"
+ "a A ab AB Ab aB abc ABC Abc AbC aBc" t)
+ "xyz xyz xyz xyz xyz xyz xyz xyz xyz xyz xyz")))
+ (let ((case-fold-search nil))
+ (should (equal (replace-regexp-in-string "a+" "xy" "ABAABBABAABA")
+ "ABAABBABAABA")))
+ ;; group substitution
+ (should (equal (replace-regexp-in-string
+ "a\\(b*\\)" "<\\1,\\&>" "babbcaabacbab")
+ "b<bb,abb>c<,a><b,ab><,a>cb<b,ab>"))
+ (should (equal (replace-regexp-in-string
+ "x\\(?2:..\\)\\(?1:..\\)\\(..\\)\\(..\\)\\(..\\)"
+ "<\\3,\\5,\\4,\\1,\\2>" "yxabcdefghijkl")
+ "y<ef,ij,gh,cd,ab>kl"))
+ ;; LITERAL
+ (should (equal (replace-regexp-in-string
+ "a\\(b*\\)" "<\\1,\\&>" "babbcaabacbab" nil t)
+ "b<\\1,\\&>c<\\1,\\&><\\1,\\&><\\1,\\&>cb<\\1,\\&>"))
+ (should (equal (replace-regexp-in-string
+ "a" "\\\\,\\?" "aba")
+ "\\,\\?b\\,\\?"))
+ (should (equal (replace-regexp-in-string
+ "a" "\\\\,\\?" "aba" nil t)
+ "\\\\,\\?b\\\\,\\?"))
+ ;; SUBEXP
+ (should (equal (replace-regexp-in-string
+ "\\(a\\)\\(b*\\)c" "xy" "babbcdacd" nil nil 2)
+ "baxycdaxycd"))
+ ;; START
+ (should (equal (replace-regexp-in-string
+ "ab" "x" "abcabdabeabf" nil nil nil 4)
+ "bdxexf"))
+ ;; An empty pattern matches once before every character.
+ (should (equal (replace-regexp-in-string "" "x" "abc")
+ "xaxbxc"))
+ (should (equal (replace-regexp-in-string "y*" "x" "abc")
+ "xaxbxc"))
+ ;; replacement function
+ (should (equal (replace-regexp-in-string
+ "a\\(b*\\)c"
+ (lambda (s)
+ (format "<%s,%s,%s,%s,%s>"
+ s
+ (match-beginning 0) (match-end 0)
+ (match-beginning 1) (match-end 1)))
+ "babbcaacabc")
+ "b<abbc,0,4,1,3>a<ac,0,2,1,1><abc,0,3,1,2>"))
+ ;; anchors (bug#15107, bug#44861)
+ (should (equal (replace-regexp-in-string "a\\B" "b" "a aaaa")
+ "a bbba"))
+ (should (equal (replace-regexp-in-string "\\`\\|x" "z" "--xx--")
+ "z--zz--")))
+
+(ert-deftest subr-match-substitute-replacement ()
+ (with-temp-buffer
+ (insert "Alpha Beta Gamma Delta Epsilon")
+ (goto-char (point-min))
+ (re-search-forward "B\\(..\\)a")
+ (should (equal (match-substitute-replacement "carrot")
+ "Carrot"))
+ (should (equal (match-substitute-replacement "<\\&>")
+ "<Beta>"))
+ (should (equal (match-substitute-replacement "m\\1a")
+ "Meta"))
+ (should (equal (match-substitute-replacement "ernin" nil nil nil 1)
+ "Bernina")))
+ (let ((s "Tau Beta Gamma Delta Epsilon"))
+ (string-match "B\\(..\\)a" s)
+ (should (equal (match-substitute-replacement "carrot" nil nil s)
+ "Carrot"))
+ (should (equal (match-substitute-replacement "<\\&>" nil nil s)
+ "<Beta>"))
+ (should (equal (match-substitute-replacement "m\\1a" nil nil s)
+ "Meta"))
+ (should (equal (match-substitute-replacement "ernin" nil nil s 1)
+ "Bernina"))))
+
+(ert-deftest subr-tests--change-group-33341 ()
+ (with-temp-buffer
+ (buffer-enable-undo)
+ (insert "0\n")
+ (let ((g (prepare-change-group)))
+ (activate-change-group g)
+ (insert "b\n")
+ (insert "c\n")
+ (cancel-change-group g))
+ (should (equal (buffer-string) "0\n"))
+ (erase-buffer)
+ (setq buffer-undo-list nil)
+ (insert "0\n")
+ (let ((g (prepare-change-group)))
+ (activate-change-group g)
+ (insert "b\n")
+ (insert "c\n")
+ (accept-change-group g))
+ (should (equal (buffer-string) "0\nb\nc\n"))
+ (undo-boundary)
+ (undo)
+ (should (equal (buffer-string) ""))))
+
+(defvar subr--ordered nil)
+
+(ert-deftest subr--add-to-ordered-list-eq ()
+ (setq subr--ordered nil)
+ (add-to-ordered-list 'subr--ordered 'b 2)
+ (should (equal subr--ordered '(b)))
+ (add-to-ordered-list 'subr--ordered 'c 3)
+ (should (equal subr--ordered '(b c)))
+ (add-to-ordered-list 'subr--ordered 'a 1)
+ (should (equal subr--ordered '(a b c)))
+ (add-to-ordered-list 'subr--ordered 'e)
+ (should (equal subr--ordered '(a b c e)))
+ (add-to-ordered-list 'subr--ordered 'd 4)
+ (should (equal subr--ordered '(a b c d e)))
+ (add-to-ordered-list 'subr--ordered 'e)
+ (should (equal subr--ordered '(a b c d e)))
+ (add-to-ordered-list 'subr--ordered 'b 5)
+ (should (equal subr--ordered '(a c d b e))))
+
+
+;;; Apropos.
+
+(ert-deftest apropos-apropos-internal ()
+ (should (equal (apropos-internal "^next-line$") '(next-line)))
+ (should (>= (length (apropos-internal "^help")) 100))
+ (should-not (apropos-internal "^test-a-missing-symbol-foo-bar-zot$")))
+
+(ert-deftest apropos-apropos-internal/predicate ()
+ (should (equal (apropos-internal "^next-line$" #'commandp) '(next-line)))
+ (should (>= (length (apropos-internal "^help" #'commandp)) 15))
+ (should-not (apropos-internal "^next-line$" #'keymapp)))
+
(provide 'subr-tests)
;;; subr-tests.el ends here
generated by cgit v1.2.3 (git 2.39.1) at 2025-04-24 09:06:05 +0000