diff options
Diffstat (limited to 'otherlibs/threads/Tests')
24 files changed, 0 insertions, 924 deletions
diff --git a/otherlibs/threads/Tests/.cvsignore b/otherlibs/threads/Tests/.cvsignore deleted file mode 100644 index e6d9e45b70..0000000000 --- a/otherlibs/threads/Tests/.cvsignore +++ /dev/null @@ -1 +0,0 @@ -*.byt diff --git a/otherlibs/threads/Tests/Makefile b/otherlibs/threads/Tests/Makefile deleted file mode 100644 index 6bf52ef059..0000000000 --- a/otherlibs/threads/Tests/Makefile +++ /dev/null @@ -1,38 +0,0 @@ -######################################################################### -# # -# Objective Caml # -# # -# Xavier Leroy, projet Cristal, INRIA Rocquencourt # -# # -# Copyright 1999 Institut National de Recherche en Informatique et # -# en Automatique. All rights reserved. This file is distributed # -# under the terms of the GNU Library General Public License, with # -# the special exception on linking described in file ../../../LICENSE.# -# # -######################################################################### - -# $Id$ - -PROGS=test1.byt test2.byt test3.byt test4.byt test5.byt test6.byt \ - test7.byt test8.byt test9.byt testA.byt sieve.byt \ - testio.byt testsocket.byt testwait.byt testsignal.byt testsignal2.byt \ - testsieve.byt token1.byt token2.byt - -CAMLC=../../../boot/ocamlrun ../../../ocamlc -I .. -I ../../../stdlib -I ../../unix - -include ../../../config/Makefile - -all: $(PROGS) - -clean: - rm -f *.cm* *.byt - -sorts.byt: sorts.ml - $(CAMLC) -o sorts.byt -I ../../graph threads.cma graphics.cma sorts.ml $(LIBS) $(X11_LINK) - -.SUFFIXES: .ml .byt - -.ml.byt: - $(CAMLC) -o $*.byt unix.cma threads.cma $*.ml $(LIBS) - -$(PROGS): ../threads.cma ../libthreads.a diff --git a/otherlibs/threads/Tests/close.ml b/otherlibs/threads/Tests/close.ml deleted file mode 100644 index 21ebb44a6a..0000000000 --- a/otherlibs/threads/Tests/close.ml +++ /dev/null @@ -1,14 +0,0 @@ -let main () = - let (rd, wr) = Unix.pipe() in - Thread.create - (fun () -> - Thread.delay 3.0; - prerr_endline "closing fd..."; - Unix.close rd) - (); - let buf = String.create 10 in - prerr_endline "reading..."; - Unix.read rd buf 0 10; - prerr_endline "read returned" - -let _ = Unix.handle_unix_error main () diff --git a/otherlibs/threads/Tests/sieve.ml b/otherlibs/threads/Tests/sieve.ml deleted file mode 100644 index 72e2656605..0000000000 --- a/otherlibs/threads/Tests/sieve.ml +++ /dev/null @@ -1,33 +0,0 @@ -open Printf -open Thread - -let rec integers n ch = - Event.sync (Event.send ch n); - integers (n+1) ch - -let rec sieve n chin chout = - let m = Event.sync (Event.receive chin) - in if m mod n = 0 - then sieve n chin chout - else Event.sync (Event.send chout m); - sieve n chin chout - -let rec print_primes ch max = - let n = Event.sync (Event.receive ch) - in if n > max - then () - else begin - printf "%d\n" n; flush stdout; - let ch_after_n = Event.new_channel () - in Thread.create (sieve n ch) ch_after_n; - print_primes ch_after_n max - end - -let go max = - let ch = Event.new_channel () - in Thread.create (integers 2) ch; - print_primes ch max;; - -let _ = go 1000 - -;; diff --git a/otherlibs/threads/Tests/sorts.ml b/otherlibs/threads/Tests/sorts.ml deleted file mode 100644 index abc8dc1b5c..0000000000 --- a/otherlibs/threads/Tests/sorts.ml +++ /dev/null @@ -1,228 +0,0 @@ -(* Animation of sorting algorithms. *) - -open Graphics - -(* Information on a given sorting process *) - -type graphic_context = - { array: int array; (* Data to sort *) - x0: int; (* X coordinate, lower left corner *) - y0: int; (* Y coordinate, lower left corner *) - width: int; (* Width in pixels *) - height: int; (* Height in pixels *) - nelts: int; (* Number of elements in the array *) - maxval: int; (* Max val in the array + 1 *) - rad: int (* Dimension of the rectangles *) - } - -(* Array assignment and exchange with screen update *) - -let screen_mutex = Mutex.create() - -let draw gc i v = - fill_rect (gc.x0 + (gc.width * i) / gc.nelts) - (gc.y0 + (gc.height * v) / gc.maxval) - gc.rad gc.rad - -let assign gc i v = - Mutex.lock screen_mutex; - set_color background; draw gc i gc.array.(i); - set_color foreground; draw gc i v; - gc.array.(i) <- v; - Mutex.unlock screen_mutex - -let exchange gc i j = - let val_i = gc.array.(i) in - assign gc i gc.array.(j); - assign gc j val_i - -(* Construction of a graphic context *) - -let initialize name array maxval x y w h = - let (_, label_height) = text_size name in - let rad = (w - 2) / (Array.length array) - 1 in - let gc = - { array = Array.copy array; - x0 = x + 1; (* Leave one pixel left for Y axis *) - y0 = y + 1; (* Leave one pixel below for X axis *) - width = w - 2; (* 1 pixel left, 1 pixel right *) - height = h - 1 - label_height - rad; - nelts = Array.length array; - maxval = maxval; - rad = rad } in - moveto (gc.x0 - 1) (gc.y0 + gc.height); - lineto (gc.x0 - 1) (gc.y0 - 1); - lineto (gc.x0 + gc.width) (gc.y0 - 1); - moveto (gc.x0 - 1) (gc.y0 + gc.height); - draw_string name; - for i = 0 to Array.length array - 1 do - draw gc i array.(i) - done; - gc - -(* Main animation function *) - -let display functs nelts maxval = - let a = Array.create nelts 0 in - for i = 0 to nelts - 1 do - a.(i) <- Random.int maxval - done; - let num_finished = ref 0 in - let lock_finished = Mutex.create() in - let cond_finished = Condition.create() in - for i = 0 to Array.length functs - 1 do - let (name, funct, x, y, w, h) = functs.(i) in - let gc = initialize name a maxval x y w h in - Thread.create - (fun () -> - funct gc; - Mutex.lock lock_finished; - incr num_finished; - Mutex.unlock lock_finished; - Condition.signal cond_finished) - () - done; - Mutex.lock lock_finished; - while !num_finished < Array.length functs do - Condition.wait cond_finished lock_finished - done; - Mutex.unlock lock_finished; - read_key() - -(***** - let delay = ref 0 in - try - while true do - let gc = Queue.take q in - begin match gc.action with - Finished -> () - | Pause f -> - gc.action <- f (); - for i = 0 to !delay do () done; - Queue.add gc q - end; - if key_pressed() then begin - match read_key() with - 'q'|'Q' -> - raise Exit - | '0'..'9' as c -> - delay := (Char.code c - 48) * 500 - | _ -> - () - end - done - with Exit -> () - | Queue.Empty -> read_key(); () -*****) - -(* The sorting functions. *) - -(* Bubble sort *) - -let bubble_sort gc = - let ordered = ref false in - while not !ordered do - ordered := true; - for i = 0 to Array.length gc.array - 2 do - if gc.array.(i+1) < gc.array.(i) then begin - exchange gc i (i+1); - ordered := false - end - done - done - -(* Insertion sort *) - -let insertion_sort gc = - for i = 1 to Array.length gc.array - 1 do - let val_i = gc.array.(i) in - let j = ref (i - 1) in - while !j >= 0 && val_i < gc.array.(!j) do - assign gc (!j + 1) gc.array.(!j); - decr j - done; - assign gc (!j + 1) val_i - done - -(* Selection sort *) - -let selection_sort gc = - for i = 0 to Array.length gc.array - 1 do - let min = ref i in - for j = i+1 to Array.length gc.array - 1 do - if gc.array.(j) < gc.array.(!min) then min := j - done; - exchange gc i !min - done - -(* Quick sort *) - -let quick_sort gc = - let rec quick lo hi = - if lo < hi then begin - let i = ref lo in - let j = ref hi in - let pivot = gc.array.(hi) in - while !i < !j do - while !i < hi && gc.array.(!i) <= pivot do incr i done; - while !j > lo && gc.array.(!j) >= pivot do decr j done; - if !i < !j then exchange gc !i !j - done; - exchange gc !i hi; - quick lo (!i-1); - quick (!i+1) hi - end - in quick 0 (Array.length gc.array - 1) - -(* Merge sort *) - -let merge_sort gc = - let rec merge i l1 l2 = - match (l1, l2) with - ([], []) -> - () - | ([], v2::r2) -> - assign gc i v2; merge (i+1) l1 r2 - | (v1::r1, []) -> - assign gc i v1; merge (i+1) r1 l2 - | (v1::r1, v2::r2) -> - if v1 < v2 - then begin assign gc i v1; merge (i+1) r1 l2 end - else begin assign gc i v2; merge (i+1) l1 r2 end in - let rec msort start len = - if len < 2 then () else begin - let m = len / 2 in - msort start m; - msort (start+m) (len-m); - merge start - (Array.to_list (Array.sub gc.array start m)) - (Array.to_list (Array.sub gc.array (start+m) (len-m))) - end in - msort 0 (Array.length gc.array) - -(* Main program *) - -let animate() = - open_graph ""; - moveto 0 0; draw_string "Press a key to start..."; - let seed = ref 0 in - while not (key_pressed()) do incr seed done; - read_key(); - Random.init !seed; - clear_graph(); - let prompt = "0: fastest ... 9: slowest, press 'q' to quit" in - moveto 0 0; draw_string prompt; - let (_, h) = text_size prompt in - let sx = size_x() / 2 and sy = (size_y() - h) / 3 in - display [| "Bubble", bubble_sort, 0, h, sx, sy; - "Insertion", insertion_sort, 0, h+sy, sx, sy; - "Selection", selection_sort, 0, h+2*sy, sx, sy; - "Quicksort", quick_sort, sx, h, sx, sy; - (** "Heapsort", heap_sort, sx, h+sy, sx, sy; **) - "Mergesort", merge_sort, sx, h+2*sy, sx, sy |] - 100 1000; - close_graph() - -let _ = if !Sys.interactive then () else begin animate(); exit 0 end - -;; diff --git a/otherlibs/threads/Tests/test1.ml b/otherlibs/threads/Tests/test1.ml deleted file mode 100644 index 9d2cf0a5ee..0000000000 --- a/otherlibs/threads/Tests/test1.ml +++ /dev/null @@ -1,57 +0,0 @@ -(* Classic producer-consumer *) - -type 'a prodcons = - { buffer: 'a array; - lock: Mutex.t; - mutable readpos: int; - mutable writepos: int; - notempty: Condition.t; - notfull: Condition.t } - -let create size init = - { buffer = Array.create size init; - lock = Mutex.create(); - readpos = 0; - writepos = 0; - notempty = Condition.create(); - notfull = Condition.create() } - -let put p data = - Mutex.lock p.lock; - while (p.writepos + 1) mod Array.length p.buffer = p.readpos do - Condition.wait p.notfull p.lock - done; - p.buffer.(p.writepos) <- data; - p.writepos <- (p.writepos + 1) mod Array.length p.buffer; - Condition.signal p.notempty; - Mutex.unlock p.lock - -let get p = - Mutex.lock p.lock; - while p.writepos = p.readpos do - Condition.wait p.notempty p.lock - done; - let data = p.buffer.(p.readpos) in - p.readpos <- (p.readpos + 1) mod Array.length p.buffer; - Condition.signal p.notfull; - Mutex.unlock p.lock; - data - -(* Test *) - -let buff = create 20 0 - -let rec produce n = - print_int n; print_string "-->"; print_newline(); - put buff n; - if n < 10000 then produce (n+1) - -let rec consume () = - let n = get buff in - print_string "-->"; print_int n; print_newline(); - if n < 10000 then consume () - -let t1 = Thread.create produce 0 -let _ = consume () - -;; diff --git a/otherlibs/threads/Tests/test2.ml b/otherlibs/threads/Tests/test2.ml deleted file mode 100644 index 926f09078f..0000000000 --- a/otherlibs/threads/Tests/test2.ml +++ /dev/null @@ -1,15 +0,0 @@ -let yield = ref false - -let print_message c = - for i = 1 to 10000 do - print_char c; flush stdout; - if !yield then Thread.yield() - done - -let _ = yield := (Array.length Sys.argv > 1) -let t1 = Thread.create print_message 'a' -let t2 = Thread.create print_message 'b' -let _ = Thread.join t1 -let _ = Thread.join t2 - -;; diff --git a/otherlibs/threads/Tests/test3.ml b/otherlibs/threads/Tests/test3.ml deleted file mode 100644 index c6df3326e4..0000000000 --- a/otherlibs/threads/Tests/test3.ml +++ /dev/null @@ -1,8 +0,0 @@ -let print_message delay c = - while true do - print_char c; flush stdout; Thread.delay delay - done - -let _ = - Thread.create (print_message 0.6666666666) 'a'; - print_message 1.0 'b' diff --git a/otherlibs/threads/Tests/test4.ml b/otherlibs/threads/Tests/test4.ml deleted file mode 100644 index ff84961bb3..0000000000 --- a/otherlibs/threads/Tests/test4.ml +++ /dev/null @@ -1,13 +0,0 @@ -let rec fib n = if n <= 2 then 1 else fib(n-1) + fib(n-2) - -let fibtask n = - while true do - print_int(fib n); print_newline() - done - -let _ = - Thread.create fibtask 28; - while true do - let l = read_line () in - print_string ">> "; print_string l; print_newline() - done diff --git a/otherlibs/threads/Tests/test5.ml b/otherlibs/threads/Tests/test5.ml deleted file mode 100644 index 2baffe024b..0000000000 --- a/otherlibs/threads/Tests/test5.ml +++ /dev/null @@ -1,21 +0,0 @@ -open Event - -let ch = (new_channel() : string channel) - -let rec sender msg = - sync (send ch msg); - sender msg - -let rec receiver name = - print_string (name ^ ": " ^ sync (receive ch) ^ "\n"); - flush stdout; - receiver name - -let _ = - Thread.create sender "hello"; - Thread.create sender "world"; - Thread.create receiver "A"; - receiver "B"; - exit 0 - - diff --git a/otherlibs/threads/Tests/test6.ml b/otherlibs/threads/Tests/test6.ml deleted file mode 100644 index b846858e56..0000000000 --- a/otherlibs/threads/Tests/test6.ml +++ /dev/null @@ -1,17 +0,0 @@ -open Event - -let ch = (new_channel() : string channel) - -let rec f tag msg = - select [ - send ch msg; - wrap (receive ch) (fun x -> print_string(tag ^ ": " ^ x); print_newline()) - ]; - f tag msg - -let _ = - Thread.create (f "A") "hello"; - f "B" "world"; - exit 0 - - diff --git a/otherlibs/threads/Tests/test7.ml b/otherlibs/threads/Tests/test7.ml deleted file mode 100644 index e6bd1d810d..0000000000 --- a/otherlibs/threads/Tests/test7.ml +++ /dev/null @@ -1,28 +0,0 @@ -open Event - -let add_ch = new_channel() -let sub_ch = new_channel() -let read_ch = new_channel() - -let rec accu n = - select [ - wrap (receive add_ch) (fun x -> accu (n+x)); - wrap (receive sub_ch) (fun x -> accu (n-x)); - wrap (send read_ch n) (fun () -> accu n) - ] - -let rec sender chan value = - sync(send chan value); sender chan value - -let read () = - print_int(sync(receive read_ch)); print_newline() - -let main () = - Thread.create accu 0; - Thread.create (sender add_ch) 1; - Thread.create (sender sub_ch) 1; - while true do read() done - -let _ = Printexc.catch main () - - diff --git a/otherlibs/threads/Tests/test8.ml b/otherlibs/threads/Tests/test8.ml deleted file mode 100644 index cc587b0a7c..0000000000 --- a/otherlibs/threads/Tests/test8.ml +++ /dev/null @@ -1,46 +0,0 @@ -open Event - -type 'a buffer_channel = { input: 'a channel; output: 'a channel } - -let new_buffer_channel() = - let ic = new_channel() in - let oc = new_channel() in - let buff = Queue.create() in - let rec buffer_process front rear = - match (front, rear) with - ([], []) -> buffer_process [sync(receive ic)] [] - | (hd::tl, _) -> - select [ - wrap (receive ic) (fun x -> buffer_process front (x::rear)); - wrap (send oc hd) (fun () -> buffer_process tl rear) - ] - | ([], _) -> buffer_process (List.rev rear) [] in - Thread.create (buffer_process []) []; - { input = ic; output = oc } - -let buffer_send bc data = - sync(send bc.input data) - -let buffer_receive bc = - receive bc.output - -(* Test *) - -let box = new_buffer_channel() -let ch = new_channel() - -let f () = - buffer_send box "un"; - buffer_send box "deux"; - sync (send ch 3) - -let g () = - print_int (sync(receive ch)); print_newline(); - print_string (sync(buffer_receive box)); print_newline(); - print_string (sync(buffer_receive box)); print_newline() - -let _ = - Thread.create f (); - g() - - diff --git a/otherlibs/threads/Tests/test9.ml b/otherlibs/threads/Tests/test9.ml deleted file mode 100644 index 1f80beb8f8..0000000000 --- a/otherlibs/threads/Tests/test9.ml +++ /dev/null @@ -1,26 +0,0 @@ -open Event - -type 'a swap_chan = ('a * 'a channel) channel - -let swap msg_out ch = - guard (fun () -> - let ic = new_channel() in - choose [ - wrap (receive ch) (fun (msg_in, oc) -> sync (send oc msg_out); msg_in); - wrap (send ch (msg_out, ic)) (fun () -> sync (receive ic)) - ]) - -let ch = new_channel() - -let f () = - let res = sync (swap "F" ch) in - print_string "f "; print_string res; print_newline() - -let g () = - let res = sync (swap "G" ch) in - print_string "g "; print_string res; print_newline() - -let _ = - let id = Thread.create f () in - g (); - Thread.join id diff --git a/otherlibs/threads/Tests/testA.ml b/otherlibs/threads/Tests/testA.ml deleted file mode 100644 index b1999b87bc..0000000000 --- a/otherlibs/threads/Tests/testA.ml +++ /dev/null @@ -1,24 +0,0 @@ -let private_data = (Hashtbl.create 17 : (Thread.t, string) Hashtbl.t) -let private_data_lock = Mutex.create() - -let set_private_data data = - Mutex.lock private_data_lock; - Hashtbl.add private_data (Thread.self()) data; - Mutex.unlock private_data_lock - -let get_private_data () = - Hashtbl.find private_data (Thread.self()) - -let process id data = - set_private_data data; - print_int id; print_string " --> "; print_string(get_private_data()); - print_newline() - -let _ = - let t1 = Thread.create (process 1) "un" in - let t2 = Thread.create (process 2) "deux" in - let t3 = Thread.create (process 3) "trois" in - let t4 = Thread.create (process 4) "quatre" in - let t5 = Thread.create (process 5) "cinq" in - List.iter Thread.join [t1;t2;t3;t4;t5] - diff --git a/otherlibs/threads/Tests/testexit.ml b/otherlibs/threads/Tests/testexit.ml deleted file mode 100644 index 2045c25a86..0000000000 --- a/otherlibs/threads/Tests/testexit.ml +++ /dev/null @@ -1,22 +0,0 @@ -(* Test Thread.exit *) - -let somethread (name, limit, last) = - let counter = ref 0 in - while true do - incr counter; - if !counter >= limit then begin - print_string (name ^ " exiting\n"); - flush stdout; - if last then exit 0 else Thread.exit() - end; - print_string (name ^ ": " ^ string_of_int !counter ^ "\n"); - flush stdout; - Thread.delay 0.5 - done - -let _ = - let _ = Thread.create somethread ("A", 5, false) in - let _ = Thread.create somethread ("B", 8, false) in - let _ = Thread.create somethread ("C", 11, true) in - somethread ("Main", 3, false) - diff --git a/otherlibs/threads/Tests/testio.ml b/otherlibs/threads/Tests/testio.ml deleted file mode 100644 index 3ed08a88f4..0000000000 --- a/otherlibs/threads/Tests/testio.ml +++ /dev/null @@ -1,119 +0,0 @@ -(* Test a file copy function *) - -let test msg producer consumer src dst = - print_string msg; print_newline(); - let ic = open_in_bin src in - let oc = open_out_bin dst in - let (in_fd, out_fd) = Unix.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.create producer (ic, opipe) in - let cons = Thread.create consumer (ipipe, oc) in - Thread.join prod; - Thread.join cons; - if Unix.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*16) '.'); output_char oc '\n' - done; - close_out oc - -(* Test input_line on truncated lines *) - -let test_trunc_line ofile = - print_string "truncated line"; print_newline(); - let oc = open_out ofile in - output_string oc "A line without newline!"; - close_out oc; - try - let ic = open_in ofile in - let s = input_line ic in - close_in ic; - if s = "A line without newline!" - then print_string "passed" - else print_string "FAILED"; - print_newline() - with End_of_file -> - print_string "FAILED"; print_newline() - -(* The test *) - -let main() = - let ifile = Sys.argv.(1) in - let ofile = "/tmp/testio" in - test "256-byte chunks, 256-byte chunks" - (copy_file 256) (copy_file 256) ifile ofile; - test "4096-byte chunks, 4096-byte chunks" - (copy_file 4096) (copy_file 4096) ifile ofile; - test "65536-byte chunks, 65536-byte chunks" - (copy_file 65536) (copy_file 65536) ifile ofile; - test "256-byte chunks, 4096-byte chunks" - (copy_file 256) (copy_file 4096) ifile ofile; - test "4096-byte chunks, 256-byte chunks" - (copy_file 4096) (copy_file 256) ifile ofile; - test "4096-byte chunks, 65536-byte chunks" - (copy_file 4096) (copy_file 65536) ifile ofile; - test "263-byte chunks, 4011-byte chunks" - (copy_file 263) (copy_file 4011) ifile ofile; - test "613-byte chunks, 1027-byte chunks" - (copy_file 613) (copy_file 1027) ifile ofile; - test "0...8192 byte chunks" - (copy_random 8192) (copy_random 8192) ifile ofile; - test "line per line, short lines" - copy_line copy_line "/etc/hosts" ofile; - make_lines "/tmp/lines"; - test "line per line, short and long lines" - copy_line copy_line "/tmp/lines" ofile; - test_trunc_line ofile; - Sys.remove "/tmp/lines"; - Sys.remove ofile; - exit 0 - -let _ = Unix.handle_unix_error main (); exit 0 diff --git a/otherlibs/threads/Tests/testsieve.ml b/otherlibs/threads/Tests/testsieve.ml deleted file mode 100644 index 6079d8a8eb..0000000000 --- a/otherlibs/threads/Tests/testsieve.ml +++ /dev/null @@ -1,42 +0,0 @@ -let sieve primes= - Event.sync (Event.send primes 0); - Event.sync (Event.send primes 1); - Event.sync (Event.send primes 2); - let integers = Event.new_channel () in - let rec enumerate n= - Event.sync (Event.send integers n); - enumerate (n + 2) - and filter inpout = - let n = Event.sync (Event.receive inpout) - (* On prepare le terrain pour l'appel recursif *) - and output = Event.new_channel () in - (* Celui qui etait en tete du crible est premier *) - Event.sync (Event.send primes n); - Thread.create filter output; - (* On elimine de la sortie ceux qui sont des multiples de n *) - while true do - let m = Event.sync (Event.receive inpout) in - (* print_int n; print_string ": "; print_int m; print_newline(); *) - if (m mod n) = 0 - then () - else ((Event.sync (Event.send output m));()) - done in - Thread.create filter integers; - Thread.create enumerate 3 - -let premiers = Event.new_channel () - -let main _ = - Thread.create sieve premiers; - while true do - for i = 1 to 100 do - let n = Event.sync (Event.receive premiers) in - print_int n; print_newline() - done; - exit 0 - done - - -let _ = - try main () - with _ -> exit 0;; diff --git a/otherlibs/threads/Tests/testsignal.ml b/otherlibs/threads/Tests/testsignal.ml deleted file mode 100644 index 7781f3377b..0000000000 --- a/otherlibs/threads/Tests/testsignal.ml +++ /dev/null @@ -1,13 +0,0 @@ -let sighandler _ = - print_string "Got ctrl-C, exiting..."; print_newline(); - exit 0 - -let print_message delay c = - while true do - print_char c; flush stdout; Thread.delay delay - done - -let _ = - Sys.signal Sys.sigint (Sys.Signal_handle sighandler); - Thread.create (print_message 0.6666666666) 'a'; - print_message 1.0 'b' diff --git a/otherlibs/threads/Tests/testsignal2.ml b/otherlibs/threads/Tests/testsignal2.ml deleted file mode 100644 index 1f7fc0f91c..0000000000 --- a/otherlibs/threads/Tests/testsignal2.ml +++ /dev/null @@ -1,10 +0,0 @@ -let print_message delay c = - while true do - print_char c; flush stdout; Thread.delay delay - done - -let _ = - let th1 = Thread.create (print_message 0.6666666666) 'a' in - let th2 = Thread.create (print_message 1.0) 'b' in - let s = Thread.wait_signal [Sys.sigint; Sys.sigterm] in - Printf.printf "Got signal %d, exiting...\n" s diff --git a/otherlibs/threads/Tests/testsocket.ml b/otherlibs/threads/Tests/testsocket.ml deleted file mode 100644 index d0f14cbf5b..0000000000 --- a/otherlibs/threads/Tests/testsocket.ml +++ /dev/null @@ -1,31 +0,0 @@ -open Unix - -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\r\n\r\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_out oc - -let main() = - let addresses = Array.create (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.create (Array.length addresses) (Thread.self()) in - for i = 0 to Array.length addresses - 1 do - processes.(i) <- Thread.create (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 - - diff --git a/otherlibs/threads/Tests/token1.ml b/otherlibs/threads/Tests/token1.ml deleted file mode 100644 index fb0ddb2dfd..0000000000 --- a/otherlibs/threads/Tests/token1.ml +++ /dev/null @@ -1,36 +0,0 @@ -(* Performance test for mutexes and conditions *) - -let mut = Mutex.create() - -let niter = ref 0 - -let token = ref 0 - -let process (n, conds, nprocs) = - while true do - Mutex.lock mut; - while !token <> n do - (* Printf.printf "Thread %d waiting (token = %d)\n" n !token; *) - Condition.wait conds.(n) mut - done; - (* Printf.printf "Thread %d got token %d\n" n !token; *) - incr token; - if !token >= nprocs then token := 0; - if n = 0 then begin - decr niter; - if !niter <= 0 then exit 0 - end; - Condition.signal conds.(!token); - Mutex.unlock mut - done - -let main() = - let nprocs = int_of_string Sys.argv.(1) in - let iter = int_of_string Sys.argv.(2) in - let conds = Array.create nprocs (Condition.create()) in - for i = 1 to nprocs - 1 do conds.(i) <- Condition.create() done; - niter := iter; - for i = 0 to nprocs - 1 do Thread.create process (i, conds, nprocs) done; - Thread.delay 3600. - -let _ = main() diff --git a/otherlibs/threads/Tests/token2.ml b/otherlibs/threads/Tests/token2.ml deleted file mode 100644 index 32b897dd13..0000000000 --- a/otherlibs/threads/Tests/token2.ml +++ /dev/null @@ -1,36 +0,0 @@ -(* Performance test for I/O scheduling *) - -let mut = Mutex.create() - -let niter = ref 0 - -let token = ref 0 - -let process (n, ins, outs, nprocs) = - let buf = String.create 1 in - while true do - Unix.read ins.(n) buf 0 1; - (* Printf.printf "Thread %d got the token\n" n; *) - if n = 0 then begin - decr niter; - if !niter <= 0 then exit 0 - end; - let next = if n + 1 >= nprocs then 0 else n + 1 in - (* Printf.printf "Thread %d sending token to thread %d\n" n next; *) - Unix.write outs.(next) buf 0 1 - done - -let main() = - let nprocs = int_of_string Sys.argv.(1) in - let iter = int_of_string Sys.argv.(2) in - let ins = Array.create nprocs Unix.stdin in - let outs = Array.create nprocs Unix.stdout in - for n = 0 to nprocs - 1 do - let (i, o) = Unix.pipe() in ins.(n) <- i; outs.(n) <- o - done; - niter := iter; - for i = 0 to nprocs - 1 do Thread.create process (i, ins, outs, nprocs) done; - Unix.write outs.(0) "X" 0 1; - Thread.delay 3600. - -let _ = main() diff --git a/otherlibs/threads/Tests/torture.ml b/otherlibs/threads/Tests/torture.ml deleted file mode 100644 index b52766dc72..0000000000 --- a/otherlibs/threads/Tests/torture.ml +++ /dev/null @@ -1,46 +0,0 @@ -(* Torture test - lots of GC *) - -let gc_thread () = - while true do -(* print_string "gc"; print_newline(); *) - Gc.minor(); - Thread.yield() - done - -let stdin_thread () = - while true do - print_string "> "; flush stdout; - let s = read_line() in - print_string ">>> "; print_string s; print_newline() - done - -let writer_thread (oc, size) = - while true do -(* print_string "writer "; print_int size; print_newline(); *) - let buff = String.make size 'a' in - Unix.write oc buff 0 size - done - -let reader_thread (ic, size) = - while true do -(* print_string "reader "; print_int size; print_newline(); *) - let buff = String.create size in - let n = Unix.read ic buff 0 size in -(* print_string "reader "; print_int n; print_newline(); *) - for i = 0 to n-1 do - if buff.[i] <> 'a' then prerr_endline "error in reader_thread" - done - done - -let main() = - Thread.create gc_thread (); - let (out1, in1) = Unix.pipe() in - Thread.create writer_thread (in1, 4096); - Thread.create reader_thread (out1, 4096); - let (out2, in2) = Unix.pipe() in - Thread.create writer_thread (in2, 16); - Thread.create reader_thread (out2, 16); - stdin_thread() - -let _ = main() - |