[Emacs-diffs] emacs-26 646e56e: Fix Bug#28959

[Michael Albinus]

branch: emacs-26
commit 646e56e150ca08978d6ce736b12867b4958a0cd8
Author: Michael Albinus <address@hidden>
Commit: Michael Albinus <address@hidden>

    Fix Bug#28959
    
    * lisp/net/tramp.el (tramp-handle-find-backup-file-name):
    Use `tramp-tramp-file-p' rather than `tramp-file-name-p'.  Add
    hop to backup file name.  (Bug#28959)
    
    * test/lisp/net/tramp-tests.el (tramp-test34-find-backup-file-name):
    New test.
    (tramp-test35-make-nearby-temp-file)
    (tramp-test36-special-characters)
    (tramp-test36-special-characters-with-stat)
    (tramp-test36-special-characters-with-perl)
    (tramp-test36-special-characters-with-ls, tramp-test37-utf8)
    (tramp-test37-utf8-with-stat, tramp-test37-utf8-with-perl)
    (tramp-test37-utf8-with-ls, tramp-test38-file-system-info)
    (tramp-test39-asynchronous-requests)
    (tramp-test40-recursive-load, tramp-test41-remote-load-path)
    (tramp-test42-delay-load, tramp-test43-unload): Rename.
---
 lisp/net/tramp.el            |   4 +-
 test/lisp/net/tramp-tests.el | 132 ++++++++++++++++++++++++++++++++++++-------
 2 files changed, 115 insertions(+), 21 deletions(-)

diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index 736c28c..e300b3a 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -3226,9 +3226,9 @@ User is always nil."
                   (car x)
                   (if (and (stringp (cdr x))
                            (file-name-absolute-p (cdr x))
-                           (not (tramp-file-name-p (cdr x))))
+                           (not (tramp-tramp-file-p (cdr x))))
                       (tramp-make-tramp-file-name
-                       method user domain host port (cdr x))
+                       method user domain host port (cdr x) hop)
                     (cdr x))))
                tramp-backup-directory-alist)
             backup-directory-alist)))
diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el
index 7e644e6..af707f8 100644
--- a/test/lisp/net/tramp-tests.el
+++ b/test/lisp/net/tramp-tests.el
@@ -3638,8 +3638,103 @@ This tests also `make-symbolic-link', `file-truename' 
and `add-name-to-file'."
        (ignore-errors (delete-file tmp-name1))
        (ignore-errors (delete-directory tmp-name2 'recursive))))))
 
+(ert-deftest tramp-test34-find-backup-file-name ()
+  "Check `find-backup-file-name'."
+  (skip-unless (tramp--test-enabled))
+
+  (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil)))
+    (let ((tmp-name1 (tramp--test-make-temp-name nil quoted))
+         (tmp-name2 (tramp--test-make-temp-name nil quoted))
+         ;; These settings are not used by Tramp, so we ignore them.
+         version-control delete-old-versions
+         (kept-old-versions (default-toplevel-value 'kept-old-versions))
+         (kept-new-versions (default-toplevel-value 'kept-new-versions)))
+
+      (unwind-protect
+         ;; Use default `backup-directory-alist' mechanism.
+         (let (backup-directory-alist tramp-backup-directory-alist)
+           (should
+            (equal
+             (find-backup-file-name tmp-name1)
+             (list
+              (funcall
+               (if quoted 'tramp-compat-file-name-quote 'identity)
+               (expand-file-name
+                (format "%s~" (file-name-nondirectory tmp-name1))
+                tramp-test-temporary-file-directory)))))))
+
+      (unwind-protect
+         ;; Map `backup-directory-alist'.
+         (let ((backup-directory-alist `(("." . ,tmp-name2)))
+               tramp-backup-directory-alist)
+           (should
+            (equal
+             (find-backup-file-name tmp-name1)
+             (list
+              (funcall
+               (if quoted 'tramp-compat-file-name-quote 'identity)
+               (expand-file-name
+                (format
+                 "%s~"
+                 ;; This is taken from `make-backup-file-name-1'.
+                 (subst-char-in-string
+                  ?/ ?! (replace-regexp-in-string "!" "!!" tmp-name1)))
+                tmp-name2)))))
+           ;; The backup directory is created.
+           (should (file-directory-p tmp-name2)))
+
+       ;; Cleanup.
+       (ignore-errors (delete-directory tmp-name2 'recursive)))
+
+      (unwind-protect
+         ;; Map `tramp-backup-directory-alist'.
+         (let ((tramp-backup-directory-alist `(("." . ,tmp-name2)))
+               backup-directory-alist)
+           (should
+            (equal
+             (find-backup-file-name tmp-name1)
+             (list
+              (funcall
+               (if quoted 'tramp-compat-file-name-quote 'identity)
+               (expand-file-name
+                (format
+                 "%s~"
+                 ;; This is taken from `make-backup-file-name-1'.
+                 (subst-char-in-string
+                  ?/ ?! (replace-regexp-in-string "!" "!!" tmp-name1)))
+                tmp-name2)))))
+           ;; The backup directory is created.
+           (should (file-directory-p tmp-name2)))
+
+       ;; Cleanup.
+       (ignore-errors (delete-directory tmp-name2 'recursive)))
+
+      (unwind-protect
+         ;; Map `tramp-backup-directory-alist' with local file name.
+         (let ((tramp-backup-directory-alist
+                `(("." . ,(file-remote-p tmp-name2 'localname))))
+               backup-directory-alist)
+           (should
+            (equal
+             (find-backup-file-name tmp-name1)
+             (list
+              (funcall
+               (if quoted 'tramp-compat-file-name-quote 'identity)
+               (expand-file-name
+                (format
+                 "%s~"
+                 ;; This is taken from `make-backup-file-name-1'.
+                 (subst-char-in-string
+                  ?/ ?! (replace-regexp-in-string "!" "!!" tmp-name1)))
+                tmp-name2)))))
+           ;; The backup directory is created.
+           (should (file-directory-p tmp-name2)))
+
+       ;; Cleanup.
+       (ignore-errors (delete-directory tmp-name2 'recursive))))))
+
 ;; The functions were introduced in Emacs 26.1.
-(ert-deftest tramp-test34-make-nearby-temp-file ()
+(ert-deftest tramp-test35-make-nearby-temp-file ()
   "Check `make-nearby-temp-file' and `temporary-file-directory'."
   (skip-unless (tramp--test-enabled))
   ;; Since Emacs 26.1.
@@ -3904,7 +3999,7 @@ This requires restrictions of file name syntax."
        (ignore-errors (delete-directory tmp-name2 'recursive))))))
 
 (defun tramp--test-special-characters ()
-  "Perform the test in `tramp-test35-special-characters*'."
+  "Perform the test in `tramp-test36-special-characters*'."
   ;; Newlines, slashes and backslashes in file names are not
   ;; supported.  So we don't test.  And we don't test the tab
   ;; character on Windows or Cygwin, because the backslash is
@@ -3947,7 +4042,7 @@ This requires restrictions of file name syntax."
    "{foo}bar{baz}"))
 
 ;; These tests are inspired by Bug#17238.
-(ert-deftest tramp-test35-special-characters ()
+(ert-deftest tramp-test36-special-characters ()
   "Check special characters in file names."
   (skip-unless (tramp--test-enabled))
   (skip-unless (not (tramp--test-rsync-p)))
@@ -3955,7 +4050,7 @@ This requires restrictions of file name syntax."
 
   (tramp--test-special-characters))
 
-(ert-deftest tramp-test35-special-characters-with-stat ()
+(ert-deftest tramp-test36-special-characters-with-stat ()
   "Check special characters in file names.
 Use the `stat' command."
   :tags '(:expensive-test)
@@ -3973,7 +4068,7 @@ Use the `stat' command."
          tramp-connection-properties)))
     (tramp--test-special-characters)))
 
-(ert-deftest tramp-test35-special-characters-with-perl ()
+(ert-deftest tramp-test36-special-characters-with-perl ()
   "Check special characters in file names.
 Use the `perl' command."
   :tags '(:expensive-test)
@@ -3994,7 +4089,7 @@ Use the `perl' command."
          tramp-connection-properties)))
     (tramp--test-special-characters)))
 
-(ert-deftest tramp-test35-special-characters-with-ls ()
+(ert-deftest tramp-test36-special-characters-with-ls ()
   "Check special characters in file names.
 Use the `ls' command."
   :tags '(:expensive-test)
@@ -4017,7 +4112,7 @@ Use the `ls' command."
     (tramp--test-special-characters)))
 
 (defun tramp--test-utf8 ()
-  "Perform the test in `tramp-test36-utf8*'."
+  "Perform the test in `tramp-test37-utf8*'."
   (let* ((utf8 (if (and (eq system-type 'darwin)
                        (memq 'utf-8-hfs (coding-system-list)))
                   'utf-8-hfs 'utf-8))
@@ -4032,7 +4127,7 @@ Use the `ls' command."
      "银河系漫游指南系列"
      "Автостопом по гала́ктике")))
 
-(ert-deftest tramp-test36-utf8 ()
+(ert-deftest tramp-test37-utf8 ()
   "Check UTF8 encoding in file names and file contents."
   (skip-unless (tramp--test-enabled))
   (skip-unless (not (tramp--test-docker-p)))
@@ -4042,7 +4137,7 @@ Use the `ls' command."
 
   (tramp--test-utf8))
 
-(ert-deftest tramp-test36-utf8-with-stat ()
+(ert-deftest tramp-test37-utf8-with-stat ()
   "Check UTF8 encoding in file names and file contents.
 Use the `stat' command."
   :tags '(:expensive-test)
@@ -4062,7 +4157,7 @@ Use the `stat' command."
          tramp-connection-properties)))
     (tramp--test-utf8)))
 
-(ert-deftest tramp-test36-utf8-with-perl ()
+(ert-deftest tramp-test37-utf8-with-perl ()
   "Check UTF8 encoding in file names and file contents.
 Use the `perl' command."
   :tags '(:expensive-test)
@@ -4085,7 +4180,7 @@ Use the `perl' command."
          tramp-connection-properties)))
     (tramp--test-utf8)))
 
-(ert-deftest tramp-test36-utf8-with-ls ()
+(ert-deftest tramp-test37-utf8-with-ls ()
   "Check UTF8 encoding in file names and file contents.
 Use the `ls' command."
   :tags '(:expensive-test)
@@ -4108,7 +4203,7 @@ Use the `ls' command."
          tramp-connection-properties)))
     (tramp--test-utf8)))
 
-(ert-deftest tramp-test37-file-system-info ()
+(ert-deftest tramp-test38-file-system-info ()
   "Check that `file-system-info' returns proper values."
   (skip-unless (tramp--test-enabled))
   ;; Since Emacs 27.1.
@@ -4130,7 +4225,7 @@ Use the `ls' command."
   (ert-fail (format "`%s' timed out" (ert-test-name (ert-running-test)))))
 
 ;; This test is inspired by Bug#16928.
-(ert-deftest tramp-test38-asynchronous-requests ()
+(ert-deftest tramp-test39-asynchronous-requests ()
   "Check parallel asynchronous requests.
 Such requests could arrive from timers, process filters and
 process sentinels.  They shall not disturb each other."
@@ -4287,7 +4382,7 @@ process sentinels.  They shall not disturb each other."
         (ignore-errors (cancel-timer timer))
         (ignore-errors (delete-directory tmp-name 'recursive)))))))
 
-(ert-deftest tramp-test39-recursive-load ()
+(ert-deftest tramp-test40-recursive-load ()
   "Check that Tramp does not fail due to recursive load."
   (skip-unless (tramp--test-enabled))
 
@@ -4310,7 +4405,7 @@ process sentinels.  They shall not disturb each other."
          (mapconcat 'shell-quote-argument load-path " -L ")
          (shell-quote-argument code))))))))
 
-(ert-deftest tramp-test40-remote-load-path ()
+(ert-deftest tramp-test41-remote-load-path ()
   "Check that Tramp autoloads its packages with remote `load-path'."
   ;; `tramp-cleanup-all-connections' is autoloaded from tramp-cmds.el.
   ;; It shall still work, when a remote file name is in the
@@ -4333,7 +4428,7 @@ process sentinels.  They shall not disturb each other."
        (mapconcat 'shell-quote-argument load-path " -L ")
        (shell-quote-argument code)))))))
 
-(ert-deftest tramp-test41-delay-load ()
+(ert-deftest tramp-test42-delay-load ()
   "Check that Tramp is loaded lazily, only when needed."
   ;; Tramp is neither loaded at Emacs startup, nor when completing a
   ;; non-Tramp file name like "/foo".  Completing a Tramp-alike file
@@ -4355,7 +4450,7 @@ process sentinels.  They shall not disturb each other."
        (mapconcat 'shell-quote-argument load-path " -L ")
        (shell-quote-argument code)))))))
 
-(ert-deftest tramp-test42-unload ()
+(ert-deftest tramp-test43-unload ()
   "Check that Tramp and its subpackages unload completely.
 Since it unloads Tramp, it shall be the last test to run."
   :tags '(:expensive-test)
@@ -4408,7 +4503,6 @@ Since it unloads Tramp, it shall be the last test to run."
 ;; * file-acl
 ;; * file-name-case-insensitive-p
 ;; * file-selinux-context
-;; * find-backup-file-name
 ;; * set-file-acl
 ;; * set-file-selinux-context
 
@@ -4417,7 +4511,7 @@ Since it unloads Tramp, it shall be the last test to run."
 ;; * Fix `tramp-test06-directory-file-name' for `ftp'.
 ;; * Fix `tramp-test27-start-file-process' on MS Windows (`process-send-eof'?).
 ;; * Fix `tramp-test28-interrupt-process', timeout doesn't work reliably.
-;; * Fix Bug#16928 in `tramp-test38-asynchronous-requests'.
+;; * Fix Bug#16928 in `tramp-test39-asynchronous-requests'.
 
 (defun tramp-test-all (&optional interactive)
   "Run all tests for \\[tramp]."