From 44cdb65cf3d98f9d6706419a5cf866ff2df79019 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Sun, 26 Oct 2025 06:51:59 -0700 Subject: [PATCH] Fix regression involving erc-channel-user accessors * etc/ERC-NEWS: New section for ERC 5.6.2 and new entry mentioning slight change in `erc-channel-user' accessor behavior. * lisp/erc/erc-common.el (erc-channel-user): Change type for status slot to natnum from integer. * lisp/erc/erc.el (erc-channel-user-signal-if-status-unknown): New variable. (erc--define-channel-user-status-compat-getter): Only use fallback in Non-ERC buffers because "obviously" a status flag is unusable if the server doesn't advertise it or, rather, advertises nonsupport via its absence. This regression was introduced in ERC 5.6. (erc-channel-begin-receiving-names): Sharp-quote function name. (erc--get-prefix-flag): Mention in doc that a return value of nil can also mean the status flag is not supported by the server. * test/lisp/erc/erc-tests.el (erc--parsed-prefix): Show that it returns nil in a non-ERC buffer. (erc-tests--make-combinations) (erc-tests--with-channel-user-status-accessors): New functions. (erc-channel-user/status-accessors/solo/default) (erc-channel-user/status-accessors/solo/ov) (erc-channel-user/status-accessors/multi/default) (erc-channel-user/status-accessors/multi/ov): New tests. (Bug#67220) --- etc/ERC-NEWS | 14 ++++ lisp/erc/erc-common.el | 2 +- lisp/erc/erc.el | 46 +++++++---- test/lisp/erc/erc-tests.el | 158 ++++++++++++++++++++++++++++++++++++- 4 files changed, 203 insertions(+), 17 deletions(-) diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS index 513ed8f706d..932b7a58aa7 100644 --- a/etc/ERC-NEWS +++ b/etc/ERC-NEWS @@ -11,6 +11,20 @@ This file is about changes in ERC, the powerful, modular, and extensible IRC (Internet Relay Chat) client distributed with GNU Emacs since Emacs version 22.1. + +* Changes in ERC 5.6.2 + +** Changes in the library API. + +*** Accessors like 'erc-channel-user-voice' may ignore assignments. +ERC now silently ignores attempts to enable certain status flags on +'erc-channel-user' objects if the connection's "PREFIX" parameter omits +them. In the future, ERC will likely signal an error if such an attempt +is made. Users can preview this potentially disruptive behavior by +setting the new variable 'erc-channel-user-signal-if-status-unknown' to +t. This change stems from a bug fix for a regression affecting ERC 5.6 +and 5.6.1 in which these accessors mishandled unsupported flags. + * Changes in ERC 5.6.1 diff --git a/lisp/erc/erc-common.el b/lisp/erc/erc-common.el index d293e6ba878..e383e92c7ff 100644 --- a/lisp/erc/erc-common.el +++ b/lisp/erc/erc-common.el @@ -100,7 +100,7 @@ ERC only refolds `string', never `substxt'.")) :named) "Object containing channel-specific data for a single user." ;; voice halfop op admin owner - (status 0 :type integer) + (status 0 :type natnum) ;; Last message time (in the form of the return value of ;; (current-time) ;; diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index e26ee8728a3..271c5d5fcf8 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -684,6 +684,11 @@ Also remove members from the server table if this was their only buffer." (funcall original-function nick user)))))) (erc-remove-channel-users))) +(defvar erc-channel-user-signal-if-status-unknown nil + "If non-nil ERC signals before setting an unadvertized status prefix. +But only in ERC buffers. Otherwise, if nil, accessors like +`erc-channel-user-halfop' ignore such attempts and return nil.") + (defmacro erc--define-channel-user-status-compat-getter (name c d) "Define accessor with gv getter for historical `erc-channel-user' slot NAME. Expect NAME to be a string, C to be its traditionally associated letter, @@ -691,19 +696,30 @@ and D to be its fallback power-of-2 integer for non-ERC buffers. Unlike pre-ERC-5.6 accessors, do not bother generating a compiler macro for inlining calls to these adapters." `(defun ,(intern (concat "erc-channel-user-" name)) (u) - ,(format "Get equivalent of pre-5.6 `%s' slot for `erc-channel-user'." - name) - (declare (gv-setter (lambda (v) - (macroexp-let2 nil v v - (,'\`(let ((val (erc-channel-user-status ,',u)) - (n (or (erc--get-prefix-flag ,c) ,d))) - (setf (erc-channel-user-status ,',u) - (if ,',v - (logior val n) - (logand val (lognot n)))) - ,',v)))))) - (let ((n (or (erc--get-prefix-flag ,c) ,d))) - (= n (logand n (erc-channel-user-status u)))))) + ,(concat + "Get equivalent of pre-5.6 `" name "' slot for `erc-channel-user'." + "\nUse a fallback value in non-ERC buffers. Treat an unadvertised" + "\nstatus according to `erc-channel-user-signal-if-status-unknown'.") + (declare (gv-setter + (lambda (v) + (macroexp-let2 nil v v + (,'\`(let* ((val (erc-channel-user-status ,',u)) + (p (erc--parsed-prefix)) + (n (if p (or (erc--get-prefix-flag ,c p) 0) ,d)) + (nop (and p ,',v (zerop n))) ; unsupportedp + (rv (and (not nop) ,',v))) + (when (and nop + erc-channel-user-signal-if-status-unknown) + (error "Unsupported status prefix: %c" ,c)) + (unless nop + (setf (erc-channel-user-status ,',u) + (if ,',v + (logior val n) + (logand val (lognot n))))) + rv)))))) + (let* ((p (erc--parsed-prefix)) + (n (if p (erc--get-prefix-flag ,c p) ,d))) + (and n (= n (logand n (erc-channel-user-status u))))))) (erc--define-channel-user-status-compat-getter "voice" ?v 1) (erc--define-channel-user-status-compat-getter "halfop" ?h 2) @@ -7090,7 +7106,7 @@ Used when a channel names list is about to be received. Should be called with the current buffer set to the channel buffer. See also `erc-channel-end-receiving-names'." - (setq erc-channel-new-member-names (make-hash-table :test 'equal))) + (setq erc-channel-new-member-names (make-hash-table :test #'equal))) (defun erc-channel-end-receiving-names () "Internal function. @@ -7142,7 +7158,7 @@ stand-in from the fallback value \"(qaohv)~&@%+\"." :alist (nreverse alist))))) (defun erc--get-prefix-flag (char &optional parsed-prefix from-prefix-p) - "Return numeric rank for CHAR or nil if unknown. + "Return numeric rank for CHAR or nil if unknown or unsupported. For example, given letters \"qaohv\" return 1 for ?v, 2 for ?h, and 4 for ?o, etc. If given, expect PARSED-PREFIX to be a `erc--parsed-prefix' object. With FROM-PREFIX-P, expect CHAR to diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index 1b486c68584..7ad2d268fa3 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -688,6 +688,9 @@ (should-not (erc--parse-nuh "abc\nde!fg@xy"))) (ert-deftest erc--parsed-prefix () + ;; Effectively a no-op in a non-ERC buffer. + (should-not (erc--parsed-prefix)) + (erc-tests-common-make-server-buf (buffer-name)) ;; Uses fallback values when no PREFIX parameter yet received, thus @@ -817,6 +820,156 @@ (should-not (erc--cusr-status-p cusr ?v)) (should-not (erc--cusr-status-p cusr ?q))))) +(defun erc-tests--make-combinations (flags) + "Return a list of all combinations in FLAGS, preserving order." + (let* ((flags (apply #'vector flags)) + (n (length flags)) + (max (1- (ash 1 n))) + (mask 0) + (out ())) + (while (<= (cl-incf mask) max) + (let ((i 0) + (subset ())) + (while (< i n) + (unless (zerop (logand mask (ash 1 i))) + (push (aref flags i) subset)) + (cl-incf i)) + (when (cdr subset) + (push (nreverse subset) out)))) + out)) + +(defun erc-tests--with-channel-user-status-accessors (test) + (erc-tests-common-make-server-buf) + + (let* ((u (make-erc-channel-user)) + (get (lambda (letter) + (pcase letter + (?v (erc-channel-user-voice u)) + (?h (erc-channel-user-halfop u)) + (?o (erc-channel-user-op u)) + (?a (erc-channel-user-admin u)) + (?q (erc-channel-user-owner u))))) + + (set (lambda (letter val) + (pcase letter + (?v (setf (erc-channel-user-voice u) val)) + (?h (setf (erc-channel-user-halfop u) val)) + (?o (setf (erc-channel-user-op u) val)) + (?a (setf (erc-channel-user-admin u) val)) + (?q (setf (erc-channel-user-owner u) val))))) + + (assert-null + (lambda (&rest letters) + (dolist (letter letters) + (ert-info ((format "Assert null: %c" letter)) + (should-not (funcall get letter)))))) + + (assert-set + (lambda (letter &optional nop) + (ert-info ((format "Assert: %c%s" letter (if nop " (no-op)" ""))) + (should-not (funcall get letter)) + (if (and nop erc-channel-user-signal-if-status-unknown) + (should-error (funcall set letter t)) + ;; If the flag is unsupported, always return nil, + ;; and don't set anything, otherwise, return t. + (let ((rv (funcall set letter t))) + (ert-info ((format "Set: %S" rv)) + (should (xor rv nop))))) + (let ((rv (funcall get letter))) + (ert-info ((format "Get: %S" rv)) + (should (xor rv nop))))))) + + (assert-solo + (lambda (letter &optional nop) + (setf (erc-channel-user-status u) 0) ; clear + (funcall assert-set letter nop) + (apply assert-null (seq-difference '(?v ?h ?o ?a ?q) + (list letter))))) + + (assert-multi + (lambda (&rest supported) + ;; Set all defined flags from smallest to largest rank. + (dolist (flags (erc-tests--make-combinations '(?v ?h ?o ?a ?q))) + (setf (erc-channel-user-status u) 0) + (ert-info ((let ((print-integers-as-characters t)) + (format "Multi %S" (list :flags flags + :supported supported)))) + (let ((seen-supported ()) + (seen-unsupported ())) + (dolist (a flags) + (let ((supportedp (memq a supported))) + (push a (if supportedp seen-supported seen-unsupported)) + (funcall assert-set a (not supportedp)) + ;; Addition of new flag has not corrupted others. + (dolist (aa seen-supported) + (ert-info ((format "Seen supported: %s %c" u aa)) + (should (funcall get aa)))) + (dolist (aa `(,@seen-unsupported ,@(cdr (memq a flags)))) + (should-not (funcall get aa)))))) + ;; Unset in reverse, although not doing so is valid. + (setq flags (nreverse flags)) + (let ((seen ())) + (while-let ((b (pop flags))) + (ert-info ((format "Unsetting: %S %c" u b)) + (should-not (funcall set b nil)) + (dolist (bb (push b seen)) + (ert-info ((format "Seen unset: %c" bb)) + (should-not (funcall get bb)))) + (dolist (bb flags) + (ert-info ((format "Unseen set: %c" bb)) + (if (memq bb supported) + (should (funcall get bb)) + (should-not (funcall get bb))))))))))))) + + ;; Run the same test twice, with compat flag nil and non-nil. + (let ((erc-channel-user-signal-if-status-unknown nil)) + (funcall test assert-null assert-set assert-solo assert-multi)) + + (ert-info ("With `erc-channel-user-signal-if-status-unknown'") + (setf (erc-channel-user-status u) 0) ; clear + (let ((erc-channel-user-signal-if-status-unknown t)) + (funcall test assert-null assert-set assert-solo assert-multi))) + + (erc-tests-common-kill-buffers))) + +(ert-deftest erc-channel-user/status-accessors/solo/default () + (erc-tests--with-channel-user-status-accessors + (lambda (assert-null _assert-set assert-solo _assert-multi) + + (ert-info ("Baseline") + (funcall assert-null ?v ?h ?o ?a ?q)) + + (ert-info ("+v") (funcall assert-solo ?v)) + (ert-info ("+h") (funcall assert-solo ?h)) + (ert-info ("+o") (funcall assert-solo ?o)) + (ert-info ("+a") (funcall assert-solo ?a)) + (ert-info ("+q") (funcall assert-solo ?q))))) + +(ert-deftest erc-channel-user/status-accessors/solo/ov () + (erc-tests--with-channel-user-status-accessors + (lambda (assert-null _assert-set assert-solo _assert-multi) + (erc-tests-common-simulate-line ":irc.gnu.org 005 tester PREFIX=(ov)@+") + + (ert-info ("Baseline") + (funcall assert-null ?v ?h ?o ?a ?q)) + + (ert-info ("+v") (funcall assert-solo ?v)) + (ert-info ("+h (unknown)") (funcall assert-solo ?h 'nop)) + (ert-info ("+o") (funcall assert-solo ?o)) + (ert-info ("+a (unknown)") (funcall assert-solo ?a 'nop)) + (ert-info ("+q (unknown)") (funcall assert-solo ?q 'nop))))) + +(ert-deftest erc-channel-user/status-accessors/multi/default () + (erc-tests--with-channel-user-status-accessors + (lambda (_assert-null _assert-set _assert-solo assert-multi) + (funcall assert-multi ?v ?h ?o ?a ?q)))) + +(ert-deftest erc-channel-user/status-accessors/multi/ov () + (erc-tests--with-channel-user-status-accessors + (lambda (_assert-null _assert-set _assert-solo assert-multi) + (erc-tests-common-simulate-line ":irc.gnu.org 005 tester PREFIX=(ov)@+") + (funcall assert-multi ?v ?o)))) + ;; This exists as a reference to assert legacy behavior in order to ;; preserve and incorporate it as a fallback in the 5.6+ replacement. (ert-deftest erc-parse-modes () @@ -3489,8 +3642,11 @@ (when noninteractive (erc-tests-common-kill-buffers))) +;; For legacy accessors, like `erc-channel-user-halfop', this test only +;; demonstrates compat-oriented behavior in a non-ERC buffer. See +;; `erc-tests--with-channel-user-status-accessors' based tests for +;; behavior in ERC buffers, both fallback and ISUPPORT-defined. (ert-deftest erc-channel-user () - ;; Traditional and alternate constructor swapped for compatibility. (should (= 0 (erc-channel-user-status (erc-channel-user--make)))) (should-not (erc-channel-user-last-message-time (erc-channel-user--make)))