Make subprocess functions resolve the default directory

`call-process' doesn't respect file name handlers in
`default-directory', so `file-name-non-special' has to resolve them
for `process-file', `start-file-process', and
`shell-command' (Bug#25949).

* lisp/files.el (file-name-non-special): Also resolve default
directory for 'process-file', 'start-file-process', and
'shell-command'.
* test/lisp/files-tests.el
(files-tests--file-name-non-special--subprocess): Add unit test.
This commit is contained in:
Philipp Stephani 2017-03-03 17:56:01 +01:00
parent f4b50dad8d
commit 604eb02fff
2 changed files with 17 additions and 1 deletions

View file

@ -6915,7 +6915,15 @@ only these files will be asked to be saved."
(defun file-name-non-special (operation &rest arguments)
(let ((file-name-handler-alist nil)
(default-directory
(if (eq operation 'insert-directory)
;; Some operations respect file name handlers in
;; `default-directory'. Because core function like
;; `call-process' don't care about file name handlers in
;; `default-directory', we here have to resolve the
;; directory into a local one. For `process-file',
;; `start-file-process', and `shell-command', this fixes
;; Bug#25949.
(if (memq operation '(insert-directory process-file start-file-process
shell-command))
(directory-file-name
(expand-file-name
(unhandled-file-name-directory default-directory)))

View file

@ -243,5 +243,13 @@ be $HOME."
(concat "/:/:" subdir)))))
(delete-directory dir 'recursive))))
(ert-deftest files-tests--file-name-non-special--subprocess ()
"Check that Bug#25949 is fixed."
(skip-unless (executable-find "true"))
(should (eq (let ((default-directory "/:/")) (process-file "true")) 0))
(should (processp (let ((default-directory "/:/"))
(start-file-process "foo" nil "true"))))
(should (eq (let ((default-directory "/:/")) (shell-command "true")) 0)))
(provide 'files-tests)
;;; files-tests.el ends here