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 (declare-function w32-application-type "w32proc")
 113
 114 ;; The working horses.
 115
 116 (defvar vc-test--cleanup-hook nil
 117   "Functions for cleanup at the end of an ert test.
 118 Don't set it globally, the functions shall be let-bound.")
 119
 120 (defun vc-test--revision-granularity-function (backend)
 121   "Run the `vc-revision-granularity' backend function."
 122   (vc-call-backend backend 'revision-granularity))
 123
 124 (defun vc-test--create-repo-function (backend)
 125   "Run the `vc-create-repo' backend function.
 126 For backends which dont support it, it is emulated."
 127
 128   (cond
 129    ((eq backend 'CVS)
 130     (let ((tmp-dir
 131            (expand-file-name
 132             (make-temp-name "vc-test") temporary-file-directory)))
 133       (make-directory (expand-file-name "module" tmp-dir) 'parents)
 134       (make-directory (expand-file-name "CVSROOT" tmp-dir) 'parents)
 135       (if (not (fboundp 'w32-application-type))
 136           (shell-command-to-string (format "cvs -Q -d:local:%s co module"
 137                                            tmp-dir))
 138         (let ((cvs-prog (executable-find "cvs"))
 139               (tdir tmp-dir))
 140           ;; If CVS executable is an MSYS program, reformat the file
 141           ;; name of TMP-DIR to have the /d/foo/bar form supported by
 142           ;; MSYS programs.  (FIXME: What about Cygwin cvs.exe?)
 143           (if (eq (w32-application-type cvs-prog) 'msys)
 144               (setq tdir
 145                     (concat "/" (substring tmp-dir 0 1) (substring tmp-dir 2))))
 146           (shell-command-to-string (format "cvs -Q -d:local:%s co module"
 147                                            tdir))))
 148       (rename-file "module/CVS" default-directory)
 149       (delete-directory "module" 'recursive)
 150       ;; We must cleanup the "remote" CVS repo as well.
 151       (add-hook 'vc-test--cleanup-hook
 152                 `(lambda () (delete-directory ,tmp-dir 'recursive)))))
 153
 154    ((eq backend 'Arch)
 155     (let ((archive-name (format "%s--%s" user-mail-address (random))))
 156       (when (string-match
 157              "no arch user id set" (shell-command-to-string "tla my-id"))
 158         (shell-command-to-string
 159          (format "tla my-id \"<%s>\"" user-mail-address)))
 160       (shell-command-to-string
 161        (format "tla make-archive %s %s" archive-name default-directory))
 162       (shell-command-to-string
 163        (format "tla my-default-archive %s" archive-name))))
 164
 165    ((eq backend 'Mtn)
 166     (let ((archive-name "foo.mtn"))
 167       (shell-command-to-string
 168        (format
 169         "mtn db init --db=%s"
 170         (expand-file-name archive-name default-directory)))
 171       (shell-command-to-string
 172        (format "mtn --db=%s --branch=foo setup ." archive-name))))
 173
 174    (t (vc-create-repo backend))))
 175
 176 (defun vc-test--create-repo (backend)
 177   "Create a test repository in `default-directory', a temporary directory."
 178
 179   (let ((vc-handled-backends `(,backend))
 180         (default-directory
 181           (file-name-as-directory
 182            (expand-file-name
 183             (make-temp-name "vc-test") temporary-file-directory)))
 184         vc-test--cleanup-hook)
 185
 186     (unwind-protect
 187         (progn
 188           ;; Cleanup.
 189           (add-hook
 190            'vc-test--cleanup-hook
 191            `(lambda () (delete-directory ,default-directory 'recursive)))
 192
 193           ;; Check the revision granularity.
 194           (should (memq (vc-test--revision-granularity-function backend)
 195                         '(file repository)))
 196
 197           ;; Create empty repository.
 198           (make-directory default-directory)
 199           (should (file-directory-p default-directory))
 200           (vc-test--create-repo-function backend)
 201           (should (eq (vc-responsible-backend default-directory) backend)))
 202
 203       ;; Save exit.
 204       (ignore-errors (run-hooks 'vc-test--cleanup-hook)))))
 205
 206 ;; FIXME: Why isn't there `vc-unregister'?
 207 (defun vc-test--unregister-function (backend file)
 208   "Run the `vc-unregister' backend function.
 209 For backends which don't support it, `vc-not-supported' is signalled."
 210   ;; CVS, SVN, SCCS, SRC and Mtn are not supported, and will signal
 211   ;; `vc-not-supported'.
 212   (prog1
 213       (vc-call-backend backend 'unregister file)
 214     (vc-file-clearprops file)))
 215
 216 (defmacro vc-test--run-maybe-unsupported-function (func &rest args)
 217   "Run FUNC withs ARGS as arguments.
 218 Catch the `vc-not-supported' error."
 219   `(let (err)
 220     (condition-case err
 221         (funcall ,func ,@args)
 222       (vc-not-supported 'vc-not-supported)
 223       (t (signal (car err) (cdr err))))))
 224
 225 (defun vc-test--register (backend)
 226   "Register and unregister a file.
 227 This checks also `vc-backend' and `vc-responsible-backend'."
 228
 229   (let ((vc-handled-backends `(,backend))
 230         (default-directory
 231           (file-name-as-directory
 232            (expand-file-name
 233             (make-temp-name "vc-test") temporary-file-directory)))
 234         vc-test--cleanup-hook)
 235
 236     (unwind-protect
 237         (progn
 238           ;; Cleanup.
 239           (add-hook
 240            'vc-test--cleanup-hook
 241            `(lambda () (delete-directory ,default-directory 'recursive)))
 242
 243           ;; Create empty repository.
 244           (make-directory default-directory)
 245           (vc-test--create-repo-function backend)
 246           ;; For file oriented backends CVS, RCS and SVN the backend is
 247           ;; returned, and the directory is registered already.
 248           (should (if (vc-backend default-directory)
 249                       (vc-registered default-directory)
 250                     (not (vc-registered default-directory))))
 251           (should (eq (vc-responsible-backend default-directory) backend))
 252
 253           (let ((tmp-name1 (expand-file-name "foo" default-directory))
 254                 (tmp-name2 "bla"))
 255             ;; Register files.  Check for it.
 256             (write-region "foo" nil tmp-name1 nil 'nomessage)
 257             (should (file-exists-p tmp-name1))
 258             (should-not (vc-backend tmp-name1))
 259             (should (eq (vc-responsible-backend tmp-name1) backend))
 260             (should-not (vc-registered tmp-name1))
 261
 262             (write-region "bla" nil tmp-name2 nil 'nomessage)
 263             (should (file-exists-p tmp-name2))
 264             (should-not (vc-backend tmp-name2))
 265             (should (eq (vc-responsible-backend tmp-name2) backend))
 266             (should-not (vc-registered tmp-name2))
 267
 268             (vc-register (list backend (list tmp-name1 tmp-name2)))
 269             (should (file-exists-p tmp-name1))
 270             (should (eq (vc-backend tmp-name1) backend))
 271             (should (eq (vc-responsible-backend tmp-name1) backend))
 272             (should (vc-registered tmp-name1))
 273
 274             (should (file-exists-p tmp-name2))
 275             (should (eq (vc-backend tmp-name2) backend))
 276             (should (eq (vc-responsible-backend tmp-name2) backend))
 277             (should (vc-registered tmp-name2))
 278
 279             ;; `vc-backend' accepts also a list of files,
 280             ;; `vc-responsible-backend' doesn't.
 281             (should (vc-backend (list tmp-name1 tmp-name2)))
 282
 283             ;; Unregister the files.
 284             (unless (eq (vc-test--run-maybe-unsupported-function
 285                          'vc-test--unregister-function backend tmp-name1)
 286                         'vc-not-supported)
 287               (should-not (vc-backend tmp-name1))
 288               (should-not (vc-registered tmp-name1)))
 289             (unless (eq (vc-test--run-maybe-unsupported-function
 290                          'vc-test--unregister-function backend tmp-name2)
 291                         'vc-not-supported)
 292               (should-not (vc-backend tmp-name2))
 293               (should-not (vc-registered tmp-name2)))
 294
 295             ;; The files shall still exist.
 296             (should (file-exists-p tmp-name1))
 297             (should (file-exists-p tmp-name2))))
 298
 299       ;; Save exit.
 300       (ignore-errors (run-hooks 'vc-test--cleanup-hook)))))
 301
 302 (defun vc-test--state (backend)
 303   "Check the different states of a file."
 304
 305   (let ((vc-handled-backends `(,backend))
 306         (default-directory
 307           (file-name-as-directory
 308            (expand-file-name
 309             (make-temp-name "vc-test") temporary-file-directory)))
 310         vc-test--cleanup-hook)
 311
 312     (unwind-protect
 313         (progn
 314           ;; Cleanup.
 315           (add-hook
 316            'vc-test--cleanup-hook
 317            `(lambda () (delete-directory ,default-directory 'recursive)))
 318
 319           ;; Create empty repository.  Check repository state.
 320           (make-directory default-directory)
 321           (vc-test--create-repo-function backend)
 322
 323           ;; FIXME: The state shall be unregistered only.
 324           ;; nil: RCS
 325           ;; unregistered: Bzr CVS Git Hg Mtn SCCS SRC
 326           ;; up-to-date: SVN
 327           (message "vc-state1 %s" (vc-state default-directory))
 328           (should (eq (vc-state default-directory)
 329                       (vc-state default-directory backend)))
 330           (should (memq (vc-state default-directory)
 331                         '(nil unregistered up-to-date)))
 332
 333           (let ((tmp-name (expand-file-name "foo" default-directory)))
 334             ;; Check state of a nonexistent file.
 335
 336             ;; unregistered: Bzr CVS Git Hg Mtn RCS SCCS SRC SVN
 337             (message "vc-state2 %s" (vc-state tmp-name))
 338             (should (eq (vc-state tmp-name) (vc-state tmp-name backend)))
 339             (should (eq (vc-state tmp-name) 'unregistered))
 340
 341             ;; Write a new file.  Check state.
 342             (write-region "foo" nil tmp-name nil 'nomessage)
 343
 344             ;; unregistered: Bzr CVS Git Hg Mtn RCS SCCS SRC SVN
 345             (message "vc-state3 %s" (vc-state tmp-name))
 346             (should (eq (vc-state tmp-name) (vc-state tmp-name backend)))
 347             (should (eq (vc-state tmp-name) 'unregistered))
 348
 349             ;; Register a file.  Check state.
 350             (vc-register
 351              (list backend (list (file-name-nondirectory tmp-name))))
 352
 353             ;; FIXME: nil seems to be wrong.
 354             ;; nil: SRC
 355             ;; added: Bzr CVS Git Hg Mtn SVN
 356             ;; up-to-date: RCS SCCS
 357             (message "vc-state4 %s" (vc-state tmp-name))
 358             (should (eq (vc-state tmp-name) (vc-state tmp-name backend)))
 359             (should (memq (vc-state tmp-name) '(nil added up-to-date)))
 360
 361             ;; Unregister the file.  Check state.
 362             (if (eq (vc-test--run-maybe-unsupported-function
 363                      'vc-test--unregister-function backend tmp-name)
 364                     'vc-not-supported)
 365                 (message "vc-state5 unsupported")
 366               ;; unregistered: Bzr Git Hg RCS
 367               ;; unsupported: CVS Mtn SCCS SRC SVN
 368               (message "vc-state5 %s" (vc-state tmp-name))
 369               (should (eq (vc-state tmp-name) (vc-state tmp-name backend)))
 370               (should (memq (vc-state tmp-name) '(unregistered))))))
 371
 372       ;; Save exit.
 373       (ignore-errors (run-hooks 'vc-test--cleanup-hook)))))
 374
 375 (defun vc-test--working-revision (backend)
 376   "Check the working revision of a repository."
 377
 378   (let ((vc-handled-backends `(,backend))
 379         (default-directory
 380           (file-name-as-directory
 381            (expand-file-name
 382             (make-temp-name "vc-test") temporary-file-directory)))
 383         vc-test--cleanup-hook)
 384
 385     (unwind-protect
 386         (progn
 387           ;; Cleanup.
 388           (add-hook
 389            'vc-test--cleanup-hook
 390            `(lambda () (delete-directory ,default-directory 'recursive)))
 391
 392           ;; Create empty repository.  Check working revision of
 393           ;; repository, should be nil.
 394           (make-directory default-directory)
 395           (vc-test--create-repo-function backend)
 396
 397           ;; FIXME: Is the value for SVN correct?
 398           ;; nil: Bzr CVS Git Hg Mtn RCS SCCS SRC
 399           ;; "0": SVN
 400           (message
 401            "vc-working-revision1 %s" (vc-working-revision default-directory))
 402           (should (eq (vc-working-revision default-directory)
 403                       (vc-working-revision default-directory backend)))
 404           (should (member (vc-working-revision default-directory) '(nil "0")))
 405
 406           (let ((tmp-name (expand-file-name "foo" default-directory)))
 407             ;; Check initial working revision, should be nil until
 408             ;; it's registered.
 409
 410             ;; nil: Bzr CVS Git Hg Mtn RCS SCCS SRC SVN
 411             (message "vc-working-revision2 %s" (vc-working-revision tmp-name))
 412             (should (eq (vc-working-revision tmp-name)
 413                         (vc-working-revision tmp-name backend)))
 414             (should-not (vc-working-revision tmp-name))
 415
 416             ;; Write a new file.  Check working revision.
 417             (write-region "foo" nil tmp-name nil 'nomessage)
 418
 419             ;; nil: Bzr CVS Git Hg Mtn RCS SCCS SRC SVN
 420             (message "vc-working-revision3 %s" (vc-working-revision tmp-name))
 421             (should (eq (vc-working-revision tmp-name)
 422                         (vc-working-revision tmp-name backend)))
 423             (should-not (vc-working-revision tmp-name))
 424
 425             ;; Register a file.  Check working revision.
 426             (vc-register
 427              (list backend (list (file-name-nondirectory tmp-name))))
 428
 429             ;; FIXME: nil doesn't seem to be proper.
 430             ;; nil: Git Mtn
 431             ;; "0": Bzr CVS Hg SRC SVN
 432             ;; "1.1": RCS SCCS
 433             (message "vc-working-revision4 %s" (vc-working-revision tmp-name))
 434             (should (eq (vc-working-revision tmp-name)
 435                         (vc-working-revision tmp-name backend)))
 436             (should (member (vc-working-revision tmp-name) '(nil "0" "1.1")))
 437
 438             ;; Unregister the file.  Check working revision.
 439             (if (eq (vc-test--run-maybe-unsupported-function
 440                      'vc-test--unregister-function backend tmp-name)
 441                     'vc-not-supported)
 442                 (message "vc-working-revision5 unsupported")
 443               ;; nil: Bzr Git Hg RCS
 444               ;; unsupported: CVS Mtn SCCS SRC SVN
 445               (message "vc-working-revision5 %s" (vc-working-revision tmp-name))
 446               (should (eq (vc-working-revision tmp-name)
 447                           (vc-working-revision tmp-name backend)))
 448               (should-not (vc-working-revision tmp-name)))))
 449
 450       ;; Save exit.
 451       (ignore-errors (run-hooks 'vc-test--cleanup-hook)))))
 452
 453 (defun vc-test--checkout-model (backend)
 454   "Check the checkout model of a repository."
 455
 456   (let ((vc-handled-backends `(,backend))
 457         (default-directory
 458           (file-name-as-directory
 459            (expand-file-name
 460             (make-temp-name "vc-test") temporary-file-directory)))
 461         vc-test--cleanup-hook)
 462
 463     (unwind-protect
 464         (progn
 465           ;; Cleanup.
 466           (add-hook
 467            'vc-test--cleanup-hook
 468            `(lambda () (delete-directory ,default-directory 'recursive)))
 469
 470           ;; Create empty repository.  Check repository checkout model.
 471           (make-directory default-directory)
 472           (vc-test--create-repo-function backend)
 473
 474           ;; Surprisingly, none of the backends returns 'announce.
 475           ;; implicit: Bzr CVS Git Hg Mtn SRC SVN
 476           ;; locking: RCS SCCS
 477           (message
 478            "vc-checkout-model1 %s"
 479            (vc-checkout-model backend default-directory))
 480           (should (memq (vc-checkout-model backend default-directory)
 481                         '(announce implicit locking)))
 482
 483           (let ((tmp-name (expand-file-name "foo" default-directory)))
 484             ;; Check checkout model of a nonexistent file.
 485
 486             ;; implicit: Bzr CVS Git Hg Mtn SRC SVN
 487             ;; locking: RCS SCCS
 488             (message
 489              "vc-checkout-model2 %s" (vc-checkout-model backend tmp-name))
 490             (should (memq (vc-checkout-model backend tmp-name)
 491                           '(announce implicit locking)))
 492
 493             ;; Write a new file.  Check checkout model.
 494             (write-region "foo" nil tmp-name nil 'nomessage)
 495
 496             ;; implicit: Bzr CVS Git Hg Mtn SRC SVN
 497             ;; locking: RCS SCCS
 498             (message
 499              "vc-checkout-model3 %s" (vc-checkout-model backend tmp-name))
 500             (should (memq (vc-checkout-model backend tmp-name)
 501                           '(announce implicit locking)))
 502
 503             ;; Register a file.  Check checkout model.
 504             (vc-register
 505              (list backend (list (file-name-nondirectory tmp-name))))
 506
 507             ;; implicit: Bzr CVS Git Hg Mtn SRC SVN
 508             ;; locking: RCS SCCS
 509             (message
 510              "vc-checkout-model4 %s" (vc-checkout-model backend tmp-name))
 511             (should (memq (vc-checkout-model backend tmp-name)
 512                           '(announce implicit locking)))
 513
 514             ;; Unregister the file.  Check checkout model.
 515             (if (eq (vc-test--run-maybe-unsupported-function
 516                      'vc-test--unregister-function backend tmp-name)
 517                     'vc-not-supported)
 518                 (message "vc-checkout-model5 unsupported")
 519               ;; implicit: Bzr Git Hg
 520               ;; locking: RCS
 521               ;; unsupported: CVS Mtn SCCS SRC SVN
 522               (message
 523                "vc-checkout-model5 %s" (vc-checkout-model backend tmp-name))
 524               (should (memq (vc-checkout-model backend tmp-name)
 525                             '(announce implicit locking))))))
 526
 527       ;; Save exit.
 528       (ignore-errors (run-hooks 'vc-test--cleanup-hook)))))
 529
 530 ;; Create the test cases.
 531
 532 (defun vc-test--rcs-enabled ()
 533   (executable-find "rcs"))
 534
 535 (defun vc-test--cvs-enabled ()
 536   (executable-find "cvs"))
 537
 538 (defvar vc-svn-program)
 539 (defun vc-test--svn-enabled ()
 540   (executable-find vc-svn-program))
 541
 542 (defun vc-test--sccs-enabled ()
 543   (executable-find "sccs"))
 544
 545 (defvar vc-src-program)
 546 (defun vc-test--src-enabled ()
 547   (executable-find vc-src-program))
 548
 549 (defvar vc-bzr-program)
 550 (defun vc-test--bzr-enabled ()
 551   (executable-find vc-bzr-program))
 552
 553 (defvar vc-git-program)
 554 (defun vc-test--git-enabled ()
 555   (executable-find vc-git-program))
 556
 557 (defvar vc-hg-program)
 558 (defun vc-test--hg-enabled ()
 559   (executable-find vc-hg-program))
 560
 561 (defvar vc-mtn-program)
 562 (defun vc-test--mtn-enabled ()
 563   (executable-find vc-mtn-program))
 564
 565 ;; Obsoleted.
 566 (defvar vc-arch-program)
 567 (defun vc-test--arch-enabled ()
 568   (executable-find vc-arch-program))
 569
 570 ;; Create the test cases.
 571 (dolist (backend vc-handled-backends)
 572   (let ((backend-string (downcase (symbol-name backend))))
 573     (require (intern (format "vc-%s" backend-string)))
 574     (eval
 575      ;; Check, whether the backend is supported.
 576      `(when (funcall ',(intern (format "vc-test--%s-enabled" backend-string)))
 577
 578         (ert-deftest
 579             ,(intern (format "vc-test-%s00-create-repo" backend-string)) ()
 580           ,(format "Check `vc-create-repo' for the %s backend."
 581                    backend-string)
 582           (vc-test--create-repo ',backend))
 583
 584         (ert-deftest
 585             ,(intern (format "vc-test-%s01-register" backend-string)) ()
 586           ,(format
 587             "Check `vc-register' and `vc-registered' for the %s backend."
 588             backend-string)
 589           (skip-unless
 590            (ert-test-passed-p
 591             (ert-test-most-recent-result
 592              (ert-get-test
 593               ',(intern
 594                  (format "vc-test-%s00-create-repo" backend-string))))))
 595           (vc-test--register ',backend))
 596
 597         (ert-deftest
 598             ,(intern (format "vc-test-%s02-state" backend-string)) ()
 599           ,(format "Check `vc-state' for the %s backend." backend-string)
 600           (skip-unless
 601            (ert-test-passed-p
 602             (ert-test-most-recent-result
 603              (ert-get-test
 604               ',(intern
 605                  (format "vc-test-%s01-register" backend-string))))))
 606           (vc-test--state ',backend))
 607
 608         (ert-deftest
 609             ,(intern (format "vc-test-%s03-working-revision" backend-string)) ()
 610           ,(format "Check `vc-working-revision' for the %s backend."
 611                    backend-string)
 612           (skip-unless
 613            (ert-test-passed-p
 614             (ert-test-most-recent-result
 615              (ert-get-test
 616               ',(intern
 617                  (format "vc-test-%s01-register" backend-string))))))
 618           (vc-test--working-revision ',backend))
 619
 620         (ert-deftest
 621             ,(intern (format "vc-test-%s04-checkout-model" backend-string)) ()
 622           ,(format "Check `vc-checkout-model' for the %s backend."
 623                    backend-string)
 624           (skip-unless
 625            (ert-test-passed-p
 626             (ert-test-most-recent-result
 627              (ert-get-test
 628               ',(intern
 629                  (format "vc-test-%s01-register" backend-string))))))
 630           (vc-test--checkout-model ',backend))))))
 631
 632 (provide 'vc-tests)
 633 ;;; vc-tests.el ends here