AtlatestRepositorysigil-irc

sigil-irc / tree / testtest-message.sgl

1;;; Tests for IRC message parsing (including IRCv3 message tags)
2
3(import (sigil test)
4 (sigil irc message))
5
6(test-group "IRC Message Parsing"
7
8 (test-group "parse-irc-message — RFC 1459/2812 line shape"
9
10 (test "parses PRIVMSG with prefix"
11 (let ((msg (parse-irc-message ":nick!user@host PRIVMSG #channel :Hello world")))
12 (assert-true msg)
13 (assert-equal "nick" (irc-message-nick msg))
14 (assert-equal "user" (irc-message-user msg))
15 (assert-equal "host" (irc-message-host msg))
16 (assert-equal 'PRIVMSG (irc-message-command msg))
17 (assert-equal "#channel" (irc-message-target msg))
18 (assert-equal "Hello world" (irc-message-trailing msg))
19 (assert-equal '() (irc-message-tags msg))))
21 (test "parses PING without prefix"
22 (let ((msg (parse-irc-message "PING :server.name")))
23 (assert-true msg)
24 (assert-equal #f (irc-message-prefix msg))
25 (assert-equal #f (irc-message-nick msg))
26 (assert-equal 'PING (irc-message-command msg))
27 (assert-equal "server.name" (irc-message-trailing msg))))
29 (test "parses numeric reply"
30 (let ((msg (parse-irc-message ":server 001 mynick :Welcome to IRC")))
31 (assert-true msg)
32 (assert-equal "server" (irc-message-prefix msg))
33 (assert-equal (string->symbol "001") (irc-message-command msg))
34 (assert-equal "mynick" (irc-message-target msg))
35 (assert-equal "Welcome to IRC" (irc-message-trailing msg))))
37 (test "parses JOIN with trailing channel"
38 (let ((msg (parse-irc-message ":nick!user@host JOIN :#channel")))
39 (assert-true msg)
40 (assert-equal 'JOIN (irc-message-command msg))
41 (assert-equal "#channel" (irc-message-trailing msg))))
43 (test "parses JOIN with param channel"
44 (let ((msg (parse-irc-message ":nick!user@host JOIN #channel")))
45 (assert-true msg)
46 (assert-equal 'JOIN (irc-message-command msg))
47 (assert-equal "#channel" (irc-message-target msg))))
49 (test "parses message with multiple params"
50 (let ((msg (parse-irc-message ":server 332 nick #channel :This is the topic")))
51 (assert-true msg)
52 (assert-equal (string->symbol "332") (irc-message-command msg))
53 (assert-equal '("nick" "#channel") (irc-message-params msg))
54 (assert-equal "This is the topic" (irc-message-trailing msg))))
56 (test "parses server prefix (no user@host)"
57 (let ((msg (parse-irc-message ":irc.server.com NOTICE * :Server notice")))
58 (assert-true msg)
59 (assert-equal "irc.server.com" (irc-message-prefix msg))
60 (assert-equal "irc.server.com" (irc-message-nick msg))
61 (assert-equal #f (irc-message-user msg))
62 (assert-equal #f (irc-message-host msg))))
64 (test "handles empty trailing"
65 (let ((msg (parse-irc-message ":nick!user@host PRIVMSG #channel :")))
66 (assert-true msg)
67 (assert-equal "" (irc-message-trailing msg))))
69 (test "returns #f for empty input"
70 (assert-equal #f (parse-irc-message "")))
72 (test "uppercases commands"
73 (let ((msg (parse-irc-message "ping :test")))
74 (assert-true msg)
75 (assert-equal 'PING (irc-message-command msg)))))
78 (test-group "parse-irc-message — IRCv3 message tags"
80 (test "parses single value tag"
81 (let ((msg (parse-irc-message "@time=2026-04-27T12:00:00Z :nick!u@h PRIVMSG #c :hi")))
82 (assert-true msg)
83 (assert-equal '(("time" . "2026-04-27T12:00:00Z")) (irc-message-tags msg))
84 (assert-equal "2026-04-27T12:00:00Z" (irc-message-tag msg "time"))
85 (assert-equal 'PRIVMSG (irc-message-command msg))
86 (assert-equal "hi" (irc-message-trailing msg))))
88 (test "parses multiple tags"
89 (let ((msg (parse-irc-message "@time=2026Z;account=alice;echo-message :n!u@h PRIVMSG #c :hi")))
90 (assert-true msg)
91 (assert-equal "2026Z" (irc-message-tag msg "time"))
92 (assert-equal "alice" (irc-message-tag msg "account"))
93 (assert-equal 'flag (irc-message-tag msg "echo-message"))
94 (assert-true (irc-message-has-tag? msg "echo-message"))
95 (assert-false (irc-message-has-tag? msg "missing"))))
97 (test "parses tags without prefix"
98 (let ((msg (parse-irc-message "@label=req-123 PING :foo")))
99 (assert-true msg)
100 (assert-equal "req-123" (irc-message-tag msg "label"))
101 (assert-equal 'PING (irc-message-command msg))
102 (assert-equal #f (irc-message-prefix msg))))
104 (test "unescapes tag values"
105 (let ((msg (parse-irc-message "@k=hello\\sworld\\:rest PRIVMSG #c :x")))
106 (assert-equal "hello world;rest" (irc-message-tag msg "k"))))
108 (test "valueless tag returns 'flag"
109 (let ((msg (parse-irc-message "@only-flag PRIVMSG #c :x")))
110 (assert-equal 'flag (irc-message-tag msg "only-flag")))))
113 (test-group "tag escaping/unescaping"
115 (test "escapes semicolons"
116 (assert-equal "a\\:b" (irc-tag-escape "a;b")))
118 (test "escapes spaces"
119 (assert-equal "a\\sb" (irc-tag-escape "a b")))
121 (test "escapes backslashes"
122 (assert-equal "a\\\\b" (irc-tag-escape "a\\b")))
124 (test "escapes CR LF"
125 (assert-equal "a\\r\\nb" (irc-tag-escape "a\r\nb")))
127 (test "round-trips through escape/unescape"
128 (let ((s "hello world; \\rest\r\n"))
129 (assert-equal s (irc-tag-unescape (irc-tag-escape s)))))
131 (test "drops trailing lone backslash on unescape"
132 (assert-equal "abc" (irc-tag-unescape "abc\\")))
134 (test "drops backslash from unknown escape"
135 (assert-equal "abc" (irc-tag-unescape "a\\bc"))))
138 (test-group "parse-irc-tags / irc-tags->string"
140 (test "parses simple tag list"
141 (assert-equal '(("a" . "1") ("b" . "2"))
142 (parse-irc-tags "a=1;b=2")))
144 (test "parses valueless tags"
145 (assert-equal '(("flag" . #f) ("k" . "v"))
146 (parse-irc-tags "flag;k=v")))
148 (test "serializes simple tag list"
149 (assert-equal "a=1;b=2"
150 (irc-tags->string '(("a" . "1") ("b" . "2")))))
152 (test "serializes flag-only tags as bare names"
153 (assert-equal "echo;a=1"
154 (irc-tags->string '(("echo" . #f) ("a" . "1"))))))
157 (test-group "make-irc-command / make-irc-command/tags"
159 (test "creates simple command"
160 (assert-equal (make-irc-command "PING") "PING"))
162 (test "creates command with single param"
163 (assert-equal (make-irc-command "NICK" "mynick") "NICK mynick"))
165 (test "creates command with trailing colon when needed"
166 (assert-equal (make-irc-command "PRIVMSG" "#channel" "Hello world")
167 "PRIVMSG #channel :Hello world"))
169 (test "adds colon for trailing with spaces"
170 (assert-equal (make-irc-command "QUIT" "Goodbye everyone")
171 "QUIT :Goodbye everyone"))
173 (test "handles multiple middle params"
174 (assert-equal (make-irc-command "MODE" "#channel" "+o" "user")
175 "MODE #channel +o user"))
177 (test "tagged build with prefix"
178 ;; Note: trailing parameter "Hello world" with whitespace gets the
179 ;; colon; "hi" without whitespace doesn't (it's an unambiguous
180 ;; one-token middle param per RFC 1459 line shape).
181 (assert-equal
182 "@time=2026Z :alice!a@host PRIVMSG #chan :Hello world"
183 (make-irc-command/tags
184 tags: '(("time" . "2026Z"))
185 prefix: "alice!a@host"
186 command: "PRIVMSG"
187 params: '("#chan" "Hello world"))))
189 (test "tagged build with no tags is unprefixed"
190 (assert-equal
191 "PING foo"
192 (make-irc-command/tags command: "PING" params: '("foo")))))
195 ;; ============================================================
196 ;; make-trailing-command — unconditional `:` on the last param,
197 ;; for commands whose final argument is the message body
198 ;; (PRIVMSG, NOTICE, TOPIC, etc.). Without the colon, strict
199 ;; parsers route a short single-token body into the middle-params
200 ;; slot and leave trailing #f, dropping the message.
201 ;; ============================================================
203 (test-group "make-trailing-command"
205 (test "single-token body still gets the colon"
206 ;; The bug: make-irc-command would produce "PRIVMSG #c connected."
207 ;; (no colon) since the body has no spaces. After a round-trip
208 ;; through a re-encoding server (which uses make-irc-command
209 ;; via params: shape), the receiver's parser sees no trailing
210 ;; and the body lands in params, leaving irc-message-trailing #f.
211 (assert-equal "PRIVMSG #channel :connected."
212 (make-trailing-command "PRIVMSG" "#channel" "connected.")))
214 (test "multi-word body keeps the colon (same as before)"
215 (assert-equal "PRIVMSG #channel :hello world"
216 (make-trailing-command "PRIVMSG" "#channel" "hello world")))
218 (test "empty body emits :"
219 (assert-equal "NOTICE alice :"
220 (make-trailing-command "NOTICE" "alice" "")))
222 (test "round-trips through parser into trailing"
223 ;; The whole point: parse-irc-message must populate
224 ;; irc-message-trailing for a make-trailing-command output.
225 (let ((msg (parse-irc-message
226 (make-trailing-command "PRIVMSG" "#hive" "connected."))))
227 (assert-true msg)
228 (assert-equal 'PRIVMSG (irc-message-command msg))
229 (assert-equal "#hive" (irc-message-target msg))
230 (assert-equal "connected." (irc-message-trailing msg))
231 (assert-equal "connected." (irc-message-text msg))))
233 (test "make-irc-command's own behavior unchanged for spaceless"
234 ;; Sanity: we deliberately did NOT change make-irc-command.
235 ;; MODE, NICK, etc. still emit unambiguous single-token last
236 ;; params without a colon.
237 (assert-equal "MODE #channel +o alice"
238 (make-irc-command "MODE" "#channel" "+o" "alice"))
239 (assert-equal "NICK mynick"
240 (make-irc-command "NICK" "mynick")))
242 (test "irc-privmsg wire-shape: round-trip via parse-irc-message"
243 ;; Verifies the irc-privmsg path emits a `:trailing` even for
244 ;; short single-token bodies. We can't easily assert against
245 ;; the live wire here without a socket, but since irc-privmsg
246 ;; delegates to make-trailing-command, the round-trip below
247 ;; matches what hits the wire.
248 (let ((wire (string-append
249 (make-trailing-command "PRIVMSG" "#hive" "ack")
250 "\r\n")))
251 (assert-equal "PRIVMSG #hive :ack\r\n" wire))))
254 (test-group "irc-command->string adds CRLF"
256 (test "adds CRLF"
257 (assert-equal (irc-command->string "PING" "test")
258 "PING test\r\n"))))
260(run-tests)