Github/emacs
2
0
Fork 1
mirror of git://git.sv.gnu.org/emacs.git synced 2026-06-14 04:21:24 +00:00
Code Issues Projects Releases Packages Wiki Activity

Merge from origin/emacs-31

Browse source 
28a13b01c7 vc-refresh-state: Override default-directory for backend ...
389874c533 Eglot: unbreak for treesit-less builds
10e91e096d Get selected item in newsticker list view
6bd73af241 ; * test/lisp/jsonrpc-tests.el: Adjust timeouts for CI EM...
eb90c528f3 ; * lisp/progmodes/eglot.el (eglot-code-action-indication...
1d7d6ffedb ; * etc/PROBLEMS: Fix entries about display of Emoji on T...
6c1829bf4c Eglot: fix thinko in recent markdown-related commit (bug#...
36036e71c0 Jsonrpc: migrate more tests to Python subprocess fixtures
0977d5915d Eglot: add left-fringe code action indicator (bug#80326)
b7825c3a27 Fix auth-source-backends-parse
d89054627c Fix updates of embedded formulas by 'calc-embedded-update...
1832a93547 ; * src/fns.c (Fequal): Doc fix.
f68e7a0a41 ; Improve documentation of commands that move by compilat...
This commit is contained in:
Sean Whitton 2026-05-18 22:16:46 +01:00
commit 641754e870
17 changed files with 320 additions and 268 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

72
etc/PROBLEMS
View file

@ -2649,6 +2649,45 @@ all such characters will look the same on display, and the only way of
knowing what is the real codepoint in the buffer is to go to the
character and type "C-u C-x =".
*** Display problems with Emoji on text terminals
Some text-mode terminals cause problems with Emoji sequences: when
displaying them, the Emacs text-mode frame could show gaps, misalignment
between the display and cursor motion, and other visual artifacts and
display problems.
This can happen if the terminal and Emacs differ in their notions of how
many columns (a.k.a. "character cells") a given sequence of characters
takes on the screen when displayed. As one example, Emoji sequences
that begin with a non-Emoji character and end in U+FE0F VARIATION
SELECTOR 16 are composed on display into an Emoji glyph, but the width
of this glyph is up to the terminal and the font it uses to show the
Emoji. If the non-Emoji character that begins the sequence has the
width 1, Emacs will think that its composition with VS-16 also takes 1
column on the screen, because VS-16 has width of zero. But some
terminals which support Emoji sequences will show a double-width Emoji
glyph in this case, without any way for Emacs to know that. This causes
cursor addressing to get out of sync and eventually messes up the
display. In particular, Kitty, Alacritty, Ghostty, and some other
terminal emulators are known to behave like that.
Similar problems can happen with composition of characters other than
Emoji.
The solution is to disable 'auto-composition-mode' on these
terminals, for example, like this:
(setq auto-composition-mode "alacritty")
This disables 'auto-composition-mode' on frames that display on
terminals of the named type. More generally, customizing the
'auto-composition-mode' variable to have as value a string that the
'tty-type' function returns on a terminal will disable compositions in
windows shown on terminals of that type. (You can also disable
'auto-composition-mode' globally, if all your frames are on terminals
that have this problem, by setting 'auto-composition-mode' to the nil
value.)
*** Messed-up display on the Kitty text terminal
This terminal has its own peculiar ideas about display of unusual
@ -2674,33 +2713,6 @@ Another workaround is to set 'nobreak-char-ascii-display' to a non-nil
value, which will cause any non-ASCII space and hyphen characters to
be displayed as their ASCII counterparts, with a special face.
Kitty also differs from many other character terminals in how it
handles character compositions. As one example, Emoji sequences that
begin with a non-Emoji character and end in U+FE0F VARIATION SELECTOR
16 should be composed into an Emoji glyph; Kitty assumes that all such
Emoji glyphs have 2-column width, whereas Emacs and many other text
terminals display them as 1-column glyphs. Again, this causes cursor
addressing to get out of sync and eventually messes up the display.
One possible workaround for problems caused by character composition
is to turn off 'auto-composition-mode' on Kitty terminals, e.g. by
customizing the 'auto-composition-mode' variable to have as value a
string that the 'tty-type' function returns on those terminals.
*** Display artifacts on the Alacritty text terminal
This terminal is known to cause problems with Emoji sequences: when
displaying them, the Emacs text-mode frame could show gaps and other
visual artifacts.
The solution is to disable 'auto-composition-mode' on these
terminals, for example, like this:
(setq auto-composition-mode "alacritty")
This disables 'auto-composition-mode' on frames that display on
terminals of this type.
** Screen readers get confused about character position
The Emacs display code sometimes emits TAB characters purely for motion
@ -2713,6 +2725,12 @@ This can confuse screen reader software under certain terminal emulators
in the terminal before starting Emacs may mitigate this. See also the
discussion in Bug#78474 <https://debbugs.gnu.org/78474>.
Starting from version 31.1, Emacs by default no longer outputs series of
TAB characters followed by BACKSPACE, which used to confuse some of the
screen readers. If you encounter some problems in this area, verify
that the variable 'tty-cursor-movement-use-TAB-BS' is set to its default
nil value.
* Runtime problems specific to individual Unix variants
** GNU/Linux

20
lisp/auth-source.el
View file

@ -361,9 +361,19 @@ soon as a function returns non-nil.")
(defun auth-source-backend-parse (entry)
"Create an `auth-source-backend' from an ENTRY in `auth-sources'."
(let ((backend
(run-hook-with-args-until-success 'auth-source-backend-parser-functions
entry)))
(let* ((auth-source-backend-parser-functions
;; The functions shall drop backends of type `ignore', in
;; order to let the hook continue.
(mapcar
(lambda (fun)
`(lambda (entry)
(and-let* ((result (funcall ',fun entry))
((not (eq (slot-value result 'type) 'ignore)))
result))))
auth-source-backend-parser-functions))
(backend
(run-hook-with-args-until-success
'auth-source-backend-parser-functions entry)))
(unless backend
;; none of the parsers worked
@ -378,12 +388,12 @@ soon as a function returns non-nil.")
"List of usable backends from `auth-sources'.
Filter out backends with type `ignore'.
A fallback backend is added to ensure, that at least `read-passwd' is called."
`(or (seq-keep
`(or (seq-uniq (seq-keep
(lambda (entry)
(and-let* ((backend (auth-source-backend-parse entry))
((not (eq (slot-value backend 'type) 'ignore)))
backend)))
auth-sources)
auth-sources))
;; Fallback.
(list (auth-source-backend
:source ""

6
lisp/calc/calc-embed.el
View file

@ -103,7 +103,8 @@
;; 3 Bottom of current formula (marker).
;; 4 Top of current formula's delimiters (marker).
;; 5 Bottom of current formula's delimiters (marker).
;; 6 String representation of current formula.
;; 6 String representation of current formula (actually, the
;; buffer-substring between positions given by 2 and 3 above.
;; 7 Non-nil if formula is embedded within a single line.
;; 8 Internal representation of current formula.
;; 9 Variable assigned by this formula, or nil.
@ -1140,7 +1141,8 @@ The command \\[yank] can retrieve it from there."
(insert str)
(set-marker (aref info 3) (+ (point) adjbot))
(set-marker (aref info 5) (+ (point) delta))
(aset info 6 str))))))
(aset info 6 (buffer-substring (aref info 2)
(aref info 3))))))))
(if (eq (car-safe val) 'calcFunc-evalto)
(progn
(setq evalled (nth 2 val)

6
lisp/net/newst-treeview.el
View file

@ -1387,8 +1387,10 @@ Will move to previous feed until an item is found."
(defun newsticker--treeview-get-selected-item ()
"Return item that is currently selected in list buffer."
(with-current-buffer (newsticker--treeview-list-buffer)
(beginning-of-line)
(get-text-property (point) :nt-item)))
(goto-char (point-min))
(if-let* ((selected (text-property-search-forward :nt-selected t t)))
(get-text-property (prop-match-beginning selected) :nt-item)
(get-text-property (point-min) :nt-item))))
(defun newsticker-treeview-mark-item-old (&optional dont-proceed)
"Mark current item as old unless it is obsolete.

17
lisp/progmodes/compile.el
View file

@ -2821,13 +2821,23 @@ and runs `compilation-filter-hook'."
(defun compilation-next-error (n &optional different-file pt)
"Move point to the next error in the compilation buffer.
This function does NOT find the source line like \\[next-error].
This function does NOT find the source line like \\[next-error],
but you can use \\[compilation-display-error] to find and
display the corresponding source code.
Prefix arg N says how many error messages to move forwards (or
backwards, if negative).
Where the current error ends and the next one begins is determined
by the rules from `compilation-error-regexp-alist' that matched
the compilation messages; this function moves point to where
the \\+`compilation-message' text property changes its value.
In general, all the messages that have the same line and column
numbers are considered parts of a single compilation message.
Optional arg DIFFERENT-FILE, if non-nil, means find next error for a
file that is different from the current one.
Optional arg PT, if non-nil, specifies the value of point to start
looking for the next message."
looking for the next message.
In interacvtive invocations, DIFFERENT-FILE and PT are always nil."
(interactive "p")
(or (compilation-buffer-p (current-buffer))
(error "Not in a compilation buffer"))
@ -2871,7 +2881,8 @@ looking for the next message."
"Move point to the previous error in the compilation buffer.
Prefix arg N says how many error messages to move backwards (or
forwards, if negative).
Does NOT find the source line like \\[previous-error]."
Does NOT find the source line like \\[previous-error].
This is like `compilation-next-error', but moves in the other direction."
(interactive "p")
(compilation-next-error (- n)))

71
lisp/progmodes/eglot.el
View file

@ -595,15 +595,16 @@ servers."
:type 'boolean)
(defface eglot-code-action-indicator-face
'((t (:inherit font-lock-escape-face :weight bold)))
'((t (:inherit warning :weight bold)))
"Face used for code action suggestions.")
(defcustom eglot-code-action-indications
'(eldoc-hint margin)
'(eldoc-hint left-fringe margin)
"How Eglot indicates there's are code actions available at point.
Value is a list of symbols, more than one can be specified:
- `eldoc-hint': ElDoc is used to hint about at-point actions;
- `left-fringe': A special indicator appears on the left fringe;
- `margin': A special indicator appears in the margin;
- `nearby': A special indicator appears near point;
- `mode-line': A special indicator appears in the mode-line.
@ -612,15 +613,19 @@ If the list is empty, Eglot will not hint about code actions at point.
Note additionally:
- `margin' and `nearby' are incompatible. If both are specified,
the latter takes priority;
- `mode-line' only works if `eglot-mode-line-action-suggestion' exists in
`eglot-mode-line-format' (which see)."
- Some values are incompatible; if one or more of `nearby',
`left-fringe' and `margin' are specified, earlier values take
precedence.
- The indicators for many of these are customizable via
`eglot-code-action-indicator' (which see), except for `left-fringe'.
- `mode-line' only works if `eglot-mode-line-action-suggestion' exists
in `eglot-mode-line-format' (which see)."
:type '(set
:tag "Tick the ones you're interested in"
(const :tag "ElDoc textual hint" eldoc-hint)
(const :tag "Right besides point" nearby)
(const :tag "In mode line" mode-line)
(const :tag "In left fringe" left-fringe)
(const :tag "In margin" margin))
:package-version '(Eglot . "1.19"))
@ -721,11 +726,15 @@ This can be useful when using docker to run a language server.")
(executable-find command)))
(declare-function treesit-grammar-location "treesit.c")
(defun eglot--builtin-mdown-p ()
(and (fboundp 'markdown-ts-view-mode)
(fboundp 'treesit-grammar-location)
(treesit-grammar-location 'markdown)))
(defun eglot--accepted-formats ()
(if (and (not eglot-prefer-plaintext)
(or (fboundp 'gfm-view-mode)
(and (fboundp 'markdown-ts-view-mode)
(treesit-grammar-location 'markdown))))
(or (fboundp 'gfm-view-mode) (eglot--builtin-mdown-p)))
["markdown" "plaintext"]
["plaintext"]))
@ -2232,9 +2241,7 @@ Doubles as an indicator of snippet support."
(cl-defun eglot--format-markup
(markup &optional mode
&aux string lang render extract
(built-in (and (fboundp 'markdown-ts-view-mode)
(treesit-grammar-location 'markdown))))
&aux string lang render extract)
"Format MARKUP according to LSP's spec.
MARKUP is either an LSP MarkedString or MarkupContent object.
If MODE, force MODE to be used for fontifying MARKUP."
@ -2251,12 +2258,13 @@ If MODE, force MODE to be used for fontifying MARKUP."
for to = (or (next-single-property-change from 'invisible)
(point-max))
when inv
do (put-text-property from to 'invisible t)))
do (put-text-property from to 'invisible t)
finally return (buffer-string)))
(calc2 (forced-mode)
(cond
(forced-mode `(,forced-mode))
(built-in `(,#'markdown-ts-view-mode))
((fboundp 'gfm-view-mode) `(,#'gfm-view-mode #'gfm-extract))
((eglot--builtin-mdown-p) `(,#'markdown-ts-view-mode))
((fboundp 'gfm-view-mode) `(,#'gfm-view-mode ,#'gfm-extract))
(t `(#'text-mode))))
(calc (s &optional (forced-mode mode) &aux (x (calc2 forced-mode)))
(setq string s render (car x) extract (or (cadr x) #'buffer-string))))
@ -4720,6 +4728,19 @@ at point. With prefix argument, prompt for ACTION-KIND."
(eglot--code-action eglot-code-action-rewrite "refactor.rewrite")
(eglot--code-action eglot-code-action-quickfix "quickfix")
(define-fringe-bitmap 'eglot--fringe-action
[#b00000111
#b00001110
#b00011100
#b00111000
#b01111111
#b00001110
#b01011100
#b01111000
#b01110000
#b01111000]
nil nil 'center)
(defun eglot-code-action-suggestion (cb &rest _ignored)
"A member of `eldoc-documentation-functions', for suggesting actions."
(when (and (eglot-server-capable :codeActionProvider)
@ -4759,13 +4780,19 @@ at point. With prefix argument, prompt for ACTION-KIND."
(overlay-put
ov
'before-string
(cond ((memq 'nearby eglot-code-action-indications)
tooltip)
((memq 'margin eglot-code-action-indications)
(propertize "⚡"
'display
`((margin left-margin)
,tooltip)))))
(cond
((memq 'nearby eglot-code-action-indications)
tooltip)
((and
(memq 'left-fringe eglot-code-action-indications)
(< 0 (nth 0 (window-fringes))))
(propertize
"⚡" 'display `(left-fringe
eglot--fringe-action
eglot-code-action-indicator-face)))
((memq 'margin eglot-code-action-indications)
(propertize
"⚡" 'display `((margin left-margin) ,tooltip)))))
(setq eglot--suggestion-overlay ov))))
(when use-text-p (funcall cb blurb))))
:hint :textDocument/codeAction)

5
lisp/simple.el
View file

@ -362,7 +362,10 @@ until you use it in some other buffer that uses Compilation mode
or Compilation Minor mode.
To control which errors are matched, customize the variable
`compilation-error-regexp-alist'."
`compilation-error-regexp-alist'. The rules there determine the
boundaries between error messages. In general, messages that share
the same line and column numbers are considered parts of a single
error message."
(interactive "P")
(if (consp arg) (setq reset t arg nil))
(let ((buffer (next-error-find-buffer)))

14
lisp/vc/vc-hooks.el
View file

@ -955,10 +955,16 @@ In the latter case, VC mode is deactivated for this buffer."
(cond
((setq backend (with-demoted-errors "VC refresh error: %S"
(vc-backend buffer-file-name)))
;; Let the backend setup any buffer-local things he needs.
(vc-call-backend backend 'find-file-hook)
;; Compute the state and put it in the mode line.
(vc-mode-line buffer-file-name backend)
;; When `auto-revert-handler' calls us then `default-directory'
;; may be let-bound to something else for the purpose of some
;; command that's currently doing some minibuffer prompting.
;; Backend find-file-hook and mode-line-string functions should
;; not need to be written so as to handle that possibility.
(let ((default-directory (buffer-local-toplevel-value 'default-directory)))
;; Let the backend setup any buffer-local things it needs.
(vc-call-backend backend 'find-file-hook)
;; Compute the state and put it in the mode line.
(vc-mode-line buffer-file-name backend))
(unless vc-make-backup-files
;; Use this variable, not make-backup-files,
;; because this is for things that depend on the file name.

3
src/fns.c
View file

@ -2804,7 +2804,8 @@ DEFUN ("equal", Fequal, Sequal, 2, 2, 0,
doc: /* Return t if two Lisp objects have similar structure and contents.
They must have the same data type.
Conses are compared by comparing the cars and the cdrs.
Vectors and strings are compared element by element.
Vectors and strings are compared element by element (so text properties
of strings are ignored).
Numbers are compared via `eql', so integers do not equal floats.
\(Use `=' if you want integers and floats to be able to be equal.)
Symbols must match exactly. */)

9
test/lisp/jsonrpc-resources/common.py
View file

@ -30,3 +30,12 @@ def write_msg(msg):
def log(text):
"""Write a log line to stderr."""
print(f'[test-server] {text}', file=sys.stderr, flush=True)
def harakiri(msg):
"""Maybe handle harakiri request/notif in msg."""
if msg.get('method') == 'harakiri':
log('-> very clean harakiri')
if (mid := msg.get('id')) is not None:
write_msg({'jsonrpc': '2.0', 'id': mid, 'result': True})
return True
return False

6
test/lisp/jsonrpc-resources/server-anxious-nested.py
View file

@ -15,7 +15,7 @@
import os
import sys
sys.path.insert(0, os.path.dirname(__file__))
from common import read_msg, write_msg, log
from common import read_msg, write_msg, log, harakiri
def main():
@ -26,9 +26,7 @@ def main():
mid = lr1.get('id')
method = lr1.get('method')
log(f'<- {method or "(response)"} id={mid}')
if method == 'harakiri':
log('-> very clean harakiri')
break
if harakiri(lr1): break
elif method == 'LR1':
# Send RR1, then immediately respond to LR1 without awaiting
# anything. The response-to-LR1 will be queued as anxious on the

54
test/lisp/jsonrpc-resources/server-emacsrpc.py Normal file
View file

@ -0,0 +1,54 @@
#!/usr/bin/env python3
"""General-purpose JSONRPC server for jsonrpc.el tests.
Handles arithmetic (+ - * /), sit-for, vconcat, append, and ignore,
mirroring the methods the in-process Emacs RPC server supports.
"""
import functools
import operator
import os
import sys
import time
sys.path.insert(0, os.path.dirname(__file__))
from common import log, read_msg, write_msg, harakiri
HANDLERS = {
'+': lambda p: sum(p),
'-': lambda p: functools.reduce(operator.sub, p),
'*': lambda p: functools.reduce(operator.mul, p),
'/': lambda p: functools.reduce(operator.truediv, p),
'vconcat': lambda p: sum(p, []),
'append': lambda p: sum(p, []),
'sit-for': lambda p: time.sleep(p[0]),
'ignore': lambda _: None,
}
def main():
while True:
msg = read_msg()
if msg is None:
break
mid = msg.get('id')
method = msg.get('method')
log(f'<- {method or "(response)"} id={mid}')
if harakiri(msg): break
if method is None or mid is None:
continue
handler = HANDLERS.get(method)
if handler is None:
write_msg({'jsonrpc': '2.0', 'id': mid,
'error': {'code': -32601, 'message': 'Method not found'}})
else:
try:
result = handler(msg.get('params', []))
write_msg({'jsonrpc': '2.0', 'id': mid, 'result': result})
log(f'-> (response {method}) id={mid}')
except Exception as exc:
write_msg({'jsonrpc': '2.0', 'id': mid,
'error': {'code': -32603, 'message': str(exc)}})
if __name__ == '__main__':
main()

6
test/lisp/jsonrpc-resources/server-harakiri.py
View file

@ -5,7 +5,7 @@
"""
import os, sys
sys.path.insert(0, os.path.dirname(__file__))
from common import read_msg, log
from common import read_msg, log, harakiri
def main():
@ -15,9 +15,7 @@ def main():
break
method = msg.get('method')
log(f'<- {method or "(response)"} id={msg.get("id")}')
if method == 'harakiri':
log('-> very clean harakiri')
break
if harakiri(msg): break
if __name__ == '__main__':

6
test/lisp/jsonrpc-resources/server-remote-during-sync-1.py
View file

@ -11,7 +11,7 @@
import os
import sys
sys.path.insert(0, os.path.dirname(__file__))
from common import read_msg, write_msg, log
from common import read_msg, write_msg, log, harakiri
def main():
@ -22,9 +22,7 @@ def main():
mid = msg.get('id')
method = msg.get('method')
log(f'<- {method or "(response)"} id={mid}')
if method == 'harakiri':
log('-> very clean harakiri')
break
if harakiri(msg): break
elif method == 'LR1':
# Send RR1 request
write_msg({'jsonrpc': '2.0', 'id': 1000,

6
test/lisp/jsonrpc-resources/server-remote-during-sync-2.py
View file

@ -11,7 +11,7 @@
import os
import sys
sys.path.insert(0, os.path.dirname(__file__))
from common import read_msg, write_msg, log
from common import read_msg, write_msg, log, harakiri
def main():
@ -22,9 +22,7 @@ def main():
mid = msg.get('id')
method = msg.get('method')
log(f'<- {method or "(response)"} id={mid}')
if method == 'harakiri':
log('-> very clean harakiri')
break
if harakiri(msg): break
elif method == 'LR1':
# Send RR1 request
write_msg({'jsonrpc': '2.0', 'id': 1000,

6
test/lisp/jsonrpc-resources/server-remote-error.py
View file

@ -13,7 +13,7 @@
"""
import os, sys
sys.path.insert(0, os.path.dirname(__file__))
from common import read_msg, write_msg, log
from common import read_msg, write_msg, log, harakiri
def main():
@ -24,9 +24,7 @@ def main():
mid = msg.get('id')
method = msg.get('method')
log(f'<- {method or "(response)"} id={mid}')
if method == 'harakiri':
log('-> very clean harakiri')
break
if harakiri(msg): break
elif method == 'LR1':
# Send badMethod BEFORE responding to LR1; the client
# rdispatcher will signal a jsonrpc-error for it.

281
test/lisp/jsonrpc-tests.el
View file

@ -41,121 +41,55 @@
(defclass jsonrpc--test-client (jsonrpc--test-endpoint)
((hold-deferred :initform t :accessor jsonrpc--hold-deferred)))
(defun jsonrpc--call-with-emacsrpc-fixture (fn)
"Do work for `jsonrpc--with-emacsrpc-fixture'. Call FN."
(let* (listen-server endpoint)
(unwind-protect
(progn
(setq listen-server
(make-network-process
:name "Emacs RPC server" :server t :host "localhost"
:service (if (version<= emacs-version "26.1")
44444
;; 26.1 can automatically find ports if
;; one passes 0 here.
0)
:log (lambda (listen-server client _message)
(push
(make-instance
'jsonrpc--test-endpoint
:name (process-name client)
:process client
:request-dispatcher
(lambda (_endpoint method params)
(unless (memq method '(+ - * / vconcat append
sit-for ignore))
(signal 'jsonrpc-error
'((jsonrpc-error-message
. "Sorry, this isn't allowed")
(jsonrpc-error-code . -32601))))
(apply method (append params nil)))
:on-shutdown
(lambda (conn)
(setf (jsonrpc--shutdown-complete-p conn) t)))
(process-get listen-server 'handlers)))))
(setq endpoint
(make-instance
'jsonrpc--test-client
:process
(open-network-stream "JSONRPC test tcp endpoint"
nil "localhost"
(process-contact listen-server
:service))
:on-shutdown
(lambda (conn)
(setf (jsonrpc--shutdown-complete-p conn) t))))
(funcall fn endpoint))
(unwind-protect
(when endpoint
(kill-buffer (jsonrpc--events-buffer endpoint))
(jsonrpc-shutdown endpoint))
(when listen-server
(cl-loop do (delete-process listen-server)
while (progn (accept-process-output nil 0.1)
(process-live-p listen-server))
do (jsonrpc--message
"test listen-server is still running, waiting"))
(cl-loop for handler in (process-get listen-server 'handlers)
do (ignore-errors (jsonrpc-shutdown handler)))
(mapc #'kill-buffer
(mapcar #'jsonrpc--events-buffer
(process-get listen-server 'handlers))))))))
(cl-defmacro jsonrpc--with-emacsrpc-fixture ((endpoint-sym) &body body)
;;; Tests using Python subprocesses
;;;
(defconst jsonrpc--test-dir
(file-name-directory (or load-file-name buffer-file-name))
"Directory of this test file, captured at load time.")
(cl-defmacro jsonrpc--with-python-fixture ((script conn &rest initargs) &body body)
"Start SCRIPT under python3 as a pipe subprocess, bind connection to CONN.
SCRIPT is a path relative to this file's directory.
INITARGS are passed to `make-instance' for `jsonrpc--test-client'."
(declare (indent 1))
`(jsonrpc--call-with-emacsrpc-fixture (lambda (,endpoint-sym) ,@body)))
(ert-deftest returns-3 ()
"A basic test for adding two numbers in our test RPC."
(skip-when (eq system-type 'windows-nt))
(jsonrpc--with-emacsrpc-fixture (conn)
(should (= 3 (jsonrpc-request conn '+ [1 2])))))
(ert-deftest errors-with--32601 ()
"Errors with -32601"
(skip-when (eq system-type 'windows-nt))
(jsonrpc--with-emacsrpc-fixture (conn)
(condition-case err
(progn
(jsonrpc-request conn 'delete-directory "~/tmp")
(ert-fail "A `jsonrpc-error' should have been signaled!"))
(jsonrpc-error
(should (= -32601 (cdr (assoc 'jsonrpc-error-code (cdr err)))))))))
(ert-deftest signals-an--32603-JSONRPC-error ()
"Signals an -32603 JSONRPC error."
(skip-when (eq system-type 'windows-nt))
(jsonrpc--with-emacsrpc-fixture (conn)
(condition-case err
(let ((jsonrpc-inhibit-debug-on-error t))
(jsonrpc-request conn '+ ["a" 2])
(ert-fail "A `jsonrpc-error' should have been signaled!"))
(jsonrpc-error
(should (= -32603 (cdr (assoc 'jsonrpc-error-code (cdr err)))))))))
(ert-deftest times-out ()
"Request for 3-sec sit-for with 1-sec timeout times out."
(skip-when (eq system-type 'windows-nt))
(jsonrpc--with-emacsrpc-fixture (conn)
(should-error
(jsonrpc-request conn 'sit-for [3] :timeout 1))))
(ert-deftest doesnt-time-out ()
:tags '(:expensive-test)
"Request for 1-sec sit-for with 2-sec timeout succeeds."
(skip-when (eq system-type 'windows-nt))
(jsonrpc--with-emacsrpc-fixture (conn)
(jsonrpc-request conn 'sit-for [1] :timeout 2)))
(ert-deftest stretching-it-but-works ()
"Vector of numbers or vector of vector of numbers are serialized."
(skip-when (eq system-type 'windows-nt))
(jsonrpc--with-emacsrpc-fixture (conn)
;; (vconcat [1 2 3] [3 4 5]) => [1 2 3 3 4 5] which can be
;; serialized.
(should (equal
[1 2 3 3 4 5]
(jsonrpc-request conn 'vconcat [[1 2 3] [3 4 5]])))))
`(let ((,conn nil))
(skip-unless (executable-find "python3"))
(unwind-protect
(progn
(setq ,conn
(make-instance
'jsonrpc--test-client
:name "jsonrpc-python-test"
:process (make-process
:name "jsonrpc-python-test"
:command (list "python3"
(expand-file-name
,script
jsonrpc--test-dir))
:connection-type 'pipe
:noquery t)
,@initargs))
(with-timeout (5
(when ,conn
(let ((buf (jsonrpc--events-buffer ,conn)))
(when (buffer-live-p buf)
(if noninteractive
(progn
(message "contents of `%s':" (buffer-name buf))
(princ (with-current-buffer buf (buffer-string))
#'external-debugging-output))
(message "Preserved for inspection: %s"
(buffer-name buf))))))
(ert-fail "Test timed out after 5s"))
,@body))
(when ,conn
(ignore-errors
(jsonrpc-request ,conn 'harakiri nil :timeout 1)
(accept-process-output nil 0.1)
(kill-buffer (jsonrpc--events-buffer ,conn))
(jsonrpc-shutdown ,conn))))))
(cl-defmethod jsonrpc-connection-ready-p
((conn jsonrpc--test-client) what)
@ -163,11 +97,46 @@
(or (not (string-match "deferred" what))
(not (jsonrpc--hold-deferred conn)))))
(ert-deftest returns-3 ()
"A basic test for adding two numbers in our test RPC."
(skip-when (eq system-type 'windows-nt))
(jsonrpc--with-python-fixture
("jsonrpc-resources/server-emacsrpc.py" conn)
(should (= 3 (jsonrpc-request conn '+ [1 2])))))
(ert-deftest times-out ()
"Request for 3-sec sit-for with 1-sec timeout times out."
(skip-when (eq system-type 'windows-nt))
(jsonrpc--with-python-fixture
("jsonrpc-resources/server-emacsrpc.py" conn)
(should-error
(jsonrpc-request conn 'sit-for [3] :timeout 1))))
(ert-deftest doesnt-time-out ()
:tags '(:expensive-test)
"Request for 1-sec sit-for with 2-sec timeout succeeds."
(skip-when (eq system-type 'windows-nt))
(jsonrpc--with-python-fixture
("jsonrpc-resources/server-emacsrpc.py" conn)
(jsonrpc-request conn 'sit-for [1] :timeout 2)))
(ert-deftest stretching-it-but-works ()
"Vector of numbers or vector of vector of numbers are serialized."
(skip-when (eq system-type 'windows-nt))
(jsonrpc--with-python-fixture
("jsonrpc-resources/server-emacsrpc.py" conn)
;; (vconcat [1 2 3] [3 4 5]) => [1 2 3 3 4 5] which can be
;; serialized.
(should (equal
[1 2 3 3 4 5]
(jsonrpc-request conn 'vconcat [[1 2 3] [3 4 5]])))))
(ert-deftest deferred-action-toolate ()
:tags '(:expensive-test)
"Deferred request fails because no one clears the flag."
(skip-when (eq system-type 'windows-nt))
(jsonrpc--with-emacsrpc-fixture (conn)
(jsonrpc--with-python-fixture
("jsonrpc-resources/server-emacsrpc.py" conn)
(should-error
(jsonrpc-request conn '+ [1 2]
:deferred "deferred-testing" :timeout 0.5)
@ -182,7 +151,8 @@
(skip-when (eq system-type 'windows-nt))
;; Send an async request, which returns immediately. However the
;; success fun which sets the flag only runs after some time.
(jsonrpc--with-emacsrpc-fixture (conn)
(jsonrpc--with-python-fixture
("jsonrpc-resources/server-emacsrpc.py" conn)
(jsonrpc-async-request conn
'sit-for [0.5]
:success-fn
@ -199,32 +169,34 @@
:tags '(:expensive-test)
"Test a more complex situation with deferred requests."
(skip-when (eq system-type 'windows-nt))
(jsonrpc--with-emacsrpc-fixture (conn)
(jsonrpc--with-python-fixture
("jsonrpc-resources/server-emacsrpc.py" conn)
(let (n-deferred-1
n-deferred-2
second-deferred-went-through-p)
;; This returns immediately
(jsonrpc-async-request
conn
'sit-for [0.1]
'sit-for [0.01]
:success-fn
(lambda (_result)
;; this only gets runs after the "first deferred" is stashed.
(setq n-deferred-1
(hash-table-count (jsonrpc--deferred-actions conn)))))
(should-error
;; This stashes the request and waits. It will error because
;; no-one clears the "hold deferred" flag.
;; This stashes the request and waits. It will error with a
;; timeout after blocking for 1 sec because no-one clears the
;; "hold deferred" flag.
(jsonrpc-request conn 'ignore ["first deferred"]
:deferred "first deferred"
:timeout 0.5)
:timeout 1.0)
:type 'jsonrpc-error)
;; The error means the deferred actions stash is now empty
(should (zerop (hash-table-count (jsonrpc--deferred-actions conn))))
;; Again, this returns immediately.
(jsonrpc-async-request
conn
'sit-for [0.1]
'sit-for [0.01]
:success-fn
(lambda (_result)
;; This gets run while "third deferred" below is waiting for
@ -252,60 +224,11 @@
(should (eq 2 n-deferred-2))
(should (eq 0 (hash-table-count (jsonrpc--deferred-actions conn)))))))
;;; Tests using Python subprocesses (scontrol / anxious mechanism)
;;;
(defconst jsonrpc--test-dir
(file-name-directory (or load-file-name buffer-file-name))
"Directory of this test file, captured at load time.")
(cl-defmacro jsonrpc--with-python-fixture ((script conn &rest initargs) &body body)
"Start SCRIPT under python3 as a pipe subprocess, bind connection to CONN.
SCRIPT is a path relative to this file's directory.
INITARGS are passed to `make-instance' for `jsonrpc-process-connection'."
(declare (indent 1))
`(let ((,conn nil))
(unwind-protect
(progn
(setq ,conn
(make-instance
'jsonrpc-process-connection
:name "jsonrpc-python-test"
:process (make-process
:name "jsonrpc-python-test"
:command (list "python3"
(expand-file-name
,script
jsonrpc--test-dir))
:connection-type 'pipe
:noquery t)
,@initargs))
(with-timeout (5
(when ,conn
(let ((buf (jsonrpc--events-buffer ,conn)))
(when (buffer-live-p buf)
(if noninteractive
(progn
(message "contents of `%s':" (buffer-name buf))
(princ (with-current-buffer buf (buffer-string))
#'external-debugging-output))
(message "Preserved for inspection: %s"
(buffer-name buf))))))
(ert-fail "Test timed out after 5s"))
,@body))
(when ,conn
(ignore-errors
(jsonrpc-notify ,conn 'harakiri nil)
(kill-buffer (jsonrpc--events-buffer ,conn))
(jsonrpc-shutdown ,conn))))))
(ert-deftest scontrol-remote-during-sync-1 ()
"Anxious local continuations.
Endpoint sends a remote request RR1 on LR1, then replies to LR1
immediately before waiting for RR1 to resolve.
This is what JETLS does (bug#80623)."
(skip-unless (executable-find "python3"))
(skip-when (eq system-type 'windows-nt))
(jsonrpc--with-python-fixture
("jsonrpc-resources/server-remote-during-sync-1.py" conn
@ -322,7 +245,6 @@ Exactly the same test as 2, but different endpoint, which now still
sends RR1 on LR1 but now waits for RR1 to resolve before replying to
LR1.
This is what GoPls does (bug#80623)."
(skip-unless (executable-find "python3"))
(skip-when (eq system-type 'windows-nt))
(jsonrpc--with-python-fixture
("jsonrpc-resources/server-remote-during-sync-2.py" conn
@ -337,7 +259,6 @@ This is what GoPls does (bug#80623)."
"Nested anxious continuations
Two local sync requests LR1 and LR2 with a remote RR1 in between.
Vaguely similar to Julia's JETLS (bug#80623), but more complex."
(skip-unless (executable-find "python3"))
(skip-when (eq system-type 'windows-nt))
(let (lr2-result completed)
(jsonrpc--with-python-fixture
@ -349,7 +270,8 @@ Vaguely similar to Julia's JETLS (bug#80623), but more complex."
(setq lr2-result
(jsonrpc-request conn 'LR2 [] :timeout 5))
(push "lr2" completed)
(push "rr1" completed))
(push "rr1" completed)
"rr1-ok")
(_ (error "unexpected method: %s" method)))))
(should (equal "lr1-ok" (jsonrpc-request conn 'LR1 [] :timeout 5)))
(push "lr1" completed)
@ -358,7 +280,6 @@ Vaguely similar to Julia's JETLS (bug#80623), but more complex."
(ert-deftest scontrol-remote-error ()
"Anxious continuation even when rdispatcher signals errors."
(skip-unless (executable-find "python3"))
(skip-when (eq system-type 'windows-nt))
(jsonrpc--with-python-fixture
("jsonrpc-resources/server-remote-error.py" conn
@ -372,10 +293,9 @@ Vaguely similar to Julia's JETLS (bug#80623), but more complex."
(_ (error "unexpected method: %s" method)))))
(should (equal "ok" (jsonrpc-request conn 'LR1 [] :timeout 5)))))
(ert-deftest shutdown-clean-after-notification ()
"Server exits cleanly after harakiri notification.
(ert-deftest shutdown-clean-after-request ()
"Server exits cleanly after harakiri request.
`jsonrpc-shutdown' should not emit a \"Sentinel hasn't run\" warning."
(skip-unless (executable-find "python3"))
(skip-when (eq system-type 'windows-nt))
(let (warned)
(cl-letf (((symbol-function 'jsonrpc--warn)
@ -383,10 +303,9 @@ Vaguely similar to Julia's JETLS (bug#80623), but more complex."
(setq warned (apply #'format fmt args)))))
(jsonrpc--with-python-fixture
("jsonrpc-resources/server-harakiri.py" conn)
(jsonrpc-notify conn 'harakiri nil)
;; Give the server time to exit before shutdown checks the sentinel.
(accept-process-output nil 0.3)
(jsonrpc-shutdown conn)))
(jsonrpc-request conn 'harakiri nil :timeout 3)
(jsonrpc-shutdown conn)
(setq conn nil)))
(should-not warned)))
(provide 'jsonrpc-tests)