mirror/emacs
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2024-11-22 07:09:54 +00:00
Code Issues Releases Activity

Fix userlock.el and filelock-tests in some rare cases

Browse Source 
* lisp/userlock.el (userlock--check-content-unchanged): Don't
assume 'file-truename' of FILENAME is always non-nil.  It could be
nil if we are called from a temporary buffer where some Lisp
program has forcibly set 'buffer-file-name'.  (Bug#64821)

* test/src/filelock-tests.el (filelock-tests--fixture): Set
'buffer-file-name' to the true name of the temporary file.
Patch by Mattias Engdegård <mattias.engdegard@gmail.com>.
(filelock-tests-detect-external-change): Quote the file names
passed to shell commands.
This commit is contained in:
Eli Zaretskii 2023-07-28 09:31:25 +03:00
parent fd88b6cdd4
commit 36b6124d81
2 changed files with 14 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
lisp/userlock.el
View File

@ -141,8 +141,10 @@ You can <\\`q'>uit; don't modify this file."))
;; modtime in that buffer, to cater to use case where the
;; file is about to be written to from some buffer that
;; doesn't visit any file, like a temporary buffer.
(with-current-buffer (get-file-buffer (file-truename filename))
(set-visited-file-modtime))
(let ((buf (get-file-buffer (file-truename filename))))
(when buf ; If we cannot find the visiting buffer, punt.
(with-current-buffer buf
(set-visited-file-modtime))))
'unchanged)))))
;;;###autoload

14
test/src/filelock-tests.el
View File

@ -38,8 +38,12 @@ Create a test directory and a buffer whose `buffer-file-name' and
Finally, delete the buffer and the test directory."
(declare (debug (body)))
`(ert-with-temp-directory temp-dir
(let ((name (concat (file-name-as-directory temp-dir)
"userfile"))
(let ((name
;; Use file-truename for when 'temporary-file-directory'
;; is a symlink, to make sure 'buffer-file-name' is set
;; below to a real existing file.
(file-truename (concat (file-name-as-directory temp-dir)
"userfile")))
(create-lockfiles t))
(with-temp-buffer
(setq buffer-file-name name
@ -184,7 +188,8 @@ the case)."
;; Just changing the file modification on disk doesn't hurt,
;; because file contents in buffer and on disk look equal.
(shell-command (format "touch %s" (buffer-file-name)))
(shell-command (format "touch %s"
(shell-quote-argument (buffer-file-name))))
(insert "bar")
(when cl (filelock-tests--should-be-locked))
@ -198,7 +203,8 @@ the case)."
;; Changing the file contents on disk hurts when buffer is
;; modified. There shall be a query, which we answer.
;; *Messages* buffer is checked for prompt.
(shell-command (format "echo bar >>%s" (buffer-file-name)))
(shell-command (format "echo bar >>%s"
(shell-quote-argument (buffer-file-name))))
(cl-letf (((symbol-function 'read-char-choice)
(lambda (prompt &rest _) (message "%s" prompt) ?y)))
(ert-with-message-capture captured-messages