procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

VC: Fix tests for SCCS and Mtn

Browse source 
* test/lisp/vc/vc-tests.el: Prefer closures to `(lambda ...).
(vc-test-mtn05-rename-file, vc-test-mtn06-version-diff): Skip.

* lisp/vc/vc.el (vc-responsible-backend): Fix vc-test--register on SCCS.
This commit is contained in:
Stefan Monnier 2022-01-18 16:42:19 -05:00
parent ea1e5c97e3
commit 0f558e3be9
2 changed files with 29 additions and 17 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

15
lisp/vc/vc.el
View file

@ -1004,13 +1004,14 @@ responsible for the given file."
;;
;; First try: find a responsible backend. If this is for registration,
;; it must be a backend under which FILE is not yet registered.
(let ((dirs (delq nil
(mapcar
(lambda (backend)
(when-let ((dir (vc-call-backend
backend 'responsible-p file)))
(cons backend dir)))
vc-handled-backends))))
(let* ((file (expand-file-name file))
(dirs (delq nil
(mapcar
(lambda (backend)
(when-let ((dir (vc-call-backend
backend 'responsible-p file)))
(cons backend dir)))
vc-handled-backends))))
;; Just a single response (or none); use it.
(if (< (length dirs) 2)
(caar dirs)

31
test/lisp/vc/vc-tests.el
View file

@ -153,7 +153,7 @@ For backends which dont support it, it is emulated."
(delete-directory "module" 'recursive)
;; We must cleanup the "remote" CVS repo as well.
(add-hook 'vc-test--cleanup-hook
`(lambda () (delete-directory ,tmp-dir 'recursive)))))
(lambda () (delete-directory tmp-dir 'recursive)))))
((eq backend 'Arch)
(let ((archive-name (format "%s--%s" user-mail-address (random))))
@ -196,7 +196,8 @@ For backends which dont support it, it is emulated."
;; Cleanup.
(add-hook
'vc-test--cleanup-hook
`(lambda () (delete-directory ,default-directory 'recursive)))
(let ((dir default-directory))
(lambda () (delete-directory dir 'recursive))))
;; Check the revision granularity.
(should (memq (vc-test--revision-granularity-function backend)
@ -249,7 +250,8 @@ This checks also `vc-backend' and `vc-responsible-backend'."
;; Cleanup.
(add-hook
'vc-test--cleanup-hook
`(lambda () (delete-directory ,default-directory 'recursive)))
(let ((dir default-directory))
(lambda () (delete-directory dir 'recursive))))
;; Create empty repository.
(make-directory default-directory)
@ -329,7 +331,8 @@ This checks also `vc-backend' and `vc-responsible-backend'."
;; Cleanup.
(add-hook
'vc-test--cleanup-hook
`(lambda () (delete-directory ,default-directory 'recursive)))
(let ((dir default-directory))
(lambda () (delete-directory dir 'recursive))))
;; Create empty repository.
(make-directory default-directory)
@ -394,7 +397,8 @@ This checks also `vc-backend' and `vc-responsible-backend'."
;; Cleanup.
(add-hook
'vc-test--cleanup-hook
`(lambda () (delete-directory ,default-directory 'recursive)))
(let ((dir default-directory))
(lambda () (delete-directory dir 'recursive))))
;; Create empty repository. Check working revision of
;; repository, should be nil.
@ -471,7 +475,8 @@ This checks also `vc-backend' and `vc-responsible-backend'."
;; Cleanup.
(add-hook
'vc-test--cleanup-hook
`(lambda () (delete-directory ,default-directory 'recursive)))
(let ((dir default-directory))
(lambda () (delete-directory dir 'recursive))))
;; Create empty repository. Check repository checkout model.
(make-directory default-directory)
@ -553,7 +558,8 @@ This checks also `vc-backend' and `vc-responsible-backend'."
;; Cleanup.
(add-hook
'vc-test--cleanup-hook
`(lambda () (delete-directory ,default-directory 'recursive)))
(let ((dir default-directory))
(lambda () (delete-directory dir 'recursive))))
;; Create empty repository.
(make-directory default-directory)
@ -613,7 +619,8 @@ This checks also `vc-backend' and `vc-responsible-backend'."
;; Cleanup.
(add-hook
'vc-test--cleanup-hook
`(lambda () (delete-directory ,default-directory 'recursive)))
(let ((dir default-directory))
(lambda () (delete-directory dir 'recursive))))
;; Create empty repository. Check repository checkout model.
(make-directory default-directory)
@ -771,8 +778,9 @@ This checks also `vc-backend' and `vc-responsible-backend'."
',(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)))
;; "Really want to delete ...?", and `vc-mtn.el' does not implement
;; `delete-file' at all.
(skip-unless (not (memq ',backend '(CVS Mtn))))
(vc-test--rename-file ',backend))
(ert-deftest
@ -785,6 +793,9 @@ This checks also `vc-backend' and `vc-responsible-backend'."
(ert-get-test
',(intern
(format "vc-test-%s01-register" backend-string))))))
;; `vc-mtn.el' gives me:
;; "Failed (status 1): mtn commit -m Testing vc-version-diff\n\n foo"
(skip-unless (not (memq ',backend '(Mtn))))
(vc-test--version-diff ',backend))
))))