Subject: Re: bug#20637: incompatible, undocumented change to vc-working-revision

From: Dmitry Gutov <[email-masked]>
Date: Mon, 18 Apr 2016 04:40:27 +0300

On 04/15/2016 04:11 PM, Michael Albinus wrote:

> I would prefer to apply further patches to the master branch only. Only
> patches absolutely necessary for fixing problems shall go to the
> emacs-25 branch, in order not to threaten the release.
>
> After applying your patch, vc-tests.el fails for me in vc-test-src02-state
> and vc-test-rcs03-working-revision.

Here's the patch against master. The latter one doesn't fail there.

Could you handle the SRC test failure yourself? Either by fixing the 
relevant code, or by simply exempting SRC from the relevant check.
diff --git a/lisp/vc/vc-hooks.el b/lisp/vc/vc-hooks.el
index 4c0161d..43cbb3f 100644
--- a/lisp/vc/vc-hooks.el
+++ b/lisp/vc/vc-hooks.el
@@ -476,7 +476,7 @@ vc-state
   ;; - `copied' and `moved' (might be handled by `removed' and `added')
   (or (vc-file-getprop file 'vc-state)
       (when (> (length file) 0)         ;Why??  --Stef
-	(setq backend (or backend (vc-responsible-backend file)))
+	(setq backend (or backend (vc-backend file)))
 	(when backend
           (vc-state-refresh file backend)))))
 
@@ -495,7 +495,7 @@ vc-working-revision
 If FILE is not registered, this function always returns nil."
   (or (vc-file-getprop file 'vc-working-revision)
       (progn
-	(setq backend (or backend (vc-responsible-backend file)))
+	(setq backend (or backend (vc-backend file)))
 	(when backend
 	  (vc-file-setprop file 'vc-working-revision
 			   (vc-call-backend backend 'working-revision file))))))
diff --git a/test/lisp/vc/vc-tests.el b/test/lisp/vc/vc-tests.el
index 2b3445a..cabd560 100644
--- a/test/lisp/vc/vc-tests.el
+++ b/test/lisp/vc/vc-tests.el
@@ -205,16 +205,10 @@ vc-test--create-repo
 (defun vc-test--unregister-function (backend file)
   "Run the `vc-unregister' backend function.
 For backends which dont support it, `vc-not-supported' is signalled."
-
-  (unwind-protect
-      (let ((symbol (intern (downcase (format "vc-%s-unregister" backend)))))
-        (if (functionp symbol)
-            (funcall symbol file)
-          ;; CVS, SVN, SCCS, SRC and Mtn are not supported.
-          (signal 'vc-not-supported (list 'unregister backend))))
-
-    ;; FIXME This shall be called in `vc-unregister'.
-    (vc-file-clearprops file)))
+  ;; CVS, SVN, SCCS, SRC and Mtn are not supported, and will signal
+  ;; `vc-not-supported'.
+  (vc-call-backend backend 'unregister file)
+  (vc-file-clearprops file))
 
 (defun vc-test--register (backend)
   "Register and unregister a file.
@@ -312,43 +306,30 @@ vc-test--state
 	   'vc-test--cleanup-hook
 	   `(lambda () (delete-directory ,default-directory 'recursive)))
 
-	  ;; Create empty repository.  Check repository state.
+	  ;; Create empty repository.
 	  (make-directory default-directory)
 	  (vc-test--create-repo-function backend)
 
-	  ;; nil: Hg Mtn RCS
-          ;; added: Git
-          ;; unregistered: CVS SCCS SRC
-	  ;; up-to-date: Bzr SVN
-          (message "vc-state1 %s" (vc-state default-directory))
-	  (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 state of an empty file.
+	    ;; Check state of a nonexistent file.
 
-	    ;; nil: Hg Mtn SRC SVN
+            (message "vc-state2 %s" (vc-state tmp-name))
+            ;; FIXME:
             ;; added: Git
 	    ;; unregistered: RCS SCCS
 	    ;; up-to-date: Bzr CVS
-            (message "vc-state2 %s" (vc-state tmp-name))
-	    (should (eq (vc-state tmp-name) (vc-state tmp-name backend)))
-	    (should (memq (vc-state tmp-name)
-			  '(nil added unregistered up-to-date)))
+	    ;; (should (eq (vc-state tmp-name) (vc-state tmp-name backend)))
+	    (should (null (vc-state tmp-name)))
 
 	    ;; Write a new file.  Check state.
 	    (write-region "foo" nil tmp-name nil 'nomessage)
 
-            ;; nil: Mtn
-            ;; added: Git
-            ;; unregistered: Hg RCS SCCS SRC SVN
-            ;; up-to-date: Bzr CVS
             (message "vc-state3 %s" (vc-state tmp-name))
-	    (should (eq (vc-state tmp-name) (vc-state tmp-name backend)))
-	    (should (memq (vc-state tmp-name)
-			  '(nil added unregistered up-to-date)))
+            ;; FIXME:
+            ;; added: Git
+            ;; unregistered: Bzr Hg RCS SCCS SRC SVN CVS
+	    ;; (should (eq (vc-state tmp-name) (vc-state tmp-name backend)))
+	    (should (null (vc-state tmp-name)))
 
 	    ;; Register a file.  Check state.
 	    (vc-register
@@ -359,21 +340,20 @@ vc-test--state
             ;; up-to-date: Bzr CVS
             (message "vc-state4 %s" (vc-state tmp-name))
 	    (should (eq (vc-state tmp-name) (vc-state tmp-name backend)))
-	    (should (memq (vc-state tmp-name) '(added unregistered up-to-date)))
+	    (should (memq (vc-state tmp-name) '(added up-to-date)))
 
 	    ;; Unregister the file.  Check state.
 	    (condition-case err
 		(progn
 		  (vc-test--unregister-function backend tmp-name)
 
-		  ;; added: Git
-		  ;; unregistered: Hg RCS
 		  ;; unsupported: CVS Mtn SCCS SRC SVN
-		  ;; up-to-date: Bzr
                   (message "vc-state5 %s" (vc-state tmp-name))
-		  (should (eq (vc-state tmp-name) (vc-state tmp-name backend)))
-		  (should (memq (vc-state tmp-name)
-				'(added unregistered up-to-date))))
+                  ;; FIXME:
+                  ;; added: Git
+		  ;; unregistered: Hg RCS Bzr
+		  ;; (should (eq (vc-state tmp-name) (vc-state tmp-name backend)))
+		  (should (null (vc-state tmp-name))))
 	      (vc-not-supported (message "vc-state5 unsupported"))
               (t (signal (car err) (cdr err))))))
 
@@ -406,8 +386,8 @@ vc-test--working-revision
 	  ;; "0": Bzr Hg SRC SVN
           (message
            "vc-working-revision1 %s" (vc-working-revision default-directory))
-	  (should (eq (vc-working-revision default-directory)
-		      (vc-working-revision default-directory backend)))
+	  ;; (should (eq (vc-working-revision default-directory)
+	  ;;             (vc-working-revision default-directory backend)))
 	  (should (member (vc-working-revision default-directory) '(nil "0")))
 
 	  (let ((tmp-name (expand-file-name "foo" default-directory)))
@@ -417,8 +397,8 @@ vc-test--working-revision
 	    ;; nil: CVS Git Mtn RCS SCCS SVN
 	    ;; "0": Bzr Hg SRC
             (message "vc-working-revision2 %s" (vc-working-revision tmp-name))
-	    (should (eq (vc-working-revision tmp-name)
-			(vc-working-revision tmp-name backend)))
+	    ;; (should (eq (vc-working-revision tmp-name)
+	    ;;     	(vc-working-revision tmp-name backend)))
 	    (should (member (vc-working-revision tmp-name) '(nil "0")))
 
 	    ;; Write a new file.  Check working revision.
@@ -427,8 +407,8 @@ vc-test--working-revision
 	    ;; nil: CVS Git Mtn RCS SCCS SVN
 	    ;; "0": Bzr Hg SRC
             (message "vc-working-revision3 %s" (vc-working-revision tmp-name))
-	    (should (eq (vc-working-revision tmp-name)
-			(vc-working-revision tmp-name backend)))
+	    ;; (should (eq (vc-working-revision tmp-name)
+	    ;;     	(vc-working-revision tmp-name backend)))
 	    (should (member (vc-working-revision tmp-name) '(nil "0")))
 
 	    ;; Register a file.  Check working revision.
@@ -439,22 +419,22 @@ vc-test--working-revision
 	    ;; "0": Bzr CVS Hg SRC SVN
             ;; "1.1"  RCS SCCS
             (message "vc-working-revision4 %s" (vc-working-revision tmp-name))
-	    (should (eq (vc-working-revision tmp-name)
-			(vc-working-revision tmp-name backend)))
+	    ;; (should (eq (vc-working-revision tmp-name)
+	    ;;     	(vc-working-revision tmp-name backend)))
 	    (should (member (vc-working-revision tmp-name) '(nil "0" "1.1")))
 
 	    ;; Unregister the file.  Check working revision.
 	    (condition-case err
 		(progn
-		  (vc-test--unregister-function backend tmp-name)
+                  (vc-test--unregister-function backend tmp-name)
 
 		  ;; nil: Git RCS
 		  ;; "0": Bzr Hg
 		  ;; unsupported: CVS Mtn SCCS SRC SVN
                   (message
                    "vc-working-revision5 %s" (vc-working-revision tmp-name))
-		  (should (eq (vc-working-revision tmp-name)
-			      (vc-working-revision tmp-name backend)))
+                  ;; (should (eq (vc-working-revision tmp-name)
+                  ;;             (vc-working-revision tmp-name backend)))
 		  (should (member (vc-working-revision tmp-name) '(nil "0"))))
 	      (vc-not-supported (message "vc-working-revision5 unsupported"))
               (t (signal (car err) (cdr err))))))