Start at dispatch module, needs debugging

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

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) &&

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] *)

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);
+      );
+  ]

tests.ml

@@ -35,48 +35,45 @@ let rec epollfds_as_list pfds =
 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" >:::
-    [
+  "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]);
-	     assert_equal
-	       ~printer:epollfds_as_string
-	       [(a, [Epoll.Out])]
-	       (Epoll.wait e 1 0);
+           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);
+           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);
+           expect [(b, [Epoll.Out])];
 
            Epoll.ctl e Epoll.Modify (a, [Epoll.Out; Epoll.In]);
+           expect [(a, [Epoll.Out]); (b, [Epoll.Out])];
            assert_equal
-	       ~printer:epollfds_as_string
-	       [(a, [Epoll.Out]); (b, [Epoll.Out])]
-	       (Epoll.wait e 2 0);
+             1
+             (List.length (Epoll.wait e 1 0));
 
            Epoll.ctl e Epoll.Modify (a, [Epoll.Out; Epoll.In]);
+           expect [(a, [Epoll.Out]); (b, [Epoll.Out])];
+
            assert_equal
-	       ~printer:epollfds_as_string
-	       [(b, [Epoll.Out])]
-	       (Epoll.wait e 1 0);
+             2
+             (Unix.write a "hi" 0 2);
+           expect [(a, [Epoll.Out]); (b, [Epoll.In; Epoll.Out])];
 
            Epoll.ctl e Epoll.Delete (a, []);
-	     assert_equal
-	       ~printer:epollfds_as_string
-	       [(b, [Epoll.Out])]
-	       (Epoll.wait e 2 0);
+           expect [(b, [Epoll.In; Epoll.Out])];
            assert_raises 
              (Failure "ocaml_epoll_ctl: No such file or directory")
              (fun () ->
@@ -85,23 +82,17 @@ let unit_tests =
              (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);
+           expect [(b, [Epoll.In; Epoll.Out])];
 
-	     Unix.close b;
-	     assert_equal
-	       ~printer:epollfds_as_string
-	       []
-	       (Epoll.wait e 2 0);
+           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 (b, [Epoll.In; Epoll.Priority]));
+                Epoll.ctl e Epoll.Modify (a, [Epoll.In; Epoll.Priority]));
 
-	     Epoll.destroy e;
-	     Unix.close a
+           Unix.close b;
+           Epoll.destroy e
       );
 
       "command_of_string" >:: 
@@ -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])