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

View File

@ -21,7 +21,7 @@ section
tests.cmo:
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
test: tests

View File

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

View File

@ -4,8 +4,8 @@ type t
type event = Input | Priority | Output | Error | Hangup
(** An event associated with a file descriptor *)
type fd_handler = t -> event -> Unix.file_descr -> unit
(** [fd_handler d evt fd] handles an [event] generated by dispatcher [d] *)
type fd_handler = t -> Unix.file_descr -> event list -> unit
(** [fd_handler d fd evt] handles an [event] generated by dispatcher [d] *)
type timeout_handler = t -> float -> unit
(** [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 =
match events with
| [] ->
[]
[]
| Epoll.In :: tl ->
"POLLIN" :: (epollevents_as_list tl)
"POLLIN" :: (epollevents_as_list tl)
| Epoll.Priority :: tl ->
"POLLPRI" :: (epollevents_as_list tl)
"POLLPRI" :: (epollevents_as_list tl)
| Epoll.Out :: tl ->
"POLLOUT" :: (epollevents_as_list tl)
"POLLOUT" :: (epollevents_as_list tl)
| Epoll.Error :: tl ->
"POLLERR" :: (epollevents_as_list tl)
"POLLERR" :: (epollevents_as_list tl)
| Epoll.Hangup :: tl ->
"POLLHUP" :: (epollevents_as_list 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
(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 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 =
"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);
"Unit tests" >::: [
"epoll" >::
(fun () ->
let a,b = Unix.socketpair Unix.PF_UNIX Unix.SOCK_STREAM 0 in
let e = Epoll.create 1 in
let expect = epoll_expect e in
Epoll.ctl e Epoll.Add (a, [Epoll.Out; Epoll.In]);
expect [(a, [Epoll.Out])];
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.Modify (a, [Epoll.In; Epoll.Priority]);
expect [];
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.Add (b, [Epoll.Out; Epoll.In]);
expect [(b, [Epoll.Out])];
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]);
expect [(a, [Epoll.Out]); (b, [Epoll.Out])];
assert_equal
1
(List.length (Epoll.wait e 1 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.Modify (a, [Epoll.Out; Epoll.In]);
expect [(a, [Epoll.Out]); (b, [Epoll.Out])];
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);
assert_equal
2
(Unix.write a "hi" 0 2);
expect [(a, [Epoll.Out]); (b, [Epoll.In; Epoll.Out])];
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.ctl e Epoll.Delete (a, []);
expect [(b, [Epoll.In; Epoll.Out])];
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]));
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" >::
(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");
)
(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");
)
]
@ -145,11 +136,11 @@ let regression_tests =
(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";
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";
@ -158,10 +149,10 @@ let regression_tests =
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 "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";
@ -178,13 +169,13 @@ let regression_tests =
chat_run ues);
"Second connection" >::
(fun () ->
(fun () ->
let script =
(do_login "otherguy") @
[
Send "ISON nick otherguy\r\n";
Recv ":testserver.test 303 otherguy :otherguy\r\n";
]
[
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
@ -226,6 +217,6 @@ let regression_tests =
let _ =
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])