diff --git a/lwt.opam b/lwt.opam index 3c097fc8f..10e40c46c 100644 --- a/lwt.opam +++ b/lwt.opam @@ -19,7 +19,7 @@ maintainer: [ dev-repo: "git+https://github.com/ocsigen/lwt.git" depends: [ - "cppo" {build & >= "1.1.0"} + "cppo" {build & with-test & >= "1.1.0"} "dune" {>= "1.8.0"} "dune-configurator" "mmap" {>= "1.1.0" & "os" != "win32"} # mmap is needed as long as Lwt supports OCaml < 4.06.0. @@ -31,6 +31,8 @@ depends: [ # Until https://github.com/aantron/bisect_ppx/pull/327. # "bisect_ppx" {dev & >= "2.0.0"} "ocamlfind" {dev & >= "1.7.3-1"} + + "alcotest" {with-test & >= "1.5.0" & "ocaml" >= "4.05"} ] depopts: [ diff --git a/lwt_luv.opam b/lwt_luv.opam index caa0d633f..7a8e9b3c8 100644 --- a/lwt_luv.opam +++ b/lwt_luv.opam @@ -22,6 +22,8 @@ depends: [ # Until https://github.com/aantron/bisect_ppx/pull/327. # "bisect_ppx" {dev & >= "2.0.0"} + + "alcotest" {with-test & >= "1.5.0" & "ocaml" >= "4.05"} ] build: [ diff --git a/lwt_react.opam b/lwt_react.opam index c7e4622cc..e8c17d51e 100644 --- a/lwt_react.opam +++ b/lwt_react.opam @@ -21,6 +21,8 @@ depends: [ "lwt" {>= "3.0.0"} "ocaml" "react" {>= "1.0.0"} + + "alcotest" {with-test & >= "1.5.0" & "ocaml" >= "4.05"} ] build: [ diff --git a/test/dune b/test/dune index bee204a1b..815aa0dfe 100644 --- a/test/dune +++ b/test/dune @@ -1,4 +1,7 @@ (library (name lwttester) (wrapped false) - (libraries lwt unix lwt.unix)) + (libraries lwt unix lwt.unix + (select test.ml from + (alcotest -> test_alcotest.ml) + ( -> test_lwt.ml)))) diff --git a/test/test_alcotest.ml b/test/test_alcotest.ml new file mode 100644 index 000000000..72e8b9ca7 --- /dev/null +++ b/test/test_alcotest.ml @@ -0,0 +1,168 @@ +(* This file is part of Lwt, released under the MIT license. See LICENSE.md for + details, or visit https://github.com/ocsigen/lwt/blob/master/LICENSE.md. *) + +exception Skip + +type test = { + test_name : string; + skip_if_this_is_false : unit -> bool; + sequential : bool; (* Sequential is ignored in Alcotest *) + run : [`Lwt of unit -> bool Lwt.t | `Direct of unit -> bool ]; + } + +let test_direct test_name ?(only_if = fun () -> true) run = + { test_name; skip_if_this_is_false = only_if; sequential = false; run = `Direct run; } + +let test test_name ?(only_if = fun () -> true) ?(sequential = false) run = + { test_name; skip_if_this_is_false = only_if; sequential; run = `Lwt run; } + + +(* Alcotest_lwt 1.5.0 + * + * Copyright (c) 2017 Thomas Gazagnaire + * + * Permission to use, copy, modify, and distribute this software for any + * purpose with or without fee is hereby granted, provided that the above + * copyright notice and this permission notice appear in all copies. + * + * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES + * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF + * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR + * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES + * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN + * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF + * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. +*) + +module Alcotest_lwt_intf = struct + module type V1 = sig + include Alcotest_engine.V1.Cli.S with type return = unit Lwt.t + + val test_case : + string -> + Alcotest.speed_level -> + (Lwt_switch.t -> 'a -> unit Lwt.t) -> + 'a test_case + + val test_case_sync : + string -> Alcotest.speed_level -> ('a -> unit) -> 'a test_case + end + + module type Alcotest_lwt = sig + include V1 + + (** {1 Versioned APIs} *) + + module V1 : V1 + (** An alias of the above API that provides a stability guarantees over major + version changes. *) + end +end + +module Alcotest_lwt : sig + include Alcotest_lwt_intf.Alcotest_lwt +end = struct + let run_test fn args = + let async_ex, async_waker = Lwt.wait () in + let handle_exn ex = + Printf.eprintf "Uncaught async exception: %s\n%s" (Printexc.to_string ex) (Printexc.get_backtrace ()); + if Lwt.state async_ex = Lwt.Sleep then Lwt.wakeup_exn async_waker ex + in + Lwt.async_exception_hook := handle_exn; + Lwt_switch.with_switch (fun sw -> Lwt.pick [ fn sw args; async_ex ]) + + module V1 = struct + module Tester = Alcotest_engine.V1.Cli.Make (Alcotest.Unix_platform) (Lwt) + include Tester + + let test_case_sync n s f = test_case n s (fun x -> Lwt.return (f x)) + let test_case n s f = test_case n s (run_test f) + end + + include V1 +end + + +let fold_left_map f accu l = + let rec aux accu l_accu = function + | [] -> accu, List.rev l_accu + | x :: l -> + let accu, x = f accu x in + aux accu (x :: l_accu) l in + aux accu [] l + +let fold_left_mapi f accu l = + let rec aux i accu l_accu = function + | [] -> accu, List.rev l_accu + | x :: l -> + let accu, x = f i accu x in + aux (i + 1) accu (x :: l_accu) l in + aux 0 accu [] l + + +open Lwt.Infix + +type suite = { + suite_name : string; + suite_tests : unit Alcotest_lwt.test_case list; + skip_suite_if_this_is_false : unit -> bool; + skip_indexes : int list; +} + +let suite name ?(only_if = fun () -> true) tests = + let to_test_case test = + match test.run with + | `Lwt run -> + Alcotest_lwt.test_case test.test_name `Quick (fun _switch () -> + run () >|= fun b -> + Alcotest.(check bool) "success" b true) + | `Direct run -> + Alcotest_lwt.test_case_sync test.test_name `Quick (fun () -> + let b = run () in + Alcotest.(check bool) "success" b true) + in + let skip_indexes, tests = + fold_left_mapi (fun i skip_indexes test -> + if test.skip_if_this_is_false () then skip_indexes, to_test_case test + else i :: skip_indexes, to_test_case test) + [] (tests : test list) + in + {suite_name = name; + suite_tests = tests; + skip_suite_if_this_is_false = only_if; + skip_indexes} + +let run library_name suites = + let skip = Hashtbl.create 16 in + let skip_names, tests = + fold_left_map (fun skip_names suite -> + if suite.skip_suite_if_this_is_false () then + begin + Hashtbl.add skip suite.suite_name suite.skip_indexes; + skip_names, (suite.suite_name, suite.suite_tests) + end + else + suite.suite_name :: skip_names, (suite.suite_name, suite.suite_tests)) + [] suites in + let filter ~name ~index = + if List.mem name skip_names then `Skip + else + let skip_indexes = Hashtbl.find skip name in + if List.mem index skip_indexes then `Skip + else `Run + in + Alcotest_lwt.run ~filter library_name tests + +let run library_name suites = Lwt_main.run @@ run library_name suites +let concurrent = run + +let with_async_exception_hook hook f = + let old_hook = !Lwt.async_exception_hook in + Lwt.async_exception_hook := hook; + Lwt.finalize f (fun () -> + Lwt.async_exception_hook := old_hook; + Lwt.return ()) + +let instrument = function + | true -> Printf.ksprintf (fun _s -> true) + | false -> Printf.ksprintf (fun s -> prerr_endline ("\n" ^ s); false) diff --git a/test/test.ml b/test/test_lwt.ml similarity index 100% rename from test/test.ml rename to test/test_lwt.ml