neale
/
irc-bot
mirror of https://github.com/nealey/irc-bot
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

An attempt to get the first regression test passing 

I fixed a couple bugs and stubbed in a client state change, so now it's
at least failing closer to where it ought to.
This commit is contained in:
Neale Pickett 2008-02-28 22:24:52 -07:00
parent 4b2a60ec71
commit 1617dbca19
2 changed files with 56 additions and 37 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

52
client.ml
View File

@ -40,7 +40,7 @@ let close cli ues g fd =
let write cli cmd = let write cli cmd =
let was_empty = Queue.is_empty cli.outq in let was_empty = Queue.is_empty cli.outq in
Queue.add cmd cli.outq; Queue.add cmd cli.outq;
if was_empty then if (was_empty && (!(cli.unsent) = "")) then
cli.output_ready () cli.output_ready ()
let handle_close cli = let handle_close cli =
@ -51,24 +51,40 @@ let handle_command cli command =
let handle_command_login cli cmd = let handle_command_login cli cmd =
(* Handle a command during the login phase *) (* Handle a command during the login phase *)
match (Command.as_tuple cmd) with (match (Command.as_tuple cmd) with
| (None, "USER", [username], Some realname) -> | (None, "USER", [username; _; _], Some realname) ->
cli.username := username; cli.username := username;
cli.realname := Irc.truncate realname 40 cli.realname := Irc.truncate realname 40
| (None, "NICK", [nick], None) -> | (None, "NICK", [nick], None) ->
cli.nick := nick cli.nick := nick;
| _ -> | _ ->
write cli (Command.create write cli (Command.create
~sender:(Some !Irc.name) ~sender:(Some !Irc.name)
~text:(Some "Register first.") ~text:(Some "Register first.")
"451" ["*"]) "451" ["*"]));
(match (!(cli.username), !(cli.nick)) with
| ("", _)
| (_, "") ->
()
| (_, nick) ->
write cli (Command.create
~sender:(Some !Irc.name)
~text:(Some "*** Hi there.")
"NOTICE"
[nick]))
let rec handle_input cli = let rec handle_input cli =
match cli.ibuf with match cli.ibuf with
| "" -> | "" ->
() ()
| ibuf -> | ibuf ->
let p = String.index ibuf '\n' in let p =
let nlp = String.index ibuf '\n' in
if ((String.get ibuf (nlp - 1)) = '\r') then
(nlp - 1)
else
nlp
in
let s = String.sub ibuf 0 p in let s = String.sub ibuf 0 p in
if p >= !(cli.ibuf_len) then if p >= !(cli.ibuf_len) then
raise Not_found; raise Not_found;
@ -102,12 +118,16 @@ let handle_event ues esys e =
let buf = let buf =
if (!(cli.unsent) = "") then if (!(cli.unsent) = "") then
let cmd = Queue.pop cli.outq in let cmd = Queue.pop cli.outq in
Command.as_string cmd (Command.as_string cmd) ^ "\r\n"
else else
!(cli.unsent) !(cli.unsent)
in in
let n = Unix.single_write fd buf 0 (String.length buf) in let buflen = String.length buf in
cli.unsent := Str.string_after buf n let n = Unix.single_write fd buf 0 buflen in
if n < buflen then
cli.unsent := Str.string_after buf n
else if Queue.is_empty cli.outq then
Unixqueue.remove_resource ues g (Unixqueue.Wait_out fd)
| Unixqueue.Out_of_band (g, fd) -> | Unixqueue.Out_of_band (g, fd) ->
print_endline "oob" print_endline "oob"
| Unixqueue.Timeout (g, op) -> | Unixqueue.Timeout (g, op) ->

41
tests.ml
View File

@ -39,11 +39,9 @@ let unit_tests =
let regression_tests = let regression_tests =
let login_script = let login_script =
[ [
Send "USER nick +iw nick :gecos\n"; Send "USER nick +iw nick :gecos\r\n";
Send "NICK nick\n"; Send "NICK nick\r\n";
Recv ":testserver.test NOTICE nick :*** Hi there.\n"; Recv ":testserver.test NOTICE nick :*** Hi there.\r\n";
Recv "PING :12345\n";
Send "PONG :12345\n";
] ]
in in
"Regression tests" >::: "Regression tests" >:::
@ -56,27 +54,28 @@ let regression_tests =
(do_chat (do_chat
(login_script @ (login_script @
[ [
Recv ":testserver.test 001 nick :Welcome to the test script\n"; Recv ":testserver.test 001 nick :Welcome to the test script\r\n";
Recv ":testserver.test 002 nick :Your host is testserver.test\n"; Recv ":testserver.test 002 nick :Your host is testserver.test\r\n";
Recv ":testserver.test 003 nick :This server is timeless\n"; Recv ":testserver.test 003 nick :This server is timeless\r\n";
Recv ":testserver.test 004 nick testserver.test testscript DGabcdfg bilmnopst bkloveI\n"; Recv ":testserver.test 004 nick testserver.test testscript DGabcdfg bilmnopst bkloveI\r\n";
Recv ":testserver.test 005 nick CALLERID CASEMAPPING=rfc1459 KICKLEN=160 MODES=4 WHATEVER=4 WHO=1 CARES=3 :are supported by this server\n"; Recv ":testserver.test 005 nick CALLERID CASEMAPPING=rfc1459 KICKLEN=160 MODES=4 WHATEVER=4 WHO=1 CARES=3 :are supported by this server\r\n";
Recv ":testserver.test 043 00XAAAAL6 :your unique ID\n"; Recv ":testserver.test 043 00XAAAAL6 :your unique ID\r\n";
Recv ":testserver.test 251 nick :There are 14 users and 4 invisible on 1 servers\n"; Recv ":testserver.test 251 nick :There are 14 users and 4 invisible on 1 servers\r\n";
Recv ":testserver.test 252 nick 1 :IRC Operators online\n"; Recv ":testserver.test 252 nick 1 :IRC Operators online\r\n";
Recv ":testserver.test 254 4 :channels formed\n"; Recv ":testserver.test 254 4 :channels formed\r\n";
Recv ":testserver.test 255 nick :I have 17 clients and 0 servers\n"; Recv ":testserver.test 255 nick :I have 17 clients and 0 servers\r\n";
Recv ":testserver.test 265 nick :Current local users: 17 Max: 25\n"; Recv ":testserver.test 265 nick :Current local users: 17 Max: 25\r\n";
Recv ":testserver.test 266 nick :Current global users: 17 Max: 25\n"; Recv ":testserver.test 266 nick :Current global users: 17 Max: 25\r\n";
Recv ":testserver.test 250 nick :Highest connection count: 25 (25 clients) (430 connections received)\n"; Recv ":testserver.test 250 nick :Highest connection count: 25 (25 clients) (430 connections received)\r\n";
Recv ":testserver.test 375 nick :- xirc.lanl.gov Message of the Day -\n"; Recv ":testserver.test 375 nick :- xirc.lanl.gov Message of the Day -\r\n";
Recv ":testserver.test 372 nick :- This is ircd-hybrid MOTD replace it with something better\n"; Recv ":testserver.test 372 nick :- This is ircd-hybrid MOTD replace it with something better\r\n";
Recv ":testserver.test 376 nick :End of /MOTD command.\n"; Recv ":testserver.test 376 nick :End of /MOTD command.\r\n";
] ]
)); ));
] ]
let _ = let _ =
Irc.name := "testserver.test";
run_test_tt_main (TestList [unit_tests; regression_tests]) run_test_tt_main (TestList [unit_tests; regression_tests])