[Emacs-diffs] emacs-26 57249fb: Fix compatibility problem in Tramp

[Michael Albinus]

branch: emacs-26
commit 57249fb297237bb942ead1f7a0af0ac20811a9cf
Author: Michael Albinus <address@hidden>
Commit: Michael Albinus <address@hidden>

    Fix compatibility problem in Tramp
    
    * lisp/net/tramp.el (tramp-interrupt-process): Better error handling.
    
    * lisp/net/tramp-compat.el (default-toplevel-value): Move up.
    (top): Do not call `tramp-change-syntax' anymore.
    (tramp-compat-directory-name-p): New defalias.
    
    * lisp/net/tramp-adb.el (tramp-adb-handle-copy-file):
    * lisp/net/tramp-sh.el (tramp-sh-handle-copy-directory):
    * lisp/net/tramp-smb.el (tramp-smb-handle-copy-directory)
    (tramp-smb-handle-copy-file): Use it.
    
    * test/lisp/net/tramp-tests.el (tramp-test28-interrupt-process):
    Modify test.
---
 lisp/net/tramp-adb.el        |  2 +-
 lisp/net/tramp-compat.el     | 33 ++++++++++++++++++++-------------
 lisp/net/tramp-sh.el         |  2 +-
 lisp/net/tramp-smb.el        |  4 ++--
 lisp/net/tramp.el            | 21 +++++++++++----------
 test/lisp/net/tramp-tests.el |  7 ++-----
 6 files changed, 37 insertions(+), 32 deletions(-)

diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el
index c22869d..760d020 100644
--- a/lisp/net/tramp-adb.el
+++ b/lisp/net/tramp-adb.el
@@ -740,7 +740,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are 
completely ignored."
 
                ;; Remote newname.
                (when (and (file-directory-p newname)
-                          (directory-name-p newname))
+                          (tramp-compat-directory-name-p newname))
                  (setq newname
                        (expand-file-name
                         (file-name-nondirectory filename) newname)))
diff --git a/lisp/net/tramp-compat.el b/lisp/net/tramp-compat.el
index 5d9a1fd..214ad04 100644
--- a/lisp/net/tramp-compat.el
+++ b/lisp/net/tramp-compat.el
@@ -23,8 +23,9 @@
 
 ;;; Commentary:
 
-;; Tramp's main Emacs version for development is Emacs 26.  This
-;; package provides compatibility functions for Emacs 24 and Emacs 25.
+;; Tramp's main Emacs version for development is Emacs 27.  This
+;; package provides compatibility functions for Emacs 24, Emacs 25 and
+;; Emacs 26.
 
 ;;; Code:
 
@@ -104,6 +105,10 @@ Add the extension of F, if existing."
    'tramp-error vec-or-proc
    (if (fboundp 'user-error) 'user-error 'error) format args))
 
+;; `default-toplevel-value' has been declared in Emacs 24.4.
+(unless (fboundp 'default-toplevel-value)
+  (defalias 'default-toplevel-value 'symbol-value))
+
 ;; `file-attribute-*' are introduced in Emacs 25.1.
 
 (if (fboundp 'file-attribute-type)
@@ -163,14 +168,23 @@ This is a floating point number if the size is too large 
for an integer."
 This is a string of ten letters or dashes as in ls -l."
     (nth 8 attributes)))
 
-;; `default-toplevel-value' has been declared in Emacs 24.4.
-(unless (fboundp 'default-toplevel-value)
-  (defalias 'default-toplevel-value 'symbol-value))
-
 ;; `format-message' is new in Emacs 25.1.
 (unless (fboundp 'format-message)
   (defalias 'format-message 'format))
 
+;; `directory-name-p' is new in Emacs 25.1.
+(if (fboundp 'directory-name-p)
+    (defalias 'tramp-compat-directory-name-p 'directory-name-p)
+  (defsubst tramp-compat-directory-name-p (name)
+    "Return non-nil if NAME ends with a directory separator character."
+    (let ((len (length name))
+          (lastc ?.))
+      (if (> len 0)
+          (setq lastc (aref name (1- len))))
+      (or (= lastc ?/)
+          (and (memq system-type '(windows-nt ms-dos))
+               (= lastc ?\\))))))
+
 ;; `file-missing' is introduced in Emacs 26.1.
 (defconst tramp-file-missing
   (if (get 'file-missing 'error-conditions) 'file-missing 'file-error)
@@ -221,13 +235,6 @@ If NAME is a remote file name, the local part of NAME is 
unquoted."
        ((eq tramp-syntax 'sep) 'separate)
        (t tramp-syntax)))
 
-;; Older Emacsen keep incompatible autoloaded values of `tramp-syntax'.
-(eval-after-load 'tramp
-  '(unless
-       (memq tramp-syntax (tramp-compat-funcall (quote tramp-syntax-values)))
-     (tramp-compat-funcall
-      (quote tramp-change-syntax) (tramp-compat-tramp-syntax))))
-
 (provide 'tramp-compat)
 
 ;;; TODO:
diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el
index 7df5aa3..5f145d4 100644
--- a/lisp/net/tramp-sh.el
+++ b/lisp/net/tramp-sh.el
@@ -1985,7 +1985,7 @@ tramp-sh-handle-file-name-all-completions: internal error 
accessing `%s': `%s'"
          ;; scp or rsync DTRT.
          (progn
            (when (and (file-directory-p newname)
-                      (not (directory-name-p newname)))
+                      (not (tramp-compat-directory-name-p newname)))
              (tramp-error v 'file-already-exists newname))
            (setq dirname (directory-file-name (expand-file-name dirname))
                  newname (directory-file-name (expand-file-name newname)))
diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el
index 4969566..ee6baaa 100644
--- a/lisp/net/tramp-smb.el
+++ b/lisp/net/tramp-smb.el
@@ -415,7 +415,7 @@ pass to the OPERATION."
        (with-tramp-progress-reporter
            v 0 (format "Copying %s to %s" dirname newname)
          (when (and (file-directory-p newname)
-                    (not (directory-name-p newname)))
+                    (not (tramp-compat-directory-name-p newname)))
            (tramp-error v 'file-already-exists newname))
          (cond
           ;; We must use a local temporary directory.
@@ -586,7 +586,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are 
completely ignored."
 
          ;; Remote newname.
          (when (and (file-directory-p newname)
-                    (directory-name-p newname))
+                    (tramp-compat-directory-name-p newname))
            (setq newname
                  (expand-file-name (file-name-nondirectory filename) newname)))
 
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index 4577607..07c0680 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -4547,16 +4547,17 @@ Only works for Bourne-like shells."
               (t                  process)))
        pid)
     ;; If it's a Tramp process, send the INT signal remotely.
-    (when (and (processp proc) (process-live-p proc)
-              (setq pid (process-get proc 'remote-pid)))
-      (tramp-message proc 5 "Interrupt process %s with pid %s" proc pid)
-      ;; This is for tramp-sh.el.  Other backends do not support this (yet).
-      (tramp-compat-funcall
-       'tramp-send-command
-       (tramp-get-connection-property proc "vector" nil)
-       (format "kill -2 %d" pid))
-      ;; Report success.
-      proc)))
+    (when (and (processp proc) (setq pid (process-get proc 'remote-pid)))
+      (if (not  (process-live-p proc))
+         (tramp-error proc 'error "Process %s is not active" proc)
+       (tramp-message proc 5 "Interrupt process %s with pid %s" proc pid)
+       ;; This is for tramp-sh.el.  Other backends do not support this (yet).
+       (tramp-compat-funcall
+        'tramp-send-command
+        (tramp-get-connection-property proc "vector" nil)
+        (format "kill -2 %d" pid))
+       ;; Report success.
+       proc))))
 
 ;; `interrupt-process-functions' exists since Emacs 26.1.
 (when (boundp 'interrupt-process-functions)
diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el
index e851530..88e9709 100644
--- a/test/lisp/net/tramp-tests.el
+++ b/test/lisp/net/tramp-tests.el
@@ -3193,15 +3193,13 @@ This tests also `make-symbolic-link', `file-truename' 
and `add-name-to-file'."
          (should (processp proc))
          (should (process-live-p proc))
          (should (equal (process-status proc) 'run))
+         (should (numberp (process-get proc 'remote-pid)))
          (should (interrupt-process proc))
          ;; Let the process accept the interrupt.
           (accept-process-output proc 1 nil 0)
          (should-not (process-live-p proc))
-         (should (equal (process-status proc) 'signal))
          ;; An interrupted process cannot be interrupted, again.
-         ;; Does not work reliable.
-         ;; (should-error (interrupt-process proc) :type 'error))
-         )
+         (should-error (interrupt-process proc) :type 'error))
 
       ;; Cleanup.
       (ignore-errors (delete-process proc)))))
@@ -3477,7 +3475,6 @@ This tests also `make-symbolic-link', `file-truename' and 
`add-name-to-file'."
   (skip-unless (tramp--test-enabled))
   (skip-unless (tramp--test-sh-p))
 
-  ;; TODO: This test fails.
   (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil)))
     (let* ((default-directory tramp-test-temporary-file-directory)
           (tmp-name1 (tramp--test-make-temp-name nil quoted))