mirrors/emacs
1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2025-12-05 22:20:24 -08:00
Code Issues Projects Releases Wiki Activity

Fix regression involving erc-channel-user accessors

Browse source 
* 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)
This commit is contained in:
F. Jason Park 2025-10-26 06:51:59 -07:00
parent 2fa768dd4b
commit 44cdb65cf3
4 changed files with 203 additions and 17 deletions
Download patch file Download diff file Expand all files Collapse all files

14
etc/ERC-NEWS
View file

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

2
lisp/erc/erc-common.el
View file

@ -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)
;;

38
lisp/erc/erc.el
View file

@ -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)
,(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))
(n (or (erc--get-prefix-flag ,c) ,d)))
(,'\`(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))))
,',v))))))
(let ((n (or (erc--get-prefix-flag ,c) ,d)))
(= n (logand n (erc-channel-user-status u))))))
(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

158
test/lisp/erc/erc-tests.el
View file

@ -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)))