aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorJuri Linkov2019-06-03 23:18:31 +0300
committerJuri Linkov2019-06-03 23:18:31 +0300
commit9d72d6a3a2fb23c6f7123c5aba2457dee93d9454 (patch)
tree0f2bae3eed0da6ac668a6cae9ee2c7e749937e45
parent4b87a032dcaebad3ba37cdb3cb0cdd2760fc24fd (diff)
downloademacs-9d72d6a3a2fb23c6f7123c5aba2457dee93d9454.tar.gz
emacs-9d72d6a3a2fb23c6f7123c5aba2457dee93d9454.zip
* lisp/char-fold.el (char-fold-make-table): New function
with body extracted from INITVALUE of defconst (bug#35689). Bind search-spaces-regexp to nil (bug#35802). * test/lisp/char-fold-tests.el: Relocate helpers to file beginning. (char-fold--test-bug-35802): New test.
-rw-r--r--lisp/char-fold.el23
-rw-r--r--test/lisp/char-fold-tests.el50
2 files changed, 42 insertions, 31 deletions
diff --git a/lisp/char-fold.el b/lisp/char-fold.el
index e61bc3edc6a..d2fa7108bbd 100644
--- a/lisp/char-fold.el
+++ b/lisp/char-fold.el
@@ -24,11 +24,12 @@
24 24
25(eval-and-compile (put 'char-fold-table 'char-table-extra-slots 1)) 25(eval-and-compile (put 'char-fold-table 'char-table-extra-slots 1))
26 26
27(defconst char-fold-table 27(eval-and-compile
28 (eval-when-compile 28 (defun char-fold-make-table ()
29 (let ((equiv (make-char-table 'char-fold-table)) 29 (let* ((equiv (make-char-table 'char-fold-table))
30 (equiv-multi (make-char-table 'char-fold-table)) 30 (equiv-multi (make-char-table 'char-fold-table))
31 (table (unicode-property-table-internal 'decomposition))) 31 (search-spaces-regexp nil) ; workaround for bug#35802
32 (table (unicode-property-table-internal 'decomposition)))
32 (set-char-table-extra-slot equiv 0 equiv-multi) 33 (set-char-table-extra-slot equiv 0 equiv-multi)
33 34
34 ;; Ensure the table is populated. 35 ;; Ensure the table is populated.
@@ -107,13 +108,17 @@
107 108
108 ;; Convert the lists of characters we compiled into regexps. 109 ;; Convert the lists of characters we compiled into regexps.
109 (map-char-table 110 (map-char-table
110 (lambda (char dec-list) 111 (lambda (char decomp-list)
111 (let ((re (regexp-opt (cons (char-to-string char) dec-list)))) 112 (let ((re (regexp-opt (cons (char-to-string char) decomp-list))))
112 (if (consp char) 113 (if (consp char) ; FIXME: char never is consp?
113 (set-char-table-range equiv char re) 114 (set-char-table-range equiv char re)
114 (aset equiv char re)))) 115 (aset equiv char re))))
115 equiv) 116 equiv)
116 equiv)) 117 equiv)))
118
119(defconst char-fold-table
120 (eval-when-compile
121 (char-fold-make-table))
117 "Used for folding characters of the same group during search. 122 "Used for folding characters of the same group during search.
118This is a char-table with the `char-fold-table' subtype. 123This is a char-table with the `char-fold-table' subtype.
119 124
diff --git a/test/lisp/char-fold-tests.el b/test/lisp/char-fold-tests.el
index 8a647bd0765..8a7414084b0 100644
--- a/test/lisp/char-fold-tests.el
+++ b/test/lisp/char-fold-tests.el
@@ -26,6 +26,24 @@
26 (mapconcat (lambda (_) (string (+ 9 (random 117)))) 26 (mapconcat (lambda (_) (string (+ 9 (random 117))))
27 (make-list n nil) "")) 27 (make-list n nil) ""))
28 28
29(defun char-fold--ascii-upcase (string)
30 "Like `upcase' but acts on ASCII characters only."
31 (replace-regexp-in-string "[a-z]+" 'upcase string))
32
33(defun char-fold--ascii-downcase (string)
34 "Like `downcase' but acts on ASCII characters only."
35 (replace-regexp-in-string "[a-z]+" 'downcase string))
36
37(defun char-fold--test-match-exactly (string &rest strings-to-match)
38 (let ((re (concat "\\`" (char-fold-to-regexp string) "\\'")))
39 (dolist (it strings-to-match)
40 (should (string-match re it)))
41 ;; Case folding
42 (let ((case-fold-search t))
43 (dolist (it strings-to-match)
44 (should (string-match (char-fold--ascii-upcase re) (downcase it)))
45 (should (string-match (char-fold--ascii-downcase re) (upcase it)))))))
46
29(defun char-fold--test-search-with-contents (contents string) 47(defun char-fold--test-search-with-contents (contents string)
30 (with-temp-buffer 48 (with-temp-buffer
31 (insert contents) 49 (insert contents)
@@ -54,25 +72,7 @@
54 (concat w1 "\s\n\s\t\f\t\n\r\t" w2) 72 (concat w1 "\s\n\s\t\f\t\n\r\t" w2)
55 (concat w1 (make-string 10 ?\s) w2))))) 73 (concat w1 (make-string 10 ?\s) w2)))))
56 74
57(defun char-fold--ascii-upcase (string) 75(ert-deftest char-fold--test-multi-defaults ()
58 "Like `upcase' but acts on ASCII characters only."
59 (replace-regexp-in-string "[a-z]+" 'upcase string))
60
61(defun char-fold--ascii-downcase (string)
62 "Like `downcase' but acts on ASCII characters only."
63 (replace-regexp-in-string "[a-z]+" 'downcase string))
64
65(defun char-fold--test-match-exactly (string &rest strings-to-match)
66 (let ((re (concat "\\`" (char-fold-to-regexp string) "\\'")))
67 (dolist (it strings-to-match)
68 (should (string-match re it)))
69 ;; Case folding
70 (let ((case-fold-search t))
71 (dolist (it strings-to-match)
72 (should (string-match (char-fold--ascii-upcase re) (downcase it)))
73 (should (string-match (char-fold--ascii-downcase re) (upcase it)))))))
74
75(ert-deftest char-fold--test-some-defaults ()
76 (dolist (it '(("ffl" . "ffl") ("ffi" . "ffi") 76 (dolist (it '(("ffl" . "ffl") ("ffi" . "ffi")
77 ("fi" . "fi") ("ff" . "ff") 77 ("fi" . "fi") ("ff" . "ff")
78 ("ä" . "ä"))) 78 ("ä" . "ä")))
@@ -109,9 +109,7 @@
109(ert-deftest char-fold--speed-test () 109(ert-deftest char-fold--speed-test ()
110 (dolist (string (append '("tty-set-up-initial-frame-face" 110 (dolist (string (append '("tty-set-up-initial-frame-face"
111 "tty-set-up-initial-frame-face-frame-faceframe-faceframe-faceframe-face") 111 "tty-set-up-initial-frame-face-frame-faceframe-faceframe-faceframe-face")
112 (mapcar #'char-fold--random-word '(10 50 100 112 (mapcar #'char-fold--random-word '(10 50 100 50 100))))
113 50 100))))
114 (message "Testing %s" string)
115 ;; Make sure we didn't just fallback on the trivial search. 113 ;; Make sure we didn't just fallback on the trivial search.
116 (should-not (string= (regexp-quote string) 114 (should-not (string= (regexp-quote string)
117 (char-fold-to-regexp string))) 115 (char-fold-to-regexp string)))
@@ -126,5 +124,13 @@
126 ;; Ensure it took less than a second. 124 ;; Ensure it took less than a second.
127 (should (< (- (time-to-seconds) time) 1)))))) 125 (should (< (- (time-to-seconds) time) 1))))))
128 126
127(ert-deftest char-fold--test-bug-35802 ()
128 (let* ((char-code-property-alist ; initial value
129 (cons '(decomposition . "uni-decomposition.el")
130 char-code-property-alist))
131 (search-spaces-regexp "\\(\\s-\\|\n\\)+")
132 (char-fold-table (char-fold-make-table)))
133 (char-fold--test-match-exactly "ä" "ä")))
134
129(provide 'char-fold-tests) 135(provide 'char-fold-tests)
130;;; char-fold-tests.el ends here 136;;; char-fold-tests.el ends here