diff options
| author | Juri Linkov | 2019-06-03 23:18:31 +0300 |
|---|---|---|
| committer | Juri Linkov | 2019-06-03 23:18:31 +0300 |
| commit | 9d72d6a3a2fb23c6f7123c5aba2457dee93d9454 (patch) | |
| tree | 0f2bae3eed0da6ac668a6cae9ee2c7e749937e45 | |
| parent | 4b87a032dcaebad3ba37cdb3cb0cdd2760fc24fd (diff) | |
| download | emacs-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.el | 23 | ||||
| -rw-r--r-- | test/lisp/char-fold-tests.el | 50 |
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. |
| 118 | This is a char-table with the `char-fold-table' subtype. | 123 | This 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 |