diff options
Diffstat (limited to 'test/lisp/vc')
| -rw-r--r-- | test/lisp/vc/add-log-tests.el | 4 | ||||
| -rw-r--r-- | test/lisp/vc/diff-mode-tests.el | 69 | ||||
| -rw-r--r-- | test/lisp/vc/ediff-ptch-tests.el | 60 | ||||
| -rw-r--r-- | test/lisp/vc/smerge-mode-tests.el | 2 | ||||
| -rw-r--r-- | test/lisp/vc/vc-bzr-tests.el | 174 | ||||
| -rw-r--r-- | test/lisp/vc/vc-tests.el | 802 |
6 files changed, 626 insertions, 485 deletions
diff --git a/test/lisp/vc/add-log-tests.el b/test/lisp/vc/add-log-tests.el index dc2b9961c6c..70e49fe57fe 100644 --- a/test/lisp/vc/add-log-tests.el +++ b/test/lisp/vc/add-log-tests.el @@ -29,8 +29,8 @@ content marker expected-defun) "Generate an ert test for mode-own `add-log-current-defun-function'. Run `add-log-current-defun' at the point where MARKER specifies -in a buffer which content is CONTENT under major mode MODE. Then -it compares the result with EXPECTED-DEFUN." +in a buffer which content is CONTENT under major mode MODE. +Then it compares the result with EXPECTED-DEFUN." (let ((xname (intern (concat "add-log-current-defun-test-" (symbol-name name) )))) diff --git a/test/lisp/vc/diff-mode-tests.el b/test/lisp/vc/diff-mode-tests.el index 5bc4ad6dace..909d5620de6 100644 --- a/test/lisp/vc/diff-mode-tests.el +++ b/test/lisp/vc/diff-mode-tests.el @@ -173,35 +173,33 @@ wristwatches wrongheadedly wrongheadedness youthfulness -") - (temp-dir (make-temp-file "diff-mode-test" 'dir))) - - (let ((buf (find-file-noselect (format "%s/%s" temp-dir "fil" ))) - (buf2 (find-file-noselect (format "%s/%s" temp-dir "fil2")))) - (unwind-protect - (progn - (with-current-buffer buf (insert fil_before) (save-buffer)) - (with-current-buffer buf2 (insert fil2_before) (save-buffer)) - - (with-temp-buffer - (cd temp-dir) - (insert patch) - (goto-char (point-min)) - (diff-apply-hunk) - (diff-apply-hunk) - (diff-apply-hunk)) - - (should (equal (with-current-buffer buf (buffer-string)) - fil_after)) - (should (equal (with-current-buffer buf2 (buffer-string)) - fil2_after))) - - (ignore-errors - (with-current-buffer buf (set-buffer-modified-p nil)) - (kill-buffer buf) - (with-current-buffer buf2 (set-buffer-modified-p nil)) - (kill-buffer buf2) - (delete-directory temp-dir 'recursive)))))) +")) + (ert-with-temp-directory temp-dir + (let ((buf (find-file-noselect (format "%s/%s" temp-dir "fil" ))) + (buf2 (find-file-noselect (format "%s/%s" temp-dir "fil2")))) + (unwind-protect + (progn + (with-current-buffer buf (insert fil_before) (save-buffer)) + (with-current-buffer buf2 (insert fil2_before) (save-buffer)) + + (with-temp-buffer + (cd temp-dir) + (insert patch) + (goto-char (point-min)) + (diff-apply-hunk) + (diff-apply-hunk) + (diff-apply-hunk)) + + (should (equal (with-current-buffer buf (buffer-string)) + fil_after)) + (should (equal (with-current-buffer buf2 (buffer-string)) + fil2_after))) + + (ignore-errors + (with-current-buffer buf (set-buffer-modified-p nil)) + (kill-buffer buf) + (with-current-buffer buf2 (set-buffer-modified-p nil)) + (kill-buffer buf2))))))) (ert-deftest diff-mode-test-hunk-text-no-newline () "Check output of `diff-hunk-text' with no newline at end of file." @@ -468,4 +466,17 @@ baz")))) (114 131 (diff-mode syntax face font-lock-string-face)) (134 140 (diff-mode syntax face font-lock-keyword-face)))))))) +(ert-deftest test-hunk-file-names () + (with-temp-buffer + (insert "diff -c /tmp/ange-ftp13518wvE.el /tmp/ange-ftp1351895K.el\n") + (goto-char (point-min)) + (should (equal (diff-hunk-file-names) + '("/tmp/ange-ftp1351895K.el" "/tmp/ange-ftp13518wvE.el")))) + (with-temp-buffer + (insert "diff -c -L /ftp:slbhao:/home/albinus/src/tramp/lisp/tramp.el -L /ftp:slbhao:/home/albinus/src/emacs/lisp/net/tramp.el /tmp/ange-ftp13518wvE.el /tmp/ange-ftp1351895K.el\n") + (goto-char (point-min)) + (should (equal (diff-hunk-file-names) + '("/tmp/ange-ftp1351895K.el" "/tmp/ange-ftp13518wvE.el"))))) + (provide 'diff-mode-tests) +;;; diff-mode-tests.el ends here diff --git a/test/lisp/vc/ediff-ptch-tests.el b/test/lisp/vc/ediff-ptch-tests.el index a464db2349d..0f09616a816 100644 --- a/test/lisp/vc/ediff-ptch-tests.el +++ b/test/lisp/vc/ediff-ptch-tests.el @@ -22,6 +22,7 @@ ;;; Code: (require 'ert) +(require 'ert-x) (require 'ediff-ptch) (ert-deftest ediff-ptch-test-bug25010 () @@ -45,34 +46,33 @@ index 6a07f80..6e8e947 100644 "Test for https://debbugs.gnu.org/26084 ." (skip-unless (executable-find "git")) (skip-unless (executable-find ediff-patch-program)) - (let* ((tmpdir (make-temp-file "ediff-ptch-test" t)) - (default-directory (file-name-as-directory tmpdir)) - (patch (make-temp-file "ediff-ptch-test")) - (qux (expand-file-name "qux.txt" tmpdir)) - (bar (expand-file-name "bar.txt" tmpdir)) - (git-program (executable-find "git"))) - ;; Create repository. - (with-temp-buffer - (insert "qux here\n") - (write-region nil nil qux nil 'silent) - (erase-buffer) - (insert "bar here\n") - (write-region nil nil bar nil 'silent)) - (call-process git-program nil nil nil "init") - (call-process git-program nil nil nil "add" ".") - (call-process git-program nil nil nil "commit" "-m" "Test repository.") - ;; Update repo., save the diff and reset to initial state. - (with-temp-buffer - (insert "foo here\n") - (write-region nil nil qux nil 'silent) - (write-region nil nil bar nil 'silent)) - (call-process git-program nil `(:file ,patch) nil "diff") - (call-process git-program nil nil nil "reset" "--hard" "HEAD") - ;; Visit the diff file i.e., patch; extract from it the parts - ;; affecting just each of the files: store in patch-bar the part - ;; affecting 'bar', and in patch-qux the part affecting 'qux'. - (find-file patch) - (unwind-protect + (ert-with-temp-directory tmpdir + (ert-with-temp-file patch + (let* ((default-directory (file-name-as-directory tmpdir)) + (qux (expand-file-name "qux.txt" tmpdir)) + (bar (expand-file-name "bar.txt" tmpdir)) + (git-program (executable-find "git"))) + ;; Create repository. + (with-temp-buffer + (insert "qux here\n") + (write-region nil nil qux nil 'silent) + (erase-buffer) + (insert "bar here\n") + (write-region nil nil bar nil 'silent)) + (call-process git-program nil nil nil "init") + (call-process git-program nil nil nil "add" ".") + (call-process git-program nil nil nil "commit" "-m" "Test repository.") + ;; Update repo., save the diff and reset to initial state. + (with-temp-buffer + (insert "foo here\n") + (write-region nil nil qux nil 'silent) + (write-region nil nil bar nil 'silent)) + (call-process git-program nil `(:file ,patch) nil "diff") + (call-process git-program nil nil nil "reset" "--hard" "HEAD") + ;; Visit the diff file i.e., patch; extract from it the parts + ;; affecting just each of the files: store in patch-bar the part + ;; affecting 'bar', and in patch-qux the part affecting 'qux'. + (find-file patch) (let* ((info (progn (ediff-map-patch-buffer (current-buffer)) ediff-patch-map)) (patch-bar @@ -116,9 +116,7 @@ index 6a07f80..6e8e947 100644 (buffer-string)) (with-temp-buffer (insert-file-contents backup) - (buffer-string))))))) - (delete-directory tmpdir 'recursive) - (delete-file patch))))) + (buffer-string)))))))))))) (provide 'ediff-ptch-tests) diff --git a/test/lisp/vc/smerge-mode-tests.el b/test/lisp/vc/smerge-mode-tests.el index 2c8f48618e5..d7827c7a8cb 100644 --- a/test/lisp/vc/smerge-mode-tests.el +++ b/test/lisp/vc/smerge-mode-tests.el @@ -34,3 +34,5 @@ (should (equal (buffer-substring (point-min) (point-max)) "")))) (provide 'smerge-mode-tests) + +;;; smerge-mode-tests.el ends here diff --git a/test/lisp/vc/vc-bzr-tests.el b/test/lisp/vc/vc-bzr-tests.el index b02dce8f707..afced819fbc 100644 --- a/test/lisp/vc/vc-bzr-tests.el +++ b/test/lisp/vc/vc-bzr-tests.el @@ -25,6 +25,7 @@ ;;; Code: (require 'ert) +(require 'ert-x) (require 'vc-bzr) (require 'vc-dir) @@ -51,106 +52,97 @@ ;; temporary directory. ;; TODO does this means tests should be setting XDG_ variables (not ;; just HOME) to temporary values too? - (let* ((homedir (make-temp-file "vc-bzr-test" t)) - (bzrdir (expand-file-name "bzr" homedir)) - (ignored-dir (progn - (make-directory bzrdir) - (expand-file-name "ignored-dir" bzrdir))) - (default-directory (file-name-as-directory bzrdir)) - (process-environment (cons (format "HOME=%s" homedir) - process-environment))) - (unwind-protect - (progn - (make-directory ignored-dir) - (with-temp-buffer - (insert (file-name-nondirectory ignored-dir)) - (write-region nil nil (expand-file-name ".bzrignore" bzrdir) - nil 'silent)) - (skip-unless (eq 0 ; some internal bzr error - (call-process vc-bzr-program nil nil nil "init"))) - (call-process vc-bzr-program nil nil nil "add") - (call-process vc-bzr-program nil nil nil "commit" "-m" "Commit 1") - (with-temp-buffer - (insert "unregistered file") - (write-region nil nil (expand-file-name "testfile2" ignored-dir) - nil 'silent)) - (vc-dir ignored-dir) - (while (vc-dir-busy) - (sit-for 0.1)) - ;; FIXME better to explicitly test for error from process sentinel. - (with-current-buffer "*vc-dir*" - (goto-char (point-min)) - (should (search-forward "unregistered" nil t)))) - (delete-directory homedir t)))) + (ert-with-temp-directory homedir + (let* ((bzrdir (expand-file-name "bzr" homedir)) + (ignored-dir (progn + (make-directory bzrdir) + (expand-file-name "ignored-dir" bzrdir))) + (default-directory (file-name-as-directory bzrdir)) + (process-environment (cons (format "HOME=%s" homedir) + process-environment))) + (make-directory ignored-dir) + (with-temp-buffer + (insert (file-name-nondirectory ignored-dir)) + (write-region nil nil (expand-file-name ".bzrignore" bzrdir) + nil 'silent)) + (skip-unless (eq 0 ; some internal bzr error + (call-process vc-bzr-program nil nil nil "init"))) + (call-process vc-bzr-program nil nil nil "add") + (call-process vc-bzr-program nil nil nil "commit" "-m" "Commit 1") + (with-temp-buffer + (insert "unregistered file") + (write-region nil nil (expand-file-name "testfile2" ignored-dir) + nil 'silent)) + (vc-dir ignored-dir) + (while (vc-dir-busy) + (sit-for 0.1)) + ;; FIXME better to explicitly test for error from process sentinel. + (with-current-buffer "*vc-dir*" + (goto-char (point-min)) + (should (search-forward "unregistered" nil t)))))) ;; Not specific to bzr. (ert-deftest vc-bzr-test-bug9781 () "Test for https://debbugs.gnu.org/9781 ." (skip-unless (executable-find vc-bzr-program)) - (let* ((homedir (make-temp-file "vc-bzr-test" t)) - (bzrdir (expand-file-name "bzr" homedir)) - (subdir (progn - (make-directory bzrdir) - (expand-file-name "subdir" bzrdir))) - (file (expand-file-name "file" bzrdir)) - (default-directory (file-name-as-directory bzrdir)) - (process-environment (cons (format "HOME=%s" homedir) - process-environment))) - (unwind-protect - (progn - (skip-unless (eq 0 ; some internal bzr error - (call-process vc-bzr-program nil nil nil "init"))) - (make-directory subdir) - (with-temp-buffer - (insert "text") - (write-region nil nil file nil 'silent) - (write-region nil nil (expand-file-name "subfile" subdir) - nil 'silent)) - (call-process vc-bzr-program nil nil nil "add") - (call-process vc-bzr-program nil nil nil "commit" "-m" "Commit 1") - (call-process vc-bzr-program nil nil nil "remove" subdir) - (with-temp-buffer - (insert "different text") - (write-region nil nil file nil 'silent)) - (vc-dir bzrdir) - (while (vc-dir-busy) - (sit-for 0.1)) - (vc-dir-mark-all-files t) - (cl-letf (((symbol-function 'y-or-n-p) (lambda (_) t))) - (vc-next-action nil)) - (should (get-buffer "*vc-log*"))) - (delete-directory homedir t)))) + (ert-with-temp-directory homedir + (let* ((bzrdir (expand-file-name "bzr" homedir)) + (subdir (progn + (make-directory bzrdir) + (expand-file-name "subdir" bzrdir))) + (file (expand-file-name "file" bzrdir)) + (default-directory (file-name-as-directory bzrdir)) + (process-environment (cons (format "HOME=%s" homedir) + process-environment))) + (skip-unless (eq 0 ; some internal bzr error + (call-process vc-bzr-program nil nil nil "init"))) + (make-directory subdir) + (with-temp-buffer + (insert "text") + (write-region nil nil file nil 'silent) + (write-region nil nil (expand-file-name "subfile" subdir) + nil 'silent)) + (call-process vc-bzr-program nil nil nil "add") + (call-process vc-bzr-program nil nil nil "commit" "-m" "Commit 1") + (call-process vc-bzr-program nil nil nil "remove" subdir) + (with-temp-buffer + (insert "different text") + (write-region nil nil file nil 'silent)) + (vc-dir bzrdir) + (while (vc-dir-busy) + (sit-for 0.1)) + (vc-dir-mark-all-files t) + (cl-letf (((symbol-function 'y-or-n-p) (lambda (_) t))) + (vc-next-action nil)) + (should (get-buffer "*vc-log*"))))) ;; https://lists.gnu.org/r/help-gnu-emacs/2012-04/msg00145.html (ert-deftest vc-bzr-test-faulty-bzr-autoloads () "Test we can generate autoloads in a bzr directory when bzr is faulty." (skip-unless (executable-find vc-bzr-program)) - (let* ((homedir (make-temp-file "vc-bzr-test" t)) - (bzrdir (expand-file-name "bzr" homedir)) - (file (progn - (make-directory bzrdir) - (expand-file-name "foo.el" bzrdir))) - (default-directory (file-name-as-directory bzrdir)) - (process-environment (cons (format "HOME=%s" homedir) - process-environment))) - (unwind-protect - (progn - (call-process vc-bzr-program nil nil nil "init") - (with-temp-buffer - (insert ";;;###autoload + (ert-with-temp-directory homedir + (let* ((bzrdir (expand-file-name "bzr" homedir)) + (file (progn + (make-directory bzrdir) + (expand-file-name "foo.el" bzrdir))) + (default-directory (file-name-as-directory bzrdir)) + (process-environment (cons (format "HOME=%s" homedir) + process-environment))) + (call-process vc-bzr-program nil nil nil "init") + (with-temp-buffer + (insert ";;;###autoload \(defun foo () \"foo\" (interactive) (message \"foo!\"))") - (write-region nil nil file nil 'silent)) - (call-process vc-bzr-program nil nil nil "add") - (call-process vc-bzr-program nil nil nil "commit" "-m" "Commit 1") - ;; Deleting dirstate ensures both that vc-bzr's status heuristic - ;; fails, so it has to call the external bzr status, and - ;; causes bzr status to fail. This simulates a broken bzr - ;; installation. - (delete-file ".bzr/checkout/dirstate") - (should (progn (make-directory-autoloads - default-directory - (expand-file-name "loaddefs.el" bzrdir)) - t))) - (delete-directory homedir t)))) + (write-region nil nil file nil 'silent)) + (call-process vc-bzr-program nil nil nil "add") + (call-process vc-bzr-program nil nil nil "commit" "-m" "Commit 1") + ;; Deleting dirstate ensures both that vc-bzr's status heuristic + ;; fails, so it has to call the external bzr status, and + ;; causes bzr status to fail. This simulates a broken bzr + ;; installation. + (delete-file ".bzr/checkout/dirstate") + (should (progn (make-directory-autoloads + default-directory + (expand-file-name "loaddefs.el" bzrdir)) + t))))) -;;; vc-bzr.el ends here +;;; vc-bzr-tests.el ends here diff --git a/test/lisp/vc/vc-tests.el b/test/lisp/vc/vc-tests.el index 5430535c5ed..578d7ebb418 100644 --- a/test/lisp/vc/vc-tests.el +++ b/test/lisp/vc/vc-tests.el @@ -52,7 +52,7 @@ ;; - responsible-p (file) ;; - receive-file (file rev) ;; - unregister (file) DONE -;; * checkin (files comment) +;; * checkin (files comment) DONE ;; * find-revision (file rev buffer) ;; * checkout (file &optional rev) ;; * revert (file &optional contents-done) @@ -75,7 +75,7 @@ ;; - show-log-entry (revision) ;; - comment-history (file) ;; - update-changelog (files) -;; * diff (files &optional async rev1 rev2 buffer) +;; * diff (files &optional async rev1 rev2 buffer) DONE ;; - revision-completion-table (files) ;; - annotate-command (file buf &optional rev) ;; - annotate-time () @@ -100,7 +100,7 @@ ;; - log-edit-mode () ;; - check-headers () ;; - delete-file (file) -;; - rename-file (old new) +;; - rename-file (old new) DONE ;; - find-file-hook () ;; - extra-menu () ;; - extra-dir-menu () @@ -109,7 +109,9 @@ ;;; Code: (require 'ert) +(require 'ert-x) (require 'vc) +(require 'log-edit) (declare-function w32-application-type "w32proc.c") @@ -177,41 +179,38 @@ For backends which dont support it, it is emulated." (defun vc-test--create-repo (backend) "Create a test repository in `default-directory', a temporary directory." - - (let ((vc-handled-backends `(,backend)) - (default-directory - (file-name-as-directory - (expand-file-name - (make-temp-name "vc-test") temporary-file-directory))) - (process-environment process-environment) - tempdir - vc-test--cleanup-hook) - (when (eq backend 'Bzr) - (setq tempdir (make-temp-file "vc-test--create-repo" t) - process-environment (cons (format "BZR_HOME=%s" tempdir) - process-environment))) - - (unwind-protect - (progn - ;; Cleanup. - (add-hook - '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)) - (vc-test--create-repo-function backend) - (should (eq (vc-responsible-backend default-directory) backend))) - - ;; Save exit. - (ignore-errors - (if tempdir (delete-directory tempdir t)) - (run-hooks 'vc-test--cleanup-hook))))) + (ert-with-temp-directory tempdir + (let ((vc-handled-backends `(,backend)) + (default-directory + (file-name-as-directory + (expand-file-name + (make-temp-name "vc-test") temporary-file-directory))) + (process-environment process-environment) + vc-test--cleanup-hook) + (when (eq backend 'Bzr) + (setq process-environment (cons (format "BZR_HOME=%s" tempdir) + process-environment))) + + (unwind-protect + (progn + ;; Cleanup. + (add-hook + '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)) + (vc-test--create-repo-function backend) + (should (eq (vc-responsible-backend default-directory) backend))) + + ;; Save exit. + (ignore-errors + (run-hooks 'vc-test--cleanup-hook)))))) ;; FIXME: Why isn't there `vc-unregister'? (defun vc-test--unregister-function (backend file) @@ -234,318 +233,429 @@ Catch the `vc-not-supported' error." (defun vc-test--register (backend) "Register and unregister a file. This checks also `vc-backend' and `vc-responsible-backend'." - - (let ((vc-handled-backends `(,backend)) - (default-directory - (file-name-as-directory - (expand-file-name - (make-temp-name "vc-test") temporary-file-directory))) - (process-environment process-environment) - tempdir - vc-test--cleanup-hook) - (when (eq backend 'Bzr) - (setq tempdir (make-temp-file "vc-test--register" t) - process-environment (cons (format "BZR_HOME=%s" tempdir) - process-environment))) - (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) - ;; For file oriented backends CVS, RCS and SVN the backend is - ;; returned, and the directory is registered already. - (should (if (vc-backend default-directory) - (vc-registered default-directory) - (not (vc-registered default-directory)))) - (should (eq (vc-responsible-backend default-directory) backend)) - - (let ((tmp-name1 (expand-file-name "foo" default-directory)) - (tmp-name2 "bla")) - ;; Register files. Check for it. - (write-region "foo" nil tmp-name1 nil 'nomessage) - (should (file-exists-p tmp-name1)) - (should-not (vc-backend tmp-name1)) - (should (eq (vc-responsible-backend tmp-name1) backend)) - (should-not (vc-registered tmp-name1)) - - (write-region "bla" nil tmp-name2 nil 'nomessage) - (should (file-exists-p tmp-name2)) - (should-not (vc-backend tmp-name2)) - (should (eq (vc-responsible-backend tmp-name2) backend)) - (should-not (vc-registered tmp-name2)) - - (vc-register (list backend (list tmp-name1 tmp-name2))) - (should (file-exists-p tmp-name1)) - (should (eq (vc-backend tmp-name1) backend)) - (should (eq (vc-responsible-backend tmp-name1) backend)) - (should (vc-registered tmp-name1)) - - (should (file-exists-p tmp-name2)) - (should (eq (vc-backend tmp-name2) backend)) - (should (eq (vc-responsible-backend tmp-name2) backend)) - (should (vc-registered tmp-name2)) - - ;; `vc-backend' accepts also a list of files, - ;; `vc-responsible-backend' doesn't. - (should (vc-backend (list tmp-name1 tmp-name2))) - - ;; Unregister the files. - (unless (eq (vc-test--run-maybe-unsupported-function - 'vc-test--unregister-function backend tmp-name1) - 'vc-not-supported) + (ert-with-temp-directory tempdir + (let ((vc-handled-backends `(,backend)) + (default-directory + (file-name-as-directory + (expand-file-name + (make-temp-name "vc-test") temporary-file-directory))) + (process-environment process-environment) + vc-test--cleanup-hook) + (when (eq backend 'Bzr) + (setq process-environment (cons (format "BZR_HOME=%s" tempdir) + process-environment))) + (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) + ;; For file oriented backends CVS, RCS and SVN the backend is + ;; returned, and the directory is registered already. + (should (if (vc-backend default-directory) + (vc-registered default-directory) + (not (vc-registered default-directory)))) + (should (eq (vc-responsible-backend default-directory) backend)) + + (let ((tmp-name1 (expand-file-name "foo" default-directory)) + (tmp-name2 "bla")) + ;; Register files. Check for it. + (write-region "foo" nil tmp-name1 nil 'nomessage) + (should (file-exists-p tmp-name1)) (should-not (vc-backend tmp-name1)) - (should-not (vc-registered tmp-name1))) - (unless (eq (vc-test--run-maybe-unsupported-function - 'vc-test--unregister-function backend tmp-name2) - 'vc-not-supported) - (should-not (vc-backend tmp-name2)) - (should-not (vc-registered tmp-name2))) + (should (eq (vc-responsible-backend tmp-name1) backend)) + (should-not (vc-registered tmp-name1)) - ;; The files should still exist. - (should (file-exists-p tmp-name1)) - (should (file-exists-p tmp-name2)))) - - ;; Save exit. - (ignore-errors - (if tempdir (delete-directory tempdir t)) - (run-hooks 'vc-test--cleanup-hook))))) + (write-region "bla" nil tmp-name2 nil 'nomessage) + (should (file-exists-p tmp-name2)) + (should-not (vc-backend tmp-name2)) + (should (eq (vc-responsible-backend tmp-name2) backend)) + (should-not (vc-registered tmp-name2)) + + (vc-register (list backend (list tmp-name1 tmp-name2))) + (should (file-exists-p tmp-name1)) + (should (eq (vc-backend tmp-name1) backend)) + (should (eq (vc-responsible-backend tmp-name1) backend)) + (should (vc-registered tmp-name1)) + + (should (file-exists-p tmp-name2)) + (should (eq (vc-backend tmp-name2) backend)) + (should (eq (vc-responsible-backend tmp-name2) backend)) + (should (vc-registered tmp-name2)) + + ;; `vc-backend' accepts also a list of files, + ;; `vc-responsible-backend' doesn't. + (should (vc-backend (list tmp-name1 tmp-name2))) + + ;; Unregister the files. + (unless (eq (vc-test--run-maybe-unsupported-function + 'vc-test--unregister-function backend tmp-name1) + 'vc-not-supported) + (should-not (vc-backend tmp-name1)) + (should-not (vc-registered tmp-name1))) + (unless (eq (vc-test--run-maybe-unsupported-function + 'vc-test--unregister-function backend tmp-name2) + 'vc-not-supported) + (should-not (vc-backend tmp-name2)) + (should-not (vc-registered tmp-name2))) + + ;; The files should still exist. + (should (file-exists-p tmp-name1)) + (should (file-exists-p tmp-name2)))) + + ;; Save exit. + (ignore-errors + (run-hooks 'vc-test--cleanup-hook)))))) (defun vc-test--state (backend) "Check the different states of a file." - - (let ((vc-handled-backends `(,backend)) - (default-directory - (file-name-as-directory - (expand-file-name - (make-temp-name "vc-test") temporary-file-directory))) - (process-environment process-environment) - tempdir - vc-test--cleanup-hook) - (when (eq backend 'Bzr) - (setq tempdir (make-temp-file "vc-test--state" t) - process-environment (cons (format "BZR_HOME=%s" tempdir) - process-environment))) - (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) - - (let ((tmp-name (expand-file-name "foo" default-directory))) - ;; Check state of a nonexistent file. - - (message "vc-state2 %s" (vc-state tmp-name)) - (should (null (vc-state tmp-name))) - - ;; Write a new file. Check state. - (write-region "foo" nil tmp-name nil 'nomessage) - - ;; nil: Mtn - ;; unregistered: Bzr CVS Git Hg SVN RCS - (message "vc-state3 %s %s" backend (vc-state tmp-name backend)) - (should (memq (vc-state tmp-name backend) '(nil unregistered))) - - ;; Register a file. Check state. - (vc-register - (list backend (list (file-name-nondirectory tmp-name)))) - - ;; FIXME: nil is definitely wrong. - ;; nil: SRC - ;; added: Bzr CVS Git Hg Mtn SVN - ;; up-to-date: RCS SCCS - (message "vc-state4 %s" (vc-state tmp-name)) - (should (memq (vc-state tmp-name) '(nil added up-to-date))) - - ;; Unregister the file. Check state. - (if (eq (vc-test--run-maybe-unsupported-function - 'vc-test--unregister-function backend tmp-name) - 'vc-not-supported) - (message "vc-state5 unsupported") - ;; unregistered: Bzr Git RCS Hg - ;; unsupported: CVS Mtn SCCS SRC SVN - (message "vc-state5 %s %s" backend (vc-state tmp-name backend)) - (should (memq (vc-state tmp-name backend) - '(nil unregistered)))))) - - ;; Save exit. - (ignore-errors - (if tempdir (delete-directory tempdir t)) - (run-hooks 'vc-test--cleanup-hook))))) + (ert-with-temp-directory tempdir + (let ((vc-handled-backends `(,backend)) + (default-directory + (file-name-as-directory + (expand-file-name + (make-temp-name "vc-test") temporary-file-directory))) + (process-environment process-environment) + vc-test--cleanup-hook) + (when (eq backend 'Bzr) + (setq process-environment (cons (format "BZR_HOME=%s" tempdir) + process-environment))) + (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) + + (let ((tmp-name (expand-file-name "foo" default-directory))) + ;; Check state of a nonexistent file. + + (message "vc-state2 %s" (vc-state tmp-name)) + (should (null (vc-state tmp-name))) + + ;; Write a new file. Check state. + (write-region "foo" nil tmp-name nil 'nomessage) + + ;; nil: Mtn + ;; unregistered: Bzr CVS Git Hg SVN RCS + (message "vc-state3 %s %s" backend (vc-state tmp-name backend)) + (should (memq (vc-state tmp-name backend) '(nil unregistered))) + + ;; Register a file. Check state. + (vc-register + (list backend (list (file-name-nondirectory tmp-name)))) + + ;; FIXME: nil is definitely wrong. + ;; nil: SRC + ;; added: Bzr CVS Git Hg Mtn SVN + ;; up-to-date: RCS SCCS + (message "vc-state4 %s" (vc-state tmp-name)) + (should (memq (vc-state tmp-name) '(nil added up-to-date))) + + ;; Unregister the file. Check state. + (if (eq (vc-test--run-maybe-unsupported-function + 'vc-test--unregister-function backend tmp-name) + 'vc-not-supported) + (message "vc-state5 unsupported") + ;; unregistered: Bzr Git RCS Hg + ;; unsupported: CVS Mtn SCCS SRC SVN + (message "vc-state5 %s %s" backend (vc-state tmp-name backend)) + (should (memq (vc-state tmp-name backend) + '(nil unregistered)))))) + + ;; 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))) - (process-environment process-environment) - tempdir - vc-test--cleanup-hook) - (when (eq backend 'Bzr) - (setq tempdir (make-temp-file "vc-test--working-revision" t) - process-environment (cons (format "BZR_HOME=%s" tempdir) - process-environment))) - - (unwind-protect - (progn - ;; Cleanup. - (add-hook - 'vc-test--cleanup-hook - `(lambda () (delete-directory ,default-directory 'recursive))) - - ;; Create empty repository. Check working revision of - ;; repository, should be nil. - (make-directory default-directory) - (vc-test--create-repo-function backend) - - ;; FIXME: Is the value for SVN correct? - ;; nil: Bzr CVS Git Hg Mtn RCS SCCS SRC - ;; "0": SVN - (message - "vc-working-revision1 %s" (vc-working-revision default-directory)) - (should (member (vc-working-revision default-directory) '(nil "0"))) - - (let ((tmp-name (expand-file-name "foo" default-directory))) - ;; Check initial working revision, should be nil until - ;; it's registered. - - (message "vc-working-revision2 %s" (vc-working-revision tmp-name)) - (should-not (vc-working-revision tmp-name)) - - ;; Write a new file. Check working revision. - (write-region "foo" nil tmp-name nil 'nomessage) - - (message "vc-working-revision3 %s" (vc-working-revision tmp-name)) - (should-not (vc-working-revision tmp-name)) - - ;; Register a file. Check working revision. - (vc-register - (list backend (list (file-name-nondirectory tmp-name)))) - - ;; XXX: nil is fine, at least in Git's case, because - ;; `vc-register' only makes the file `added' in this case. - ;; nil: Git Mtn - ;; "0": Bzr CVS Hg SRC SVN - ;; "1.1": RCS SCCS - ;; "-1": Hg versions before 5 (probably) - (message "vc-working-revision4 %s" (vc-working-revision tmp-name)) - (should (member (vc-working-revision tmp-name) '(nil "0" "1.1" "-1"))) - - ;; TODO: Call `vc-checkin', and check the resulting - ;; working revision. None of the return values should be - ;; nil then. - - ;; Unregister the file. Check working revision. - (if (eq (vc-test--run-maybe-unsupported-function - 'vc-test--unregister-function backend tmp-name) - 'vc-not-supported) - (message "vc-working-revision5 unsupported") - ;; nil: Bzr Git Hg RCS - ;; unsupported: CVS Mtn SCCS SRC SVN - (message "vc-working-revision5 %s" (vc-working-revision tmp-name)) - (should-not (vc-working-revision tmp-name))))) - - ;; Save exit. - (ignore-errors - (if tempdir (delete-directory tempdir t)) - (run-hooks 'vc-test--cleanup-hook))))) + (ert-with-temp-directory tempdir + (let ((vc-handled-backends `(,backend)) + (default-directory + (file-name-as-directory + (expand-file-name + (make-temp-name "vc-test") temporary-file-directory))) + (process-environment process-environment) + vc-test--cleanup-hook) + (when (eq backend 'Bzr) + (setq process-environment (cons (format "BZR_HOME=%s" tempdir) + process-environment))) + + (unwind-protect + (progn + ;; Cleanup. + (add-hook + 'vc-test--cleanup-hook + `(lambda () (delete-directory ,default-directory 'recursive))) + + ;; Create empty repository. Check working revision of + ;; repository, should be nil. + (make-directory default-directory) + (vc-test--create-repo-function backend) + + ;; FIXME: Is the value for SVN correct? + ;; nil: Bzr CVS Git Hg Mtn RCS SCCS SRC + ;; "0": SVN + (message + "vc-working-revision1 %s" (vc-working-revision default-directory)) + (should (member (vc-working-revision default-directory) '(nil "0"))) + + (let ((tmp-name (expand-file-name "foo" default-directory))) + ;; Check initial working revision, should be nil until + ;; it's registered. + + (message "vc-working-revision2 %s" (vc-working-revision tmp-name)) + (should-not (vc-working-revision tmp-name)) + + ;; Write a new file. Check working revision. + (write-region "foo" nil tmp-name nil 'nomessage) + + (message "vc-working-revision3 %s" (vc-working-revision tmp-name)) + (should-not (vc-working-revision tmp-name)) + + ;; Register a file. Check working revision. + (vc-register + (list backend (list (file-name-nondirectory tmp-name)))) + + ;; XXX: nil is fine, at least in Git's case, because + ;; `vc-register' only makes the file `added' in this case. + ;; nil: Git Mtn + ;; "0": Bzr CVS Hg SRC SVN + ;; "1.1": RCS SCCS + ;; "-1": Hg versions before 5 (probably) + (message "vc-working-revision4 %s" (vc-working-revision tmp-name)) + (should (member (vc-working-revision tmp-name) '(nil "0" "1.1" "-1"))) + + ;; TODO: Call `vc-checkin', and check the resulting + ;; working revision. None of the return values should be + ;; nil then. + + ;; Unregister the file. Check working revision. + (if (eq (vc-test--run-maybe-unsupported-function + 'vc-test--unregister-function backend tmp-name) + 'vc-not-supported) + (message "vc-working-revision5 unsupported") + ;; nil: Bzr Git Hg RCS + ;; unsupported: CVS Mtn SCCS SRC SVN + (message "vc-working-revision5 %s" (vc-working-revision tmp-name)) + (should-not (vc-working-revision tmp-name))))) + + ;; 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))) - (process-environment process-environment) - tempdir - vc-test--cleanup-hook) - (when (eq backend 'Bzr) - (setq tempdir (make-temp-file "vc-test--checkout-model" t) - process-environment (cons (format "BZR_HOME=%s" tempdir) - process-environment))) - - (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. - ;; implicit: Bzr CVS Git Hg Mtn SRC SVN - ;; locking: RCS SCCS - (message - "vc-checkout-model1 %s" - (vc-checkout-model backend default-directory)) - (should (memq (vc-checkout-model backend default-directory) - '(announce implicit locking))) - - (let ((tmp-name (expand-file-name "foo" default-directory))) - ;; Check checkout model of a nonexistent file. - - ;; implicit: Bzr CVS Git Hg Mtn SRC SVN - ;; locking: RCS SCCS + (ert-with-temp-directory tempdir + (let ((vc-handled-backends `(,backend)) + (default-directory + (file-name-as-directory + (expand-file-name + (make-temp-name "vc-test") temporary-file-directory))) + (process-environment process-environment) + vc-test--cleanup-hook) + (when (eq backend 'Bzr) + (setq process-environment (cons (format "BZR_HOME=%s" tempdir) + process-environment))) + + (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. + ;; implicit: Bzr CVS Git Hg Mtn SRC SVN + ;; locking: RCS SCCS (message - "vc-checkout-model2 %s" (vc-checkout-model backend tmp-name)) - (should (memq (vc-checkout-model backend tmp-name) - '(announce implicit locking))) + "vc-checkout-model1 %s" + (vc-checkout-model backend default-directory)) + (should (memq (vc-checkout-model backend default-directory) + '(announce implicit locking))) - ;; Write a new file. Check checkout model. - (write-region "foo" nil tmp-name nil 'nomessage) + (let ((tmp-name (expand-file-name "foo" default-directory))) + ;; Check checkout model of a nonexistent file. - ;; implicit: Bzr CVS Git Hg Mtn SRC SVN - ;; locking: RCS SCCS - (message - "vc-checkout-model3 %s" (vc-checkout-model backend tmp-name)) - (should (memq (vc-checkout-model backend tmp-name) - '(announce implicit locking))) + ;; implicit: Bzr CVS Git Hg Mtn SRC SVN + ;; locking: RCS SCCS + (message + "vc-checkout-model2 %s" (vc-checkout-model backend tmp-name)) + (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)))) + ;; Write a new file. Check checkout model. + (write-region "foo" nil tmp-name nil 'nomessage) - ;; implicit: Bzr CVS Git Hg Mtn SRC SVN - ;; locking: RCS SCCS - (message - "vc-checkout-model4 %s" (vc-checkout-model backend tmp-name)) - (should (memq (vc-checkout-model backend tmp-name) - '(announce implicit locking))) - - ;; Unregister the file. Check checkout model. - (if (eq (vc-test--run-maybe-unsupported-function - 'vc-test--unregister-function backend tmp-name) - 'vc-not-supported) - (message "vc-checkout-model5 unsupported") - ;; implicit: Bzr Git Hg - ;; locking: RCS - ;; unsupported: CVS Mtn SCCS SRC SVN + ;; implicit: Bzr CVS Git Hg Mtn SRC SVN + ;; locking: RCS SCCS (message - "vc-checkout-model5 %s" (vc-checkout-model backend tmp-name)) + "vc-checkout-model3 %s" (vc-checkout-model backend tmp-name)) (should (memq (vc-checkout-model backend tmp-name) - '(announce implicit locking)))))) + '(announce implicit locking))) - ;; Save exit. - (ignore-errors - (if tempdir (delete-directory tempdir t)) - (run-hooks 'vc-test--cleanup-hook))))) + ;; Register a file. Check checkout model. + (vc-register + (list backend (list (file-name-nondirectory tmp-name)))) + + ;; implicit: Bzr CVS Git Hg Mtn SRC SVN + ;; locking: RCS SCCS + (message + "vc-checkout-model4 %s" (vc-checkout-model backend tmp-name)) + (should (memq (vc-checkout-model backend tmp-name) + '(announce implicit locking))) + + ;; Unregister the file. Check checkout model. + (if (eq (vc-test--run-maybe-unsupported-function + 'vc-test--unregister-function backend tmp-name) + 'vc-not-supported) + (message "vc-checkout-model5 unsupported") + ;; implicit: Bzr Git Hg + ;; locking: RCS + ;; unsupported: CVS Mtn SCCS SRC SVN + (message + "vc-checkout-model5 %s" (vc-checkout-model backend tmp-name)) + (should (memq (vc-checkout-model backend tmp-name) + '(announce implicit locking)))))) + + ;; Save exit. + (ignore-errors + (run-hooks 'vc-test--cleanup-hook)))))) + +(defun vc-test--rename-file (backend) + "Check the rename-file action." + (ert-with-temp-directory tempdir + (let ((vc-handled-backends `(,backend)) + (default-directory + (file-name-as-directory + (expand-file-name + (make-temp-name "vc-test") temporary-file-directory))) + (process-environment process-environment) + vc-test--cleanup-hook) + (when (eq backend 'Bzr) + (setq process-environment (cons (format "BZR_HOME=%s" tempdir) + process-environment))) + + (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) + + (let ((tmp-name (expand-file-name "foo" default-directory)) + (new-name (expand-file-name "bar" default-directory))) + ;; Write a new file. + (write-region "foo" nil tmp-name nil 'nomessage) + + ;; Register it. Renaming can fail otherwise. + (vc-register + (list backend (list (file-name-nondirectory tmp-name)))) + + (vc-rename-file tmp-name new-name) + + (should (not (file-exists-p tmp-name))) + (should (file-exists-p new-name)) + + (should (equal (vc-state new-name) + (if (memq backend '(RCS SCCS)) + 'up-to-date + 'added))))) + + ;; Save exit. + (ignore-errors + (run-hooks 'vc-test--cleanup-hook)))))) + +(declare-function log-edit-done "vc/log-edit") + +(defun vc-test--version-diff (backend) + "Check the diff version of a repository." + (ert-with-temp-directory tempdir + (let ((vc-handled-backends `(,backend)) + (default-directory + (file-name-as-directory + (expand-file-name + (make-temp-name "vc-test") temporary-file-directory))) + (process-environment process-environment) + vc-test--cleanup-hook) + (when (eq backend 'Bzr) + (setq process-environment (cons (format "BZR_HOME=%s" tempdir) + process-environment))) + ;; git tries various approaches to guess a user name and email, + ;; which can fail depending on how the system is configured. + ;; Eg if the user account has no GECOS, git commit can fail with + ;; status 128 "fatal: empty ident name". + (when (memq backend '(Bzr Git)) + (setq process-environment (cons "EMAIL=john@doe.ee" + process-environment))) + (if (eq backend 'Git) + (setq process-environment (append '("GIT_AUTHOR_NAME=A" + "GIT_COMMITTER_NAME=C") + process-environment))) + (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) + + (let* ((tmp-name (expand-file-name "foo" default-directory)) + (files (list (file-name-nondirectory tmp-name)))) + ;; Write and register a new file. + (write-region "originaltext" nil tmp-name nil 'nomessage) + (vc-register (list backend files)) + + (let ((buff (find-file tmp-name))) + (with-current-buffer buff + (progn + ;; Optionally checkout file. + (when (memq backend '(RCS CVS SCCS)) + (vc-checkout tmp-name)) + + ;; Checkin file. + (vc-checkin files backend) + (insert "Testing vc-version-diff") + (log-edit-done)))) + + ;; Modify file content. + (when (memq backend '(RCS CVS SCCS)) + (vc-checkout tmp-name)) + (write-region "updatedtext" nil tmp-name nil 'nomessage) + + ;; Check version diff. + (vc-version-diff files nil nil) + (should (bufferp (get-buffer "*vc-diff*"))) + + (with-current-buffer "*vc-diff*" + (progn + (let ((rawtext (buffer-substring-no-properties (point-min) + (point-max)))) + (should (string-search "-originaltext" rawtext)) + (should (string-search "+updatedtext" rawtext))))))) + + ;; Save exit. + (ignore-errors + (run-hooks 'vc-test--cleanup-hook)))))) ;; Create the test cases. @@ -648,7 +758,35 @@ This checks also `vc-backend' and `vc-responsible-backend'." (ert-get-test ',(intern (format "vc-test-%s01-register" backend-string)))))) - (vc-test--checkout-model ',backend)))))) + (vc-test--checkout-model ',backend)) + + (ert-deftest + ,(intern (format "vc-test-%s05-rename-file" backend-string)) () + ,(format "Check `vc-rename-file' 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)))))) + ;; CVS calls vc-delete-file, which insists on prompting + ;; "Really want to delete ...?" + (skip-unless (not (eq 'CVS ',backend))) + (vc-test--rename-file ',backend)) + + (ert-deftest + ,(intern (format "vc-test-%s06-version-diff" backend-string)) () + ,(format "Check `vc-version-diff' 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--version-diff ',backend)) + )))) (provide 'vc-tests) ;;; vc-tests.el ends here |