Tests pour ThreadUnix et ThreadIO.

git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@774 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02

2 files changed, 133 insertions, 0 deletions

diff --git a/otherlibs/threads/Tests/testio.ml b/otherlibs/threads/Tests/testio.ml
new file mode 100644
index 000000000..987ea0aba
--- /dev/null
+++ b/otherlibs/threads/Tests/testio.ml
@@ -0,0 +1,100 @@
+open ThreadIO
+
+(* Test a file copy function *)
+
+let test msg producer consumer src dst =
+  print_string msg; print_newline();
+  let ic = open_in src in
+  let oc = open_out dst in
+  let (in_fd, out_fd) = ThreadUnix.pipe() in
+  let ipipe = Unix.in_channel_of_descr in_fd in
+  let opipe = Unix.out_channel_of_descr out_fd in
+  let prod = Thread.new producer (ic, opipe) in
+  let cons = Thread.new consumer (ipipe, oc) in
+  Thread.join prod;
+  Thread.join cons;
+  if ThreadUnix.system ("cmp " ^ src ^ " " ^ dst) = Unix.WEXITED 0
+  then print_string "passed"
+  else print_string "FAILED";
+  print_newline()
+
+(* File copy with constant-sized chunks *)
+
+let copy_file sz (ic, oc) =
+  let buffer = String.create sz in
+  let rec copy () =
+    let n = input ic buffer 0 sz in
+    if n = 0 then () else begin
+      output oc buffer 0 n;
+      copy ()
+    end in
+  copy();
+  close_in ic;
+  close_out oc
+
+(* File copy with random-sized chunks *)
+
+let copy_random sz (ic, oc) =
+  let buffer = String.create sz in
+  let rec copy () =
+    let s = 1 + Random.int sz in
+    let n = input ic buffer 0 s in
+    if n = 0 then () else begin
+      output oc buffer 0 n;
+      copy ()
+    end in
+  copy();
+  close_in ic;
+  close_out oc
+
+(* File copy line per line *)
+
+let copy_line (ic, oc) =
+  try
+    while true do
+      output_string oc (input_line ic); output_char oc '\n'
+    done
+  with End_of_file ->
+    close_in ic;
+    close_out oc
+
+(* Create long lines of text *)
+
+let make_lines ofile =
+  let oc = open_out ofile in
+  for i = 1 to 256 do
+    output_string oc (String.make (i*64) '.'); output_char oc '\n'
+  done;
+  close_out oc
+
+(* The test *)
+
+let main() =
+  test "256-byte chunks, 256-byte chunks"
+       (copy_file 256) (copy_file 256) "/vmunix" "/tmp/testio";
+  test "4096-byte chunks, 4096-byte chunks"
+       (copy_file 4096) (copy_file 4096) "/vmunix" "/tmp/testio";
+  test "65536-byte chunks, 65536-byte chunks"
+       (copy_file 65536) (copy_file 65536) "/vmunix" "/tmp/testio";
+  test "256-byte chunks, 4096-byte chunks"
+       (copy_file 256) (copy_file 4096) "/vmunix" "/tmp/testio";
+  test "4096-byte chunks, 256-byte chunks"
+       (copy_file 4096) (copy_file 256) "/vmunix" "/tmp/testio";
+  test "4096-byte chunks, 65536-byte chunks"
+       (copy_file 4096) (copy_file 65536) "/vmunix" "/tmp/testio";
+  test "263-byte chunks, 4011-byte chunks"
+       (copy_file 263) (copy_file 4011) "/vmunix" "/tmp/testio";
+  test "613-byte chunks, 1027-byte chunks"
+       (copy_file 613) (copy_file 1027) "/vmunix" "/tmp/testio";
+  test "0...8192 byte chunks"
+       (copy_random 8192) (copy_random 8192) "/vmunix" "/tmp/testio";
+  test "line per line, short lines"
+       copy_line copy_line "/etc/hosts" "/tmp/testio";
+  make_lines "/tmp/lines";
+  test "line per line, short and long lines"
+       copy_line copy_line "/tmp/lines" "/tmp/testio";
+  Sys.remove "/tmp/lines";
+  Sys.remove "/tmp/testio";
+  exit 0
+
+let _ = Unix.handle_unix_error main (); exit 0
diff --git a/otherlibs/threads/Tests/testsocket.ml b/otherlibs/threads/Tests/testsocket.ml
new file mode 100644
index 000000000..50a7115e0
--- /dev/null
+++ b/otherlibs/threads/Tests/testsocket.ml
@@ -0,0 +1,33 @@
+open ThreadIO
+open Unix
+open ThreadUnix
+
+let engine number address =
+  print_int number; print_string "> connecting"; print_newline();
+  let (ic, oc) = open_connection (ADDR_INET(address, 80)) in
+  print_int number; print_string "> connected"; print_newline();
+  output_string oc "GET / HTTP1.0\n\n"; flush oc;
+  try
+    while true do
+      let s = input_line ic in
+      print_int number; print_string ">"; print_string s; print_newline()
+    done
+  with End_of_file ->
+    close_in ic; close_out oc
+
+let main() =
+  let addresses = Array.new (Array.length Sys.argv - 1) inet_addr_any in
+  for i = 1 to Array.length Sys.argv - 1 do
+    addresses.(i - 1) <- (gethostbyname Sys.argv.(i)).h_addr_list.(0)
+  done;
+  let processes = Array.new (Array.length addresses) (Thread.self()) in
+  for i = 0 to Array.length addresses - 1 do
+    processes.(i) <- Thread.new (engine i) addresses.(i)
+  done;
+  for i = 0 to Array.length processes - 1 do
+    Thread.join processes.(i)
+  done
+
+let _ = Printexc.catch main (); exit 0
+
+