Commit 2a2e6726 authored by Michael Albinus's avatar Michael Albinus
Browse files

* automated/tramp-tests.el (tramp-copy-size-limit): Set to nil.

(tramp--test-make-temp-name): Optional argument LOCAL.
(tramp--instrument-test-case): Show messages.  Catch also `quit'.
(tramp-test10-write-region): No special test for out-of-band copy
needed anymore.
(tramp-test11-copy-file, tramp-test12-rename-file)
(tramp-test21-file-links): Extend tests.
(tramp-test20-file-modes): More robust check for user "root".
(tramp--test-check-files): New defun.
(tramp-test30-special-characters, tramp-test33-recursive-load)
(tramp-test34-unload): New tests.
(tramp-test31-utf8, tramp-test32-asynchronous-requests):  Rename.
parent ce8c5107
2014-04-18 Michael Albinus <michael.albinus@gmx.de>
* automated/tramp-tests.el (tramp-copy-size-limit): Set to nil.
(tramp--test-make-temp-name): Optional argument LOCAL.
(tramp--instrument-test-case): Show messages. Catch also `quit'.
(tramp-test10-write-region): No special test for out-of-band copy
needed anymore.
(tramp-test11-copy-file, tramp-test12-rename-file)
(tramp-test21-file-links): Extend tests.
(tramp-test20-file-modes): More robust check for user "root".
(tramp--test-check-files): New defun.
(tramp-test30-special-characters, tramp-test33-recursive-load)
(tramp-test34-unload): New tests.
(tramp-test31-utf8, tramp-test32-asynchronous-requests): Rename.
2014-04-10 Paul Eggert <eggert@cs.ucla.edu>
* automated/electric-tests.el: Fix spelling error in test name.
......
......@@ -56,6 +56,7 @@
(setq password-cache-expiry nil
tramp-verbose 0
tramp-copy-size-limit nil
tramp-message-show-message nil)
;; Disable interactive passwords in batch mode.
......@@ -92,10 +93,11 @@ being the result.")
;; Return result.
(cdr tramp--test-enabled-checked))
(defun tramp--test-make-temp-name ()
(defun tramp--test-make-temp-name (&optional local)
"Create a temporary file name for test."
(expand-file-name
(make-temp-name "tramp-test") tramp-test-temporary-file-directory))
(make-temp-name "tramp-test")
(if local temporary-file-directory tramp-test-temporary-file-directory)))
(defmacro tramp--instrument-test-case (verbose &rest body)
"Run BODY with `tramp-verbose' equal VERBOSE.
......@@ -103,12 +105,17 @@ Print the the content of the Tramp debug buffer, if BODY does not
eval properly in `should', `should-not' or `should-error'."
(declare (indent 1) (debug (natnump body)))
`(let ((tramp-verbose ,verbose)
(tramp-message-show-message t)
(tramp-debug-on-error t))
(condition-case err
(progn ,@body)
;; In general, we cannot use a timeout here: this would
;; prevent traces when the test runs into an error.
; (with-timeout (10 (ert-fail "`tramp--instrument-test-case' timed out"))
(progn
,@body)
(ert-test-skipped
(signal (car err) (cdr err)))
(error
((error quit)
(with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
(with-current-buffer (tramp-get-connection-buffer v)
(message "%s" (buffer-string)))
......@@ -662,15 +669,7 @@ and `file-name-nondirectory'."
(write-region 3 5 tmp-name))
(with-temp-buffer
(insert-file-contents tmp-name)
(should (string-equal (buffer-string) "34")))
;; Trigger out-of-band copy.
(let ((string ""))
(while (<= (length string) tramp-copy-size-limit)
(setq string (concat string (md5 string))))
(write-region string nil tmp-name)
(with-temp-buffer
(insert-file-contents tmp-name)
(should (string-equal (buffer-string) string)))))
(should (string-equal (buffer-string) "34"))))
(ignore-errors (delete-file tmp-name)))))
(ert-deftest tramp-test11-copy-file ()
......@@ -678,7 +677,12 @@ and `file-name-nondirectory'."
(skip-unless (tramp--test-enabled))
(let ((tmp-name1 (tramp--test-make-temp-name))
(tmp-name2 (tramp--test-make-temp-name)))
(tmp-name2 (tramp--test-make-temp-name))
(tmp-name3 (tramp--test-make-temp-name))
(tmp-name4 (tramp--test-make-temp-name 'local))
(tmp-name5 (tramp--test-make-temp-name 'local)))
;; Copy on remote side.
(unwind-protect
(progn
(write-region "foo" nil tmp-name1)
......@@ -686,17 +690,69 @@ and `file-name-nondirectory'."
(should (file-exists-p tmp-name2))
(with-temp-buffer
(insert-file-contents tmp-name2)
(should (string-equal (buffer-string) "foo"))))
(ignore-errors
(delete-file tmp-name1)
(delete-file tmp-name2)))))
(should (string-equal (buffer-string) "foo")))
(should-error (copy-file tmp-name1 tmp-name2))
(copy-file tmp-name1 tmp-name2 'ok)
(make-directory tmp-name3)
(copy-file tmp-name1 tmp-name3)
(should
(file-exists-p
(expand-file-name (file-name-nondirectory tmp-name1) tmp-name3))))
(ignore-errors (delete-file tmp-name1))
(ignore-errors (delete-file tmp-name2))
(ignore-errors (delete-directory tmp-name3 'recursive)))
;; Copy from remote side to local side.
(unwind-protect
(progn
(write-region "foo" nil tmp-name1)
(copy-file tmp-name1 tmp-name4)
(should (file-exists-p tmp-name4))
(with-temp-buffer
(insert-file-contents tmp-name4)
(should (string-equal (buffer-string) "foo")))
(should-error (copy-file tmp-name1 tmp-name4))
(copy-file tmp-name1 tmp-name4 'ok)
(make-directory tmp-name5)
(copy-file tmp-name1 tmp-name5)
(should
(file-exists-p
(expand-file-name (file-name-nondirectory tmp-name1) tmp-name5))))
(ignore-errors (delete-file tmp-name1))
(ignore-errors (delete-file tmp-name4))
(ignore-errors (delete-directory tmp-name5 'recursive)))
;; Copy from local side to remote side.
(unwind-protect
(progn
(write-region "foo" nil tmp-name4 nil 'nomessage)
(copy-file tmp-name4 tmp-name1)
(should (file-exists-p tmp-name1))
(with-temp-buffer
(insert-file-contents tmp-name1)
(should (string-equal (buffer-string) "foo")))
(should-error (copy-file tmp-name4 tmp-name1))
(copy-file tmp-name4 tmp-name1 'ok)
(make-directory tmp-name3)
(copy-file tmp-name4 tmp-name3)
(should
(file-exists-p
(expand-file-name (file-name-nondirectory tmp-name4) tmp-name3))))
(ignore-errors (delete-file tmp-name1))
(ignore-errors (delete-file tmp-name4))
(ignore-errors (delete-directory tmp-name3 'recursive)))))
(ert-deftest tramp-test12-rename-file ()
"Check `rename-file'."
(skip-unless (tramp--test-enabled))
(let ((tmp-name1 (tramp--test-make-temp-name))
(tmp-name2 (tramp--test-make-temp-name)))
(tmp-name2 (tramp--test-make-temp-name))
(tmp-name3 (tramp--test-make-temp-name))
(tmp-name4 (tramp--test-make-temp-name 'local))
(tmp-name5 (tramp--test-make-temp-name 'local)))
;; Rename on remote side.
(unwind-protect
(progn
(write-region "foo" nil tmp-name1)
......@@ -705,8 +761,71 @@ and `file-name-nondirectory'."
(should (file-exists-p tmp-name2))
(with-temp-buffer
(insert-file-contents tmp-name2)
(should (string-equal (buffer-string) "foo"))))
(ignore-errors (delete-file tmp-name2)))))
(should (string-equal (buffer-string) "foo")))
(write-region "foo" nil tmp-name1)
(should-error (rename-file tmp-name1 tmp-name2))
(rename-file tmp-name1 tmp-name2 'ok)
(should-not (file-exists-p tmp-name1))
(write-region "foo" nil tmp-name1)
(make-directory tmp-name3)
(rename-file tmp-name1 tmp-name3)
(should-not (file-exists-p tmp-name1))
(should
(file-exists-p
(expand-file-name (file-name-nondirectory tmp-name1) tmp-name3))))
(ignore-errors (delete-file tmp-name1))
(ignore-errors (delete-file tmp-name2))
(ignore-errors (delete-directory tmp-name3 'recursive)))
;; Rename from remote side to local side.
(unwind-protect
(progn
(write-region "foo" nil tmp-name1)
(rename-file tmp-name1 tmp-name4)
(should-not (file-exists-p tmp-name1))
(should (file-exists-p tmp-name4))
(with-temp-buffer
(insert-file-contents tmp-name4)
(should (string-equal (buffer-string) "foo")))
(write-region "foo" nil tmp-name1)
(should-error (rename-file tmp-name1 tmp-name4))
(rename-file tmp-name1 tmp-name4 'ok)
(should-not (file-exists-p tmp-name1))
(write-region "foo" nil tmp-name1)
(make-directory tmp-name5)
(rename-file tmp-name1 tmp-name5)
(should-not (file-exists-p tmp-name1))
(should
(file-exists-p
(expand-file-name (file-name-nondirectory tmp-name1) tmp-name5))))
(ignore-errors (delete-file tmp-name1))
(ignore-errors (delete-file tmp-name4))
(ignore-errors (delete-directory tmp-name5 'recursive)))
;; Rename from local side to remote side.
(unwind-protect
(progn
(write-region "foo" nil tmp-name4 nil 'nomessage)
(rename-file tmp-name4 tmp-name1)
(should-not (file-exists-p tmp-name4))
(should (file-exists-p tmp-name1))
(with-temp-buffer
(insert-file-contents tmp-name1)
(should (string-equal (buffer-string) "foo")))
(write-region "foo" nil tmp-name4 nil 'nomessage)
(should-error (rename-file tmp-name4 tmp-name1))
(rename-file tmp-name4 tmp-name1 'ok)
(should-not (file-exists-p tmp-name4))
(write-region "foo" nil tmp-name4 nil 'nomessage)
(make-directory tmp-name3)
(rename-file tmp-name4 tmp-name3)
(should-not (file-exists-p tmp-name4))
(should
(file-exists-p
(expand-file-name (file-name-nondirectory tmp-name4) tmp-name3))))
(ignore-errors (delete-file tmp-name1))
(ignore-errors (delete-file tmp-name4))
(ignore-errors (delete-directory tmp-name3 'recursive)))))
(ert-deftest tramp-test13-make-directory ()
"Check `make-directory'.
......@@ -930,7 +1049,7 @@ This tests also `file-executable-p', `file-writable-p' and `set-file-modes'."
(should (= (file-modes tmp-name) #o444))
(should-not (file-executable-p tmp-name))
;; A file is always writable for user "root".
(when (not (string-equal (file-remote-p tmp-name 'user) "root"))
(unless (zerop (nth 2 (file-attributes tmp-name)))
(should-not (file-writable-p tmp-name))))
(ignore-errors (delete-file tmp-name)))))
......@@ -941,7 +1060,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
(let ((tmp-name1 (tramp--test-make-temp-name))
(tmp-name2 (tramp--test-make-temp-name))
(tmp-name3 (make-temp-name "tramp-")))
(tmp-name3 (tramp--test-make-temp-name 'local)))
(unwind-protect
(progn
(write-region "foo" nil tmp-name1)
......@@ -988,16 +1107,18 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
(should (file-symlink-p tmp-name2))
(should-not (string-equal tmp-name2 (file-truename tmp-name2)))
(should
(string-equal (file-truename tmp-name1) (file-truename tmp-name2))))
(string-equal (file-truename tmp-name1) (file-truename tmp-name2)))
(should (file-equal-p tmp-name1 tmp-name2)))
(ignore-errors
(delete-file tmp-name1)
(delete-file tmp-name2)))
;; `file-truename' shall preserve trailing link of directories.
(let* ((dir1 (directory-file-name tramp-test-temporary-file-directory))
(dir2 (file-name-as-directory dir1)))
(should (string-equal (file-truename dir1) (expand-file-name dir1)))
(should (string-equal (file-truename dir2) (expand-file-name dir2))))))
(unless (file-symlink-p tramp-test-temporary-file-directory)
(let* ((dir1 (directory-file-name tramp-test-temporary-file-directory))
(dir2 (file-name-as-directory dir1)))
(should (string-equal (file-truename dir1) (expand-file-name dir1)))
(should (string-equal (file-truename dir2) (expand-file-name dir2)))))))
(ert-deftest tramp-test22-file-times ()
"Check `set-file-times' and `file-newer-than-file-p'."
......@@ -1295,35 +1416,61 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
(ignore-errors (delete-directory tmp-name1 'recursive)))))
(ert-deftest tramp-test30-utf8 ()
"Check UTF8 encoding in file names and file contents."
(skip-unless (tramp--test-enabled))
(let ((tmp-name (tramp--test-make-temp-name))
(coding-system-for-read 'utf-8)
(coding-system-for-write 'utf-8)
(arabic "أصبح بوسعك الآن تنزيل نسخة كاملة من موسوعة ويكيبيديا العربية لتصفحها بلا اتصال بالإنترنت")
(chinese "银河系漫游指南系列")
(russian "Автостопом по гала́ктике"))
(defun tramp--test-check-files (&rest files)
"Runs a simple but comprehensive test over every file in FILES."
(let ((tmp-name (tramp--test-make-temp-name)))
(unwind-protect
(progn
(make-directory tmp-name)
(dolist (lang `(,arabic ,chinese ,russian))
(let ((file (expand-file-name lang tmp-name)))
(write-region lang nil file)
(dolist (elt files)
(let ((file (expand-file-name elt tmp-name)))
(write-region elt nil file)
(should (file-exists-p file))
;; Check file contents.
(with-temp-buffer
(insert-file-contents file)
(should (string-equal (buffer-string) lang)))))
(should (string-equal (buffer-string) elt)))))
;; Check file names.
(should (equal (directory-files
tmp-name nil directory-files-no-dot-files-regexp)
(sort `(,arabic ,chinese ,russian) 'string-lessp))))
(sort files 'string-lessp))))
(ignore-errors (delete-directory tmp-name '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))
;; Newlines and slashes in file names are not supported. So we don't test.
(tramp--test-check-files
" foo bar\tbaz "
"$foo$bar$$baz$"
"-foo-bar-baz-"
"%foo%bar%baz%"
"&foo&bar&baz&"
"?foo?bar?baz?"
"*foo*bar*baz*"
"'foo\"bar'baz\""
"\\foo\\bar\\baz\\"
"#foo#bar#baz#"
"!foo|bar!baz|"
":foo;bar:baz;"
"<foo>bar<baz>"
"(foo)bar(baz)"))
(ert-deftest tramp-test31-utf8 ()
"Check UTF8 encoding in file names and file contents."
(skip-unless (tramp--test-enabled))
(let ((coding-system-for-read 'utf-8)
(coding-system-for-write 'utf-8))
(tramp--test-check-files
"أصبح بوسعك الآن تنزيل نسخة كاملة من موسوعة ويكيبيديا العربية لتصفحها بلا اتصال بالإنترنت"
"银河系漫游指南系列"
"Автостопом по гала́ктике")))
;; This test is inspired by Bug#16928.
(ert-deftest tramp-test31-asynchronous-requests ()
(ert-deftest tramp-test32-asynchronous-requests ()
"Check parallel asynchronous requests.
Such requests could arrive from timers, process filters and
process sentinels. They shall not disturb each other."
......@@ -1412,6 +1559,62 @@ process sentinels. They shall not disturb each other."
(dolist (buf buffers)
(ignore-errors (kill-buffer buf)))))))
(ert-deftest tramp-test33-recursive-load ()
"Check that Tramp does not fail due to recursive load."
(skip-unless (tramp--test-enabled))
(dolist (code
(list
(format
"(expand-file-name %S))"
tramp-test-temporary-file-directory)
(format
"(let ((default-directory %S)) (expand-file-name %S))"
tramp-test-temporary-file-directory
temporary-file-directory)))
(should-not
(string-match
"Recursive load"
(shell-command-to-string
(format
"%s -batch -Q -L %s --eval %s"
(expand-file-name invocation-name invocation-directory)
(mapconcat 'shell-quote-argument load-path " -L ")
(shell-quote-argument code)))))))
(ert-deftest tramp-test34-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.
:expected-result (if (featurep 'tramp) :failed :passed)
(when (featurep 'tramp)
(unload-feature 'tramp 'force)
;; No Tramp feature must be left.
(should-not (featurep 'tramp))
(should-not (all-completions "tramp" (delq 'tramp-tests features)))
;; `file-name-handler-alist' must be clean.
(should-not (all-completions "tramp" (mapcar 'cdr file-name-handler-alist)))
;; There shouldn't be left a bound symbol. We do not regard our
;; test symbols, and the Tramp unload hooks.
(mapatoms
(lambda (x)
(and (or (boundp x) (functionp x))
(string-match "^tramp" (symbol-name x))
(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
(lambda (x)
(and (boundp x)
(string-match "-hooks?$" (symbol-name x))
(not (string-match "unload-hook$" (symbol-name x)))
(consp (symbol-value x))
(ignore-errors (all-completions "tramp" (symbol-value x)))
(ert-fail (format "Hook `%s' still contains Tramp function" x)))))))
;; TODO:
;; * dired-compress-file
......@@ -1426,8 +1629,11 @@ process sentinels. They shall not disturb each other."
;; * Fix `tramp-test27-start-file-process' on MS Windows (`process-send-eof'?).
;; * Fix `tramp-test28-shell-command' on MS Windows (nasty plink message).
;; * Fix `tramp-test30-utf8' on MS Windows. Seems to be in `directory-files'.
;; * Fix Bug#16928. Set expected error of `tramp-test31-asynchronous-requests'.
;; * 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
;; expected error.
(defun tramp-test-all (&optional interactive)
"Run all tests for \\[tramp]."
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment