1 ;;; char-fold-tests.el --- Tests for char-fold.el -*- lexical-binding: t; -*-
3 ;; Copyright (C) 2013-2016 Free Software Foundation, Inc.
5 ;; Author: Artur Malabarba <bruce.connor.am@gmail.com>
7 ;; This program is free software; you can redistribute it and/or modify
8 ;; it under the terms of the GNU General Public License as published by
9 ;; the Free Software Foundation, either version 3 of the License, or
10 ;; (at your option) any later version.
12 ;; This program is distributed in the hope that it will be useful,
13 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
14 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 ;; GNU General Public License for more details.
17 ;; You should have received a copy of the GNU General Public License
18 ;; along with this program. If not, see <http://www.gnu.org/licenses/>.
25 (defun char-fold--random-word (n)
26 (mapconcat (lambda (_) (string (+ 9 (random 117))))
27 (make-list n nil
) ""))
29 (defun char-fold--test-search-with-contents (contents string
)
32 (goto-char (point-min))
33 (should (search-forward-regexp (char-fold-to-regexp string
) nil
'noerror
))
34 (goto-char (point-min))
35 (should (char-fold-search-forward string nil
'noerror
))
36 (should (char-fold-search-backward string nil
'noerror
))))
39 (ert-deftest char-fold--test-consistency
()
41 (let ((w (char-fold--random-word n
)))
42 ;; A folded string should always match the original string.
43 (char-fold--test-search-with-contents w w
))))
45 (ert-deftest char-fold--test-lax-whitespace
()
47 (let ((w1 (char-fold--random-word n
))
48 (w2 (char-fold--random-word n
))
49 (search-spaces-regexp "\\s-+"))
50 (char-fold--test-search-with-contents
51 (concat w1
"\s\n\s\t\f\t\n\r\t" w2
)
53 (char-fold--test-search-with-contents
54 (concat w1
"\s\n\s\t\f\t\n\r\t" w2
)
55 (concat w1
(make-string 10 ?\s
) w2
)))))
57 (defun char-fold--test-match-exactly (string &rest strings-to-match
)
58 (let ((re (concat "\\`" (char-fold-to-regexp string
) "\\'")))
59 (dolist (it strings-to-match
)
60 (should (string-match re it
)))
62 (let ((case-fold-search t
))
63 (dolist (it strings-to-match
)
64 (should (string-match (upcase re
) (downcase it
)))
65 (should (string-match (downcase re
) (upcase it
)))))))
67 (ert-deftest char-fold--test-some-defaults
()
68 (dolist (it '(("ffl" .
"ffl") ("ffi" .
"ffi")
69 ("fi" .
"fi") ("ff" .
"ff")
71 (char-fold--test-search-with-contents (cdr it
) (car it
))
72 (let ((multi (char-table-extra-slot char-fold-table
0))
73 (char-fold-table (make-char-table 'char-fold-table
)))
74 (set-char-table-extra-slot char-fold-table
0 multi
)
75 (char-fold--test-match-exactly (car it
) (cdr it
)))))
77 (ert-deftest char-fold--test-fold-to-regexp
()
78 (let ((char-fold-table (make-char-table 'char-fold-table
))
79 (multi (make-char-table 'char-fold-table
)))
80 (set-char-table-extra-slot char-fold-table
0 multi
)
81 (aset char-fold-table ?a
"xx")
82 (aset char-fold-table ?
1 "44")
83 (aset char-fold-table ?\s
"-!-")
84 (char-fold--test-match-exactly "a1a1" "xx44xx44")
85 (char-fold--test-match-exactly "a1 a 1" "xx44-!--!-xx-!-44")
86 (aset multi ?a
'(("1" .
"99")
89 (char-fold--test-match-exactly "a" "xx")
90 (char-fold--test-match-exactly "a1" "xx44" "99")
91 (char-fold--test-match-exactly "a12" "77" "xx442" "992")
92 (char-fold--test-match-exactly "a2" "88")
93 (aset multi ?
1 '(("2" .
"yy")))
94 (char-fold--test-match-exactly "a1" "xx44" "99")
95 (char-fold--test-match-exactly "a12" "77" "xx442" "992")
96 ;; Support for this case is disabled. See function definition or:
97 ;; https://lists.gnu.org/archive/html/emacs-devel/2015-11/msg02562.html
98 ;; (char-fold--test-match-exactly "a12" "xxyy")
101 (ert-deftest char-fold--speed-test
()
102 (dolist (string (append '("tty-set-up-initial-frame-face"
103 "tty-set-up-initial-frame-face-frame-faceframe-faceframe-faceframe-face")
104 (mapcar #'char-fold--random-word
'(10 50 100
106 (message "Testing %s" string
)
107 ;; Make sure we didn't just fallback on the trivial search.
108 (should-not (string= (regexp-quote string
)
109 (char-fold-to-regexp string
)))
111 (save-excursion (insert string
))
112 (let ((time (time-to-seconds (current-time))))
113 ;; Our initial implementation of case-folding in char-folding
114 ;; created a lot of redundant paths in the regexp. Because of
115 ;; that, if a really long string "almost" matches, the regexp
116 ;; engine took a long time to realize that it doesn't match.
117 (should-not (char-fold-search-forward (concat string
"c") nil
'noerror
))
118 ;; Ensure it took less than a second.
119 (should (< (- (time-to-seconds (current-time))
123 (provide 'char-fold-tests
)
124 ;;; char-fold-tests.el ends here