From 08ff832e84470822ff25b733af07f7d750d0cde3 Mon Sep 17 00:00:00 2001 From: Laurence Warne 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 . ;;; 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