Port Lwttester to Alcotest

[Alcotest][] is "a lightweight and colourful test framework".

It provides benefits over Lwt's current lwttester: it allows selecting
which test cases and test suites to run, has a colorful logging, better
integration with dune and standalone testing, and better logging
overall.

Porting the whole test suite was deemed too complex without
code-rewriting tools, so only Lwt's Test library was re-implemented on
top of Alcotest. We can revisit that later.

1. The main caveat is that Alcotest has no support for running tests
   concurrently, so the whole run is slightly longer.
2. Another problem is that alcotest-lwt re-exports lwt.unix which causes
   circular dependencies, so version alcotest-lwt.1.5.0 was embedded.
3. Usage of the Skip exception to skip a test while it's running cannot
   be ported to Alcotest too.
4. Alcotest requires OCaml >= 4.05. We keep the old test suite for
   OCaml < 4.05.

Author: MisterDA

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: [

lwt_luv.opam

@@ -22,6 +22,9 @@ 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"})
+  "cppo" {with-test & >= "1.1.0"}
 ]
 
 build: [

lwt_react.opam

@@ -21,6 +21,9 @@ depends: [
   "lwt" {>= "3.0.0"}
   "ocaml"
   "react" {>= "1.0.0"}
+
+  ("alcotest" {with-test & >= "1.5.0"} & "ocaml" {>= "4.05"})
+  "cppo" {with-test & >= "1.1.0"}
 ]
 
 build: [

test/dune

@@ -1,4 +1,11 @@
+(rule
+ (targets test.ml)
+ (deps (:ml test.cppo.ml))
+ (action
+  (chdir %{project_root}
+   (run %{bin:cppo} -V OCAML:%{ocaml_version} %{ml} -o %{targets}))))
+
 (library
  (name lwttester)
  (wrapped false)
- (libraries lwt unix lwt.unix))
+ (libraries lwt unix lwt.unix alcotest))

test/test.ml renamed to test/test.cppo.ml

@@ -1,34 +1,32 @@
 (* 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;
-  run : unit -> bool Lwt.t;
+  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; }
+
+
+#if OCAML_VERSION < (4, 05, 0)
+
 type outcome =
   | Passed
   | Failed
   | Exception of exn
   | Skipped
 
-exception Skip
 exception Duplicate_Test_Names of string
 
-let test_direct test_name ?(only_if = fun () -> true) run =
-  let run =
-    fun () ->
-      Lwt.return (run ())
-  in
-  {test_name; skip_if_this_is_false = only_if; sequential = false; run}
-
-let test test_name ?(only_if = fun () -> true) ?(sequential = false) run =
-  {test_name; skip_if_this_is_false = only_if; sequential; run}
-
 module Log =
 struct
   let log_file =
@@ -82,7 +80,9 @@ let run_test : test -> outcome Lwt.t = fun test ->
         let test_completion_promise =
           Lwt.try_bind
             (fun () ->
-              test.run ())
+              match test.run with
+              | `Lwt run -> run ()
+              | `Direct run -> Lwt.return (run ()))
 
             (fun test_did_pass ->
               if test_did_pass then
@@ -340,6 +340,134 @@ let concurrent library_name suites =
 let concurrent library_name suites =
   Lwt_main.run (concurrent library_name suites)
 
+#else
+
+(* Alcotest_lwt 1.5.0
+ *
+ * Copyright (c) 2017 Thomas Gazagnaire <[email protected]>
+ *
+ * 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
+
+
+module List = struct
+  include List
+
+  let filter_map f =
+    let rec aux accu = function
+      | [] -> rev accu
+      | x :: l ->
+        match f x with
+        | None -> aux accu l
+        | Some v -> aux (v :: accu) l
+    in
+    aux []
+end
+
+
+open Lwt.Infix
+
+type suite = {
+  suite_name : string;
+  suite_tests : unit Alcotest_lwt.test_case list;
+  skip_suite_if_this_is_false : unit -> bool;
+}
+
+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 tests =
+    List.filter_map (fun test ->
+        if test.skip_if_this_is_false () then
+          Some (to_test_case test)
+        else None)
+      tests
+  in
+  {suite_name = name;
+   suite_tests = tests;
+   skip_suite_if_this_is_false = only_if}
+
+let run library_name suites =
+  let tests =
+    List.filter_map (fun suite ->
+        if suite.skip_suite_if_this_is_false () then
+          Some (suite.suite_name, suite.suite_tests)
+        else None)
+      suites in
+  Alcotest_lwt.run library_name tests
+
+let run library_name suites = Lwt_main.run @@ run library_name suites
+let concurrent = run
+
+#endif
+
 let with_async_exception_hook hook f =
   let old_hook = !Lwt.async_exception_hook in
   Lwt.async_exception_hook := hook;