test/automated/tramp-tests.el

   1 ;;; tramp-tests.el --- Tests of remote file access
   2
   3 ;; Copyright (C) 2013-2014 Free Software Foundation, Inc.
   4
   5 ;; Author: Michael Albinus <michael.albinus@gmx.de>
   6
   7 ;; This program is free software: you can redistribute it and/or
   8 ;; modify it under the terms of the GNU General Public License as
   9 ;; published by the Free Software Foundation, either version 3 of the
  10 ;; License, or (at your option) any later version.
  11 ;;
  12 ;; This program is distributed in the hope that it will be useful, but
  13 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  14 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  15 ;; General Public License for more details.
  16 ;;
  17 ;; You should have received a copy of the GNU General Public License
  18 ;; along with this program.  If not, see `http://www.gnu.org/licenses/'.
  19
  20 ;;; Commentary:
  21
  22 ;; The tests require a recent ert.el from Emacs 24.4.
  23
  24 ;; Some of the tests require access to a remote host files.  Set
  25 ;; $REMOTE_TEMPORARY_FILE_DIRECTORY to a suitable value in order
  26 ;; to overwrite the default value.  If you want to skip tests
  27 ;; accessing a remote host, set this environment variable to
  28 ;; "/dev/null" or whatever is appropriate on your system.
  29
  30 ;; When running the tests in batch mode, it must NOT require an
  31 ;; interactive password prompt unless the environment variable
  32 ;; $REMOTE_ALLOW_PASSWORD is set.
  33
  34 ;; A whole test run can be performed calling the command `tramp-test-all'.
  35
  36 ;;; Code:
  37
  38 (require 'ert)
  39 (require 'tramp)
  40 (require 'vc)
  41 (require 'vc-bzr)
  42 (require 'vc-git)
  43 (require 'vc-hg)
  44
  45 (declare-function tramp-find-executable "tramp-sh")
  46 (declare-function tramp-get-remote-path "tramp-sh")
  47
  48 ;; There is no default value on w32 systems, which could work out of the box.
  49 (defconst tramp-test-temporary-file-directory
  50   (cond
  51    ((getenv "REMOTE_TEMPORARY_FILE_DIRECTORY"))
  52    ((eq system-type 'windows-nt) null-device)
  53    (t (format "/ssh::%s" temporary-file-directory)))
  54   "Temporary directory for Tramp tests.")
  55
  56 (setq password-cache-expiry nil
  57       tramp-verbose 0
  58       tramp-message-show-message nil)
  59
  60 ;; Disable interactive passwords in batch mode.
  61 (when (and noninteractive (not (getenv "REMOTE_ALLOW_PASSWORD")))
  62   (defalias 'tramp-read-passwd 'ignore))
  63
  64 ;; This shall happen on hydra only.
  65 (when (getenv "NIX_STORE")
  66   (add-to-list 'tramp-remote-path 'tramp-own-remote-path))
  67
  68 (defvar tramp--test-enabled-checked nil
  69   "Cached result of `tramp--test-enabled'.
  70 If the function did run, the value is a cons cell, the `cdr'
  71 being the result.")
  72
  73 (defun tramp--test-enabled ()
  74   "Whether remote file access is enabled."
  75   (unless (consp tramp--test-enabled-checked)
  76     (setq
  77      tramp--test-enabled-checked
  78      (cons
  79       t (ignore-errors
  80           (and
  81            (file-remote-p tramp-test-temporary-file-directory)
  82            (file-directory-p tramp-test-temporary-file-directory)
  83            (file-writable-p tramp-test-temporary-file-directory))))))
  84
  85   (when (and (cdr tramp--test-enabled-checked)
  86              (not (eq (tramp-find-foreign-file-name-handler
  87                        tramp-test-temporary-file-directory)
  88                       'tramp-adb-file-name-handler)))
  89     ;; Cleanup connection.  We don't cleanup for adb, because it
  90     ;; doesn't behave well when is disconnect several times.
  91     (tramp-cleanup-connection
  92      (tramp-dissect-file-name tramp-test-temporary-file-directory)
  93      nil 'keep-password))
  94
  95   ;; Return result.
  96   (cdr tramp--test-enabled-checked))
  97
  98 (defun tramp--test-make-temp-name ()
  99   "Create a temporary file name for test."
 100   (expand-file-name
 101    (make-temp-name "tramp-test") tramp-test-temporary-file-directory))
 102
 103 (defmacro tramp--instrument-test-case (verbose &rest body)
 104   "Run BODY with `tramp-verbose' equal VERBOSE.
 105 Print the the content of the Tramp debug buffer, if BODY does not
 106 eval properly in `should', `should-not' or `should-error'."
 107   (declare (indent 1) (debug (natnump body)))
 108   `(let ((tramp-verbose ,verbose)
 109          (tramp-debug-on-error t))
 110      (condition-case err
 111          (progn ,@body)
 112        (ert-test-skipped
 113         (signal (car err) (cdr err)))
 114        (error
 115         (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
 116           (with-current-buffer (tramp-get-connection-buffer v)
 117             (message "%s" (buffer-string)))
 118           (with-current-buffer (tramp-get-debug-buffer v)
 119             (message "%s" (buffer-string))))
 120         (message "%s" err)
 121         (signal (car err) (cdr err))))))
 122
 123 (ert-deftest tramp-test00-availability ()
 124   "Test availability of Tramp functions."
 125   :expected-result (if (tramp--test-enabled) :passed :failed)
 126   (should (ignore-errors
 127             (and
 128              (file-remote-p tramp-test-temporary-file-directory)
 129              (file-directory-p tramp-test-temporary-file-directory)
 130              (file-writable-p tramp-test-temporary-file-directory)))))
 131
 132 (ert-deftest tramp-test01-file-name-syntax ()
 133   "Check remote file name syntax."
 134   ;; Simple cases.
 135   (should (tramp-tramp-file-p "/method::"))
 136   (should (tramp-tramp-file-p "/host:"))
 137   (should (tramp-tramp-file-p "/user@:"))
 138   (should (tramp-tramp-file-p "/user@host:"))
 139   (should (tramp-tramp-file-p "/method:host:"))
 140   (should (tramp-tramp-file-p "/method:user@:"))
 141   (should (tramp-tramp-file-p "/method:user@host:"))
 142   (should (tramp-tramp-file-p "/method:user@email@host:"))
 143
 144   ;; Using a port.
 145   (should (tramp-tramp-file-p "/host#1234:"))
 146   (should (tramp-tramp-file-p "/user@host#1234:"))
 147   (should (tramp-tramp-file-p "/method:host#1234:"))
 148   (should (tramp-tramp-file-p "/method:user@host#1234:"))
 149
 150   ;; Using an IPv4 address.
 151   (should (tramp-tramp-file-p "/1.2.3.4:"))
 152   (should (tramp-tramp-file-p "/user@1.2.3.4:"))
 153   (should (tramp-tramp-file-p "/method:1.2.3.4:"))
 154   (should (tramp-tramp-file-p "/method:user@1.2.3.4:"))
 155
 156   ;; Using an IPv6 address.
 157   (should (tramp-tramp-file-p "/[]:"))
 158   (should (tramp-tramp-file-p "/[::1]:"))
 159   (should (tramp-tramp-file-p "/user@[::1]:"))
 160   (should (tramp-tramp-file-p "/method:[::1]:"))
 161   (should (tramp-tramp-file-p "/method:user@[::1]:"))
 162
 163   ;; Local file name part.
 164   (should (tramp-tramp-file-p "/host:/:"))
 165   (should (tramp-tramp-file-p "/method:::"))
 166   (should (tramp-tramp-file-p "/method::/path/to/file"))
 167   (should (tramp-tramp-file-p "/method::file"))
 168
 169   ;; Multihop.
 170   (should (tramp-tramp-file-p "/method1:|method2::"))
 171   (should (tramp-tramp-file-p "/method1:host1|host2:"))
 172   (should (tramp-tramp-file-p "/method1:host1|method2:host2:"))
 173   (should (tramp-tramp-file-p "/method1:user1@host1|method2:user2@host2:"))
 174   (should (tramp-tramp-file-p
 175            "/method1:user1@host1|method2:user2@host2|method3:user3@host3:"))
 176
 177   ;; No strings.
 178   (should-not (tramp-tramp-file-p nil))
 179   (should-not (tramp-tramp-file-p 'symbol))
 180   ;; "/:" suppresses file name handlers.
 181   (should-not (tramp-tramp-file-p "/::"))
 182   (should-not (tramp-tramp-file-p "/:@:"))
 183   (should-not (tramp-tramp-file-p "/:[]:"))
 184   ;; Multihops require a method.
 185   (should-not (tramp-tramp-file-p "/host1|host2:"))
 186   ;; Methods or hostnames shall be at least two characters on MS Windows.
 187   (when (memq system-type '(cygwin windows-nt))
 188       (should-not (tramp-tramp-file-p "/c:/path/to/file"))
 189       (should-not (tramp-tramp-file-p "/c::/path/to/file"))))
 190
 191 (ert-deftest tramp-test02-file-name-dissect ()
 192   "Check remote file name components."
 193   (let ((tramp-default-method "default-method")
 194         (tramp-default-user "default-user")
 195         (tramp-default-host "default-host"))
 196     ;; Expand `tramp-default-user' and `tramp-default-host'.
 197     (should (string-equal
 198              (file-remote-p "/method::")
 199              (format "/%s:%s@%s:" "method" "default-user" "default-host")))
 200     (should (string-equal (file-remote-p "/method::" 'method) "method"))
 201     (should (string-equal (file-remote-p "/method::" 'user) "default-user"))
 202     (should (string-equal (file-remote-p "/method::" 'host) "default-host"))
 203     (should (string-equal (file-remote-p "/method::" 'localname) ""))
 204
 205     ;; Expand `tramp-default-method' and `tramp-default-user'.
 206     (should (string-equal
 207              (file-remote-p "/host:")
 208              (format "/%s:%s@%s:" "default-method" "default-user" "host")))
 209     (should (string-equal (file-remote-p "/host:" 'method) "default-method"))
 210     (should (string-equal (file-remote-p "/host:" 'user) "default-user"))
 211     (should (string-equal (file-remote-p "/host:" 'host) "host"))
 212     (should (string-equal (file-remote-p "/host:" 'localname) ""))
 213
 214     ;; Expand `tramp-default-method' and `tramp-default-host'.
 215     (should (string-equal
 216              (file-remote-p "/user@:")
 217              (format "/%s:%s@%s:" "default-method""user" "default-host")))
 218     (should (string-equal (file-remote-p "/user@:" 'method) "default-method"))
 219     (should (string-equal (file-remote-p "/user@:" 'user) "user"))
 220     (should (string-equal (file-remote-p "/user@:" 'host) "default-host"))
 221     (should (string-equal (file-remote-p "/user@:" 'localname) ""))
 222
 223     ;; Expand `tramp-default-method'.
 224     (should (string-equal
 225              (file-remote-p "/user@host:")
 226              (format "/%s:%s@%s:" "default-method" "user" "host")))
 227     (should (string-equal
 228              (file-remote-p "/user@host:" 'method) "default-method"))
 229     (should (string-equal (file-remote-p "/user@host:" 'user) "user"))
 230     (should (string-equal (file-remote-p "/user@host:" 'host) "host"))
 231     (should (string-equal (file-remote-p "/user@host:" 'localname) ""))
 232
 233     ;; Expand `tramp-default-user'.
 234     (should (string-equal
 235              (file-remote-p "/method:host:")
 236              (format "/%s:%s@%s:" "method" "default-user" "host")))
 237     (should (string-equal (file-remote-p "/method:host:" 'method) "method"))
 238     (should (string-equal (file-remote-p "/method:host:" 'user) "default-user"))
 239     (should (string-equal (file-remote-p "/method:host:" 'host) "host"))
 240     (should (string-equal (file-remote-p "/method:host:" 'localname) ""))
 241
 242     ;; Expand `tramp-default-host'.
 243     (should (string-equal
 244              (file-remote-p "/method:user@:")
 245              (format "/%s:%s@%s:" "method" "user" "default-host")))
 246     (should (string-equal (file-remote-p "/method:user@:" 'method) "method"))
 247     (should (string-equal (file-remote-p "/method:user@:" 'user) "user"))
 248     (should (string-equal (file-remote-p "/method:user@:" 'host)
 249                           "default-host"))
 250     (should (string-equal (file-remote-p "/method:user@:" 'localname) ""))
 251
 252     ;; No expansion.
 253     (should (string-equal
 254              (file-remote-p "/method:user@host:")
 255              (format "/%s:%s@%s:" "method" "user" "host")))
 256     (should (string-equal
 257              (file-remote-p "/method:user@host:" 'method) "method"))
 258     (should (string-equal (file-remote-p "/method:user@host:" 'user) "user"))
 259     (should (string-equal (file-remote-p "/method:user@host:" 'host) "host"))
 260     (should (string-equal (file-remote-p "/method:user@host:" 'localname) ""))
 261
 262     ;; No expansion.
 263     (should (string-equal
 264              (file-remote-p "/method:user@email@host:")
 265              (format "/%s:%s@%s:" "method" "user@email" "host")))
 266     (should (string-equal
 267              (file-remote-p "/method:user@email@host:" 'method) "method"))
 268     (should (string-equal
 269              (file-remote-p "/method:user@email@host:" 'user) "user@email"))
 270     (should (string-equal
 271              (file-remote-p "/method:user@email@host:" 'host) "host"))
 272     (should (string-equal
 273              (file-remote-p "/method:user@email@host:" 'localname) ""))
 274
 275     ;; Expand `tramp-default-method' and `tramp-default-user'.
 276     (should (string-equal
 277              (file-remote-p "/host#1234:")
 278              (format "/%s:%s@%s:" "default-method" "default-user" "host#1234")))
 279     (should (string-equal
 280              (file-remote-p "/host#1234:" 'method) "default-method"))
 281     (should (string-equal (file-remote-p "/host#1234:" 'user) "default-user"))
 282     (should (string-equal (file-remote-p "/host#1234:" 'host) "host#1234"))
 283     (should (string-equal (file-remote-p "/host#1234:" 'localname) ""))
 284
 285     ;; Expand `tramp-default-method'.
 286     (should (string-equal
 287              (file-remote-p "/user@host#1234:")
 288              (format "/%s:%s@%s:" "default-method" "user" "host#1234")))
 289     (should (string-equal
 290              (file-remote-p "/user@host#1234:" 'method) "default-method"))
 291     (should (string-equal (file-remote-p "/user@host#1234:" 'user) "user"))
 292     (should (string-equal (file-remote-p "/user@host#1234:" 'host) "host#1234"))
 293     (should (string-equal (file-remote-p "/user@host#1234:" 'localname) ""))
 294
 295     ;; Expand `tramp-default-user'.
 296     (should (string-equal
 297              (file-remote-p "/method:host#1234:")
 298              (format "/%s:%s@%s:" "method" "default-user" "host#1234")))
 299     (should (string-equal
 300              (file-remote-p "/method:host#1234:" 'method) "method"))
 301     (should (string-equal
 302              (file-remote-p "/method:host#1234:" 'user) "default-user"))
 303     (should (string-equal
 304              (file-remote-p "/method:host#1234:" 'host) "host#1234"))
 305     (should (string-equal (file-remote-p "/method:host#1234:" 'localname) ""))
 306
 307     ;; No expansion.
 308     (should (string-equal
 309              (file-remote-p "/method:user@host#1234:")
 310              (format "/%s:%s@%s:" "method" "user" "host#1234")))
 311     (should (string-equal
 312              (file-remote-p "/method:user@host#1234:" 'method) "method"))
 313     (should (string-equal
 314              (file-remote-p "/method:user@host#1234:" 'user) "user"))
 315     (should (string-equal
 316              (file-remote-p "/method:user@host#1234:" 'host) "host#1234"))
 317     (should (string-equal
 318              (file-remote-p "/method:user@host#1234:" 'localname) ""))
 319
 320     ;; Expand `tramp-default-method' and `tramp-default-user'.
 321     (should (string-equal
 322              (file-remote-p "/1.2.3.4:")
 323              (format "/%s:%s@%s:" "default-method" "default-user" "1.2.3.4")))
 324     (should (string-equal (file-remote-p "/1.2.3.4:" 'method) "default-method"))
 325     (should (string-equal (file-remote-p "/1.2.3.4:" 'user) "default-user"))
 326     (should (string-equal (file-remote-p "/1.2.3.4:" 'host) "1.2.3.4"))
 327     (should (string-equal (file-remote-p "/1.2.3.4:" 'localname) ""))
 328
 329     ;; Expand `tramp-default-method'.
 330     (should (string-equal
 331              (file-remote-p "/user@1.2.3.4:")
 332              (format "/%s:%s@%s:" "default-method" "user" "1.2.3.4")))
 333     (should (string-equal
 334              (file-remote-p "/user@1.2.3.4:" 'method) "default-method"))
 335     (should (string-equal (file-remote-p "/user@1.2.3.4:" 'user) "user"))
 336     (should (string-equal (file-remote-p "/user@1.2.3.4:" 'host) "1.2.3.4"))
 337     (should (string-equal (file-remote-p "/user@1.2.3.4:" 'localname) ""))
 338
 339     ;; Expand `tramp-default-user'.
 340     (should (string-equal
 341              (file-remote-p "/method:1.2.3.4:")
 342              (format "/%s:%s@%s:" "method" "default-user" "1.2.3.4")))
 343     (should (string-equal (file-remote-p "/method:1.2.3.4:" 'method) "method"))
 344     (should (string-equal
 345              (file-remote-p "/method:1.2.3.4:" 'user) "default-user"))
 346     (should (string-equal (file-remote-p "/method:1.2.3.4:" 'host) "1.2.3.4"))
 347     (should (string-equal (file-remote-p "/method:1.2.3.4:" 'localname) ""))
 348
 349     ;; No expansion.
 350     (should (string-equal
 351              (file-remote-p "/method:user@1.2.3.4:")
 352              (format "/%s:%s@%s:" "method" "user" "1.2.3.4")))
 353     (should (string-equal
 354              (file-remote-p "/method:user@1.2.3.4:" 'method) "method"))
 355     (should (string-equal (file-remote-p "/method:user@1.2.3.4:" 'user) "user"))
 356     (should (string-equal
 357              (file-remote-p "/method:user@1.2.3.4:" 'host) "1.2.3.4"))
 358     (should (string-equal
 359              (file-remote-p "/method:user@1.2.3.4:" 'localname) ""))
 360
 361     ;; Expand `tramp-default-method', `tramp-default-user' and
 362     ;; `tramp-default-host'.
 363     (should (string-equal
 364              (file-remote-p "/[]:")
 365              (format
 366               "/%s:%s@%s:" "default-method" "default-user" "default-host")))
 367     (should (string-equal (file-remote-p "/[]:" 'method) "default-method"))
 368     (should (string-equal (file-remote-p "/[]:" 'user) "default-user"))
 369     (should (string-equal (file-remote-p "/[]:" 'host) "default-host"))
 370     (should (string-equal (file-remote-p "/[]:" 'localname) ""))
 371
 372     ;; Expand `tramp-default-method' and `tramp-default-user'.
 373     (let ((tramp-default-host "::1"))
 374       (should (string-equal
 375                (file-remote-p "/[]:")
 376                (format "/%s:%s@%s:" "default-method" "default-user" "[::1]")))
 377       (should (string-equal (file-remote-p "/[]:" 'method) "default-method"))
 378       (should (string-equal (file-remote-p "/[]:" 'user) "default-user"))
 379       (should (string-equal (file-remote-p "/[]:" 'host) "::1"))
 380       (should (string-equal (file-remote-p "/[]:" 'localname) "")))
 381
 382     ;; Expand `tramp-default-method' and `tramp-default-user'.
 383     (should (string-equal
 384              (file-remote-p "/[::1]:")
 385              (format "/%s:%s@%s:" "default-method" "default-user" "[::1]")))
 386     (should (string-equal (file-remote-p "/[::1]:" 'method) "default-method"))
 387     (should (string-equal (file-remote-p "/[::1]:" 'user) "default-user"))
 388     (should (string-equal (file-remote-p "/[::1]:" 'host) "::1"))
 389     (should (string-equal (file-remote-p "/[::1]:" 'localname) ""))
 390
 391     ;; Expand `tramp-default-method'.
 392     (should (string-equal
 393              (file-remote-p "/user@[::1]:")
 394              (format "/%s:%s@%s:" "default-method" "user" "[::1]")))
 395     (should (string-equal
 396              (file-remote-p "/user@[::1]:" 'method) "default-method"))
 397     (should (string-equal (file-remote-p "/user@[::1]:" 'user) "user"))
 398     (should (string-equal (file-remote-p "/user@[::1]:" 'host) "::1"))
 399     (should (string-equal (file-remote-p "/user@[::1]:" 'localname) ""))
 400
 401     ;; Expand `tramp-default-user'.
 402     (should (string-equal
 403              (file-remote-p "/method:[::1]:")
 404              (format "/%s:%s@%s:" "method" "default-user" "[::1]")))
 405     (should (string-equal (file-remote-p "/method:[::1]:" 'method) "method"))
 406     (should (string-equal
 407              (file-remote-p "/method:[::1]:" 'user) "default-user"))
 408     (should (string-equal (file-remote-p "/method:[::1]:" 'host) "::1"))
 409     (should (string-equal (file-remote-p "/method:[::1]:" 'localname) ""))
 410
 411     ;; No expansion.
 412     (should (string-equal
 413              (file-remote-p "/method:user@[::1]:")
 414              (format "/%s:%s@%s:" "method" "user" "[::1]")))
 415     (should (string-equal
 416              (file-remote-p "/method:user@[::1]:" 'method) "method"))
 417     (should (string-equal (file-remote-p "/method:user@[::1]:" 'user) "user"))
 418     (should (string-equal (file-remote-p "/method:user@[::1]:" 'host) "::1"))
 419     (should (string-equal
 420              (file-remote-p "/method:user@[::1]:" 'localname) ""))
 421
 422     ;; Local file name part.
 423     (should (string-equal (file-remote-p "/host:/:" 'localname) "/:"))
 424     (should (string-equal (file-remote-p "/method:::" 'localname) ":"))
 425     (should (string-equal (file-remote-p "/method:: " 'localname) " "))
 426     (should (string-equal (file-remote-p "/method::file" 'localname) "file"))
 427     (should (string-equal
 428              (file-remote-p "/method::/path/to/file" 'localname)
 429              "/path/to/file"))
 430
 431     ;; Multihop.
 432     (should
 433      (string-equal
 434       (file-remote-p "/method1:user1@host1|method2:user2@host2:/path/to/file")
 435       (format "/%s:%s@%s:" "method2" "user2" "host2")))
 436     (should
 437      (string-equal
 438       (file-remote-p
 439        "/method1:user1@host1|method2:user2@host2:/path/to/file" 'method)
 440       "method2"))
 441     (should
 442      (string-equal
 443       (file-remote-p
 444        "/method1:user1@host1|method2:user2@host2:/path/to/file" 'user)
 445       "user2"))
 446     (should
 447      (string-equal
 448       (file-remote-p
 449        "/method1:user1@host1|method2:user2@host2:/path/to/file" 'host)
 450       "host2"))
 451     (should
 452      (string-equal
 453       (file-remote-p
 454        "/method1:user1@host1|method2:user2@host2:/path/to/file" 'localname)
 455       "/path/to/file"))
 456
 457     (should
 458      (string-equal
 459       (file-remote-p
 460        "/method1:user1@host1|method2:user2@host2|method3:user3@host3:/path/to/file")
 461       (format "/%s:%s@%s:" "method3" "user3" "host3")))
 462     (should
 463      (string-equal
 464       (file-remote-p
 465        "/method1:user1@host1|method2:user2@host2|method3:user3@host3:/path/to/file"
 466        'method)
 467       "method3"))
 468     (should
 469      (string-equal
 470       (file-remote-p
 471        "/method1:user1@host1|method2:user2@host2|method3:user3@host3:/path/to/file"
 472        'user)
 473       "user3"))
 474     (should
 475      (string-equal
 476       (file-remote-p
 477        "/method1:user1@host1|method2:user2@host2|method3:user3@host3:/path/to/file"
 478        'host)
 479       "host3"))
 480     (should
 481      (string-equal
 482       (file-remote-p
 483        "/method1:user1@host1|method2:user2@host2|method3:user3@host3:/path/to/file"
 484        'localname)
 485       "/path/to/file"))))
 486
 487 (ert-deftest tramp-test03-file-name-defaults ()
 488   "Check default values for some methods."
 489   ;; Default values in tramp-adb.el.
 490   (should (string-equal (file-remote-p "/adb::" 'host) ""))
 491   ;; Default values in tramp-ftp.el.
 492   (should (string-equal (file-remote-p "/ftp.host:" 'method) "ftp"))
 493   (dolist (u '("ftp" "anonymous"))
 494     (should (string-equal (file-remote-p (format "/%s@:" u) 'method) "ftp")))
 495   ;; Default values in tramp-gvfs.el.
 496   (when (and (load "tramp-gvfs" 'noerror 'nomessage)
 497              (symbol-value 'tramp-gvfs-enabled))
 498     (should (string-equal (file-remote-p "/synce::" 'user) nil)))
 499   ;; Default values in tramp-gw.el.
 500   (dolist (m '("tunnel" "socks"))
 501     (should
 502      (string-equal (file-remote-p (format "/%s::" m) 'user) (user-login-name))))
 503   ;; Default values in tramp-sh.el.
 504   (dolist (h `("127.0.0.1" "[::1]" "localhost" "localhost6" ,(system-name)))
 505     (should (string-equal (file-remote-p (format "/root@%s:" h) 'method) "su")))
 506   (dolist (m '("su" "sudo" "ksu"))
 507     (should (string-equal (file-remote-p (format "/%s::" m) 'user) "root")))
 508   (dolist (m '("rcp" "remcp" "rsh" "telnet" "krlogin" "fcp"))
 509     (should
 510      (string-equal (file-remote-p (format "/%s::" m) 'user) (user-login-name))))
 511   ;; Default values in tramp-smb.el.
 512   (should (string-equal (file-remote-p "/user%domain@host:" 'method) "smb"))
 513   (should (string-equal (file-remote-p "/smb::" 'user) nil)))
 514
 515 (ert-deftest tramp-test04-substitute-in-file-name ()
 516   "Check `substitute-in-file-name'."
 517   (should (string-equal (substitute-in-file-name "/method:host://foo") "/foo"))
 518   (should
 519    (string-equal
 520     (substitute-in-file-name "/method:host:/path//foo") "/method:host:/foo"))
 521   (should
 522    (string-equal (substitute-in-file-name "/method:host:/path///foo")   "/foo"))
 523   (should
 524    (string-equal
 525     (substitute-in-file-name "/method:host:/path/~/foo") "/method:host:~/foo"))
 526   (should
 527    (string-equal (substitute-in-file-name "/method:host:/path//~/foo") "~/foo"))
 528   (let (process-environment)
 529     (should
 530      (string-equal
 531       (substitute-in-file-name "/method:host:/path/$FOO")
 532       "/method:host:/path/$FOO"))
 533     (setenv "FOO" "bla")
 534     (should
 535      (string-equal
 536       (substitute-in-file-name "/method:host:/path/$FOO")
 537       "/method:host:/path/bla"))
 538     (should
 539      (string-equal
 540       (substitute-in-file-name "/method:host:/path/$$FOO")
 541       "/method:host:/path/$FOO"))))
 542
 543 (ert-deftest tramp-test05-expand-file-name ()
 544   "Check `expand-file-name'."
 545   (should
 546    (string-equal
 547     (expand-file-name "/method:host:/path/./file") "/method:host:/path/file"))
 548   (should
 549    (string-equal
 550     (expand-file-name "/method:host:/path/../file") "/method:host:/file")))
 551
 552 (ert-deftest tramp-test06-directory-file-name ()
 553   "Check `directory-file-name'.
 554 This checks also `file-name-as-directory', `file-name-directory'
 555 and `file-name-nondirectory'."
 556   (should
 557    (string-equal
 558     (directory-file-name "/method:host:/path/to/file")
 559     "/method:host:/path/to/file"))
 560   (should
 561    (string-equal
 562     (directory-file-name "/method:host:/path/to/file/")
 563     "/method:host:/path/to/file"))
 564   (should
 565    (string-equal
 566     (file-name-as-directory "/method:host:/path/to/file")
 567     "/method:host:/path/to/file/"))
 568   (should
 569    (string-equal
 570     (file-name-as-directory "/method:host:/path/to/file/")
 571     "/method:host:/path/to/file/"))
 572   (should
 573    (string-equal
 574     (file-name-directory "/method:host:/path/to/file")
 575     "/method:host:/path/to/"))
 576   (should
 577    (string-equal
 578     (file-name-directory "/method:host:/path/to/file/")
 579     "/method:host:/path/to/file/"))
 580   (should
 581    (string-equal (file-name-nondirectory "/method:host:/path/to/file") "file"))
 582   (should
 583    (string-equal (file-name-nondirectory "/method:host:/path/to/file/") ""))
 584   (should-not
 585    (file-remote-p
 586     (unhandled-file-name-directory "/method:host:/path/to/file"))))
 587
 588 (ert-deftest tramp-test07-file-exists-p ()
 589   "Check `file-exist-p', `write-region' and `delete-file'."
 590   (skip-unless (tramp--test-enabled))
 591
 592   (let ((tmp-name (tramp--test-make-temp-name)))
 593     (should-not (file-exists-p tmp-name))
 594     (write-region "foo" nil tmp-name)
 595     (should (file-exists-p tmp-name))
 596     (delete-file tmp-name)
 597     (should-not (file-exists-p tmp-name))))
 598
 599 (ert-deftest tramp-test08-file-local-copy ()
 600   "Check `file-local-copy'."
 601   (skip-unless (tramp--test-enabled))
 602
 603   (let ((tmp-name1 (tramp--test-make-temp-name))
 604         tmp-name2)
 605     (unwind-protect
 606         (progn
 607           (write-region "foo" nil tmp-name1)
 608           (should (setq tmp-name2 (file-local-copy tmp-name1)))
 609           (with-temp-buffer
 610             (insert-file-contents tmp-name2)
 611             (should (string-equal (buffer-string) "foo"))))
 612       (ignore-errors
 613         (delete-file tmp-name1)
 614         (delete-file tmp-name2)))))
 615
 616 (ert-deftest tramp-test09-insert-file-contents ()
 617   "Check `insert-file-contents'."
 618   (skip-unless (tramp--test-enabled))
 619
 620   (let ((tmp-name (tramp--test-make-temp-name)))
 621     (unwind-protect
 622         (progn
 623           (write-region "foo" nil tmp-name)
 624           (with-temp-buffer
 625             (insert-file-contents tmp-name)
 626             (should (string-equal (buffer-string) "foo"))
 627             (insert-file-contents tmp-name)
 628             (should (string-equal (buffer-string) "foofoo"))
 629             ;; Insert partly.
 630             (insert-file-contents tmp-name nil 1 3)
 631             (should (string-equal (buffer-string) "oofoofoo"))
 632             ;; Replace.
 633             (insert-file-contents tmp-name nil nil nil 'replace)
 634             (should (string-equal (buffer-string) "foo"))))
 635       (ignore-errors (delete-file tmp-name)))))
 636
 637 (ert-deftest tramp-test10-write-region ()
 638   "Check `write-region'."
 639   (skip-unless (tramp--test-enabled))
 640
 641   (let ((tmp-name (tramp--test-make-temp-name)))
 642     (unwind-protect
 643         (progn
 644           (with-temp-buffer
 645             (insert "foo")
 646             (write-region nil nil tmp-name))
 647           (with-temp-buffer
 648             (insert-file-contents tmp-name)
 649             (should (string-equal (buffer-string) "foo")))
 650           ;; Append.
 651           (with-temp-buffer
 652             (insert "bla")
 653             (write-region nil nil tmp-name 'append))
 654           (with-temp-buffer
 655             (insert-file-contents tmp-name)
 656             (should (string-equal (buffer-string) "foobla")))
 657           ;; Write string.
 658           (write-region "foo" nil tmp-name)
 659           (with-temp-buffer
 660             (insert-file-contents tmp-name)
 661             (should (string-equal (buffer-string) "foo")))
 662           ;; Write partly.
 663           (with-temp-buffer
 664             (insert "123456789")
 665             (write-region 3 5 tmp-name))
 666           (with-temp-buffer
 667             (insert-file-contents tmp-name)
 668             (should (string-equal (buffer-string) "34"))))
 669      (ignore-errors (delete-file tmp-name)))))
 670
 671 (ert-deftest tramp-test11-copy-file ()
 672   "Check `copy-file'."
 673   (skip-unless (tramp--test-enabled))
 674
 675   (let ((tmp-name1 (tramp--test-make-temp-name))
 676         (tmp-name2 (tramp--test-make-temp-name)))
 677     (unwind-protect
 678         (progn
 679           (write-region "foo" nil tmp-name1)
 680           (copy-file tmp-name1 tmp-name2)
 681           (should (file-exists-p tmp-name2))
 682           (with-temp-buffer
 683             (insert-file-contents tmp-name2)
 684             (should (string-equal (buffer-string) "foo"))))
 685       (ignore-errors
 686         (delete-file tmp-name1)
 687         (delete-file tmp-name2)))))
 688
 689 (ert-deftest tramp-test12-rename-file ()
 690   "Check `rename-file'."
 691   (skip-unless (tramp--test-enabled))
 692
 693   (let ((tmp-name1 (tramp--test-make-temp-name))
 694         (tmp-name2 (tramp--test-make-temp-name)))
 695     (unwind-protect
 696         (progn
 697           (write-region "foo" nil tmp-name1)
 698           (rename-file tmp-name1 tmp-name2)
 699           (should-not (file-exists-p tmp-name1))
 700           (should (file-exists-p tmp-name2))
 701           (with-temp-buffer
 702             (insert-file-contents tmp-name2)
 703             (should (string-equal (buffer-string) "foo"))))
 704       (ignore-errors (delete-file tmp-name2)))))
 705
 706 (ert-deftest tramp-test13-make-directory ()
 707   "Check `make-directory'.
 708 This tests also `file-directory-p' and `file-accessible-directory-p'."
 709   (skip-unless (tramp--test-enabled))
 710
 711   (let ((tmp-name (tramp--test-make-temp-name)))
 712     (unwind-protect
 713         (progn
 714           (make-directory tmp-name)
 715           (should (file-directory-p tmp-name))
 716           (should (file-accessible-directory-p tmp-name)))
 717       (ignore-errors (delete-directory tmp-name)))))
 718
 719 (ert-deftest tramp-test14-delete-directory ()
 720   "Check `delete-directory'."
 721   (skip-unless (tramp--test-enabled))
 722
 723   (let ((tmp-name (tramp--test-make-temp-name)))
 724     ;; Delete empty directory.
 725     (make-directory tmp-name)
 726     (should (file-directory-p tmp-name))
 727     (delete-directory tmp-name)
 728     (should-not (file-directory-p tmp-name))
 729     ;; Delete non-empty directory.
 730     (make-directory tmp-name)
 731     (write-region "foo" nil (expand-file-name "bla" tmp-name))
 732     (should-error (delete-directory tmp-name) :type 'file-error)
 733     (delete-directory tmp-name 'recursive)
 734     (should-not (file-directory-p tmp-name))))
 735
 736 (ert-deftest tramp-test15-copy-directory ()
 737   "Check `copy-directory'."
 738   (skip-unless (tramp--test-enabled))
 739
 740   (let* ((tmp-name1 (tramp--test-make-temp-name))
 741          (tmp-name2 (tramp--test-make-temp-name))
 742          (tmp-name3 (expand-file-name
 743                      (file-name-nondirectory tmp-name1) tmp-name2))
 744          (tmp-name4 (expand-file-name "foo" tmp-name1))
 745          (tmp-name5 (expand-file-name "foo" tmp-name2))
 746          (tmp-name6 (expand-file-name "foo" tmp-name3)))
 747     (unwind-protect
 748         (progn
 749           ;; Copy empty directory.
 750           (make-directory tmp-name1)
 751           (write-region "foo" nil tmp-name4)
 752           (should (file-directory-p tmp-name1))
 753           (should (file-exists-p tmp-name4))
 754           ;; We do not care, whether file permissions and time stamps
 755           ;; are correct.  Sometimes, it is not possible to manage
 756           ;; them, for example in tramp-adb.el.
 757           (ignore-errors (copy-directory tmp-name1 tmp-name2))
 758           (should (file-directory-p tmp-name2))
 759           (should (file-exists-p tmp-name5))
 760           ;; Target directory does exist already.
 761           (ignore-errors (copy-directory tmp-name1 tmp-name2))
 762           (should (file-directory-p tmp-name3))
 763           (should (file-exists-p tmp-name6)))
 764       (ignore-errors
 765         (delete-directory tmp-name1 'recursive)
 766         (delete-directory tmp-name2 'recursive)))))
 767
 768 (ert-deftest tramp-test16-directory-files ()
 769   "Check `directory-files'."
 770   (skip-unless (tramp--test-enabled))
 771
 772   (let* ((tmp-name1 (tramp--test-make-temp-name))
 773          (tmp-name2 (expand-file-name "bla" tmp-name1))
 774          (tmp-name3 (expand-file-name "foo" tmp-name1)))
 775     (unwind-protect
 776         (progn
 777           (make-directory tmp-name1)
 778           (write-region "foo" nil tmp-name2)
 779           (write-region "bla" nil tmp-name3)
 780           (should (file-directory-p tmp-name1))
 781           (should (file-exists-p tmp-name2))
 782           (should (file-exists-p tmp-name3))
 783           (should (equal (directory-files tmp-name1) '("." ".." "bla" "foo")))
 784           (should (equal (directory-files tmp-name1 'full)
 785                          `(,(concat tmp-name1 "/.")
 786                            ,(concat tmp-name1 "/..")
 787                            ,tmp-name2 ,tmp-name3)))
 788           (should (equal (directory-files
 789                           tmp-name1 nil directory-files-no-dot-files-regexp)
 790                          '("bla" "foo")))
 791           (should (equal (directory-files
 792                           tmp-name1 'full directory-files-no-dot-files-regexp)
 793                          `(,tmp-name2 ,tmp-name3))))
 794       (ignore-errors (delete-directory tmp-name1 'recursive)))))
 795
 796 (ert-deftest tramp-test17-insert-directory ()
 797   "Check `insert-directory'."
 798   (skip-unless (tramp--test-enabled))
 799
 800   (let* ((tmp-name1 (tramp--test-make-temp-name))
 801          (tmp-name2 (expand-file-name "foo" tmp-name1)))
 802     (unwind-protect
 803         (progn
 804           (make-directory tmp-name1)
 805           (write-region "foo" nil tmp-name2)
 806           (should (file-directory-p tmp-name1))
 807           (should (file-exists-p tmp-name2))
 808           (with-temp-buffer
 809             (insert-directory tmp-name1 nil)
 810             (goto-char (point-min))
 811             (should (looking-at-p (regexp-quote tmp-name1))))
 812           (with-temp-buffer
 813             (insert-directory tmp-name1 "-al")
 814             (goto-char (point-min))
 815             (should (looking-at-p (format "^.+ %s$" (regexp-quote tmp-name1)))))
 816           (with-temp-buffer
 817             (insert-directory (file-name-as-directory tmp-name1) "-al")
 818             (goto-char (point-min))
 819             (should
 820              (looking-at-p (format "^.+ %s/$" (regexp-quote tmp-name1)))))
 821           (with-temp-buffer
 822             (insert-directory
 823              (file-name-as-directory tmp-name1) "-al" nil 'full-directory-p)
 824             (goto-char (point-min))
 825             (should
 826              (looking-at-p
 827               "\\(total.+[[:digit:]]+\n\\)?.+ \\.\n.+ \\.\\.\n.+ foo$"))))
 828       (ignore-errors (delete-directory tmp-name1 'recursive)))))
 829
 830 (ert-deftest tramp-test18-file-attributes ()
 831   "Check `file-attributes'.
 832 This tests also `file-readable-p' and `file-regular-p'."
 833   (skip-unless (tramp--test-enabled))
 834
 835   (let ((tmp-name (tramp--test-make-temp-name))
 836         attr)
 837     (unwind-protect
 838         (progn
 839           (write-region "foo" nil tmp-name)
 840           (should (file-exists-p tmp-name))
 841           (setq attr (file-attributes tmp-name))
 842           (should (consp attr))
 843           (should (file-exists-p tmp-name))
 844           (should (file-readable-p tmp-name))
 845           (should (file-regular-p tmp-name))
 846           ;; We do not test inodes and device numbers.
 847           (should (null (car attr)))
 848           (should (numberp (nth 1 attr))) ;; Link.
 849           (should (numberp (nth 2 attr))) ;; Uid.
 850           (should (numberp (nth 3 attr))) ;; Gid.
 851           ;; Last access time.
 852           (should (stringp (current-time-string (nth 4 attr))))
 853           ;; Last modification time.
 854           (should (stringp (current-time-string (nth 5 attr))))
 855           ;; Last status change time.
 856           (should (stringp (current-time-string (nth 6 attr))))
 857           (should (numberp (nth 7 attr))) ;; Size.
 858           (should (stringp (nth 8 attr))) ;; Modes.
 859
 860           (setq attr (file-attributes tmp-name 'string))
 861           (should (stringp (nth 2 attr))) ;; Uid.
 862           (should (stringp (nth 3 attr))) ;; Gid.
 863           (delete-file tmp-name)
 864
 865           (make-directory tmp-name)
 866           (should (file-exists-p tmp-name))
 867           (should (file-readable-p tmp-name))
 868           (should-not (file-regular-p tmp-name))
 869           (setq attr (file-attributes tmp-name))
 870           (should (eq (car attr) t)))
 871       (ignore-errors (delete-directory tmp-name)))))
 872
 873 (ert-deftest tramp-test19-directory-files-and-attributes ()
 874   "Check `directory-files-and-attributes'."
 875   (skip-unless (tramp--test-enabled))
 876
 877   ;; `directory-files-and-attributes' contains also values for "../".
 878   ;; We must nesure, that this doesn't change during tests, for
 879   ;; example due to handling temporary files.
 880   (let* ((tmp-name1 (tramp--test-make-temp-name))
 881          (tmp-name2 (expand-file-name "bla" tmp-name1))
 882          attr)
 883     (unwind-protect
 884         (progn
 885           (make-directory tmp-name1)
 886           (should (file-directory-p tmp-name1))
 887           (make-directory tmp-name2)
 888           (should (file-directory-p tmp-name2))
 889           (write-region "foo" nil (expand-file-name "foo" tmp-name2))
 890           (write-region "bar" nil (expand-file-name "bar" tmp-name2))
 891           (write-region "boz" nil (expand-file-name "boz" tmp-name2))
 892           (setq attr (directory-files-and-attributes tmp-name2))
 893           (should (consp attr))
 894           (dolist (elt attr)
 895             (should
 896              (equal (file-attributes (expand-file-name (car elt) tmp-name2))
 897                     (cdr elt))))
 898           (setq attr (directory-files-and-attributes tmp-name2 'full))
 899           (dolist (elt attr)
 900             (should
 901              (equal (file-attributes (car elt)) (cdr elt))))
 902           (setq attr (directory-files-and-attributes tmp-name2 nil "^b"))
 903           (should (equal (mapcar 'car attr) '("bar" "boz"))))
 904       (ignore-errors (delete-directory tmp-name1 'recursive)))))
 905
 906 (ert-deftest tramp-test20-file-modes ()
 907   "Check `file-modes'.
 908 This tests also `file-executable-p', `file-writable-p' and `set-file-modes'."
 909   (skip-unless (tramp--test-enabled))
 910   (skip-unless
 911    (not
 912     (memq
 913      (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory)
 914      '(tramp-adb-file-name-handler
 915        tramp-gvfs-file-name-handler
 916        tramp-smb-file-name-handler))))
 917
 918   (let ((tmp-name (tramp--test-make-temp-name)))
 919     (unwind-protect
 920         (progn
 921           (write-region "foo" nil tmp-name)
 922           (should (file-exists-p tmp-name))
 923           (set-file-modes tmp-name #o777)
 924           (should (= (file-modes tmp-name) #o777))
 925           (should (file-executable-p tmp-name))
 926           (should (file-writable-p tmp-name))
 927           (set-file-modes tmp-name #o444)
 928           (should (= (file-modes tmp-name) #o444))
 929           (should-not (file-executable-p tmp-name))
 930           ;; A file is always writable for user "root".
 931           (when (not (string-equal (file-remote-p tmp-name 'user) "root"))
 932             (should-not (file-writable-p tmp-name))))
 933       (ignore-errors (delete-file tmp-name)))))
 934
 935 (ert-deftest tramp-test21-file-links ()
 936   "Check `file-symlink-p'.
 937 This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
 938   (skip-unless (tramp--test-enabled))
 939
 940   (let ((tmp-name1 (tramp--test-make-temp-name))
 941         (tmp-name2 (tramp--test-make-temp-name))
 942         (tmp-name3 (make-temp-name "tramp-")))
 943     (unwind-protect
 944         (progn
 945           (write-region "foo" nil tmp-name1)
 946           (should (file-exists-p tmp-name1))
 947           ;; Method "smb" supports `make-symbolic-link' only if the
 948           ;; remote host has CIFS capabilities.  tramp-adb.el and
 949           ;; tramp-gvfs.el do not support symbolic links at all.
 950           (condition-case err
 951               (make-symbolic-link tmp-name1 tmp-name2)
 952             (file-error
 953              (skip-unless
 954               (not (string-equal (error-message-string err)
 955                                  "make-symbolic-link not supported")))))
 956           (should (file-symlink-p tmp-name2))
 957           (should-error (make-symbolic-link tmp-name1 tmp-name2))
 958           (make-symbolic-link tmp-name1 tmp-name2 'ok-if-already-exists)
 959           (should (file-symlink-p tmp-name2))
 960           ;; `tmp-name3' is a local file name.
 961           (should-error (make-symbolic-link tmp-name1 tmp-name3)))
 962       (ignore-errors
 963         (delete-file tmp-name1)
 964         (delete-file tmp-name2)))
 965
 966     (unwind-protect
 967         (progn
 968           (write-region "foo" nil tmp-name1)
 969           (should (file-exists-p tmp-name1))
 970           (add-name-to-file tmp-name1 tmp-name2)
 971           (should-not (file-symlink-p tmp-name2))
 972           (should-error (add-name-to-file tmp-name1 tmp-name2))
 973           (add-name-to-file tmp-name1 tmp-name2 'ok-if-already-exists)
 974           (should-not (file-symlink-p tmp-name2))
 975           ;; `tmp-name3' is a local file name.
 976           (should-error (add-name-to-file tmp-name1 tmp-name3)))
 977       (ignore-errors
 978         (delete-file tmp-name1)
 979         (delete-file tmp-name2)))
 980
 981     (unwind-protect
 982         (progn
 983           (write-region "foo" nil tmp-name1)
 984           (should (file-exists-p tmp-name1))
 985           (make-symbolic-link tmp-name1 tmp-name2)
 986           (should (file-symlink-p tmp-name2))
 987           (should-not (string-equal tmp-name2 (file-truename tmp-name2)))
 988           (should
 989            (string-equal (file-truename tmp-name1) (file-truename tmp-name2))))
 990       (ignore-errors
 991         (delete-file tmp-name1)
 992         (delete-file tmp-name2)))
 993
 994     ;; `file-truename' shall preserve trailing link of directories.
 995     (let* ((dir1 (directory-file-name tramp-test-temporary-file-directory))
 996            (dir2 (file-name-as-directory dir1)))
 997       (should (string-equal (file-truename dir1) (expand-file-name dir1)))
 998       (should (string-equal (file-truename dir2) (expand-file-name dir2))))))
 999
1000 (ert-deftest tramp-test22-file-times ()
1001   "Check `set-file-times' and `file-newer-than-file-p'."
1002   (skip-unless (tramp--test-enabled))
1003   (skip-unless
1004    (not
1005     (memq
1006      (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory)
1007      '(tramp-gvfs-file-name-handler tramp-smb-file-name-handler))))
1008
1009   (let ((tmp-name1 (tramp--test-make-temp-name))
1010         (tmp-name2 (tramp--test-make-temp-name))
1011         (tmp-name3 (tramp--test-make-temp-name)))
1012     (unwind-protect
1013         (progn
1014           (write-region "foo" nil tmp-name1)
1015           (should (file-exists-p tmp-name1))
1016           (should (consp (nth 5 (file-attributes tmp-name1))))
1017           ;; '(0 0) means don't know, and will be replaced by
1018           ;; `current-time'.  Therefore, we use '(0 1).
1019           ;; We skip the test, if the remote handler is not able to
1020           ;; set the correct time.
1021           (skip-unless (set-file-times tmp-name1 '(0 1)))
1022           ;; Dumb busyboxes are not able to return the date correctly.
1023           ;; They say "don't know.
1024           (skip-unless (not (equal (nth 5 (file-attributes tmp-name1)) '(0 0))))
1025           (should (equal (nth 5 (file-attributes tmp-name1)) '(0 1)))
1026           (write-region "bla" nil tmp-name2)
1027           (should (file-exists-p tmp-name2))
1028           (should (file-newer-than-file-p tmp-name2 tmp-name1))
1029           ;; `tmp-name3' does not exist.
1030           (should (file-newer-than-file-p tmp-name2 tmp-name3))
1031           (should-not (file-newer-than-file-p tmp-name3 tmp-name1)))
1032       (ignore-errors
1033         (delete-file tmp-name1)
1034         (delete-file tmp-name2)))))
1035
1036 (ert-deftest tramp-test23-visited-file-modtime ()
1037   "Check `set-visited-file-modtime' and `verify-visited-file-modtime'."
1038   (skip-unless (tramp--test-enabled))
1039
1040   (let ((tmp-name (tramp--test-make-temp-name)))
1041     (unwind-protect
1042         (progn
1043           (write-region "foo" nil tmp-name)
1044           (should (file-exists-p tmp-name))
1045           (with-temp-buffer
1046             (insert-file-contents tmp-name)
1047             (should (verify-visited-file-modtime))
1048             (set-visited-file-modtime '(0 1))
1049             (should (verify-visited-file-modtime))
1050             (should (equal (visited-file-modtime) '(0 1 0 0)))))
1051       (ignore-errors (delete-file tmp-name)))))
1052
1053 (ert-deftest tramp-test24-file-name-completion ()
1054   "Check `file-name-completion' and `file-name-all-completions'."
1055   (skip-unless (tramp--test-enabled))
1056
1057   (let ((tmp-name (tramp--test-make-temp-name)))
1058     (unwind-protect
1059         (progn
1060           (make-directory tmp-name)
1061           (should (file-directory-p tmp-name))
1062           (write-region "foo" nil (expand-file-name "foo" tmp-name))
1063           (write-region "bar" nil (expand-file-name "bold" tmp-name))
1064           (make-directory (expand-file-name "boz" tmp-name))
1065           (should (equal (file-name-completion "fo" tmp-name) "foo"))
1066           (should (equal (file-name-completion "b" tmp-name) "bo"))
1067           (should
1068            (equal (file-name-completion "b" tmp-name 'file-directory-p) "boz/"))
1069           (should (equal (file-name-all-completions "fo" tmp-name) '("foo")))
1070           (should
1071            (equal (sort (file-name-all-completions "b" tmp-name) 'string-lessp)
1072                   '("bold" "boz/"))))
1073       (ignore-errors (delete-directory tmp-name 'recursive)))))
1074
1075 (ert-deftest tramp-test25-load ()
1076   "Check `load'."
1077   (skip-unless (tramp--test-enabled))
1078
1079   (let ((tmp-name (tramp--test-make-temp-name)))
1080     (unwind-protect
1081         (progn
1082           (load tmp-name 'noerror 'nomessage)
1083           (should-not (featurep 'tramp-test-load))
1084           (write-region "(provide 'tramp-test-load)" nil tmp-name)
1085           ;; `load' in lread.c does not pass `must-suffix'.  Why?
1086           ;(should-error (load tmp-name nil 'nomessage 'nosuffix 'must-suffix))
1087           (load tmp-name nil 'nomessage 'nosuffix)
1088           (should (featurep 'tramp-test-load)))
1089       (ignore-errors
1090         (and (featurep 'tramp-test-load) (unload-feature 'tramp-test-load))
1091         (delete-file tmp-name)))))
1092
1093 (ert-deftest tramp-test26-process-file ()
1094   "Check `process-file'."
1095   (skip-unless (tramp--test-enabled))
1096   (skip-unless
1097    (not
1098     (memq
1099      (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory)
1100      '(tramp-gvfs-file-name-handler tramp-smb-file-name-handler))))
1101
1102   (let ((tmp-name (tramp--test-make-temp-name))
1103         (default-directory tramp-test-temporary-file-directory)
1104         kill-buffer-query-functions)
1105     (unwind-protect
1106         (progn
1107           ;; We cannot use "/bin/true" and "/bin/false"; those paths
1108           ;; do not exist on hydra.
1109           (should (zerop (process-file "true")))
1110           (should-not (zerop (process-file "false")))
1111           (should-not (zerop (process-file "binary-does-not-exist")))
1112           (with-temp-buffer
1113             (write-region "foo" nil tmp-name)
1114             (should (file-exists-p tmp-name))
1115             (should
1116              (zerop
1117               (process-file "ls" nil t nil (file-name-nondirectory tmp-name))))
1118             ;; `ls' could produce colorized output.
1119             (goto-char (point-min))
1120             (while (re-search-forward tramp-color-escape-sequence-regexp nil t)
1121               (replace-match "" nil nil))
1122             (should
1123              (string-equal
1124               (format "%s\n" (file-name-nondirectory tmp-name))
1125               (buffer-string)))))
1126       (ignore-errors (delete-file tmp-name)))))
1127
1128 (ert-deftest tramp-test27-start-file-process ()
1129   "Check `start-file-process'."
1130   (skip-unless (tramp--test-enabled))
1131   (skip-unless
1132    (not
1133     (memq
1134      (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory)
1135      '(tramp-adb-file-name-handler
1136        tramp-gvfs-file-name-handler
1137        tramp-smb-file-name-handler))))
1138
1139   (let ((default-directory tramp-test-temporary-file-directory)
1140         (tmp-name (tramp--test-make-temp-name))
1141         kill-buffer-query-functions proc)
1142     (unwind-protect
1143         (with-temp-buffer
1144           (setq proc (start-file-process "test1" (current-buffer) "cat"))
1145           (should (processp proc))
1146           (should (equal (process-status proc) 'run))
1147           (process-send-string proc "foo")
1148           (process-send-eof proc)
1149           (accept-process-output proc 1)
1150           (should (string-equal (buffer-string) "foo")))
1151       (ignore-errors (delete-process proc)))
1152
1153     (unwind-protect
1154         (with-temp-buffer
1155           (write-region "foo" nil tmp-name)
1156           (should (file-exists-p tmp-name))
1157           (setq proc
1158                 (start-file-process
1159                  "test2" (current-buffer)
1160                  "cat" (file-name-nondirectory tmp-name)))
1161           (should (processp proc))
1162           (accept-process-output proc 1)
1163           (should (string-equal (buffer-string) "foo")))
1164       (ignore-errors
1165         (delete-process proc)
1166         (delete-file tmp-name)))
1167
1168     (unwind-protect
1169         (progn
1170           (setq proc (start-file-process "test3" nil "cat"))
1171           (should (processp proc))
1172           (should (equal (process-status proc) 'run))
1173           (set-process-filter
1174            proc (lambda (_p s) (should (string-equal s "foo"))))
1175           (process-send-string proc "foo")
1176           (process-send-eof proc)
1177           (accept-process-output proc 1))
1178       (ignore-errors (delete-process proc)))))
1179
1180 (ert-deftest tramp-test28-shell-command ()
1181   "Check `shell-command'."
1182   (skip-unless (tramp--test-enabled))
1183   (skip-unless
1184    (not
1185     (memq
1186      (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory)
1187      '(tramp-adb-file-name-handler
1188        tramp-gvfs-file-name-handler
1189        tramp-smb-file-name-handler))))
1190
1191   (let ((tmp-name (tramp--test-make-temp-name))
1192         (default-directory tramp-test-temporary-file-directory)
1193         kill-buffer-query-functions)
1194     (unwind-protect
1195         (with-temp-buffer
1196           (write-region "foo" nil tmp-name)
1197           (should (file-exists-p tmp-name))
1198           (shell-command
1199            (format "ls %s" (file-name-nondirectory tmp-name)) (current-buffer))
1200           ;; `ls' could produce colorized output.
1201           (goto-char (point-min))
1202           (while (re-search-forward tramp-color-escape-sequence-regexp nil t)
1203             (replace-match "" nil nil))
1204           (should
1205            (string-equal
1206             (format "%s\n" (file-name-nondirectory tmp-name)) (buffer-string))))
1207       (ignore-errors (delete-file tmp-name)))
1208
1209     (unwind-protect
1210         (with-temp-buffer
1211           (write-region "foo" nil tmp-name)
1212           (should (file-exists-p tmp-name))
1213           (async-shell-command
1214            (format "ls %s" (file-name-nondirectory tmp-name)) (current-buffer))
1215           (accept-process-output (get-buffer-process (current-buffer)) 1)
1216           (with-timeout (10 (ert-fail "`async-shell-command' timed out"))
1217             (while
1218                 (ignore-errors
1219                   (memq (process-status (get-buffer-process (current-buffer)))
1220                         '(run open)))
1221               (accept-process-output (get-buffer-process (current-buffer)) 1)))
1222           ;; `ls' could produce colorized output.
1223           (goto-char (point-min))
1224           (while (re-search-forward tramp-color-escape-sequence-regexp nil t)
1225             (replace-match "" nil nil))
1226           (should
1227            (string-equal
1228             (format "%s\n" (file-name-nondirectory tmp-name)) (buffer-string))))
1229       (ignore-errors (delete-file tmp-name)))
1230
1231     (unwind-protect
1232         (with-temp-buffer
1233           (write-region "foo" nil tmp-name)
1234           (should (file-exists-p tmp-name))
1235           (async-shell-command "read line; ls $line" (current-buffer))
1236           (process-send-string
1237            (get-buffer-process (current-buffer))
1238            (format "%s\n" (file-name-nondirectory tmp-name)))
1239           (accept-process-output (get-buffer-process (current-buffer)) 1)
1240           (with-timeout (10 (ert-fail "`async-shell-command' timed out"))
1241             (while
1242                 (ignore-errors
1243                   (memq (process-status (get-buffer-process (current-buffer)))
1244                         '(run open)))
1245               (accept-process-output (get-buffer-process (current-buffer)) 1)))
1246           (should
1247            (string-equal
1248             (format "%s\n" (file-name-nondirectory tmp-name)) (buffer-string))))
1249       (ignore-errors (delete-file tmp-name)))))
1250
1251 (ert-deftest tramp-test29-vc-registered ()
1252   "Check `vc-registered'."
1253   (skip-unless (tramp--test-enabled))
1254   (skip-unless
1255    (eq
1256     (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory)
1257     'tramp-sh-file-name-handler))
1258
1259   (let* ((default-directory tramp-test-temporary-file-directory)
1260          (tmp-name1 (tramp--test-make-temp-name))
1261          (tmp-name2 (expand-file-name "foo" tmp-name1))
1262          (vc-handled-backends
1263           (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
1264             (cond
1265              ((tramp-find-executable v vc-bzr-program (tramp-get-remote-path v))
1266               '(Bzr))
1267              ((tramp-find-executable v vc-git-program (tramp-get-remote-path v))
1268               '(Git))
1269              ((tramp-find-executable v vc-hg-program (tramp-get-remote-path v))
1270               '(Hg))
1271              (t nil)))))
1272     (skip-unless vc-handled-backends)
1273     (message "%s" vc-handled-backends)
1274
1275     (unwind-protect
1276         (progn
1277           (make-directory tmp-name1)
1278           (write-region "foo" nil tmp-name2)
1279           (should (file-directory-p tmp-name1))
1280           (should (file-exists-p tmp-name2))
1281           (should-not (vc-registered tmp-name1))
1282           (should-not (vc-registered tmp-name2))
1283
1284           (let ((default-directory tmp-name1))
1285             ;; Create empty repository, and register the file.
1286             (vc-create-repo (car vc-handled-backends))
1287             ;; The structure of VC-FILESET is not documented.  Let's
1288             ;; hope it won't change.
1289             (vc-register
1290              nil (list (car vc-handled-backends)
1291                        (list (file-name-nondirectory tmp-name2)))))
1292           (should (vc-registered tmp-name2)))
1293
1294         (ignore-errors (delete-directory tmp-name1 'recursive)))))
1295
1296 (ert-deftest tramp-test30-utf8 ()
1297   "Check UTF8 encoding in file names and file contents."
1298   (skip-unless (tramp--test-enabled))
1299
1300   (let ((tmp-name (tramp--test-make-temp-name))
1301         (coding-system-for-read 'utf-8)
1302         (coding-system-for-write 'utf-8)
1303         (arabic "أصبح بوسعك الآن تنزيل نسخة كاملة من موسوعة ويكيبيديا العربية لتصفحها بلا اتصال بالإنترنت")
1304         (chinese "银河系漫游指南系列")
1305         (russian "Автостопом по гала́ктике"))
1306     (unwind-protect
1307         (progn
1308           (make-directory tmp-name)
1309           (dolist (lang `(,arabic ,chinese ,russian))
1310             (let ((file (expand-file-name lang tmp-name)))
1311               (write-region lang nil file)
1312               (should (file-exists-p file))
1313               ;; Check file contents.
1314               (with-temp-buffer
1315                 (insert-file-contents file)
1316                 (should (string-equal (buffer-string) lang)))))
1317           ;; Check file names.
1318           (should (equal (directory-files
1319                           tmp-name nil directory-files-no-dot-files-regexp)
1320                          (sort `(,arabic ,chinese ,russian) 'string-lessp))))
1321       (ignore-errors (delete-directory tmp-name 'recursive)))))
1322
1323 ;; TODO:
1324
1325 ;; * dired-compress-file
1326 ;; * dired-uncache
1327 ;; * file-acl
1328 ;; * file-ownership-preserved-p
1329 ;; * file-selinux-context
1330 ;; * find-backup-file-name
1331 ;; * make-auto-save-file-name
1332 ;; * set-file-acl
1333 ;; * set-file-selinux-context
1334
1335 ;; * Fix `tramp-test27-start-file-process' on MS Windows (`process-send-eof'?).
1336 ;; * Fix `tramp-test28-shell-command' on MS Windows (`process-send-eof'?).
1337 ;; * Fix `tramp-test30-utf8' on MS Windows.  Seems to be in `directory-files'.
1338
1339 (defun tramp-test-all (&optional interactive)
1340   "Run all tests for \\[tramp]."
1341   (interactive "p")
1342   (funcall
1343    (if interactive 'ert-run-tests-interactively 'ert-run-tests-batch) "^tramp"))
1344
1345 (provide 'tramp-tests)
1346 ;;; tramp-tests.el ends here