bug#63550: proced-refine-with-update-test is racy

[Laurence Warne <laurencewarne@gmail.com>]

[-- Attachment #1.1: Type: text/plain, Size: 663 bytes --]

Hi,

> The proced test `proced-refine-with-update-test` seems to have an update
race which makes it fail randomly. (This is on macOS, but I see no reason
it would be much different elsewhere.)

Strange, I can't seem to reproduce running it continuously (I'm on linux
also).  Though whilst looking over the test suite, I don't think I like the
approach I took.  I've attached a new patch which changes the test suite to
mock the list of active processes (of course comments welcome).

Are either of you able to test whether this fixes the test in question?
The change also makes the tests a lot faster to run and hopefully less
system dependent.

Thanks, Laurence

[-- Attachment #1.2: Type: text/html, Size: 838 bytes --]

[-- Attachment #2: 0001-Mock-processes-in-proced-test.patch --]
[-- Type: text/x-patch, Size: 6138 bytes --]

From 08ff832e84470822ff25b733af07f7d750d0cde3 Mon Sep 17 00:00:00 2001
From: Laurence Warne <laurencewarne@gmail.com>
Date: Sat, 20 May 2023 20:24:45 +0100
Subject: [PATCH] Mock processes in proced-test

Mock 'list-system-processes' and 'process-attributes' for Proced tests
in order to mock a list of existing processes.

* test/lisp/proced-tests.el (proced--within-buffer): Allow a list of
processes to specified as a parameter to be used as mocks.
(proced-format-test, proced-update-test)
(proced-update-preserves-pid-at-point-test, proced-revert-test)
(proced-color-test, proced-refine-test, proced-refine-with-update-test)
(proced-update-preserves-pid-at-point-test): Adapt to use mocks.
---
 test/lisp/proced-tests.el | 101 ++++++++++++++++++++++++++++----------
 1 file changed, 76 insertions(+), 25 deletions(-)

diff --git a/test/lisp/proced-tests.el b/test/lisp/proced-tests.el
index d69414cf43a..06c427d056f 100644
--- a/test/lisp/proced-tests.el
+++ b/test/lisp/proced-tests.el
@@ -18,26 +18,69 @@
 ;; along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.
 
 ;;; Code:
+(require 'cl-lib)
 (require 'ert)
 (require 'proced)
 (require 'thingatpt)
 
-(cl-defmacro proced--within-buffer (format filter &body body)
-  "Execute BODY within a proced buffer using format FORMAT and filter FILTER."
+(defconst proced--mock-process-attributes
+  '((args . "/sbin/init")
+    (pmem . 0.03338765170917735)
+    (pcpu . 0.008040037401062874)
+    (etime 0 20149 160000 0)
+    (rss . 10964)
+    (vsize . 164524)
+    (start 25704 42324 637481 508000)
+    (thcount . 1)
+    (nice . 0)
+    (pri . 20)
+    (ctime 0 873 550000 0)
+    (cstime 0 16 30000 0)
+    (cutime 0 857 520000 0)
+    (time 0 1 620000 0)
+    (stime 0 1 360000 0)
+    (utime 0 0 260000 0)
+    (cmajflt . 3931)
+    (cminflt . 425816)
+    (majflt . 162)
+    (minflt . 25825)
+    (tpgid . -1)
+    (ttname . "")
+    (sess . 1)
+    (pgrp . 1)
+    (ppid . 0)
+    (state . "S")
+    (comm . "systemd")
+    (group . "root")
+    (egid . 0)
+    (user . "root")
+    (euid . 0))
+  "A mocked list of process attributes.")
+
+(defconst proced--mock-pid 34123)
+
+(cl-defmacro proced--within-buffer (format filter processes &body body)
+  "Execute BODY within a proced buffer using format FORMAT and filter FILTER.
+
+Also use PROCESSES as a mocked list of processes."
   `(let ((proced-format ,format)
          (proced-filter ,filter)
          (proced-auto-update-flag nil)
          (inhibit-message t))
-     (proced)
-     (unwind-protect
-         (with-current-buffer "*Proced*"
-           ,@body)
-       (kill-buffer "*Proced*"))))
-
-(defun proced--assert-emacs-pid-in-buffer ()
-  "Fail unless the process ID of the current Emacs process exists in buffer."
+     (cl-letf (((symbol-function 'list-system-processes)
+                (lambda (&rest args) (mapcar #'car ,processes)))
+               ((symbol-function 'process-attributes)
+                (lambda (process) (alist-get process ,processes))))
+       (proced)
+       (unwind-protect
+           (with-current-buffer "*Proced*"
+             ,@body)
+         (kill-buffer "*Proced*")))))
+
+(defun proced--assert-pid-in-buffer (pid)
+  "Fail unless PID exists in the current buffer."
   (should (string-match-p
-           (number-to-string (emacs-pid))
+           (number-to-string pid)
            (buffer-substring-no-properties (point-min) (point-max)))))
 
 (defun proced--move-to-column (attribute)
@@ -48,35 +91,40 @@ proced-format-test
   (dolist (format '(short medium long verbose))
     (proced--within-buffer
      format
-     'user
-     (proced--assert-emacs-pid-in-buffer))))
+     'all
+     `((,proced--mock-pid . ,proced--mock-process-attributes))
+     (proced--assert-pid-in-buffer proced--mock-pid))))
 
 (ert-deftest proced-update-test ()
   (proced--within-buffer
    'short
-   'user
+   'all
+   `((,proced--mock-pid . ,proced--mock-process-attributes))
    (proced-update)
-   (proced--assert-emacs-pid-in-buffer)))
+   (proced--assert-pid-in-buffer proced--mock-pid)))
 
 (ert-deftest proced-revert-test ()
   (proced--within-buffer
    'short
-   'user
+   'all
+   `((,proced--mock-pid . ,proced--mock-process-attributes))
    (proced-revert)
-   (proced--assert-emacs-pid-in-buffer)))
+   (proced--assert-pid-in-buffer proced--mock-pid)))
 
 (ert-deftest proced-color-test ()
   (let ((proced-enable-color-flag t))
     (proced--within-buffer
      'short
-     'user
-     (proced--assert-emacs-pid-in-buffer))))
+     'all
+     `((,proced--mock-pid . ,proced--mock-process-attributes))
+     (proced--assert-pid-in-buffer proced--mock-pid))))
 
 (ert-deftest proced-refine-test ()
-  ;;(skip-unless (memq system-type '(gnu/linux gnu/kfreebsd darwin)))
   (proced--within-buffer
    'medium
-   'user
+   'all
+   `((,proced--mock-pid . ,proced--mock-process-attributes)
+     (,(1+ proced--mock-pid) . ,proced--mock-process-attributes))
    ;; When refining on PID for process A, a process is kept if and only
    ;; if its PID are the same as process A, which more or less guarentees
    ;; the refinement will remove some processes.
@@ -89,10 +137,11 @@ proced-refine-test
        (forward-line)))))
 
 (ert-deftest proced-refine-with-update-test ()
-  :tags '(:unstable)   ; There seems to be an update race here.
   (proced--within-buffer
    'medium
-   'user
+   'all
+   `((,proced--mock-pid . ,proced--mock-process-attributes)
+     (,(1+ proced--mock-pid) . ,proced--mock-process-attributes))
    (proced--move-to-column "PID")
    (let ((pid (word-at-point)))
      (proced-refine)
@@ -105,9 +154,11 @@ proced-refine-with-update-test
 (ert-deftest proced-update-preserves-pid-at-point-test ()
   (proced--within-buffer
    'medium
-   'user
+   'all
+   `((,proced--mock-pid . ,proced--mock-process-attributes)
+     (,(1+ proced--mock-pid) . ,proced--mock-process-attributes))
    (goto-char (point-min))
-   (search-forward (number-to-string (emacs-pid)))
+   (search-forward (number-to-string proced--mock-pid))
    (proced--move-to-column "PID")
    (save-window-excursion
      (let ((pid (proced-pid-at-point))
-- 
2.30.2