;;; vc-tests.el --- Tests of different backends of vc.el  -*- lexical-binding:t -*-

;; Copyright (C) 2014-2022 Free Software Foundation, Inc.

;; Author: Michael Albinus <michael.albinus@gmx.de>

;; This file is part of GNU Emacs.
;;
;; GNU Emacs 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 <https://www.gnu.org/licenses/>.

;;; Commentary:

;; For every supported VC on the machine, different test cases are
;; generated automatically.

;; Functions to be tested (see Commentary of vc.el).  Mandatory
;; functions are marked with `*', optional functions are marked with `-':

;; BACKEND PROPERTIES
;;
;; * revision-granularity                                       DONE

;; STATE-QUERYING FUNCTIONS
;;
;; * registered (file)                                          DONE
;; * state (file)                                               DONE
;; - dir-status (dir update-function)
;; - dir-status-files (dir files default-state update-function)
;; - dir-extra-headers (dir)
;; - dir-printer (fileinfo)
;; - status-fileinfo-extra (file)
;; * working-revision (file)                                    DONE
;; - latest-on-branch-p (file)
;; * checkout-model (files)                                     DONE
;; - mode-line-string (file)

;; STATE-CHANGING FUNCTIONS
;;
;; * create-repo (backend)                                      DONE
;; * register (files &optional comment)                         DONE
;; - responsible-p (file)
;; - receive-file (file rev)
;; - unregister (file)                                          DONE
;; * checkin (files comment)                                    DONE
;; * find-revision (file rev buffer)
;; * checkout (file &optional rev)
;; * revert (file &optional contents-done)
;; - rollback (files)
;; - merge-file (file rev1 rev2)
;; - merge-branch ()
;; - merge-news (file)
;; - pull (prompt)
;; - steal-lock (file &optional revision)
;; - modify-change-comment (files rev comment)
;; - mark-resolved (files)
;; - find-admin-dir (file)

;; HISTORY FUNCTIONS
;;
;; * print-log (files buffer &optional shortlog start-revision limit)
;; * log-outgoing (backend remote-location)
;; * log-incoming (backend remote-location)
;; - log-view-mode ()
;; - show-log-entry (revision)
;; - comment-history (file)
;; - update-changelog (files)
;; * diff (files &optional async rev1 rev2 buffer)              DONE
;; - revision-completion-table (files)
;; - annotate-command (file buf &optional rev)
;; - annotate-time ()
;; - annotate-current-time ()
;; - annotate-extract-revision-at-line ()
;; - region-history (FILE BUFFER LFROM LTO)
;; - region-history-mode ()

;; TAG SYSTEM
;;
;; - create-tag (dir name branchp)
;; - retrieve-tag (dir name update)

;; MISCELLANEOUS
;;
;; - make-version-backups-p (file)
;; - root (file)
;; - ignore (file &optional directory)
;; - ignore-completion-table
;; - previous-revision (file rev)
;; - next-revision (file rev)
;; - log-edit-mode ()
;; - check-headers ()
;; - delete-file (file)
;; - rename-file (old new)                                      DONE
;; - find-file-hook ()
;; - extra-menu ()
;; - extra-dir-menu ()
;; - conflicted-files (dir)

;;; Code:

(require 'ert)
(require 'ert-x)
(require 'vc)
(require 'log-edit)

(declare-function w32-application-type "w32proc.c")

;; The working horses.

(defvar vc-test--cleanup-hook nil
  "Functions for cleanup at the end of an ert test.
Don't set it globally, the functions should be let-bound.")

(defun vc-test--revision-granularity-function (backend)
  "Run the `vc-revision-granularity' backend function."
  (vc-call-backend backend 'revision-granularity))

(defun vc-test--create-repo-function (backend)
  "Run the `vc-create-repo' backend function.
For backends which dont support it, it is emulated."

  (cond
   ((eq backend 'CVS)
    (let ((tmp-dir
	   (expand-file-name
	    (make-temp-name "vc-test") temporary-file-directory)))
      (make-directory (expand-file-name "module" tmp-dir) 'parents)
      (make-directory (expand-file-name "CVSROOT" tmp-dir) 'parents)
      (if (not (fboundp 'w32-application-type))
          (shell-command-to-string (format "cvs -Q -d:local:%s co module"
                                           tmp-dir))
        (let ((cvs-prog (executable-find "cvs"))
              (tdir tmp-dir))
          ;; If CVS executable is an MSYS program, reformat the file
          ;; name of TMP-DIR to have the /d/foo/bar form supported by
          ;; MSYS programs.  (FIXME: What about Cygwin cvs.exe?)
          (if (eq (w32-application-type cvs-prog) 'msys)
              (setq tdir
                    (concat "/" (substring tmp-dir 0 1) (substring tmp-dir 2))))
          (shell-command-to-string (format "cvs -Q -d:local:%s co module"
                                           tdir))))
      (rename-file "module/CVS" default-directory)
      (delete-directory "module" 'recursive)
      ;; We must cleanup the "remote" CVS repo as well.
      (add-hook 'vc-test--cleanup-hook
		(lambda () (delete-directory tmp-dir 'recursive)))))

   ((eq backend 'Arch)
    (let ((archive-name (format "%s--%s" user-mail-address (random))))
      (when (string-match
	     "no arch user id set" (shell-command-to-string "tla my-id"))
	(shell-command-to-string
	 (format "tla my-id \"<%s>\"" user-mail-address)))
      (shell-command-to-string
       (format "tla make-archive %s %s" archive-name default-directory))
      (shell-command-to-string
       (format "tla my-default-archive %s" archive-name))))

   ((eq backend 'Mtn)
    (let ((archive-name "foo.mtn"))
      (shell-command-to-string
       (format
	"mtn db init --db=%s"
	(expand-file-name archive-name default-directory)))
      (shell-command-to-string
       (format "mtn --db=%s --branch=foo setup ." archive-name))))

   (t (vc-create-repo backend))))

(defun vc-test--create-repo (backend)
  "Create a test repository in `default-directory', a temporary directory."
  (ert-with-temp-directory tempdir
    (let ((vc-handled-backends `(,backend))
          (default-directory
           (file-name-as-directory
            (expand-file-name
             (make-temp-name "vc-test") temporary-file-directory)))
          (process-environment process-environment)
          vc-test--cleanup-hook)
      (when (eq backend 'Bzr)
        (setq process-environment (cons (format "BZR_HOME=%s" tempdir)
                                        process-environment)))

      (unwind-protect
          (progn
            ;; Cleanup.
            (add-hook
             'vc-test--cleanup-hook
             (let ((dir default-directory))
               (lambda () (delete-directory dir 'recursive))))

            ;; Check the revision granularity.
            (should (memq (vc-test--revision-granularity-function backend)
                          '(file repository)))

            ;; Create empty repository.
            (make-directory default-directory)
            (should (file-directory-p default-directory))
            (vc-test--create-repo-function backend)
            (should (eq (vc-responsible-backend default-directory) backend)))

        ;; Save exit.
        (ignore-errors
          (run-hooks 'vc-test--cleanup-hook))))))

;; FIXME: Why isn't there `vc-unregister'?
(defun vc-test--unregister-function (backend file)
  "Run the `vc-unregister' backend function.
For backends which don't support it, `vc-not-supported' is signaled."
  ;; CVS, SVN, SCCS, SRC and Mtn are not supported, and will signal
  ;; `vc-not-supported'.
  (prog1
      (vc-call-backend backend 'unregister file)
    (vc-file-clearprops file)))

(defmacro vc-test--run-maybe-unsupported-function (func &rest args)
  "Run FUNC with ARGS as arguments.
Catch the `vc-not-supported' error."
  `(condition-case err
       (funcall ,func ,@args)
     (vc-not-supported 'vc-not-supported)
     (t (signal (car err) (cdr err)))))

(defun vc-test--register (backend)
  "Register and unregister a file.
This checks also `vc-backend' and `vc-responsible-backend'."
  (ert-with-temp-directory tempdir
    (let ((vc-handled-backends `(,backend))
          (default-directory
           (file-name-as-directory
            (expand-file-name
             (make-temp-name "vc-test") temporary-file-directory)))
          (process-environment process-environment)
          vc-test--cleanup-hook)
      (when (eq backend 'Bzr)
        (setq process-environment (cons (format "BZR_HOME=%s" tempdir)
                                        process-environment)))
      (unwind-protect
          (progn
            ;; Cleanup.
            (add-hook
             'vc-test--cleanup-hook
             (let ((dir default-directory))
               (lambda () (delete-directory dir 'recursive))))

            ;; Create empty repository.
            (make-directory default-directory)
            (vc-test--create-repo-function backend)
            ;; For file oriented backends CVS, RCS and SVN the backend is
            ;; returned, and the directory is registered already.
            (should (if (vc-backend default-directory)
                        (vc-registered default-directory)
                      (not (vc-registered default-directory))))
            (should (eq (vc-responsible-backend default-directory) backend))

            (let ((tmp-name1 (expand-file-name "foo" default-directory))
                  (tmp-name2 "bla"))
              ;; Register files.  Check for it.
              (write-region "foo" nil tmp-name1 nil 'nomessage)
              (should (file-exists-p tmp-name1))
              (should-not (vc-backend tmp-name1))
              (should (eq (vc-responsible-backend tmp-name1) backend))
              (should-not (vc-registered tmp-name1))

              (write-region "bla" nil tmp-name2 nil 'nomessage)
              (should (file-exists-p tmp-name2))
              (should-not (vc-backend tmp-name2))
              (should (eq (vc-responsible-backend tmp-name2) backend))
              (should-not (vc-registered tmp-name2))

              (vc-register (list backend (list tmp-name1 tmp-name2)))
              (should (file-exists-p tmp-name1))
              (should (eq (vc-backend tmp-name1) backend))
              (should (eq (vc-responsible-backend tmp-name1) backend))
              (should (vc-registered tmp-name1))

              (should (file-exists-p tmp-name2))
              (should (eq (vc-backend tmp-name2) backend))
              (should (eq (vc-responsible-backend tmp-name2) backend))
              (should (vc-registered tmp-name2))

              ;; `vc-backend' accepts also a list of files,
              ;; `vc-responsible-backend' doesn't.
              (should (vc-backend (list tmp-name1 tmp-name2)))

              ;; Unregister the files.
              (unless (eq (vc-test--run-maybe-unsupported-function
                           'vc-test--unregister-function backend tmp-name1)
                          'vc-not-supported)
                (should-not (vc-backend tmp-name1))
                (should-not (vc-registered tmp-name1)))
              (unless (eq (vc-test--run-maybe-unsupported-function
                           'vc-test--unregister-function backend tmp-name2)
                          'vc-not-supported)
                (should-not (vc-backend tmp-name2))
                (should-not (vc-registered tmp-name2)))

              ;; The files should still exist.
              (should (file-exists-p tmp-name1))
              (should (file-exists-p tmp-name2))))

        ;; Save exit.
        (ignore-errors
          (run-hooks 'vc-test--cleanup-hook))))))

(defun vc-test--state (backend)
  "Check the different states of a file."
  (ert-with-temp-directory tempdir
    (let ((vc-handled-backends `(,backend))
          (default-directory
           (file-name-as-directory
            (expand-file-name
             (make-temp-name "vc-test") temporary-file-directory)))
          (process-environment process-environment)
          vc-test--cleanup-hook)
      (when (eq backend 'Bzr)
        (setq process-environment (cons (format "BZR_HOME=%s" tempdir)
                                        process-environment)))
      (unwind-protect
          (progn
            ;; Cleanup.
            (add-hook
             'vc-test--cleanup-hook
             (let ((dir default-directory))
               (lambda () (delete-directory dir 'recursive))))

            ;; Create empty repository.
            (make-directory default-directory)
            (vc-test--create-repo-function backend)

            (let ((tmp-name (expand-file-name "foo" default-directory)))
              ;; Check state of a nonexistent file.

              (message "vc-state2 %s" (vc-state tmp-name))
              (should (null (vc-state tmp-name)))

              ;; Write a new file.  Check state.
              (write-region "foo" nil tmp-name nil 'nomessage)

              ;; nil: Mtn
              ;; unregistered: Bzr CVS Git Hg SVN RCS
              (message "vc-state3 %s %s" backend (vc-state tmp-name backend))
              (should (memq (vc-state tmp-name backend) '(nil unregistered)))

              ;; Register a file.  Check state.
              (vc-register
               (list backend (list (file-name-nondirectory tmp-name))))

              ;; FIXME: nil is definitely wrong.
              ;; nil: SRC
              ;; added: Bzr CVS Git Hg Mtn SVN
              ;; up-to-date: RCS SCCS
              (message "vc-state4 %s" (vc-state tmp-name))
              (should (memq (vc-state tmp-name) '(nil added up-to-date)))

              ;; Unregister the file.  Check state.
              (if (eq (vc-test--run-maybe-unsupported-function
                       'vc-test--unregister-function backend tmp-name)
                      'vc-not-supported)
                  (message "vc-state5 unsupported")
                ;; unregistered: Bzr Git RCS Hg
                ;; unsupported: CVS Mtn SCCS SRC SVN
                (message "vc-state5 %s %s" backend (vc-state tmp-name backend))
                (should (memq (vc-state tmp-name backend)
                              '(nil unregistered))))))

        ;; Save exit.
        (ignore-errors
          (run-hooks 'vc-test--cleanup-hook))))))

(defun vc-test--working-revision (backend)
  "Check the working revision of a repository."
  (ert-with-temp-directory tempdir
    (let ((vc-handled-backends `(,backend))
          (default-directory
           (file-name-as-directory
            (expand-file-name
             (make-temp-name "vc-test") temporary-file-directory)))
          (process-environment process-environment)
          vc-test--cleanup-hook)
      (when (eq backend 'Bzr)
        (setq process-environment (cons (format "BZR_HOME=%s" tempdir)
                                        process-environment)))

      (unwind-protect
          (progn
            ;; Cleanup.
            (add-hook
             'vc-test--cleanup-hook
             (let ((dir default-directory))
               (lambda () (delete-directory dir 'recursive))))

            ;; Create empty repository.  Check working revision of
            ;; repository, should be nil.
            (make-directory default-directory)
            (vc-test--create-repo-function backend)

            ;; FIXME: Is the value for SVN correct?
            ;; nil: Bzr CVS Git Hg Mtn RCS SCCS SRC
            ;; "0": SVN
            (message
             "vc-working-revision1 %s" (vc-working-revision default-directory))
            (should (member (vc-working-revision default-directory) '(nil "0")))

            (let ((tmp-name (expand-file-name "foo" default-directory)))
              ;; Check initial working revision, should be nil until
              ;; it's registered.

              (message "vc-working-revision2 %s" (vc-working-revision tmp-name))
              (should-not (vc-working-revision tmp-name))

              ;; Write a new file.  Check working revision.
              (write-region "foo" nil tmp-name nil 'nomessage)

              (message "vc-working-revision3 %s" (vc-working-revision tmp-name))
              (should-not (vc-working-revision tmp-name))

              ;; Register a file.  Check working revision.
              (vc-register
               (list backend (list (file-name-nondirectory tmp-name))))

              ;; XXX: nil is fine, at least in Git's case, because
              ;; `vc-register' only makes the file `added' in this case.
              ;; nil: Git Mtn
              ;; "0": Bzr CVS Hg SRC SVN
              ;; "1.1": RCS SCCS
              ;; "-1": Hg versions before 5 (probably)
              (message "vc-working-revision4 %s" (vc-working-revision tmp-name))
              (should (member (vc-working-revision tmp-name) '(nil "0" "1.1" "-1")))

              ;; TODO: Call `vc-checkin', and check the resulting
              ;; working revision.  None of the return values should be
              ;; nil then.

              ;; Unregister the file.  Check working revision.
              (if (eq (vc-test--run-maybe-unsupported-function
                       'vc-test--unregister-function backend tmp-name)
                      'vc-not-supported)
                  (message "vc-working-revision5 unsupported")
                ;; nil: Bzr Git Hg RCS
                ;; unsupported: CVS Mtn SCCS SRC SVN
                (message "vc-working-revision5 %s" (vc-working-revision tmp-name))
                (should-not (vc-working-revision tmp-name)))))

        ;; Save exit.
        (ignore-errors
          (run-hooks 'vc-test--cleanup-hook))))))

(defun vc-test--checkout-model (backend)
  "Check the checkout model of a repository."
  (ert-with-temp-directory tempdir
    (let ((vc-handled-backends `(,backend))
          (default-directory
           (file-name-as-directory
            (expand-file-name
             (make-temp-name "vc-test") temporary-file-directory)))
          (process-environment process-environment)
          vc-test--cleanup-hook)
      (when (eq backend 'Bzr)
        (setq process-environment (cons (format "BZR_HOME=%s" tempdir)
                                        process-environment)))

      (unwind-protect
          (progn
            ;; Cleanup.
            (add-hook
             'vc-test--cleanup-hook
             (let ((dir default-directory))
               (lambda () (delete-directory dir 'recursive))))

            ;; Create empty repository.  Check repository checkout model.
            (make-directory default-directory)
            (vc-test--create-repo-function backend)

            ;; Surprisingly, none of the backends returns 'announce.
            ;; implicit: Bzr CVS Git Hg Mtn SRC SVN
            ;; locking: RCS SCCS
            (message
             "vc-checkout-model1 %s"
             (vc-checkout-model backend default-directory))
            (should (memq (vc-checkout-model backend default-directory)
                          '(announce implicit locking)))

            (let ((tmp-name (expand-file-name "foo" default-directory)))
              ;; Check checkout model of a nonexistent file.

              ;; implicit: Bzr CVS Git Hg Mtn SRC SVN
              ;; locking: RCS SCCS
              (message
               "vc-checkout-model2 %s" (vc-checkout-model backend tmp-name))
              (should (memq (vc-checkout-model backend tmp-name)
                            '(announce implicit locking)))

              ;; Write a new file.  Check checkout model.
              (write-region "foo" nil tmp-name nil 'nomessage)

              ;; implicit: Bzr CVS Git Hg Mtn SRC SVN
              ;; locking: RCS SCCS
              (message
               "vc-checkout-model3 %s" (vc-checkout-model backend tmp-name))
              (should (memq (vc-checkout-model backend tmp-name)
                            '(announce implicit locking)))

              ;; Register a file.  Check checkout model.
              (vc-register
               (list backend (list (file-name-nondirectory tmp-name))))

              ;; implicit: Bzr CVS Git Hg Mtn SRC SVN
              ;; locking: RCS SCCS
              (message
               "vc-checkout-model4 %s" (vc-checkout-model backend tmp-name))
              (should (memq (vc-checkout-model backend tmp-name)
                            '(announce implicit locking)))

              ;; Unregister the file.  Check checkout model.
              (if (eq (vc-test--run-maybe-unsupported-function
                       'vc-test--unregister-function backend tmp-name)
                      'vc-not-supported)
                  (message "vc-checkout-model5 unsupported")
                ;; implicit: Bzr Git Hg
                ;; locking: RCS
                ;; unsupported: CVS Mtn SCCS SRC SVN
                (message
                 "vc-checkout-model5 %s" (vc-checkout-model backend tmp-name))
                (should (memq (vc-checkout-model backend tmp-name)
                              '(announce implicit locking))))))

        ;; Save exit.
        (ignore-errors
          (run-hooks 'vc-test--cleanup-hook))))))

(defun vc-test--rename-file (backend)
  "Check the rename-file action."
  (ert-with-temp-directory tempdir
    (let ((vc-handled-backends `(,backend))
          (default-directory
           (file-name-as-directory
            (expand-file-name
             (make-temp-name "vc-test") temporary-file-directory)))
          (process-environment process-environment)
          vc-test--cleanup-hook)
      (when (eq backend 'Bzr)
        (setq process-environment (cons (format "BZR_HOME=%s" tempdir)
                                        process-environment)))

      (unwind-protect
          (progn
            ;; Cleanup.
            (add-hook
             'vc-test--cleanup-hook
             (let ((dir default-directory))
               (lambda () (delete-directory dir 'recursive))))

            ;; Create empty repository.
            (make-directory default-directory)
            (vc-test--create-repo-function backend)

            (let ((tmp-name (expand-file-name "foo" default-directory))
                  (new-name (expand-file-name "bar" default-directory)))
              ;; Write a new file.
              (write-region "foo" nil tmp-name nil 'nomessage)

              ;; Register it.  Renaming can fail otherwise.
              (vc-register
               (list backend (list (file-name-nondirectory tmp-name))))

              (vc-rename-file tmp-name new-name)

              (should (not (file-exists-p tmp-name)))
              (should (file-exists-p new-name))

              (should (equal (vc-state new-name)
                             (if (memq backend '(RCS SCCS))
                                 'up-to-date
                               'added)))))

        ;; Save exit.
        (ignore-errors
          (run-hooks 'vc-test--cleanup-hook))))))

(declare-function log-edit-done "vc/log-edit")

(defun vc-test--version-diff (backend)
  "Check the diff version of a repository."
  (ert-with-temp-directory tempdir
    (let ((vc-handled-backends `(,backend))
          (default-directory
           (file-name-as-directory
            (expand-file-name
             (make-temp-name "vc-test") temporary-file-directory)))
          (process-environment process-environment)
          vc-test--cleanup-hook)
      (when (eq backend 'Bzr)
        (setq process-environment (cons (format "BZR_HOME=%s" tempdir)
                                        process-environment)))
      ;; git tries various approaches to guess a user name and email,
      ;; which can fail depending on how the system is configured.
      ;; Eg if the user account has no GECOS, git commit can fail with
      ;; status 128 "fatal: empty ident name".
      (when (memq backend '(Bzr Git))
        (setq process-environment (cons "EMAIL=john@doe.ee"
                                        process-environment)))
      (if (eq backend 'Git)
          (setq process-environment (append '("GIT_AUTHOR_NAME=A"
                                              "GIT_COMMITTER_NAME=C")
                                            process-environment)))
      (unwind-protect
          (progn
            ;; Cleanup.
            (add-hook
             'vc-test--cleanup-hook
             (let ((dir default-directory))
               (lambda () (delete-directory dir 'recursive))))

            ;; Create empty repository.  Check repository checkout model.
            (make-directory default-directory)
            (vc-test--create-repo-function backend)

            (let* ((tmp-name (expand-file-name "foo" default-directory))
                   (files (list (file-name-nondirectory tmp-name))))
              ;; Write and register a new file.
              (write-region "originaltext" nil tmp-name nil 'nomessage)
              (vc-register (list backend files))

              (let ((buff (find-file tmp-name)))
                (with-current-buffer buff
                  (progn
                    ;; Optionally checkout file.
                    (when (memq backend '(RCS CVS SCCS))
                      (vc-checkout tmp-name))

                    ;; Checkin file.
                    (vc-checkin files backend)
                    (insert "Testing vc-version-diff")
                    (log-edit-done))))

              ;; Modify file content.
              (when (memq backend '(RCS CVS SCCS))
                (vc-checkout tmp-name))
              (write-region "updatedtext" nil tmp-name nil 'nomessage)

              ;; Check version diff.
              (vc-version-diff files nil nil)
              (should (bufferp (get-buffer "*vc-diff*")))

              (with-current-buffer "*vc-diff*"
                (progn
                  (let ((rawtext (buffer-substring-no-properties (point-min)
                                                                 (point-max))))
                    (should (string-search "-originaltext" rawtext))
                    (should (string-search "+updatedtext" rawtext)))))))

        ;; Save exit.
        (ignore-errors
          (run-hooks 'vc-test--cleanup-hook))))))

;; Create the test cases.

(defun vc-test--rcs-enabled ()
  (executable-find "rcs"))

(defun vc-test--cvs-enabled ()
  (executable-find "cvs"))

(defvar vc-svn-program)
(defun vc-test--svn-enabled ()
  (and (executable-find "svnadmin")
       (executable-find vc-svn-program)))

(defun vc-test--sccs-enabled ()
  (executable-find "sccs"))

(defvar vc-src-program)
(defun vc-test--src-enabled ()
  (executable-find vc-src-program))

(defvar vc-bzr-program)
(defun vc-test--bzr-enabled ()
  (executable-find vc-bzr-program))

(defvar vc-git-program)
(defun vc-test--git-enabled ()
  (executable-find vc-git-program))

(defvar vc-hg-program)
(defun vc-test--hg-enabled ()
  (executable-find vc-hg-program))

(defvar vc-mtn-program)
(defun vc-test--mtn-enabled ()
  (executable-find vc-mtn-program))

;; Obsoleted.
(defvar vc-arch-program)
(defun vc-test--arch-enabled ()
  (executable-find vc-arch-program))

;; Create the test cases.
(dolist (backend vc-handled-backends)
  (let ((backend-string (downcase (symbol-name backend))))
    (require (intern (format "vc-%s" backend-string)))
    (eval
     ;; Check, whether the backend is supported.
     `(when (funcall ',(intern (format "vc-test--%s-enabled" backend-string)))

	(ert-deftest
	    ,(intern (format "vc-test-%s00-create-repo" backend-string)) ()
	  ,(format "Check `vc-create-repo' for the %s backend."
		   backend-string)
	  (vc-test--create-repo ',backend))

	(ert-deftest
	    ,(intern (format "vc-test-%s01-register" backend-string)) ()
	  ,(format
	    "Check `vc-register' and `vc-registered' for the %s backend."
	    backend-string)
	  (skip-unless
	   (ert-test-passed-p
	    (ert-test-most-recent-result
	     (ert-get-test
	      ',(intern
		 (format "vc-test-%s00-create-repo" backend-string))))))
	  (vc-test--register ',backend))

	(ert-deftest
	    ,(intern (format "vc-test-%s02-state" backend-string)) ()
	  ,(format "Check `vc-state' for the %s backend." backend-string)
	  (skip-unless
	   (ert-test-passed-p
	    (ert-test-most-recent-result
	     (ert-get-test
	      ',(intern
		 (format "vc-test-%s01-register" backend-string))))))
	  (vc-test--state ',backend))

	(ert-deftest
	    ,(intern (format "vc-test-%s03-working-revision" backend-string)) ()
	  ,(format "Check `vc-working-revision' for the %s backend."
		   backend-string)
	  (skip-unless
	   (ert-test-passed-p
	    (ert-test-most-recent-result
	     (ert-get-test
	      ',(intern
		 (format "vc-test-%s01-register" backend-string))))))
	  (vc-test--working-revision ',backend))

	(ert-deftest
	    ,(intern (format "vc-test-%s04-checkout-model" backend-string)) ()
	  ,(format "Check `vc-checkout-model' for the %s backend."
		   backend-string)
	  (skip-unless
	   (ert-test-passed-p
	    (ert-test-most-recent-result
	     (ert-get-test
	      ',(intern
		 (format "vc-test-%s01-register" backend-string))))))
	  (vc-test--checkout-model ',backend))

        (ert-deftest
            ,(intern (format "vc-test-%s05-rename-file" backend-string)) ()
          ,(format "Check `vc-rename-file' for the %s backend."
                   backend-string)
          (skip-unless
           (ert-test-passed-p
            (ert-test-most-recent-result
             (ert-get-test
              ',(intern
                 (format "vc-test-%s01-register" backend-string))))))
          ;; CVS calls vc-delete-file, which insists on prompting
          ;; "Really want to delete ...?", and `vc-mtn.el' does not implement
          ;; `delete-file' at all.
          (skip-unless (not (memq ',backend '(CVS Mtn))))
          (vc-test--rename-file ',backend))

        (ert-deftest
            ,(intern (format "vc-test-%s06-version-diff" backend-string)) ()
          ,(format "Check `vc-version-diff' for the %s backend."
                   backend-string)
          (skip-unless
           (ert-test-passed-p
            (ert-test-most-recent-result
             (ert-get-test
              ',(intern
                 (format "vc-test-%s01-register" backend-string))))))
          ;; `vc-mtn.el' gives me:
          ;; "Failed (status 1): mtn commit -m Testing vc-version-diff\n\n foo"
          (skip-unless (not (memq ',backend '(Mtn))))
          (vc-test--version-diff ',backend))
        ))))

(provide 'vc-tests)
;;; vc-tests.el ends here