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)

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
@@ -12,6 +12,20 @@ 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
 
 ** Option 'erc-truncate-padding-size' controls truncation frequency.
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)))