test/lisp/net/tramp-archive-tests.el

   1 ;;; tramp-archive-tests.el --- Tests of file archive access  -*- lexical-binding:t -*-
   2
   3 ;; Copyright (C) 2017-2018 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 `https://www.gnu.org/licenses/'.
  19
  20 ;;; Code:
  21
  22 ;; The `tramp-archive-testnn-*' tests correspond to the respective
  23 ;; tests in tramp-tests.el.
  24
  25 (require 'ert)
  26 (require 'tramp-archive)
  27
  28 (defconst tramp-archive-test-resource-directory
  29   (let ((default-directory
  30           (if load-in-progress
  31               (file-name-directory load-file-name)
  32             default-directory)))
  33     (cond
  34      ((file-accessible-directory-p (expand-file-name "resources"))
  35       (expand-file-name "resources"))
  36      ((file-accessible-directory-p (expand-file-name "tramp-archive-resources"))
  37       (expand-file-name "tramp-archive-resources"))))
  38   "The resources directory test files are located in.")
  39
  40 (defconst tramp-archive-test-file-archive
  41   (file-truename
  42    (expand-file-name "foo.tar.gz" tramp-archive-test-resource-directory))
  43   "The test file archive.")
  44
  45 (defconst tramp-archive-test-archive
  46   (file-name-as-directory tramp-archive-test-file-archive)
  47   "The test archive.")
  48
  49 (defconst tramp-archive-test-directory
  50   (file-truename
  51    (expand-file-name "foo.iso" tramp-archive-test-resource-directory))
  52   "A directory file name, which looks like an archive.")
  53
  54 (setq password-cache-expiry nil
  55       tramp-verbose 0
  56       tramp-cache-read-persistent-data t ;; For auth-sources.
  57       tramp-copy-size-limit nil
  58       tramp-message-show-message nil
  59       tramp-persistency-file-name nil)
  60
  61 (defun tramp-archive--test-make-temp-name ()
  62   "Return a temporary file name for test.
  63 The temporary file is not created."
  64   (expand-file-name
  65    (make-temp-name "tramp-archive-test") temporary-file-directory))
  66
  67 (defun tramp-archive--test-delete (tmpfile)
  68   "Delete temporary file or directory TMPFILE.
  69 This needs special support, because archive file names, which are
  70 the origin of the temporary TMPFILE, have no write permissions."
  71   (unless (file-writable-p (file-name-directory tmpfile))
  72     (set-file-modes
  73      (file-name-directory tmpfile)
  74      (logior (file-modes (file-name-directory tmpfile)) #o0700)))
  75   (set-file-modes tmpfile #o0700)
  76   (if (file-regular-p tmpfile)
  77       (delete-file tmpfile)
  78     (mapc
  79      'tramp-archive--test-delete
  80      (directory-files tmpfile 'full directory-files-no-dot-files-regexp))
  81     (delete-directory tmpfile)))
  82
  83 (defun tramp-archive--test-emacs26-p ()
  84   "Check for Emacs version >= 26.1.
  85 Some semantics has been changed for there, w/o new functions or
  86 variables, so we check the Emacs version directly."
  87   (>= emacs-major-version 26))
  88
  89 (defun tramp-archive--test-emacs27-p ()
  90   "Check for Emacs version >= 27.1.
  91 Some semantics has been changed for there, w/o new functions or
  92 variables, so we check the Emacs version directly."
  93   (>= emacs-major-version 27))
  94
  95 (ert-deftest tramp-archive-test00-availability ()
  96   "Test availability of archive file name functions."
  97   :expected-result (if tramp-archive-enabled :passed :failed)
  98   (should
  99    (and
 100     tramp-archive-enabled
 101     (file-exists-p tramp-archive-test-file-archive)
 102     (tramp-archive-file-name-p tramp-archive-test-archive))))
 103
 104 (ert-deftest tramp-archive-test01-file-name-syntax ()
 105   "Check archive file name syntax."
 106   (should-not (tramp-archive-file-name-p tramp-archive-test-file-archive))
 107   (should (tramp-archive-file-name-p tramp-archive-test-archive))
 108   (should
 109    (string-equal
 110     (tramp-archive-file-name-archive tramp-archive-test-archive)
 111     tramp-archive-test-file-archive))
 112   (should
 113    (string-equal
 114     (tramp-archive-file-name-localname tramp-archive-test-archive) "/"))
 115   (should (tramp-archive-file-name-p (concat tramp-archive-test-archive "foo")))
 116   (should
 117    (string-equal
 118     (tramp-archive-file-name-localname
 119      (concat tramp-archive-test-archive "foo"))
 120     "/foo"))
 121   (should
 122    (tramp-archive-file-name-p (concat tramp-archive-test-archive "foo/bar")))
 123   (should
 124    (string-equal
 125     (tramp-archive-file-name-localname
 126      (concat tramp-archive-test-archive "foo/bar"))
 127     "/foo/bar"))
 128   ;; A file archive inside a file archive.
 129   (should
 130    (tramp-archive-file-name-p (concat tramp-archive-test-archive "baz.tar")))
 131   (should
 132    (string-equal
 133     (tramp-archive-file-name-archive
 134      (concat tramp-archive-test-archive "baz.tar"))
 135     tramp-archive-test-file-archive))
 136   (should
 137    (string-equal
 138     (tramp-archive-file-name-localname
 139      (concat tramp-archive-test-archive "baz.tar"))
 140     "/baz.tar"))
 141   (should
 142    (tramp-archive-file-name-p (concat tramp-archive-test-archive "baz.tar/")))
 143   (should
 144    (string-equal
 145     (tramp-archive-file-name-archive
 146      (concat tramp-archive-test-archive "baz.tar/"))
 147     (concat tramp-archive-test-archive "baz.tar")))
 148   (should
 149    (string-equal
 150     (tramp-archive-file-name-localname
 151      (concat tramp-archive-test-archive "baz.tar/"))
 152     "/")))
 153
 154 (ert-deftest tramp-archive-test02-file-name-dissect ()
 155   "Check archive file name components."
 156   (skip-unless tramp-archive-enabled)
 157
 158   (with-parsed-tramp-archive-file-name tramp-archive-test-archive nil
 159     (should (string-equal method tramp-archive-method))
 160     (should-not user)
 161     (should-not domain)
 162     (should
 163      (string-equal
 164       host
 165       (file-remote-p
 166        (tramp-archive-gvfs-file-name tramp-archive-test-archive) 'host)))
 167     (should
 168      (string-equal
 169       host
 170       (url-hexify-string (concat "file://" tramp-archive-test-file-archive))))
 171     (should-not port)
 172     (should (string-equal localname "/"))
 173     (should (string-equal archive tramp-archive-test-file-archive)))
 174
 175   ;; Localname.
 176   (with-parsed-tramp-archive-file-name
 177       (concat tramp-archive-test-archive "foo") nil
 178     (should (string-equal method tramp-archive-method))
 179     (should-not user)
 180     (should-not domain)
 181     (should
 182      (string-equal
 183       host
 184       (file-remote-p
 185        (tramp-archive-gvfs-file-name tramp-archive-test-archive) 'host)))
 186    (should
 187      (string-equal
 188       host
 189       (url-hexify-string (concat "file://" tramp-archive-test-file-archive))))
 190     (should-not port)
 191     (should (string-equal localname "/foo"))
 192     (should (string-equal archive tramp-archive-test-file-archive)))
 193
 194   ;; File archive in file archive.
 195   (let* ((tramp-archive-test-file-archive
 196           (concat tramp-archive-test-archive "baz.tar"))
 197          (tramp-archive-test-archive
 198           (file-name-as-directory tramp-archive-test-file-archive))
 199          (tramp-methods (cons `(,tramp-archive-method) tramp-methods))
 200          (tramp-gvfs-methods tramp-archive-all-gvfs-methods))
 201     (unwind-protect
 202         (with-parsed-tramp-archive-file-name
 203             (expand-file-name "bar" tramp-archive-test-archive) nil
 204           (should (string-equal method tramp-archive-method))
 205           (should-not user)
 206           (should-not domain)
 207           (should
 208            (string-equal
 209             host
 210             (file-remote-p
 211              (tramp-archive-gvfs-file-name tramp-archive-test-archive) 'host)))
 212           ;; We reimplement the logic of tramp-archive.el here.  Don't
 213           ;; know, whether it is worth the test.
 214           (should
 215            (string-equal
 216             host
 217             (url-hexify-string
 218              (concat
 219               (tramp-gvfs-url-file-name
 220                (tramp-make-tramp-file-name
 221                 tramp-archive-method
 222                 ;; User and Domain.
 223                 nil nil
 224                 ;; Host.
 225                 (url-hexify-string
 226                  (concat
 227                   "file://"
 228                   ;; `directory-file-name' does not leave file archive
 229                   ;; boundaries.  So we must cut the trailing slash
 230                   ;; ourselves.
 231                   (substring
 232                    (file-name-directory tramp-archive-test-file-archive) 0 -1)))
 233                 nil "/"))
 234               (file-name-nondirectory tramp-archive-test-file-archive)))))
 235           (should-not port)
 236           (should (string-equal localname "/bar"))
 237           (should (string-equal archive tramp-archive-test-file-archive)))
 238
 239       ;; Cleanup.
 240       (tramp-archive-cleanup-hash))))
 241
 242 (ert-deftest tramp-archive-test05-expand-file-name ()
 243   "Check `expand-file-name'."
 244   (should
 245    (string-equal
 246     (expand-file-name "/foo.tar/path/./file") "/foo.tar/path/file"))
 247   (should
 248    (string-equal (expand-file-name "/foo.tar/path/../file") "/foo.tar/file"))
 249   ;; `expand-file-name' does not care "~/" in archive file names.
 250   (should
 251    (string-equal (expand-file-name "/foo.tar/~/file") "/foo.tar/~/file"))
 252   ;; `expand-file-name' does not care file archive boundaries.
 253   (should (string-equal (expand-file-name "/foo.tar/./file") "/foo.tar/file"))
 254   (should (string-equal (expand-file-name "/foo.tar/../file") "/file")))
 255
 256 ;; This test is inspired by Bug#30293.
 257 (ert-deftest tramp-archive-test05-expand-file-name-non-archive-directory ()
 258   "Check existing directories with archive file name syntax.
 259 They shall still be supported"
 260   (should (file-directory-p tramp-archive-test-directory))
 261   ;; `tramp-archive-file-name-p' tests only for file name syntax.  It
 262   ;; doesn't test, whether it is really a file archive.
 263   (should
 264    (tramp-archive-file-name-p
 265     (file-name-as-directory tramp-archive-test-directory)))
 266   (should
 267    (file-directory-p (file-name-as-directory tramp-archive-test-directory)))
 268   (should
 269    (file-exists-p (expand-file-name "foo" tramp-archive-test-directory))))
 270
 271 (ert-deftest tramp-archive-test06-directory-file-name ()
 272   "Check `directory-file-name'.
 273 This checks also `file-name-as-directory', `file-name-directory',
 274 `file-name-nondirectory' and `unhandled-file-name-directory'."
 275   (skip-unless tramp-archive-enabled)
 276
 277   (should
 278    (string-equal
 279     (directory-file-name "/foo.tar/path/to/file") "/foo.tar/path/to/file"))
 280   (should
 281    (string-equal
 282     (directory-file-name "/foo.tar/path/to/file/") "/foo.tar/path/to/file"))
 283   ;; `directory-file-name' does not leave file archive boundaries.
 284   (should (string-equal (directory-file-name "/foo.tar/") "/foo.tar/"))
 285
 286   (should
 287    (string-equal
 288     (file-name-as-directory "/foo.tar/path/to/file") "/foo.tar/path/to/file/"))
 289   (should
 290    (string-equal
 291     (file-name-as-directory "/foo.tar/path/to/file/") "/foo.tar/path/to/file/"))
 292   (should (string-equal (file-name-as-directory "/foo.tar/") "/foo.tar/"))
 293   (should (string-equal (file-name-as-directory "/foo.tar") "/foo.tar/"))
 294
 295   (should
 296    (string-equal
 297     (file-name-directory "/foo.tar/path/to/file") "/foo.tar/path/to/"))
 298   (should
 299    (string-equal
 300     (file-name-directory "/foo.tar/path/to/file/") "/foo.tar/path/to/file/"))
 301   (should (string-equal (file-name-directory "/foo.tar/") "/foo.tar/"))
 302
 303   (should
 304    (string-equal (file-name-nondirectory "/foo.tar/path/to/file") "file"))
 305   (should
 306    (string-equal (file-name-nondirectory "/foo.tar/path/to/file/") ""))
 307   (should (string-equal (file-name-nondirectory "/foo.tar/") ""))
 308
 309   (should-not
 310    (unhandled-file-name-directory "/foo.tar/path/to/file")))
 311
 312 (ert-deftest tramp-archive-test07-file-exists-p ()
 313   "Check `file-exist-p', `write-region' and `delete-file'."
 314   (skip-unless tramp-archive-enabled)
 315
 316   (unwind-protect
 317       (let ((default-directory tramp-archive-test-archive))
 318         (should (file-exists-p tramp-archive-test-file-archive))
 319         (should (file-exists-p tramp-archive-test-archive))
 320         (should (file-exists-p "foo.txt"))
 321         (should (file-exists-p "foo.lnk"))
 322         (should (file-exists-p "bar"))
 323         (should (file-exists-p "bar/bar"))
 324         (should-error
 325          (write-region "foo" nil "baz")
 326          :type 'file-error)
 327         (should-error
 328          (delete-file "baz")
 329          :type 'file-error))
 330
 331     ;; Cleanup.
 332     (tramp-archive-cleanup-hash)))
 333
 334 (ert-deftest tramp-archive-test08-file-local-copy ()
 335   "Check `file-local-copy'."
 336   (skip-unless tramp-archive-enabled)
 337
 338   (let (tmp-name)
 339     (unwind-protect
 340         (progn
 341           (should
 342            (setq tmp-name
 343                  (file-local-copy
 344                   (expand-file-name "bar/bar" tramp-archive-test-archive))))
 345           (with-temp-buffer
 346             (insert-file-contents tmp-name)
 347             (should (string-equal (buffer-string) "bar\n")))
 348             ;; Error case.
 349             (tramp-archive--test-delete tmp-name)
 350             (should-error
 351              (setq tmp-name
 352                    (file-local-copy
 353                     (expand-file-name "what" tramp-archive-test-archive)))
 354              :type tramp-file-missing))
 355
 356       ;; Cleanup.
 357       (ignore-errors (tramp-archive--test-delete tmp-name))
 358       (tramp-archive-cleanup-hash))))
 359
 360 (ert-deftest tramp-archive-test09-insert-file-contents ()
 361   "Check `insert-file-contents'."
 362   (skip-unless tramp-archive-enabled)
 363
 364   (let ((tmp-name (expand-file-name "bar/bar" tramp-archive-test-archive)))
 365     (unwind-protect
 366         (with-temp-buffer
 367           (insert-file-contents tmp-name)
 368           (should (string-equal (buffer-string) "bar\n"))
 369           (insert-file-contents tmp-name)
 370           (should (string-equal (buffer-string) "bar\nbar\n"))
 371           ;; Insert partly.
 372           (insert-file-contents tmp-name nil 1 3)
 373           (should (string-equal (buffer-string) "arbar\nbar\n"))
 374           ;; Replace.
 375           (insert-file-contents tmp-name nil nil nil 'replace)
 376           (should (string-equal (buffer-string) "bar\n"))
 377           ;; Error case.
 378           (should-error
 379            (insert-file-contents
 380             (expand-file-name "what" tramp-archive-test-archive))
 381            :type tramp-file-missing))
 382
 383         ;; Cleanup.
 384         (tramp-archive-cleanup-hash))))
 385
 386 (ert-deftest tramp-archive-test11-copy-file ()
 387   "Check `copy-file'."
 388   (skip-unless tramp-archive-enabled)
 389
 390   ;; Copy simple file.
 391   (let ((tmp-name1 (expand-file-name "bar/bar" tramp-archive-test-archive))
 392         (tmp-name2 (tramp-archive--test-make-temp-name)))
 393     (unwind-protect
 394         (progn
 395           (copy-file tmp-name1 tmp-name2)
 396           (should (file-exists-p tmp-name2))
 397           (with-temp-buffer
 398             (insert-file-contents tmp-name2)
 399             (should (string-equal (buffer-string) "bar\n")))
 400           (should-error
 401            (copy-file tmp-name1 tmp-name2)
 402            :type 'file-already-exists)
 403           (copy-file tmp-name1 tmp-name2 'ok)
 404           ;; The file archive is not writable.
 405           (should-error
 406            (copy-file tmp-name2 tmp-name1 'ok)
 407            :type 'file-error))
 408
 409       ;; Cleanup.
 410       (ignore-errors (tramp-archive--test-delete tmp-name2))
 411       (tramp-archive-cleanup-hash)))
 412
 413   ;; Copy directory to existing directory.
 414   (let ((tmp-name1 (expand-file-name "bar" tramp-archive-test-archive))
 415         (tmp-name2 (tramp-archive--test-make-temp-name)))
 416     (unwind-protect
 417         (progn
 418           (make-directory tmp-name2)
 419           (should (file-directory-p tmp-name2))
 420           ;; Directory `tmp-name2' exists already, so we must use
 421           ;; `file-name-as-directory'.
 422           (copy-file tmp-name1 (file-name-as-directory tmp-name2))
 423           (should
 424            (file-exists-p
 425             (expand-file-name
 426              (concat (file-name-nondirectory tmp-name1) "/bar") tmp-name2))))
 427
 428       ;; Cleanup.
 429       (ignore-errors (tramp-archive--test-delete tmp-name2))
 430       (tramp-archive-cleanup-hash)))
 431
 432   ;; Copy directory/file to non-existing directory.
 433   (let ((tmp-name1 (expand-file-name "bar" tramp-archive-test-archive))
 434         (tmp-name2 (tramp-archive--test-make-temp-name)))
 435     (unwind-protect
 436         (progn
 437           (make-directory tmp-name2)
 438           (should (file-directory-p tmp-name2))
 439           (copy-file
 440            tmp-name1
 441            (expand-file-name (file-name-nondirectory tmp-name1) tmp-name2))
 442           (should
 443            (file-exists-p
 444             (expand-file-name
 445              (concat (file-name-nondirectory tmp-name1) "/bar") tmp-name2))))
 446
 447       ;; Cleanup.
 448       (ignore-errors (tramp-archive--test-delete tmp-name2))
 449       (tramp-archive-cleanup-hash))))
 450
 451 (ert-deftest tramp-archive-test15-copy-directory ()
 452   "Check `copy-directory'."
 453   (skip-unless tramp-archive-enabled)
 454
 455   (let* ((tmp-name1 (expand-file-name "bar" tramp-archive-test-archive))
 456          (tmp-name2 (tramp-archive--test-make-temp-name))
 457          (tmp-name3 (expand-file-name
 458                      (file-name-nondirectory tmp-name1) tmp-name2))
 459          (tmp-name4 (expand-file-name "bar" tmp-name2))
 460          (tmp-name5 (expand-file-name "bar" tmp-name3)))
 461
 462     ;; Copy complete directory.
 463     (unwind-protect
 464         (progn
 465           ;; Copy empty directory.
 466           (copy-directory tmp-name1 tmp-name2)
 467           (should (file-directory-p tmp-name2))
 468           (should (file-exists-p tmp-name4))
 469           ;; Target directory does exist already.
 470           ;; This has been changed in Emacs 26.1.
 471           (when (tramp-archive--test-emacs26-p)
 472             (should-error
 473              (copy-directory tmp-name1 tmp-name2)
 474              :type 'file-error))
 475           (tramp-archive--test-delete tmp-name4)
 476           (copy-directory tmp-name1 (file-name-as-directory tmp-name2))
 477           (should (file-directory-p tmp-name3))
 478           (should (file-exists-p tmp-name5)))
 479
 480       ;; Cleanup.
 481       (ignore-errors (tramp-archive--test-delete tmp-name2))
 482       (tramp-archive-cleanup-hash))
 483
 484     ;; Copy directory contents.
 485     (unwind-protect
 486         (progn
 487           ;; Copy empty directory.
 488           (copy-directory tmp-name1 tmp-name2 nil 'parents 'contents)
 489           (should (file-directory-p tmp-name2))
 490           (should (file-exists-p tmp-name4))
 491           ;; Target directory does exist already.
 492           (tramp-archive--test-delete tmp-name4)
 493           (copy-directory
 494            tmp-name1 (file-name-as-directory tmp-name2)
 495            nil 'parents 'contents)
 496           (should (file-directory-p tmp-name2))
 497           (should (file-exists-p tmp-name4))
 498           (should-not (file-directory-p tmp-name3))
 499           (should-not (file-exists-p tmp-name5)))
 500
 501       ;; Cleanup.
 502       (ignore-errors (tramp-archive--test-delete tmp-name2))
 503       (tramp-archive-cleanup-hash))))
 504
 505 (ert-deftest tramp-archive-test16-directory-files ()
 506   "Check `directory-files'."
 507   (skip-unless tramp-archive-enabled)
 508
 509   (let ((tmp-name tramp-archive-test-archive)
 510         (files '("." ".." "bar"  "baz.tar" "foo.hrd" "foo.lnk" "foo.txt")))
 511     (unwind-protect
 512         (progn
 513           (should (file-directory-p tmp-name))
 514           (should (equal (directory-files tmp-name) files))
 515           (should (equal (directory-files tmp-name 'full)
 516                          (mapcar (lambda (x) (concat tmp-name x)) files)))
 517           (should (equal (directory-files
 518                           tmp-name nil directory-files-no-dot-files-regexp)
 519                          (delete "." (delete ".." files))))
 520           (should (equal (directory-files
 521                           tmp-name 'full directory-files-no-dot-files-regexp)
 522                          (mapcar (lambda (x) (concat tmp-name x))
 523                                  (delete "." (delete ".." files))))))
 524
 525       ;; Cleanup.
 526       (tramp-archive-cleanup-hash))))
 527
 528 (ert-deftest tramp-archive-test17-insert-directory ()
 529   "Check `insert-directory'."
 530   (skip-unless tramp-archive-enabled)
 531
 532   (let (;; We test for the summary line.  Keyword "total" could be localized.
 533         (process-environment
 534          (append '("LANG=C" "LANGUAGE=C" "LC_ALL=C") process-environment)))
 535     (unwind-protect
 536         (progn
 537           ;; Due to Bug#29423, this works only since for Emacs 26.1.
 538           (when nil ;; TODO (tramp-archive--test-emacs26-p)
 539             (with-temp-buffer
 540               (insert-directory tramp-archive-test-archive nil)
 541               (goto-char (point-min))
 542               (should
 543                (looking-at-p (regexp-quote tramp-archive-test-archive)))))
 544           (with-temp-buffer
 545             (insert-directory tramp-archive-test-archive "-al")
 546             (goto-char (point-min))
 547             (should
 548              (looking-at-p
 549               (format "^.+ %s$" (regexp-quote tramp-archive-test-archive)))))
 550           (with-temp-buffer
 551             (insert-directory
 552              (file-name-as-directory tramp-archive-test-archive)
 553              "-al" nil 'full-directory-p)
 554             (goto-char (point-min))
 555             (should
 556              (looking-at-p
 557               (concat
 558                ;; There might be a summary line.
 559                "\\(total.+[[:digit:]]+\n\\)?"
 560                ;; We don't know in which order the files appear.
 561                (format
 562                 "\\(.+ %s\\( ->.+\\)?\n\\)\\{%d\\}"
 563                 (regexp-opt (directory-files tramp-archive-test-archive))
 564                 (length (directory-files tramp-archive-test-archive))))))))
 565
 566       ;; Cleanup.
 567       (tramp-archive-cleanup-hash))))
 568
 569 (ert-deftest tramp-archive-test18-file-attributes ()
 570   "Check `file-attributes'.
 571 This tests also `file-readable-p' and `file-regular-p'."
 572   (skip-unless tramp-archive-enabled)
 573
 574   (let ((tmp-name1 (expand-file-name "foo.txt" tramp-archive-test-archive))
 575         (tmp-name2 (expand-file-name "foo.lnk" tramp-archive-test-archive))
 576         (tmp-name3 (expand-file-name "bar" tramp-archive-test-archive))
 577         attr)
 578     (unwind-protect
 579         (progn
 580           (should (file-exists-p tmp-name1))
 581           (should (file-readable-p tmp-name1))
 582           (should (file-regular-p tmp-name1))
 583
 584           ;; We do not test inodes and device numbers.
 585           (setq attr (file-attributes tmp-name1))
 586           (should (consp attr))
 587           (should (null (car attr)))
 588           (should (numberp (nth 1 attr))) ;; Link.
 589           (should (numberp (nth 2 attr))) ;; Uid.
 590           (should (numberp (nth 3 attr))) ;; Gid.
 591           ;; Last access time.
 592           (should (stringp (current-time-string (nth 4 attr))))
 593           ;; Last modification time.
 594           (should (stringp (current-time-string (nth 5 attr))))
 595           ;; Last status change time.
 596           (should (stringp (current-time-string (nth 6 attr))))
 597           (should (numberp (nth 7 attr))) ;; Size.
 598           (should (stringp (nth 8 attr))) ;; Modes.
 599
 600           (setq attr (file-attributes tmp-name1 'string))
 601           (should (stringp (nth 2 attr))) ;; Uid.
 602           (should (stringp (nth 3 attr))) ;; Gid.
 603
 604           ;; Symlink.
 605           (should (file-exists-p tmp-name2))
 606           (should (file-symlink-p tmp-name2))
 607           (setq attr (file-attributes tmp-name2))
 608           (should (string-equal (car attr) (file-name-nondirectory tmp-name1)))
 609
 610           ;; Directory.
 611           (should (file-exists-p tmp-name3))
 612           (should (file-readable-p tmp-name3))
 613           (should-not (file-regular-p tmp-name3))
 614           (setq attr (file-attributes tmp-name3))
 615           (should (eq (car attr) t)))
 616
 617       ;; Cleanup.
 618       (tramp-archive-cleanup-hash))))
 619
 620 (ert-deftest tramp-archive-test19-directory-files-and-attributes ()
 621   "Check `directory-files-and-attributes'."
 622   (skip-unless tramp-archive-enabled)
 623
 624   (let ((tmp-name (expand-file-name "bar" tramp-archive-test-archive))
 625         attr)
 626     (unwind-protect
 627         (progn
 628           (should (file-directory-p tmp-name))
 629           (setq attr (directory-files-and-attributes tmp-name))
 630           (should (consp attr))
 631           (dolist (elt attr)
 632             (should
 633              (equal (file-attributes (expand-file-name (car elt) tmp-name))
 634                     (cdr elt))))
 635           (setq attr (directory-files-and-attributes tmp-name 'full))
 636           (dolist (elt attr)
 637             (should (equal (file-attributes (car elt)) (cdr elt))))
 638           (setq attr (directory-files-and-attributes tmp-name nil "^b"))
 639           (should (equal (mapcar 'car attr) '("bar"))))
 640
 641       ;; Cleanup.
 642       (tramp-archive-cleanup-hash))))
 643
 644 (ert-deftest tramp-archive-test20-file-modes ()
 645   "Check `file-modes'.
 646 This tests also `file-executable-p', `file-writable-p' and `set-file-modes'."
 647   (skip-unless tramp-archive-enabled)
 648
 649   (let ((tmp-name1 (expand-file-name "foo.txt" tramp-archive-test-archive))
 650         (tmp-name2 (expand-file-name "bar" tramp-archive-test-archive)))
 651     (unwind-protect
 652         (progn
 653           (should (file-exists-p tmp-name1))
 654           ;; `set-file-modes' is not implemented.
 655           (should-error
 656            (set-file-modes tmp-name1 #o777)
 657            :type 'file-error)
 658           (should (= (file-modes tmp-name1) #o400))
 659           (should-not (file-executable-p tmp-name1))
 660           (should-not (file-writable-p tmp-name1))
 661
 662           (should (file-exists-p tmp-name2))
 663           ;; `set-file-modes' is not implemented.
 664           (should-error
 665            (set-file-modes tmp-name2 #o777)
 666            :type 'file-error)
 667           (should (= (file-modes tmp-name2) #o500))
 668           (should (file-executable-p tmp-name2))
 669           (should-not (file-writable-p tmp-name2)))
 670
 671       ;; Cleanup.
 672       (tramp-archive-cleanup-hash))))
 673
 674 (ert-deftest tramp-archive-test21-file-links ()
 675   "Check `file-symlink-p' and `file-truename'"
 676   (skip-unless tramp-archive-enabled)
 677
 678   ;; We must use `file-truename' for the file archive, because it
 679   ;; could be located on a symlinked directory.  This would let the
 680   ;; test fail.
 681   (let* ((tramp-archive-test-archive (file-truename tramp-archive-test-archive))
 682          (tmp-name1 (expand-file-name "foo.txt" tramp-archive-test-archive))
 683          (tmp-name2 (expand-file-name "foo.lnk" tramp-archive-test-archive)))
 684
 685     (unwind-protect
 686         (progn
 687           (should (file-exists-p tmp-name1))
 688           (should (string-equal tmp-name1 (file-truename tmp-name1)))
 689           ;; `make-symbolic-link' is not implemented.
 690           (should-error
 691            (make-symbolic-link tmp-name1 tmp-name2)
 692            :type 'file-error)
 693           (should (file-symlink-p tmp-name2))
 694           (should
 695            (string-equal
 696             ;; This is "/foo.txt".
 697             (with-parsed-tramp-archive-file-name tmp-name1 nil localname)
 698             ;; `file-symlink-p' returns "foo.txt".  Wer must expand, therefore.
 699             (with-parsed-tramp-archive-file-name
 700                 (expand-file-name
 701                  (file-symlink-p tmp-name2) tramp-archive-test-archive)
 702                 nil
 703               localname)))
 704           (should-not (string-equal tmp-name2 (file-truename tmp-name2)))
 705           (should
 706            (string-equal (file-truename tmp-name1) (file-truename tmp-name2)))
 707           (should (file-equal-p tmp-name1 tmp-name2)))
 708
 709       ;; Cleanup.
 710       (tramp-archive-cleanup-hash))))
 711
 712 (ert-deftest tramp-archive-test26-file-name-completion ()
 713   "Check `file-name-completion' and `file-name-all-completions'."
 714   (skip-unless tramp-archive-enabled)
 715
 716   (let ((tmp-name tramp-archive-test-archive))
 717     (unwind-protect
 718         (progn
 719           ;; Local files.
 720           (should (equal (file-name-completion "fo" tmp-name) "foo."))
 721           (should (equal (file-name-completion "foo.txt" tmp-name) t))
 722           (should (equal (file-name-completion "b" tmp-name) "ba"))
 723           (should-not (file-name-completion "a" tmp-name))
 724           (should
 725            (equal
 726             (file-name-completion "b" tmp-name 'file-directory-p) "bar/"))
 727           (should
 728            (equal
 729             (sort (file-name-all-completions "fo" tmp-name) 'string-lessp)
 730             '("foo.hrd" "foo.lnk" "foo.txt")))
 731           (should
 732            (equal
 733             (sort (file-name-all-completions "b" tmp-name) 'string-lessp)
 734             '("bar/" "baz.tar")))
 735           (should-not (file-name-all-completions "a" tmp-name))
 736           ;; `completion-regexp-list' restricts the completion to
 737           ;; files which match all expressions in this list.
 738           (let ((completion-regexp-list
 739                  `(,directory-files-no-dot-files-regexp "b")))
 740             (should
 741              (equal (file-name-completion "" tmp-name) "ba"))
 742             (should
 743              (equal
 744               (sort (file-name-all-completions "" tmp-name) 'string-lessp)
 745               '("bar/" "baz.tar")))))
 746
 747       ;; Cleanup.
 748       (tramp-archive-cleanup-hash))))
 749
 750 ;; The functions were introduced in Emacs 26.1.
 751 (ert-deftest tramp-archive-test37-make-nearby-temp-file ()
 752   "Check `make-nearby-temp-file' and `temporary-file-directory'."
 753   (skip-unless tramp-archive-enabled)
 754   ;; Since Emacs 26.1.
 755   (skip-unless
 756    (and (fboundp 'make-nearby-temp-file) (fboundp 'temporary-file-directory)))
 757
 758   ;; `make-nearby-temp-file' and `temporary-file-directory' exists
 759   ;; since Emacs 26.1.  We don't want to see compiler warnings for
 760   ;; older Emacsen.
 761   (let ((default-directory tramp-archive-test-archive)
 762         tmp-file)
 763     ;; The file archive shall know a temporary file directory.  It is
 764     ;; not in the archive itself.
 765     (should
 766      (stringp (with-no-warnings (with-no-warnings (temporary-file-directory)))))
 767     (should-not
 768      (tramp-archive-file-name-p (with-no-warnings (temporary-file-directory))))
 769
 770     ;; A temporary file or directory shall not be located in the
 771     ;; archive itself.
 772     (setq tmp-file
 773           (with-no-warnings (make-nearby-temp-file "tramp-archive-test")))
 774     (should (file-exists-p tmp-file))
 775     (should (file-regular-p tmp-file))
 776     (should-not (tramp-archive-file-name-p tmp-file))
 777     (delete-file tmp-file)
 778     (should-not (file-exists-p tmp-file))
 779
 780     (setq tmp-file
 781           (with-no-warnings (make-nearby-temp-file "tramp-archive-test" 'dir)))
 782     (should (file-exists-p tmp-file))
 783     (should (file-directory-p tmp-file))
 784     (should-not (tramp-archive-file-name-p tmp-file))
 785     (delete-directory tmp-file)
 786     (should-not (file-exists-p tmp-file))))
 787
 788 (ert-deftest tramp-archive-test40-file-system-info ()
 789   "Check that `file-system-info' returns proper values."
 790   (skip-unless tramp-archive-enabled)
 791   ;; Since Emacs 27.1.
 792   (skip-unless (fboundp 'file-system-info))
 793
 794   ;; `file-system-info' exists since Emacs 27.  We don't want to see
 795   ;; compiler warnings for older Emacsen.
 796   (let ((fsi (with-no-warnings (file-system-info tramp-archive-test-archive))))
 797     (skip-unless fsi)
 798     (should (and (consp fsi)
 799                  (= (length fsi) 3)
 800                  (numberp (nth 0 fsi))
 801                  ;; FREE and AVAIL are always 0.
 802                  (zerop (nth 1 fsi))
 803                  (zerop (nth 2 fsi))))))
 804
 805 (ert-deftest tramp-archive-test42-auto-load ()
 806   "Check that `tramp-archive' autoloads properly."
 807   (skip-unless tramp-archive-enabled)
 808   ;; Autoloading tramp-archive works since Emacs 27.1.
 809   (skip-unless (tramp-archive--test-emacs27-p))
 810
 811   ;; tramp-archive is neither loaded at Emacs startup, nor when
 812   ;; loading a file like "/mock::foo" (which loads Tramp).
 813   (let ((default-directory (expand-file-name temporary-file-directory))
 814         (code
 815          "(progn \
 816             (message \"tramp-archive loaded: %%s %%s\" \
 817               (featurep 'tramp) (featurep 'tramp-archive)) \
 818             (file-attributes %S \"/\") \
 819             (message \"tramp-archive loaded: %%s %%s\" \
 820               (featurep 'tramp) (featurep 'tramp-archive)))"))
 821     (dolist (file `("/mock::foo" ,(concat tramp-archive-test-archive "foo")))
 822       (should
 823        (string-match
 824         (format
 825          "tramp-archive loaded: nil nil[[:ascii:]]+tramp-archive loaded: t %s"
 826          (tramp-archive-file-name-p file))
 827         (shell-command-to-string
 828          (format
 829           "%s -batch -Q -L %s --eval %s"
 830           (shell-quote-argument
 831            (expand-file-name invocation-name invocation-directory))
 832           (mapconcat 'shell-quote-argument load-path " -L ")
 833           (shell-quote-argument (format code file)))))))))
 834
 835 (ert-deftest tramp-archive-test42-delay-load ()
 836   "Check that `tramp-archive' is loaded lazily, only when needed."
 837   (skip-unless tramp-archive-enabled)
 838   ;; Autoloading tramp-archive works since Emacs 27.1.
 839   (skip-unless (tramp-archive--test-emacs27-p))
 840
 841   ;; tramp-archive is neither loaded at Emacs startup, nor when
 842   ;; loading a file like "/foo.tar".  It is loaded only when
 843   ;; `tramp-archive-enabled' is t.
 844   (let ((default-directory (expand-file-name temporary-file-directory))
 845         (code
 846          "(progn \
 847             (setq tramp-archive-enabled %s) \
 848             (message \"tramp-archive loaded: %%s\" \
 849               (featurep 'tramp-archive)) \
 850             (file-attributes %S \"/\") \
 851             (message \"tramp-archive loaded: %%s\" \
 852               (featurep 'tramp-archive)) \
 853             (file-attributes %S \"/\") \
 854             (message \"tramp-archive loaded: %%s\" \
 855               (featurep 'tramp-archive)))"))
 856     ;; tramp-archive doesn't load when `tramp-archive-enabled' is nil.
 857     (dolist (tae '(t nil))
 858       (should
 859        (string-match
 860         (format
 861          "tramp-archive loaded: nil[[:ascii:]]+tramp-archive loaded: nil[[:ascii:]]+tramp-archive loaded: %s"
 862          tae)
 863         (shell-command-to-string
 864          (format
 865           "%s -batch -Q -L %s --eval %s"
 866           (shell-quote-argument
 867            (expand-file-name invocation-name invocation-directory))
 868           (mapconcat 'shell-quote-argument load-path " -L ")
 869           (shell-quote-argument
 870            (format
 871             code tae tramp-archive-test-file-archive
 872             (concat tramp-archive-test-archive "foo"))))))))))
 873
 874 (ert-deftest tramp-archive-test99-libarchive-tests ()
 875   "Run tests of libarchive test files."
 876   :tags '(:expensive-test)
 877   (skip-unless tramp-archive-enabled)
 878   ;; We do not want to run unless chosen explicitly.  This test makes
 879   ;; sense only in my local environment.  Michael Albinus.
 880   (skip-unless
 881    (equal
 882     (ert--stats-selector ert--current-run-stats)
 883     (ert-test-name (ert-running-test))))
 884
 885   (url-handler-mode)
 886   (unwind-protect
 887       (dolist (dir
 888                '("~/Downloads" "/sftp::~/Downloads" "/ssh::~/Downloads"
 889                  "http://ftp.debian.org/debian/pool/main/c/coreutils"))
 890         (dolist
 891             (file
 892              '("coreutils_8.26-3_amd64.deb"
 893                "coreutils_8.26-3ubuntu3_amd64.deb"))
 894           (setq file (expand-file-name file dir))
 895           (when (file-exists-p file)
 896             (setq file (expand-file-name "control.tar.gz/control" file))
 897             (message "%s" file)
 898             (should (file-attributes (file-name-as-directory file))))))
 899
 900     ;; Cleanup.
 901     (tramp-archive-cleanup-hash))
 902
 903   (unwind-protect
 904       (dolist (dir '("" "/sftp::" "/ssh::"))
 905         (dolist
 906             (file
 907              (apply
 908               'append
 909               (mapcar
 910                (lambda (x) (directory-files (concat dir x) 'full "uu\\'" 'sort))
 911                '("~/src/libarchive-3.2.2/libarchive/test"
 912                  "~/src/libarchive-3.2.2/cpio/test"
 913                  "~/src/libarchive-3.2.2/tar/test"))))
 914           (setq file (file-name-as-directory file))
 915           (cond
 916            ((not (tramp-archive-file-name-p file))
 917             (message "skipped: %s" file))
 918            ((file-attributes file)
 919             (message "%s" file))
 920            (t (message "failed: %s" file)))
 921           (tramp-archive-cleanup-hash)))
 922
 923     ;; Cleanup.
 924     (tramp-archive-cleanup-hash)))
 925
 926 (defun tramp-archive-test-all (&optional interactive)
 927   "Run all tests for \\[tramp-archive]."
 928   (interactive "p")
 929   (funcall
 930    (if interactive 'ert-run-tests-interactively 'ert-run-tests-batch)
 931    "^tramp-archive"))
 932
 933 (provide 'tramp-archive-tests)
 934 ;;; tramp-archive-tests.el ends here