1 USING: kernel tools.test accessors arrays sequences qualified
2 io io.streams.duplex namespaces threads
3 calendar irc.client.private irc.client irc.messages.private
4 concurrency.mailboxes classes assocs combinators ;
5 EXCLUDE: irc.messages => join ;
6 RENAME: join irc.messages => join_
10 TUPLE: mb-writer lines last-line disposed ;
11 TUPLE: mb-reader lines disposed ;
12 : <mb-writer> ( -- mb-writer ) V{ } clone V{ } clone f mb-writer boa ;
13 : <mb-reader> ( -- mb-reader ) <mailbox> f mb-reader boa ;
14 : push-line ( line test-reader-stream -- ) lines>> mailbox-put ;
15 : <test-stream> ( -- stream ) <mb-reader> <mb-writer> <duplex-stream> ;
16 M: mb-writer stream-write ( line mb-writer -- ) last-line>> push ;
17 M: mb-writer stream-flush ( mb-writer -- ) drop ;
18 M: mb-reader stream-readln ( mb-reader -- str/f ) lines>> mailbox-get ;
19 M: mb-writer stream-nl ( mb-writer -- )
20 [ [ last-line>> concat ] [ lines>> ] bi push ] keep
21 V{ } clone >>last-line drop ;
23 : spawn-client ( -- irc-client )
24 "someserver" irc-port "factorbot" f <irc-profile>
27 <test-stream> >>stream
28 dup [ spawn-irc yield ] with-irc-client ;
30 ! to be used inside with-irc-client quotations
31 : %add-named-listener ( listener -- ) [ name>> ] keep set+run-listener ;
32 : %join ( channel -- ) <irc-channel-listener> irc> add-listener ;
33 : %push-line ( line -- ) irc> stream>> in>> push-line yield ;
35 : read-matching-message ( listener quot: ( msg -- ? ) -- irc-message )
36 [ in-messages>> 0.1 seconds ] dip mailbox-get-timeout? ;
38 : with-irc ( quot: ( -- ) -- )
39 [ spawn-client ] dip [ f %push-line ] compose with-irc-client ; inline
41 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
43 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
45 [ { t } [ irc> profile>> nickname>> me? ] unit-test
47 { "factorbot" } [ irc> profile>> nickname>> ] unit-test
49 { "someuser" } [ "someuser!n=user@some.where" parse-name ] unit-test
51 { "#factortest" } [ ":someuser!n=user@some.where PRIVMSG #factortest :hi"
52 parse-irc-line forward-name ] unit-test
54 { "someuser" } [ ":someuser!n=user@some.where PRIVMSG factorbot :hi"
55 parse-irc-line forward-name ] unit-test
58 ! Test login and nickname set
60 ":some.where 001 factorbot2 :Welcome factorbot2" %push-line
61 irc> profile>> nickname>>
65 [ { join_ "#factortest" } [
66 { ":factorbot!n=factorbo@some.where JOIN :#factortest"
67 ":ircserver.net 353 factorbot @ #factortest :@factorbot "
68 ":ircserver.net 366 factorbot #factortest :End of /NAMES list."
69 ":ircserver.net 477 factorbot #factortest :[ircserver-info] blah blah"
71 irc> join-messages>> 0.1 seconds mailbox-get-timeout
72 [ class ] [ trailing>> ] bi
76 [ { T{ participant-changed f "somebody" +join+ } } [
77 "#factortest" <irc-channel-listener> [ %add-named-listener ] keep
78 ":somebody!n=somebody@some.where JOIN :#factortest" %push-line
79 [ participant-changed? ] read-matching-message
83 [ { privmsg "#factortest" "hello" } [
84 "#factortest" <irc-channel-listener> [ %add-named-listener ] keep
85 ":somebody!n=somebody@some.where PRIVMSG #factortest :hello" %push-line
86 [ privmsg? ] read-matching-message
87 [ class ] [ name>> ] [ trailing>> ] tri
91 [ { privmsg "factorbot" "hello" } [
92 "somedude" <irc-nick-listener> [ %add-named-listener ] keep
93 ":somedude!n=user@isp.net PRIVMSG factorbot :hello" %push-line
94 [ privmsg? ] read-matching-message
95 [ class ] [ name>> ] [ trailing>> ] tri
100 "#factortest" <irc-channel-listener> [ %add-named-listener ] keep
101 ":ircserver.net MODE #factortest +ns" %push-line
102 [ mode? ] read-matching-message class
106 ! Participant lists tests
107 [ { H{ { "somedude" +normal+ } } } [
108 "#factortest" <irc-channel-listener> [ %add-named-listener ] keep
109 ":somedude!n=user@isp.net JOIN :#factortest" %push-line
114 [ { H{ { "somedude2" +normal+ } } } [
115 "#factortest" <irc-channel-listener>
116 H{ { "somedude2" +normal+ }
117 { "somedude" +normal+ } } clone >>participants
118 [ %add-named-listener ] keep
119 ":somedude!n=user@isp.net PART #factortest" %push-line
124 [ { H{ { "somedude2" +normal+ } } } [
125 "#factortest" <irc-channel-listener>
126 H{ { "somedude2" +normal+ }
127 { "somedude" +normal+ } } clone >>participants
128 [ %add-named-listener ] keep
129 ":somedude!n=user@isp.net QUIT" %push-line
134 [ { H{ { "somedude2" +normal+ } } } [
135 "#factortest" <irc-channel-listener>
136 H{ { "somedude2" +normal+ }
137 { "somedude" +normal+ } } clone >>participants
138 [ %add-named-listener ] keep
139 ":somedude2!n=user2@isp.net KICK #factortest somedude" %push-line
144 [ { H{ { "somedude2" +normal+ } } } [
145 "#factortest" <irc-channel-listener>
146 H{ { "somedude" +normal+ } } clone >>participants
147 [ %add-named-listener ] keep
148 ":somedude!n=user2@isp.net NICK :somedude2" %push-line
153 ! Namelist change notification
154 [ { T{ participant-changed f f f f } } [
155 "#factortest" <irc-channel-listener> [ %add-named-listener ] keep
156 ":ircserver.net 353 factorbot @ #factortest :@factorbot " %push-line
157 ":ircserver.net 366 factorbot #factortest :End of /NAMES list." %push-line
158 [ participant-changed? ] read-matching-message
162 [ { T{ participant-changed f "somedude" +part+ f } } [
163 "#factortest" <irc-channel-listener>
164 H{ { "somedude" +normal+ } } clone >>participants
165 [ %add-named-listener ] keep
166 ":somedude!n=user@isp.net QUIT" %push-line
167 [ participant-changed? ] read-matching-message
171 [ { T{ participant-changed f "somedude" +nick+ "somedude2" } } [
172 "#factortest" <irc-channel-listener>
173 H{ { "somedude" +normal+ } } clone >>participants
174 [ %add-named-listener ] keep
175 ":somedude!n=user2@isp.net NICK :somedude2" %push-line
176 [ participant-changed? ] read-matching-message