extra/irc/client/client-tests.factor

   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_
   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
  23 : spawn-client ( -- irc-client )
  24     "someserver" irc-port "factorbot" f <irc-profile>
  25     <irc-client>
  26         t >>is-running
  27         <test-stream> >>stream
  28     dup [ spawn-irc yield ] with-irc-client ;
  29
  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 ;
  34
  35 : read-matching-message ( listener quot: ( msg -- ? ) -- irc-message )
  36     [ in-messages>> 0.1 seconds ] dip mailbox-get-timeout? ;
  37
  38 : with-irc ( quot: ( -- ) -- )
  39     [ spawn-client ] dip [ f %push-line ] compose with-irc-client ; inline
  40
  41 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  42 !                       TESTS
  43 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  44
  45 [ { t } [ irc> nick>> me? ] unit-test
  46
  47   { "factorbot" } [ irc> nick>> ] unit-test
  48
  49   { "someuser" } [ "someuser!n=user@some.where" parse-name ] unit-test
  50
  51   { "#factortest" } [ ":someuser!n=user@some.where PRIVMSG #factortest :hi"
  52                       parse-irc-line forward-name ] unit-test
  53
  54   { "someuser" } [ ":someuser!n=user@some.where PRIVMSG factorbot :hi"
  55                    parse-irc-line forward-name ] unit-test
  56 ] with-irc
  57
  58 ! Test login and nickname set
  59 [ { "factorbot2" } [
  60      ":some.where 001 factorbot2 :Welcome factorbot2" %push-line
  61       irc> nick>>
  62   ] unit-test
  63 ] with-irc
  64
  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"
  70       } [ %push-line ] each
  71       irc> join-messages>> 0.1 seconds mailbox-get-timeout
  72       [ class ] [ trailing>> ] bi
  73   ] unit-test
  74 ] with-irc
  75
  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
  80   ] unit-test
  81 ] with-irc
  82
  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
  88   ] unit-test
  89 ] with-irc
  90
  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
  96   ] unit-test
  97 ] with-irc
  98
  99 [ { mode } [
 100       "#factortest" <irc-channel-listener>  [ %add-named-listener ] keep
 101       ":ircserver.net MODE #factortest +ns" %push-line
 102       [ mode? ] read-matching-message class
 103   ] unit-test
 104 ] with-irc
 105
 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
 110       participants>>
 111   ] unit-test
 112 ] with-irc
 113
 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
 120       participants>>
 121   ] unit-test
 122 ] with-irc
 123
 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
 130       participants>>
 131   ] unit-test
 132 ] with-irc
 133
 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
 140       participants>>
 141   ] unit-test
 142 ] with-irc
 143
 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
 149       participants>>
 150   ] unit-test
 151 ] with-irc
 152
 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
 159   ] unit-test
 160 ] with-irc
 161
 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
 168   ] unit-test
 169 ] with-irc
 170
 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
 177   ] unit-test
 178 ] with-irc