emacs-elpa-diffs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[elpa] externals/compat 6f22d46c85 1/2: Improve exec-path, executable-fi


From: ELPA Syncer
Subject: [elpa] externals/compat 6f22d46c85 1/2: Improve exec-path, executable-find and temporary-file-directory
Date: Mon, 16 Jan 2023 16:57:26 -0500 (EST)

branch: externals/compat
commit 6f22d46c857d3fbf41242854514dee276e027a3f
Author: Daniel Mendler <mail@daniel-mendler.de>
Commit: Daniel Mendler <mail@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 ""))



reply via email to

[Prev in Thread] Current Thread [Next in Thread]