[Emacs-diffs] emacs-24 r116982: * automated/tramp-tests.el (tramp-copy-size-limit): Set to nil.

[Michael Albinus]

------------------------------------------------------------
revno: 116982
revision-id: address@hidden
parent: address@hidden
committer: Michael Albinus <address@hidden>
branch nick: emacs-24
timestamp: Fri 2014-04-18 20:58:13 +0200
message:
  * 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.
modified:
  test/ChangeLog                 changelog-20091113204419-o5vbwnq5f7feedwu-8588
  test/automated/tramp-tests.el  tramptests.el-20131105142319-d9zp3oprkpxj5v1e-1

=== modified file 'test/ChangeLog'
--- a/test/ChangeLog    2014-04-10 19:12:34 +0000
+++ b/test/ChangeLog    2014-04-18 18:58:13 +0000
@@ -1,3 +1,18 @@
+2014-04-18  Michael Albinus  <address@hidden>
+
+       * 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  <address@hidden>
 
        * automated/electric-tests.el: Fix spelling error in test name.

=== modified file 'test/automated/tramp-tests.el'
--- a/test/automated/tramp-tests.el     2014-03-07 14:11:37 +0000
+++ b/test/automated/tramp-tests.el     2014-04-18 18:58:13 +0000
@@ -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 @@
   ;; 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 @@
 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 @@
            (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 @@
   (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 @@
          (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 @@
          (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 @@
          (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 @@
 
   (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 @@
          (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 @@
 
        (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 @@
       (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 @@
 
 ;; * 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]."