Extend vc-tests.el

* automated/vc-tests.el (vc-test--create-repo): Add check for
`vc-responsible-backend'.
(vc-test--register): Do not print a message when unsupported.
(vc-test--state, vc-test--working-revision): Rework.  Raise no
error in case of inconsistent result, but document everything.
(vc-test--checkout-model): New defun.
(vc-test-*-checkout-model): New tests.

2 files changed, 204 insertions, 52 deletions

diff --git a/test/ChangeLog b/test/ChangeLog
index ff3042e8cbf..cf1b2c13d7e 100644
--- a/test/ChangeLog
+++ b/test/ChangeLog
@@ -1,3 +1,13 @@
+2015-03-01  Michael Albinus  <michael.albinus@gmx.de>
+
+        * automated/vc-tests.el (vc-test--create-repo): Add check for
+        `vc-responsible-backend'.
+        (vc-test--register): Do not print a message when unsupported.
+        (vc-test--state, vc-test--working-revision): Rework.  Raise no
+        error in case of inconsistent result, but document everything.
+        (vc-test--checkout-model): New defun.
+        (vc-test-*-checkout-model): New tests.
+
 2015-02-26  Fabián Ezequiel Gallina  <fgallina@gnu.org>
 
         * automated/python-tests.el
diff --git a/test/automated/vc-tests.el b/test/automated/vc-tests.el
index 4d9aefad7fb..44f25728447 100644
--- a/test/automated/vc-tests.el
+++ b/test/automated/vc-tests.el
@@ -27,29 +27,29 @@
 
 ;; BACKEND PROPERTIES
 ;;
-;; * revision-granularity
+;; * revision-granularity                                       DONE
 
 ;; STATE-QUERYING FUNCTIONS
 ;;
-;; * registered (file)
-;; * state (file)
+;; * 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)
+;; * working-revision (file)                                    DONE
 ;; - latest-on-branch-p (file)
-;; * checkout-model (files)
+;; * checkout-model (files)                                     DONE
 ;; - mode-line-string (file)
 
 ;; STATE-CHANGING FUNCTIONS
 ;;
-;; * create-repo (backend)
-;; * register (files &optional comment)
+;; * create-repo (backend)                                      DONE
+;; * register (files &optional comment)                         DONE
 ;; - responsible-p (file)
 ;; - receive-file (file rev)
-;; - unregister (file)
+;; - unregister (file)                                          DONE
 ;; * checkin (files comment)
 ;; * find-revision (file rev buffer)
 ;; * checkout (file &optional rev)
@@ -178,12 +178,13 @@ For backends which dont support it, it is emulated."
 
           ;; Check the revision granularity.
           (should (memq (vc-test--revision-granularity-function backend)
-                 '(file repository)))
+                        '(file repository)))
 
           ;; Create empty repository.
           (make-directory default-directory)
           (should (file-directory-p default-directory))
-          (vc-test--create-repo-function backend))
+          (vc-test--create-repo-function backend)
+          (should (eq (vc-responsible-backend default-directory) backend)))
 
       ;; Save exit.
       (ignore-errors (run-hooks 'vc-test--cleanup-hook)))))
@@ -229,8 +230,7 @@ For backends which dont support it, `vc-not-supported' is signalled."
             (write-region "bla" nil tmp-name2 nil 'nomessage)
             (should (file-exists-p tmp-name2))
             (should-not (vc-registered tmp-name2))
-            (vc-register
-             (list backend (list tmp-name1 tmp-name2)))
+            (vc-register (list backend (list tmp-name1 tmp-name2)))
             (should (file-exists-p tmp-name1))
             (should (vc-registered tmp-name1))
             (should (file-exists-p tmp-name2))
@@ -244,15 +244,14 @@ For backends which dont support it, `vc-not-supported' is signalled."
                   (vc-test--unregister-function backend tmp-name2)
                   (should-not (vc-registered tmp-name2)))
               ;; CVS, SVN, SCCS, SRC and Mtn are not supported.
-              (vc-not-supported (message "%s" (error-message-string err))))
+              (vc-not-supported t))
+            ;; The files shall still exist.
             (should (file-exists-p tmp-name1))
             (should (file-exists-p tmp-name2))))
 
       ;; Save exit.
       (ignore-errors (run-hooks 'vc-test--cleanup-hook)))))
 
-;; `vc-state' returns different results for different backends.  So we
-;; don't check with `should', but print the results for analysis.
 (defun vc-test--state (backend)
   "Check the different states of a file."
 
@@ -261,7 +260,7 @@ For backends which dont support it, `vc-not-supported' is signalled."
           (file-name-as-directory
            (expand-file-name
             (make-temp-name "vc-test") temporary-file-directory)))
-        vc-test--cleanup-hook errors)
+        vc-test--cleanup-hook)
 
     (unwind-protect
         (progn
@@ -270,36 +269,64 @@ For backends which dont support it, `vc-not-supported' is signalled."
            'vc-test--cleanup-hook
            `(lambda () (delete-directory ,default-directory 'recursive)))
 
-          ;; Create empty repository.
+          ;; Create empty repository.  Check repository state.
           (make-directory default-directory)
           (vc-test--create-repo-function backend)
 
-          (message "%s" (vc-state default-directory backend))
-          ;(should (eq (vc-state default-directory backend) 'up-to-date))
+          ;; nil: Hg Mtn RCS
+          ;; added: Git
+          ;; unregistered: CVS SCCS SRC
+          ;; up-to-date: Bzr SVN
+          (should (eq (vc-state default-directory)
+                      (vc-state default-directory backend)))
+          (should (memq (vc-state default-directory)
+                        '(nil added unregistered up-to-date)))
 
           (let ((tmp-name (expand-file-name "foo" default-directory)))
-            ;; Check for initial state.
-            (message "%s" (vc-state tmp-name backend))
-            ;(should (eq (vc-state tmp-name backend) 'unregistered))
+            ;; Check state of an empty file.
 
-            ;; Write a new file.  Check for state.
+            ;; nil: Hg Mtn SRC SVN
+            ;; added: Git
+            ;; unregistered: RCS SCCS
+            ;; up-to-date: Bzr CVS
+            (should (eq (vc-state tmp-name) (vc-state tmp-name backend)))
+            (should (memq (vc-state tmp-name)
+                          '(nil added unregistered up-to-date)))
+
+            ;; Write a new file.  Check state.
             (write-region "foo" nil tmp-name nil 'nomessage)
-            (message "%s" (vc-state tmp-name backend))
-            ;(should (eq (vc-state tmp-name backend) 'unregistered))
 
-            ;; Register a file.  Check for state.
+            ;; nil: Mtn
+            ;; added: Git
+            ;; unregistered: Hg RCS SCCS SRC SVN
+            ;; up-to-date: Bzr CVS
+            (should (eq (vc-state tmp-name) (vc-state tmp-name backend)))
+            (should (memq (vc-state tmp-name)
+                          '(nil added unregistered up-to-date)))
+
+            ;; Register a file.  Check state.
             (vc-register
              (list backend (list (file-name-nondirectory tmp-name))))
-            (message "%s" (vc-state tmp-name backend))
-            ;(should (eq (vc-state tmp-name backend) 'added))
 
-            ;; Unregister the file.  Check for state.
+            ;; added: Git Mtn
+            ;; unregistered: Hg RCS SCCS SRC SVN
+            ;; up-to-date: Bzr CVS
+            (should (eq (vc-state tmp-name) (vc-state tmp-name backend)))
+            (should (memq (vc-state tmp-name) '(added unregistered up-to-date)))
+
+            ;; Unregister the file.  Check state.
             (condition-case nil
                 (progn
                   (vc-test--unregister-function backend tmp-name)
-                  (message "%s" (vc-state tmp-name backend))
-                  );(should (eq (vc-state tmp-name backend) 'unregistered)))
-              (vc-not-supported (message "%s" 'unsupported)))))
+
+                  ;; added: Git
+                  ;; unregistered: Hg
+                  ;; unsupported: CVS Mtn SCCS SRC SVN
+                  ;; up-to-date: Bzr
+                  (should (eq (vc-state tmp-name) (vc-state tmp-name backend)))
+                  (should (memq (vc-state tmp-name)
+                                '(added unregistered up-to-date))))
+              (vc-not-supported t))))
 
       ;; Save exit.
       (ignore-errors (run-hooks 'vc-test--cleanup-hook)))))
@@ -312,7 +339,7 @@ For backends which dont support it, `vc-not-supported' is signalled."
           (file-name-as-directory
            (expand-file-name
             (make-temp-name "vc-test") temporary-file-directory)))
-        vc-test--cleanup-hook errors)
+        vc-test--cleanup-hook)
 
     (unwind-protect
         (progn
@@ -321,40 +348,141 @@ For backends which dont support it, `vc-not-supported' is signalled."
            'vc-test--cleanup-hook
            `(lambda () (delete-directory ,default-directory 'recursive)))
 
-          ;; Create empty repository.
+          ;; Create empty repository.  Check working revision of
+          ;; repository, should be nil.
           (make-directory default-directory)
           (vc-test--create-repo-function backend)
 
+          ;; nil: CVS Mtn RCS SCCS
+          ;; "0": Bzr Hg SRC SVN
+          ;; "master": Git
+          (should (eq (vc-working-revision default-directory)
+                      (vc-working-revision default-directory backend)))
           (should
            (member
-            (vc-working-revision default-directory backend) '("0" "master")))
+            (vc-working-revision default-directory) '(nil "0" "master")))
 
           (let ((tmp-name (expand-file-name "foo" default-directory)))
-            ;; Check for initial state, should be nil until it's registered.
-            ;; Don't pass the backend explicitly, otherwise some
-            ;; implementations return non-nil.
-            (should (null (vc-working-revision tmp-name)))
+            ;; Check initial working revision, should be nil until
+            ;; it's registered.
+
+            ;; nil: CVS Mtn RCS SCCS SVN
+            ;; "0": Bzr Hg SRC
+            ;; "master": Git
+            (should (eq (vc-working-revision tmp-name)
+                        (vc-working-revision tmp-name backend)))
+            (should
+             (member (vc-working-revision tmp-name) '(nil "0" "master")))
 
-            ;; Write a new file.  Check state.
+            ;; Write a new file.  Check working revision.
             (write-region "foo" nil tmp-name nil 'nomessage)
-            (should (null (vc-working-revision tmp-name)))
 
-            ;; Register a file.  Check for state.
+            ;; nil: CVS Mtn RCS SCCS SVN
+            ;; "0": Bzr Hg SRC
+            ;; "master": Git
+            (should (eq (vc-working-revision tmp-name)
+                        (vc-working-revision tmp-name backend)))
+            (should
+             (member (vc-working-revision tmp-name) '(nil "0" "master")))
+
+            ;; Register a file.  Check working revision.
             (vc-register
              (list backend (list (file-name-nondirectory tmp-name))))
-            ;; FIXME: Don't pass the backend.  Emacs should be able to
-            ;; figure it out.
+
+            ;; nil: Mtn RCS SCCS
+            ;; "0": Bzr CVS Hg SRC SVN
+            ;; "master": Git
+            (should (eq (vc-working-revision tmp-name)
+                        (vc-working-revision tmp-name backend)))
             (should
-             (member (vc-working-revision tmp-name backend) '("0" "master")))
+             (member (vc-working-revision tmp-name) '(nil "0" "master")))
 
-            ;; Unregister the file.  Check for working-revision.
+            ;; Unregister the file.  Check working revision.
             (condition-case nil
                 (progn
                   (vc-test--unregister-function backend tmp-name)
+
+                  ;; nil: RCS
+                  ;; "0": Bzr Hg
+                  ;; "master": Git
+                  ;; unsupported: CVS Mtn SCCS SRC SVN
+                  (should (eq (vc-working-revision tmp-name)
+                              (vc-working-revision tmp-name backend)))
                   (should
                    (member
-                    (vc-working-revision tmp-name backend) '("0" "master"))))
-              (vc-not-supported (message "%s" 'unsupported)))))
+                    (vc-working-revision tmp-name) '(nil "0" "master"))))
+              (vc-not-supported t))))
+
+      ;; Save exit.
+      (ignore-errors (run-hooks 'vc-test--cleanup-hook)))))
+
+(defun vc-test--checkout-model (backend)
+  "Check the checkout model of a repository."
+
+  (let ((vc-handled-backends `(,backend))
+        (default-directory
+          (file-name-as-directory
+           (expand-file-name
+            (make-temp-name "vc-test") temporary-file-directory)))
+        vc-test--cleanup-hook)
+
+    (unwind-protect
+        (progn
+          ;; Cleanup.
+          (add-hook
+           'vc-test--cleanup-hook
+           `(lambda () (delete-directory ,default-directory '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.
+          ;; nil: RCS
+          ;; implicit: Bzr CVS Git Hg Mtn SRC SVN
+          ;; locking: SCCS
+          (should (memq (vc-checkout-model backend default-directory)
+                        '(announce implicit locking)))
+
+          (let ((tmp-name (expand-file-name "foo" default-directory)))
+            ;; Check checkout model of an empty file.
+
+            ;; nil: RCS
+            ;; implicit: Bzr CVS Git Hg Mtn SRC SVN
+            ;; locking: SCCS
+            (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)
+
+            ;; nil: RCS
+            ;; implicit: Bzr CVS Git Hg Mtn SRC SVN
+            ;; locking: SCCS
+            (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))))
+
+            ;; nil: RCS
+            ;; implicit: Bzr CVS Git Hg Mtn SRC SVN
+            ;; locking: SCCS
+            (should (memq (vc-checkout-model backend tmp-name)
+                          '(announce implicit locking)))
+
+            ;; Unregister the file.  Check checkout model.
+            (condition-case nil
+                (progn
+                  (vc-test--unregister-function backend tmp-name)
+
+                  ;; nil: RCS
+                  ;; implicit: Bzr Git Hg
+                  ;; unsupported: CVS Mtn SCCS SRC SVN
+                  (should (memq (vc-checkout-model backend tmp-name)
+                                '(announce implicit locking))))
+              (vc-not-supported t))))
 
       ;; Save exit.
       (ignore-errors (run-hooks 'vc-test--cleanup-hook)))))
@@ -394,11 +522,11 @@ For backends which dont support it, `vc-not-supported' is signalled."
 (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))
 
-
 ;; There are too many failed test cases yet.  We suppress them on hydra.
 (if (getenv "NIX_STORE")
     (ert-deftest vc-test ()
@@ -415,7 +543,8 @@ For backends which dont support it, `vc-not-supported' is signalled."
 
           (ert-deftest
               ,(intern (format "vc-test-%s00-create-repo" backend-string)) ()
-            ,(format "Check `vc-create-repo' for the %s backend." backend-string)
+            ,(format "Check `vc-create-repo' for the %s backend."
+                     backend-string)
             (vc-test--create-repo ',backend))
 
           (ert-deftest
@@ -444,14 +573,27 @@ For backends which dont support it, `vc-not-supported' is signalled."
 
           (ert-deftest
               ,(intern (format "vc-test-%s03-working-revision" backend-string)) ()
-            ,(format "Check `vc-working-revision' for the %s backend." 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--working-revision ',backend)))))))
+            (vc-test--checkout-model ',backend)))))))
 
 (provide 'vc-tests)
 ;;; vc-tests.el ends here