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