From: Michael Albinus Date: Sun, 17 Sep 2017 17:16:59 +0000 (+0200) Subject: Fix compatibility problem in Tramp X-Git-Tag: emacs-26.0.90~148 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=57249fb297237bb942ead1f7a0af0ac20811a9cf;p=emacs.git 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 c22869d2cc2..760d020f672 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 5d9a1fd1967..214ad040a17 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 7df5aa3b7b0..5f145d4fae1 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 49695666707..ee6baaab121 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 45776078be3..07c06808bb2 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 e8515302c00..88e97092ed7 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))