mirror of
https://github.com/c-cube/ocaml-containers.git
synced 2025-12-06 11:15:31 -05:00
merge remaining tests as qtest, remove lwt stuff including bench_io
This commit is contained in:
Simon Cruanes
parent
507fe33086
commit
ed31060d7d
11 changed files with 76 additions and 349 deletions
20
Makefile
20
Makefile
|
|
@ -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
23
_oasis
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
()
|
||||
|
||||
|
||||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -1,3 +0,0 @@
|
|||
S .
|
||||
B ../_build/tests/
|
||||
REC
|
||||
|
|
@ -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
|
||||
*)
|
||||
|
|
@ -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 ()
|
||||
)
|
||||
|
||||
|
|
@ -1,6 +0,0 @@
|
|||
#!/usr/bin/env bash
|
||||
|
||||
for i in tests/quick/*.ml ; do
|
||||
echo -n "${i}..."
|
||||
$i
|
||||
done
|
||||
|
|
@ -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;;
|
||||
|
|
@ -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;
|
||||
]
|
||||
|
||||
|
|
@ -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
|
||||
()
|
||||
Loading…
Add table
Reference in a new issue