[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
master be67cc276a9 3/3: Merge from origin/emacs-29
|
From: |
Stefan Kangas |
|
Subject: |
master be67cc276a9 3/3: Merge from origin/emacs-29 |
|
Date: |
Sun, 4 Dec 2022 00:47:15 -0500 (EST) |
branch: master
commit be67cc276a95a97a329fa633fef686ba06c8e6d2
Merge: 91a578ac9fe 96af584af6c
Author: Stefan Kangas <stefankangas@gmail.com>
Commit: Stefan Kangas <stefankangas@gmail.com>
Merge from origin/emacs-29
96af584af6c Fix comment-start-skip in tree-sitter modes (bug#59690)
520a4e12f8e ; * lisp/treesit.el (treesit-end-of-defun): Guard against...
2c4d92d30f6 ; * lisp/subr.el (posn-col-row): Revert inadvertent change.
6fb9a03cbdf ; Remove debugging leftover message
c5ba47c889e Speed up Unicode normalisation tests by a factor of 5
afa4fcb95b4 Fix "C-h k" when clicking on another frame
f6e2f30f394 ; Fix typos
bd58dcedfb9 Fix and expand tests broken by commit 2772ebe366 of 2022-...
a0dd9fdebe3 ; Add cross-reference to string-equal docstring
11c3c54d8ad Fix handling of relative directories in "--init-directory...
401f76cc3d6 Make sure 'user-emacs-directory' ends in a slash
---
lisp/cedet/semantic/bovine/c.el | 2 +-
lisp/cedet/semantic/db.el | 2 +-
lisp/cedet/semantic/format.el | 2 +-
lisp/cedet/semantic/ia.el | 2 +-
lisp/cedet/semantic/idle.el | 2 +-
lisp/cedet/semantic/lex-spp.el | 2 +-
lisp/cedet/semantic/lex.el | 6 +-
lisp/cedet/semantic/sort.el | 2 +-
lisp/cedet/semantic/symref.el | 3 +-
lisp/emacs-lisp/comp.el | 1 -
lisp/help.el | 6 +-
lisp/progmodes/c-ts-mode.el | 6 +-
lisp/progmodes/csharp-mode.el | 3 +-
lisp/progmodes/java-ts-mode.el | 3 +-
lisp/progmodes/js.el | 3 +-
lisp/progmodes/typescript-ts-mode.el | 4 +-
lisp/speedbar.el | 2 +-
lisp/startup.el | 6 ++
lisp/subr.el | 4 +-
lisp/treesit.el | 7 +-
src/fns.c | 4 +-
test/lisp/emacs-lisp/comp-tests.el | 55 ++++++++------
test/lisp/international/ucs-normalize-tests.el | 100 +++++++++++++------------
23 files changed, 132 insertions(+), 95 deletions(-)
diff --git a/lisp/cedet/semantic/bovine/c.el b/lisp/cedet/semantic/bovine/c.el
index 5e08413a96d..c8470e08cb8 100644
--- a/lisp/cedet/semantic/bovine/c.el
+++ b/lisp/cedet/semantic/bovine/c.el
@@ -1578,7 +1578,7 @@ Optional PARENT and COLOR as specified with
c-mode (token &optional parent color)
"Return an UML string describing TOKEN for C and C++.
Optional PARENT and COLOR as specified with
-`semantic-abbreviate-tag-default'."
+`semantic-format-tag-abbreviate-default'."
;; If we have special template things, append.
(concat (semantic-format-tag-uml-prototype-default token parent color)
(semantic-c-template-string token parent color)))
diff --git a/lisp/cedet/semantic/db.el b/lisp/cedet/semantic/db.el
index ff62f53d3cf..08e03bf7158 100644
--- a/lisp/cedet/semantic/db.el
+++ b/lisp/cedet/semantic/db.el
@@ -351,7 +351,7 @@ Note: This index will not be saved in a persistent file.")
;; the tables without using the accessor.
:accessor semanticdb-get-database-tables
:protection :protected
- :documentation "List of `semantic-db-table' objects."))
+ :documentation "List of `semanticdb-table' objects."))
"Database of file tables.")
(cl-defmethod semanticdb-full-filename ((obj semanticdb-table))
diff --git a/lisp/cedet/semantic/format.el b/lisp/cedet/semantic/format.el
index 80e7f1117a2..3d9476d685f 100644
--- a/lisp/cedet/semantic/format.el
+++ b/lisp/cedet/semantic/format.el
@@ -123,7 +123,7 @@ See that variable for details on adding new types."
(defun semantic--format-colorize-merge-text (precoloredtext face-class)
"Apply onto PRECOLOREDTEXT a color associated with FACE-CLASS.
-FACE-CLASS is a tag type found in `semantic-formatface-alist'.
+FACE-CLASS is a tag type found in `semantic-format-face-alist'.
See that variable for details on adding new types."
(let ((face (cdr-safe (assoc face-class semantic-format-face-alist)))
(newtext (concat precoloredtext)))
diff --git a/lisp/cedet/semantic/ia.el b/lisp/cedet/semantic/ia.el
index 2172085d6b9..da884b9d16d 100644
--- a/lisp/cedet/semantic/ia.el
+++ b/lisp/cedet/semantic/ia.el
@@ -457,7 +457,7 @@ parts of the parent classes are displayed."
;; it. The simple `semanticdb-find-tag-by-...' are simple, and
;; you need to pass it the exact name you want.
;;
- ;; The analyzer function `semantic-analyze-tag-name' will take
+ ;; The analyzer function `semantic-analyze-find-tag' will take
;; more complex names, such as the cpp symbol foo::bar::baz,
;; and break it up, and dive through the namespaces.
(let ((class (semantic-analyze-find-tag typename)))
diff --git a/lisp/cedet/semantic/idle.el b/lisp/cedet/semantic/idle.el
index e53dd9104ad..8ab115d717e 100644
--- a/lisp/cedet/semantic/idle.el
+++ b/lisp/cedet/semantic/idle.el
@@ -347,7 +347,7 @@ Returns t if all processing succeeded."
"Core handler for idle work processing of long running tasks.
Visits Semantic controlled buffers, and makes sure all needed
include files have been parsed, and that the typecache is up to date.
-Uses `semantic-idle-work-for-on-buffer' to do the work."
+Uses `semantic-idle-work-for-one-buffer' to do the work."
(let*
((errbuf nil)
(interrupted
diff --git a/lisp/cedet/semantic/lex-spp.el b/lisp/cedet/semantic/lex-spp.el
index b66e5c19cb2..390c13ec98b 100644
--- a/lisp/cedet/semantic/lex-spp.el
+++ b/lisp/cedet/semantic/lex-spp.el
@@ -1256,7 +1256,7 @@ DOC is the documentation for the analyzer.
REGEXP is a regular expression for the analyzer to match.
See `define-lex-regex-analyzer' for more on regexp.
TOKIDX is an index into REGEXP for which a new lexical token
-of type `spp-macro-include' is to be created.
+of type `spp-system-include' is to be created.
VALFORM are forms that return the name of the thing being included, and the
type of include. The return value should be of the form:
(NAME . TYPE)
diff --git a/lisp/cedet/semantic/lex.el b/lisp/cedet/semantic/lex.el
index b3c9e96538c..264b2027711 100644
--- a/lisp/cedet/semantic/lex.el
+++ b/lisp/cedet/semantic/lex.el
@@ -1436,9 +1436,9 @@ Return either a paren token or a semantic list token
depending on
(define-lex semantic-comment-lexer
"A simple lexical analyzer that handles comments.
-This lexer will only return comment tokens. It is the default lexer
-used by `semantic-find-doc-snarf-comment' to snarf up the comment at
-point."
+This lexer will only return comment tokens. It is the default
+lexer used by `semantic-doc-snarf-comment-for-tag' to snarf up
+the comment at point."
semantic-lex-ignore-whitespace
semantic-lex-ignore-newline
semantic-lex-comments
diff --git a/lisp/cedet/semantic/sort.el b/lisp/cedet/semantic/sort.el
index 756b949c0d1..e02abe98765 100644
--- a/lisp/cedet/semantic/sort.el
+++ b/lisp/cedet/semantic/sort.el
@@ -474,7 +474,7 @@ The default behavior, if not overridden with
the name of TAG.
If this function is overridden, use
-`semantic-tag-external-member-children-p-default' to also
+`semantic-tag-external-member-children-default' to also
include the default behavior, and merely extend your own."
)
diff --git a/lisp/cedet/semantic/symref.el b/lisp/cedet/semantic/symref.el
index 16bbacc428e..2ad95fb5a05 100644
--- a/lisp/cedet/semantic/symref.el
+++ b/lisp/cedet/semantic/symref.el
@@ -388,7 +388,8 @@ Each element is a cons cell of the form (LINE . FILENAME).")
:type list
:documentation
"The list of tags with hits in them.
-Use the `semantic-symref-hit-tags' method to get this list.")
+Use the `semantic-symref-hit-to-tag-via-buffer' method to get
+this list.")
)
"The results from a symbol reference search.")
diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el
index 46abca417b2..7b562aaa53d 100644
--- a/lisp/emacs-lisp/comp.el
+++ b/lisp/emacs-lisp/comp.el
@@ -4115,7 +4115,6 @@ the deferred compilation mechanism."
comp-ctxt
(comp-ctxt-output comp-ctxt)
(file-exists-p (comp-ctxt-output comp-ctxt)))
- (message "Deleting %s" (comp-ctxt-output comp-ctxt))
(delete-file (comp-ctxt-output comp-ctxt))))))))
(defun native-compile-async-skip-p (file load selector)
diff --git a/lisp/help.el b/lisp/help.el
index 8e1b325141e..b709062cb27 100644
--- a/lisp/help.el
+++ b/lisp/help.el
@@ -861,11 +861,13 @@ in the selected window."
(mouse-msg (if (or (memq 'click modifiers) (memq 'down modifiers)
(memq 'drag modifiers))
" at that spot" ""))
+ (click-pos (event-end event))
;; Use `posn-set-point' to handle the case when a menu item
;; is selected from the context menu that should describe KEY
;; at the position of mouse click that opened the context menu.
- ;; When no mouse was involved, don't use `posn-set-point'.
- (defn (if buffer
+ ;; When no mouse was involved, or the event doesn't provide a
+ ;; valid position, don't use `posn-set-point'.
+ (defn (if (or buffer (not (consp click-pos)))
(key-binding key t)
(save-excursion (posn-set-point (event-end event))
(key-binding key t)))))
diff --git a/lisp/progmodes/c-ts-mode.el b/lisp/progmodes/c-ts-mode.el
index fcabb5beac8..a8189a0f3da 100644
--- a/lisp/progmodes/c-ts-mode.el
+++ b/lisp/progmodes/c-ts-mode.el
@@ -566,7 +566,8 @@ the subtrees."
;; Comments.
(setq-local comment-start "/* ")
(setq-local comment-end " */")
- (setq-local comment-start-skip (rx (group "/" (or (+ "/") (+ "*")))
+ (setq-local comment-start-skip (rx (or (seq "/" (+ "/"))
+ (seq "/" (+ "*")))
(* (syntax whitespace))))
(setq-local comment-end-skip
(rx (* (syntax whitespace))
@@ -596,7 +597,8 @@ the subtrees."
;; Comments.
(setq-local comment-start "// ")
(setq-local comment-end "")
- (setq-local comment-start-skip (rx (group "/" (or (+ "/") (+ "*")))
+ (setq-local comment-start-skip (rx (or (seq "/" (+ "/"))
+ (seq "/" (+ "*")))
(* (syntax whitespace))))
(setq-local comment-end-skip
(rx (* (syntax whitespace))
diff --git a/lisp/progmodes/csharp-mode.el b/lisp/progmodes/csharp-mode.el
index 3da3079f089..054dabfed07 100644
--- a/lisp/progmodes/csharp-mode.el
+++ b/lisp/progmodes/csharp-mode.el
@@ -900,7 +900,8 @@ Key bindings:
;; Comments.
(setq-local comment-start "// ")
(setq-local comment-end "")
- (setq-local comment-start-skip (rx (group "/" (or (+ "/") (+ "*")))
+ (setq-local comment-start-skip (rx (or (seq "/" (+ "/"))
+ (seq "/" (+ "*")))
(* (syntax whitespace))))
(setq-local comment-end-skip
(rx (* (syntax whitespace))
diff --git a/lisp/progmodes/java-ts-mode.el b/lisp/progmodes/java-ts-mode.el
index cf2482bb6ee..2c42505ac94 100644
--- a/lisp/progmodes/java-ts-mode.el
+++ b/lisp/progmodes/java-ts-mode.el
@@ -301,7 +301,8 @@ the subtrees."
;; Comments.
(setq-local comment-start "// ")
(setq-local comment-end "")
- (setq-local comment-start-skip (rx (group "/" (or (+ "/") (+ "*")))
+ (setq-local comment-start-skip (rx (or (seq "/" (+ "/"))
+ (seq "/" (+ "*")))
(* (syntax whitespace))))
(setq-local comment-end-skip
(rx (* (syntax whitespace))
diff --git a/lisp/progmodes/js.el b/lisp/progmodes/js.el
index ad1fe62d429..389096147ac 100644
--- a/lisp/progmodes/js.el
+++ b/lisp/progmodes/js.el
@@ -3849,7 +3849,8 @@ Currently there are `js-mode' and `js-ts-mode'."
;; Comment.
(setq-local comment-start "// ")
(setq-local comment-end "")
- (setq-local comment-start-skip (rx (group "/" (or (+ "/") (+ "*")))
+ (setq-local comment-start-skip (rx (or (seq "/" (+ "/"))
+ (seq "/" (+ "*")))
(* (syntax whitespace))))
(setq-local comment-end-skip
(rx (* (syntax whitespace))
diff --git a/lisp/progmodes/typescript-ts-mode.el
b/lisp/progmodes/typescript-ts-mode.el
index e09bacdcb1b..48ac1169fe8 100644
--- a/lisp/progmodes/typescript-ts-mode.el
+++ b/lisp/progmodes/typescript-ts-mode.el
@@ -362,7 +362,9 @@ Argument LANGUAGE is either `typescript' or `tsx'."
;; Comments.
(setq-local comment-start "// ")
(setq-local comment-end "")
- (setq-local comment-start-skip "\\(?://+\\|/\\*+\\)\\s *")
+ (setq-local comment-start-skip (rx (or (seq "/" (+ "/"))
+ (seq "/" (+ "*")))
+ (* (syntax whitespace))))
(setq-local comment-end-skip
(rx (* (syntax whitespace))
(group (or (syntax comment-end)
diff --git a/lisp/speedbar.el b/lisp/speedbar.el
index 515f7d5d750..7a279bdaa0e 100644
--- a/lisp/speedbar.el
+++ b/lisp/speedbar.el
@@ -349,7 +349,7 @@ determined automatically."
(defcustom speedbar-sort-tags nil
"If non-nil, sort tags in the speedbar display. *Obsolete*.
-Use `semantic-tag-hierarchy-method' instead."
+Use `speedbar-tag-hierarchy-method' instead."
:group 'speedbar
:type 'boolean)
diff --git a/lisp/startup.el b/lisp/startup.el
index 5e0a47d3f8f..6270de2ace6 100644
--- a/lisp/startup.el
+++ b/lisp/startup.el
@@ -1259,6 +1259,12 @@ please check its value")
(setq init-file-user nil))
((member argi '("-init-directory"))
(setq user-emacs-directory (or argval (pop args))
+ user-emacs-directory (if (stringp user-emacs-directory)
+ (file-name-as-directory
+ (expand-file-name
+ user-emacs-directory
+ command-line-default-directory))
+ user-emacs-directory)
argval nil))
((member argi '("-u" "-user"))
(setq init-file-user (or argval (pop args))
diff --git a/lisp/subr.el b/lisp/subr.el
index 15662162798..21f43092d42 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -5437,7 +5437,9 @@ and replace a sub-expression, e.g.
(defsubst string-equal-ignore-case (string1 string2)
"Compare STRING1 and STRING2 case-insensitively.
Upper-case and lower-case letters are treated as equal.
-Unibyte strings are converted to multibyte for comparison."
+Unibyte strings are converted to multibyte for comparison.
+
+See also `string-equal'."
(declare (pure t) (side-effect-free t))
(eq t (compare-strings string1 0 nil string2 0 nil t)))
diff --git a/lisp/treesit.el b/lisp/treesit.el
index 0de0e283c3b..f3c03daf7e0 100644
--- a/lisp/treesit.el
+++ b/lisp/treesit.el
@@ -1614,7 +1614,12 @@ ARG is the same as in `beginning-of-defun'."
(let* ((node (treesit-search-forward
(treesit-node-at (point)) treesit-defun-type-regexp t t))
(top (treesit--defun-maybe-top-level node)))
- (goto-char (treesit-node-end top))))
+ ;; Technically `end-of-defun' should only call this function when
+ ;; point is at the beginning of a defun, so TOP should always be
+ ;; non-nil, but things happen, and we want to be safe, so check
+ ;; for TOP anyway.
+ (when top
+ (goto-char (treesit-node-end top)))))
;;; Activating tree-sitter
diff --git a/src/fns.c b/src/fns.c
index 7cc6d00afef..d8744c1a4de 100644
--- a/src/fns.c
+++ b/src/fns.c
@@ -334,7 +334,9 @@ Letter-case is significant, but text properties are
ignored. */)
DEFUN ("string-equal", Fstring_equal, Sstring_equal, 2, 2, 0,
doc: /* Return t if two strings have identical contents.
Case is significant, but text properties are ignored.
-Symbols are also allowed; their print names are used instead. */)
+Symbols are also allowed; their print names are used instead.
+
+See also `string-equal-ignore-case'. */)
(register Lisp_Object s1, Lisp_Object s2)
{
if (SYMBOLP (s1))
diff --git a/test/lisp/emacs-lisp/comp-tests.el
b/test/lisp/emacs-lisp/comp-tests.el
index 082b641fe30..418c7296948 100644
--- a/test/lisp/emacs-lisp/comp-tests.el
+++ b/test/lisp/emacs-lisp/comp-tests.el
@@ -31,25 +31,30 @@
(defmacro with-test-native-compile-prune-cache (&rest body)
(declare (indent 0) (debug t))
`(ert-with-temp-directory testdir
- (setq testdir (expand-file-name "eln-cache" testdir))
- (make-directory testdir)
- (let* ((c1 (expand-file-name "29.0.50-cur" testdir))
- (c2 (expand-file-name "29.0.50-old" testdir))
- (native-comp-eln-load-path (list testdir))
- (comp-native-version-dir "29.0.50-cur"))
- (dolist (d (list c1 c2))
- (make-directory d)
- (with-temp-file (expand-file-name "some.eln" d) (insert "foo"))
- (with-temp-file (expand-file-name "some.eln.tmp" d) (insert "foo")))
- ,@body)))
+ (let ((usr-cache (expand-file-name "eln-usr-cache" testdir))
+ (sys-cache (expand-file-name "eln-sys-cache" testdir)))
+ (make-directory usr-cache)
+ (make-directory sys-cache)
+ (let* ((c1 (expand-file-name "29.0.50-cur" usr-cache))
+ (c2 (expand-file-name "29.0.50-old" usr-cache))
+ (s1 (expand-file-name "29.0.50-cur" sys-cache))
+ (s2 (expand-file-name "preloaded" s1))
+ (native-comp-eln-load-path (list usr-cache sys-cache))
+ (comp-native-version-dir "29.0.50-cur"))
+ (dolist (d (list c1 c2 s1 s2))
+ (make-directory d)
+ (with-temp-file (expand-file-name "some.eln" d) (insert "foo"))
+ (with-temp-file (expand-file-name "some.eln.tmp" d) (insert "foo")))
+ ,@body))))
(ert-deftest test-native-compile-prune-cache ()
(skip-unless (featurep 'native-compile))
(with-test-native-compile-prune-cache
(native-compile-prune-cache)
- (should (file-directory-p c1))
- (should (file-regular-p (expand-file-name "some.eln" c1)))
- (should (file-regular-p (expand-file-name "some.eln.tmp" c1)))
+ (dolist (d (list c1 s1 s2))
+ (should (file-directory-p d))
+ (should (file-regular-p (expand-file-name "some.eln" d)))
+ (should (file-regular-p (expand-file-name "some.eln.tmp" d))))
(should-not (file-directory-p c2))
(should-not (file-regular-p (expand-file-name "some.eln" c2)))
(should-not (file-regular-p (expand-file-name "some.eln.tmp" c2)))))
@@ -57,21 +62,23 @@
(ert-deftest test-native-compile-prune-cache/delete-only-eln ()
(skip-unless (featurep 'native-compile))
(with-test-native-compile-prune-cache
- (with-temp-file (expand-file-name "keep1.txt" c1) (insert "foo"))
- (with-temp-file (expand-file-name "keep2.txt" c2) (insert "foo"))
+ (dolist (d (list c1 c2 s1 s2))
+ (with-temp-file (expand-file-name "keep.txt" d) (insert "foo")))
(native-compile-prune-cache)
- (should (file-regular-p (expand-file-name "keep1.txt" c1)))
- (should (file-regular-p (expand-file-name "keep2.txt" c2)))))
+ (dolist (d (list c1 c2 s1 s2))
+ (should (file-regular-p (expand-file-name "keep.txt" d))))))
(ert-deftest test-native-compile-prune-cache/dont-delete-in-parent-of-cache ()
(skip-unless (featurep 'native-compile))
(with-test-native-compile-prune-cache
- (let ((f1 (expand-file-name "../some.eln" testdir))
- (f2 (expand-file-name "some.eln" testdir)))
- (with-temp-file f1 (insert "foo"))
- (with-temp-file f2 (insert "foo"))
+ (let ((f1 (expand-file-name "../some.eln" usr-cache))
+ (f2 (expand-file-name "some.eln" usr-cache))
+ (f3 (expand-file-name "../some.eln" sys-cache))
+ (f4 (expand-file-name "some.eln" sys-cache)))
+ (dolist (f (list f1 f2 f3 f4))
+ (with-temp-file f (insert "foo")))
(native-compile-prune-cache)
- (should (file-regular-p f1))
- (should (file-regular-p f2)))))
+ (dolist (f (list f1 f2 f3 f4))
+ (should (file-regular-p f))))))
;;; comp-tests.el ends here
diff --git a/test/lisp/international/ucs-normalize-tests.el
b/test/lisp/international/ucs-normalize-tests.el
index 9e359d5022f..8d7ac5eb8b1 100644
--- a/test/lisp/international/ucs-normalize-tests.el
+++ b/test/lisp/international/ucs-normalize-tests.el
@@ -59,7 +59,7 @@ And NORM is one of the symbols `NFC', `NFD', `NFKC', `NFKD'
for brevity."
(NFD . ucs-normalize-NFD-region)
(NFKC . ucs-normalize-NFKC-region)
(NFKD . ucs-normalize-NFKD-region))))
- `(with-current-buffer ucs-normalize-tests--norm-buf
+ `(progn
(erase-buffer)
(insert ,str)
(,(cdr (assq norm norm-alist)) (point-min) (point-max))
@@ -74,7 +74,7 @@ And NORM is one of the symbols `NFC', `NFD', `NFKC', `NFKD'
for brevity."
(NFD . ucs-normalize-NFD-region)
(NFKC . ucs-normalize-NFKC-region)
(NFKD . ucs-normalize-NFKD-region))))
- `(with-current-buffer ucs-normalize-tests--norm-buf
+ `(progn
(erase-buffer)
(insert ,char)
(,(cdr (assq norm norm-alist)) (point-min) (point-max))
@@ -90,36 +90,37 @@ The following invariants must be true for all conformant
implementations..."
;; See `ucs-normalize-tests--rule2-holds-p'.
(aset ucs-normalize-tests--chars-part1
(aref source 0) 1))
- (and
- ;; c2 == toNFC(c1) == toNFC(c2) == toNFC(c3)
- (ucs-normalize-tests--normalization-equal-p NFC source nfc)
- (ucs-normalize-tests--normalization-equal-p NFC nfc nfc)
- (ucs-normalize-tests--normalization-equal-p NFC nfd nfc)
- ;; c4 == toNFC(c4) == toNFC(c5)
- (ucs-normalize-tests--normalization-equal-p NFC nfkc nfkc)
- (ucs-normalize-tests--normalization-equal-p NFC nfkd nfkc)
-
- ;; c3 == toNFD(c1) == toNFD(c2) == toNFD(c3)
- (ucs-normalize-tests--normalization-equal-p NFD source nfd)
- (ucs-normalize-tests--normalization-equal-p NFD nfc nfd)
- (ucs-normalize-tests--normalization-equal-p NFD nfd nfd)
- ;; c5 == toNFD(c4) == toNFD(c5)
- (ucs-normalize-tests--normalization-equal-p NFD nfkc nfkd)
- (ucs-normalize-tests--normalization-equal-p NFD nfkd nfkd)
-
- ;; c4 == toNFKC(c1) == toNFKC(c2) == toNFKC(c3) == toNFKC(c4) == toNFKC(c5)
- (ucs-normalize-tests--normalization-equal-p NFKC source nfkc)
- (ucs-normalize-tests--normalization-equal-p NFKC nfc nfkc)
- (ucs-normalize-tests--normalization-equal-p NFKC nfd nfkc)
- (ucs-normalize-tests--normalization-equal-p NFKC nfkc nfkc)
- (ucs-normalize-tests--normalization-equal-p NFKC nfkd nfkc)
-
- ;; c5 == toNFKD(c1) == toNFKD(c2) == toNFKD(c3) == toNFKD(c4) == toNFKD(c5)
- (ucs-normalize-tests--normalization-equal-p NFKD source nfkd)
- (ucs-normalize-tests--normalization-equal-p NFKD nfc nfkd)
- (ucs-normalize-tests--normalization-equal-p NFKD nfd nfkd)
- (ucs-normalize-tests--normalization-equal-p NFKD nfkc nfkd)
- (ucs-normalize-tests--normalization-equal-p NFKD nfkd nfkd)))
+ (with-current-buffer ucs-normalize-tests--norm-buf
+ (and
+ ;; c2 == toNFC(c1) == toNFC(c2) == toNFC(c3)
+ (ucs-normalize-tests--normalization-equal-p NFC source nfc)
+ (ucs-normalize-tests--normalization-equal-p NFC nfc nfc)
+ (ucs-normalize-tests--normalization-equal-p NFC nfd nfc)
+ ;; c4 == toNFC(c4) == toNFC(c5)
+ (ucs-normalize-tests--normalization-equal-p NFC nfkc nfkc)
+ (ucs-normalize-tests--normalization-equal-p NFC nfkd nfkc)
+
+ ;; c3 == toNFD(c1) == toNFD(c2) == toNFD(c3)
+ (ucs-normalize-tests--normalization-equal-p NFD source nfd)
+ (ucs-normalize-tests--normalization-equal-p NFD nfc nfd)
+ (ucs-normalize-tests--normalization-equal-p NFD nfd nfd)
+ ;; c5 == toNFD(c4) == toNFD(c5)
+ (ucs-normalize-tests--normalization-equal-p NFD nfkc nfkd)
+ (ucs-normalize-tests--normalization-equal-p NFD nfkd nfkd)
+
+ ;; c4 == toNFKC(c1) == toNFKC(c2) == toNFKC(c3) == toNFKC(c4) ==
toNFKC(c5)
+ (ucs-normalize-tests--normalization-equal-p NFKC source nfkc)
+ (ucs-normalize-tests--normalization-equal-p NFKC nfc nfkc)
+ (ucs-normalize-tests--normalization-equal-p NFKC nfd nfkc)
+ (ucs-normalize-tests--normalization-equal-p NFKC nfkc nfkc)
+ (ucs-normalize-tests--normalization-equal-p NFKC nfkd nfkc)
+
+ ;; c5 == toNFKD(c1) == toNFKD(c2) == toNFKD(c3) == toNFKD(c4) ==
toNFKD(c5)
+ (ucs-normalize-tests--normalization-equal-p NFKD source nfkd)
+ (ucs-normalize-tests--normalization-equal-p NFKD nfc nfkd)
+ (ucs-normalize-tests--normalization-equal-p NFKD nfd nfkd)
+ (ucs-normalize-tests--normalization-equal-p NFKD nfkc nfkd)
+ (ucs-normalize-tests--normalization-equal-p NFKD nfkd nfkd))))
(defsubst ucs-normalize-tests--rule2-holds-p (X)
"Check 2nd conformance rule.
@@ -127,7 +128,9 @@ For every code point X assigned in this version of Unicode
that
is not specifically listed in Part 1, the following invariants
must be true for all conformant implementations:
- X == toNFC(X) == toNFD(X) == toNFKC(X) == toNFKD(X)"
+ X == toNFC(X) == toNFD(X) == toNFKC(X) == toNFKD(X)
+
+Must be called with `ucs-normalize-tests--norm-buf' as current buffer."
(and (ucs-normalize-tests--normalization-chareq-p NFC X X)
(ucs-normalize-tests--normalization-chareq-p NFD X X)
(ucs-normalize-tests--normalization-chareq-p NFKC X X)
@@ -230,20 +233,23 @@ must be true for all conformant implementations:
(defun ucs-normalize-tests--part1-rule2 (chars-part1)
(let ((reporter (make-progress-reporter "UCS Normalize Test Part1, rule 2"
- 0 (max-char)))
- (failed-chars nil))
- (map-char-table
- (lambda (char-range listed-in-part)
- (unless (eq listed-in-part 1)
- (if (characterp char-range)
- (progn (unless (ucs-normalize-tests--rule2-holds-p char-range)
- (push char-range failed-chars))
- (progress-reporter-update reporter char-range))
- (cl-loop for char from (car char-range) to (cdr char-range)
- unless (ucs-normalize-tests--rule2-holds-p char)
- do (push char failed-chars)
- do (progress-reporter-update reporter char)))))
- chars-part1)
+ 0 (max-char t)))
+ (failed-chars nil)
+ (unicode-max (max-char t)))
+ (with-current-buffer ucs-normalize-tests--norm-buf
+ (map-char-table
+ (lambda (char-range listed-in-part)
+ (unless (eq listed-in-part 1)
+ (if (characterp char-range)
+ (progn (unless (ucs-normalize-tests--rule2-holds-p char-range)
+ (push char-range failed-chars))
+ (progress-reporter-update reporter char-range))
+ (cl-loop for char from (car char-range) to (min (cdr char-range)
+ unicode-max)
+ unless (ucs-normalize-tests--rule2-holds-p char)
+ do (push char failed-chars)
+ do (progress-reporter-update reporter char)))))
+ chars-part1))
(progress-reporter-done reporter)
failed-chars))