code.delx.au - gnu-emacs/blob - test/lisp/vc/vc-tests.el

   1 ;;; vc-tests.el --- Tests of different backends of vc.el
   2
   3 ;; Copyright (C) 2014-2016 Free Software Foundation, Inc.
   4
   5 ;; Author: Michael Albinus <michael.albinus@gmx.de>
   6
   7 ;; This program is free software: you can redistribute it and/or
   8 ;; modify it under the terms of the GNU General Public License as
   9 ;; published by the Free Software Foundation, either version 3 of the
  10 ;; License, or (at your option) any later version.
  11 ;;
  12 ;; This program is distributed in the hope that it will be useful, but
  13 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  14 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  15 ;; General Public License for more details.
  16 ;;
  17 ;; You should have received a copy of the GNU General Public License
  18 ;; along with this program.  If not, see `http://www.gnu.org/licenses/'.
  19
  20 ;;; Commentary:
  21
  22 ;; For every supported VC on the machine, different test cases are
  23 ;; generated automatically.
  24
  25 ;; Functions to be tested (see Commentary of vc.el).  Mandatory
  26 ;; functions are marked with `*', optional functions are marked with `-':
  27
  28 ;; BACKEND PROPERTIES
  29 ;;
  30 ;; * revision-granularity                                       DONE
  31
  32 ;; STATE-QUERYING FUNCTIONS
  33 ;;
  34 ;; * registered (file)                                          DONE
  35 ;; * state (file)                                               DONE
  36 ;; - dir-status (dir update-function)
  37 ;; - dir-status-files (dir files default-state update-function)
  38 ;; - dir-extra-headers (dir)
  39 ;; - dir-printer (fileinfo)
  40 ;; - status-fileinfo-extra (file)
  41 ;; * working-revision (file)                                    DONE
  42 ;; - latest-on-branch-p (file)
  43 ;; * checkout-model (files)                                     DONE
  44 ;; - mode-line-string (file)
  45
  46 ;; STATE-CHANGING FUNCTIONS
  47 ;;
  48 ;; * create-repo (backend)                                      DONE
  49 ;; * register (files &optional comment)                         DONE
  50 ;; - responsible-p (file)
  51 ;; - receive-file (file rev)
  52 ;; - unregister (file)                                          DONE
  53 ;; * checkin (files comment)
  54 ;; * find-revision (file rev buffer)
  55 ;; * checkout (file &optional rev)
  56 ;; * revert (file &optional contents-done)
  57 ;; - rollback (files)
  58 ;; - merge-file (file rev1 rev2)
  59 ;; - merge-branch ()
  60 ;; - merge-news (file)
  61 ;; - pull (prompt)
  62 ;; - steal-lock (file &optional revision)
  63 ;; - modify-change-comment (files rev comment)
  64 ;; - mark-resolved (files)
  65 ;; - find-admin-dir (file)
  66
  67 ;; HISTORY FUNCTIONS
  68 ;;
  69 ;; * print-log (files buffer &optional shortlog start-revision limit)
  70 ;; * log-outgoing (backend remote-location)
  71 ;; * log-incoming (backend remote-location)
  72 ;; - log-view-mode ()
  73 ;; - show-log-entry (revision)
  74 ;; - comment-history (file)
  75 ;; - update-changelog (files)
  76 ;; * diff (files &optional async rev1 rev2 buffer)
  77 ;; - revision-completion-table (files)
  78 ;; - annotate-command (file buf &optional rev)
  79 ;; - annotate-time ()
  80 ;; - annotate-current-time ()
  81 ;; - annotate-extract-revision-at-line ()
  82 ;; - region-history (FILE BUFFER LFROM LTO)
  83 ;; - region-history-mode ()
  84
  85 ;; TAG SYSTEM
  86 ;;
  87 ;; - create-tag (dir name branchp)
  88 ;; - retrieve-tag (dir name update)
  89
  90 ;; MISCELLANEOUS
  91 ;;
  92 ;; - make-version-backups-p (file)
  93 ;; - root (file)
  94 ;; - ignore (file &optional directory)
  95 ;; - ignore-completion-table
  96 ;; - previous-revision (file rev)
  97 ;; - next-revision (file rev)
  98 ;; - log-edit-mode ()
  99 ;; - check-headers ()
 100 ;; - delete-file (file)
 101 ;; - rename-file (old new)
 102 ;; - find-file-hook ()
 103 ;; - extra-menu ()
 104 ;; - extra-dir-menu ()
 105 ;; - conflicted-files (dir)
 106
 107 ;;; Code:
 108
 109 (require 'ert)
 110 (require 'vc)
 111
 112 ;; The working horses.
 113
 114 (defvar vc-test--cleanup-hook nil
 115   "Functions for cleanup at the end of an ert test.
 116 Don't set it globally, the functions shall be let-bound.")
 117
 118 (defun vc-test--revision-granularity-function (backend)
 119   "Run the `vc-revision-granularity' backend function."
 120   (funcall (intern (downcase (format "vc-%s-revision-granularity" backend)))))
 121
 122 (defun vc-test--create-repo-function (backend)
 123   "Run the `vc-create-repo' backend function.
 124 For backends which dont support it, it is emulated."
 125
 126   (cond
 127    ((eq backend 'CVS)
 128     (let ((tmp-dir
 129            (expand-file-name
 130             (make-temp-name "vc-test") temporary-file-directory)))
 131       (make-directory (expand-file-name "module" tmp-dir) 'parents)
 132       (make-directory (expand-file-name "CVSROOT" tmp-dir) 'parents)
 133       (if (not (fboundp 'w32-application-type))
 134           (shell-command-to-string (format "cvs -Q -d:local:%s co module"
 135                                            tmp-dir))
 136         (let ((cvs-prog (executable-find "cvs"))
 137               (tdir tmp-dir))
 138           ;; If CVS executable is an MSYS program, reformat the file
 139           ;; name of TMP-DIR to have the /d/foo/bar form supported by
 140           ;; MSYS programs.  (FIXME What about Cygwin cvs.exe?)
 141           (if (eq (w32-application-type cvs-prog) 'msys)
 142               (setq tdir
 143                     (concat "/" (substring tmp-dir 0 1) (substring tmp-dir 2))))
 144           (shell-command-to-string (format "cvs -Q -d:local:%s co module"
 145                                            tdir))))
 146       (rename-file "module/CVS" default-directory)
 147       (delete-directory "module" 'recursive)
 148       ;; We must cleanup the "remote" CVS repo as well.
 149       (add-hook 'vc-test--cleanup-hook
 150                 `(lambda () (delete-directory ,tmp-dir 'recursive)))))
 151
 152    ((eq backend 'Arch)
 153     (let ((archive-name (format "%s--%s" user-mail-address (random))))
 154       (when (string-match
 155              "no arch user id set" (shell-command-to-string "tla my-id"))
 156         (shell-command-to-string
 157          (format "tla my-id \"<%s>\"" user-mail-address)))
 158       (shell-command-to-string
 159        (format "tla make-archive %s %s" archive-name default-directory))
 160       (shell-command-to-string
 161        (format "tla my-default-archive %s" archive-name))))
 162
 163    ((eq backend 'Mtn)
 164     (let ((archive-name "foo.mtn"))
 165       (shell-command-to-string
 166        (format
 167         "mtn db init --db=%s"
 168         (expand-file-name archive-name default-directory)))
 169       (shell-command-to-string
 170        (format "mtn --db=%s --branch=foo setup ." archive-name))))
 171
 172    (t (vc-create-repo backend))))
 173
 174 (defun vc-test--create-repo (backend)
 175   "Create a test repository in `default-directory', a temporary directory."
 176
 177   (let ((vc-handled-backends `(,backend))
 178         (default-directory
 179           (file-name-as-directory
 180            (expand-file-name
 181             (make-temp-name "vc-test") temporary-file-directory)))
 182         vc-test--cleanup-hook)
 183
 184     (unwind-protect
 185         (progn
 186           ;; Cleanup.
 187           (add-hook
 188            'vc-test--cleanup-hook
 189            `(lambda () (delete-directory ,default-directory 'recursive)))
 190
 191           ;; Check the revision granularity.
 192           (should (memq (vc-test--revision-granularity-function backend)
 193                         '(file repository)))
 194
 195           ;; Create empty repository.
 196           (make-directory default-directory)
 197           (should (file-directory-p default-directory))
 198           (vc-test--create-repo-function backend)
 199           (should (eq (vc-responsible-backend default-directory) backend)))
 200
 201       ;; Save exit.
 202       (ignore-errors (run-hooks 'vc-test--cleanup-hook)))))
 203
 204 ;; FIXME Why isn't there `vc-unregister'?
 205 (defun vc-test--unregister-function (backend file)
 206   "Run the `vc-unregister' backend function.
 207 For backends which dont support it, `vc-not-supported' is signalled."
 208
 209   (unwind-protect
 210       (let ((symbol (intern (downcase (format "vc-%s-unregister" backend)))))
 211         (if (functionp symbol)
 212             (funcall symbol file)
 213           ;; CVS, SVN, SCCS, SRC and Mtn are not supported.
 214           (signal 'vc-not-supported (list 'unregister backend))))
 215
 216     ;; FIXME This shall be called in `vc-unregister'.
 217     (vc-file-clearprops file)))
 218
 219 (defun vc-test--register (backend)
 220   "Register and unregister a file.
 221 This checks also `vc-backend' and `vc-reponsible-backend'."
 222
 223   (let ((vc-handled-backends `(,backend))
 224         (default-directory
 225           (file-name-as-directory
 226            (expand-file-name
 227             (make-temp-name "vc-test") temporary-file-directory)))
 228         vc-test--cleanup-hook)
 229
 230     (unwind-protect
 231         (progn
 232           ;; Cleanup.
 233           (add-hook
 234            'vc-test--cleanup-hook
 235            `(lambda () (delete-directory ,default-directory 'recursive)))
 236
 237           ;; Create empty repository.
 238           (make-directory default-directory)
 239           (vc-test--create-repo-function backend)
 240           ;; For file oriented backends CVS, RCS and SVN the backend is
 241           ;; returned, and the directory is registered already.
 242           ;; FIXME is this correct?
 243           (should (if (vc-backend default-directory)
 244                       (vc-registered default-directory)
 245                     (not (vc-registered default-directory))))
 246           (should (eq (vc-responsible-backend default-directory) backend))
 247
 248           (let ((tmp-name1 (expand-file-name "foo" default-directory))
 249                 (tmp-name2 "bla"))
 250             ;; Register files.  Check for it.
 251             (write-region "foo" nil tmp-name1 nil 'nomessage)
 252             (should (file-exists-p tmp-name1))
 253             (should-not (vc-backend tmp-name1))
 254             (should (eq (vc-responsible-backend tmp-name1) backend))
 255             (should-not (vc-registered tmp-name1))
 256
 257             (write-region "bla" nil tmp-name2 nil 'nomessage)
 258             (should (file-exists-p tmp-name2))
 259             (should-not (vc-backend tmp-name2))
 260             (should (eq (vc-responsible-backend tmp-name2) backend))
 261             (should-not (vc-registered tmp-name2))
 262
 263             (vc-register (list backend (list tmp-name1 tmp-name2)))
 264             (should (file-exists-p tmp-name1))
 265             (should (eq (vc-backend tmp-name1) backend))
 266             (should (eq (vc-responsible-backend tmp-name1) backend))
 267             (should (vc-registered tmp-name1))
 268
 269             (should (file-exists-p tmp-name2))
 270             (should (eq (vc-backend tmp-name2) backend))
 271             (should (eq (vc-responsible-backend tmp-name2) backend))
 272             (should (vc-registered tmp-name2))
 273
 274             ;; FIXME `vc-backend' accepts also a list of files,
 275             ;; `vc-responsible-backend' doesn't.  Is this right?
 276             (should (vc-backend (list tmp-name1 tmp-name2)))
 277
 278             ;; Unregister the files.
 279             (condition-case err
 280                 (progn
 281                   (vc-test--unregister-function backend tmp-name1)
 282                   (should-not (vc-backend tmp-name1))
 283                   (should-not (vc-registered tmp-name1))
 284                   (vc-test--unregister-function backend tmp-name2)
 285                   (should-not (vc-backend tmp-name2))
 286                   (should-not (vc-registered tmp-name2)))
 287               ;; CVS, SVN, SCCS, SRC and Mtn are not supported.
 288               (vc-not-supported t)
 289               (t (signal (car err) (cdr err))))
 290
 291             ;; The files shall still exist.
 292             (should (file-exists-p tmp-name1))
 293             (should (file-exists-p tmp-name2))))
 294
 295       ;; Save exit.
 296       (ignore-errors (run-hooks 'vc-test--cleanup-hook)))))
 297
 298 (defun vc-test--state (backend)
 299   "Check the different states of a file."
 300
 301   (let ((vc-handled-backends `(,backend))
 302         (default-directory
 303           (file-name-as-directory
 304            (expand-file-name
 305             (make-temp-name "vc-test") temporary-file-directory)))
 306         vc-test--cleanup-hook)
 307
 308     (unwind-protect
 309         (progn
 310           ;; Cleanup.
 311           (add-hook
 312            'vc-test--cleanup-hook
 313            `(lambda () (delete-directory ,default-directory 'recursive)))
 314
 315           ;; Create empty repository.  Check repository state.
 316           (make-directory default-directory)
 317           (vc-test--create-repo-function backend)
 318
 319           ;; nil: Hg Mtn RCS
 320           ;; added: Git
 321           ;; unregistered: CVS SCCS SRC
 322           ;; up-to-date: Bzr SVN
 323           (message "vc-state1 %s" (vc-state default-directory))
 324           (should (eq (vc-state default-directory)
 325                       (vc-state default-directory backend)))
 326           (should (memq (vc-state default-directory)
 327                         '(nil added unregistered up-to-date)))
 328
 329           (let ((tmp-name (expand-file-name "foo" default-directory)))
 330             ;; Check state of an empty file.
 331
 332             ;; nil: Hg Mtn SRC SVN
 333             ;; added: Git
 334             ;; unregistered: RCS SCCS
 335             ;; up-to-date: Bzr CVS
 336             (message "vc-state2 %s" (vc-state tmp-name))
 337             (should (eq (vc-state tmp-name) (vc-state tmp-name backend)))
 338             (should (memq (vc-state tmp-name)
 339                           '(nil added unregistered up-to-date)))
 340
 341             ;; Write a new file.  Check state.
 342             (write-region "foo" nil tmp-name nil 'nomessage)
 343
 344             ;; nil: Mtn
 345             ;; added: Git
 346             ;; unregistered: Hg RCS SCCS SRC SVN
 347             ;; up-to-date: Bzr CVS
 348             (message "vc-state3 %s" (vc-state tmp-name))
 349             (should (eq (vc-state tmp-name) (vc-state tmp-name backend)))
 350             (should (memq (vc-state tmp-name)
 351                           '(nil added unregistered up-to-date)))
 352
 353             ;; Register a file.  Check state.
 354             (vc-register
 355              (list backend (list (file-name-nondirectory tmp-name))))
 356
 357             ;; added: Git Mtn
 358             ;; unregistered: Hg RCS SCCS SRC SVN
 359             ;; up-to-date: Bzr CVS
 360             (message "vc-state4 %s" (vc-state tmp-name))
 361             (should (eq (vc-state tmp-name) (vc-state tmp-name backend)))
 362             (should (memq (vc-state tmp-name) '(added unregistered up-to-date)))
 363
 364             ;; Unregister the file.  Check state.
 365             (condition-case err
 366                 (progn
 367                   (vc-test--unregister-function backend tmp-name)
 368
 369                   ;; added: Git
 370                   ;; unregistered: Hg RCS
 371                   ;; unsupported: CVS Mtn SCCS SRC SVN
 372                   ;; up-to-date: Bzr
 373                   (message "vc-state5 %s" (vc-state tmp-name))
 374                   (should (eq (vc-state tmp-name) (vc-state tmp-name backend)))
 375                   (should (memq (vc-state tmp-name)
 376                                 '(added unregistered up-to-date))))
 377               (vc-not-supported (message "vc-state5 unsupported"))
 378               (t (signal (car err) (cdr err))))))
 379
 380       ;; Save exit.
 381       (ignore-errors (run-hooks 'vc-test--cleanup-hook)))))
 382
 383 (defun vc-test--working-revision (backend)
 384   "Check the working revision of a repository."
 385
 386   (let ((vc-handled-backends `(,backend))
 387         (default-directory
 388           (file-name-as-directory
 389            (expand-file-name
 390             (make-temp-name "vc-test") temporary-file-directory)))
 391         vc-test--cleanup-hook)
 392
 393     (unwind-protect
 394         (progn
 395           ;; Cleanup.
 396           (add-hook
 397            'vc-test--cleanup-hook
 398            `(lambda () (delete-directory ,default-directory 'recursive)))
 399
 400           ;; Create empty repository.  Check working revision of
 401           ;; repository, should be nil.
 402           (make-directory default-directory)
 403           (vc-test--create-repo-function backend)
 404
 405           ;; nil: CVS Git Mtn RCS SCCS
 406           ;; "0": Bzr Hg SRC SVN
 407           (message
 408            "vc-working-revision1 %s" (vc-working-revision default-directory))
 409           (should (eq (vc-working-revision default-directory)
 410                       (vc-working-revision default-directory backend)))
 411           (should (member (vc-working-revision default-directory) '(nil "0")))
 412
 413           (let ((tmp-name (expand-file-name "foo" default-directory)))
 414             ;; Check initial working revision, should be nil until
 415             ;; it's registered.
 416
 417             ;; nil: CVS Git Mtn RCS SCCS SVN
 418             ;; "0": Bzr Hg SRC
 419             (message "vc-working-revision2 %s" (vc-working-revision tmp-name))
 420             (should (eq (vc-working-revision tmp-name)
 421                         (vc-working-revision tmp-name backend)))
 422             (should (member (vc-working-revision tmp-name) '(nil "0")))
 423
 424             ;; Write a new file.  Check working revision.
 425             (write-region "foo" nil tmp-name nil 'nomessage)
 426
 427             ;; nil: CVS Git Mtn RCS SCCS SVN
 428             ;; "0": Bzr Hg SRC
 429             (message "vc-working-revision3 %s" (vc-working-revision tmp-name))
 430             (should (eq (vc-working-revision tmp-name)
 431                         (vc-working-revision tmp-name backend)))
 432             (should (member (vc-working-revision tmp-name) '(nil "0")))
 433
 434             ;; Register a file.  Check working revision.
 435             (vc-register
 436              (list backend (list (file-name-nondirectory tmp-name))))
 437
 438             ;; nil: Mtn Git
 439             ;; "0": Bzr CVS Hg SRC SVN
 440             ;; "1.1"  RCS SCCS
 441             (message "vc-working-revision4 %s" (vc-working-revision tmp-name))
 442             (should (eq (vc-working-revision tmp-name)
 443                         (vc-working-revision tmp-name backend)))
 444             (should (member (vc-working-revision tmp-name) '(nil "0" "1.1")))
 445
 446             ;; Unregister the file.  Check working revision.
 447             (condition-case err
 448                 (progn
 449                   (vc-test--unregister-function backend tmp-name)
 450
 451                   ;; nil: Git RCS
 452                   ;; "0": Bzr Hg
 453                   ;; unsupported: CVS Mtn SCCS SRC SVN
 454                   (message
 455                    "vc-working-revision5 %s" (vc-working-revision tmp-name))
 456                   (should (eq (vc-working-revision tmp-name)
 457                               (vc-working-revision tmp-name backend)))
 458                   (should (member (vc-working-revision tmp-name) '(nil "0"))))
 459               (vc-not-supported (message "vc-working-revision5 unsupported"))
 460               (t (signal (car err) (cdr err))))))
 461
 462       ;; Save exit.
 463       (ignore-errors (run-hooks 'vc-test--cleanup-hook)))))
 464
 465 (defun vc-test--checkout-model (backend)
 466   "Check the checkout model of a repository."
 467
 468   (let ((vc-handled-backends `(,backend))
 469         (default-directory
 470           (file-name-as-directory
 471            (expand-file-name
 472             (make-temp-name "vc-test") temporary-file-directory)))
 473         vc-test--cleanup-hook)
 474
 475     (unwind-protect
 476         (progn
 477           ;; Cleanup.
 478           (add-hook
 479            'vc-test--cleanup-hook
 480            `(lambda () (delete-directory ,default-directory 'recursive)))
 481
 482           ;; Create empty repository.  Check repository checkout model.
 483           (make-directory default-directory)
 484           (vc-test--create-repo-function backend)
 485
 486           ;; Surprisingly, none of the backends returns 'announce.
 487           ;; nil: RCS
 488           ;; implicit: Bzr CVS Git Hg Mtn SRC SVN
 489           ;; locking: SCCS
 490           (message
 491            "vc-checkout-model1 %s"
 492            (vc-checkout-model backend default-directory))
 493           (should (memq (vc-checkout-model backend default-directory)
 494                         '(announce implicit locking)))
 495
 496           (let ((tmp-name (expand-file-name "foo" default-directory)))
 497             ;; Check checkout model of an empty file.
 498
 499             ;; nil: RCS
 500             ;; implicit: Bzr CVS Git Hg Mtn SRC SVN
 501             ;; locking: SCCS
 502             (message
 503              "vc-checkout-model2 %s" (vc-checkout-model backend tmp-name))
 504             (should (memq (vc-checkout-model backend tmp-name)
 505                           '(announce implicit locking)))
 506
 507             ;; Write a new file.  Check checkout model.
 508             (write-region "foo" nil tmp-name nil 'nomessage)
 509
 510             ;; nil: RCS
 511             ;; implicit: Bzr CVS Git Hg Mtn SRC SVN
 512             ;; locking: SCCS
 513             (message
 514              "vc-checkout-model3 %s" (vc-checkout-model backend tmp-name))
 515             (should (memq (vc-checkout-model backend tmp-name)
 516                           '(announce implicit locking)))
 517
 518             ;; Register a file.  Check checkout model.
 519             (vc-register
 520              (list backend (list (file-name-nondirectory tmp-name))))
 521
 522             ;; nil: RCS
 523             ;; implicit: Bzr CVS Git Hg Mtn SRC SVN
 524             ;; locking: SCCS
 525             (message
 526              "vc-checkout-model4 %s" (vc-checkout-model backend tmp-name))
 527             (should (memq (vc-checkout-model backend tmp-name)
 528                           '(announce implicit locking)))
 529
 530             ;; Unregister the file.  Check checkout model.
 531             (condition-case err
 532                 (progn
 533                   (vc-test--unregister-function backend tmp-name)
 534
 535                   ;; nil: RCS
 536                   ;; implicit: Bzr Git Hg
 537                   ;; unsupported: CVS Mtn SCCS SRC SVN
 538                   (message
 539                    "vc-checkout-model5 %s" (vc-checkout-model backend tmp-name))
 540                   (should (memq (vc-checkout-model backend tmp-name)
 541                                 '(announce implicit locking))))
 542               (vc-not-supported (message "vc-checkout-model5 unsupported"))
 543               (t (signal (car err) (cdr err))))))
 544
 545       ;; Save exit.
 546       (ignore-errors (run-hooks 'vc-test--cleanup-hook)))))
 547
 548 ;; Create the test cases.
 549
 550 (defun vc-test--rcs-enabled ()
 551   (executable-find "rcs"))
 552
 553 (defun vc-test--cvs-enabled ()
 554   (executable-find "cvs"))
 555
 556 (defvar vc-svn-program)
 557 (defun vc-test--svn-enabled ()
 558   (executable-find vc-svn-program))
 559
 560 (defun vc-test--sccs-enabled ()
 561   (executable-find "sccs"))
 562
 563 (defvar vc-src-program)
 564 (defun vc-test--src-enabled ()
 565   (executable-find vc-src-program))
 566
 567 (defvar vc-bzr-program)
 568 (defun vc-test--bzr-enabled ()
 569   (executable-find vc-bzr-program))
 570
 571 (defvar vc-git-program)
 572 (defun vc-test--git-enabled ()
 573   (executable-find vc-git-program))
 574
 575 (defvar vc-hg-program)
 576 (defun vc-test--hg-enabled ()
 577   (executable-find vc-hg-program))
 578
 579 (defvar vc-mtn-program)
 580 (defun vc-test--mtn-enabled ()
 581   (executable-find vc-mtn-program))
 582
 583 ;; Obsoleted.
 584 (defvar vc-arch-program)
 585 (defun vc-test--arch-enabled ()
 586   (executable-find vc-arch-program))
 587
 588 ;; Create the test cases.
 589 (dolist (backend vc-handled-backends)
 590   (let ((backend-string (downcase (symbol-name backend))))
 591     (require (intern (format "vc-%s" backend-string)))
 592     (eval
 593      ;; Check, whether the backend is supported.
 594      `(when (funcall ',(intern (format "vc-test--%s-enabled" backend-string)))
 595
 596         (ert-deftest
 597             ,(intern (format "vc-test-%s00-create-repo" backend-string)) ()
 598           ,(format "Check `vc-create-repo' for the %s backend."
 599                    backend-string)
 600           (vc-test--create-repo ',backend))
 601
 602         (ert-deftest
 603             ,(intern (format "vc-test-%s01-register" backend-string)) ()
 604           ,(format
 605             "Check `vc-register' and `vc-registered' for the %s backend."
 606             backend-string)
 607           (skip-unless
 608            (ert-test-passed-p
 609             (ert-test-most-recent-result
 610              (ert-get-test
 611               ',(intern
 612                  (format "vc-test-%s00-create-repo" backend-string))))))
 613           (vc-test--register ',backend))
 614
 615         (ert-deftest
 616             ,(intern (format "vc-test-%s02-state" backend-string)) ()
 617           ,(format "Check `vc-state' for the %s backend." backend-string)
 618           ;; FIXME make this pass.
 619           :expected-result ,(if (equal backend 'SRC) :failed :passed)
 620           (skip-unless
 621            (ert-test-passed-p
 622             (ert-test-most-recent-result
 623              (ert-get-test
 624               ',(intern
 625                  (format "vc-test-%s01-register" backend-string))))))
 626           (vc-test--state ',backend))
 627
 628         (ert-deftest
 629             ,(intern (format "vc-test-%s03-working-revision" backend-string)) ()
 630           ,(format "Check `vc-working-revision' for the %s backend."
 631                    backend-string)
 632           (skip-unless
 633            (ert-test-passed-p
 634             (ert-test-most-recent-result
 635              (ert-get-test
 636               ',(intern
 637                  (format "vc-test-%s01-register" backend-string))))))
 638           (vc-test--working-revision ',backend))
 639
 640         (ert-deftest
 641             ,(intern (format "vc-test-%s04-checkout-model" backend-string)) ()
 642           ,(format "Check `vc-checkout-model' for the %s backend."
 643                    backend-string)
 644           ;; FIXME make this pass.
 645           :expected-result ,(if (equal backend 'RCS) :failed :passed)
 646           (skip-unless
 647            (ert-test-passed-p
 648             (ert-test-most-recent-result
 649              (ert-get-test
 650               ',(intern
 651                  (format "vc-test-%s01-register" backend-string))))))
 652           (vc-test--checkout-model ',backend))))))
 653
 654 (provide 'vc-tests)
 655 ;;; vc-tests.el ends here