From: Philipp Stephani <phst@google.com>
Date: Fri, 3 Mar 2017 16:56:01 +0000 (+0100)
Subject: Make subprocess functions resolve the default directory
X-Git-Tag: emacs-26.0.90~521^2~731
X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=604eb02fff061e663e7523f45a72ecb71c2061e1;p=emacs.git

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.
---

diff --git a/lisp/files.el b/lisp/files.el
index b4872e46b01..204c26416a6 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -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)))
diff --git a/test/lisp/files-tests.el b/test/lisp/files-tests.el
index 9d456c512b0..80bbeb1bc54 100644
--- a/test/lisp/files-tests.el
+++ b/test/lisp/files-tests.el
@@ -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