simon/ocaml-containers
1
0
Fork 0
mirror of https://github.com/c-cube/ocaml-containers.git synced 2025-12-05 19:00:31 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

merge remaining tests as qtest, remove lwt stuff including bench_io

Browse source
This commit is contained in:
Simon Cruanes 2015-09-16 19:33:56 +02:00
parent 507fe33086
commit ed31060d7d
11 changed files with 76 additions and 349 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

20
Makefile
View file

@ -79,16 +79,10 @@ QTESTABLE=$(filter-out $(DONTTEST), \
$(wildcard src/threads/*.mli) \
)
QTESTABLE_LWT=$(filter-out $(DONTTEST), \
$(wildcard src/lwt/*.ml) \
$(wildcard src/lwt/*.mli) \
)
qtest-clean:
@rm -rf qtest/
QTEST_PREAMBLE='open CCFun;; '
QTEST_LWT_PREAMBLE=$(QTEST_PREAMBLE)
#qtest-build: qtest-clean build
# @mkdir -p qtest
@ -108,15 +102,6 @@ qtest-gen:
else touch qtest/run_qtest.ml ; \
fi
qtest-lwt-gen:
@mkdir -p qtest/lwt/
@if which qtest > /dev/null ; then \
qtest extract --preamble $(QTEST_LWT_PREAMBLE) \
-o qtest/lwt/run_qtest_lwt.ml \
$(QTESTABLE_LWT) 2> /dev/null ; \
else touch qtest/lwt/run_qtest_lwt.ml ; \
fi
push-stable:
git checkout stable
git merge master -m 'merge from master'
@ -128,11 +113,6 @@ push-stable:
clean-generated:
rm **/*.{mldylib,mlpack,mllib} myocamlbuild.ml -f
run-test: build
./run_qtest.native
test-all: run-test
tags:
otags *.ml *.mli

23
_oasis
View file

@ -161,22 +161,6 @@ Executable run_bench_hash
MainIs: run_bench_hash.ml
BuildDepends: containers
Executable run_bench_io
Path: benchs/
Install: false
CompiledObject: best
Build$: flag(bench) && flag(unix)
MainIs: run_bench_io.ml
BuildDepends: containers, containers_lwt, unix, lwt.unix, benchmark
Executable run_test_future
Path: tests/threads/
Install: false
CompiledObject: best
Build$: flag(tests) && flag(thread)
MainIs: run_test_future.ml
BuildDepends: containers, threads, sequence, oUnit, containers.thread
PreBuildCommand: make qtest-gen
Executable run_qtest
@ -192,15 +176,10 @@ Executable run_qtest
sequence, gen, unix, oUnit, QTest2Lib
Test all
Command: make test-all
Command: ./run_qtest.native
TestTools: run_qtest
Run$: flag(tests) && flag(unix) && flag(advanced) && flag(bigarray)
Test future
Command: echo "run test future" ; ./run_test_future.native
TestTools: run_test_future
Run$: flag(tests) && flag(thread)
Executable id_sexp
Path: examples/
Install: false

88
benchs/run_bench_io.ml
View file

@ -1,88 +0,0 @@
let read_input_char file =
CCIO.with_in file
(fun ic ->
let count = ref 0 in
try
while true do
let _ = input_char ic in
incr count
done;
assert false
with End_of_file -> !count
)
let read_input file =
CCIO.with_in file
(fun ic ->
let count = ref 0 in
let n = 4096 in
let b = Bytes.make n ' ' in
try
while true do
let n' = input ic b 0 n in
if n'=0 then raise Exit;
count := !count + n'
done;
assert false
with Exit ->
!count
)
let read_read file =
let fd = Unix.openfile file [Unix.O_RDONLY] 0o644 in
let count = ref 0 in
let n = 4096 in
let b = Bytes.make n ' ' in
try
while true do
let n' = Unix.read fd b 0 n in
if n'=0 then raise Exit;
count := !count + n'
done;
assert false
with Exit ->
Unix.close fd;
!count
let read_lwt file =
let open Lwt.Infix in
Lwt_io.with_file ~mode:Lwt_io.input file
(fun ic ->
let n = 4096 in
let b = Bytes.make n ' ' in
let rec read_chunk count =
Lwt_io.read_into ic b 0 n >>= fun n' ->
let count = count + n' in
if n'>0 then read_chunk count else Lwt.return count
in
read_chunk 0
)
let read_lwt' file = Lwt_main.run (read_lwt file)
let profile ~f file () = (f file)
let bench file =
let n1 = read_input_char file in
let n2 = read_input file in
let n3 = read_read file in
let n4 = read_lwt' file in
Printf.printf "results: %d, %d, %d, %d\n" n1 n2 n3 n4;
assert (n1=n2 && n2 = n3 && n3=n4);
Benchmark.throughputN ~repeat:5 4
[ "input_char", profile ~f:read_input_char file, ()
; "input", profile ~f:read_input file, ()
; "Unix.read", profile ~f:read_read file, ()
; "Lwt_io.read", profile ~f:read_lwt' file, ()
]
let () =
if Array.length Sys.argv < 2 then invalid_arg "use: truc file";
let file = Sys.argv.(1) in
Printf.printf "read file %s\n" file;
let res = bench file in
Benchmark.tabulate res;
()

75
src/threads/CCFuture.ml
View file

@ -127,6 +127,10 @@ module Pool = struct
)
end
(*$inject
open Infix
*)
let pool = Pool.create ~max_size:50 ()
(** Default pool of threads, should be ok for most uses. *)
@ -214,6 +218,22 @@ let make1 f x =
let make f = make1 f ()
(*$R
List.iter
(fun n ->
let l = Sequence.(1 -- n) |> Sequence.to_list in
let l = List.map (fun i ->
make
(fun () ->
Thread.delay 0.1;
1
)) l in
let l' = List.map get l in
OUnit.assert_equal n (List.fold_left (+) 0 l');
)
[ 10; 300 ]
*)
let make2 f x y =
let cell = create_cell() in
Pool.run pool (run_and_set2 cell f x) y;
@ -286,6 +306,13 @@ let map f fut = match fut with
);
Run cell'
(*$R
let a = make (fun () -> 1) in
let b = map (fun x -> x+1) a in
let c = map (fun x -> x-1) b in
OUnit.assert_equal 1 (get c)
*)
let flat_map f fut = match fut with
| Return x -> f x
| FailNow e -> FailNow e
@ -342,6 +369,29 @@ let sequence futures =
) futures;
Run cell
(*$R
let l = CCList.(1 -- 10) in
let l' = l
|> List.map
(fun x -> make (fun () -> Thread.delay 0.2; x*10))
|> sequence
|> map (List.fold_left (+) 0)
in
let expected = List.fold_left (fun acc x -> acc + 10 * x) 0 l in
OUnit.assert_equal expected (get l')
*)
(*$R
let l = CCList.(1 -- 10) in
let l' = l
|> List.map
(fun x -> make (fun () -> Thread.delay 0.2; if x = 5 then raise Exit; x))
|> sequence
|> map (List.fold_left (+) 0)
in
OUnit.assert_raises Exit (fun () -> get l')
*)
let choose futures =
let cell = create_cell() in
let state = ref `Waiting in
@ -399,6 +449,16 @@ let spawn_process ?(stdin="") cmd : subprocess_res t =
let sleep time = make (fun () -> Thread.delay time)
(*$R
let start = Unix.gettimeofday () in
let l = CCList.(1 -- 10)
|> List.map (fun _ -> make (fun () -> Thread.delay 0.5))
in
List.iter get l;
let stop = Unix.gettimeofday () in
OUnit.assert_bool "some_parallelism" (stop -. start < 10. *. 0.5);
*)
(** {2 Event timer} *)
module Timer = struct
@ -528,6 +588,21 @@ module Timer = struct
)
end
(*$R
let timer = Timer.create () in
let n = CCLock.create 1 in
let getter = make (fun () -> Thread.delay 0.8; CCLock.get n) in
let _ =
Timer.after timer 0.6
>>= fun () -> CCLock.update n (fun x -> x+2); return()
in
let _ =
Timer.after timer 0.4
>>= fun () -> CCLock.update n (fun x -> x * 4); return()
in
OUnit.assert_equal 6 (get getter);
*)
module Infix = struct
let (>>=) x f = flat_map f x
let (>>) a f = and_then a f

3
tests/.merlin
View file

@ -1,3 +0,0 @@
S .
B ../_build/tests/
REC

19
tests/quick/.common.ml
View file

@ -1,19 +0,0 @@
#use "topfind";;
#directory "_build/src/core/";;
#directory "_build/src/string";;
#directory "_build/src/misc";;
#directory "_build/src/io";;
#directory "_build/src/lwt";;
#require "unix";;
let ok () =
print_endline "... OK";
exit 0;;
let fail msg =
print_endline ("... FAILURE " ^ msg);
exit 1;;
(* vim:syntax=ocaml
*)

33
tests/quick/actors.ml
View file

@ -1,33 +0,0 @@
#!/usr/bin/env ocaml
#use "tests/quick/.common.ml";;
#load "containers.cma";;
#require "lwt.unix";;
#load "containers_misc.cma";;
#load "containers_lwt.cma";;
let (>>=) = Lwt.(>>=)
module A = Containers_lwt.Lwt_actor
let a = A.spawn
(fun _ (`Ping sender) ->
Lwt_io.printl "ping!" >>= fun () ->
Lwt_unix.sleep 1. >>= fun () ->
A.send sender `Pong
)
let b = A.spawn
(fun self -> function
| `Pong
| `Start ->
Lwt_io.printl "pong!" >>= fun () ->
Lwt_unix.sleep 1. >>= fun () ->
A.send a (`Ping self)
)
let () = Lwt_main.run (
Lwt_io.printl "start" >>= fun () ->
A.send b `Start >>= fun () ->
A.wait_all ()
)

6
tests/quick/all.sh
View file

@ -1,6 +0,0 @@
#!/usr/bin/env bash
for i in tests/quick/*.ml ; do
echo -n "${i}..."
$i
done

18
tests/quick/levenshtein_dict.ml
View file

@ -1,18 +0,0 @@
#!/usr/bin/env ocaml
#use "tests/quick/.common.ml";;
#load "containers.cma";;
#load "containers_string.cma";;
#load "containers_io.cma";;
open Containers_string
let words =
CCIO.with_in "/usr/share/dict/words" CCIO.read_lines_l
let idx = List.fold_left
(fun idx s -> Levenshtein.Index.add idx s s)
Levenshtein.Index.empty words;;
Levenshtein.Index.retrieve ~limit:1 idx "hell"
|> Levenshtein.klist_to_list
|> List.iter print_endline;;

52
tests/test_univ.ml
View file

@ -1,52 +0,0 @@
open OUnit
open Containers_misc
(** Test Univ embedding *)
let test_val () =
let e1 = Univ.embed () in
let e2 = Univ.embed () in
let v1 = Univ.pack e1 42 in
let v2 = Univ.pack e2 "hello" in
OUnit.assert_equal (Some 42) (Univ.unpack e1 v1);
OUnit.assert_equal None (Univ.unpack e1 v2);
OUnit.assert_equal (Some "hello") (Univ.unpack e2 v2);
OUnit.assert_equal None (Univ.unpack e2 v1);
()
let test_compatible () =
let e1 = Univ.embed () in
let e2 = Univ.embed () in
let v1 = Univ.pack e1 42 in
let v2 = Univ.pack e2 "hello" in
OUnit.assert_bool "compatible" (Univ.compatible e1 v1);
OUnit.assert_bool "not compatible" (not (Univ.compatible e1 v2));
OUnit.assert_bool "compatible" (Univ.compatible e2 v2);
OUnit.assert_bool "not compatible" (not (Univ.compatible e2 v1));
()
let test_set () =
let e1 = (Univ.embed () : int Univ.embedding) in
let e2 = (Univ.embed () : string Univ.embedding) in
(* create val *)
let v = Univ.pack e1 42 in
OUnit.assert_equal (Some 42) (Univ.unpack e1 v);
OUnit.assert_equal None (Univ.unpack e2 v);
(* set content, keeping type *)
Univ.set e1 v 100;
OUnit.assert_equal (Some 100) (Univ.unpack e1 v);
OUnit.assert_equal None (Univ.unpack e2 v);
(* set content, changing type *)
Univ.set e2 v "hello";
OUnit.assert_equal None (Univ.unpack e1 v);
OUnit.assert_equal (Some "hello") (Univ.unpack e2 v);
()
let suite =
"test_univ" >:::
[ "test_val" >:: test_val;
"test_compatible" >:: test_compatible;
"test_set" >:: test_set;
]

88
tests/threads/run_test_future.ml
View file

@ -1,88 +0,0 @@
(** Test Future *)
open OUnit
open CCFun
module Future = CCFuture
open Future.Infix
let test_parallel n () =
let l = Sequence.(1 -- n) |> Sequence.to_list in
let l = List.map (fun i ->
Future.make
(fun () ->
Thread.delay 0.1;
1
)) l in
let l' = List.map Future.get l in
OUnit.assert_equal n (List.fold_left (+) 0 l');
()
let test_map () =
let a = Future.make (fun () -> 1) in
let b = Future.map (fun x -> x+1) a in
let c = Future.map (fun x -> x-1) b in
OUnit.assert_equal 1 (Future.get c)
let test_sequence_ok () =
let l = CCList.(1 -- 10) in
let l' = l
|> List.map
(fun x -> Future.make (fun () -> Thread.delay 0.2; x*10))
|> Future.sequence
|> Future.map (List.fold_left (+) 0)
in
let expected = List.fold_left (fun acc x -> acc + 10 * x) 0 l in
OUnit.assert_equal expected (Future.get l')
let test_sequence_fail () =
let l = CCList.(1 -- 10) in
let l' = l
|> List.map
(fun x -> Future.make (fun () -> Thread.delay 0.2; if x = 5 then raise Exit; x))
|> Future.sequence
|> Future.map (List.fold_left (+) 0)
in
OUnit.assert_raises Exit (fun () -> Future.get l')
let test_time () =
let start = Unix.gettimeofday () in
let l = CCList.(1 -- 10)
|> List.map (fun _ -> Future.make (fun () -> Thread.delay 0.5))
in
List.iter Future.get l;
let stop = Unix.gettimeofday () in
OUnit.assert_bool "some_parallelism" (stop -. start < 10. *. 0.5);
()
let test_timer () =
let timer = Future.Timer.create () in
let n = CCLock.create 1 in
let get = Future.make (fun () -> Thread.delay 0.8; CCLock.get n) in
let _ =
Future.Timer.after timer 0.6
>>= fun () -> CCLock.update n (fun x -> x+2); Future.return()
in
let _ =
Future.Timer.after timer 0.4
>>= fun () -> CCLock.update n (fun x -> x * 4); Future.return()
in
OUnit.assert_equal 6 (Future.get get);
()
let suite =
"test_future" >:::
[
"test_parallel_10" >:: test_parallel 10;
"test_parallel_300" >:: test_parallel 300;
"test_time" >:: test_time;
"test_map" >:: test_map;
"test_sequence_ok" >:: test_sequence_ok;
"test_sequence_fail" >:: test_sequence_fail;
"test_timer" >:: test_timer;
]
let () =
let _ = OUnit.run_test_tt_main suite in
()