From: F. Jason Park <jp@neverwas.me>
Date: Sat, 12 Oct 2024 21:33:25 +0000 (-0700)
Subject: Fix trailing args bug in erc-d-i--parse-message
X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=646eaa0f1e1547b522aa177f1950f6c31f67c35f;p=emacs.git

Fix trailing args bug in erc-d-i--parse-message

* test/lisp/erc/resources/erc-d/erc-d-i.el: Require `subr-x'.
(erc-d-i--parse-message): Populate `contents' slot when lone trailing
arg lacks a preceding colon.
* test/lisp/erc/resources/erc-d/erc-d-tests.el (erc-d-i--parse-message):
Fix expected result.
(erc-d-i--parse-message/privmsg): New test.

(cherry picked from commit a5b2de8b54c3a2d7dcb84f7697e18b2257959dfc)
---

diff --git a/test/lisp/erc/resources/erc-d/erc-d-i.el b/test/lisp/erc/resources/erc-d/erc-d-i.el
index 219ab6d63f0..97cd56408ce 100644
--- a/test/lisp/erc/resources/erc-d/erc-d-i.el
+++ b/test/lisp/erc/resources/erc-d/erc-d-i.el
@@ -22,6 +22,7 @@
 ;;; Code:
 
 (require 'cl-lib)
+(require 'subr-x)
 
 (cl-defstruct (erc-d-i-message (:conc-name erc-d-i-message.))
   "Identical to `erc-response'.
@@ -101,18 +102,19 @@ With DECODE, decode as UTF-8 text."
     (setq s (decode-coding-string s 'utf-8 t)))
   (let ((mes (make-erc-d-i-message :unparsed s :compat (not decode)))
         tokens)
-    (when-let* (((not (string-empty-p s)))
-                ((eq ?@ (aref s 0)))
-                (m (string-match " " s))
-                (u (substring s 1 m)))
+    (when-let (((not (string-empty-p s)))
+               ((eq ?@ (aref s 0)))
+               (m (string-match " " s))
+               (u (substring s 1 m)))
       (setf (erc-d-i-message.tags mes) (erc-d-i--validate-tags u)
             s (substring s (1+ m))))
-    (if-let* ((m (string-match " :" s))
-              (other-toks (split-string (substring s 0 m) " " t))
-              (rest (substring s (+ 2 m))))
+    (if-let ((m (string-search " :" s))
+             (other-toks (split-string (substring s 0 m) " " t))
+             (rest (substring s (+ 2 m))))
         (setf (erc-d-i-message.contents mes) rest
               tokens (nconc other-toks (list rest)))
-      (setq tokens (split-string s " " t " ")))
+      (setf tokens (split-string s " " t " ")
+            (erc-d-i-message.contents mes) (car (last tokens))))
     (when (and tokens (eq ?: (aref (car tokens) 0)))
       (setf (erc-d-i-message.sender mes) (substring (pop tokens) 1)))
     (setf (erc-d-i-message.command mes) (or (pop tokens) "")
diff --git a/test/lisp/erc/resources/erc-d/erc-d-tests.el b/test/lisp/erc/resources/erc-d/erc-d-tests.el
index 63d304907ea..a626ddd8edc 100644
--- a/test/lisp/erc/resources/erc-d/erc-d-tests.el
+++ b/test/lisp/erc/resources/erc-d/erc-d-tests.el
@@ -248,9 +248,37 @@
                   'decode))
       (should-not (erc-d-i-message.compat ours))
       (should (equal (erc-d-i-message.command-args ours) '("#chàn")))
-      (should (equal (erc-d-i-message.contents ours) ""))
+      (should (equal (erc-d-i-message.contents ours) "#chàn"))
       (should (equal (erc-d-i-message.tags ours) '((foo . "çedilla")))))))
 
+(ert-deftest erc-d-i--parse-message/privmsg ()
+  (dolist (raw '(":Bob!~bob@gnu.org PRIVMSG #chan :one two"
+                 ":Bob!~bob@gnu.org PRIVMSG #chan one"
+                 ":Bob!~bob@gnu.org PRIVMSG #chan : "
+                 ":Bob!~bob@gnu.org PRIVMSG #chan :"
+                 "@account=bob :Bob!~bob@gnu.org PRIVMSG #chan one"
+                 "@foo=bar;baz :Bob!~bob@gnu.org PRIVMSG #chan :one"))
+    (dolist (slot '(unparsed
+                    sender
+                    command
+                    command-args
+                    contents
+                    tags))
+      (let ((ours (erc-d-i--parse-message raw))
+            (orig (erc-d-tests--parse-message-upstream raw)))
+        (ert-info ((format "slot: `%s', orig: %S, ours: %S"
+                           slot orig ours))
+          (if (eq slot 'tags)
+              (should (equal (erc-response.tags orig)
+                             (mapcar (pcase-lambda (`(,key . ,value))
+                                       (if value
+                                           (list (symbol-name key) value)
+                                         (list (symbol-name key))))
+                                     (reverse (erc-d-i-message.tags ours)))))
+            (should
+             (equal (cl-struct-slot-value 'erc-d-i-message slot ours)
+                    (cl-struct-slot-value 'erc-response slot orig)))))))))
+
 (ert-deftest erc-d-i--unescape-tag-value ()
   (should (equal (erc-d-i--unescape-tag-value
                   "\\sabc\\sdef\\s\\sxyz\\s")