Subject: bug#76187: vc-git-test-dir-branch-headers failure on Fedora

From: Kévin Le Gouguec <[email-masked]>
Date: Sat, 15 Feb 2025 11:42:33 +0100

Eli Zaretskii <[email-masked]> writes:

>> From: Kévin Le Gouguec <[email-masked]>
>> Cc: [email-masked],  [email-masked]
>> Date: Thu, 13 Feb 2025 23:58:21 +0100
>> 
>> Kévin Le Gouguec <[email-masked]> writes:
>> 
>> > FWIW, with that last patch I posted, the test has been passing on repeat
>> > for 3h (47k iterations) and counting.  Maybe we have a winner?
>> 
>> 4h10min, 66k iterations, no failures.  Stopping the count because this
>> brain needs zzz's.
>> 
>> > Let me know if it looks acceptable, I'll add commentary & a changelog
>> > entry.
>> 
>> Done; attached for your consideration.
>
> I'm okay with this if Dmitry agrees.

For the sake of intellectual honesty (and to prove, if need be, that I
am a clown), while I do still prefer getting vc-dir out of the equation
for the purpose of testing vc-git-dir-extra-headers (and so, applying
the patch to which you reply),

I should note that with the alternative attached patch, the test has
been passing 7k times for 1h, with reassuring traces such as:

    Running in foreground: git --no-pager clone /tmp/emacs-test-Aoc9gk-vc-git/ /tmp/emacs-test-qRZ6nt-vc-git/ .
    Done (status=0): git --no-pager clone /tmp/emacs-test-Aoc9gk-vc-git/ /tmp/emacs-test-qRZ6nt-vc-git/ .
    Running in foreground: git --no-pager config --get remote.origin.url
    Done (status=0): git --no-pager config --get remote.origin.url
    Running in background: git --no-pager update-index --refresh .
    Done in background: git --no-pager update-index --refresh .
    Running in background: git --no-pager diff-index --relative -z -M HEAD -- .
    Done in background: git --no-pager diff-index --relative -z -M HEAD -- .
    Running in background: git --no-pager ls-files -z -u -- .
    Done in background: git --no-pager ls-files -z -u -- .
    Running in background: git --no-pager ls-files -z -o --exclude-standard -- .
    Done in background: git --no-pager ls-files -z -o --exclude-standard -- .
    Paused 50 ms waiting for vc-dir-busy
    Running in foreground: git --no-pager checkout -b feature/foo master .

IOW waiting for vc-dir-busy *after* invoking vc-dir seems to work fine,
which makes complete sense, and I am not sure why I never thought about
this in the first place?

Let me know if we favor this approach, in which case I'll add the
finishing touches on that patch (docstring, changelog).

diff --git a/test/lisp/vc/vc-git-tests.el b/test/lisp/vc/vc-git-tests.el
index 4b5cb75df01..78af4d1665c 100644
--- a/test/lisp/vc/vc-git-tests.el
+++ b/test/lisp/vc/vc-git-tests.el
@@ -106,7 +106,11 @@ vc-git-test--with-repo
 (defun vc-git-test--run (&rest args)
   "Run git ARGS…, check for non-zero status, and return output."
   (with-temp-buffer
-    (apply 'vc-git-command t 0 nil args)
+    (condition-case err
+        (apply 'vc-git-command t 0 nil args)
+      (t (message "err in %s: %s" default-directory err)
+         (message "(buffer-string:\n%s\n)" (buffer-string))
+         (signal (car err) (cdr err))))
     (buffer-string)))
 
 (defun vc-git-test--start-branch ()
@@ -119,18 +123,28 @@ vc-git-test--start-branch
   (vc-git-test--run "commit" "-mFirst")
   (string-trim (vc-git-test--run "branch" "--show-current")))
 
+(defun vc-git-test--vc-dir ()
+  "TODO"
+  (vc-dir default-directory)
+  ;; Wait until background processes are finished; some of them hold
+  ;; index.lock files that would trip the next Git commands.
+  (let ((i 0)
+        (step 50)
+        (max 1000))
+    (while (vc-dir-busy)
+      (when (> (cl-incf i step) max)
+        (error "Timed out waiting for vc-dir-busy"))
+      (sleep-for (/ (float step) max)))
+    (when (> i 0)
+      (message "Paused %d ms waiting for vc-dir-busy" i))))
+
 (defun vc-git-test--dir-headers (headers)
   "Return an alist of header values for the current `vc-dir' buffer.
 
 HEADERS should be a list of (NAME ...) strings.  This function will
 return a list of (NAME . VALUE) pairs, where VALUE is nil if the header
 is absent."
-  ;; FIXME: to reproduce interactive sessions faithfully, we would need
-  ;; to wait for the dir-status-files process to terminate; have not
-  ;; found a reliable way to do this.  As a workaround, kill pending
-  ;; processes and revert the `vc-dir' buffer.
-  (vc-dir-kill-dir-status-process)
-  (revert-buffer)
+  (vc-git-test--vc-dir)
   (mapcar
    (lambda (header)
      (let* ((pattern
@@ -148,46 +162,47 @@ vc-git-test-dir-branch-headers
   (skip-unless (executable-find vc-git-program))
   ;; Create a repository that will serve as the "remote".
   (vc-git-test--with-repo origin-repo
-    (let ((main-branch (vc-git-test--start-branch)))
+    (let ((main-branch (vc-git-test--start-branch))
+          (vc-command-messages t))
       ;; 'git clone' this repository and test things in this clone.
       (ert-with-temp-directory clone-repo
         (vc-git-test--run "clone" origin-repo clone-repo)
-        (vc-dir clone-repo)
-        (should
-         (equal
-          (vc-git-test--dir-headers
-           '("Branch" "Tracking" "Remote"))
-          `(("Branch"   . ,main-branch)
-            ("Tracking" . ,(concat "origin/" main-branch))
-            ("Remote"   . ,origin-repo))))
-        ;; Checkout a new branch: no tracking information.
-        (vc-git-test--run "checkout" "-b" "feature/foo" main-branch)
-        (should
-         (equal
-          (vc-git-test--dir-headers
-           '("Branch" "Tracking" "Remote"))
-          '(("Branch"   . "feature/foo")
-            ("Tracking" . nil)
-            ("Remote"   . nil))))
-        ;; Push with '--set-upstream origin': tracking information
-        ;; should be updated.
-        (vc-git-test--run "push" "--set-upstream" "origin" "feature/foo")
-        (should
-         (equal
-          (vc-git-test--dir-headers
-           '("Branch" "Tracking" "Remote"))
-          `(("Branch"   . "feature/foo")
-            ("Tracking" . "origin/feature/foo")
-            ("Remote"   . ,origin-repo))))
-        ;; Checkout a new branch tracking the _local_ main branch.
-        ;; Bug#68183.
-        (vc-git-test--run "checkout" "-b" "feature/bar" "--track" main-branch)
-        (should
-         (equal
-          (vc-git-test--dir-headers
-           '("Branch" "Tracking" "Remote"))
-          `(("Branch"   . "feature/bar")
-            ("Tracking" . ,main-branch)
-            ("Remote"   . "none (tracking local branch)"))))))))
+        (let ((default-directory clone-repo))
+          (should
+           (equal
+            (vc-git-test--dir-headers
+             '("Branch" "Tracking" "Remote"))
+            `(("Branch"   . ,main-branch)
+              ("Tracking" . ,(concat "origin/" main-branch))
+              ("Remote"   . ,origin-repo))))
+          ;; Checkout a new branch: no tracking information.
+          (vc-git-test--run "checkout" "-b" "feature/foo" main-branch)
+          (should
+           (equal
+            (vc-git-test--dir-headers
+             '("Branch" "Tracking" "Remote"))
+            '(("Branch"   . "feature/foo")
+              ("Tracking" . nil)
+              ("Remote"   . nil))))
+          ;; Push with '--set-upstream origin': tracking information
+          ;; should be updated.
+          (vc-git-test--run "push" "--set-upstream" "origin" "feature/foo")
+          (should
+           (equal
+            (vc-git-test--dir-headers
+             '("Branch" "Tracking" "Remote"))
+            `(("Branch"   . "feature/foo")
+              ("Tracking" . "origin/feature/foo")
+              ("Remote"   . ,origin-repo))))
+          ;; Checkout a new branch tracking the _local_ main branch.
+          ;; Bug#68183.
+          (vc-git-test--run "checkout" "-b" "feature/bar" "--track" main-branch)
+          (should
+           (equal
+            (vc-git-test--dir-headers
+             '("Branch" "Tracking" "Remote"))
+            `(("Branch"   . "feature/bar")
+              ("Tracking" . ,main-branch)
+              ("Remote"   . "none (tracking local branch)")))))))))
 
 ;;; vc-git-tests.el ends here