From ed31060d7dab71ba8aa9f759d081a0dc3196e32c Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Wed, 16 Sep 2015 19:33:56 +0200 Subject: [PATCH] merge remaining tests as qtest, remove lwt stuff including `bench_io` --- Makefile | 20 -------- _oasis | 23 +-------- benchs/run_bench_io.ml | 88 -------------------------------- src/threads/CCFuture.ml | 75 +++++++++++++++++++++++++++ tests/.merlin | 3 -- tests/quick/.common.ml | 19 ------- tests/quick/actors.ml | 33 ------------ tests/quick/all.sh | 6 --- tests/quick/levenshtein_dict.ml | 18 ------- tests/test_univ.ml | 52 ------------------- tests/threads/run_test_future.ml | 88 -------------------------------- 11 files changed, 76 insertions(+), 349 deletions(-) delete mode 100644 benchs/run_bench_io.ml delete mode 100644 tests/.merlin delete mode 100644 tests/quick/.common.ml delete mode 100755 tests/quick/actors.ml delete mode 100755 tests/quick/all.sh delete mode 100755 tests/quick/levenshtein_dict.ml delete mode 100644 tests/test_univ.ml delete mode 100644 tests/threads/run_test_future.ml diff --git a/Makefile b/Makefile index e30d8a61..28add908 100644 --- a/Makefile +++ b/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 diff --git a/_oasis b/_oasis index d43fa4a9..54f42ea0 100644 --- a/_oasis +++ b/_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 diff --git a/benchs/run_bench_io.ml b/benchs/run_bench_io.ml deleted file mode 100644 index a741486c..00000000 --- a/benchs/run_bench_io.ml +++ /dev/null @@ -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; - () - - diff --git a/src/threads/CCFuture.ml b/src/threads/CCFuture.ml index 19b62dc5..ac5cf381 100644 --- a/src/threads/CCFuture.ml +++ b/src/threads/CCFuture.ml @@ -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 diff --git a/tests/.merlin b/tests/.merlin deleted file mode 100644 index c8fb82a3..00000000 --- a/tests/.merlin +++ /dev/null @@ -1,3 +0,0 @@ -S . -B ../_build/tests/ -REC diff --git a/tests/quick/.common.ml b/tests/quick/.common.ml deleted file mode 100644 index fe217640..00000000 --- a/tests/quick/.common.ml +++ /dev/null @@ -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 -*) diff --git a/tests/quick/actors.ml b/tests/quick/actors.ml deleted file mode 100755 index ef10daf7..00000000 --- a/tests/quick/actors.ml +++ /dev/null @@ -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 () -) - diff --git a/tests/quick/all.sh b/tests/quick/all.sh deleted file mode 100755 index 80591a99..00000000 --- a/tests/quick/all.sh +++ /dev/null @@ -1,6 +0,0 @@ -#!/usr/bin/env bash - -for i in tests/quick/*.ml ; do - echo -n "${i}..." - $i -done diff --git a/tests/quick/levenshtein_dict.ml b/tests/quick/levenshtein_dict.ml deleted file mode 100755 index 5fc2c3be..00000000 --- a/tests/quick/levenshtein_dict.ml +++ /dev/null @@ -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;; diff --git a/tests/test_univ.ml b/tests/test_univ.ml deleted file mode 100644 index 51fe80fa..00000000 --- a/tests/test_univ.ml +++ /dev/null @@ -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; - ] - diff --git a/tests/threads/run_test_future.ml b/tests/threads/run_test_future.ml deleted file mode 100644 index c3767c6f..00000000 --- a/tests/threads/run_test_future.ml +++ /dev/null @@ -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 - ()