procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

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

Browse source 
* 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.
This commit is contained in:
F. Jason Park 2024-10-12 14:33:25 -07:00
parent b00f400d1d
commit a5b2de8b54
2 changed files with 39 additions and 9 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

18
test/lisp/erc/resources/erc-d/erc-d-i.el
View file

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

30
test/lisp/erc/resources/erc-d/erc-d-tests.el
View file

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