mirror of https://github.com/nealey/irc-bot
Start at dispatch module, needs debugging
This commit is contained in:
parent
0d4b2e3f92
commit
3eb2571769
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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) &&
|
||||
|
|
|
|||
|
|
@ -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] *)
|
||||
|
|
|
|||
|
|
@ -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
195
tests.ml
|
|
@ -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])
|
||||
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue