Commit 9d72d6a3 authored by Juri Linkov's avatar Juri Linkov

* 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.
parent 4b87a032
Pipeline #1885 failed with stage
in 3 seconds
...@@ -24,11 +24,12 @@ ...@@ -24,11 +24,12 @@
(eval-and-compile (put 'char-fold-table 'char-table-extra-slots 1)) (eval-and-compile (put 'char-fold-table 'char-table-extra-slots 1))
(defconst char-fold-table (eval-and-compile
(eval-when-compile (defun char-fold-make-table ()
(let ((equiv (make-char-table 'char-fold-table)) (let* ((equiv (make-char-table 'char-fold-table))
(equiv-multi (make-char-table 'char-fold-table)) (equiv-multi (make-char-table 'char-fold-table))
(table (unicode-property-table-internal 'decomposition))) (search-spaces-regexp nil) ; workaround for bug#35802
(table (unicode-property-table-internal 'decomposition)))
(set-char-table-extra-slot equiv 0 equiv-multi) (set-char-table-extra-slot equiv 0 equiv-multi)
;; Ensure the table is populated. ;; Ensure the table is populated.
...@@ -107,13 +108,17 @@ ...@@ -107,13 +108,17 @@
;; Convert the lists of characters we compiled into regexps. ;; Convert the lists of characters we compiled into regexps.
(map-char-table (map-char-table
(lambda (char dec-list) (lambda (char decomp-list)
(let ((re (regexp-opt (cons (char-to-string char) dec-list)))) (let ((re (regexp-opt (cons (char-to-string char) decomp-list))))
(if (consp char) (if (consp char) ; FIXME: char never is consp?
(set-char-table-range equiv char re) (set-char-table-range equiv char re)
(aset equiv char re)))) (aset equiv char re))))
equiv) equiv)
equiv)) equiv)))
(defconst char-fold-table
(eval-when-compile
(char-fold-make-table))
"Used for folding characters of the same group during search. "Used for folding characters of the same group during search.
This is a char-table with the `char-fold-table' subtype. This is a char-table with the `char-fold-table' subtype.
......
...@@ -26,6 +26,24 @@ ...@@ -26,6 +26,24 @@
(mapconcat (lambda (_) (string (+ 9 (random 117)))) (mapconcat (lambda (_) (string (+ 9 (random 117))))
(make-list n nil) "")) (make-list n nil) ""))
(defun char-fold--ascii-upcase (string)
"Like `upcase' but acts on ASCII characters only."
(replace-regexp-in-string "[a-z]+" 'upcase string))
(defun char-fold--ascii-downcase (string)
"Like `downcase' but acts on ASCII characters only."
(replace-regexp-in-string "[a-z]+" 'downcase string))
(defun char-fold--test-match-exactly (string &rest strings-to-match)
(let ((re (concat "\\`" (char-fold-to-regexp string) "\\'")))
(dolist (it strings-to-match)
(should (string-match re it)))
;; Case folding
(let ((case-fold-search t))
(dolist (it strings-to-match)
(should (string-match (char-fold--ascii-upcase re) (downcase it)))
(should (string-match (char-fold--ascii-downcase re) (upcase it)))))))
(defun char-fold--test-search-with-contents (contents string) (defun char-fold--test-search-with-contents (contents string)
(with-temp-buffer (with-temp-buffer
(insert contents) (insert contents)
...@@ -54,25 +72,7 @@ ...@@ -54,25 +72,7 @@
(concat w1 "\s\n\s\t\f\t\n\r\t" w2) (concat w1 "\s\n\s\t\f\t\n\r\t" w2)
(concat w1 (make-string 10 ?\s) w2))))) (concat w1 (make-string 10 ?\s) w2)))))
(defun char-fold--ascii-upcase (string) (ert-deftest char-fold--test-multi-defaults ()
"Like `upcase' but acts on ASCII characters only."
(replace-regexp-in-string "[a-z]+" 'upcase string))
(defun char-fold--ascii-downcase (string)
"Like `downcase' but acts on ASCII characters only."
(replace-regexp-in-string "[a-z]+" 'downcase string))
(defun char-fold--test-match-exactly (string &rest strings-to-match)
(let ((re (concat "\\`" (char-fold-to-regexp string) "\\'")))
(dolist (it strings-to-match)
(should (string-match re it)))
;; Case folding
(let ((case-fold-search t))
(dolist (it strings-to-match)
(should (string-match (char-fold--ascii-upcase re) (downcase it)))
(should (string-match (char-fold--ascii-downcase re) (upcase it)))))))
(ert-deftest char-fold--test-some-defaults ()
(dolist (it '(("ffl" . "ffl") ("ffi" . "ffi") (dolist (it '(("ffl" . "ffl") ("ffi" . "ffi")
("fi" . "fi") ("ff" . "ff") ("fi" . "fi") ("ff" . "ff")
("ä" . "ä"))) ("ä" . "ä")))
...@@ -109,9 +109,7 @@ ...@@ -109,9 +109,7 @@
(ert-deftest char-fold--speed-test () (ert-deftest char-fold--speed-test ()
(dolist (string (append '("tty-set-up-initial-frame-face" (dolist (string (append '("tty-set-up-initial-frame-face"
"tty-set-up-initial-frame-face-frame-faceframe-faceframe-faceframe-face") "tty-set-up-initial-frame-face-frame-faceframe-faceframe-faceframe-face")
(mapcar #'char-fold--random-word '(10 50 100 (mapcar #'char-fold--random-word '(10 50 100 50 100))))
50 100))))
(message "Testing %s" string)
;; Make sure we didn't just fallback on the trivial search. ;; Make sure we didn't just fallback on the trivial search.
(should-not (string= (regexp-quote string) (should-not (string= (regexp-quote string)
(char-fold-to-regexp string))) (char-fold-to-regexp string)))
...@@ -126,5 +124,13 @@ ...@@ -126,5 +124,13 @@
;; Ensure it took less than a second. ;; Ensure it took less than a second.
(should (< (- (time-to-seconds) time) 1)))))) (should (< (- (time-to-seconds) time) 1))))))
(ert-deftest char-fold--test-bug-35802 ()
(let* ((char-code-property-alist ; initial value
(cons '(decomposition . "uni-decomposition.el")
char-code-property-alist))
(search-spaces-regexp "\\(\\s-\\|\n\\)+")
(char-fold-table (char-fold-make-table)))
(char-fold--test-match-exactly "ä" "ä")))
(provide 'char-fold-tests) (provide 'char-fold-tests)
;;; char-fold-tests.el ends here ;;; char-fold-tests.el ends here
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment