merge remaining tests as qtest, remove lwt stuff including bench_io

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
 

_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

benchs/run_bench_io.ml

@@ -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;
-  ()
-
-

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

tests/.merlin

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

tests/quick/.common.ml

@@ -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
-*)

tests/quick/actors.ml

@@ -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 ()
-)
-

tests/quick/all.sh

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

tests/quick/levenshtein_dict.ml

@@ -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;;

tests/test_univ.ml

@@ -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;
-    ]
-

tests/threads/run_test_future.ml

@@ -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
-  ()