From 3eb2571769e6e904760b4198e4ab2de066dc4203 Mon Sep 17 00:00:00 2001 From: Neale Pickett Date: Fri, 14 Mar 2008 21:28:22 -0600 Subject: [PATCH] Start at dispatch module, needs debugging --- OMakefile | 2 +- dispatch.ml | 6 +- dispatch.mli | 4 +- dispatch_tests.ml | 27 +++++++ tests.ml | 195 ++++++++++++++++++++++------------------------ 5 files changed, 126 insertions(+), 108 deletions(-) create mode 100644 dispatch_tests.ml diff --git a/OMakefile b/OMakefile index 534b56c..ea86327 100644 --- a/OMakefile +++ b/OMakefile @@ -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 diff --git a/dispatch.ml b/dispatch.ml index 9aa5cc3..bcafc69 100644 --- a/dispatch.ml +++ b/dispatch.ml @@ -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) && diff --git a/dispatch.mli b/dispatch.mli index b6723a0..218cb3c 100644 --- a/dispatch.mli +++ b/dispatch.mli @@ -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] *) diff --git a/dispatch_tests.ml b/dispatch_tests.ml new file mode 100644 index 0000000..fe518ac --- /dev/null +++ b/dispatch_tests.ml @@ -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); + ); + ] diff --git a/tests.ml b/tests.ml index 60e6a13..6e854ac 100644 --- a/tests.ml +++ b/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])