procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Merge remote-tracking branch 'origin/master' into feature/android

Browse source
This commit is contained in:
Po Lu 2023-04-10 08:16:44 +08:00
commit 857e2bcb66
19 changed files with 264 additions and 154 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

15
etc/NEWS
View file

@ -480,6 +480,21 @@ simplified away.
This warning can be suppressed using 'with-suppressed-warnings' with
the warning name 'suspicious'.
---
*** Warn about more ignored function return values.
The compiler now warns when the return value from certain functions is
ignored. Example:
(progn (nreverse my-list) my-list)
will elicit a warning because it is usually pointless to call
'nreverse' on a list without using the returned value. To silence the
warning, make use of the value in some way, such as assigning it to a
variable. You can also wrap the function call in '(ignore ...)'.
This warning can be suppressed using 'with-suppressed-warnings' with
the warning name 'ignored-return-value'.
+++
** New function 'file-user-uid'.
This function is like 'user-uid', but is aware of file name handlers,

2
lisp/emacs-lisp/byte-opt.el
View file

@ -1706,7 +1706,7 @@ See Info node `(elisp) Integer Basics'."
charsetp commandp cons consp
current-buffer current-global-map current-indentation
current-local-map current-minor-mode-maps current-time
eobp eolp eq equal
eobp eolp eq equal eql
floatp following-char framep
hash-table-p
identity indirect-function integerp integer-or-marker-p

62
lisp/emacs-lisp/bytecomp.el
View file

@ -3502,7 +3502,67 @@ lambda-expression."
;; so maybe we don't need to bother about it here?
(setq form (cons 'progn (cdr form)))
(setq handler #'byte-compile-progn))
((and (or sef (eq (car form) 'mapcar))
((and (or sef
(memq (car form)
;; FIXME: Use a function property (declaration)
;; instead of this list.
'(
;; Functions that are side-effect-free
;; except for the behaviour of
;; functions passed as argument.
mapcar mapcan mapconcat
cl-mapcar cl-mapcan cl-maplist cl-map cl-mapcon
cl-reduce
assoc assoc-default plist-get plist-member
cl-assoc cl-assoc-if cl-assoc-if-not
cl-rassoc cl-rassoc-if cl-rassoc-if-not
cl-member cl-member-if cl-member-if-not
cl-adjoin
cl-mismatch cl-search
cl-find cl-find-if cl-find-if-not
cl-position cl-position-if cl-position-if-not
cl-count cl-count-if cl-count-if-not
cl-remove cl-remove-if cl-remove-if-not
cl-member cl-member-if cl-member-if-not
cl-remove-duplicates
cl-subst cl-subst-if cl-subst-if-not
cl-substitute cl-substitute-if
cl-substitute-if-not
cl-sublis
cl-union cl-intersection
cl-set-difference cl-set-exclusive-or
cl-subsetp
cl-every cl-some cl-notevery cl-notany
cl-tree-equal
;; Functions that mutate and return a list.
cl-delete-if cl-delete-if-not
;; `delete-dups' and `delete-consecutive-dups'
;; never delete the first element so it's
;; safe to ignore their return value, but
;; this isn't the case with
;; `cl-delete-duplicates'.
cl-delete-duplicates
cl-nsubst cl-nsubst-if cl-nsubst-if-not
cl-nsubstitute cl-nsubstitute-if
cl-nsubstitute-if-not
cl-nunion cl-nintersection
cl-nset-difference cl-nset-exclusive-or
cl-nreconc cl-nsublis
cl-merge
;; It's safe to ignore the value of `sort'
;; and `nreverse' when used on arrays,
;; but most calls pass lists.
nreverse
sort cl-sort cl-stable-sort
;; Adding the following functions yields many
;; positives; evaluate how many of them are
;; false first.
;;delq delete cl-delete
;;nconc plist-put
)))
(byte-compile-warning-enabled-p
'ignored-return-value (car form)))
(byte-compile-warn-x

2
lisp/emacs-lisp/cl-extra.el
View file

@ -408,6 +408,7 @@ Other non-digit chars are considered junk.
RADIX is an integer between 2 and 36, the default is 10. Signal
an error if the substring between START and END cannot be parsed
as an integer unless JUNK-ALLOWED is non-nil."
(declare (side-effect-free t))
(cl-check-type string string)
(let* ((start (or start 0))
(len (length string))
@ -566,6 +567,7 @@ too large if positive or too small if negative)."
;;;###autoload
(defun cl-revappend (x y)
"Equivalent to (append (reverse X) Y)."
(declare (side-effect-free t))
(nconc (reverse x) y))
;;;###autoload

1
lisp/emacs-lisp/cl-lib.el
View file

@ -459,6 +459,7 @@ Thus, `(cl-list* A B C D)' is equivalent to `(nconc (list A B C) D)', or to
(defun cl-copy-list (list)
"Return a copy of LIST, which may be a dotted list.
The elements of LIST are not copied, just the list structure itself."
(declare (side-effect-free error-free))
(if (consp list)
(let ((res nil))
(while (consp list) (push (pop list) res))

6
lisp/emacs-lisp/cl-macs.el
View file

@ -3690,14 +3690,14 @@ macro that returns its `&whole' argument."
;;; Things that are side-effect-free.
(mapc (lambda (x) (function-put x 'side-effect-free t))
'(cl-oddp cl-evenp cl-signum last butlast cl-ldiff cl-pairlis cl-gcd
'(cl-oddp cl-evenp cl-signum cl-ldiff cl-pairlis cl-gcd
cl-lcm cl-isqrt cl-floor cl-ceiling cl-truncate cl-round cl-mod cl-rem
cl-subseq cl-list-length cl-get cl-getf))
;;; Things that are side-effect-and-error-free.
(mapc (lambda (x) (function-put x 'side-effect-free 'error-free))
'(eql cl-list* cl-subst cl-acons cl-equalp
cl-random-state-p copy-tree cl-sublis))
'(cl-list* cl-acons cl-equalp
cl-random-state-p copy-tree))
;;; Types and assertions.

4
lisp/emacs-lisp/ert-x.el
View file

@ -563,9 +563,9 @@ The same keyword arguments are supported as in
;; Emacs's Makefile sets $HOME to a nonexistent value. Needed
;; in batch mode only, therefore.
(when (and noninteractive (not (file-directory-p "~/")))
(setenv "HOME" temporary-file-directory))
(setenv "HOME" (directory-file-name temporary-file-directory)))
(format "/mock::%s" temporary-file-directory))))
"Temporary directory for remote file tests.")
"Temporary directory for remote file tests.")
(provide 'ert-x)

3
lisp/gnus/gnus-group.el
View file

@ -4195,7 +4195,8 @@ If DONT-SCAN is non-nil, scan non-activated groups as well."
(let ((info (gnus-get-info group))
(active (gnus-active group)))
(when info
(gnus-request-update-info info method))
(gnus-request-update-info info method)
(setq active (gnus-active group)))
(gnus-get-unread-articles-in-group info active)
(unless (gnus-virtual-group-p group)
(gnus-close-group group))

3
lisp/gnus/gnus-start.el
View file

@ -1490,7 +1490,8 @@ backend check whether the group actually exists."
(gnus-request-update-info
info (inline (gnus-find-method-for-group
(gnus-info-group info)))))
(gnus-activate-group (gnus-info-group info) nil t))
(gnus-activate-group (gnus-info-group info) nil t)
(setq active (gnus-active (gnus-info-group info))))
(let* ((range (gnus-info-read info))
(num 0))

143
lisp/gnus/nnselect.el
View file

@ -440,7 +440,7 @@ artlist; otherwise store the ARTLIST in the group parameters."
(if (eq 'nnselect (car (gnus-server-to-method server)))
(with-current-buffer gnus-summary-buffer
(let ((thread (gnus-id-to-thread article)))
(when thread
(when (car thread)
(mapc
(lambda (x)
(when (and x (> x 0))
@ -594,62 +594,63 @@ artlist; otherwise store the ARTLIST in the group parameters."
(gnus-newsgroup-selection
(or gnus-newsgroup-selection (nnselect-get-artlist group)))
newmarks)
(gnus-info-set-marks info nil)
(setf (gnus-info-read info) nil)
(pcase-dolist (`(,artgroup . ,nartids)
(ids-by-group
(number-sequence 1 (nnselect-artlist-length
gnus-newsgroup-selection))))
(let* ((gnus-newsgroup-active nil)
(idmap (make-hash-table :test 'eql))
(gactive (sort (mapcar 'cdr nartids) '<))
(group-info (gnus-get-info artgroup))
(marks (gnus-info-marks group-info)))
(pcase-dolist (`(,val . ,key) nartids)
(puthash key val idmap))
(setf (gnus-info-read info)
(range-add-list
(gnus-info-read info)
(sort (mapcar (lambda (art) (gethash art idmap))
(gnus-sorted-intersection
gactive
(range-uncompress (gnus-info-read group-info))))
'<)))
(pcase-dolist (`(,type . ,mark-list) marks)
(let ((mark-type (gnus-article-mark-to-type type)) new)
(when
(setq new
(if (not mark-list) nil
(cond
((eq mark-type 'tuple)
(delq nil
(mapcar
(lambda (mark)
(let ((id (gethash (car mark) idmap)))
(when id (cons id (cdr mark)))))
mark-list)))
(t
(mapcar (lambda (art) (gethash art idmap))
(gnus-sorted-intersection
gactive (range-uncompress mark-list)))))))
(let ((previous (alist-get type newmarks)))
(if previous
(nconc previous new)
(push (cons type new) newmarks))))))))
(when gnus-newsgroup-selection
(gnus-info-set-marks info nil)
(setf (gnus-info-read info) nil)
(pcase-dolist (`(,artgroup . ,nartids)
(ids-by-group
(number-sequence 1 (nnselect-artlist-length
gnus-newsgroup-selection))))
(let* ((gnus-newsgroup-active nil)
(idmap (make-hash-table :test 'eql))
(gactive (sort (mapcar 'cdr nartids) #'<))
(group-info (gnus-get-info artgroup))
(marks (gnus-info-marks group-info)))
(pcase-dolist (`(,val . ,key) nartids)
(puthash key val idmap))
(setf (gnus-info-read info)
(range-add-list
(gnus-info-read info)
(sort (mapcar (lambda (art) (gethash art idmap))
(gnus-sorted-intersection
gactive
(range-uncompress (gnus-info-read group-info))))
#'<)))
(pcase-dolist (`(,type . ,mark-list) marks)
(let ((mark-type (gnus-article-mark-to-type type)) new)
(when
(setq new
(if (not mark-list) nil
(cond
((eq mark-type 'tuple)
(delq nil
(mapcar
(lambda (mark)
(let ((id (gethash (car mark) idmap)))
(when id (cons id (cdr mark)))))
mark-list)))
(t
(mapcar (lambda (art) (gethash art idmap))
(gnus-sorted-intersection
gactive (range-uncompress mark-list)))))))
(let ((previous (alist-get type newmarks)))
(if previous
(nconc previous new)
(push (cons type new) newmarks))))))))
;; Clean up the marks: compress lists;
(pcase-dolist (`(,type . ,mark-list) newmarks)
(let ((mark-type (gnus-article-mark-to-type type)))
(unless (eq mark-type 'tuple)
(setf (alist-get type newmarks)
(gnus-compress-sequence (sort mark-list '<))))))
;; and ensure an unexist key.
(unless (assq 'unexist newmarks)
(push (cons 'unexist nil) newmarks))
;; Clean up the marks: compress lists;
(pcase-dolist (`(,type . ,mark-list) newmarks)
(let ((mark-type (gnus-article-mark-to-type type)))
(unless (eq mark-type 'tuple)
(setf (alist-get type newmarks)
(gnus-compress-sequence (sort mark-list #'<))))))
;; and ensure an unexist key.
(unless (assq 'unexist newmarks)
(push (cons 'unexist nil) newmarks))
(gnus-info-set-marks info newmarks)
(gnus-set-active group (cons 1 (nnselect-artlist-length
gnus-newsgroup-selection)))))
(gnus-info-set-marks info newmarks)
(gnus-set-active group (cons 1 (nnselect-artlist-length
gnus-newsgroup-selection))))))
(deffoo nnselect-request-thread (header &optional group server)
@ -759,7 +760,8 @@ artlist; otherwise store the ARTLIST in the group parameters."
(deffoo nnselect-close-group (group &optional _server)
(let ((group (nnselect-add-prefix group)))
(unless gnus-group-is-exiting-without-update-p
(nnselect-push-info group))
(when gnus-newsgroup-selection
(nnselect-push-info group)))
(setq gnus-newsgroup-selection nil)
(when (gnus-ephemeral-group-p group)
(gnus-kill-ephemeral-group group)
@ -882,23 +884,28 @@ article came from is also searched."
(defun nnselect-push-info (group)
(defun nnselect-push-info (_group)
"Copy mark-lists from GROUP to the originating groups."
(let ((select-unreads (numbers-by-group gnus-newsgroup-unreads))
(select-reads (numbers-by-group
(gnus-info-read (gnus-get-info group)) 'range))
(select-unseen (numbers-by-group gnus-newsgroup-unseen))
(gnus-newsgroup-active nil) mark-list)
(select-reads (numbers-by-group
(gnus-sorted-difference gnus-newsgroup-articles
gnus-newsgroup-unreads)))
(select-unseen (numbers-by-group gnus-newsgroup-unseen))
(gnus-newsgroup-active nil) mark-list)
;; collect the set of marked article lists categorized by
;; originating groups
(pcase-dolist (`(,mark . ,type) gnus-article-mark-lists)
(let (type-list)
(when (setq type-list
(symbol-value (intern (format "gnus-newsgroup-%s" mark))))
(push (cons
type
(numbers-by-group type-list (gnus-article-mark-to-type type)))
mark-list))))
(let ((mark-type (gnus-article-mark-to-type type))
(type-list (symbol-value
(intern (format "gnus-newsgroup-%s" mark)))))
(when type-list
(unless (eq 'tuple mark-type)
(setq type-list (range-list-intersection
gnus-newsgroup-articles type-list)))
(push (cons
type
(numbers-by-group type-list mark-type))
mark-list))))
;; now work on each originating group one at a time
(pcase-dolist (`(,artgroup . ,artlist)
(numbers-by-group gnus-newsgroup-articles))

3
lisp/net/eudcb-mab.el
View file

@ -86,7 +86,8 @@ RETURN-ATTRS is a list of attributes to return, defaulting to
((eq (car term) 'email)
(unless (string= (cdr term) mail)
(setq matched nil)))
((eq (car term) 'phone))))
;; ((eq (car term) 'phone))
))
(when matched
(setq result

4
lisp/net/tramp-sshfs.el
View file

@ -244,8 +244,8 @@ arguments to pass to the OPERATION."
(setq result
(insert-file-contents
(tramp-fuse-local-file-name filename) visit beg end replace))
(when visit (setq buffer-file-name filename))
(cons filename (cdr result)))))
(when visit (setq buffer-file-name filename)))
(cons filename (cdr result))))
(defun tramp-sshfs-handle-process-file
(program &optional infile destination display &rest args)

3
lisp/org/ob-core.el
View file

@ -2426,7 +2426,8 @@ INFO may provide the values of these header arguments (in the
(delete-region (point) (org-babel-result-end)))
((member "append" result-params)
(goto-char (org-babel-result-end)) (setq beg (point-marker)))
((member "prepend" result-params))) ; already there
;; ((member "prepend" result-params)) ; already there
)
(setq results-switches
(if results-switches (concat " " results-switches) ""))
(let ((wrap

8
lisp/progmodes/project.el
View file

@ -1248,8 +1248,10 @@ If you exit the `query-replace', you can later continue the
(defun project-prefixed-buffer-name (mode)
(concat "*"
(file-name-nondirectory
(directory-file-name default-directory))
(if-let ((proj (project-current nil)))
(project-name proj)
(file-name-nondirectory
(directory-file-name default-directory)))
"-"
(downcase mode)
"*"))
@ -1261,7 +1263,7 @@ If non-nil, it overrides `compilation-buffer-name-function' for
:version "28.1"
:group 'project
:type '(choice (const :tag "Default" nil)
(const :tag "Prefixed with root directory name"
(const :tag "Prefixed with project name"
project-prefixed-buffer-name)
(function :tag "Custom function")))

4
lisp/progmodes/prolog.el
View file

@ -828,7 +828,7 @@ Relevant only when `prolog-imenu-flag' is non-nil."
((not (zerop (skip-chars-forward prolog-operator-chars))))
((not (zerop (skip-syntax-forward "w_'"))))
;; In case of non-ASCII punctuation.
((not (zerop (skip-syntax-forward ".")))))
(t (skip-syntax-forward ".")))
(point))))
(defun prolog-smie-backward-token ()
@ -842,7 +842,7 @@ Relevant only when `prolog-imenu-flag' is non-nil."
((not (zerop (skip-chars-backward prolog-operator-chars))))
((not (zerop (skip-syntax-backward "w_'"))))
;; In case of non-ASCII punctuation.
((not (zerop (skip-syntax-backward ".")))))
(t (skip-syntax-backward ".")))
(point))))
(defconst prolog-smie-grammar

16
test/lisp/emacs-lisp/nadvice-tests.el
View file

@ -118,20 +118,20 @@
(declare-function sm-test7 nil)
(advice-add 'sm-test7 :around
(lambda (f &rest args)
(list (cons 1 (called-interactively-p)) (apply f args))))
(list (cons 1 (called-interactively-p 'any)) (apply f args))))
(should (equal (sm-test7) '((1 . nil) 11)))
(should (equal (call-interactively 'sm-test7) '((1 . t) 11)))
(let ((smi 7))
(advice-add 'sm-test7 :before
(lambda (&rest _args)
(setq smi (called-interactively-p))))
(setq smi (called-interactively-p 'any))))
(should (equal (list (sm-test7) smi)
'(((1 . nil) 11) nil)))
(should (equal (list (call-interactively 'sm-test7) smi)
'(((1 . t) 11) t))))
(advice-add 'sm-test7 :around
(lambda (f &rest args)
(cons (cons 2 (called-interactively-p)) (apply f args))))
(cons (cons 2 (called-interactively-p 'any)) (apply f args))))
(should (equal (call-interactively 'sm-test7) '((2 . t) (1 . t) 11))))
(ert-deftest advice-test-called-interactively-p-around ()
@ -140,18 +140,18 @@
This tests the currently broken case of the innermost advice to a
function being an around advice."
:expected-result :failed
(defun sm-test7.2 () (interactive) (cons 1 (called-interactively-p)))
(defun sm-test7.2 () (interactive) (cons 1 (called-interactively-p 'any)))
(declare-function sm-test7.2 nil)
(advice-add 'sm-test7.2 :around
(lambda (f &rest args)
(list (cons 1 (called-interactively-p)) (apply f args))))
(list (cons 1 (called-interactively-p 'any)) (apply f args))))
(should (equal (sm-test7.2) '((1 . nil) (1 . nil))))
(should (equal (call-interactively 'sm-test7.2) '((1 . t) (1 . t)))))
(ert-deftest advice-test-called-interactively-p-filter-args ()
"Check interaction between filter-args advice and called-interactively-p."
:expected-result :failed
(defun sm-test7.3 () (interactive) (cons 1 (called-interactively-p)))
(defun sm-test7.3 () (interactive) (cons 1 (called-interactively-p 'any)))
(declare-function sm-test7.3 nil)
(advice-add 'sm-test7.3 :filter-args #'list)
(should (equal (sm-test7.3) '(1 . nil)))
@ -159,7 +159,9 @@ function being an around advice."
(ert-deftest advice-test-call-interactively ()
"Check interaction between advice on call-interactively and called-interactively-p."
(let ((sm-test7.4 (lambda () (interactive) (cons 1 (called-interactively-p))))
(let ((sm-test7.4 (lambda ()
(interactive)
(cons 1 (called-interactively-p 'any))))
(old (symbol-function 'call-interactively)))
(unwind-protect
(progn

37
test/lisp/net/tramp-tests.el
View file

@ -2412,22 +2412,51 @@ This checks also `file-name-as-directory', `file-name-directory',
(with-temp-buffer
(write-region "foo" nil tmp-name)
(let ((point (point)))
(insert-file-contents tmp-name)
(should
(equal
(insert-file-contents tmp-name)
`(,(expand-file-name tmp-name) 3)))
(should (string-equal (buffer-string) "foo"))
(should (= point (point))))
(goto-char (1+ (point)))
(let ((point (point)))
(insert-file-contents tmp-name)
(should
(equal
(insert-file-contents tmp-name)
`(,(expand-file-name tmp-name) 3)))
(should (string-equal (buffer-string) "ffoooo"))
(should (= point (point))))
;; Insert partly.
(let ((point (point)))
(insert-file-contents tmp-name nil 1 3)
(should
(equal
(insert-file-contents tmp-name nil 1 3)
`(,(expand-file-name tmp-name) 2)))
(should (string-equal (buffer-string) "foofoooo"))
(should (= point (point))))
(let ((point (point)))
(should
(equal
(insert-file-contents tmp-name nil 2 5)
`(,(expand-file-name tmp-name) 1)))
(should (string-equal (buffer-string) "fooofoooo"))
(should (= point (point))))
;; Replace.
(let ((point (point)))
(insert-file-contents tmp-name nil nil nil 'replace)
;; 0 characters replaced, because "foo" is already there.
(should
(equal
(insert-file-contents tmp-name nil nil nil 'replace)
`(,(expand-file-name tmp-name) 0)))
(should (string-equal (buffer-string) "foo"))
(should (= point (point))))
(let ((point (point)))
(replace-string-in-region "foo" "bar" (point-min) (point-max))
(goto-char point)
(should
(equal
(insert-file-contents tmp-name nil nil nil 'replace)
`(,(expand-file-name tmp-name) 3)))
(should (string-equal (buffer-string) "foo"))
(should (= point (point))))
;; Error case.

63
test/lisp/progmodes/eglot-tests.el
View file

@ -37,8 +37,8 @@
;; value (FIXME: like what?) in order to overwrite the default value.
;;
;; IMPORTANT: Since Eglot is a :core ELPA package, these tests are
;;supposed to run on Emacsen down to 26.3. Do not use bleeding-edge
;;functionality not compatible with that Emacs version.
;; supposed to run on Emacsen down to 26.3. Do not use bleeding-edge
;; functionality not compatible with that Emacs version.
;;; Code:
(require 'eglot)
@ -61,16 +61,13 @@
(apply #'format format args)))
(defmacro eglot--with-fixture (fixture &rest body)
"Setup FIXTURE, call BODY, teardown FIXTURE.
"Set up FIXTURE, call BODY, tear down FIXTURE.
FIXTURE is a list. Its elements are of the form (FILE . CONTENT)
to create a readable FILE with CONTENT. FILE may be a directory
name and CONTENT another (FILE . CONTENT) list to specify a
directory hierarchy. FIXTURE's elements can also be (SYMBOL
VALUE) meaning SYMBOL should be bound to VALUE during BODY and
then restored."
directory hierarchy."
(declare (indent 1) (debug t))
`(eglot--call-with-fixture
,fixture #'(lambda () ,@body)))
`(eglot--call-with-fixture ,fixture (lambda () ,@body)))
(defun eglot--make-file-or-dir (ass)
(let ((file-or-dir-name (car ass))
@ -91,18 +88,9 @@ then restored."
"Helper for `eglot--with-fixture'. Run FN under FIXTURE."
(let* ((fixture-directory (make-nearby-temp-file "eglot--fixture" t))
(default-directory fixture-directory)
file-specs created-files
syms-to-restore
created-files
new-servers
test-body-successful-p)
(dolist (spec fixture)
(cond ((symbolp spec)
(push (cons spec (symbol-value spec)) syms-to-restore)
(set spec nil))
((symbolp (car spec))
(push (cons (car spec) (symbol-value (car spec))) syms-to-restore)
(set (car spec) (cadr spec)))
((stringp (car spec)) (push spec file-specs))))
(eglot--test-message "[%s]: test start" (ert-test-name (ert-running-test)))
(unwind-protect
(let* ((process-environment
@ -123,7 +111,7 @@ then restored."
process-environment))
(eglot-server-initialized-hook
(lambda (server) (push server new-servers))))
(setq created-files (mapcan #'eglot--make-file-or-dir file-specs))
(setq created-files (mapcan #'eglot--make-file-or-dir fixture))
(prog1 (funcall fn)
(setq test-body-successful-p t)))
(eglot--test-message "[%s]: %s" (ert-test-name (ert-running-test))
@ -155,18 +143,15 @@ then restored."
(t
(eglot--test-message "Preserved for inspection: %s"
(mapconcat #'buffer-name buffers ", "))))))))
(eglot--cleanup-after-test fixture-directory created-files syms-to-restore)))))
(eglot--cleanup-after-test fixture-directory created-files)))))
(defun eglot--cleanup-after-test (fixture-directory created-files syms-to-restore)
(defun eglot--cleanup-after-test (fixture-directory created-files)
(let ((buffers-to-delete
(delete nil (mapcar #'find-buffer-visiting created-files))))
(eglot--test-message "Killing %s, wiping %s, restoring %s"
(delq nil (mapcar #'find-buffer-visiting created-files))))
(eglot--test-message "Killing %s, wiping %s"
buffers-to-delete
fixture-directory
(mapcar #'car syms-to-restore))
(cl-loop for (sym . val) in syms-to-restore
do (set sym val))
(dolist (buf buffers-to-delete) ;; have to save otherwise will get prompted
fixture-directory)
(dolist (buf buffers-to-delete) ;; Have to save otherwise will get prompted.
(with-current-buffer buf (save-buffer) (kill-buffer)))
(delete-directory fixture-directory 'recursive)
;; Delete Tramp buffers if needed.
@ -325,8 +310,7 @@ then restored."
"Connect to eclipse.jdt.ls server."
(skip-unless (executable-find "jdtls"))
(eglot--with-fixture
'(("project/src/main/java/foo" . (("Main.java" . "")))
("project/.git/" . nil))
'(("project/src/main/java/foo" . (("Main.java" . ""))))
(with-current-buffer
(eglot--find-file-noselect "project/src/main/java/foo/Main.java")
(eglot--sniffing (:server-notifications s-notifs)
@ -480,11 +464,11 @@ then restored."
(should (eq 'eglot-diagnostic-tag-unnecessary-face (face-at-point))))))))
(defun eglot--eldoc-on-demand ()
;; Trick Eldoc 1.1.0 into accepting on-demand calls.
;; Trick ElDoc 1.1.0 into accepting on-demand calls.
(eldoc t))
(defun eglot--tests-force-full-eldoc ()
;; FIXME: This uses some Eldoc implementation defatils.
;; FIXME: This uses some ElDoc implementation details.
(when (buffer-live-p eldoc--doc-buffer)
(with-current-buffer eldoc--doc-buffer
(let ((inhibit-read-only t))
@ -670,7 +654,7 @@ int main() {
(should (string-match "^fprintf" (eglot--tests-force-full-eldoc))))))
(ert-deftest eglot-test-multiline-eldoc ()
"Test Eldoc documentation from multiple osurces."
"Test ElDoc documentation from multiple osurces."
(skip-unless (executable-find "clangd"))
(eglot--with-fixture
`(("project" . (("coiso.c" .
@ -723,7 +707,7 @@ int main() {
(eglot--sniffing (:server-notifications s-notifs)
(should (eglot--tests-connect))
(eglot--wait-for (s-notifs 20) (&key method &allow-other-keys)
(string= method "textDocument/publishDiagnostics")))
(string= method "textDocument/publishDiagnostics")))
(goto-char (point-max))
(eglot--simulate-key-event ?.)
(should (looking-back "^ \\."))))))
@ -872,9 +856,9 @@ int main() {
(skip-unless (executable-find "clangd"))
(eglot--with-fixture
`(("project" . (("foo.c" . "int foo() {return 42;}")
("bar.c" . "int bar() {return 42;}")))
(c-mode-hook (eglot-ensure)))
(let (server)
("bar.c" . "int bar() {return 42;}"))))
(let ((c-mode-hook '(eglot-ensure))
server)
;; need `ert-simulate-command' because `eglot-ensure'
;; relies on `post-command-hook'.
(with-current-buffer
@ -1288,7 +1272,7 @@ macro will assume it exists."
(ert-deftest eglot-test-path-to-uri-windows ()
(skip-unless (eq system-type 'windows-nt))
(should (string-prefix-p "file:///"
(eglot--path-to-uri "c:/Users/Foo/bar.lisp")))
(eglot--path-to-uri "c:/Users/Foo/bar.lisp")))
(should (string-suffix-p "c%3A/Users/Foo/bar.lisp"
(eglot--path-to-uri "c:/Users/Foo/bar.lisp"))))
@ -1318,8 +1302,9 @@ macro will assume it exists."
(should (eq (eglot-current-server) server))))))
(provide 'eglot-tests)
;;; eglot-tests.el ends here
;; Local Variables:
;; checkdoc-force-docstrings-flag: nil
;; End:
;;; eglot-tests.el ends here

39
test/src/fns-tests.el
View file

@ -114,22 +114,24 @@
(should-error (nreverse 1))
(should-error (nreverse (make-char-table 'foo)))
(should (equal (nreverse (copy-sequence "xyzzy")) "yzzyx"))
(let ((A (vector)))
(nreverse A)
(should (equal A [])))
(let ((A (vector 0)))
(nreverse A)
(should (equal A [0])))
(let ((A (vector 1 2 3 4)))
(nreverse A)
(should (equal A [4 3 2 1])))
(let ((A (vector 1 2 3 4)))
(nreverse A)
(nreverse A)
(should (equal A [1 2 3 4])))
(let* ((A (vector))
(B (nreverse A)))
(should (equal A []))
(should (eq B A)))
(let* ((A (vector 0))
(B (nreverse A)))
(should (equal A [0]))
(should (eq B A)))
(let* ((A (vector 1 2 3 4))
(B (nreverse (nreverse A))))
(should (equal A B))))
(B (nreverse A)))
(should (equal A [4 3 2 1]))
(should (eq B A)))
(let* ((A (vector 1 2 3 4))
(B (nreverse A))
(C (nreverse A)))
(should (equal A [1 2 3 4]))
(should (eq B A))
(should (eq C A))))
(ert-deftest fns-tests-reverse-bool-vector ()
(let ((A (make-bool-vector 10 nil)))
@ -140,9 +142,10 @@
(ert-deftest fns-tests-nreverse-bool-vector ()
(let ((A (make-bool-vector 10 nil)))
(dotimes (i 5) (aset A i t))
(nreverse A)
(should (equal [nil nil nil nil nil t t t t t] (vconcat A)))
(should (equal [t t t t t nil nil nil nil nil] (vconcat (nreverse A))))))
(let ((B (nreverse A)))
(should (eq B A))
(should (equal [nil nil nil nil nil t t t t t] (vconcat A)))
(should (equal [t t t t t nil nil nil nil nil] (vconcat (nreverse A)))))))
(defconst fns-tests--string-lessp-cases
`(("abc" < "abd")