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.

diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el
index c22869d2cc23008a68be658e3013b7d04cfa7e4d..760d020f672831a3fb7570429017ef2f491f7707 100644 (file)
--- 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 5d9a1fd19673ba88acb00ccb81b9dda9d1f851b1..214ad040a17f16789d56b403b6e2bd2681805958 100644 (file)
--- 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 7df5aa3b7b07df89d415139583d6dfc5634edf04..5f145d4fae116260668862e68ca4800a97a308da 100644 (file)
--- 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 4969566670793b2357a1f1831f69f556b4fc65a4..ee6baaab121256cf1730621cce9906d8c96c5c79 100644 (file)
--- 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 45776078be3e362a7d365a7b3e935e17f71ff35b..07c06808bb22c2d0b2c3c804c34bc15b8035be41 100644 (file)
--- 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 e8515302c008a943b55c43842140db62687bb2d0..88e97092ed7b4b52d5c1671d858c26853f7d4fb0 100644 (file)
--- 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))