branch: externals/compat
commit 6f22d46c857d3fbf41242854514dee276e027a3f
Author: Daniel Mendler <m...@daniel-mendler.de>
Commit: Daniel Mendler <m...@daniel-mendler.de>
Improve exec-path, executable-find and temporary-file-directory
Implement Tramp tests using the mock protocol.
---
compat-26.el | 28 +++++++++++++++++-----------
compat-27.el | 32 +++++++-------------------------
compat-tests.el | 56 ++++++++++++++++++++++++++++++++++++--------------------
3 files changed, 60 insertions(+), 56 deletions(-)
diff --git a/compat-26.el b/compat-26.el
index 3502f66db8..43770f3582 100644
--- a/compat-26.el
+++ b/compat-26.el
@@ -360,13 +360,16 @@ mounted file system (see `mounted-file-systems'), the
function
returns `default-directory'.
For a non-remote and non-mounted `default-directory', the value of
the variable `temporary-file-directory' is returned."
+ ;; NOTE: The handler may fail with an error, since the
+ ;; `temporary-file-directory' handler was introduced in Emacs 26.
(let ((handler (find-file-name-handler
default-directory 'temporary-file-directory)))
- (if handler
- (funcall handler 'temporary-file-directory)
- (if (string-match mounted-file-systems default-directory)
- default-directory
- temporary-file-directory))))
+ (or (and handler (ignore-errors (funcall handler
'temporary-file-directory)))
+ (if-let ((remote (file-remote-p default-directory)))
+ (concat remote "/tmp/") ;; FIXME: Guess /tmp on remote host
+ (if (string-match mounted-file-systems default-directory)
+ default-directory
+ temporary-file-directory)))))
(compat-defun make-nearby-temp-file (prefix &optional dir-flag suffix) ;;
<compat-tests:make-nearby-temp-file>
"Create a temporary file as close as possible to `default-directory'.
@@ -376,12 +379,15 @@ temporary file is created in the directory returned by the
function `temporary-file-directory'. Otherwise, the function
`make-temp-file' is used. PREFIX, DIR-FLAG and SUFFIX have the
same meaning as in `make-temp-file'."
- (let ((handler (find-file-name-handler
- default-directory 'make-nearby-temp-file)))
- (if (and handler (not (file-name-absolute-p default-directory)))
- (funcall handler 'make-nearby-temp-file prefix dir-flag suffix)
- (let ((temporary-file-directory (temporary-file-directory)))
- (make-temp-file prefix dir-flag suffix)))))
+ ;; NOTE: The handler may fail with an error, since the
+ ;; `make-nearby-temp-file' handler was introduced in Emacs 26.
+ (let ((handler (and (not (file-name-absolute-p default-directory))
+ (find-file-name-handler
+ default-directory 'make-nearby-temp-file))))
+ (or (and handler (ignore-errors (funcall handler 'make-nearby-temp-file
+ prefix dir-flag suffix)))
+ (let ((temporary-file-directory (temporary-file-directory)))
+ (make-temp-file prefix dir-flag suffix)))))
(compat-defun file-attribute-type (attributes) ;;
<compat-tests:file-attribute-getters>
"The type field in ATTRIBUTES returned by `file-attributes'.
diff --git a/compat-27.el b/compat-27.el
index 978a9c7368..fadf934c2d 100644
--- a/compat-27.el
+++ b/compat-27.el
@@ -419,31 +419,13 @@ The remote host is identified by `default-directory'.
For remote
hosts that do not support subprocesses, this returns nil.
If `default-directory' is a local directory, this function returns
the value of the variable `exec-path'."
- (cond
- ((let ((handler (find-file-name-handler default-directory 'exec-path)))
- ;; FIXME: The handler was added in 27.1, and this compatibility
- ;; function only applies to versions of Emacs before that.
- (when handler
- (condition-case nil
- (funcall handler 'exec-path)
- (error nil)))))
- ((file-remote-p default-directory)
- ;; TODO: This is not completely portable, even if "sh" and
- ;; "getconf" should be provided on every POSIX system, the chance
- ;; of this not working are greater than zero.
- ;;
- ;; FIXME: This invokes a shell process every time exec-path is
- ;; called. It should instead be cached on a host-local basis.
- (with-temp-buffer
- (if (condition-case nil
- (zerop (process-file "sh" nil t nil "-c" "getconf PATH"))
- (file-missing t))
- (list "/bin" "/usr/bin")
- (let (path)
- (while (re-search-forward "\\([^:]+?\\)[\n:]" nil t)
- (push (match-string 1) path))
- (nreverse path)))))
- (exec-path)))
+ (let ((handler (find-file-name-handler default-directory 'exec-path)))
+ ;; NOTE: The handler may fail since it was added in 27.1.
+ (or (and handler (ignore-errors (funcall handler 'exec-path)))
+ (if (file-remote-p default-directory)
+ ;; FIXME: Just return some standard path on remote
+ '("/bin" "/usr/bin" "/sbin" "/usr/sbin" "/usr/local/bin"
"/usr/local/sbin")
+ exec-path))))
(compat-defun executable-find (command &optional remote) ;;
<compat-tests:executable-find>
"Search for COMMAND in `exec-path' and return the absolute file name.
diff --git a/compat-tests.el b/compat-tests.el
index 16bad8929f..25215f36f3 100644
--- a/compat-tests.el
+++ b/compat-tests.el
@@ -57,6 +57,21 @@
(require 'image)
(require 'text-property-search nil t)
+;; Setup tramp mock
+(require 'tramp)
+(add-to-list
+ 'tramp-methods
+ '("mock"
+ (tramp-login-program "sh")
+ (tramp-login-args (("-i")))
+ (tramp-direct-async ("-c"))
+ (tramp-remote-shell "/bin/sh")
+ (tramp-remote-shell-args ("-c"))
+ (tramp-connection-timeout 10)))
+(add-to-list
+ 'tramp-default-host-alist
+ `("\\`mock\\'" nil ,(system-name)))
+
(defmacro should-equal (a b)
`(should (equal ,a ,b)))
@@ -1243,7 +1258,6 @@
(should-equal backups (sort (file-backup-file-names file) #'string<))))
(ert-deftest make-nearby-temp-file ()
- ;; TODO Test tramp remote directory.
(let ((file1 (make-nearby-temp-file "compat-tests"))
(file2 (make-nearby-temp-file "compat-tests" nil "suffix"))
(dir (make-nearby-temp-file "compat-tests" t)))
@@ -1256,21 +1270,26 @@
(should-equal (file-name-directory dir) temporary-file-directory)
(delete-file file1)
(delete-file file2)
- (delete-directory dir)))
+ (delete-directory dir))
+ ;; Tramp test (mock protocol)
+ (let* ((default-directory "/mock::/")
+ (file (make-nearby-temp-file "compat-tests")))
+ (should (string-match-p "\\`/mock:.*:/tmp/compat-tests" file))
+ (delete-file file)))
(ert-deftest executable-find ()
(should (member (executable-find "sh") '("/usr/bin/sh" "/bin/sh")))
(should (member (executable-find "ls") '("/usr/bin/ls" "/bin/ls")))
- ;; TODO Test tramp remote directory.
- (let ((default-directory (format "/sudo:%s@localhost:/" user-login-name)))
+ ;; Tramp test (mock protocol)
+ (let ((default-directory "/mock::/"))
(should (member (compat-call executable-find "sh" t) '("/usr/bin/sh"
"/bin/sh")))
(should (member (compat-call executable-find "ls" t) '("/usr/bin/ls"
"/bin/ls")))))
(ert-deftest exec-path ()
(should-equal (exec-path) exec-path)
- ;; TODO Test tramp remote directory.
- (let ((default-directory (format "/sudo:%s@localhost:/" user-login-name)))
- (should (file-directory-p (car (exec-path))))))
+ ;; Tramp test (mock protocol)
+ (let ((default-directory "/mock::/"))
+ (should (member "/bin" (exec-path)))))
(ert-deftest with-existing-directory ()
(let ((dir (make-temp-name "/tmp/not-exist-")))
@@ -1284,12 +1303,9 @@
(should-equal (temporary-file-directory) temporary-file-directory)
(let ((default-directory "/mnt"))
(should-equal (temporary-file-directory) default-directory))
- ;; TODO Implement Tramp test
- ;;(let ((default-directory "/sudo:/"))
- ;; (should-equal (temporary-file-directory) temporary-file-directory))
- ;;(let ((default-directory "/ssh:does-not-exist:/"))
- ;; (should-equal (temporary-file-directory) "/ssh:does-not-exist:/tmp/"))
- )
+ ;; Tramp test (mock protocol)
+ (let ((default-directory "/mock::/"))
+ (should (string-match-p "\\`/mock:.*:/tmp/?\\'"
(temporary-file-directory)))))
(ert-deftest directory-files ()
(should-not (compat-call directory-files "." nil nil nil 0))
@@ -1444,10 +1460,11 @@
(should-equal "" (file-local-name ""))
(should-equal "foo" (file-local-name "foo"))
(should-equal "/bar/foo" (file-local-name "/bar/foo"))
- ;; These tests fails prior to Emacs 26, because /ssh:foo was a valid
+ ;; NOTE: These tests fails prior to Emacs 26, because /ssh:foo was a valid
;; TRAMP path back then.
- ;; (should-equal "/ssh:foo" (file-local-name "/ssh:foo"))
- ;; (should-equal "/ssh:/bar/foo" (file-local-name "/ssh:/bar/foo"))
+ (when (>= emacs-major-version 26)
+ (should-equal "/ssh:foo" (file-local-name "/ssh:foo"))
+ (should-equal "/ssh:/bar/foo" (file-local-name "/ssh:/bar/foo")))
(should-equal "foo" (file-local-name "/ssh::foo"))
(should-equal "/bar/foo" (file-local-name "/ssh::/bar/foo"))
(should-equal ":foo" (file-local-name "/ssh:::foo"))
@@ -1461,11 +1478,10 @@
(should-not (compat-call file-name-quoted-p "/ssh::"))
(should-not (compat-call file-name-quoted-p "/ssh::a"))
(should (compat-call file-name-quoted-p "/ssh::/:a"))
- ;; These tests fails prior to Emacs 26, because /ssh:foo was a valid
+ ;; NOTE: These tests fails prior to Emacs 26, because /ssh:foo was a valid
;; TRAMP path back then.
- ;;
- ;; (should-not (compat-call file-name-quoted-p "/ssh:/:a")))
- )
+ (when (>= emacs-major-version 26)
+ (should-not (compat-call file-name-quoted-p "/ssh:/:a"))))
(ert-deftest file-name-quote ()
(should-equal "/:" (compat-call file-name-quote ""))
