Revert a1bbc49015 (Bug#30243), do not merge

* lisp/files.el:
* test/lisp/net/tramp-tests.el: Revert a1bbc49015.  (Bug#30243)
This commit is contained in:
Michael Albinus 2018-02-01 15:00:18 +01:00
parent 855ae578ab
commit 01932c8dec
2 changed files with 69 additions and 80 deletions

View file

@ -6978,67 +6978,60 @@ only these files will be asked to be saved."
;; We depend on being the last handler on the list, ;; We depend on being the last handler on the list,
;; so that anything else which does need handling ;; so that anything else which does need handling
;; has been handled already. ;; has been handled already.
;; So it is safe for us to inhibit *all* magic file name handlers for ;; So it is safe for us to inhibit *all* magic file name handlers.
;; operations, which return a file name. See Bug#29579.
(defun file-name-non-special (operation &rest arguments) (defun file-name-non-special (operation &rest arguments)
(let* ((op-returns-file-name-list (let ((file-name-handler-alist nil)
'(expand-file-name file-name-directory file-name-as-directory (default-directory
directory-file-name file-name-sans-versions ;; Some operations respect file name handlers in
find-backup-file-name file-remote-p)) ;; `default-directory'. Because core function like
(file-name-handler-alist ;; `call-process' don't care about file name handlers in
(and ;; `default-directory', we here have to resolve the
(not (memq operation op-returns-file-name-list)) ;; directory into a local one. For `process-file',
file-name-handler-alist)) ;; `start-file-process', and `shell-command', this fixes
(default-directory ;; Bug#25949.
;; Some operations respect file name handlers in (if (memq operation '(insert-directory process-file start-file-process
;; `default-directory'. Because core function like shell-command))
;; `call-process' don't care about file name handlers in (directory-file-name
;; `default-directory', we here have to resolve the (expand-file-name
;; directory into a local one. For `process-file', (unhandled-file-name-directory default-directory)))
;; `start-file-process', and `shell-command', this fixes default-directory))
;; Bug#25949. ;; Get a list of the indices of the args which are file names.
(if (memq operation (file-arg-indices
'(insert-directory process-file start-file-process (cdr (or (assq operation
shell-command)) ;; The first six are special because they
(directory-file-name ;; return a file name. We want to include the /:
(expand-file-name ;; in the return value.
(unhandled-file-name-directory default-directory))) ;; So just avoid stripping it in the first place.
default-directory)) '((expand-file-name . nil)
;; Get a list of the indices of the args which are file names. (file-name-directory . nil)
(file-arg-indices (file-name-as-directory . nil)
(cdr (or (assq operation (directory-file-name . nil)
;; The first seven are special because they (file-name-sans-versions . nil)
;; return a file name. We want to include the /: (find-backup-file-name . nil)
;; in the return value. ;; `identity' means just return the first arg
;; So just avoid stripping it in the first place. ;; not stripped of its quoting.
(append (substitute-in-file-name identity)
(mapcar 'list op-returns-file-name-list) ;; `add' means add "/:" to the result.
'(;; `identity' means just return the first arg (file-truename add 0)
;; not stripped of its quoting. (insert-file-contents insert-file-contents 0)
(substitute-in-file-name identity) ;; `unquote-then-quote' means set buffer-file-name
;; `add' means add "/:" to the result. ;; temporarily to unquoted filename.
(file-truename add 0) (verify-visited-file-modtime unquote-then-quote)
(insert-file-contents insert-file-contents 0) ;; List the arguments which are filenames.
;; `unquote-then-quote' means set buffer-file-name (file-name-completion 1)
;; temporarily to unquoted filename. (file-name-all-completions 1)
(verify-visited-file-modtime unquote-then-quote) (write-region 2 5)
;; List the arguments which are filenames. (rename-file 0 1)
(file-name-completion 1) (copy-file 0 1)
(file-name-all-completions 1) (make-symbolic-link 0 1)
(write-region 2 5) (add-name-to-file 0 1)))
(rename-file 0 1) ;; For all other operations, treat the first argument only
(copy-file 0 1) ;; as the file name.
(copy-directory 0 1) '(nil 0))))
(file-in-directory-p 0 1) method
(make-symbolic-link 0 1) ;; Copy ARGUMENTS so we can replace elements in it.
(add-name-to-file 0 1)))) (arguments (copy-sequence arguments)))
;; For all other operations, treat the first argument only
;; as the file name.
'(nil 0))))
method
;; Copy ARGUMENTS so we can replace elements in it.
(arguments (copy-sequence arguments)))
(if (symbolp (car file-arg-indices)) (if (symbolp (car file-arg-indices))
(setq method (pop file-arg-indices))) (setq method (pop file-arg-indices)))
;; Strip off the /: from the file names that have it. ;; Strip off the /: from the file names that have it.

View file

@ -1882,9 +1882,9 @@ This checks also `file-name-as-directory', `file-name-directory',
"Check `copy-file'." "Check `copy-file'."
(skip-unless (tramp--test-enabled)) (skip-unless (tramp--test-enabled))
;; `filename-non-special' has been fixed in Emacs 26.1, see Bug#29579. ;; TODO: The quoted case does not work. Copy local file to remote.
(dolist (quoted (if (and tramp--test-expensive-test (tramp--test-emacs26-p)) ;;(dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil)))
'(nil t) '(nil))) (let (quoted)
(let ((tmp-name1 (tramp--test-make-temp-name nil quoted)) (let ((tmp-name1 (tramp--test-make-temp-name nil quoted))
(tmp-name2 (tramp--test-make-temp-name nil quoted)) (tmp-name2 (tramp--test-make-temp-name nil quoted))
(tmp-name3 (tramp--test-make-temp-name 'local quoted))) (tmp-name3 (tramp--test-make-temp-name 'local quoted)))
@ -1984,9 +1984,9 @@ This checks also `file-name-as-directory', `file-name-directory',
"Check `rename-file'." "Check `rename-file'."
(skip-unless (tramp--test-enabled)) (skip-unless (tramp--test-enabled))
;; `filename-non-special' has been fixed in Emacs 26.1, see Bug#29579. ;; TODO: The quoted case does not work.
(dolist (quoted (if (and tramp--test-expensive-test (tramp--test-emacs26-p)) ;;(dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil)))
'(nil t) '(nil))) (let (quoted)
(let ((tmp-name1 (tramp--test-make-temp-name nil quoted)) (let ((tmp-name1 (tramp--test-make-temp-name nil quoted))
(tmp-name2 (tramp--test-make-temp-name nil quoted)) (tmp-name2 (tramp--test-make-temp-name nil quoted))
(tmp-name3 (tramp--test-make-temp-name 'local quoted))) (tmp-name3 (tramp--test-make-temp-name 'local quoted)))
@ -2810,11 +2810,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
;; Symbolic links could look like a remote file name. ;; Symbolic links could look like a remote file name.
;; They must be quoted then. ;; They must be quoted then.
(delete-file tmp-name2) (delete-file tmp-name2)
(make-symbolic-link (make-symbolic-link "/penguin:motd:" tmp-name2)
(funcall
(if quoted 'tramp-compat-file-name-unquote 'identity)
"/penguin:motd:")
tmp-name2)
(should (file-symlink-p tmp-name2)) (should (file-symlink-p tmp-name2))
(should (should
(string-equal (string-equal
@ -2829,7 +2825,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
;; We must unquote it. ;; We must unquote it.
(should (should
(string-equal (string-equal
(tramp-compat-file-name-unquote (file-truename tmp-name1)) (file-truename tmp-name1)
(tramp-compat-file-name-unquote (file-truename tmp-name3))))) (tramp-compat-file-name-unquote (file-truename tmp-name3)))))
;; Cleanup. ;; Cleanup.
@ -2955,9 +2951,9 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
(skip-unless (tramp--test-enabled)) (skip-unless (tramp--test-enabled))
(skip-unless (file-acl tramp-test-temporary-file-directory)) (skip-unless (file-acl tramp-test-temporary-file-directory))
;; `filename-non-special' has been fixed in Emacs 26.1, see Bug#29579. ;; TODO: The quoted case does not work. Copy local file to remote.
(dolist (quoted (if (and tramp--test-expensive-test (tramp--test-emacs26-p)) ;;(dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil)))
'(nil t) '(nil))) (let (quoted)
(let ((tmp-name1 (tramp--test-make-temp-name nil quoted)) (let ((tmp-name1 (tramp--test-make-temp-name nil quoted))
(tmp-name2 (tramp--test-make-temp-name nil quoted)) (tmp-name2 (tramp--test-make-temp-name nil quoted))
(tmp-name3 (tramp--test-make-temp-name 'local quoted))) (tmp-name3 (tramp--test-make-temp-name 'local quoted)))
@ -3033,9 +3029,9 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
(not (equal (file-selinux-context tramp-test-temporary-file-directory) (not (equal (file-selinux-context tramp-test-temporary-file-directory)
'(nil nil nil nil)))) '(nil nil nil nil))))
;; `filename-non-special' has been fixed in Emacs 26.1, see Bug#29579. ;; TODO: The quoted case does not work. Copy local file to remote.
(dolist (quoted (if (and tramp--test-expensive-test (tramp--test-emacs26-p)) ;;(dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil)))
'(nil t) '(nil))) (let (quoted)
(let ((tmp-name1 (tramp--test-make-temp-name nil quoted)) (let ((tmp-name1 (tramp--test-make-temp-name nil quoted))
(tmp-name2 (tramp--test-make-temp-name nil quoted)) (tmp-name2 (tramp--test-make-temp-name nil quoted))
(tmp-name3 (tramp--test-make-temp-name 'local quoted))) (tmp-name3 (tramp--test-make-temp-name 'local quoted)))
@ -4086,9 +4082,9 @@ This requires restrictions of file name syntax."
(defun tramp--test-check-files (&rest files) (defun tramp--test-check-files (&rest files)
"Run a simple but comprehensive test over every file in FILES." "Run a simple but comprehensive test over every file in FILES."
;; `filename-non-special' has been fixed in Emacs 26.1, see Bug#29579. ;; TODO: The quoted case does not work.
(dolist (quoted (if (and tramp--test-expensive-test (tramp--test-emacs26-p)) ;;(dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil)))
'(nil t) '(nil))) (let (quoted)
;; We must use `file-truename' for the temporary directory, ;; We must use `file-truename' for the temporary directory,
;; because it could be located on a symlinked directory. This ;; because it could be located on a symlinked directory. This
;; would let the test fail. ;; would let the test fail.