From 9ff164ac6fb3a7a3551679f75e95b306c24fdf33 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Thu, 11 Dec 2014 13:01:45 +0100 Subject: [PATCH] * 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 8b7b74d43bd..c4ff2c70147 100644 --- a/test/ChangeLog +++ b/test/ChangeLog @@ -1,3 +1,15 @@ +2014-12-11 Michael Albinus + + * 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 * 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 d0f2dc7f989..32cf0ddd8be 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 -- 2.39.2