extra/irc/client/client-tests.factor

   1 USING: kernel tools.test accessors arrays sequences
   2        io io.streams.duplex namespaces threads destructors
   3        calendar irc.client.private irc.client irc.messages
   4        concurrency.mailboxes classes assocs combinators irc.messages.parser ;
   5 EXCLUDE: irc.messages => join ;
   6 RENAME: join irc.messages => join_
   7 IN: irc.client.tests
   8
   9 ! Streams for testing
  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 ;
  22 M: mb-reader dispose f swap push-line ;
  23 M: mb-writer dispose drop ;
  24
  25 : spawn-client ( -- irc-client )
  26     "someserver" irc-port "factorbot" f <irc-profile>
  27     <irc-client>
  28         t >>is-ready
  29         t >>is-running
  30         <test-stream> >>stream
  31     dup [ spawn-irc yield ] with-irc-client ;
  32
  33 ! to be used inside with-irc-client quotations
  34 : %add-named-chat ( chat -- ) irc> attach-chat ;
  35 : %push-line ( line -- ) irc> stream>> in>> push-line yield ;
  36 : %join ( channel -- ) <irc-channel-chat> irc> attach-chat ;
  37
  38 : read-matching-message ( chat quot: ( msg -- ? ) -- irc-message )
  39     [ in-messages>> 0.1 seconds ] dip mailbox-get-timeout? ;
  40
  41 : with-irc ( quot: ( -- ) -- )
  42     [ spawn-client ] dip [ irc> terminate-irc ] compose with-irc-client ; inline
  43
  44 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  45 !                       TESTS
  46 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  47
  48 [ { t } [ irc> nick>> me? ] unit-test
  49
  50   { "factorbot" } [ irc> nick>> ] unit-test
  51
  52 !  { "someuser" } [ "someuser!n=user@some.where" parse-name ] unit-test
  53
  54   { "#factortest" } [ ":someuser!n=user@some.where PRIVMSG #factortest :hi"
  55                       string>irc-message forward-name ] unit-test
  56
  57   { "someuser" } [ ":someuser!n=user@some.where PRIVMSG factorbot :hi"
  58                    string>irc-message forward-name ] unit-test
  59 ] with-irc
  60
  61 { privmsg "#channel" "hello" } [
  62     "#channel" "hello" strings>privmsg
  63     [ class ] [ target>> ] [ trailing>> ] tri
  64 ] unit-test
  65
  66 ! Test login and nickname set
  67 [ { "factorbot2" } [
  68     ":some.where 001 factorbot2 :Welcome factorbot2" %push-line
  69     irc> nick>>
  70   ] unit-test
  71 ] with-irc
  72
  73 ! Test connect
  74 { V{ "NICK factorbot" "USER factorbot hostname servername :irc.factor" } } [
  75     "someserver" irc-port "factorbot" f <irc-profile> <irc-client>
  76     [ 2drop <test-stream> t ] >>connect
  77     [ connect-irc ] [ stream>> out>> lines>> ] [ terminate-irc ] tri
  78 ] unit-test
  79
  80 ! Test join
  81 [ { "JOIN #factortest" } [
  82       "#factortest" %join
  83       irc> stream>> out>> lines>> pop
  84   ] unit-test
  85 ] with-irc
  86
  87 [ { join_ "#factortest" } [
  88       "#factortest" <irc-channel-chat> [ %add-named-chat ] keep
  89       { ":factorbot!n=factorbo@some.where JOIN :#factortest"
  90         ":ircserver.net 353 factorbot @ #factortest :@factorbot "
  91         ":ircserver.net 366 factorbot #factortest :End of /NAMES list."
  92         ":ircserver.net 477 factorbot #factortest :[ircserver-info] blah blah"
  93       } [ %push-line ] each
  94       in-messages>> 0.1 seconds mailbox-get-timeout
  95       [ class ] [ trailing>> ] bi
  96   ] unit-test
  97 ] with-irc
  98
  99 [ { T{ participant-changed f "somebody" +join+ } } [
 100       "#factortest" <irc-channel-chat> [ %add-named-chat ] keep
 101       ":somebody!n=somebody@some.where JOIN :#factortest" %push-line
 102       [ participant-changed? ] read-matching-message
 103   ] unit-test
 104 ] with-irc
 105
 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
 111   ] unit-test
 112 ] with-irc
 113
 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
 119   ] unit-test
 120 ] with-irc
 121
 122 [ { mode } [
 123       "#factortest" <irc-channel-chat>  [ %add-named-chat ] keep
 124       ":ircserver.net MODE #factortest +ns" %push-line
 125       [ mode? ] read-matching-message class
 126   ] unit-test
 127 ] with-irc
 128
 129 ! Participant lists tests
 130 [ { H{ { "ircuser" +normal+ } } } [
 131       "#factortest" <irc-channel-chat> [ %add-named-chat ] keep
 132       ":ircuser!n=user@isp.net JOIN :#factortest" %push-line
 133       participants>>
 134   ] unit-test
 135 ] with-irc
 136
 137 [ { H{ { "ircuser2" +normal+ } } } [
 138       "#factortest" <irc-channel-chat>
 139           H{ { "ircuser2" +normal+ }
 140              { "ircuser" +normal+ } } clone >>participants
 141       [ %add-named-chat ] keep
 142       ":ircuser!n=user@isp.net PART #factortest" %push-line
 143       participants>>
 144   ] unit-test
 145 ] with-irc
 146
 147 [ { H{ { "ircuser2" +normal+ } } } [
 148       "#factortest" <irc-channel-chat>
 149           H{ { "ircuser2" +normal+ }
 150              { "ircuser" +normal+ } } clone >>participants
 151       [ %add-named-chat ] keep
 152       ":ircuser!n=user@isp.net QUIT" %push-line
 153       participants>>
 154   ] unit-test
 155 ] with-irc
 156
 157 [ { H{ { "ircuser2" +normal+ } } } [
 158       "#factortest" <irc-channel-chat>
 159           H{ { "ircuser2" +normal+ }
 160              { "ircuser" +normal+ } } clone >>participants
 161       [ %add-named-chat ] keep
 162       ":ircuser2!n=user2@isp.net KICK #factortest ircuser" %push-line
 163       participants>>
 164   ] unit-test
 165 ] with-irc
 166
 167 [ { H{ { "ircuser2" +normal+ } } } [
 168       "#factortest" <irc-channel-chat>
 169           H{ { "ircuser" +normal+ } } clone >>participants
 170       [ %add-named-chat ] keep
 171       ":ircuser!n=user2@isp.net NICK :ircuser2" %push-line
 172       participants>>
 173   ] unit-test
 174 ] with-irc
 175
 176 [ { H{ { "factorbot" +operator+ } { "ircuser" +normal+ } } } [
 177       "#factortest" <irc-channel-chat>
 178           H{ { "ircuser" +normal+ } } clone >>participants
 179       [ %add-named-chat ] keep
 180       ":ircserver.net 353 factorbot @ #factortest :@factorbot " %push-line
 181       ":ircserver.net 353 factorbot @ #factortest :ircuser2 " %push-line
 182       ":ircserver.net 366 factorbot #factortest :End of /NAMES list." %push-line
 183       ":ircserver.net 353 factorbot @ #factortest :@factorbot " %push-line
 184       ":ircserver.net 353 factorbot @ #factortest :ircuser " %push-line
 185       ":ircserver.net 366 factorbot #factortest :End of /NAMES list." %push-line
 186       participants>>
 187   ] unit-test
 188 ] with-irc
 189
 190 ! Namelist change notification
 191 [ { T{ participant-changed f f f f } } [
 192       "#factortest" <irc-channel-chat> [ %add-named-chat ] keep
 193       ":ircserver.net 353 factorbot @ #factortest :@factorbot " %push-line
 194       ":ircserver.net 366 factorbot #factortest :End of /NAMES list." %push-line
 195       [ participant-changed? ] read-matching-message
 196   ] unit-test
 197 ] with-irc
 198
 199 [ { T{ participant-changed f "ircuser" +part+ f } } [
 200       "#factortest" <irc-channel-chat>
 201           H{ { "ircuser" +normal+ } } clone >>participants
 202       [ %add-named-chat ] keep
 203       ":ircuser!n=user@isp.net QUIT" %push-line
 204       [ participant-changed? ] read-matching-message
 205   ] unit-test
 206 ] with-irc
 207
 208 [ { T{ participant-changed f "ircuser" +nick+ "ircuser2" } } [
 209       "#factortest" <irc-channel-chat>
 210           H{ { "ircuser" +normal+ } } clone >>participants
 211       [ %add-named-chat ] keep
 212       ":ircuser!n=user2@isp.net NICK :ircuser2" %push-line
 213       [ participant-changed? ] read-matching-message
 214   ] unit-test
 215 ] with-irc
 216
 217 ! Mode change
 218 [ { T{ participant-changed f "ircuser" +mode+ "+o" } } [
 219       "#factortest" <irc-channel-chat> [ %add-named-chat ] keep
 220       ":ircserver.net MODE #factortest +o ircuser" %push-line
 221       [ participant-changed? ] read-matching-message
 222   ] unit-test
 223 ] with-irc