bug#59842: [PATCH] Make proced-update Preserve Refinements

[Laurence Warne <laurencewarne@gmail.com>]

[-- 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