irc-bot/tests.ml

232 lines
7.4 KiB
OCaml

open Unixqueue
open OUnit
open Chat
open Irc
let ues = Unixqueue.create_unix_event_system ()
let int_of_file_descr fd = (Obj.magic fd) + 0
let rec epollevents_as_list events =
match events with
| [] ->
[]
| Epoll.In :: tl ->
"POLLIN" :: (epollevents_as_list tl)
| Epoll.Priority :: tl ->
"POLLPRI" :: (epollevents_as_list tl)
| Epoll.Out :: tl ->
"POLLOUT" :: (epollevents_as_list tl)
| Epoll.Error :: tl ->
"POLLERR" :: (epollevents_as_list tl)
| Epoll.Hangup :: tl ->
"POLLHUP" :: (epollevents_as_list tl)
let rec epollfds_as_list pfds =
match pfds with
| [] ->
[]
| (fd, events) :: tl ->
(Printf.sprintf "{fd=%d; events=%s}"
(int_of_file_descr fd)
(String.concat "|" (epollevents_as_list events))) ::
epollfds_as_list tl
let epollfds_as_string pfds =
"[" ^ (String.concat ", " (epollfds_as_list pfds)) ^ "]"
let unit_tests =
"Unit tests" >:::
[
"epoll" >::
(fun () ->
let a,b = Unix.socketpair Unix.PF_UNIX Unix.SOCK_STREAM 0 in
let e = Epoll.create 1 in
Epoll.ctl e Epoll.Add (a, [Epoll.Out; Epoll.In]);
assert_equal
~printer:epollfds_as_string
[(a, [Epoll.Out])]
(Epoll.wait e 1 0);
Epoll.ctl e Epoll.Modify (a, [Epoll.In; Epoll.Priority]);
assert_equal
~printer:epollfds_as_string
[]
(Epoll.wait e 1 0);
Epoll.ctl e Epoll.Add (b, [Epoll.Out; Epoll.In]);
assert_equal
~printer:epollfds_as_string
[(b, [Epoll.Out])]
(Epoll.wait e 2 0);
Epoll.ctl e Epoll.Modify (a, [Epoll.Out; Epoll.In]);
assert_equal
~printer:epollfds_as_string
[(a, [Epoll.Out]); (b, [Epoll.Out])]
(Epoll.wait e 2 0);
Epoll.ctl e Epoll.Modify (a, [Epoll.Out; Epoll.In]);
assert_equal
~printer:epollfds_as_string
[(b, [Epoll.Out])]
(Epoll.wait e 1 0);
Epoll.ctl e Epoll.Delete (a, []);
assert_equal
~printer:epollfds_as_string
[(b, [Epoll.Out])]
(Epoll.wait e 2 0);
assert_raises
(Failure "ocaml_epoll_ctl: No such file or directory")
(fun () ->
Epoll.ctl e Epoll.Modify (a, [Epoll.In; Epoll.Priority]));
assert_raises
(Failure "ocaml_epoll_ctl: File exists")
(fun () ->
Epoll.ctl e Epoll.Add (b, [Epoll.In; Epoll.Priority]));
assert_equal
~printer:epollfds_as_string
[(b, [Epoll.Out])]
(Epoll.wait e 2 0);
Unix.close b;
assert_equal
~printer:epollfds_as_string
[]
(Epoll.wait e 2 0);
assert_raises
(Failure "ocaml_epoll_ctl: Bad file descriptor")
(fun () ->
Epoll.ctl e Epoll.Modify (b, [Epoll.In; Epoll.Priority]));
Epoll.destroy e;
Unix.close a
);
"command_of_string" >::
(fun () ->
assert_equal
~printer:Command.as_string
(Command.create None "NICK" ["name"] None)
(Command.from_string "NICK name");
assert_equal
~printer:Command.as_string
(Command.create None "NICK" ["name"] None)
(Command.from_string "nick name");
assert_equal
~printer:Command.as_string
(Command.create (Some "foo") "NICK" ["name"] None)
(Command.from_string ":foo NICK name");
assert_equal
~printer:Command.as_string
(Command.create (Some "foo.bar") "PART" ["#foo"; "#bar"]
(Some "ta ta"))
(Command.from_string ":foo.bar PART #foo #bar :ta ta");
)
]
let do_login nick =
[
Send ("USER " ^ nick ^ " +iw " ^ nick ^ " :gecos\r\n");
Send ("NICK " ^ nick ^ "\r\n");
Recv (":testserver.test 001 " ^ nick ^ " :Welcome to IRC.\r\n");
Recv (":testserver.test 002 " ^ nick ^ " :I am testserver.test Running version " ^ Irc.version ^ "\r\n");
Recv (":testserver.test 003 " ^ nick ^ " :This server was created sometime\r\n");
Recv (":testserver.test 004 " ^ nick ^ " :testserver.test 0.1 l t\r\n");
]
let regression_tests =
"Regression tests" >:::
[
"Simple connection" >::
(fun () ->
let script =
(do_login "nick") @
[
Send "BLARGH\r\n";
Recv ":testserver.test 421 nick BLARGH :Unknown or misconstructed command\r\n";
Send "MOTD\r\n";
Recv ":testserver.test 422 nick :MOTD File is missing\r\n";
Send "TIME\r\n";
Regex ":testserver\\.test 391 nick testserver\\.test :[-0-9]+T[:0-9]+Z\r\n";
Send "VERSION\r\n";
Recv ":testserver.test 351 nick 0.1 testserver.test :\r\n";
Send "PING snot\r\n";
Recv ":testserver.test PONG testserver.test :snot\r\n";
Send "PING :snot\r\n";
Recv ":testserver.test PONG testserver.test :snot\r\n";
Send "ISON nick otherguy\r\n";
Recv ":testserver.test 303 nick :nick\r\n";
Send "ISON otherguy thirdguy\r\n";
Recv ":testserver.test 303 nick :\r\n";
Send "PRIVMSG nick :hello\r\n";
Recv ":nick!nick@UDS PRIVMSG nick :hello\r\n";
Send "NOTICE nick :hello\r\n";
Recv ":nick!nick@UDS NOTICE nick :hello\r\n";
Send "PRIVMSG otherguy :hello\r\n";
Recv ":testserver.test 401 nick otherguy :No such nick/channel\r\n";
]
in
let g = Unixqueue.new_group ues in
let a,b = Unix.socketpair Unix.PF_UNIX Unix.SOCK_STREAM 0 in
Unixqueue.add_handler ues g Iobuf.handle_event;
Client.handle_connection ues g a;
ignore (new chat_handler script ues b);
chat_run ues);
"Second connection" >::
(fun () ->
let script =
(do_login "otherguy") @
[
Send "ISON nick otherguy\r\n";
Recv ":testserver.test 303 otherguy :otherguy\r\n";
]
in
let g = Unixqueue.new_group ues in
let a,b = Unix.socketpair Unix.PF_UNIX Unix.SOCK_STREAM 0 in
Unixqueue.add_handler ues g Iobuf.handle_event;
Client.handle_connection ues g a;
ignore (new chat_handler script ues b);
chat_run ues);
"Simultaneous connections" >::
(fun () ->
let script1 =
(do_login "alice") @
[
Send "ISON bob\r\n";
Recv ":testserver.test 303 alice :bob\r\n";
Send "PRIVMSG bob :Hi Bob!\r\n";
Send "PING :foo\r\n"; (* Make sure we don't disconnect too soon *)
Recv ":testserver.test PONG testserver.test :foo\r\n";
]
in
let script2 =
(do_login "bob") @
[
Send "ISON alice\r\n";
Recv ":testserver.test 303 bob :alice\r\n";
Recv ":alice!alice@UDS PRIVMSG bob :Hi Bob!\r\n";
]
in
let g = Unixqueue.new_group ues in
let aa,ab = Unix.socketpair Unix.PF_UNIX Unix.SOCK_STREAM 0 in
let ba,bb = Unix.socketpair Unix.PF_UNIX Unix.SOCK_STREAM 0 in
Unixqueue.add_handler ues g Iobuf.handle_event;
Client.handle_connection ues g aa;
Client.handle_connection ues g ba;
ignore (new chat_handler script1 ues ab);
ignore (new chat_handler script2 ues bb);
chat_run ues);
]
let _ =
Irc.name := "testserver.test";
run_test_tt_main (TestList [unit_tests; regression_tests])