;;; tramp-tests.el --- Tests of remote file access
-;; Copyright (C) 2013-2014 Free Software Foundation, Inc.
+;; Copyright (C) 2013-2015 Free Software Foundation, Inc.
;; Author: Michael Albinus <michael.albinus@gmx.de>
(declare-function tramp-find-executable "tramp-sh")
(declare-function tramp-get-remote-path "tramp-sh")
+(declare-function tramp-get-remote-stat "tramp-sh")
+(declare-function tramp-get-remote-perl "tramp-sh")
(defvar tramp-copy-size-limit)
+(defvar tramp-persistency-file-name)
(defvar tramp-remote-process-environment)
;; There is no default value on w32 systems, which could work out of the box.
(setq password-cache-expiry nil
tramp-verbose 0
tramp-copy-size-limit nil
- tramp-message-show-message nil)
+ tramp-message-show-message nil
+ tramp-persistency-file-name nil)
;; This shall happen on hydra only.
(when (getenv "NIX_STORE")
(declare (indent 1) (debug (natnump body)))
`(let ((tramp-verbose ,verbose)
(tramp-message-show-message t)
- (tramp-debug-on-error t))
+ (tramp-debug-on-error t)
+ (debug-ignored-errors
+ (cons "^make-symbolic-link not supported$" debug-ignored-errors)))
(unwind-protect
(progn ,@body)
(when (> tramp-verbose 3)
(with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
(with-current-buffer (tramp-get-connection-buffer v)
(message "%s" (buffer-string)))
- (with-current-buffer
- (tramp-get-debug-buffer v)
+ (with-current-buffer (tramp-get-debug-buffer v)
(message "%s" (buffer-string))))))))
(ert-deftest tramp-test00-availability ()
(ert-deftest tramp-test06-directory-file-name ()
"Check `directory-file-name'.
-This checks also `file-name-as-directory', `file-name-directory'
-and `file-name-nondirectory'."
+This checks also `file-name-as-directory', `file-name-directory',
+`file-name-nondirectory' and `unhandled-file-name-directory'."
(should
(string-equal
(directory-file-name "/method:host:/path/to/file")
(should
(string-equal (file-name-nondirectory "/method:host:/path/to/file/") ""))
(should-not
- (file-remote-p
- (unhandled-file-name-directory "/method:host:/path/to/file"))))
+ (unhandled-file-name-directory "/method:host:/path/to/file")))
(ert-deftest tramp-test07-file-exists-p ()
"Check `file-exist-p', `write-region' and `delete-file'."
(should (setq tmp-name2 (file-local-copy tmp-name1)))
(with-temp-buffer
(insert-file-contents tmp-name2)
- (should (string-equal (buffer-string) "foo"))))
+ (should (string-equal (buffer-string) "foo")))
+ ;; Check also that a file transfer with compression works.
+ (let ((default-directory tramp-test-temporary-file-directory)
+ (tramp-copy-size-limit 4)
+ (tramp-inline-compress-start-size 2))
+ (delete-file tmp-name2)
+ (should (setq tmp-name2 (file-local-copy tmp-name1)))))
+
+ ;; Cleanup.
(ignore-errors
(delete-file tmp-name1)
(delete-file tmp-name2)))))
;; Replace.
(insert-file-contents tmp-name nil nil nil 'replace)
(should (string-equal (buffer-string) "foo"))))
+
+ ;; Cleanup.
(ignore-errors (delete-file tmp-name)))))
(ert-deftest tramp-test10-write-region ()
(with-temp-buffer
(insert-file-contents tmp-name)
(should (string-equal (buffer-string) "34"))))
+
+ ;; Cleanup.
(ignore-errors (delete-file tmp-name)))))
(ert-deftest tramp-test11-copy-file ()
(should
(file-exists-p
(expand-file-name (file-name-nondirectory tmp-name1) tmp-name3))))
+
+ ;; Cleanup.
(ignore-errors (delete-file tmp-name1))
(ignore-errors (delete-file tmp-name2))
(ignore-errors (delete-directory tmp-name3 'recursive)))
(should
(file-exists-p
(expand-file-name (file-name-nondirectory tmp-name1) tmp-name5))))
+
+ ;; Cleanup.
(ignore-errors (delete-file tmp-name1))
(ignore-errors (delete-file tmp-name4))
(ignore-errors (delete-directory tmp-name5 'recursive)))
(should
(file-exists-p
(expand-file-name (file-name-nondirectory tmp-name4) tmp-name3))))
+
+ ;; Cleanup.
(ignore-errors (delete-file tmp-name1))
(ignore-errors (delete-file tmp-name4))
(ignore-errors (delete-directory tmp-name3 'recursive)))))
(should
(file-exists-p
(expand-file-name (file-name-nondirectory tmp-name1) tmp-name3))))
+
+ ;; Cleanup.
(ignore-errors (delete-file tmp-name1))
(ignore-errors (delete-file tmp-name2))
(ignore-errors (delete-directory tmp-name3 'recursive)))
(should
(file-exists-p
(expand-file-name (file-name-nondirectory tmp-name1) tmp-name5))))
+
+ ;; Cleanup.
(ignore-errors (delete-file tmp-name1))
(ignore-errors (delete-file tmp-name4))
(ignore-errors (delete-directory tmp-name5 'recursive)))
(should
(file-exists-p
(expand-file-name (file-name-nondirectory tmp-name4) tmp-name3))))
+
+ ;; Cleanup.
(ignore-errors (delete-file tmp-name1))
(ignore-errors (delete-file tmp-name4))
(ignore-errors (delete-directory tmp-name3 'recursive)))))
This tests also `file-directory-p' and `file-accessible-directory-p'."
(skip-unless (tramp--test-enabled))
- (let ((tmp-name (tramp--test-make-temp-name)))
+ (let* ((tmp-name1 (tramp--test-make-temp-name))
+ (tmp-name2 (expand-file-name "foo/bar" tmp-name1)))
(unwind-protect
(progn
- (make-directory tmp-name)
- (should (file-directory-p tmp-name))
- (should (file-accessible-directory-p tmp-name)))
- (ignore-errors (delete-directory tmp-name)))))
+ (make-directory tmp-name1)
+ (should (file-directory-p tmp-name1))
+ (should (file-accessible-directory-p tmp-name1))
+ (should-error (make-directory tmp-name2) :type 'file-error)
+ (make-directory tmp-name2 'parents)
+ (should (file-directory-p tmp-name2))
+ (should (file-accessible-directory-p tmp-name2)))
+
+ ;; Cleanup.
+ (ignore-errors (delete-directory tmp-name1 'recursive)))))
(ert-deftest tramp-test14-delete-directory ()
"Check `delete-directory'."
(copy-directory tmp-name1 tmp-name2)
(should (file-directory-p tmp-name3))
(should (file-exists-p tmp-name6)))
+
+ ;; Cleanup.
(ignore-errors
(delete-directory tmp-name1 'recursive)
(delete-directory tmp-name2 'recursive)))))
(should (equal (directory-files
tmp-name1 'full directory-files-no-dot-files-regexp)
`(,tmp-name2 ,tmp-name3))))
+
+ ;; Cleanup.
(ignore-errors (delete-directory tmp-name1 'recursive)))))
(ert-deftest tramp-test17-insert-directory ()
(skip-unless (tramp--test-enabled))
(let* ((tmp-name1 (tramp--test-make-temp-name))
- (tmp-name2 (expand-file-name "foo" tmp-name1)))
+ (tmp-name2 (expand-file-name "foo" tmp-name1))
+ ;; We test for the summary line. Keyword "total" could be localized.
+ (process-environment
+ (append '("LANG=C" "LANGUAGE=C" "LC_ALL=C") process-environment)))
(unwind-protect
(progn
(make-directory tmp-name1)
(goto-char (point-min))
(should
(looking-at-p
- "\\(total.+[[:digit:]]+\n\\)?.+ \\.\n.+ \\.\\.\n.+ foo$"))))
+ (concat
+ ;; There might be a summary line.
+ "\\(total.+[[:digit:]]+\n\\)?"
+ ;; We don't know in which order ".", ".." and "foo" appear.
+ "\\(.+ \\(\\.?\\.\\|foo\\)\n\\)\\{3\\}")))))
+
+ ;; Cleanup.
(ignore-errors (delete-directory tmp-name1 'recursive)))))
(ert-deftest tramp-test18-file-attributes ()
This tests also `file-readable-p' and `file-regular-p'."
(skip-unless (tramp--test-enabled))
- (let ((tmp-name (tramp--test-make-temp-name))
- attr)
+ ;; We must use `file-truename' for the temporary directory, because
+ ;; it could be located on a symlinked directory. This would let the
+ ;; test fail.
+ (let* ((tramp-test-temporary-file-directory
+ (file-truename tramp-test-temporary-file-directory))
+ (tmp-name1 (tramp--test-make-temp-name))
+ (tmp-name2 (tramp--test-make-temp-name))
+ attr)
(unwind-protect
(progn
- (write-region "foo" nil tmp-name)
- (should (file-exists-p tmp-name))
- (setq attr (file-attributes tmp-name))
+ (write-region "foo" nil tmp-name1)
+ (should (file-exists-p tmp-name1))
+ (setq attr (file-attributes tmp-name1))
(should (consp attr))
- (should (file-exists-p tmp-name))
- (should (file-readable-p tmp-name))
- (should (file-regular-p tmp-name))
+ (should (file-exists-p tmp-name1))
+ (should (file-readable-p tmp-name1))
+ (should (file-regular-p tmp-name1))
;; We do not test inodes and device numbers.
(should (null (car attr)))
(should (numberp (nth 1 attr))) ;; Link.
(should (numberp (nth 7 attr))) ;; Size.
(should (stringp (nth 8 attr))) ;; Modes.
- (setq attr (file-attributes tmp-name 'string))
+ (setq attr (file-attributes tmp-name1 'string))
(should (stringp (nth 2 attr))) ;; Uid.
(should (stringp (nth 3 attr))) ;; Gid.
- (delete-file tmp-name)
- (make-directory tmp-name)
- (should (file-exists-p tmp-name))
- (should (file-readable-p tmp-name))
- (should-not (file-regular-p tmp-name))
- (setq attr (file-attributes tmp-name))
+ (condition-case err
+ (progn
+ (make-symbolic-link tmp-name1 tmp-name2)
+ (should (file-exists-p tmp-name2))
+ (should (file-symlink-p tmp-name2))
+ (setq attr (file-attributes tmp-name2))
+ (should (string-equal
+ (car attr)
+ (file-remote-p (file-truename tmp-name1) 'localname)))
+ (delete-file tmp-name2))
+ (file-error
+ (should (string-equal (error-message-string err)
+ "make-symbolic-link not supported"))))
+ (delete-file tmp-name1)
+
+ (make-directory tmp-name1)
+ (should (file-exists-p tmp-name1))
+ (should (file-readable-p tmp-name1))
+ (should-not (file-regular-p tmp-name1))
+ (setq attr (file-attributes tmp-name1))
(should (eq (car attr) t)))
- (ignore-errors (delete-directory tmp-name)))))
+
+ ;; Cleanup.
+ (ignore-errors (delete-directory tmp-name1)))))
(ert-deftest tramp-test19-directory-files-and-attributes ()
"Check `directory-files-and-attributes'."
(equal (file-attributes (car elt)) (cdr elt)))))
(setq attr (directory-files-and-attributes tmp-name2 nil "^b"))
(should (equal (mapcar 'car attr) '("bar" "boz"))))
+
+ ;; Cleanup.
(ignore-errors (delete-directory tmp-name1 'recursive)))))
(ert-deftest tramp-test20-file-modes ()
;; A file is always writable for user "root".
(unless (zerop (nth 2 (file-attributes tmp-name)))
(should-not (file-writable-p tmp-name))))
+
+ ;; Cleanup.
(ignore-errors (delete-file tmp-name)))))
(ert-deftest tramp-test21-file-links ()
(should (file-symlink-p tmp-name2))
;; `tmp-name3' is a local file name.
(should-error (make-symbolic-link tmp-name1 tmp-name3)))
+
+ ;; Cleanup.
(ignore-errors
(delete-file tmp-name1)
(delete-file tmp-name2)))
(should-not (file-symlink-p tmp-name2))
;; `tmp-name3' is a local file name.
(should-error (add-name-to-file tmp-name1 tmp-name3)))
+
+ ;; Cleanup.
(ignore-errors
(delete-file tmp-name1)
(delete-file tmp-name2)))
;; `tmp-name3' does not exist.
(should (file-newer-than-file-p tmp-name2 tmp-name3))
(should-not (file-newer-than-file-p tmp-name3 tmp-name1))))
+
+ ;; Cleanup.
(ignore-errors
(delete-file tmp-name1)
(delete-file tmp-name2)))))
(set-visited-file-modtime '(0 1))
(should (verify-visited-file-modtime))
(should (equal (visited-file-modtime) '(0 1 0 0)))))
+
+ ;; Cleanup.
(ignore-errors (delete-file tmp-name)))))
(ert-deftest tramp-test24-file-name-completion ()
(should
(equal (sort (file-name-all-completions "b" tmp-name) 'string-lessp)
'("bold" "boz/"))))
+
+ ;; Cleanup.
(ignore-errors (delete-directory tmp-name 'recursive)))))
(ert-deftest tramp-test25-load ()
;(should-error (load tmp-name nil 'nomessage 'nosuffix 'must-suffix))
(load tmp-name nil 'nomessage 'nosuffix)
(should (featurep 'tramp-test-load)))
+
+ ;; Cleanup.
(ignore-errors
(and (featurep 'tramp-test-load) (unload-feature 'tramp-test-load))
(delete-file tmp-name)))))
;; A non-nil DISPLAY must not raise the buffer.
(should-not (get-buffer-window (current-buffer) t))))
+ ;; Cleanup.
(ignore-errors (delete-file tmp-name)))))
(ert-deftest tramp-test27-start-file-process ()
(while (< (- (point-max) (point-min)) (length "foo"))
(accept-process-output proc 1)))
(should (string-equal (buffer-string) "foo")))
+
+ ;; Cleanup.
(ignore-errors (delete-process proc)))
(unwind-protect
(while (< (- (point-max) (point-min)) (length "foo"))
(accept-process-output proc 1)))
(should (string-equal (buffer-string) "foo")))
+
+ ;; Cleanup.
(ignore-errors
(delete-process proc)
(delete-file tmp-name)))
(while (< (- (point-max) (point-min)) (length "foo"))
(accept-process-output proc 1)))
(should (string-equal (buffer-string) "foo")))
+
+ ;; Cleanup.
(ignore-errors (delete-process proc)))))
(ert-deftest tramp-test28-shell-command ()
(should
(string-equal
(format "%s\n" (file-name-nondirectory tmp-name)) (buffer-string))))
+
+ ;; Cleanup.
(ignore-errors (delete-file tmp-name)))
(unwind-protect
(should
(string-equal
(format "%s\n" (file-name-nondirectory tmp-name)) (buffer-string))))
+
+ ;; Cleanup.
(ignore-errors (delete-file tmp-name)))
(unwind-protect
(should
(string-equal
(format "%s\n" (file-name-nondirectory tmp-name)) (buffer-string))))
+
+ ;; Cleanup.
(ignore-errors (delete-file tmp-name)))))
(ert-deftest tramp-test29-vc-registered ()
(list (file-name-nondirectory tmp-name2)))))))
(should (vc-registered tmp-name2)))
- (ignore-errors (delete-directory tmp-name1 'recursive)))))
+ ;; Cleanup.
+ (ignore-errors (delete-directory tmp-name1 'recursive)))))
+
+(ert-deftest tramp-test30-make-auto-save-file-name ()
+ "Check `make-auto-save-file-name'."
+ (skip-unless (tramp--test-enabled))
-(defun tramp--test-check-files (&rest files)
- "Runs a simple but comprehensive test over every file in FILES."
(let ((tmp-name1 (tramp--test-make-temp-name))
- (tmp-name2 (tramp--test-make-temp-name 'local)))
+ (tmp-name2 (tramp--test-make-temp-name)))
+
+ (unwind-protect
+ (progn
+ ;; Use default `auto-save-file-name-transforms' mechanism.
+ (let (tramp-auto-save-directory)
+ (with-temp-buffer
+ (setq buffer-file-name tmp-name1)
+ (should
+ (string-equal
+ (make-auto-save-file-name)
+ ;; This is taken from original `make-auto-save-file-name'.
+ (expand-file-name
+ (format
+ "#%s#"
+ (subst-char-in-string
+ ?/ ?! (replace-regexp-in-string "!" "!!" tmp-name1)))
+ temporary-file-directory)))))
+
+ ;; No mapping.
+ (let (tramp-auto-save-directory auto-save-file-name-transforms)
+ (with-temp-buffer
+ (setq buffer-file-name tmp-name1)
+ (should
+ (string-equal
+ (make-auto-save-file-name)
+ (expand-file-name
+ (format "#%s#" (file-name-nondirectory tmp-name1))
+ tramp-test-temporary-file-directory)))))
+
+ ;; Use default `tramp-auto-save-directory' mechanism.
+ (let ((tramp-auto-save-directory tmp-name2))
+ (with-temp-buffer
+ (setq buffer-file-name tmp-name1)
+ (should
+ (string-equal
+ (make-auto-save-file-name)
+ ;; This is taken from Tramp.
+ (expand-file-name
+ (format
+ "#%s#"
+ (tramp-subst-strs-in-string
+ '(("_" . "|")
+ ("/" . "_a")
+ (":" . "_b")
+ ("|" . "__")
+ ("[" . "_l")
+ ("]" . "_r"))
+ tmp-name1))
+ tmp-name2)))
+ (should (file-directory-p tmp-name2))))
+
+ ;; Relative file names shall work, too.
+ (let ((tramp-auto-save-directory "."))
+ (with-temp-buffer
+ (setq buffer-file-name tmp-name1
+ default-directory tmp-name2)
+ (should
+ (string-equal
+ (make-auto-save-file-name)
+ ;; This is taken from Tramp.
+ (expand-file-name
+ (format
+ "#%s#"
+ (tramp-subst-strs-in-string
+ '(("_" . "|")
+ ("/" . "_a")
+ (":" . "_b")
+ ("|" . "__")
+ ("[" . "_l")
+ ("]" . "_r"))
+ tmp-name1))
+ tmp-name2)))
+ (should (file-directory-p tmp-name2)))))
+
+ ;; Cleanup.
+ (ignore-errors (delete-file tmp-name1))
+ (ignore-errors (delete-directory tmp-name2 'recursive)))))
+
+(defun tramp--test-adb-p ()
+ "Check, whether the remote host runs Android.
+This requires restrictions of file name syntax."
+ (tramp-adb-file-name-p tramp-test-temporary-file-directory))
+
+(defun tramp--test-ftp-p ()
+ "Check, whether an FTP-like method is used.
+This does not support globbing characters in file names (yet)."
+ ;; Globbing characters are ??, ?* and ?\[.
+ (and (eq (tramp-find-foreign-file-name-handler
+ tramp-test-temporary-file-directory)
+ 'tramp-sh-file-name-handler)
+ (string-match
+ "ftp$" (file-remote-p tramp-test-temporary-file-directory 'method))))
+
+(defun tramp--test-gvfs-p ()
+ "Check, whether the remote host runs a GVFS based method.
+This requires restrictions of file name syntax."
+ (tramp-gvfs-file-name-p tramp-test-temporary-file-directory))
+
+(defun tramp--test-smb-or-windows-nt-p ()
+ "Check, whether the locale or remote host runs MS Windows.
+This requires restrictions of file name syntax."
+ (or (eq system-type 'windows-nt)
+ (tramp-smb-file-name-p tramp-test-temporary-file-directory)))
+
+(defun tramp--test-hpux-p ()
+ "Check, whether the remote host runs HP-UX.
+Several special characters do not work properly there."
+ ;; We must refill the cache.
+ (with-parsed-tramp-file-name
+ (file-truename tramp-test-temporary-file-directory) nil
+ (string-match "^HP-UX" (tramp-get-connection-property v "uname" ""))))
+
+(defun tramp--test-check-files (&rest files)
+ "Run a simple but comprehensive test over every file in FILES."
+ ;; We must use `file-truename' for the temporary directory, because
+ ;; it could be located on a symlinked directory. This would let the
+ ;; test fail.
+ (let* ((tramp-test-temporary-file-directory
+ (file-truename tramp-test-temporary-file-directory))
+ (tmp-name1 (tramp--test-make-temp-name))
+ (tmp-name2 (tramp--test-make-temp-name 'local))
+ (files (delq nil files)))
(unwind-protect
(progn
(make-directory tmp-name1)
(make-directory tmp-name2)
(dolist (elt files)
- (let ((file1 (expand-file-name elt tmp-name1))
- (file2 (expand-file-name elt tmp-name2)))
+ (let* ((file1 (expand-file-name elt tmp-name1))
+ (file2 (expand-file-name elt tmp-name2))
+ (file3 (expand-file-name (concat elt "foo") tmp-name1)))
(write-region elt nil file1)
(should (file-exists-p file1))
+
;; Check file contents.
(with-temp-buffer
(insert-file-contents file1)
(should (string-equal (buffer-string) elt)))
+
;; Copy file both directions.
(copy-file file1 tmp-name2)
(should (file-exists-p file2))
(delete-file file1)
(should-not (file-exists-p file1))
(copy-file file2 tmp-name1)
- (should (file-exists-p file1))))
+ (should (file-exists-p file1))
+
+ ;; Method "smb" supports `make-symbolic-link' only if the
+ ;; remote host has CIFS capabilities. tramp-adb.el and
+ ;; tramp-gvfs.el do not support symbolic links at all.
+ (condition-case err
+ (progn
+ (make-symbolic-link file1 file3)
+ (should (file-symlink-p file3))
+ (should
+ (string-equal
+ (expand-file-name file1) (file-truename file3)))
+ (should
+ (string-equal
+ (car (file-attributes file3))
+ (file-remote-p (file-truename file1) 'localname)))
+ ;; Check file contents.
+ (with-temp-buffer
+ (insert-file-contents file3)
+ (should (string-equal (buffer-string) elt)))
+ (delete-file file3))
+ (file-error
+ (should (string-equal (error-message-string err)
+ "make-symbolic-link not supported"))))))
;; Check file names.
(should (equal (directory-files
(should (equal (directory-files
tmp-name1 nil directory-files-no-dot-files-regexp)
(directory-files
- tmp-name2 nil directory-files-no-dot-files-regexp))))
+ tmp-name2 nil directory-files-no-dot-files-regexp)))
+ ;; Check directory creation. We use a subdirectory "foo"
+ ;; in order to avoid conflicts with previous file name tests.
+ (dolist (elt files)
+ (let* ((elt1 (concat elt "foo"))
+ (file1 (expand-file-name (concat "foo/" elt) tmp-name1))
+ (file2 (expand-file-name elt file1))
+ (file3 (expand-file-name elt1 file1)))
+ (make-directory file1 'parents)
+ (should (file-directory-p file1))
+ (write-region elt nil file2)
+ (should (file-exists-p file2))
+ (should
+ (equal
+ (directory-files file1 nil directory-files-no-dot-files-regexp)
+ `(,elt)))
+ (should
+ (equal
+ (caar (directory-files-and-attributes
+ file1 nil directory-files-no-dot-files-regexp))
+ elt))
+
+ ;; Check symlink in `directory-files-and-attributes'.
+ (condition-case err
+ (progn
+ (make-symbolic-link file2 file3)
+ (should (file-symlink-p file3))
+ (should
+ (string-equal
+ (caar (directory-files-and-attributes
+ file1 nil (regexp-quote elt1)))
+ elt1))
+ (should
+ (string-equal
+ (cadr (car (directory-files-and-attributes
+ file1 nil (regexp-quote elt1))))
+ (file-remote-p (file-truename file2) 'localname)))
+ (delete-file file3)
+ (should-not (file-exists-p file3)))
+ (file-error
+ (should (string-equal (error-message-string err)
+ "make-symbolic-link not supported"))))
+
+ (delete-file file2)
+ (should-not (file-exists-p file2))
+ (delete-directory file1)
+ (should-not (file-exists-p file1)))))
+
+ ;; Cleanup.
(ignore-errors (delete-directory tmp-name1 'recursive))
(ignore-errors (delete-directory tmp-name2 'recursive)))))
-;; This test is inspired by Bug#17238.
-(ert-deftest tramp-test30-special-characters ()
- "Check special characters in file names."
- (skip-unless (tramp--test-enabled))
- (skip-unless
- (not
- (memq
- (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory)
- '(tramp-adb-file-name-handler
- tramp-gvfs-file-name-handler
- tramp-smb-file-name-handler))))
-
- ;; Newlines, slashes and backslashes in file names are not supported.
- ;; So we don't test.
+(defun tramp--test-special-characters ()
+ "Perform the test in `tramp-test31-special-characters*'."
+ ;; Newlines, slashes and backslashes in file names are not
+ ;; supported. So we don't test. And we don't test the tab
+ ;; character on Windows or Cygwin, because the backslash is
+ ;; interpreted as a path separator, preventing "\t" from being
+ ;; expanded to <TAB>.
(tramp--test-check-files
- " foo\tbar baz\t"
+ (if (or (tramp--test-gvfs-p) (tramp--test-smb-or-windows-nt-p))
+ "foo bar baz"
+ (if (or (tramp--test-adb-p) (eq system-type 'cygwin))
+ " foo bar baz "
+ " foo\tbar baz\t"))
"$foo$bar$$baz$"
"-foo-bar-baz-"
"%foo%bar%baz%"
"&foo&bar&baz&"
- "?foo?bar?baz?"
- "*foo*bar*baz*"
- "'foo\"bar'baz\""
+ (unless (or (tramp--test-ftp-p)
+ (tramp--test-gvfs-p)
+ (tramp--test-smb-or-windows-nt-p))
+ "?foo?bar?baz?")
+ (unless (or (tramp--test-ftp-p)
+ (tramp--test-gvfs-p)
+ (tramp--test-smb-or-windows-nt-p))
+ "*foo*bar*baz*")
+ (if (or (tramp--test-gvfs-p) (tramp--test-smb-or-windows-nt-p))
+ "'foo'bar'baz'"
+ "'foo\"bar'baz\"")
"#foo~bar#baz~"
- "!foo|bar!baz|"
- ":foo;bar:baz;"
- "<foo>bar<baz>"
+ (if (or (tramp--test-gvfs-p) (tramp--test-smb-or-windows-nt-p))
+ "!foo!bar!baz!"
+ "!foo|bar!baz|")
+ (if (or (tramp--test-gvfs-p) (tramp--test-smb-or-windows-nt-p))
+ ";foo;bar;baz;"
+ ":foo;bar:baz;")
+ (unless (or (tramp--test-gvfs-p) (tramp--test-smb-or-windows-nt-p))
+ "<foo>bar<baz>")
"(foo)bar(baz)"
- "[foo]bar[baz]"
+ (unless (or (tramp--test-ftp-p) (tramp--test-gvfs-p)) "[foo]bar[baz]")
"{foo}bar{baz}"))
-(ert-deftest tramp-test31-utf8 ()
- "Check UTF8 encoding in file names and file contents."
+;; These tests are inspired by Bug#17238.
+(ert-deftest tramp-test31-special-characters ()
+ "Check special characters in file names."
(skip-unless (tramp--test-enabled))
+ (tramp--test-special-characters))
+
+(ert-deftest tramp-test31-special-characters-with-stat ()
+ "Check special characters in file names.
+Use the `stat' command."
+ (skip-unless (tramp--test-enabled))
+ (skip-unless
+ (eq
+ (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory)
+ 'tramp-sh-file-name-handler))
+ (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
+ (skip-unless (tramp-get-remote-stat v)))
+
+ (unwind-protect
+ (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
+ (tramp-set-connection-property v "perl" nil)
+ (tramp--test-special-characters))
+
+ ;; Reset suppressed properties.
+ (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
+ (tramp-set-connection-property v "perl" 'undef))))
+
+(ert-deftest tramp-test31-special-characters-with-perl ()
+ "Check special characters in file names.
+Use the `perl' command."
+ (skip-unless (tramp--test-enabled))
+ (skip-unless
+ (eq
+ (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory)
+ 'tramp-sh-file-name-handler))
+ (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
+ (skip-unless (tramp-get-remote-perl v)))
+
+ (unwind-protect
+ (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
+ (tramp-set-connection-property v "stat" nil)
+ (tramp--test-special-characters))
+
+ ;; Reset suppressed properties.
+ (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
+ (tramp-set-connection-property v "stat" 'undef))))
+
+(ert-deftest tramp-test31-special-characters-with-ls ()
+ "Check special characters in file names.
+Use the `ls' command."
+ (skip-unless (tramp--test-enabled))
+ (skip-unless
+ (eq
+ (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory)
+ 'tramp-sh-file-name-handler))
+
+ (unwind-protect
+ (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
+ (tramp-set-connection-property v "stat" nil)
+ (tramp-set-connection-property v "perl" nil)
+ (tramp--test-special-characters))
+
+ ;; Reset suppressed properties.
+ (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
+ (tramp-set-connection-property v "stat" 'undef)
+ (tramp-set-connection-property v "perl" 'undef))))
+
+(defun tramp--test-utf8 ()
+ "Perform the test in `tramp-test32-utf8*'."
(let ((coding-system-for-read 'utf-8)
(coding-system-for-write 'utf-8)
(file-name-coding-system 'utf-8))
(tramp--test-check-files
- "أصبح بوسعك الآن تنزيل نسخة كاملة من موسوعة ويكيبيديا العربية لتصفحها بلا اتصال بالإنترنت"
+ (unless (tramp--test-hpux-p) "Γυρίστε το Γαλαξία με Ώτο Στοπ")
+ (unless (tramp--test-hpux-p)
+ "أصبح بوسعك الآن تنزيل نسخة كاملة من موسوعة ويكيبيديا العربية لتصفحها بلا اتصال بالإنترنت")
"银河系漫游指南系列"
"Автостопом по гала́ктике")))
+(ert-deftest tramp-test32-utf8 ()
+ "Check UTF8 encoding in file names and file contents."
+ (skip-unless (tramp--test-enabled))
+
+ (tramp--test-utf8))
+
+(ert-deftest tramp-test32-utf8-with-stat ()
+ "Check UTF8 encoding in file names and file contents.
+Use the `stat' command."
+ (skip-unless (tramp--test-enabled))
+ (skip-unless
+ (eq
+ (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory)
+ 'tramp-sh-file-name-handler))
+ (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
+ (skip-unless (tramp-get-remote-stat v)))
+
+ (unwind-protect
+ (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
+ (tramp-set-connection-property v "perl" nil)
+ (tramp--test-utf8))
+
+ ;; Reset suppressed properties.
+ (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
+ (tramp-set-connection-property v "perl" 'undef))))
+
+(ert-deftest tramp-test32-utf8-with-perl ()
+ "Check UTF8 encoding in file names and file contents.
+Use the `perl' command."
+ (skip-unless (tramp--test-enabled))
+ (skip-unless
+ (eq
+ (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory)
+ 'tramp-sh-file-name-handler))
+ (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
+ (skip-unless (tramp-get-remote-perl v)))
+
+ (unwind-protect
+ (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
+ (tramp-set-connection-property v "stat" nil)
+ (tramp--test-utf8))
+
+ ;; Reset suppressed properties.
+ (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
+ (tramp-set-connection-property v "stat" 'undef))))
+
+(ert-deftest tramp-test32-utf8-with-ls ()
+ "Check UTF8 encoding in file names and file contents.
+Use the `ls' command."
+ (skip-unless (tramp--test-enabled))
+ (skip-unless
+ (eq
+ (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory)
+ 'tramp-sh-file-name-handler))
+
+ (unwind-protect
+ (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
+ (tramp-set-connection-property v "stat" nil)
+ (tramp-set-connection-property v "perl" nil)
+ (tramp--test-utf8))
+
+ ;; Reset suppressed properties.
+ (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
+ (tramp-set-connection-property v "stat" 'undef)
+ (tramp-set-connection-property v "perl" 'undef))))
+
;; This test is inspired by Bug#16928.
-(ert-deftest tramp-test32-asynchronous-requests ()
+(ert-deftest tramp-test33-asynchronous-requests ()
"Check parallel asynchronous requests.
Such requests could arrive from timers, process filters and
process sentinels. They shall not disturb each other."
(dolist (buf buffers)
(ignore-errors (kill-buffer buf)))))))
-(ert-deftest tramp-test33-recursive-load ()
+(ert-deftest tramp-test34-recursive-load ()
"Check that Tramp does not fail due to recursive load."
(skip-unless (tramp--test-enabled))
(mapconcat 'shell-quote-argument load-path " -L ")
(shell-quote-argument code)))))))
-(ert-deftest tramp-test34-unload ()
+(ert-deftest tramp-test35-unload ()
"Check that Tramp and its subpackages unload completely.
Since it unloads Tramp, it shall be the last test to run."
;; Mark as failed until all symbols are unbound.
(not (string-match "^tramp--?test" (symbol-name x)))
(not (string-match "unload-hook$" (symbol-name x)))
(ert-fail (format "`%s' still bound" x)))))
-; (progn (message "`%s' still bound" x)))))
;; There shouldn't be left a hook function containing a Tramp
;; function. We do not regard the Tramp unload hooks.
(mapatoms
;; * file-ownership-preserved-p
;; * file-selinux-context
;; * find-backup-file-name
-;; * make-auto-save-file-name
;; * set-file-acl
;; * set-file-selinux-context
;; doesn't work well when an interactive password must be provided.
;; * Fix `tramp-test27-start-file-process' for `nc' and on MS
;; Windows (`process-send-eof'?).
-;; * Fix `tramp-test28-shell-command' on MS Windows (nasty plink message).
-;; * Fix `tramp-test30-special-characters' for `adb', `nc' and `smb'.
-;; * Fix `tramp-test31-utf8' for MS Windows and `nc'/`telnet' (when
-;; target is a dumb busybox). Seems to be in `directory-files'.
-;; * Fix Bug#16928. Set expected error of `tramp-test32-asynchronous-requests'.
-;; * Fix `tramp-test34-unload' (Not all symbols are unbound). Set
+;; * Fix `tramp-test31-special-characters' for `nc'.
+;; * Fix `tramp-test32-utf8' for `nc'/`telnet' (when target is a dumb
+;; busybox). Seems to be in `directory-files'.
+;; * Fix Bug#16928. Set expected error of `tramp-test33-asynchronous-requests'.
+;; * Fix `tramp-test35-unload' (Not all symbols are unbound). Set
;; expected error.
(defun tramp-test-all (&optional interactive)