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

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