1 ! Copyright (C) 2009 Bruno Deferrari
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: kernel tools.test accessors arrays sequences
4 io io.streams.duplex namespaces threads destructors
5 calendar concurrency.mailboxes classes assocs combinators
6 irc.messages.parser irc.client.base irc.client.chats
7 irc.client.participants irc.client.internals ;
8 EXCLUDE: irc.messages => join ;
9 RENAME: join irc.messages => join_
10 IN: irc.client.internals.tests
13 TUPLE: mb-writer lines last-line disposed ;
14 TUPLE: mb-reader lines disposed ;
15 : <mb-writer> ( -- mb-writer ) V{ } clone V{ } clone f mb-writer boa ;
16 : <mb-reader> ( -- mb-reader ) <mailbox> f mb-reader boa ;
17 : push-line ( line test-reader-stream -- ) lines>> mailbox-put ;
18 : <test-stream> ( -- stream ) <mb-reader> <mb-writer> <duplex-stream> ;
19 M: mb-writer stream-write ( line mb-writer -- ) last-line>> push ;
20 M: mb-writer stream-flush ( mb-writer -- ) drop ;
21 M: mb-reader stream-readln ( mb-reader -- str/f ) lines>> mailbox-get ;
22 M: mb-writer stream-nl ( mb-writer -- )
23 [ [ last-line>> concat ] [ lines>> ] bi push ] keep
24 V{ } clone >>last-line drop ;
25 M: mb-reader dispose f swap push-line ;
26 M: mb-writer dispose drop ;
28 : spawn-client ( -- irc-client )
29 "someserver" irc-port "factorbot" f <irc-profile>
33 <test-stream> >>stream
34 dup [ spawn-irc yield ] with-irc ;
36 ! to be used inside with-irc quotations
37 : %add-named-chat ( chat -- ) (attach-chat) ;
38 : %push-line ( line -- ) irc> stream>> in>> push-line yield ;
39 : %push-lines ( lines -- ) [ %push-line ] each ;
40 : %join ( channel -- ) <irc-channel-chat> (attach-chat) ;
41 : %pop-output-line ( -- string ) irc> stream>> out>> lines>> pop ;
43 : read-matching-message ( chat quot: ( msg -- ? ) -- irc-message )
44 [ in-messages>> 0.1 seconds ] dip mailbox-get-timeout? ; inline
46 : spawning-irc ( quot: ( -- ) -- )
47 [ spawn-client ] dip [ (terminate-irc) ] compose with-irc ; inline
49 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
51 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
53 [ { t } [ irc> nick>> me? ] unit-test
55 { "factorbot" } [ irc> nick>> ] unit-test
57 { "#factortest" } [ ":someuser!n=user@some.where PRIVMSG #factortest :hi"
58 string>irc-message chat-name ] unit-test
60 { "someuser" } [ ":someuser!n=user@some.where PRIVMSG factorbot :hi"
61 string>irc-message chat-name ] unit-test
64 { privmsg "#channel" "hello" } [
65 "#channel" "hello" strings>privmsg
66 [ class ] [ target>> ] [ trailing>> ] tri
69 ! Test login and nickname set
71 ":some.where 001 factorbot2 :Welcome factorbot2" %push-line
77 { V{ "NICK factorbot" "USER factorbot hostname servername :irc.factor" } } [
78 "someserver" irc-port "factorbot" f <irc-profile> <irc-client>
79 [ 2drop <test-stream> ] >>connect
83 irc> stream>> out>> lines>>
89 [ { "JOIN #factortest" } [
90 "#factortest" %join %pop-output-line
94 [ { join_ "#factortest"} [
95 "#factortest" <irc-channel-chat> [ %add-named-chat ] keep
96 { ":factorbot!n=factorbo@some.where JOIN :#factortest"
97 ":ircserver.net 353 factorbot @ #factortest :@factorbot "
98 ":ircserver.net 366 factorbot #factortest :End of /NAMES list."
99 ":ircserver.net 477 factorbot #factortest :[ircserver-info] blah blah"
101 [ join? ] read-matching-message
102 [ class ] [ channel>> ] bi
106 [ { privmsg "#factortest" "hello" } [
107 "#factortest" <irc-channel-chat> [ %add-named-chat ] keep
108 ":somebody!n=somebody@some.where PRIVMSG #factortest :hello" %push-line
109 [ privmsg? ] read-matching-message
110 [ class ] [ target>> ] [ trailing>> ] tri
114 [ { privmsg "factorbot" "hello" } [
115 "ircuser" <irc-nick-chat> [ %add-named-chat ] keep
116 ":ircuser!n=user@isp.net PRIVMSG factorbot :hello" %push-line
117 [ privmsg? ] read-matching-message
118 [ class ] [ target>> ] [ trailing>> ] tri
122 [ { mode "#factortest" "+ns" } [
123 "#factortest" <irc-channel-chat> [ %add-named-chat ] keep
124 ":ircserver.net MODE #factortest +ns" %push-line
125 [ mode? ] read-matching-message
126 [ class ] [ name>> ] [ mode>> ] tri
130 ! Participant lists tests
131 [ { { "ircuser" } } [
132 "#factortest" <irc-channel-chat> [ %add-named-chat ] keep
133 ":ircuser!n=user@isp.net JOIN :#factortest" %push-line
138 [ { { "ircuser2" } } [
139 "#factortest" <irc-channel-chat>
140 { "ircuser2" "ircuser" } [ over join-participant ] each
141 [ %add-named-chat ] keep
142 ":ircuser!n=user@isp.net PART #factortest" %push-line
147 [ { { "ircuser2" } } [
148 "#factortest" <irc-channel-chat>
149 { "ircuser2" "ircuser" } [ over join-participant ] each
150 [ %add-named-chat ] keep
151 ":ircuser!n=user@isp.net QUIT" %push-line
156 [ { { "ircuser2" } } [
157 "#factortest" <irc-channel-chat>
158 { "ircuser2" "ircuser" } [ over join-participant ] each
159 [ %add-named-chat ] keep
160 ":ircuser2!n=user2@isp.net KICK #factortest ircuser" %push-line
165 [ { H{ { "ircuser2" T{ participant { nick "ircuser2" } } } } } [
166 "#factortest" <irc-channel-chat>
167 "ircuser" over join-participant
168 [ %add-named-chat ] keep
169 ":ircuser!n=user2@isp.net NICK :ircuser2" %push-line
174 [ { H{ { "factorbot" T{ participant { nick "factorbot" } { operator t } } }
175 { "ircuser" T{ participant { nick "ircuser" } } }
176 { "voiced" T{ participant { nick "voiced" } { voice t } } } } } [
177 "#factortest" <irc-channel-chat>
178 "ircuser" over join-participant
179 [ %add-named-chat ] keep
180 { ":ircserver.net 353 factorbot @ #factortest :@factorbot "
181 ":ircserver.net 353 factorbot @ #factortest :ircuser2 "
182 ":ircserver.net 366 factorbot #factortest :End of /NAMES list."
183 ":ircserver.net 353 factorbot @ #factortest :@factorbot +voiced "
184 ":ircserver.net 353 factorbot @ #factortest :ircuser "
185 ":ircserver.net 366 factorbot #factortest :End of /NAMES list."
191 [ { mode "#factortest" "+o" "ircuser" } [
192 "#factortest" <irc-channel-chat> [ %add-named-chat ] keep
193 "ircuser" over join-participant
194 ":ircserver.net MODE #factortest +o ircuser" %push-line
195 [ mode? ] read-matching-message
196 { [ class ] [ name>> ] [ mode>> ] [ parameter>> ] } cleave
200 [ { T{ participant { nick "ircuser" } { operator t } } } [
201 "#factortest" <irc-channel-chat> [ %add-named-chat ] keep
202 "ircuser" over join-participant
203 ":ircserver.net MODE #factortest +o ircuser" %push-line
204 participants>> "ircuser" swap at
209 [ { "PRIVMSG #factortest :hello" } [
210 "#factortest" <irc-channel-chat> [ %add-named-chat ] keep
211 "hello" swap (speak) %pop-output-line