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.
This commit is contained in:
Michael Albinus 2017-09-17 19:16:59 +02:00
parent 411bec82c4
commit 57249fb297
6 changed files with 37 additions and 32 deletions

View file

@ -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)))

View file

@ -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:

View file

@ -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)))

View file

@ -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)))

View file

@ -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)

View file

@ -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))