diff options
| author | Laurence Warne | 2024-10-27 16:50:20 +0100 |
|---|---|---|
| committer | Michael Albinus | 2024-10-27 16:50:20 +0100 |
| commit | 7a8ca202c5eeb810e5f86510c3ea46d3ec519222 (patch) | |
| tree | 816a0f20ecbde2fb4008e4fcf64774528f5869f2 | |
| parent | 55a8cec013e8879da2c79cd8fbe387d8d2822166 (diff) | |
| download | emacs-7a8ca202c5eeb810e5f86510c3ea46d3ec519222.tar.gz emacs-7a8ca202c5eeb810e5f86510c3ea46d3ec519222.zip | |
Fix flakey proced refine tests (Bug#73441)
* test/lisp/proced-tests.el (proced-refine-test)
(proced-refine-with-update-test): Use the much simpler CPU refinement
for testing 'proced-refine'. The previous tests made the incorrect
assumption that refining on the PID of process A only filtered the
buffer to contain process A and its children, whereas in actuality
the children of process A's children, their children, and so on will
also be shown.
(proced-update-preserves-pid-at-point-test): Mark as unstable.
| -rw-r--r-- | test/lisp/proced-tests.el | 43 |
1 files changed, 20 insertions, 23 deletions
diff --git a/test/lisp/proced-tests.el b/test/lisp/proced-tests.el index 6f16a241146..b612e172ffb 100644 --- a/test/lisp/proced-tests.el +++ b/test/lisp/proced-tests.el | |||
| @@ -43,18 +43,14 @@ | |||
| 43 | 43 | ||
| 44 | (defun proced--move-to-column (attribute) | 44 | (defun proced--move-to-column (attribute) |
| 45 | "Move to the column under ATTRIBUTE in the current proced buffer." | 45 | "Move to the column under ATTRIBUTE in the current proced buffer." |
| 46 | (move-to-column (string-match attribute proced-header-line))) | 46 | (move-to-column (string-match attribute proced-header-line)) |
| 47 | 47 | ;; Sometimes the column entry does not fill the whole column. | |
| 48 | (defun proced--assert-process-valid-pid-refinement (pid) | 48 | (while (= (char-after (point)) ?\s) (forward-char))) |
| 49 | "Fail unless the process at point could be present after a refinement using PID." | 49 | |
| 50 | (proced--move-to-column "PID") | 50 | (defun proced--assert-process-valid-cpu-refinement (cpu) |
| 51 | (let ((pid-equal (string= pid (word-at-point)))) | 51 | "Fail unless the process at point could be present after a refinement using CPU." |
| 52 | (should | 52 | (proced--move-to-column "%CPU") |
| 53 | (or pid-equal | 53 | (should (>= (thing-at-point 'number) cpu))) |
| 54 | ;; Guard against the unlikely event a platform doesn't support PPID | ||
| 55 | (when (string-match "PPID" proced-header-line) | ||
| 56 | (proced--move-to-column "PPID") | ||
| 57 | (string= pid (word-at-point))))))) | ||
| 58 | 54 | ||
| 59 | (ert-deftest proced-format-test () | 55 | (ert-deftest proced-format-test () |
| 60 | (dolist (format '(short medium long verbose)) | 56 | (dolist (format '(short medium long verbose)) |
| @@ -85,26 +81,24 @@ | |||
| 85 | (proced--assert-emacs-pid-in-buffer)))) | 81 | (proced--assert-emacs-pid-in-buffer)))) |
| 86 | 82 | ||
| 87 | (ert-deftest proced-refine-test () | 83 | (ert-deftest proced-refine-test () |
| 88 | ;;(skip-unless (memq system-type '(gnu/linux gnu/kfreebsd darwin))) | ||
| 89 | (proced--within-buffer | 84 | (proced--within-buffer |
| 90 | 'verbose | 85 | 'verbose |
| 91 | 'user | 86 | 'user |
| 92 | ;; When refining on PID for process A, a process is kept if and only | 87 | ;; When refining on %CPU for process A, a process is kept if and only |
| 93 | ;; if its PID is the same as process A, or its parent process is | 88 | ;; if its %CPU is greater than or equal to that of process A. |
| 94 | ;; process A. | 89 | (proced--move-to-column "%CPU") |
| 95 | (proced--move-to-column "PID") | 90 | (let ((cpu (thing-at-point 'number))) |
| 96 | (let ((pid (word-at-point))) | ||
| 97 | (proced-refine) | 91 | (proced-refine) |
| 98 | (while (not (eobp)) | 92 | (while (not (eobp)) |
| 99 | (proced--assert-process-valid-pid-refinement pid) | 93 | (proced--assert-process-valid-cpu-refinement cpu) |
| 100 | (forward-line))))) | 94 | (forward-line))))) |
| 101 | 95 | ||
| 102 | (ert-deftest proced-refine-with-update-test () | 96 | (ert-deftest proced-refine-with-update-test () |
| 103 | (proced--within-buffer | 97 | (proced--within-buffer |
| 104 | 'verbose | 98 | 'verbose |
| 105 | 'user | 99 | 'user |
| 106 | (proced--move-to-column "PID") | 100 | (proced--move-to-column "%CPU") |
| 107 | (let ((pid (word-at-point))) | 101 | (let ((cpu (thing-at-point 'number))) |
| 108 | (proced-refine) | 102 | (proced-refine) |
| 109 | ;; Don't use (proced-update t) since this will reset `proced-process-alist' | 103 | ;; Don't use (proced-update t) since this will reset `proced-process-alist' |
| 110 | ;; and it's possible the process refined on would have exited by that | 104 | ;; and it's possible the process refined on would have exited by that |
| @@ -112,10 +106,13 @@ | |||
| 112 | ;; processes again, causing the test to fail. | 106 | ;; processes again, causing the test to fail. |
| 113 | (proced-update) | 107 | (proced-update) |
| 114 | (while (not (eobp)) | 108 | (while (not (eobp)) |
| 115 | (proced--assert-process-valid-pid-refinement pid) | 109 | (proced--assert-process-valid-cpu-refinement cpu) |
| 116 | (forward-line))))) | 110 | (forward-line))))) |
| 117 | 111 | ||
| 118 | (ert-deftest proced-update-preserves-pid-at-point-test () | 112 | (ert-deftest proced-update-preserves-pid-at-point-test () |
| 113 | ;; FIXME: Occasionally the cursor inexplicably changes to the first line which | ||
| 114 | ;; causes the test to file when the line isn't the Emacs process. | ||
| 115 | :tags '(:unstable) | ||
| 119 | (proced--within-buffer | 116 | (proced--within-buffer |
| 120 | 'medium | 117 | 'medium |
| 121 | 'user | 118 | 'user |
| @@ -128,7 +125,7 @@ | |||
| 128 | (old-window (get-buffer-window))) | 125 | (old-window (get-buffer-window))) |
| 129 | (select-window new-window) | 126 | (select-window new-window) |
| 130 | (with-current-buffer "*Proced*" | 127 | (with-current-buffer "*Proced*" |
| 131 | (proced-update t t)) | 128 | (proced-update)) |
| 132 | (select-window old-window) | 129 | (select-window old-window) |
| 133 | (should (= pid (proced-pid-at-point))))))) | 130 | (should (= pid (proced-pid-at-point))))))) |
| 134 | 131 | ||