extra/irc/client/client-tests.factor

   1 USING: kernel tools.test accessors arrays sequences qualified
   2        io.streams.string 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 ! Utilities
  10 : <test-stream> ( lines -- stream )
  11   "\n" join <string-reader> <string-writer> <duplex-stream> ;
  12
  13 : make-client ( lines -- irc-client )
  14     "someserver" irc-port "factorbot" f <irc-profile> <irc-client>
  15     swap [ 2nip <test-stream> f ] curry >>connect ;
  16
  17 : set-nick ( irc-client nickname -- )
  18     swap profile>> (>>nickname) ;
  19
  20 : with-dummy-client ( irc-client quot -- )
  21     [ current-irc-client ] dip with-variable ; inline
  22
  23 { "" } make-client dup "factorbot" set-nick [
  24     { t } [ irc> profile>> nickname>> me? ] unit-test
  25
  26     { "factorbot" } [ irc> profile>> nickname>> ] unit-test
  27
  28     { "someuser" } [ "someuser!n=user@some.where" parse-name ] unit-test
  29
  30     { "#factortest" } [ ":someuser!n=user@some.where PRIVMSG #factortest :hi"
  31                         parse-irc-line irc-message-origin ] unit-test
  32
  33     { "someuser" } [ ":someuser!n=user@some.where PRIVMSG factorbot :hi"
  34                      parse-irc-line irc-message-origin ] unit-test
  35 ] with-dummy-client
  36
  37 ! Test login and nickname set
  38 { "factorbot" } [
  39     { "NOTICE AUTH :*** Looking up your hostname..."
  40       "NOTICE AUTH :*** Checking ident"
  41       "NOTICE AUTH :*** Found your hostname"
  42       "NOTICE AUTH :*** No identd (auth) response"
  43       ":some.where 001 factorbot :Welcome factorbot"
  44     } make-client
  45     { [ connect-irc ]
  46       [ drop 1 seconds sleep ]
  47       [ profile>> nickname>> ]
  48       [ terminate-irc ]
  49     } cleave ] unit-test
  50
  51 { join_ "#factortest" } [
  52     { ":factorbot!n=factorbo@some.where JOIN :#factortest"
  53       ":ircserver.net MODE #factortest +ns"
  54       ":ircserver.net 353 factorbot @ #factortest :@factorbot "
  55       ":ircserver.net 366 factorbot #factortest :End of /NAMES list."
  56       ":ircserver.net 477 factorbot #factortest :[ircserver-info] blah blah"
  57     } make-client
  58     { [ "factorbot" set-nick ]
  59       [ connect-irc ]
  60       [ drop 1 seconds sleep ]
  61       [ join-messages>> 1 seconds mailbox-get-timeout ]
  62       [ terminate-irc ]
  63     } cleave
  64     [ class ] [ trailing>> ] bi ] unit-test
  65
  66 { +join+ "somebody" } [
  67     { ":somebody!n=somebody@some.where JOIN :#factortest" } make-client
  68     { [ "factorbot" set-nick ]
  69       [ listeners>>
  70         [ "#factortest" [ <irc-channel-listener> ] keep ] dip set-at ]
  71       [ connect-irc ]
  72       [ listeners>> [ "#factortest" ] dip at
  73         [ read-message drop ] [ read-message drop ] [ read-message ] tri ]
  74       [ terminate-irc ]
  75     } cleave
  76     [ action>> ] [ nick>> ] bi
  77     ] unit-test
  78
  79 { privmsg "#factortest" "hello" } [
  80     { ":somebody!n=somebody@some.where PRIVMSG #factortest :hello" } make-client
  81     { [ "factorbot" set-nick ]
  82       [ listeners>>
  83         [ "#factortest" [ <irc-channel-listener> ] keep ] dip set-at ]
  84       [ connect-irc ]
  85       [ listeners>> [ "#factortest" ] dip at
  86         [ read-message drop ] [ read-message ] bi ]
  87       [ terminate-irc ]
  88     } cleave
  89     [ class ] [ name>> ] [ trailing>> ] tri
  90     ] unit-test
  91
  92 { privmsg "factorbot" "hello" } [
  93     { ":somedude!n=user@isp.net PRIVMSG factorbot :hello" } make-client
  94     { [ "factorbot" set-nick ]
  95       [ listeners>>
  96         [ "somedude" [ <irc-nick-listener> ] keep ] dip set-at ]
  97       [ connect-irc ]
  98       [ listeners>> [ "somedude" ] dip at
  99         [ read-message drop ] [ read-message ] bi ]
 100       [ terminate-irc ]
 101     } cleave
 102     [ class ] [ name>> ] [ trailing>> ] tri
 103     ] unit-test