[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[elpa] elpa 006644a: Remove tramp-archive tests
|
From: |
Michael Albinus |
|
Subject: |
[elpa] elpa 006644a: Remove tramp-archive tests |
|
Date: |
Sat, 25 May 2019 05:34:45 -0400 (EDT) |
branch: elpa
commit 006644a6dbaa818e523c69c6e445506005a1dd92
Author: Michael Albinus <address@hidden>
Commit: Michael Albinus <address@hidden>
Remove tramp-archive tests
---
test/Makefile | 3 +-
test/README | 16 +-
test/resources/bar/bar | 1 -
test/resources/baz.tar | Bin 10240 -> 0 bytes
test/resources/foo.hrd | 1 -
test/resources/foo.iso/foo | 1 -
test/resources/foo.lnk | 1 -
test/resources/foo.tar.gz | Bin 274 -> 0 bytes
test/resources/foo.txt | 1 -
test/tramp-archive-tests.el | 965 --------------------------------------------
test/tramp-time.el | 164 --------
11 files changed, 4 insertions(+), 1149 deletions(-)
diff --git a/test/Makefile b/test/Makefile
index c373cdd..0f5441e 100644
--- a/test/Makefile
+++ b/test/Makefile
@@ -23,8 +23,7 @@
EMACS = emacs -Q -batch -L ../
CLEAN_FILES = .\\\#* \\\#* .*~ *~ *.elc *.log
-TESTS = $(if ${REMOTE_TEMPORARY_FILE_DIRECTORY},, tramp-archive-tests)
-TESTS += tramp-tests
+TESTS = tramp-tests
TRAMP_TEST_ARGS ?=
SELECTOR ?= t
diff --git a/test/README b/test/README
index d88ef2e..aa1e16a 100644
--- a/test/README
+++ b/test/README
@@ -1,10 +1,5 @@
This directory contains files for running Tramp related tests.
-tramp-archive-tests.el
- This file is a test suite for file archives. It uses test
- data from directory "resources". Interactively, you can run
- the test suite by "M-x tramp-archive-test-all".
-
tramp-tests.el
This file is a test suite. Interactively, you can run the
test suite by "M-x tramp-test-all". The environment variable
@@ -12,20 +7,15 @@ tramp-tests.el
the tests on another remote host, see
`tramp-test-temporary-file-directory' for the default value.
-tramp-time.el
- These are performance tests on Tramp. Read the "Commentary"
- section for details. These tests are not covered by the Makefile.
-
The Makefile in this directory supports the following targets:
* make all or make check
- Run all tests declared in tramp-archive-tests.el and tramp-tests.el.
- If $REMOTE_TEMPORARY_FILE_DIRECTORY is set, only tramp-tests.el is
+ Run all tests declared in tramp-tests.el. If
+ $REMOTE_TEMPORARY_FILE_DIRECTORY is set, only tramp-tests.el is
used.
* make <filename>
- Run all tests declared in <filename>.el. <filename> can be either
- tramp-archive-tests or tramp-tests.
+ Run all tests declared in <filename>.el. <filename> is tramp-tests.
ERT offers selectors, which make it possible to filter out which test
cases shall run. The make variable $(SELECTOR) gives you a simple
diff --git a/test/resources/bar/bar b/test/resources/bar/bar
deleted file mode 100644
index 5716ca5..0000000
--- a/test/resources/bar/bar
+++ /dev/null
@@ -1 +0,0 @@
-bar
diff --git a/test/resources/baz.tar b/test/resources/baz.tar
deleted file mode 100644
index a1227fa..0000000
Binary files a/test/resources/baz.tar and /dev/null differ
diff --git a/test/resources/foo.hrd b/test/resources/foo.hrd
deleted file mode 100644
index 257cc56..0000000
--- a/test/resources/foo.hrd
+++ /dev/null
@@ -1 +0,0 @@
-foo
diff --git a/test/resources/foo.iso/foo b/test/resources/foo.iso/foo
deleted file mode 100644
index 257cc56..0000000
--- a/test/resources/foo.iso/foo
+++ /dev/null
@@ -1 +0,0 @@
-foo
diff --git a/test/resources/foo.lnk b/test/resources/foo.lnk
deleted file mode 120000
index 996f178..0000000
--- a/test/resources/foo.lnk
+++ /dev/null
@@ -1 +0,0 @@
-foo.txt
\ No newline at end of file
diff --git a/test/resources/foo.tar.gz b/test/resources/foo.tar.gz
deleted file mode 100644
index 0d2e987..0000000
Binary files a/test/resources/foo.tar.gz and /dev/null differ
diff --git a/test/resources/foo.txt b/test/resources/foo.txt
deleted file mode 100644
index 257cc56..0000000
--- a/test/resources/foo.txt
+++ /dev/null
@@ -1 +0,0 @@
-foo
diff --git a/test/tramp-archive-tests.el b/test/tramp-archive-tests.el
deleted file mode 100644
index 454279e..0000000
--- a/test/tramp-archive-tests.el
+++ /dev/null
@@ -1,965 +0,0 @@
-;;; tramp-archive-tests.el --- Tests of file archive access -*-
lexical-binding:t -*-
-
-;; Copyright (C) 2017-2019 Free Software Foundation, Inc.
-
-;; Author: Michael Albinus <address@hidden>
-
-;; This program is free software: you can redistribute it and/or
-;; modify it under the terms of the GNU General Public License as
-;; published by the Free Software Foundation, either version 3 of the
-;; License, or (at your option) any later version.
-;;
-;; This program is distributed in the hope that it will be useful, but
-;; WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-;; General Public License for more details.
-;;
-;; You should have received a copy of the GNU General Public License
-;; along with this program. If not, see `https://www.gnu.org/licenses/'.
-
-;;; Code:
-
-;; The `tramp-archive-testnn-*' tests correspond to the respective
-;; tests in tramp-tests.el.
-
-(require 'ert)
-(require 'tramp-archive)
-(defvar tramp-copy-size-limit)
-(defvar tramp-persistency-file-name)
-
-(defconst tramp-archive-test-resource-directory
- (let ((default-directory
- (if load-in-progress
- (file-name-directory load-file-name)
- default-directory)))
- (cond
- ((file-accessible-directory-p (expand-file-name "resources"))
- (expand-file-name "resources"))
- ((file-accessible-directory-p (expand-file-name
"tramp-archive-resources"))
- (expand-file-name "tramp-archive-resources"))))
- "The resources directory test files are located in.")
-
-(defconst tramp-archive-test-file-archive
- (file-truename
- (expand-file-name "foo.tar.gz" tramp-archive-test-resource-directory))
- "The test file archive.")
-
-(defconst tramp-archive-test-archive
- (file-name-as-directory tramp-archive-test-file-archive)
- "The test archive.")
-
-(defconst tramp-archive-test-directory
- (file-truename
- (expand-file-name "foo.iso" tramp-archive-test-resource-directory))
- "A directory file name, which looks like an archive.")
-
-(setq password-cache-expiry nil
- tramp-verbose 0
- tramp-cache-read-persistent-data t ;; For auth-sources.
- tramp-copy-size-limit nil
- tramp-message-show-message nil
- tramp-persistency-file-name nil)
-
-(defun tramp-archive--test-make-temp-name ()
- "Return a temporary file name for test.
-The temporary file is not created."
- (expand-file-name
- (make-temp-name "tramp-archive-test") temporary-file-directory))
-
-(defun tramp-archive--test-delete (tmpfile)
- "Delete temporary file or directory TMPFILE.
-This needs special support, because archive file names, which are
-the origin of the temporary TMPFILE, have no write permissions."
- (unless (file-writable-p (file-name-directory tmpfile))
- (set-file-modes
- (file-name-directory tmpfile)
- (logior (file-modes (file-name-directory tmpfile)) #o0700)))
- (set-file-modes tmpfile #o0700)
- (if (file-regular-p tmpfile)
- (delete-file tmpfile)
- (mapc
- #'tramp-archive--test-delete
- (directory-files tmpfile 'full directory-files-no-dot-files-regexp))
- (delete-directory tmpfile)))
-
-(defun tramp-archive--test-emacs26-p ()
- "Check for Emacs version >= 26.1.
-Some semantics has been changed for there, w/o new functions or
-variables, so we check the Emacs version directly."
- (>= emacs-major-version 26))
-
-(defun tramp-archive--test-emacs27-p ()
- "Check for Emacs version >= 27.1.
-Some semantics has been changed for there, w/o new functions or
-variables, so we check the Emacs version directly."
- (>= emacs-major-version 27))
-
-(ert-deftest tramp-archive-test00-availability ()
- "Test availability of archive file name functions."
- :expected-result (if tramp-archive-enabled :passed :failed)
- (should
- (and
- tramp-archive-enabled
- (file-exists-p tramp-archive-test-file-archive)
- (tramp-archive-file-name-p tramp-archive-test-archive))))
-
-(ert-deftest tramp-archive-test01-file-name-syntax ()
- "Check archive file name syntax."
- (should-not (tramp-archive-file-name-p tramp-archive-test-file-archive))
- (should (tramp-archive-file-name-p tramp-archive-test-archive))
- (should
- (string-equal
- (tramp-archive-file-name-archive tramp-archive-test-archive)
- tramp-archive-test-file-archive))
- (should
- (string-equal
- (tramp-archive-file-name-localname tramp-archive-test-archive) "/"))
- (should (tramp-archive-file-name-p (concat tramp-archive-test-archive
"foo")))
- (should
- (string-equal
- (tramp-archive-file-name-localname
- (concat tramp-archive-test-archive "foo"))
- "/foo"))
- (should
- (tramp-archive-file-name-p (concat tramp-archive-test-archive "foo/bar")))
- (should
- (string-equal
- (tramp-archive-file-name-localname
- (concat tramp-archive-test-archive "foo/bar"))
- "/foo/bar"))
- ;; A file archive inside a file archive.
- (should
- (tramp-archive-file-name-p (concat tramp-archive-test-archive "baz.tar")))
- (should
- (string-equal
- (tramp-archive-file-name-archive
- (concat tramp-archive-test-archive "baz.tar"))
- tramp-archive-test-file-archive))
- (should
- (string-equal
- (tramp-archive-file-name-localname
- (concat tramp-archive-test-archive "baz.tar"))
- "/baz.tar"))
- (should
- (tramp-archive-file-name-p (concat tramp-archive-test-archive "baz.tar/")))
- (should
- (string-equal
- (tramp-archive-file-name-archive
- (concat tramp-archive-test-archive "baz.tar/"))
- (concat tramp-archive-test-archive "baz.tar")))
- (should
- (string-equal
- (tramp-archive-file-name-localname
- (concat tramp-archive-test-archive "baz.tar/"))
- "/")))
-
-(ert-deftest tramp-archive-test02-file-name-dissect ()
- "Check archive file name components."
- (skip-unless tramp-archive-enabled)
-
- (with-parsed-tramp-archive-file-name tramp-archive-test-archive nil
- (should (string-equal method tramp-archive-method))
- (should-not user)
- (should-not domain)
- (should
- (string-equal
- host
- (file-remote-p
- (tramp-archive-gvfs-file-name tramp-archive-test-archive) 'host)))
- (should
- (string-equal
- host
- (url-hexify-string (concat "file://" tramp-archive-test-file-archive))))
- (should-not port)
- (should (string-equal localname "/"))
- (should (string-equal archive tramp-archive-test-file-archive)))
-
- ;; Localname.
- (with-parsed-tramp-archive-file-name
- (concat tramp-archive-test-archive "foo") nil
- (should (string-equal method tramp-archive-method))
- (should-not user)
- (should-not domain)
- (should
- (string-equal
- host
- (file-remote-p
- (tramp-archive-gvfs-file-name tramp-archive-test-archive) 'host)))
- (should
- (string-equal
- host
- (url-hexify-string (concat "file://" tramp-archive-test-file-archive))))
- (should-not port)
- (should (string-equal localname "/foo"))
- (should (string-equal archive tramp-archive-test-file-archive)))
-
- ;; File archive in file archive.
- (let* ((tramp-archive-test-file-archive
- (concat tramp-archive-test-archive "baz.tar"))
- (tramp-archive-test-archive
- (file-name-as-directory tramp-archive-test-file-archive))
- (tramp-methods (cons `(,tramp-archive-method) tramp-methods))
- (tramp-gvfs-methods tramp-archive-all-gvfs-methods))
- (unwind-protect
- (with-parsed-tramp-archive-file-name
- (expand-file-name "bar" tramp-archive-test-archive) nil
- (should (string-equal method tramp-archive-method))
- (should-not user)
- (should-not domain)
- (should
- (string-equal
- host
- (file-remote-p
- (tramp-archive-gvfs-file-name tramp-archive-test-archive) 'host)))
- ;; We reimplement the logic of tramp-archive.el here. Don't
- ;; know, whether it is worth the test.
- (should
- (string-equal
- host
- (url-hexify-string
- (concat
- (tramp-gvfs-url-file-name
- (tramp-make-tramp-file-name
- tramp-archive-method
- ;; User and Domain.
- nil nil
- ;; Host.
- (url-hexify-string
- (concat
- "file://"
- ;; `directory-file-name' does not leave file archive
- ;; boundaries. So we must cut the trailing slash
- ;; ourselves.
- (substring
- (file-name-directory tramp-archive-test-file-archive) 0 -1)))
- nil "/"))
- (file-name-nondirectory tramp-archive-test-file-archive)))))
- (should-not port)
- (should (string-equal localname "/bar"))
- (should (string-equal archive tramp-archive-test-file-archive)))
-
- ;; Cleanup.
- (tramp-archive-cleanup-hash))))
-
-(ert-deftest tramp-archive-test05-expand-file-name ()
- "Check `expand-file-name'."
- (should
- (string-equal
- (expand-file-name "/foo.tar/path/./file") "/foo.tar/path/file"))
- (should
- (string-equal (expand-file-name "/foo.tar/path/../file") "/foo.tar/file"))
- ;; `expand-file-name' does not care "~/" in archive file names.
- (should
- (string-equal (expand-file-name "/foo.tar/~/file") "/foo.tar/~/file"))
- ;; `expand-file-name' does not care file archive boundaries.
- (should (string-equal (expand-file-name "/foo.tar/./file") "/foo.tar/file"))
- (should (string-equal (expand-file-name "/foo.tar/../file") "/file")))
-
-;; This test is inspired by Bug#30293.
-(ert-deftest tramp-archive-test05-expand-file-name-non-archive-directory ()
- "Check existing directories with archive file name syntax.
-They shall still be supported"
- (should (file-directory-p tramp-archive-test-directory))
- ;; `tramp-archive-file-name-p' tests only for file name syntax. It
- ;; doesn't test, whether it is really a file archive.
- (should
- (tramp-archive-file-name-p
- (file-name-as-directory tramp-archive-test-directory)))
- (should
- (file-directory-p (file-name-as-directory tramp-archive-test-directory)))
- (should
- (file-exists-p (expand-file-name "foo" tramp-archive-test-directory))))
-
-(ert-deftest tramp-archive-test06-directory-file-name ()
- "Check `directory-file-name'.
-This checks also `file-name-as-directory', `file-name-directory',
-`file-name-nondirectory' and `unhandled-file-name-directory'."
- (skip-unless tramp-archive-enabled)
-
- (should
- (string-equal
- (directory-file-name "/foo.tar/path/to/file") "/foo.tar/path/to/file"))
- (should
- (string-equal
- (directory-file-name "/foo.tar/path/to/file/") "/foo.tar/path/to/file"))
- ;; `directory-file-name' does not leave file archive boundaries.
- (should (string-equal (directory-file-name "/foo.tar/") "/foo.tar/"))
-
- (should
- (string-equal
- (file-name-as-directory "/foo.tar/path/to/file") "/foo.tar/path/to/file/"))
- (should
- (string-equal
- (file-name-as-directory "/foo.tar/path/to/file/")
"/foo.tar/path/to/file/"))
- (should (string-equal (file-name-as-directory "/foo.tar/") "/foo.tar/"))
- (should (string-equal (file-name-as-directory "/foo.tar") "/foo.tar/"))
-
- (should
- (string-equal
- (file-name-directory "/foo.tar/path/to/file") "/foo.tar/path/to/"))
- (should
- (string-equal
- (file-name-directory "/foo.tar/path/to/file/") "/foo.tar/path/to/file/"))
- (should (string-equal (file-name-directory "/foo.tar/") "/foo.tar/"))
-
- (should
- (string-equal (file-name-nondirectory "/foo.tar/path/to/file") "file"))
- (should
- (string-equal (file-name-nondirectory "/foo.tar/path/to/file/") ""))
- (should (string-equal (file-name-nondirectory "/foo.tar/") ""))
-
- (should-not
- (unhandled-file-name-directory "/foo.tar/path/to/file")))
-
-(ert-deftest tramp-archive-test07-file-exists-p ()
- "Check `file-exist-p', `write-region' and `delete-file'."
- :tags '(:expensive-test)
- (skip-unless tramp-archive-enabled)
-
- (unwind-protect
- (let ((default-directory tramp-archive-test-archive))
- (should (file-exists-p tramp-archive-test-file-archive))
- (should (file-exists-p tramp-archive-test-archive))
- (should (file-exists-p "foo.txt"))
- (should (file-exists-p "foo.lnk"))
- (should (file-exists-p "bar"))
- (should (file-exists-p "bar/bar"))
- (should-error
- (write-region "foo" nil "baz")
- :type 'file-error)
- (should-error
- (delete-file "baz")
- :type 'file-error))
-
- ;; Cleanup.
- (tramp-archive-cleanup-hash)))
-
-(ert-deftest tramp-archive-test08-file-local-copy ()
- "Check `file-local-copy'."
- :tags '(:expensive-test)
- (skip-unless tramp-archive-enabled)
-
- (let (tmp-name)
- (unwind-protect
- (progn
- (should
- (setq tmp-name
- (file-local-copy
- (expand-file-name "bar/bar" tramp-archive-test-archive))))
- (with-temp-buffer
- (insert-file-contents tmp-name)
- (should (string-equal (buffer-string) "bar\n")))
- ;; Error case.
- (tramp-archive--test-delete tmp-name)
- (should-error
- (setq tmp-name
- (file-local-copy
- (expand-file-name "what" tramp-archive-test-archive)))
- :type tramp-file-missing))
-
- ;; Cleanup.
- (ignore-errors (tramp-archive--test-delete tmp-name))
- (tramp-archive-cleanup-hash))))
-
-(ert-deftest tramp-archive-test09-insert-file-contents ()
- "Check `insert-file-contents'."
- :tags '(:expensive-test)
- (skip-unless tramp-archive-enabled)
-
- (let ((tmp-name (expand-file-name "bar/bar" tramp-archive-test-archive)))
- (unwind-protect
- (with-temp-buffer
- (insert-file-contents tmp-name)
- (should (string-equal (buffer-string) "bar\n"))
- (insert-file-contents tmp-name)
- (should (string-equal (buffer-string) "bar\nbar\n"))
- ;; Insert partly.
- (insert-file-contents tmp-name nil 1 3)
- (should (string-equal (buffer-string) "arbar\nbar\n"))
- ;; Replace.
- (insert-file-contents tmp-name nil nil nil 'replace)
- (should (string-equal (buffer-string) "bar\n"))
- ;; Error case.
- (should-error
- (insert-file-contents
- (expand-file-name "what" tramp-archive-test-archive))
- :type tramp-file-missing))
-
- ;; Cleanup.
- (tramp-archive-cleanup-hash))))
-
-(ert-deftest tramp-archive-test11-copy-file ()
- "Check `copy-file'."
- :tags '(:expensive-test)
- (skip-unless tramp-archive-enabled)
-
- ;; Copy simple file.
- (let ((tmp-name1 (expand-file-name "bar/bar" tramp-archive-test-archive))
- (tmp-name2 (tramp-archive--test-make-temp-name)))
- (unwind-protect
- (progn
- (copy-file tmp-name1 tmp-name2)
- (should (file-exists-p tmp-name2))
- (with-temp-buffer
- (insert-file-contents tmp-name2)
- (should (string-equal (buffer-string) "bar\n")))
- (should-error
- (copy-file tmp-name1 tmp-name2)
- :type 'file-already-exists)
- (copy-file tmp-name1 tmp-name2 'ok)
- ;; The file archive is not writable.
- (should-error
- (copy-file tmp-name2 tmp-name1 'ok)
- :type 'file-error))
-
- ;; Cleanup.
- (ignore-errors (tramp-archive--test-delete tmp-name2))
- (tramp-archive-cleanup-hash)))
-
- ;; Copy directory to existing directory.
- (let ((tmp-name1 (expand-file-name "bar" tramp-archive-test-archive))
- (tmp-name2 (tramp-archive--test-make-temp-name)))
- (unwind-protect
- (progn
- (make-directory tmp-name2)
- (should (file-directory-p tmp-name2))
- ;; Directory `tmp-name2' exists already, so we must use
- ;; `file-name-as-directory'.
- (copy-file tmp-name1 (file-name-as-directory tmp-name2))
- (should
- (file-exists-p
- (expand-file-name
- (concat (file-name-nondirectory tmp-name1) "/bar") tmp-name2))))
-
- ;; Cleanup.
- (ignore-errors (tramp-archive--test-delete tmp-name2))
- (tramp-archive-cleanup-hash)))
-
- ;; Copy directory/file to non-existing directory.
- (let ((tmp-name1 (expand-file-name "bar" tramp-archive-test-archive))
- (tmp-name2 (tramp-archive--test-make-temp-name)))
- (unwind-protect
- (progn
- (make-directory tmp-name2)
- (should (file-directory-p tmp-name2))
- (copy-file
- tmp-name1
- (expand-file-name (file-name-nondirectory tmp-name1) tmp-name2))
- (should
- (file-exists-p
- (expand-file-name
- (concat (file-name-nondirectory tmp-name1) "/bar") tmp-name2))))
-
- ;; Cleanup.
- (ignore-errors (tramp-archive--test-delete tmp-name2))
- (tramp-archive-cleanup-hash))))
-
-(ert-deftest tramp-archive-test15-copy-directory ()
- "Check `copy-directory'."
- :tags '(:expensive-test)
- (skip-unless tramp-archive-enabled)
-
- (let* ((tmp-name1 (expand-file-name "bar" tramp-archive-test-archive))
- (tmp-name2 (tramp-archive--test-make-temp-name))
- (tmp-name3 (expand-file-name
- (file-name-nondirectory tmp-name1) tmp-name2))
- (tmp-name4 (expand-file-name "bar" tmp-name2))
- (tmp-name5 (expand-file-name "bar" tmp-name3)))
-
- ;; Copy complete directory.
- (unwind-protect
- (progn
- ;; Copy empty directory.
- (copy-directory tmp-name1 tmp-name2)
- (should (file-directory-p tmp-name2))
- (should (file-exists-p tmp-name4))
- ;; Target directory does exist already.
- ;; This has been changed in Emacs 26.1.
- (when (tramp-archive--test-emacs26-p)
- (should-error
- (copy-directory tmp-name1 tmp-name2)
- :type 'file-error))
- (tramp-archive--test-delete tmp-name4)
- (copy-directory tmp-name1 (file-name-as-directory tmp-name2))
- (should (file-directory-p tmp-name3))
- (should (file-exists-p tmp-name5)))
-
- ;; Cleanup.
- (ignore-errors (tramp-archive--test-delete tmp-name2))
- (tramp-archive-cleanup-hash))
-
- ;; Copy directory contents.
- (unwind-protect
- (progn
- ;; Copy empty directory.
- (copy-directory tmp-name1 tmp-name2 nil 'parents 'contents)
- (should (file-directory-p tmp-name2))
- (should (file-exists-p tmp-name4))
- ;; Target directory does exist already.
- (tramp-archive--test-delete tmp-name4)
- (copy-directory
- tmp-name1 (file-name-as-directory tmp-name2)
- nil 'parents 'contents)
- (should (file-directory-p tmp-name2))
- (should (file-exists-p tmp-name4))
- (should-not (file-directory-p tmp-name3))
- (should-not (file-exists-p tmp-name5)))
-
- ;; Cleanup.
- (ignore-errors (tramp-archive--test-delete tmp-name2))
- (tramp-archive-cleanup-hash))))
-
-(ert-deftest tramp-archive-test16-directory-files ()
- "Check `directory-files'."
- :tags '(:expensive-test)
- (skip-unless tramp-archive-enabled)
-
- (let ((tmp-name tramp-archive-test-archive)
- (files '("." ".." "bar" "baz.tar" "foo.hrd" "foo.lnk" "foo.txt")))
- (unwind-protect
- (progn
- (should (file-directory-p tmp-name))
- (should (equal (directory-files tmp-name) files))
- (should (equal (directory-files tmp-name 'full)
- (mapcar (lambda (x) (concat tmp-name x)) files)))
- (should (equal (directory-files
- tmp-name nil directory-files-no-dot-files-regexp)
- (delete "." (delete ".." files))))
- (should (equal (directory-files
- tmp-name 'full directory-files-no-dot-files-regexp)
- (mapcar (lambda (x) (concat tmp-name x))
- (delete "." (delete ".." files))))))
-
- ;; Cleanup.
- (tramp-archive-cleanup-hash))))
-
-(ert-deftest tramp-archive-test17-insert-directory ()
- "Check `insert-directory'."
- :tags '(:expensive-test)
- (skip-unless tramp-archive-enabled)
-
- (let (;; We test for the summary line. Keyword "total" could be localized.
- (process-environment
- (append '("LANG=C" "LANGUAGE=C" "LC_ALL=C") process-environment)))
- (unwind-protect
- (progn
- ;; Due to Bug#29423, this works only since for Emacs 26.1.
- (when nil ;; TODO (tramp-archive--test-emacs26-p)
- (with-temp-buffer
- (insert-directory tramp-archive-test-archive nil)
- (goto-char (point-min))
- (should
- (looking-at-p (regexp-quote tramp-archive-test-archive)))))
- (with-temp-buffer
- (insert-directory tramp-archive-test-archive "-al")
- (goto-char (point-min))
- (should
- (looking-at-p
- (format "^.+ %s$" (regexp-quote tramp-archive-test-archive)))))
- (with-temp-buffer
- (insert-directory
- (file-name-as-directory tramp-archive-test-archive)
- "-al" nil 'full-directory-p)
- (goto-char (point-min))
- (should
- (looking-at-p
- (concat
- ;; There might be a summary line.
- "\\(total.+[[:digit:]]+\n\\)?"
- ;; We don't know in which order the files appear.
- (format
- "\\(.+ %s\\( ->.+\\)?\n\\)\\{%d\\}"
- (regexp-opt (directory-files tramp-archive-test-archive))
- (length (directory-files tramp-archive-test-archive)))))))
-
- ;; Check error case.
- (with-temp-buffer
- (should-error
- (insert-directory
- (expand-file-name "baz" tramp-archive-test-archive) nil)
- :type tramp-file-missing)))
-
- ;; Cleanup.
- (tramp-archive-cleanup-hash))))
-
-(ert-deftest tramp-archive-test18-file-attributes ()
- "Check `file-attributes'.
-This tests also `access-file', `file-readable-p' and `file-regular-p'."
- :tags '(:expensive-test)
- (skip-unless tramp-archive-enabled)
-
- (let ((tmp-name1 (expand-file-name "foo.txt" tramp-archive-test-archive))
- (tmp-name2 (expand-file-name "foo.lnk" tramp-archive-test-archive))
- (tmp-name3 (expand-file-name "bar" tramp-archive-test-archive))
- (tmp-name4 (expand-file-name "baz" tramp-archive-test-archive))
- attr)
- (unwind-protect
- (progn
- (should (file-exists-p tmp-name1))
- (should (file-readable-p tmp-name1))
- (should (file-regular-p tmp-name1))
- (should-not (access-file tmp-name1 "error"))
-
- ;; We do not test inodes and device numbers.
- (setq attr (file-attributes tmp-name1))
- (should (consp attr))
- (should (null (car attr)))
- (should (numberp (nth 1 attr))) ;; Link.
- (should (numberp (nth 2 attr))) ;; Uid.
- (should (numberp (nth 3 attr))) ;; Gid.
- ;; Last access time.
- (should (stringp (current-time-string (nth 4 attr))))
- ;; Last modification time.
- (should (stringp (current-time-string (nth 5 attr))))
- ;; Last status change time.
- (should (stringp (current-time-string (nth 6 attr))))
- (should (numberp (nth 7 attr))) ;; Size.
- (should (stringp (nth 8 attr))) ;; Modes.
-
- (setq attr (file-attributes tmp-name1 'string))
- (should (stringp (nth 2 attr))) ;; Uid.
- (should (stringp (nth 3 attr))) ;; Gid.
-
- ;; Symlink.
- (should (file-exists-p tmp-name2))
- (should (file-symlink-p tmp-name2))
- (setq attr (file-attributes tmp-name2))
- (should (string-equal (car attr) (file-name-nondirectory tmp-name1)))
-
- ;; Directory.
- (should (file-exists-p tmp-name3))
- (should (file-readable-p tmp-name3))
- (should-not (file-regular-p tmp-name3))
- (setq attr (file-attributes tmp-name3))
- (should (eq (car attr) t))
- (should-not (access-file tmp-name3 "error"))
-
- ;; Check error case.
- (should-error
- (access-file tmp-name4 "error")
- :type tramp-file-missing))
-
- ;; Cleanup.
- (tramp-archive-cleanup-hash))))
-
-(ert-deftest tramp-archive-test19-directory-files-and-attributes ()
- "Check `directory-files-and-attributes'."
- :tags '(:expensive-test)
- (skip-unless tramp-archive-enabled)
-
- (let ((tmp-name (expand-file-name "bar" tramp-archive-test-archive))
- attr)
- (unwind-protect
- (progn
- (should (file-directory-p tmp-name))
- (setq attr (directory-files-and-attributes tmp-name))
- (should (consp attr))
- (dolist (elt attr)
- (should
- (equal (file-attributes (expand-file-name (car elt) tmp-name))
- (cdr elt))))
- (setq attr (directory-files-and-attributes tmp-name 'full))
- (dolist (elt attr)
- (should (equal (file-attributes (car elt)) (cdr elt))))
- (setq attr (directory-files-and-attributes tmp-name nil "^b"))
- (should (equal (mapcar #'car attr) '("bar"))))
-
- ;; Cleanup.
- (tramp-archive-cleanup-hash))))
-
-(ert-deftest tramp-archive-test20-file-modes ()
- "Check `file-modes'.
-This tests also `file-executable-p', `file-writable-p' and `set-file-modes'."
- :tags '(:expensive-test)
- (skip-unless tramp-archive-enabled)
-
- (let ((tmp-name1 (expand-file-name "foo.txt" tramp-archive-test-archive))
- (tmp-name2 (expand-file-name "bar" tramp-archive-test-archive)))
- (unwind-protect
- (progn
- (should (file-exists-p tmp-name1))
- ;; `set-file-modes' is not implemented.
- (should-error
- (set-file-modes tmp-name1 #o777)
- :type 'file-error)
- (should (= (file-modes tmp-name1) #o400))
- (should-not (file-executable-p tmp-name1))
- (should-not (file-writable-p tmp-name1))
-
- (should (file-exists-p tmp-name2))
- ;; `set-file-modes' is not implemented.
- (should-error
- (set-file-modes tmp-name2 #o777)
- :type 'file-error)
- (should (= (file-modes tmp-name2) #o500))
- (should (file-executable-p tmp-name2))
- (should-not (file-writable-p tmp-name2)))
-
- ;; Cleanup.
- (tramp-archive-cleanup-hash))))
-
-(ert-deftest tramp-archive-test21-file-links ()
- "Check `file-symlink-p' and `file-truename'"
- :tags '(:expensive-test)
- (skip-unless tramp-archive-enabled)
-
- ;; We must use `file-truename' for the file archive, because it
- ;; could be located on a symlinked directory. This would let the
- ;; test fail.
- (let* ((tramp-archive-test-archive (file-truename
tramp-archive-test-archive))
- (tmp-name1 (expand-file-name "foo.txt" tramp-archive-test-archive))
- (tmp-name2 (expand-file-name "foo.lnk" tramp-archive-test-archive)))
-
- (unwind-protect
- (progn
- (should (file-exists-p tmp-name1))
- (should (string-equal tmp-name1 (file-truename tmp-name1)))
- ;; `make-symbolic-link' is not implemented.
- (should-error
- (make-symbolic-link tmp-name1 tmp-name2)
- :type 'file-error)
- (should (file-symlink-p tmp-name2))
- (should
- (string-equal
- ;; This is "/foo.txt".
- (with-parsed-tramp-archive-file-name tmp-name1 nil localname)
- ;; `file-symlink-p' returns "foo.txt". Wer must expand, therefore.
- (with-parsed-tramp-archive-file-name
- (expand-file-name
- (file-symlink-p tmp-name2) tramp-archive-test-archive)
- nil
- localname)))
- (should-not (string-equal tmp-name2 (file-truename tmp-name2)))
- (should
- (string-equal (file-truename tmp-name1) (file-truename tmp-name2)))
- (should (file-equal-p tmp-name1 tmp-name2)))
-
- ;; Cleanup.
- (tramp-archive-cleanup-hash))))
-
-(ert-deftest tramp-archive-test26-file-name-completion ()
- "Check `file-name-completion' and `file-name-all-completions'."
- :tags '(:expensive-test)
- (skip-unless tramp-archive-enabled)
-
- (let ((tmp-name tramp-archive-test-archive))
- (unwind-protect
- (progn
- ;; Local files.
- (should (equal (file-name-completion "fo" tmp-name) "foo."))
- (should (equal (file-name-completion "foo.txt" tmp-name) t))
- (should (equal (file-name-completion "b" tmp-name) "ba"))
- (should-not (file-name-completion "a" tmp-name))
- (should
- (equal
- (file-name-completion "b" tmp-name #'file-directory-p) "bar/"))
- (should
- (equal
- (sort (file-name-all-completions "fo" tmp-name) #'string-lessp)
- '("foo.hrd" "foo.lnk" "foo.txt")))
- (should
- (equal
- (sort (file-name-all-completions "b" tmp-name) #'string-lessp)
- '("bar/" "baz.tar")))
- (should-not (file-name-all-completions "a" tmp-name))
- ;; `completion-regexp-list' restricts the completion to
- ;; files which match all expressions in this list.
- (let ((completion-regexp-list
- `(,directory-files-no-dot-files-regexp "b")))
- (should
- (equal (file-name-completion "" tmp-name) "ba"))
- (should
- (equal
- (sort (file-name-all-completions "" tmp-name) #'string-lessp)
- '("bar/" "baz.tar")))))
-
- ;; Cleanup.
- (tramp-archive-cleanup-hash))))
-
-;; The functions were introduced in Emacs 26.1.
-(ert-deftest tramp-archive-test39-make-nearby-temp-file ()
- "Check `make-nearby-temp-file' and `temporary-file-directory'."
- (skip-unless tramp-archive-enabled)
- ;; Since Emacs 26.1.
- (skip-unless
- (and (fboundp 'make-nearby-temp-file) (fboundp 'temporary-file-directory)))
-
- ;; `make-nearby-temp-file' and `temporary-file-directory' exists
- ;; since Emacs 26.1. We don't want to see compiler warnings for
- ;; older Emacsen.
- (let ((default-directory tramp-archive-test-archive)
- tmp-file)
- ;; The file archive shall know a temporary file directory. It is
- ;; not in the archive itself.
- (should
- (stringp (with-no-warnings (with-no-warnings
(temporary-file-directory)))))
- (should-not
- (tramp-archive-file-name-p (with-no-warnings (temporary-file-directory))))
-
- ;; A temporary file or directory shall not be located in the
- ;; archive itself.
- (setq tmp-file
- (with-no-warnings (make-nearby-temp-file "tramp-archive-test")))
- (should (file-exists-p tmp-file))
- (should (file-regular-p tmp-file))
- (should-not (tramp-archive-file-name-p tmp-file))
- (delete-file tmp-file)
- (should-not (file-exists-p tmp-file))
-
- (setq tmp-file
- (with-no-warnings (make-nearby-temp-file "tramp-archive-test" 'dir)))
- (should (file-exists-p tmp-file))
- (should (file-directory-p tmp-file))
- (should-not (tramp-archive-file-name-p tmp-file))
- (delete-directory tmp-file)
- (should-not (file-exists-p tmp-file))))
-
-(ert-deftest tramp-archive-test42-file-system-info ()
- "Check that `file-system-info' returns proper values."
- (skip-unless tramp-archive-enabled)
- ;; Since Emacs 27.1.
- (skip-unless (fboundp 'file-system-info))
-
- ;; `file-system-info' exists since Emacs 27. We don't want to see
- ;; compiler warnings for older Emacsen.
- (let ((fsi (with-no-warnings (file-system-info tramp-archive-test-archive))))
- (skip-unless fsi)
- (should (and (consp fsi)
- (= (length fsi) 3)
- (numberp (nth 0 fsi))
- ;; FREE and AVAIL are always 0.
- (zerop (nth 1 fsi))
- (zerop (nth 2 fsi))))))
-
-(ert-deftest tramp-archive-test45-auto-load ()
- "Check that `tramp-archive' autoloads properly."
- :tags '(:expensive-test)
- (skip-unless tramp-archive-enabled)
- ;; Autoloading tramp-archive works since Emacs 27.1.
- (skip-unless (tramp-archive--test-emacs27-p))
-
- ;; tramp-archive is neither loaded at Emacs startup, nor when
- ;; loading a file like "/mock::foo" (which loads Tramp).
- (let ((default-directory (expand-file-name temporary-file-directory))
- (code
- "(progn \
- (message \"tramp-archive loaded: %%s %%s\" \
- (featurep 'tramp) (featurep 'tramp-archive)) \
- (file-attributes %S \"/\") \
- (message \"tramp-archive loaded: %%s %%s\" \
- (featurep 'tramp) (featurep 'tramp-archive)))"))
- (dolist (file `("/mock::foo" ,(concat tramp-archive-test-archive "foo")))
- (should
- (string-match
- (format
- "tramp-archive loaded: nil nil[[:ascii:]]+tramp-archive loaded: t %s"
- (tramp-archive-file-name-p file))
- (shell-command-to-string
- (format
- "%s -batch -Q -L %s --eval %s"
- (shell-quote-argument
- (expand-file-name invocation-name invocation-directory))
- (mapconcat #'shell-quote-argument load-path " -L ")
- (shell-quote-argument (format code file)))))))))
-
-(ert-deftest tramp-archive-test45-delay-load ()
- "Check that `tramp-archive' is loaded lazily, only when needed."
- :tags '(:expensive-test)
- (skip-unless tramp-archive-enabled)
- ;; Autoloading tramp-archive works since Emacs 27.1.
- (skip-unless (tramp-archive--test-emacs27-p))
-
- ;; tramp-archive is neither loaded at Emacs startup, nor when
- ;; loading a file like "/foo.tar". It is loaded only when
- ;; `tramp-archive-enabled' is t.
- (let ((default-directory (expand-file-name temporary-file-directory))
- (code
- "(progn \
- (setq tramp-archive-enabled %s) \
- (message \"tramp-archive loaded: %%s\" \
- (featurep 'tramp-archive)) \
- (file-attributes %S \"/\") \
- (message \"tramp-archive loaded: %%s\" \
- (featurep 'tramp-archive)) \
- (file-attributes %S \"/\") \
- (message \"tramp-archive loaded: %%s\" \
- (featurep 'tramp-archive)))"))
- ;; tramp-archive doesn't load when `tramp-archive-enabled' is nil.
- (dolist (tae '(t nil))
- (should
- (string-match
- (format
- "tramp-archive loaded: nil[[:ascii:]]+tramp-archive loaded:
nil[[:ascii:]]+tramp-archive loaded: %s"
- tae)
- (shell-command-to-string
- (format
- "%s -batch -Q -L %s --eval %s"
- (shell-quote-argument
- (expand-file-name invocation-name invocation-directory))
- (mapconcat #'shell-quote-argument load-path " -L ")
- (shell-quote-argument
- (format
- code tae tramp-archive-test-file-archive
- (concat tramp-archive-test-archive "foo"))))))))))
-
-(ert-deftest tramp-archive-test99-libarchive-tests ()
- "Run tests of libarchive test files."
- :tags '(:expensive-test :unstable)
- (skip-unless tramp-archive-enabled)
- ;; We do not want to run unless chosen explicitly. This test makes
- ;; sense only in my local environment. Michael Albinus.
- (skip-unless
- (equal
- (ert--stats-selector ert--current-run-stats)
- (ert-test-name (ert-running-test))))
-
- (url-handler-mode)
- (unwind-protect
- (dolist (dir
- '("~/Downloads" "/sftp::~/Downloads" "/ssh::~/Downloads"
- "http://ftp.debian.org/debian/pool/main/c/coreutils";))
- (dolist
- (file
- '("coreutils_8.26-3_amd64.deb"
- "coreutils_8.26-3ubuntu3_amd64.deb"))
- (setq file (expand-file-name file dir))
- (when (file-exists-p file)
- (setq file (expand-file-name "control.tar.gz/control" file))
- (message "%s" file)
- (should (file-attributes (file-name-as-directory file))))))
-
- ;; Cleanup.
- (tramp-archive-cleanup-hash))
-
- (unwind-protect
- (dolist (dir '("" "/sftp::" "/ssh::"))
- (dolist
- (file
- (apply
- 'append
- (mapcar
- (lambda (x) (directory-files (concat dir x) 'full "uu\\'" 'sort))
- '("~/src/libarchive-3.2.2/libarchive/test"
- "~/src/libarchive-3.2.2/cpio/test"
- "~/src/libarchive-3.2.2/tar/test"))))
- (setq file (file-name-as-directory file))
- (cond
- ((not (tramp-archive-file-name-p file))
- (message "skipped: %s" file))
- ((file-attributes file)
- (message "%s" file))
- (t (message "failed: %s" file)))
- (tramp-archive-cleanup-hash)))
-
- ;; Cleanup.
- (tramp-archive-cleanup-hash)))
-
-(defun tramp-archive-test-all (&optional interactive)
- "Run all tests for \\[tramp-archive]."
- (interactive "p")
- (funcall
- (if interactive #'ert-run-tests-interactively #'ert-run-tests-batch)
- "^tramp-archive"))
-
-(provide 'tramp-archive-tests)
-;;; tramp-archive-tests.el ends here
diff --git a/test/tramp-time.el b/test/tramp-time.el
deleted file mode 100644
index 46795b2..0000000
--- a/test/tramp-time.el
+++ /dev/null
@@ -1,164 +0,0 @@
-;;; tramp-time.el --- Performance tests for Tramp
-
-;; Copyright (C) 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
-
-;; Author: Michael Albinus <address@hidden>
-;; Keywords: comm, processes
-
-;; This file is free software: you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; This package runs performance tests on Tramp. It expects that the
-;; Tramp lisp directory is included in the load path. Preferably,
-;; Tramp's Lisp files should be compiled.
-
-;; The test can be adapted by changing `tramp-verbose', or the test
-;; file name, in the `let' clause. It is expected that the test file
-;; should be accessible without password prompting.
-
-;; Three tests are run. The first one is just performing
-;; (file-exists-p test-file) and (file-attributes test-file). With
-;; this test, Tramp's initialization time shall be checked. Caching
-;; file properties should not influence the result.
-
-;; The second and third tests are executing 1000 times (file-exists-p
-;; test-file) and (file-attributes test-file), respectively. This
-;; will be heavily influenced by caching the results.
-
-;; The test can be run with "emacs -l tramp-time.el"
-
-;; Initially, I've got the following results on my Pentium III 700MHz,
-;; 256MB RAM, GNU/Debian Linux 2.6.11, Tramp compiled with the
-;; respective (X)Emacs version:
-
-;; Tramp Emacs 20.7 Emacs 21.4 Emacs 22.0 XEmacs 21.4 XEmacs 21.5
-;;
-;; 2.0.51 14.0 sec 14.0 sec 3.2 sec 3.0 sec (crash)
-;; 3.0 sec 4.0 sec 10.0 sec 5.0 sec (crash)
-;; 19.0 sec 19.0 sec 36.8 sec 25.0 sec (crash)
-;;
-;; 2.1.4 - 1.0 sec 0.8 sec 1.0 sec (crash)
-;; - 2.0 sec 1.7 sec 2.0 sec (crash)
-;; - 2.0 sec 1.7 sec 2.0 sec (crash)
-
-;; Note that Tramp 2.1.4 is applicable for (X)Emacs 21 upwards.
-;; Milliseconds are provided by Emacs 22 only. XEmacs 21.5 (from CVS)
-;; crashes with both Tramp 2.0.51 and 2.1.4 - no idea why.
-
-;;; Code:
-
-(require 'time-stamp)
-(require 'tramp)
-
-;; Initialise profiling
-;(require 'elp)
-(when (featurep 'elp)
- (elp-instrument-package "tramp"))
-
-;; Initialise debugging
-;(require 'edebug)
-;(find-file "~/src/tramp/lisp/tramp.el")
-;(let ((edebug-all-defs t)) (eval-current-buffer))
-;(goto-char (point-min))
-;(re-search-forward "defun tramp-send-command-and-check")
-;(edebug-defun)
-;(edebug-set-global-break-condition
-; (and (bufferp (get-buffer "*result*"))
-; (with-current-buffer (get-buffer "*result*") (= (point-min) (point)))))
-
-(defun run-test (operation)
- (insert (format "Start 1000x (%s \"%s\")\n" operation test-file))
- ;; We call it once in order to receive complete caching times.
- (funcall operation test-file)
- (setq start-time (current-time))
- (dotimes (i 1000)
- (funcall operation test-file))
- (setq stop-time (current-time))
- (insert (format "Stop 1000x (%s \"%s\") %s sec\n"
- operation test-file (tramp-time-diff stop-time start-time)))
- (when (featurep 'elp)
- (elp-results)
- (switch-to-buffer "*result*")
- (delete-other-windows)
- (insert (with-current-buffer elp-results-buffer (buffer-string)))))
-
-(let ((tramp-default-proxies-alist nil) (tramp-default-host nil)
- (tramp-default-method-alist nil) (tramp-default-method nil)
- (tramp-default-user-alist nil) (tramp-default-user nil)
- (tramp-verbose 0) (vc-handled-backends nil)
- (test-file
- (if (string-match "2\.0" tramp-version)
- (tramp-make-tramp-file-name nil "ssh" nil "localhost" "/")
- (tramp-make-tramp-file-name "ssh" nil "localhost" "/")))
- start-time stop-time)
-
- ;; Cleanup Tramp buffers.
- (mapcar '(lambda (b)
- (when (string-match "\\*\\(debug \\)?tramp/" (buffer-name b))
- (kill-buffer b)))
- (buffer-list))
-
- ;; Initialise Result buffer.
- (switch-to-buffer "*result*")
- (erase-buffer)
- (insert
- (format
- "Test accessing \"%s\", emacs-version %s, tramp-version %s, debug level
%d, %s compiled version, %s persistent data\n"
- test-file
- emacs-version
- tramp-version
- tramp-verbose
- (if (byte-code-function-p (symbol-function 'tramp-message)) "" "
not")
- (if (and (fboundp 'tramp-get-connection-property)
- (with-parsed-tramp-file-name test-file nil
- (tramp-get-connection-property v "uname" nil)))
- "with" "without")))
- (sit-for 1)
-
- ;; First test. This includes setting up the connection.
- (insert "Start initial connection\n")
- (setq start-time (current-time))
- (file-exists-p test-file)
- (file-attributes test-file)
- (setq stop-time (current-time))
- (insert (format "Stop initial connection %s sec\n"
- (tramp-time-diff stop-time start-time)))
- (when (featurep 'elp)
- (elp-results)
- (switch-to-buffer "*result*")
- (delete-other-windows)
- (insert (with-current-buffer elp-results-buffer (buffer-string))))
- (sit-for 1)
-
- ;; Second test. `file-exists-p' just runs "-e test-file" if not cached.
- (run-test 'file-exists-p)
- (sit-for 1)
-
- ;; Third test. `file-attributes' might run a perl script if not cached.
- (run-test 'file-attributes)
- (sit-for 1)
-
-; (run-test 'directory-files)
-; (sit-for 1)
-
-; (run-test 'directory-files-and-attributes)
-; (sit-for 1)
-
- (when (featurep 'elp)
- (kill-buffer elp-results-buffer)))
-
-;;; TODO:
-
-;; * Make it running under test-harness.el.