From 2a2e6726d1f7031d89fd6740e5b167476267f778 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Fri, 18 Apr 2014 20:58:13 +0200 Subject: [PATCH] * 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. --- test/ChangeLog | 15 ++ test/automated/tramp-tests.el | 298 ++++++++++++++++++++++++++++------ 2 files changed, 267 insertions(+), 46 deletions(-) diff --git a/test/ChangeLog b/test/ChangeLog index 8f203f68d5c..0d8dd76ff91 100644 --- a/test/ChangeLog +++ b/test/ChangeLog @@ -1,3 +1,18 @@ +2014-04-18 Michael Albinus + + * 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 * automated/electric-tests.el: Fix spelling error in test name. diff --git a/test/automated/tramp-tests.el b/test/automated/tramp-tests.el index 7bf0ab4e9c8..dff9103c4a7 100644 --- a/test/automated/tramp-tests.el +++ b/test/automated/tramp-tests.el @@ -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;" + "bar" + "(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]." -- 2.39.5