* bug#59842: [PATCH] Make proced-update Preserve Refinements
2022-12-06 17:49 ` Eli Zaretskii
@ 2022-12-08 19:06 ` Laurence Warne
2022-12-14 14:55 ` Eli Zaretskii
0 siblings, 1 reply; 4+ messages in thread
From: Laurence Warne @ 2022-12-08 19:06 UTC (permalink / raw)
To: Eli Zaretskii; +Cc: 59842
[-- Attachment #1.1: Type: text/plain, Size: 1211 bytes --]
> Thanks. Unfortunately, we don't have a test suite for proced.el, so
> non-trivial changes to it always ruin the risk of producing regressions.
> How to test this, and how did you test it?
If it's helpful, I've attached a (seperate) patch containing a test suite
(or at least the start of) for proced.el (though some parts are somewhat
awkward - mainly testing the proced buffer contains strings we would expect
- of course comments on the approach welcome), the last test there:
'proced-refine-with-update-test' fails without the original patch. I
didn't want to conflate the original patch with it, I can open a new report
with it if you prefer.
> What happens if that process did exit? Shouldn't we reset
> proced-refinements to nil?
This could lead to bad behaviour if multiple refinements are active in a
buffer, for example if I refine by CPU usage of process A (which makes
proced only show processes with usage >= process A's) and then again by the
CPU usage of process B, if process A exits, our second refinement is still
valid (given process B is still running) eventhough the first isn't. We
could remove the refinement from the list, but it wouldn't change the
behaviour.
Thanks, Laurence
[-- Attachment #1.2: Type: text/html, Size: 1445 bytes --]
[-- Attachment #2: 0001-Make-proced-update-preserve-refinements.patch --]
[-- Type: text/x-patch, Size: 5004 bytes --]
From 443d7cd9cc82b0d8d90f363475b19c1ed88883f0 Mon Sep 17 00:00:00 2001
From: Laurence Warne <laurencewarne@gmail.com>
Date: Sat, 3 Dec 2022 21:41:57 +0000
Subject: [PATCH] Make proced-update preserve refinements
Make proced-update preserve refinements by creating a new buffer local
variable proced-refinements which stores information about the current
refinements and is used by proced-update to further refine
proced-process-alist in the case it is non-nil. The result is that
refinements are not immediately cleared when a proced buffer is
updated with proced-auto-update-flag non-nil. proced-revert
maintains its current behaviour of clearing any active refinements.
* lisp/proced.el (proced-refinements): New buffer local variable
which tracks the current refinements.
(proced-refine): Set 'proced-refinements' variable and defer setting of
'proced-process-alist' to 'proced-update'.
(proced-update): Take into account 'proced-refinements' when setting
'proced-process-alist'.
(proced-revert): Set 'proced-refinements' to nil prior to calling
'proced-update'.
---
lisp/proced.el | 52 +++++++++++++++++++++++++++++++++-----------------
1 file changed, 34 insertions(+), 18 deletions(-)
diff --git a/lisp/proced.el b/lisp/proced.el
index c7419288ed..c09ee18a8b 100644
--- a/lisp/proced.el
+++ b/lisp/proced.el
@@ -656,6 +656,14 @@ proced-mode-map
)
(put 'proced-mark :advertised-binding "m")
+(defvar-local proced-refinements nil
+ "Information about the current buffer refinements.
+
+It should be a list of elements of the form (REFINER PID KEY GRAMMAR), where
+REFINER and GRAMMAR are as described in `proced-grammar-alist', PID is the
+process ID of the process used to create the refinement, and KEY the attribute
+of the process. A value of nil indicates that there are no active refinements.")
+
(easy-menu-define proced-menu proced-mode-map
"Proced Menu."
`("Proced"
@@ -1337,20 +1345,7 @@ proced-refine
(let* ((grammar (assq key proced-grammar-alist))
(refiner (nth 7 grammar)))
(when refiner
- (cond ((functionp (car refiner))
- (setq proced-process-alist (funcall (car refiner) pid)))
- ((consp refiner)
- (let ((predicate (nth 4 grammar))
- (ref (cdr (assq key (cdr (assq pid proced-process-alist)))))
- val new-alist)
- (dolist (process proced-process-alist)
- (setq val (funcall predicate (cdr (assq key (cdr process))) ref))
- (if (cond ((not val) (nth 2 refiner))
- ((eq val 'equal) (nth 1 refiner))
- (val (car refiner)))
- (push process new-alist)))
- (setq proced-process-alist new-alist))))
- ;; Do not revert listing.
+ (add-to-list 'proced-refinements (list refiner pid key grammar) t)
(proced-update)))
(message "No refiner defined here."))))
@@ -1859,10 +1854,29 @@ proced-update
"Updating process display...")))
(if revert ;; evaluate all processes
(setq proced-process-alist (proced-process-attributes)))
- ;; filtering and sorting
+ ;; filtering
+ (setq proced-process-alist (proced-filter proced-process-alist proced-filter))
+ ;; refinements
+ (pcase-dolist (`(,refiner ,pid ,key ,grammar) proced-refinements)
+ ;; It's possible the process has exited since the refinement was made
+ (when (assq pid proced-process-alist)
+ (cond ((functionp (car refiner))
+ (setq proced-process-alist (funcall (car refiner) pid)))
+ ((consp refiner)
+ (let ((predicate (nth 4 grammar))
+ (ref (cdr (assq key (cdr (assq pid proced-process-alist)))))
+ val new-alist)
+ (dolist (process proced-process-alist)
+ (setq val (funcall predicate (cdr (assq key (cdr process))) ref))
+ (when (cond ((not val) (nth 2 refiner))
+ ((eq val 'equal) (nth 1 refiner))
+ (val (car refiner)))
+ (push process new-alist)))
+ (setq proced-process-alist new-alist))))))
+
+ ;; sorting
(setq proced-process-alist
- (proced-sort (proced-filter proced-process-alist proced-filter)
- proced-sort proced-descend))
+ (proced-sort proced-process-alist proced-sort proced-descend))
;; display as process tree?
(setq proced-process-alist
@@ -1976,7 +1990,9 @@ proced-update
(defun proced-revert (&rest _args)
"Reevaluate the process listing based on the currently running processes.
-Preserves point and marks."
+Preserves point and marks, but not refinements (see `proced-refine' for
+information on refinements)."
+ (setq proced-refinements nil)
(proced-update t))
(defun proced-marked-processes ()
--
2.30.2
[-- Attachment #3: 0001-Add-tests-for-proced.patch --]
[-- Type: text/x-patch, Size: 4502 bytes --]
From 366b18cee7b710f6d0ee7bd86497c21fc0729242 Mon Sep 17 00:00:00 2001
From: Laurence Warne <laurencewarne@gmail.com>
Date: Thu, 8 Dec 2022 13:39:00 +0000
Subject: [PATCH] Add tests for proced
* test/lisp/proced-tests.el: New file.
---
test/lisp/proced-tests.el | 109 ++++++++++++++++++++++++++++++++++++++
1 file changed, 109 insertions(+)
create mode 100644 test/lisp/proced-tests.el
diff --git a/test/lisp/proced-tests.el b/test/lisp/proced-tests.el
new file mode 100644
index 0000000000..78d1b6aa40
--- /dev/null
+++ b/test/lisp/proced-tests.el
@@ -0,0 +1,109 @@
+;;; proced-tests.el --- Test suite for proced.el -*- lexical-binding: t -*-
+
+;; Copyright (C) 2022 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Code:
+(require 'ert)
+(require 'proced)
+
+(cl-defmacro proced--within-buffer (format filter &body body)
+ "Execute BODY within a proced buffer using format FORMAT and filter FILTER."
+ `(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."
+ (should (string-match-p
+ (number-to-string (emacs-pid))
+ (buffer-substring-no-properties (point-min) (point-max)))))
+
+(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)))
+
+(ert-deftest proced-format-test ()
+ (skip-unless (memq system-type '(gnu/linux gnu/kfreebsd darwin)))
+ (dolist (format '(short medium long verbose))
+ (proced--within-buffer
+ format
+ 'user
+ (proced--assert-emacs-pid-in-buffer))))
+
+(ert-deftest proced-update-test ()
+ (skip-unless (memq system-type '(gnu/linux gnu/kfreebsd darwin)))
+ (proced--within-buffer
+ 'short
+ 'user
+ (proced-update)
+ (proced--assert-emacs-pid-in-buffer)))
+
+(ert-deftest proced-revert-test ()
+ (skip-unless (memq system-type '(gnu/linux gnu/kfreebsd darwin)))
+ (proced--within-buffer
+ 'short
+ 'user
+ (proced-revert)
+ (proced--assert-emacs-pid-in-buffer)))
+
+(ert-deftest proced-color-test ()
+ (skip-unless (memq system-type '(gnu/linux gnu/kfreebsd darwin)))
+ (let ((proced-enable-color-flag t))
+ (proced--within-buffer
+ 'short
+ 'user
+ (proced--assert-emacs-pid-in-buffer))))
+
+(ert-deftest proced-refine-test ()
+ (skip-unless (memq system-type '(gnu/linux gnu/kfreebsd darwin)))
+ (proced--within-buffer
+ 'medium
+ 'user
+ ;; When refining on Args for process A, a process is kept if and only
+ ;; if its args are the same as process A, which more or less guarentees
+ ;; the refinement will remove some processes.
+ (proced--move-to-column "Args")
+ (let ((args (buffer-substring-no-properties (point) (line-end-position))))
+ (proced-refine)
+ (while (not (eobp))
+ (proced--move-to-column "Args")
+ (should (string= args (buffer-substring-no-properties (point) (line-end-position))))
+ (forward-line)))))
+
+(ert-deftest proced-refine-with-update-test ()
+ (skip-unless (memq system-type '(gnu/linux gnu/kfreebsd darwin)))
+ (proced--within-buffer
+ 'medium
+ 'user
+ (proced--move-to-column "Args")
+ (let ((args (buffer-substring-no-properties (point) (line-end-position))))
+ (proced-refine)
+ (proced-update t)
+ (while (not (eobp))
+ (proced--move-to-column "Args")
+ (should (string= args (buffer-substring-no-properties (point) (line-end-position))))
+ (forward-line)))))
+
+(provide 'proced-tests)
+;;; proced-tests.el ends here
--
2.30.2
^ permalink raw reply related [flat|nested] 4+ messages in thread