Dispatch tests don't need their own module

This commit is contained in:
Neale Pickett 2008-03-15 20:01:53 -06:00
parent 27d0137167
commit dd677d5d4e
3 changed files with 30 additions and 34 deletions

View File

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

View File

@ -1,31 +0,0 @@
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 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);
Dispatch.destroy d;
Unix.close a;
Unix.close b
);
]

View File

@ -44,7 +44,7 @@ let epoll_expect e ?(n=3) l =
let unit_tests =
"Unit tests" >::: [
"epoll" >::
"Epoll" >::
(fun () ->
let a,b = Unix.socketpair Unix.PF_UNIX Unix.SOCK_STREAM 0 in
let e = Epoll.create 1 in
@ -95,6 +95,33 @@ let unit_tests =
Epoll.destroy e
);
"Dispatch" >::
(fun () ->
let d = Dispatch.create 3 in
let a,b = Unix.socketpair Unix.PF_UNIX Unix.SOCK_STREAM 0 in
let rec handle 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);
Dispatch.destroy d;
Unix.close a;
Unix.close b
);
"command_of_string" >::
(fun () ->
assert_equal
@ -217,6 +244,6 @@ let regression_tests =
let _ =
Irc.name := "testserver.test";
run_test_tt_main (TestList [Dispatch_tests.unit; unit_tests; regression_tests])
run_test_tt_main (TestList [unit_tests; regression_tests])