From d3494f1bded55a3dce3dcaee1e10a76b7b8765f4 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 10 Dec 2022 13:22:48 +0200 Subject: [PATCH] Resurrect changes omitted by a recent merge from emacs-29 (bug#59921) This includes the changes for the following commits: 670daa8b b429e524 c83c95634e7 6479691cf07 b710ca62c00 d31a2539834 a669d5fae54 f7262b8f81e fef17557365 bf81df86e52 bfc00f1c120 d2411615e8b dcf69a1d --- lisp/auth-source-pass.el | 12 ++--- lisp/erc/erc-compat.el | 8 ++-- lisp/icomplete.el | 1 - lisp/progmodes/c-ts-mode.el | 28 +++++++++++- lisp/progmodes/csharp-mode.el | 1 + lisp/progmodes/eglot.el | 65 +++++----------------------- lisp/progmodes/java-ts-mode.el | 5 +++ lisp/progmodes/json-ts-mode.el | 8 ++-- lisp/progmodes/typescript-ts-mode.el | 9 +++- lisp/textmodes/css-mode.el | 1 + lisp/treesit.el | 25 ++++++++--- src/treesit.c | 50 +++++++++++++-------- test/lisp/auth-source-pass-tests.el | 31 ++++++------- test/lisp/comint-tests.el | 16 ++++++- test/src/sqlite-tests.el | 1 + test/src/treesit-tests.el | 8 ++++ 16 files changed, 157 insertions(+), 112 deletions(-) diff --git a/lisp/auth-source-pass.el b/lisp/auth-source-pass.el index 74d38084480..fbb6944e26f 100644 --- a/lisp/auth-source-pass.el +++ b/lisp/auth-source-pass.el @@ -111,12 +111,12 @@ HOSTS can be a string or a list of strings." (defun auth-source-pass--match-regexp (s) (rx-to-string ; autoloaded `(: (or bot "/") - (or (: (? (group-n 20 (+ (not (in ?\ ?/ ,s)))) "@") - (group-n 10 (+ (not (in ?\ ?/ ?@ ,s)))) - (? ,s (group-n 30 (+ (not (in ?\ ?/ ,s)))))) - (: (group-n 11 (+ (not (in ?\ ?/ ?@ ,s)))) - (? ,s (group-n 31 (+ (not (in ?\ ?/ ,s))))) - (? "/" (group-n 21 (+ (not (in ?\ ?/ ,s))))))) + (or (: (? (group-n 20 (+ (not (in ?/ ,s)))) "@") ; user prefix + (group-n 10 (+ (not (in ?/ ?@ ,s)))) ; host + (? ,s (group-n 30 (+ (not (in ?\s ?/ ,s)))))) ; port + (: (group-n 11 (+ (not (in ?/ ?@ ,s)))) ; host + (? ,s (group-n 31 (+ (not (in ?\s ?/ ,s))))) ; port + (? "/" (group-n 21 (+ (not (in ?/ ,s))))))) ; user suffix eot) 'no-group)) diff --git a/lisp/erc/erc-compat.el b/lisp/erc/erc-compat.el index abbaafcd936..bd932547586 100644 --- a/lisp/erc/erc-compat.el +++ b/lisp/erc/erc-compat.el @@ -176,12 +176,12 @@ If START or END is negative, it counts from the end." ;; This hard codes `auth-source-pass-port-separator' to ":" (defun erc-compat--29-auth-source-pass--retrieve-parsed (seen e port-number-p) (when (string-match (rx (or bot "/") - (or (: (? (group-n 20 (+ (not (in " /:")))) "@") - (group-n 10 (+ (not (in " /:@")))) + (or (: (? (group-n 20 (+ (not (in "/:")))) "@") + (group-n 10 (+ (not (in "/:@")))) (? ":" (group-n 30 (+ (not (in " /:")))))) - (: (group-n 11 (+ (not (in " /:@")))) + (: (group-n 11 (+ (not (in "/:@")))) (? ":" (group-n 31 (+ (not (in " /:"))))) - (? "/" (group-n 21 (+ (not (in " /:"))))))) + (? "/" (group-n 21 (+ (not (in "/:"))))))) eot) e) (puthash e `( :host ,(or (match-string 10 e) (match-string 11 e)) diff --git a/lisp/icomplete.el b/lisp/icomplete.el index ef710d582d3..983931c20ca 100644 --- a/lisp/icomplete.el +++ b/lisp/icomplete.el @@ -416,7 +416,6 @@ if that doesn't produce a completion match." icomplete-scroll (not (null icomplete-vertical-mode)) completion-styles '(flex) completion-flex-nospace nil - completion-category-defaults nil completion-ignore-case t read-buffer-completion-ignore-case t read-file-name-completion-ignore-case t))) diff --git a/lisp/progmodes/c-ts-mode.el b/lisp/progmodes/c-ts-mode.el index 08b03d5666a..7b41718a745 100644 --- a/lisp/progmodes/c-ts-mode.el +++ b/lisp/progmodes/c-ts-mode.el @@ -78,6 +78,8 @@ follows the form of `treesit-simple-indent-rules'." (modify-syntax-entry ?\240 "." table) (modify-syntax-entry ?/ ". 124b" table) (modify-syntax-entry ?* ". 23" table) + (modify-syntax-entry ?\n "> b" table) + (modify-syntax-entry ?\^m "> b" table) table) "Syntax table for `c-ts-mode'.") @@ -232,7 +234,8 @@ MODE is either `c' or `cpp'." (false) @font-lock-constant-face (null) @font-lock-constant-face ,@(when (eq mode 'cpp) - '((this) @font-lock-constant-face))) + '((this) @font-lock-constant-face + (nullptr) @font-lock-constant-face))) :language mode :feature 'keyword @@ -516,9 +519,30 @@ the subtrees." (if (looking-at "\\s<\\|\n") (forward-line 1))))) +(defun c-ts-mode-indent-defun () + "Indent the current top-level declaration syntactically. + +`treesit-defun-type-regexp' defines what constructs to indent." + (interactive "*") + (let ((orig-point (point-marker))) + ;; If `treesit-beginning-of-defun' returns nil, we are not in a + ;; defun, so don't indent anything. + (when (treesit-beginning-of-defun) + (let ((start (point))) + (treesit-end-of-defun) + (indent-region start (point)))) + (goto-char orig-point))) + +(defvar-keymap c-ts-mode-map + :doc "Keymap for the C language with tree-sitter" + :parent prog-mode-map + "C-c C-q" #'c-ts-mode-indent-defun) + ;;;###autoload (define-derived-mode c-ts-base-mode prog-mode "C" - "Major mode for editing C, powered by tree-sitter." + "Major mode for editing C, powered by tree-sitter. + +\\{c-ts-mode-map}" :syntax-table c-ts-mode--syntax-table ;; Navigation. diff --git a/lisp/progmodes/csharp-mode.el b/lisp/progmodes/csharp-mode.el index 8ab5fbc91df..f08e8d6506e 100644 --- a/lisp/progmodes/csharp-mode.el +++ b/lisp/progmodes/csharp-mode.el @@ -893,6 +893,7 @@ Key bindings: ;;;###autoload (define-derived-mode csharp-ts-mode prog-mode "C#" "Major mode for editing C# code." + :syntax-table (csharp--make-mode-syntax-table) (unless (treesit-ready-p 'c-sharp) (error "Tree-sitter for C# isn't available")) diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el index c266f6e18a3..cafb99c6d80 100644 --- a/lisp/progmodes/eglot.el +++ b/lisp/progmodes/eglot.el @@ -7,7 +7,7 @@ ;; Maintainer: João Távora ;; URL: https://github.com/joaotavora/eglot ;; Keywords: convenience, languages -;; Package-Requires: ((emacs "26.3") (jsonrpc "1.0.14") (flymake "1.2.1") (project "0.3.0") (xref "1.0.1") (eldoc "1.11.0") (seq "2.23")) +;; Package-Requires: ((emacs "26.3") (jsonrpc "1.0.14") (flymake "1.2.1") (project "0.3.0") (xref "1.0.1") (eldoc "1.11.0") (seq "2.23") (external-completion "0.1")) ;; This is a GNU ELPA :core package. Avoid adding functionality ;; that is not available in the version of Emacs recorded above or any @@ -110,6 +110,7 @@ (require 'filenotify) (require 'ert) (require 'array) +(require 'external-completion) ;; ElDoc is preloaded in Emacs, so `require'-ing won't guarantee we are ;; using the latest version from GNU Elpa when we load eglot.el. Use an @@ -2060,9 +2061,11 @@ COMMAND is a symbol naming the command." (t 'eglot-note))) (mess (source code message) (concat source (and code (format " [%s]" code)) ": " message))) - (if-let ((buffer (find-buffer-visiting (eglot--uri-to-path uri)))) + (if-let* ((path (expand-file-name (eglot--uri-to-path uri))) + (buffer (find-buffer-visiting path))) (with-current-buffer buffer (cl-loop + initially (assoc-delete-all path flymake-list-only-diagnostics #'string=) for diag-spec across diagnostics collect (eglot--dbind ((Diagnostic) range code message severity source tags) diag-spec @@ -2105,7 +2108,6 @@ COMMAND is a symbol naming the command." (t (setq eglot--diagnostics diags))))) (cl-loop - with path = (expand-file-name (eglot--uri-to-path uri)) for diag-spec across diagnostics collect (eglot--dbind ((Diagnostic) code range message severity source) diag-spec (setq message (mess source code message)) @@ -2571,7 +2573,7 @@ If BUFFER, switch to it before." (let ((probe (gethash pat cache :missing))) (if (eq probe :missing) (puthash pat (refresh pat) cache) probe))) - (lookup (pat) + (lookup (pat _point) (let ((res (lookup-1 pat)) (def (and (string= pat "") (gethash :default cache)))) (append def res nil))) @@ -2579,16 +2581,12 @@ If BUFFER, switch to it before." (cl-getf (get-text-property 0 'eglot--lsp-workspaceSymbol c) :score 0))) - (lambda (string _pred action) - (pcase action - (`metadata `(metadata - (cycle-sort-function - . ,(lambda (completions) - (cl-sort completions #'> :key #'score))) - (category . eglot-indirection-joy))) - (`(eglot--lsp-tryc . ,point) `(eglot--lsp-tryc . (,string . ,point))) - (`(eglot--lsp-allc . ,_point) `(eglot--lsp-allc . ,(lookup string))) - (_ nil)))))) + (external-completion-table + 'eglot-indirection-joy + #'lookup + `((cycle-sort-function + . ,(lambda (completions) + (cl-sort completions #'> :key #'score)))))))) (defun eglot--recover-workspace-symbol-meta (string) "Search `eglot--workspace-symbols-cache' for rich entry of STRING." @@ -2600,9 +2598,6 @@ If BUFFER, switch to it before." (setq v (cdr v)))) eglot--workspace-symbols-cache))) -(add-to-list 'completion-category-overrides - '(eglot-indirection-joy (styles . (eglot--lsp-backend-style)))) - (cl-defmethod xref-backend-identifier-at-point ((_backend (eql eglot))) (let ((attempt (and (xref--prompt-p this-command) @@ -3437,42 +3432,6 @@ If NOERROR, return predicate, else erroring function." 'eglot-managed-mode-hook "1.6") (provide 'eglot) - -;;; Backend completion - -;; Written by Stefan Monnier circa 2016. Something to move to -;; minibuffer.el "ASAP" (with all the `eglot--lsp-' replaced by -;; something else. The very same code already in SLY and stable for a -;; long time. - -;; This "completion style" delegates all the work to the "programmable -;; completion" table which is then free to implement its own -;; completion style. Typically this is used to take advantage of some -;; external tool which already has its own completion system and -;; doesn't give you efficient access to the prefix completion needed -;; by other completion styles. The table should recognize the symbols -;; 'eglot--lsp-tryc and 'eglot--lsp-allc as ACTION, reply with -;; (eglot--lsp-tryc COMP...) or (eglot--lsp-allc . (STRING . POINT)), -;; accordingly. tryc/allc names made akward/recognizable on purpose. - -(add-to-list 'completion-styles-alist - '(eglot--lsp-backend-style - eglot--lsp-backend-style-try-completion - eglot--lsp-backend-style-all-completions - "Ad-hoc completion style provided by the completion table.")) - -(defun eglot--lsp-backend-style-call (op string table pred point) - (when (functionp table) - (let ((res (funcall table string pred (cons op point)))) - (when (eq op (car-safe res)) - (cdr res))))) - -(defun eglot--lsp-backend-style-try-completion (string table pred point) - (eglot--lsp-backend-style-call 'eglot--lsp-tryc string table pred point)) - -(defun eglot--lsp-backend-style-all-completions (string table pred point) - (eglot--lsp-backend-style-call 'eglot--lsp-allc string table pred point)) - ;; Local Variables: ;; bug-reference-bug-regexp: "\\(github#\\([0-9]+\\)\\)" diff --git a/lisp/progmodes/java-ts-mode.el b/lisp/progmodes/java-ts-mode.el index 96e0d5244c7..23e166ee4c3 100644 --- a/lisp/progmodes/java-ts-mode.el +++ b/lisp/progmodes/java-ts-mode.el @@ -57,6 +57,11 @@ (modify-syntax-entry ?| "." table) (modify-syntax-entry ?\' "\"" table) (modify-syntax-entry ?\240 "." table) + (modify-syntax-entry ?/ ". 124b" table) + (modify-syntax-entry ?* ". 23" table) + (modify-syntax-entry ?\n "> b" table) + (modify-syntax-entry ?\^m "> b" table) + (modify-syntax-entry ?@ "'" table) table) "Syntax table for `java-ts-mode'.") diff --git a/lisp/progmodes/json-ts-mode.el b/lisp/progmodes/json-ts-mode.el index 0a0113d1d88..a118908a00c 100644 --- a/lisp/progmodes/json-ts-mode.el +++ b/lisp/progmodes/json-ts-mode.el @@ -45,9 +45,7 @@ (defvar json-ts-mode--syntax-table (let ((table (make-syntax-table))) - ;; Taken from the cc-langs version (modify-syntax-entry ?_ "_" table) - (modify-syntax-entry ?$ "_" table) (modify-syntax-entry ?\\ "\\" table) (modify-syntax-entry ?+ "." table) (modify-syntax-entry ?- "." table) @@ -57,8 +55,12 @@ (modify-syntax-entry ?> "." table) (modify-syntax-entry ?& "." table) (modify-syntax-entry ?| "." table) - (modify-syntax-entry ?` "\"" table) + (modify-syntax-entry ?\' "\"" table) (modify-syntax-entry ?\240 "." table) + (modify-syntax-entry ?/ ". 124b" table) + (modify-syntax-entry ?* ". 23" table) + (modify-syntax-entry ?\n "> b" table) + (modify-syntax-entry ?\^m "> b" table) table) "Syntax table for `json-ts-mode'.") diff --git a/lisp/progmodes/typescript-ts-mode.el b/lisp/progmodes/typescript-ts-mode.el index 20916eaf373..243f6146ae7 100644 --- a/lisp/progmodes/typescript-ts-mode.el +++ b/lisp/progmodes/typescript-ts-mode.el @@ -44,7 +44,6 @@ (let ((table (make-syntax-table))) ;; Taken from the cc-langs version (modify-syntax-entry ?_ "_" table) - (modify-syntax-entry ?$ "_" table) (modify-syntax-entry ?\\ "\\" table) (modify-syntax-entry ?+ "." table) (modify-syntax-entry ?- "." table) @@ -54,8 +53,14 @@ (modify-syntax-entry ?> "." table) (modify-syntax-entry ?& "." table) (modify-syntax-entry ?| "." table) - (modify-syntax-entry ?` "\"" table) + (modify-syntax-entry ?\' "\"" table) (modify-syntax-entry ?\240 "." table) + (modify-syntax-entry ?/ ". 124b" table) + (modify-syntax-entry ?* ". 23" table) + (modify-syntax-entry ?\n "> b" table) + (modify-syntax-entry ?\^m "> b" table) + (modify-syntax-entry ?$ "_" table) + (modify-syntax-entry ?` "\"" table) table) "Syntax table for `typescript-ts-mode'.") diff --git a/lisp/textmodes/css-mode.el b/lisp/textmodes/css-mode.el index 8a66986dc6f..822097a86d8 100644 --- a/lisp/textmodes/css-mode.el +++ b/lisp/textmodes/css-mode.el @@ -1822,6 +1822,7 @@ Use `\\[fill-paragraph]' to reformat CSS declaration blocks. It can also be used to fill comments. \\{css-mode-map}" + :syntax-table css-mode-syntax-table (when (treesit-ready-p 'css) ;; Borrowed from `css-mode'. (add-hook 'completion-at-point-functions diff --git a/lisp/treesit.el b/lisp/treesit.el index dbbf7ec18c3..85154d0d1c7 100644 --- a/lisp/treesit.el +++ b/lisp/treesit.el @@ -833,21 +833,28 @@ The range is between START and END." (nreverse result)) (list node))) -(defun treesit--children-covering-range-recurse (node start end threshold) +(defun treesit--children-covering-range-recurse + (node start end threshold &optional limit) "Return a list of children of NODE covering a range. + Recursively go down the parse tree and collect children, until all nodes in the returned list are smaller than THRESHOLD. The -range is between START and END." +range is between START and END. + +LIMIT is the recursion limit, which defaults to 100." (let* ((child (treesit-node-first-child-for-pos node start)) + (limit (or limit 100)) result) - (while (and child (<= (treesit-node-start child) end)) + ;; If LIMIT is exceeded, we are probably seeing the erroneously + ;; tall tree, in that case, just give up. + (while (and (> limit 0) child (<= (treesit-node-start child) end)) ;; If child still too large, recurse down. Otherwise collect ;; child. (if (> (- (treesit-node-end child) (treesit-node-start child)) threshold) (dolist (r (treesit--children-covering-range-recurse - child start end threshold)) + child start end threshold (1- limit))) (push r result)) (push child result)) (setq child (treesit-node-next-sibling child))) @@ -888,6 +895,12 @@ detail.") ;; top-level nodes and query them. This ensures that querying is fast ;; everywhere else, except for the problematic region. ;; +;; Some other time the source file has a top-level node that contains +;; a huge number of children (say, 10k children), querying that node +;; is also very slow, so instead of getting the top-level node, we +;; recursively go down the tree to find nodes that cover the region +;; but are reasonably small. +;; ;; 3. It is possible to capture a node that's completely outside the ;; region between START and END: as long as the whole pattern ;; intersects the region, all the captured nodes in that pattern are @@ -917,8 +930,8 @@ If LOUDLY is non-nil, display some debugging information." ;; If we run into problematic files, use the "fast mode" to ;; try to recover. See comment #2 above for more explanation. (when treesit--font-lock-fast-mode - (setq nodes (treesit--children-covering-range - (car nodes) start end))) + (setq nodes (treesit--children-covering-range-recurse + (car nodes) start end (* 4 jit-lock-chunk-size)))) ;; Query each node. (dolist (sub-node nodes) diff --git a/src/treesit.c b/src/treesit.c index 9926806612a..8b485ca4ece 100644 --- a/src/treesit.c +++ b/src/treesit.c @@ -1642,6 +1642,17 @@ treesit_check_node (Lisp_Object obj) xsignal1 (Qtreesit_node_outdated, obj); } +/* Checks that OBJ is a positive integer and it is within the visible + portion of BUF. */ +static void +treesit_check_position (Lisp_Object obj, struct buffer *buf) +{ + treesit_check_positive_integer (obj); + ptrdiff_t pos = XFIXNUM (obj); + if (pos < BUF_BEGV (buf) || pos > BUF_ZV (buf)) + xsignal1 (Qargs_out_of_range, obj); +} + bool treesit_node_uptodate_p (Lisp_Object obj) { @@ -1990,14 +2001,12 @@ Note that this function returns an immediate child, not the smallest if (NILP (node)) return Qnil; treesit_check_node (node); - treesit_check_positive_integer (pos); struct buffer *buf = XBUFFER (XTS_PARSER (XTS_NODE (node)->parser)->buffer); ptrdiff_t visible_beg = XTS_PARSER (XTS_NODE (node)->parser)->visible_beg; ptrdiff_t byte_pos = buf_charpos_to_bytepos (buf, XFIXNUM (pos)); - if (byte_pos < BUF_BEGV_BYTE (buf) || byte_pos > BUF_ZV_BYTE (buf)) - xsignal1 (Qargs_out_of_range, pos); + treesit_check_position (pos, buf); treesit_initialize (); @@ -2028,19 +2037,14 @@ If NODE is nil, return nil. */) { if (NILP (node)) return Qnil; treesit_check_node (node); - CHECK_INTEGER (beg); - CHECK_INTEGER (end); struct buffer *buf = XBUFFER (XTS_PARSER (XTS_NODE (node)->parser)->buffer); ptrdiff_t visible_beg = XTS_PARSER (XTS_NODE (node)->parser)->visible_beg; ptrdiff_t byte_beg = buf_charpos_to_bytepos (buf, XFIXNUM (beg)); ptrdiff_t byte_end = buf_charpos_to_bytepos (buf, XFIXNUM (end)); - /* Checks for BUFFER_BEG <= BEG <= END <= BUFFER_END. */ - if (!(BUF_BEGV_BYTE (buf) <= byte_beg - && byte_beg <= byte_end - && byte_end <= BUF_ZV_BYTE (buf))) - xsignal2 (Qargs_out_of_range, beg, end); + treesit_check_position (beg, buf); + treesit_check_position (end, buf); treesit_initialize (); @@ -2426,21 +2430,24 @@ the query. */) (Lisp_Object node, Lisp_Object query, Lisp_Object beg, Lisp_Object end, Lisp_Object node_only) { - if (!NILP (beg)) - CHECK_INTEGER (beg); - if (!NILP (end)) - CHECK_INTEGER (end); - if (!(TS_COMPILED_QUERY_P (query) || CONSP (query) || STRINGP (query))) wrong_type_argument (Qtreesit_query_p, query); + treesit_initialize (); + /* Resolve NODE into an actual node. */ Lisp_Object lisp_node; if (TS_NODEP (node)) - lisp_node = node; + { + treesit_check_node (node); /* Check if up-to-date. */ + lisp_node = node; + } else if (TS_PARSERP (node)) - lisp_node = Ftreesit_parser_root_node (node); + { + treesit_check_parser (node); /* Check if deleted. */ + lisp_node = Ftreesit_parser_root_node (node); + } else if (SYMBOLP (node)) { Lisp_Object parser @@ -2452,8 +2459,6 @@ the query. */) list4 (Qor, Qtreesit_node_p, Qtreesit_parser_p, Qsymbolp), node); - treesit_initialize (); - /* Extract C values from Lisp objects. */ TSNode treesit_node = XTS_NODE (lisp_node)->node; @@ -2464,6 +2469,13 @@ the query. */) const TSLanguage *lang = ts_parser_language (XTS_PARSER (lisp_parser)->parser); + /* Check BEG and END. */ + struct buffer *buf = XBUFFER (XTS_PARSER (lisp_parser)->buffer); + if (!NILP (beg)) + treesit_check_position (beg, buf); + if (!NILP (end)) + treesit_check_position (end, buf); + /* Initialize query objects. At the end of this block, we should have a working TSQuery and a TSQueryCursor. */ TSQuery *treesit_query; diff --git a/test/lisp/auth-source-pass-tests.el b/test/lisp/auth-source-pass-tests.el index 1107e09b51b..d6d42ce942e 100644 --- a/test/lisp/auth-source-pass-tests.el +++ b/test/lisp/auth-source-pass-tests.el @@ -175,7 +175,8 @@ HOSTNAME, USER and PORT are passed unchanged to (ert-deftest auth-source-pass-any-host () (auth-source-pass--with-store '(("foo" ("port" . "foo-port") ("host" . "foo-user")) ("bar")) - (should-not (auth-source-pass-search :host t)))) + (let ((inhibit-message t)) ; silence "... does not handle host wildcards." + (should-not (auth-source-pass-search :host t))))) (ert-deftest auth-source-pass-undefined-host () (auth-source-pass--with-store '(("foo" ("port" . "foo-port") ("host" . "foo-user")) @@ -697,29 +698,29 @@ machine Libera.Chat password b ;; with slightly more realistic and less legible values. (ert-deftest auth-source-pass-extra-query-keywords--suffixed-user () - (let ((store (sort (copy-sequence '(("x.com:42/b@r" (secret . "a")) - ("b@r@x.com" (secret . "b")) + (let ((store (sort (copy-sequence '(("x.com:42/s p@m" (secret . "a")) + ("s p@m@x.com" (secret . "b")) ("x.com" (secret . "?")) - ("b@r@y.org" (secret . "c")) - ("fake.com" (secret . "?")) - ("fake.com/b@r" (secret . "d")) - ("y.org/b@r" (secret . "?")) - ("b@r@fake.com" (secret . "e")))) + ("s p@m@y.org" (secret . "c")) + ("fa ke" (secret . "?")) + ("fa ke/s p@m" (secret . "d")) + ("y.org/s p@m" (secret . "?")) + ("s p@m@fa ke" (secret . "e")))) (lambda (&rest _) (zerop (random 2)))))) (auth-source-pass--with-store store (auth-source-pass-enable) (let* ((auth-source-pass-extra-query-keywords t) - (results (auth-source-search :host '("x.com" "fake.com" "y.org") - :user "b@r" + (results (auth-source-search :host '("x.com" "fa ke" "y.org") + :user "s p@m" :require '(:user) :max 5))) (dolist (result results) (setf (plist-get result :secret) (auth-info-password result))) (should (equal results - '((:host "x.com" :user "b@r" :secret "b") - (:host "x.com" :user "b@r" :port "42" :secret "a") - (:host "fake.com" :user "b@r" :secret "e") - (:host "fake.com" :user "b@r" :secret "d") - (:host "y.org" :user "b@r" :secret "c")))))))) + '((:host "x.com" :user "s p@m" :secret "b") + (:host "x.com" :user "s p@m" :port "42" :secret "a") + (:host "fa ke" :user "s p@m" :secret "e") + (:host "fa ke" :user "s p@m" :secret "d") + (:host "y.org" :user "s p@m" :secret "c")))))))) ;; This is a more distilled version of `suffixed-user', above. It ;; better illustrates that search order takes precedence over "/user" diff --git a/test/lisp/comint-tests.el b/test/lisp/comint-tests.el index 8402c13daf3..ce1a6865b65 100644 --- a/test/lisp/comint-tests.el +++ b/test/lisp/comint-tests.el @@ -59,9 +59,23 @@ (dolist (str comint-testsuite-password-strings) (should (string-match comint-password-prompt-regexp str)))) +(declare-function w32-application-type "w32proc.c") +(defun w32-native-executable-p (fname) + "Predicate to test program FNAME for being a native Windows application." + (and (memq (w32-application-type fname) '(w32-native dos)) + (file-executable-p fname))) + +(defun w32-native-executable-find (name) + "Find a native MS-Windows application named NAME. +This is needed to avoid invoking MSYS or Cygwin executables that +happen to lurk on PATH when running the test suite." + (locate-file name exec-path exec-suffixes 'w32-native-executable-p)) + (defun comint-tests/test-password-function (password-function) "PASSWORD-FUNCTION can return nil or a string." - (when-let ((cat (executable-find "cat"))) + (when-let ((cat (if (eq system-type 'windows-nt) + (w32-native-executable-find "cat") + (executable-find "cat")))) (let ((comint-password-function password-function)) (cl-letf (((symbol-function 'read-passwd) (lambda (&rest _args) "non-nil"))) diff --git a/test/src/sqlite-tests.el b/test/src/sqlite-tests.el index e9ddf9c0bef..a2472c43dad 100644 --- a/test/src/sqlite-tests.el +++ b/test/src/sqlite-tests.el @@ -36,6 +36,7 @@ (declare-function sqlite-select "sqlite.c") (declare-function sqlite-open "sqlite.c") (declare-function sqlite-load-extension "sqlite.c") +(declare-function sqlite-version "sqlite.c") (ert-deftest sqlite-select () (skip-unless (sqlite-available-p)) diff --git a/test/src/treesit-tests.el b/test/src/treesit-tests.el index 80fde408cd3..aba12759c34 100644 --- a/test/src/treesit-tests.el +++ b/test/src/treesit-tests.el @@ -143,6 +143,8 @@ (treesit-node-string (treesit-node-first-child-for-pos doc-node 3)))) + (should-error (treesit-node-first-child-for-pos doc-node 100) + :type 'args-out-of-range) ;; `treesit-node-descendant-for-range'. (should (equal "(\"{\")" (treesit-node-string @@ -152,6 +154,9 @@ (treesit-node-string (treesit-node-descendant-for-range root-node 6 7 t)))) + (should-error (treesit-node-descendant-for-range + root-node 100 101) + :type 'args-out-of-range) ;; `treesit-node-eq'. (should (treesit-node-eq root-node root-node)) (should (not (treesit-node-eq root-node doc-node)))))) @@ -167,6 +172,9 @@ (setq root-node (treesit-parser-root-node parser))) + (should-error (treesit-query-capture root-node "" 100 101) + :type 'args-out-of-range) + ;; Test `treesit-query-capture' on string, sexp and compiled ;; queries. (dolist (query1 -- 2.39.2