neale
/
irc-bot
mirror of https://github.com/nealey/irc-bot
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

Start at dispatch module, needs debugging

This commit is contained in:
Neale Pickett 2008-03-14 21:28:22 -06:00
parent 0d4b2e3f92
commit 3eb2571769
5 changed files with 126 additions and 108 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
OMakefile
View File

@ -21,7 +21,7 @@ section
tests.cmo: tests.cmo:
tests$(EXT_OBJ): tests$(EXT_OBJ):
OCamlProgram(tests, tests chat irc command iobuf client channel) OCamlProgram(tests, tests dispatch_tests dispatch chat irc command iobuf client channel)
.PHONY: test .PHONY: test
test: tests test: tests

6
dispatch.ml
View File

@ -89,7 +89,7 @@ let rec dispatch_timeouts d now =
dispatch_timeouts d now dispatch_timeouts d now
end end
let rec dispatch_events d events_list = let rec dispatch_results d events_list =
match events_list with match events_list with
| [] -> | [] ->
() ()
@ -97,7 +97,7 @@ let rec dispatch_events d events_list =
let handler = Fd_map.find fd !d.fds in let handler = Fd_map.find fd !d.fds in
let events = events_of_epoll_events in let events = events_of_epoll_events in
handler d fd events; handler d fd events;
dispatch_events d tl dispatch_results d tl
let once d = let once d =
let now = Unix.time () in let now = Unix.time () in
@ -111,7 +111,7 @@ let once d =
in in
let result = Epoll.wait d.e !d.nfds timeout in let result = Epoll.wait d.e !d.nfds timeout in
dispatch_timeouts d (Unix.time ()); dispatch_timeouts d (Unix.time ());
dispatch_events d result dispatch_results d result
let rec run d = let rec run d =
if ((!d.fds == Fd_map.empty) && if ((!d.fds == Fd_map.empty) &&

4
dispatch.mli
View File

@ -4,8 +4,8 @@ type t
type event = Input | Priority | Output | Error | Hangup type event = Input | Priority | Output | Error | Hangup
(** An event associated with a file descriptor *) (** An event associated with a file descriptor *)
type fd_handler = t -> event -> Unix.file_descr -> unit type fd_handler = t -> Unix.file_descr -> event list -> unit
(** [fd_handler d evt fd] handles an [event] generated by dispatcher [d] *) (** [fd_handler d fd evt] handles an [event] generated by dispatcher [d] *)
type timeout_handler = t -> float -> unit type timeout_handler = t -> float -> unit
(** [timeout_handler d when] is called at or after [when] by dispatcher [d] *) (** [timeout_handler d when] is called at or after [when] by dispatcher [d] *)

27
dispatch_tests.ml Normal file
View File

@ -0,0 +1,27 @@
open OUnit
let unit =
"Dispatch unit tests" >::: [
"basic" >::
(fun () ->
let d = Dispatch.create 3 in
let a,b = Unix.socketpair Unix.PF_UNIX Unix.SOCK_STREAM 0 in
let rec handle d fd events =
match events with
| [Dispatch.Input; Dispatch.Output] ->
let s = String.create 4096 in
let n = Unix.read fd s 0 4096 in
assert_equal
n
(Unix.write fd s 0 n)
| _ ->
()
in
assert_equal 2 (Unix.write a "hi" 0 2);
Dispatch.add d b handle [Dispatch.Input; Dispatch.Output];
Dispatch.once d;
let s = String.create 4096 in
assert_equal 2 (Unix.read a s 0 4096);
assert_equal "hi" (Str.string_before s 2);
);
]

195
tests.ml
View File

@ -10,120 +10,111 @@ let int_of_file_descr fd = (Obj.magic fd) + 0
let rec epollevents_as_list events = let rec epollevents_as_list events =
match events with match events with
| [] -> | [] ->
[] []
| Epoll.In :: tl -> | Epoll.In :: tl ->
"POLLIN" :: (epollevents_as_list tl) "POLLIN" :: (epollevents_as_list tl)
| Epoll.Priority :: tl -> | Epoll.Priority :: tl ->
"POLLPRI" :: (epollevents_as_list tl) "POLLPRI" :: (epollevents_as_list tl)
| Epoll.Out :: tl -> | Epoll.Out :: tl ->
"POLLOUT" :: (epollevents_as_list tl) "POLLOUT" :: (epollevents_as_list tl)
| Epoll.Error :: tl -> | Epoll.Error :: tl ->
"POLLERR" :: (epollevents_as_list tl) "POLLERR" :: (epollevents_as_list tl)
| Epoll.Hangup :: tl -> | Epoll.Hangup :: tl ->
"POLLHUP" :: (epollevents_as_list tl) "POLLHUP" :: (epollevents_as_list tl)
let rec epollfds_as_list pfds = let rec epollfds_as_list pfds =
match pfds with match pfds with
| [] -> | [] ->
[] []
| (fd, events) :: tl -> | (fd, events) :: tl ->
(Printf.sprintf "{fd=%d; events=%s}" (Printf.sprintf "{fd=%d; events=%s}"
(int_of_file_descr fd) (int_of_file_descr fd)
(String.concat "|" (epollevents_as_list events))) :: (String.concat "|" (epollevents_as_list events))) ::
epollfds_as_list tl epollfds_as_list tl
let epollfds_as_string pfds = let epollfds_as_string pfds =
"[" ^ (String.concat ", " (epollfds_as_list pfds)) ^ "]" "[" ^ (String.concat ", " (epollfds_as_list pfds)) ^ "]"
let epoll_expect e ?(n=3) l =
let m = Epoll.wait e n 0 in
assert_equal
~printer:epollfds_as_string
(List.sort compare l)
(List.sort compare m)
let unit_tests = let unit_tests =
"Unit tests" >::: "Unit tests" >::: [
[ "epoll" >::
"epoll" >:: (fun () ->
(fun () -> let a,b = Unix.socketpair Unix.PF_UNIX Unix.SOCK_STREAM 0 in
let a,b = Unix.socketpair Unix.PF_UNIX Unix.SOCK_STREAM 0 in let e = Epoll.create 1 in
let e = Epoll.create 1 in let expect = epoll_expect e in
Epoll.ctl e Epoll.Add (a, [Epoll.Out; Epoll.In]); Epoll.ctl e Epoll.Add (a, [Epoll.Out; Epoll.In]);
assert_equal expect [(a, [Epoll.Out])];
~printer:epollfds_as_string
[(a, [Epoll.Out])]
(Epoll.wait e 1 0);
Epoll.ctl e Epoll.Modify (a, [Epoll.In; Epoll.Priority]); Epoll.ctl e Epoll.Modify (a, [Epoll.In; Epoll.Priority]);
assert_equal expect [];
~printer:epollfds_as_string
[]
(Epoll.wait e 1 0);
Epoll.ctl e Epoll.Add (b, [Epoll.Out; Epoll.In]); Epoll.ctl e Epoll.Add (b, [Epoll.Out; Epoll.In]);
assert_equal expect [(b, [Epoll.Out])];
~printer:epollfds_as_string
[(b, [Epoll.Out])]
(Epoll.wait e 2 0);
Epoll.ctl e Epoll.Modify (a, [Epoll.Out; Epoll.In]); Epoll.ctl e Epoll.Modify (a, [Epoll.Out; Epoll.In]);
assert_equal expect [(a, [Epoll.Out]); (b, [Epoll.Out])];
~printer:epollfds_as_string assert_equal
[(a, [Epoll.Out]); (b, [Epoll.Out])] 1
(Epoll.wait e 2 0); (List.length (Epoll.wait e 1 0));
Epoll.ctl e Epoll.Modify (a, [Epoll.Out; Epoll.In]); Epoll.ctl e Epoll.Modify (a, [Epoll.Out; Epoll.In]);
assert_equal expect [(a, [Epoll.Out]); (b, [Epoll.Out])];
~printer:epollfds_as_string
[(b, [Epoll.Out])]
(Epoll.wait e 1 0);
Epoll.ctl e Epoll.Delete (a, []); assert_equal
assert_equal 2
~printer:epollfds_as_string (Unix.write a "hi" 0 2);
[(b, [Epoll.Out])] expect [(a, [Epoll.Out]); (b, [Epoll.In; 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; Epoll.ctl e Epoll.Delete (a, []);
assert_equal expect [(b, [Epoll.In; Epoll.Out])];
~printer:epollfds_as_string assert_raises
[] (Failure "ocaml_epoll_ctl: No such file or directory")
(Epoll.wait e 2 0); (fun () ->
assert_raises Epoll.ctl e Epoll.Modify (a, [Epoll.In; Epoll.Priority]));
(Failure "ocaml_epoll_ctl: Bad file descriptor") assert_raises
(fun () -> (Failure "ocaml_epoll_ctl: File exists")
Epoll.ctl e Epoll.Modify (b, [Epoll.In; Epoll.Priority])); (fun () ->
Epoll.ctl e Epoll.Add (b, [Epoll.In; Epoll.Priority]));
expect [(b, [Epoll.In; Epoll.Out])];
Epoll.destroy e; Unix.close a;
Unix.close a expect [(b, [Epoll.In; Epoll.Out; Epoll.Hangup])];
); assert_raises
(Failure "ocaml_epoll_ctl: Bad file descriptor")
(fun () ->
Epoll.ctl e Epoll.Modify (a, [Epoll.In; Epoll.Priority]));
Unix.close b;
Epoll.destroy e
);
"command_of_string" >:: "command_of_string" >::
(fun () -> (fun () ->
assert_equal assert_equal
~printer:Command.as_string ~printer:Command.as_string
(Command.create None "NICK" ["name"] None) (Command.create None "NICK" ["name"] None)
(Command.from_string "NICK name"); (Command.from_string "NICK name");
assert_equal assert_equal
~printer:Command.as_string ~printer:Command.as_string
(Command.create None "NICK" ["name"] None) (Command.create None "NICK" ["name"] None)
(Command.from_string "nick name"); (Command.from_string "nick name");
assert_equal assert_equal
~printer:Command.as_string ~printer:Command.as_string
(Command.create (Some "foo") "NICK" ["name"] None) (Command.create (Some "foo") "NICK" ["name"] None)
(Command.from_string ":foo NICK name"); (Command.from_string ":foo NICK name");
assert_equal assert_equal
~printer:Command.as_string ~printer:Command.as_string
(Command.create (Some "foo.bar") "PART" ["#foo"; "#bar"] (Command.create (Some "foo.bar") "PART" ["#foo"; "#bar"]
(Some "ta ta")) (Some "ta ta"))
(Command.from_string ":foo.bar PART #foo #bar :ta ta"); (Command.from_string ":foo.bar PART #foo #bar :ta ta");
) )
] ]
@ -145,11 +136,11 @@ let regression_tests =
(fun () -> (fun () ->
let script = let script =
(do_login "nick") @ (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";
Send "MOTD\r\n"; Send "MOTD\r\n";
Recv ":testserver.test 422 nick :MOTD File is missing\r\n"; Recv ":testserver.test 422 nick :MOTD File is missing\r\n";
Send "TIME\r\n"; Send "TIME\r\n";
Regex ":testserver\\.test 391 nick testserver\\.test :[-0-9]+T[:0-9]+Z\r\n"; Regex ":testserver\\.test 391 nick testserver\\.test :[-0-9]+T[:0-9]+Z\r\n";
Send "VERSION\r\n"; Send "VERSION\r\n";
@ -158,10 +149,10 @@ let regression_tests =
Recv ":testserver.test PONG testserver.test :snot\r\n"; Recv ":testserver.test PONG testserver.test :snot\r\n";
Send "PING :snot\r\n"; Send "PING :snot\r\n";
Recv ":testserver.test PONG testserver.test :snot\r\n"; Recv ":testserver.test PONG testserver.test :snot\r\n";
Send "ISON nick otherguy\r\n"; Send "ISON nick otherguy\r\n";
Recv ":testserver.test 303 nick :nick\r\n"; Recv ":testserver.test 303 nick :nick\r\n";
Send "ISON otherguy thirdguy\r\n"; Send "ISON otherguy thirdguy\r\n";
Recv ":testserver.test 303 nick :\r\n"; Recv ":testserver.test 303 nick :\r\n";
Send "PRIVMSG nick :hello\r\n"; Send "PRIVMSG nick :hello\r\n";
Recv ":nick!nick@UDS PRIVMSG nick :hello\r\n"; Recv ":nick!nick@UDS PRIVMSG nick :hello\r\n";
Send "NOTICE nick :hello\r\n"; Send "NOTICE nick :hello\r\n";
@ -178,13 +169,13 @@ let regression_tests =
chat_run ues); chat_run ues);
"Second connection" >:: "Second connection" >::
(fun () -> (fun () ->
let script = let script =
(do_login "otherguy") @ (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 in
let g = Unixqueue.new_group ues in let g = Unixqueue.new_group ues in
let a,b = Unix.socketpair Unix.PF_UNIX Unix.SOCK_STREAM 0 in let a,b = Unix.socketpair Unix.PF_UNIX Unix.SOCK_STREAM 0 in
@ -226,6 +217,6 @@ let regression_tests =
let _ = let _ =
Irc.name := "testserver.test"; Irc.name := "testserver.test";
run_test_tt_main (TestList [unit_tests; regression_tests]) run_test_tt_main (TestList [Dispatch_tests.unit; unit_tests; regression_tests])