Simultaneous connections test

This commit is contained in:
Neale Pickett 2008-03-07 13:52:13 -07:00
parent 8cefe61976
commit babb102cd4
2 changed files with 97 additions and 53 deletions

11
chat.ml
View File

@ -161,6 +161,11 @@ object (self)
end end
let chat_create ues script proc =
let a,b = Unix.socketpair Unix.PF_UNIX Unix.SOCK_STREAM 0 in
ignore (proc ues a);
ignore (new chat_handler script ues b)
(** Run a chat script (** Run a chat script
[chat script proc] will create a Unix domain socket pair, call [proc [chat script proc] will create a Unix domain socket pair, call [proc
@ -168,11 +173,7 @@ end
[script] through it. [script] through it.
*) *)
let chat script proc = let chat_run ues =
let ues = new unix_event_system () in
let a,b = Unix.socketpair Unix.PF_UNIX Unix.SOCK_STREAM 0 in
let _ = proc ues a in
let _ = new chat_handler script ues b in
try try
Unixqueue.run ues; Unixqueue.run ues;
with with

View File

@ -3,13 +3,7 @@ open OUnit
open Chat open Chat
open Irc open Irc
let do_chat script () = let ues = Unixqueue.create_unix_event_system ()
let ircd_instance ues fd =
let g = Unixqueue.new_group ues in
Unixqueue.add_handler ues g Iobuf.handle_event;
Client.handle_connection ues g fd
in
chat script ircd_instance
let unit_tests = let unit_tests =
"Unit tests" >::: "Unit tests" >:::
@ -37,6 +31,7 @@ let unit_tests =
] ]
let do_login nick = let do_login nick =
[ [
Send ("USER " ^ nick ^ " +iw " ^ nick ^ " :gecos\r\n"); Send ("USER " ^ nick ^ " +iw " ^ nick ^ " :gecos\r\n");
@ -51,7 +46,9 @@ let regression_tests =
"Regression tests" >::: "Regression tests" >:::
[ [
"Simple connection" >:: "Simple connection" >::
(do_chat ((do_login "nick") @ (fun () ->
let script =
(do_login "nick") @
[ [
Send "BLARGH\r\n"; Send "BLARGH\r\n";
Recv ":testserver.test 421 nick BLARGH :Unknown or misconstructed command\r\n"; Recv ":testserver.test 421 nick BLARGH :Unknown or misconstructed command\r\n";
@ -75,14 +72,60 @@ let regression_tests =
Recv ":nick!nick@UDS NOTICE nick :hello\r\n"; Recv ":nick!nick@UDS NOTICE nick :hello\r\n";
Send "PRIVMSG otherguy :hello\r\n"; Send "PRIVMSG otherguy :hello\r\n";
Recv ":testserver.test 401 nick otherguy :No such nick/channel\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" >:: "Second connection" >::
(do_chat ((do_login "otherguy") @ (fun () ->
let script =
(do_login "otherguy") @
[ [
Send "ISON nick otherguy\r\n"; Send "ISON nick otherguy\r\n";
Recv ":testserver.test 303 otherguy :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 _ = let _ =