extra/irc/client/internals/internals-tests.factor

   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
  11
  12 ! Streams for testing
  13 TUPLE: mb-writer lines last-line disposed ;
  14 INSTANCE: mb-writer output-stream
  15
  16 TUPLE: mb-reader lines disposed ;
  17 INSTANCE: mb-reader input-stream
  18
  19 : <mb-writer> ( -- mb-writer ) V{ } clone V{ } clone f mb-writer boa ;
  20 : <mb-reader> ( -- mb-reader ) <mailbox> f mb-reader boa ;
  21 : push-line ( line test-reader-stream -- ) lines>> mailbox-put ;
  22 : <test-stream> ( -- stream ) <mb-reader> <mb-writer> <duplex-stream> ;
  23 M: mb-writer stream-write ( line mb-writer -- ) last-line>> push ;
  24 M: mb-writer stream-flush ( mb-writer -- ) drop ;
  25 M: mb-reader stream-readln ( mb-reader -- str/f ) lines>> mailbox-get ;
  26 M: mb-writer stream-nl ( mb-writer -- )
  27     [ [ last-line>> concat ] [ lines>> ] bi push ] keep
  28     V{ } clone >>last-line drop ;
  29 M: mb-reader dispose f swap push-line ;
  30 M: mb-writer dispose drop ;
  31
  32 : spawn-client ( -- irc-client )
  33     "someserver" irc-port "factorbot" f <irc-profile>
  34     <irc-client>
  35         t >>is-ready
  36         t >>is-running
  37         <test-stream> >>stream
  38     dup [ spawn-irc yield ] with-irc ;
  39
  40 ! to be used inside with-irc quotations
  41 : %add-named-chat ( chat -- ) (attach-chat) ;
  42 : %push-line ( line -- ) irc> stream>> in>> push-line yield ;
  43 : %push-lines ( lines -- ) [ %push-line ] each ;
  44 : %join ( channel -- ) <irc-channel-chat> (attach-chat) ;
  45 : %pop-output-line ( -- string ) irc> stream>> out>> lines>> pop ;
  46
  47 : read-matching-message ( chat quot: ( msg -- ? ) -- irc-message )
  48     [ in-messages>> 0.1 seconds ] dip mailbox-get-timeout? ; inline
  49
  50 : spawning-irc ( quot: ( -- ) -- )
  51     [ spawn-client ] dip [ (terminate-irc) ] compose with-irc ; inline
  52
  53 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  54 !                       TESTS
  55 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  56
  57 [ { t } [ irc> nick>> me? ] unit-test
  58
  59   { "factorbot" } [ irc> nick>> ] unit-test
  60
  61   { "#factortest" } [ ":someuser!n=user@some.where PRIVMSG #factortest :hi"
  62                       string>irc-message chat-name ] unit-test
  63
  64   { "someuser" } [ ":someuser!n=user@some.where PRIVMSG factorbot :hi"
  65                    string>irc-message chat-name ] unit-test
  66 ] spawning-irc
  67
  68 { privmsg "#channel" "hello" } [
  69     "#channel" "hello" strings>privmsg
  70     [ class-of ] [ target>> ] [ trailing>> ] tri
  71 ] unit-test
  72
  73 ! Test login and nickname set
  74 [ { "factorbot2" } [
  75     ":some.where 001 factorbot2 :Welcome factorbot2" %push-line
  76     irc> nick>>
  77   ] unit-test
  78 ] spawning-irc
  79
  80 ! Test connect
  81 { V{ "NICK factorbot" "USER factorbot hostname servername :irc.factor" } } [
  82     "someserver" irc-port "factorbot" f <irc-profile> <irc-client>
  83     [ 2drop <test-stream> ] >>connect
  84     [
  85         (connect-irc)
  86         (do-login)
  87         irc> stream>> out>> lines>>
  88         (terminate-irc)
  89     ] with-irc
  90 ] unit-test
  91
  92 ! Test connect with password
  93 { V{ "PASS password" "NICK factorbot" "USER factorbot hostname servername :irc.factor" } } [
  94     "someserver" irc-port "factorbot" "password" <irc-profile> <irc-client>
  95     [ 2drop <test-stream> ] >>connect
  96     [
  97         (connect-irc)
  98         (do-login)
  99         irc> stream>> out>> lines>>
 100         (terminate-irc)
 101     ] with-irc
 102 ] unit-test
 103
 104 ! Test join
 105 [ { "JOIN #factortest" } [
 106     "#factortest" %join %pop-output-line
 107   ] unit-test
 108 ] spawning-irc
 109
 110 [ { "PART #factortest" } [
 111     "#factortest" %join %pop-output-line drop
 112     "#factortest" chat> remove-chat %pop-output-line
 113   ] unit-test
 114 ] spawning-irc
 115
 116 [ { join_ "#factortest" } [
 117       "#factortest" <irc-channel-chat> [ %add-named-chat ] keep
 118       { ":factorbot!n=factorbo@some.where JOIN :#factortest"
 119         ":ircserver.net 353 factorbot @ #factortest :@factorbot "
 120         ":ircserver.net 366 factorbot #factortest :End of /NAMES list."
 121         ":ircserver.net 477 factorbot #factortest :[ircserver-info] blah blah"
 122       } %push-lines
 123       [ join? ] read-matching-message
 124       [ class-of ] [ channel>> ] bi
 125   ] unit-test
 126 ] spawning-irc
 127
 128 [ { privmsg "#factortest" "hello" } [
 129       "#factortest" <irc-channel-chat> [ %add-named-chat ] keep
 130       ":somebody!n=somebody@some.where PRIVMSG #factortest :hello" %push-line
 131       [ privmsg? ] read-matching-message
 132       [ class-of ] [ target>> ] [ trailing>> ] tri
 133   ] unit-test
 134 ] spawning-irc
 135
 136 [ { privmsg "factorbot" "hello" } [
 137       "ircuser" <irc-nick-chat>  [ %add-named-chat ] keep
 138       ":ircuser!n=user@isp.net PRIVMSG factorbot :hello" %push-line
 139       [ privmsg? ] read-matching-message
 140       [ class-of ] [ target>> ] [ trailing>> ] tri
 141   ] unit-test
 142 ] spawning-irc
 143
 144 [ { mode "#factortest" "+ns" } [
 145       "#factortest" <irc-channel-chat>  [ %add-named-chat ] keep
 146       ":ircserver.net MODE #factortest +ns" %push-line
 147       [ mode? ] read-matching-message
 148       [ class-of ] [ name>> ] [ mode>> ] tri
 149   ] unit-test
 150 ] spawning-irc
 151
 152 ! Participant lists tests
 153 [ { { "ircuser" } } [
 154       "#factortest" <irc-channel-chat> [ %add-named-chat ] keep
 155       ":ircuser!n=user@isp.net JOIN :#factortest" %push-line
 156       participants>> keys
 157   ] unit-test
 158 ] spawning-irc
 159
 160 [ { { "ircuser2" } } [
 161       "#factortest" <irc-channel-chat>
 162       { "ircuser2" "ircuser" } [ over join-participant ] each
 163       [ %add-named-chat ] keep
 164       ":ircuser!n=user@isp.net PART #factortest" %push-line
 165       participants>> keys
 166   ] unit-test
 167 ] spawning-irc
 168
 169 [ { { "ircuser2" } } [
 170       "#factortest" <irc-channel-chat>
 171       { "ircuser2" "ircuser" } [ over join-participant ] each
 172       [ %add-named-chat ] keep
 173       ":ircuser!n=user@isp.net QUIT" %push-line
 174       participants>> keys
 175   ] unit-test
 176 ] spawning-irc
 177
 178 [ { { "ircuser2" } } [
 179       "#factortest" <irc-channel-chat>
 180       { "ircuser2" "ircuser" } [ over join-participant ] each
 181       [ %add-named-chat ] keep
 182       ":ircuser2!n=user2@isp.net KICK #factortest ircuser" %push-line
 183       participants>> keys
 184   ] unit-test
 185 ] spawning-irc
 186
 187 [ { H{ { "ircuser2" T{ participant { nick "ircuser2" } } } } } [
 188       "#factortest" <irc-channel-chat>
 189       "ircuser" over join-participant
 190       [ %add-named-chat ] keep
 191       ":ircuser!n=user2@isp.net NICK :ircuser2" %push-line
 192       participants>>
 193   ] unit-test
 194 ] spawning-irc
 195
 196 [ { H{ { "factorbot" T{ participant { nick "factorbot" } { operator t } } }
 197        { "ircuser" T{ participant { nick "ircuser" } } }
 198        { "voiced" T{ participant { nick "voiced" } { voice t } } } } } [
 199       "#factortest" <irc-channel-chat>
 200       "ircuser" over join-participant
 201       [ %add-named-chat ] keep
 202       { ":ircserver.net 353 factorbot @ #factortest :@factorbot "
 203         ":ircserver.net 353 factorbot @ #factortest :ircuser2 "
 204         ":ircserver.net 366 factorbot #factortest :End of /NAMES list."
 205         ":ircserver.net 353 factorbot @ #factortest :@factorbot +voiced "
 206         ":ircserver.net 353 factorbot @ #factortest :ircuser "
 207         ":ircserver.net 366 factorbot #factortest :End of /NAMES list."
 208       } %push-lines
 209       participants>>
 210   ] unit-test
 211 ] spawning-irc
 212
 213 [ { mode "#factortest" "+o" "ircuser" } [
 214       "#factortest" <irc-channel-chat> [ %add-named-chat ] keep
 215       "ircuser" over join-participant
 216       ":ircserver.net MODE #factortest +o ircuser" %push-line
 217       [ mode? ] read-matching-message
 218       { [ class-of ] [ name>> ] [ mode>> ] [ parameter>> ] } cleave
 219   ] unit-test
 220 ] spawning-irc
 221
 222 [ { T{ participant { nick "ircuser" } { operator t } } } [
 223       "#factortest" <irc-channel-chat> [ %add-named-chat ] keep
 224       "ircuser" over join-participant
 225       ":ircserver.net MODE #factortest +o ircuser" %push-line
 226       participants>> "ircuser" of
 227   ] unit-test
 228 ] spawning-irc
 229
 230 ! Send privmsg
 231 [ { "PRIVMSG #factortest :hello" } [
 232       "#factortest" <irc-channel-chat> [ %add-named-chat ] keep
 233       "hello" swap (speak) %pop-output-line
 234   ] unit-test
 235 ] spawning-irc