emacs-diffs
[Top][All Lists]
Advanced

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

master 680906c136a: Some minor Tramp changes


From: Michael Albinus
Subject: master 680906c136a: Some minor Tramp changes
Date: Sun, 29 Dec 2024 06:26:18 -0500 (EST)

branch: master
commit 680906c136adfefda3a5d8be2b3ab7527521a449
Author: Michael Albinus <michael.albinus@gmx.de>
Commit: Michael Albinus <michael.albinus@gmx.de>

    Some minor Tramp changes
    
    * lisp/net/tramp-sh.el (tramp-sh-handle-process-file): Do proper quoting.
    
    * lisp/net/tramp.el (tramp-string-empty-or-nil-p):
    Declare `tramp-suppress-trace' property.
    (tramp-skeleton-make-symbolic-link): Drop volume letter when flushing.
    
    * test/lisp/net/tramp-tests.el (tramp-test39-make-lock-file-name):
    Adapt test.
    (tramp-test42-utf8): Do not run expensive tests on MS Windows.
---
 lisp/net/tramp-sh.el         |   5 +--
 lisp/net/tramp.el            |  10 ++++-
 test/lisp/net/tramp-tests.el | 105 ++++++++++++++++++++++++-------------------
 3 files changed, 70 insertions(+), 50 deletions(-)

diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el
index 5535ed3ab60..7b82195ed68 100644
--- a/lisp/net/tramp-sh.el
+++ b/lisp/net/tramp-sh.el
@@ -3278,8 +3278,7 @@ will be used."
               (setq ret (tramp-send-command-and-check
                         v (format
                            "cd %s && %s"
-                           (tramp-unquote-shell-quote-argument localname)
-                           command)
+                           (tramp-shell-quote-argument localname) command)
                         t t t))
            (unless (natnump ret) (setq ret 1))
            ;; We should add the output anyway.
@@ -5675,7 +5674,7 @@ Nonexistent directories are removed from spec."
        (dolist (cmd
                ;; Prefer GNU ls on *BSD and macOS.
                 (if (tramp-check-remote-uname vec tramp-bsd-unames)
-                   '( "gls" "ls" "gnuls") '("ls" "gnuls" "gls")))
+                   '("gls" "ls" "gnuls") '("ls" "gnuls" "gls")))
         (let ((dl (tramp-get-remote-path vec))
               result)
           (while (and dl (setq result (tramp-find-executable vec cmd dl t t)))
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index c23eed0bc1b..03e12471176 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -1888,8 +1888,14 @@ See `tramp-dissect-file-name' for details."
 ;;;###tramp-autoload
 (defsubst tramp-string-empty-or-nil-p (string)
   "Check whether STRING is empty or nil."
+  ;; (declare (tramp-suppress-trace t))
   (or (null string) (string= string "")))
 
+;; We cannot use the `declare' form for `tramp-suppress-trace' in
+;; autoloaded functions, because the tramp-loaddefs.el generation
+;; would fail.
+(function-put #'tramp-string-empty-or-nil-p 'tramp-suppress-trace t)
+
 (defun tramp-buffer-name (vec)
   "A name for the connection buffer VEC."
   (declare (tramp-suppress-trace t))
@@ -3717,7 +3723,9 @@ on the same host.  Otherwise, TARGET is quoted."
         (setf ,target (tramp-file-local-name (expand-file-name ,target))))
        ;; There could be a cyclic link.
        (tramp-flush-file-properties
-       v (expand-file-name ,target (tramp-file-local-name default-directory))))
+       v (tramp-drop-volume-letter
+          (expand-file-name
+           ,target (tramp-file-local-name default-directory)))))
 
      ;; If TARGET is still remote, quote it.
      (if (tramp-tramp-file-p ,target)
diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el
index 91d0fd82788..5bd8b13bd13 100644
--- a/test/lisp/net/tramp-tests.el
+++ b/test/lisp/net/tramp-tests.el
@@ -6878,34 +6878,40 @@ INPUT, if non-nil, is a string sent to the process."
             (should-not (file-locked-p tmp-name1))
 
             ;; `kill-buffer' removes the lock.
-           (lock-file tmp-name1)
-           (should (eq (file-locked-p tmp-name1) t))
-            (with-temp-buffer
-              (set-visited-file-name tmp-name1)
-              (insert "foo")
-             (should (buffer-modified-p))
-             (cl-letf (((symbol-function #'read-from-minibuffer)
-                         (lambda (&rest _args) "yes")))
-                (kill-buffer)))
-           (should-not (file-locked-p tmp-name1))
+           ;; `kill-buffer--possibly-save' exists since Emacs 29.1.
+           (when (fboundp 'kill-buffer--possibly-save)
+             (lock-file tmp-name1)
+             (should (eq (file-locked-p tmp-name1) t))
+              (with-temp-buffer
+               (set-visited-file-name tmp-name1)
+               (insert "foo")
+               (should (buffer-modified-p))
+               ;; Modifying `read-from-minibuffer' doesn't work on MS Windows.
+               (cl-letf (((symbol-function #'kill-buffer--possibly-save)
+                          #'always))
+                  (kill-buffer)))
+             (should-not (file-locked-p tmp-name1)))
 
             ;; `kill-buffer' should not remove the lock when the
             ;; connection is broken.  See Bug#61663.
-           (lock-file tmp-name1)
-           (should (eq (file-locked-p tmp-name1) t))
-            (with-temp-buffer
-              (set-visited-file-name tmp-name1)
-              (insert "foo")
-             (should (buffer-modified-p))
-             (tramp-cleanup-connection
-              tramp-test-vec 'keep-debug 'keep-password)
-             (cl-letf (((symbol-function #'read-from-minibuffer)
-                         (lambda (&rest _args) "yes")))
-                (kill-buffer)))
-           ;; A new connection changes process id, and also the
-           ;; lock file contents.  But it still exists.
-           (tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password)
-           (should (stringp (file-locked-p tmp-name1)))
+           ;; `kill-buffer--possibly-save' exists since Emacs 29.1.
+           (when (fboundp 'kill-buffer--possibly-save)
+             (lock-file tmp-name1)
+             (should (eq (file-locked-p tmp-name1) t))
+              (with-temp-buffer
+               (set-visited-file-name tmp-name1)
+               (insert "foo")
+               (should (buffer-modified-p))
+               (tramp-cleanup-connection
+                tramp-test-vec 'keep-debug 'keep-password)
+               ;; Modifying `read-from-minibuffer' doesn't work on MS Windows.
+               (cl-letf (((symbol-function #'kill-buffer--possibly-save)
+                          #'always))
+                  (kill-buffer)))
+             ;; A new connection changes process id, and also the
+             ;; lock file contents.  But it still exists.
+             (tramp-cleanup-connection tramp-test-vec 'keep-debug 
'keep-password)
+             (should (stringp (file-locked-p tmp-name1))))
 
            ;; When `remote-file-name-inhibit-locks' is set, nothing happens.
            (tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password)
@@ -6928,34 +6934,41 @@ INPUT, if non-nil, is a string sent to the process."
 
            ;; Steal the file lock.
            (tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password)
-           (cl-letf (((symbol-function #'read-char) (lambda (&rest _args) ?s)))
+           ;; Modifying `read-char' doesn't work on MS Windows.
+           (cl-letf (((symbol-function #'ask-user-about-lock) #'always))
              (lock-file tmp-name1))
            (should (eq (file-locked-p tmp-name1) t))
 
            ;; Ignore the file lock.
            (tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password)
-           (cl-letf (((symbol-function #'read-char) (lambda (&rest _args) ?p)))
+           ;; Modifying `read-char' doesn't work on MS Windows.
+           (cl-letf (((symbol-function #'ask-user-about-lock) #'ignore))
              (lock-file tmp-name1))
            (should (stringp (file-locked-p tmp-name1)))
 
-           ;; Quit the file lock machinery.
-           (tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password)
-           (cl-letf (((symbol-function #'read-char) (lambda (&rest _args) ?q)))
-             (should-error
-              (lock-file tmp-name1)
-              :type 'file-locked)
-             ;; The same for `write-region'.
-             (should-error
-              (write-region "foo" nil tmp-name1)
-              :type 'file-locked)
-             (should-error
-              (write-region "foo" nil tmp-name1 nil nil tmp-name1)
-               :type 'file-locked)
-             ;; The same for `set-visited-file-name'.
-              (with-temp-buffer
-               (should-error
-                 (set-visited-file-name tmp-name1)
-                :type 'file-locked)))
+           ;; Quit the file lock machinery.  There are problems with
+           ;; "sftp" and "podman", so we test on Emacs 29.1 only.
+           (when (tramp--test-emacs29-p )
+             (tramp-cleanup-connection tramp-test-vec 'keep-debug 
'keep-password)
+             ;; Modifying `read-char' doesn't work on MS Windows.
+             (cl-letf (((symbol-function #'ask-user-about-lock)
+                        (lambda (&rest args)
+                          (signal 'file-locked args))))
+               (should-error
+                (lock-file tmp-name1)
+                :type 'file-locked)
+               ;; The same for `write-region'.
+               (should-error
+                (write-region "foo" nil tmp-name1)
+                :type 'file-locked)
+               (should-error
+                (write-region "foo" nil tmp-name1 nil nil tmp-name1)
+                :type 'file-locked)
+               ;; The same for `set-visited-file-name'.
+               (with-temp-buffer
+                 (should-error
+                   (set-visited-file-name tmp-name1)
+                  :type 'file-locked))))
            (should (stringp (file-locked-p tmp-name1))))
 
        ;; Cleanup.
@@ -7647,7 +7660,7 @@ This requires restrictions of file name syntax."
        ;; to U+1FFFF).
        "🌈🍒👋")
 
-      (when (tramp--test-expensive-test-p)
+      (when (and (tramp--test-expensive-test-p) (not 
(tramp--test-windows-nt-p)))
        (delete-dups
         (mapcar
          ;; Use all available language specific snippets.



reply via email to

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