[Emacs-diffs] master 9ff164a: * automated/vc-tests.el (vc-test--revision-granularity-function):

[Michael Albinus]

branch: master
commit 9ff164ac6fb3a7a3551679f75e95b306c24fdf33
Author: Michael Albinus <address@hidden>
Commit: Michael Albinus <address@hidden>

    * automated/vc-tests.el (vc-test--revision-granularity-function):
    New defun.
    (vc-test--create-repo-function): Rename from
    `vc-test--create-repo-if-not-supported'.  Adapt all callees.
    (vc-test--create-repo): Check also for revision-granularity.
    (vc-test--unregister-function): Additional argument FILE.  Adapt
    all callees.
    (vc-test--working-revision): New defun.
    (vc-test-*-working-revision): New tests.
---
 test/ChangeLog             |   12 +++++
 test/automated/vc-tests.el |  114 ++++++++++++++++++++++++++++++++++---------
 2 files changed, 102 insertions(+), 24 deletions(-)

diff --git a/test/ChangeLog b/test/ChangeLog
index 8b7b74d..c4ff2c7 100644
--- a/test/ChangeLog
+++ b/test/ChangeLog
@@ -1,3 +1,15 @@
+2014-12-11  Michael Albinus  <address@hidden>
+
+       * automated/vc-tests.el (vc-test--revision-granularity-function):
+       New defun.
+       (vc-test--create-repo-function): Rename from
+       `vc-test--create-repo-if-not-supported'.  Adapt all callees.
+       (vc-test--create-repo): Check also for revision-granularity.
+       (vc-test--unregister-function): Additional argument FILE.  Adapt
+       all callees.
+       (vc-test--working-revision): New defun.
+       (vc-test-*-working-revision): New tests.
+
 2014-12-10  Michael Albinus  <address@hidden>
 
        * automated/vc-tests.el (vc-test--register): Check, that the file
diff --git a/test/automated/vc-tests.el b/test/automated/vc-tests.el
index d0f2dc7..32cf0dd 100644
--- a/test/automated/vc-tests.el
+++ b/test/automated/vc-tests.el
@@ -115,8 +115,13 @@
   "Functions for cleanup at the end of an ert test.
 Don't set it globally, the functions shall be let-bound.")
 
-(defun vc-test--create-repo-if-not-supported (backend)
-  "Create a local repository for backends which don't support 
`vc-create-repo'."
+(defun vc-test--revision-granularity-function (backend)
+  "Run the `vc-revision-granularity' backend function."
+  (funcall (intern (downcase (format "vc-%s-revision-granularity" backend)))))
+
+(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)
@@ -152,7 +157,7 @@ Don't set it globally, the functions shall be let-bound.")
       (shell-command-to-string
        (format "mtn --db=%s --branch=foo setup ." archive-name))))
 
-   (t (signal 'vc-not-supported (list 'create-repo backend)))))
+   (t (vc-create-repo backend))))
 
 (defun vc-test--create-repo (backend)
   "Create a test repository in `default-directory', a temporary directory."
@@ -171,23 +176,27 @@ Don't set it globally, the functions shall be let-bound.")
           'vc-test--cleanup-hook
           `(lambda () (delete-directory ,default-directory '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))
-         (condition-case err
-             (vc-create-repo backend)
-           ;; CVS, Mtn and Arch need special handling.
-           (vc-not-supported (vc-test--create-repo-if-not-supported backend))))
+         (vc-test--create-repo-function backend))
 
       ;; Save exit.
       (ignore-errors (run-hooks 'vc-test--cleanup-hook)))))
 
-(defun vc-test--unregister-function (backend)
-  "Return the `vc-unregister' backend function."
+;; Why isn't there `vc-unregister'?
+(defun vc-test--unregister-function (backend file)
+  "Run the `vc-unregister' backend function.
+For backends which dont support it, `vc-not-supported' is signalled."
 
   (let ((symbol (intern (downcase (format "vc-%s-unregister" backend)))))
     (if (functionp symbol)
-       symbol
+       (funcall symbol file)
+      ;; CVS, SVN, SCCS, SRC and Mtn are not supported.
       (signal 'vc-not-supported (list 'unregister backend)))))
 
 (defun vc-test--register (backend)
@@ -209,10 +218,7 @@ Don't set it globally, the functions shall be let-bound.")
 
          ;; Create empty repository.
          (make-directory default-directory)
-         (condition-case err
-             (vc-create-repo backend)
-           ;; CVS, Mtn and Arch need special handling.
-           (vc-not-supported (vc-test--create-repo-if-not-supported backend)))
+         (vc-test--create-repo-function backend)
 
          (let ((tmp-name1 (expand-file-name "foo" default-directory))
                (tmp-name2 "bla"))
@@ -230,12 +236,12 @@ Don't set it globally, the functions shall be let-bound.")
            (should (file-exists-p tmp-name2))
            (should (vc-registered tmp-name2))
 
-           ;; Unregister the files.  Why isn't there `vc-unregister'?
+           ;; Unregister the files.
            (condition-case err
                (progn
-                 (funcall (vc-test--unregister-function backend) tmp-name1)
+                 (vc-test--unregister-function backend tmp-name1)
                  (should-not (vc-registered tmp-name1))
-                 (funcall (vc-test--unregister-function backend) tmp-name2)
+                 (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))))
@@ -266,10 +272,7 @@ Don't set it globally, the functions shall be let-bound.")
 
          ;; Create empty repository.
          (make-directory default-directory)
-         (condition-case err
-             (vc-create-repo backend)
-           ;; CVS, Mtn and Arch need special handling.
-           (vc-not-supported (vc-test--create-repo-if-not-supported backend)))
+         (vc-test--create-repo-function backend)
 
          (message "%s" (vc-state default-directory backend))
          ;(should (eq (vc-state default-directory backend) 'up-to-date))
@@ -293,10 +296,62 @@ Don't set it globally, the functions shall be let-bound.")
            ;; Unregister the file.  Check for state.
            (condition-case nil
                (progn
-                 (funcall (vc-test--unregister-function backend) tmp-name)
+                 (vc-test--unregister-function backend tmp-name)
                  (message "%s" (vc-state tmp-name backend))
                  );(should (eq (vc-state tmp-name backend) 'unregistered)))
-             ;; CVS, SVN, SCCS, SRC and Mtn are not supported.
+             (vc-not-supported (message "%s" 'unsupported)))))
+
+      ;; Save exit.
+      (ignore-errors (run-hooks 'vc-test--cleanup-hook)))))
+
+(defun vc-test--working-revision (backend)
+  "Check the working revision 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 errors)
+
+    (unwind-protect
+       (progn
+         ;; Cleanup.
+         (add-hook
+          'vc-test--cleanup-hook
+          `(lambda () (delete-directory ,default-directory 'recursive)))
+
+         ;; Create empty repository.
+         (make-directory default-directory)
+         (vc-test--create-repo-function backend)
+
+         (should
+          (member
+           (vc-working-revision default-directory backend) '("0" "master")))
+
+         (let ((tmp-name (expand-file-name "foo" default-directory)))
+           ;; Check for initial state.
+           (should
+            (member (vc-working-revision tmp-name backend) '("0" "master")))
+
+           ;; Write a new file.  Check for state.
+           (write-region "foo" nil tmp-name nil 'nomessage)
+           (should
+            (member (vc-working-revision tmp-name backend) '("0" "master")))
+
+           ;; Register a file.  Check for state.
+           (vc-register
+            (list backend (list (file-name-nondirectory tmp-name))))
+           (should
+            (member (vc-working-revision tmp-name backend) '("0" "master")))
+
+           ;; Unregister the file.  Check for working-revision.
+           (condition-case nil
+               (progn
+                 (vc-test--unregister-function backend tmp-name)
+                 (should
+                  (member
+                   (vc-working-revision tmp-name backend) '("0" "master"))))
              (vc-not-supported (message "%s" 'unsupported)))))
 
       ;; Save exit.
@@ -383,7 +438,18 @@ Don't set it globally, the functions shall be let-bound.")
               (ert-get-test
                ',(intern
                   (format "vc-test-%s01-register" backend-string))))))
-           (vc-test--state ',backend)))))))
+           (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)))))))
 
 (provide 'vc-tests)
 ;;; vc-tests.el ends here