Merge from origin/emacs-30

98796f95fa5 Work on proced-tests.el
8a4d13e370c ; * doc/lispref/frames.texi (Yanking Media): Add index en...
0aae02a3741 * lisp/files.el (require-with-check): Be a bit more lenie...
cc6a11f4832 (with-peg-rules): Fix references to rulesets (bug#74018)
70f084db2ff ; * etc/NEWS: Fix typo (bug#74066).
9e1abf11fc1 Tweak doc w.r.t to "void function" (bug#73886)
7a8ca202c5e Fix flakey proced refine tests (Bug#73441)
55a8cec013e Another 'void' update

1 files changed, 37 insertions, 23 deletions

diff --git a/test/lisp/proced-tests.el b/test/lisp/proced-tests.el
index 6f16a241146..9036c15271c 100644
--- a/test/lisp/proced-tests.el
+++ b/test/lisp/proced-tests.el
@@ -43,18 +43,31 @@
 
 (defun proced--move-to-column (attribute)
   "Move to the column under ATTRIBUTE in the current proced buffer."
-  (move-to-column (string-match attribute proced-header-line)))
-
-(defun proced--assert-process-valid-pid-refinement (pid)
-  "Fail unless the process at point could be present after a refinement using PID."
-  (proced--move-to-column "PID")
-  (let ((pid-equal (string= pid (word-at-point))))
-    (should
-     (or pid-equal
-         ;; Guard against the unlikely event a platform doesn't support PPID
-         (when (string-match "PPID" proced-header-line)
-           (proced--move-to-column "PPID")
-           (string= pid (word-at-point)))))))
+  (move-to-column (string-match attribute proced-header-line))
+  ;; Sometimes the column entry does not fill the whole column.
+  (while (= (char-after (point)) ?\s) (forward-char)))
+
+(defun proced--assert-process-valid-cpu-refinement (cpu)
+  "Fail unless the process at point could be present after a refinement using CPU."
+  (proced--move-to-column "%CPU")
+  (>= (thing-at-point 'number) cpu))
+
+(defun proced--assert-process-valid-cpu-refinement-explainer (cpu)
+  "Explain the result of `proced--assert-process-valid-cpu-refinement'.
+
+CPU is as in `proced--assert-process-valid-cpu-refinement'."
+  `(unexpected-refinement
+    (header-line
+     ,(substring-no-properties
+       (string-replace "%%" "%" (cadr (proced-header-line)))))
+    (process ,(thing-at-point 'line t))
+    (refined-value ,cpu)
+    (process-value
+     ,(save-excursion
+        (proced--move-to-column "%CPU") (thing-at-point 'number)))))
+
+(put #'proced--assert-process-valid-cpu-refinement 'ert-explainer
+     #'proced--assert-process-valid-cpu-refinement-explainer)
 
 (ert-deftest proced-format-test ()
   (dolist (format '(short medium long verbose))
@@ -85,26 +98,24 @@
      (proced--assert-emacs-pid-in-buffer))))
 
 (ert-deftest proced-refine-test ()
-  ;;(skip-unless (memq system-type '(gnu/linux gnu/kfreebsd darwin)))
   (proced--within-buffer
    'verbose
    'user
-   ;; When refining on PID for process A, a process is kept if and only
-   ;; if its PID is the same as process A, or its parent process is
-   ;; process A.
-   (proced--move-to-column "PID")
-   (let ((pid (word-at-point)))
+   ;; When refining on %CPU for process A, a process is kept if and only
+   ;; if its %CPU is greater than or equal to that of process A.
+   (proced--move-to-column "%CPU")
+   (let ((cpu (thing-at-point 'number)))
      (proced-refine)
      (while (not (eobp))
-       (proced--assert-process-valid-pid-refinement pid)
+       (should (proced--assert-process-valid-cpu-refinement cpu))
        (forward-line)))))
 
 (ert-deftest proced-refine-with-update-test ()
   (proced--within-buffer
    'verbose
    'user
-   (proced--move-to-column "PID")
-   (let ((pid (word-at-point)))
+   (proced--move-to-column "%CPU")
+   (let ((cpu (thing-at-point 'number)))
      (proced-refine)
      ;; Don't use (proced-update t) since this will reset `proced-process-alist'
      ;; and it's possible the process refined on would have exited by that
@@ -112,10 +123,13 @@
      ;; processes again, causing the test to fail.
      (proced-update)
      (while (not (eobp))
-       (proced--assert-process-valid-pid-refinement pid)
+       (should (proced--assert-process-valid-cpu-refinement cpu))
        (forward-line)))))
 
 (ert-deftest proced-update-preserves-pid-at-point-test ()
+  ;; FIXME: Occasionally the cursor inexplicably changes to the first line which
+  ;; causes the test to file when the line isn't the Emacs process.
+  :tags '(:unstable)
   (proced--within-buffer
    'medium
    'user
@@ -128,7 +142,7 @@
            (old-window (get-buffer-window)))
        (select-window new-window)
        (with-current-buffer "*Proced*"
-         (proced-update t t))
+         (proced-update))
        (select-window old-window)
        (should (= pid (proced-pid-at-point)))))))