Repository: ocsigen/lwt
Pull request #860 (2021-05-24 11:15:07)

Lwt_domain: an interface to multicore parallelism
**Synopsis**: The PR aims to add a module `Lwt_domain` that enables offloading computations to many CPU cores via Multicore's [Domains](https://github.com/ocaml-multicore/ocaml-multicore/blob/4.12%2Bdomains%2Beffects/stdlib/domain.mli).

### `Lwt_domain` interface

This patch aims to add a new module `Lwt_domain`. The API is similar to `Lwt_preemptive`, the major difference being `Lwt_preemptive` runs compuatations in a new systhread and `Lwt_domain` computations in a new domain. 

In effect, the `Lwt_domain` runs OCaml computations in parallel on multiple CPU cores, which is not the case with `Lwt_preemptive`. This is because system threads are run on a single CPU core despite being run concurrently. On the other hand, multicore domains run on the available cores.

### Implementation

A pool of domains is created by the `simple_init` function, with the default number of domains being `4`. The created domains will be alive and waiting for tasks till the time main loop is alive. The number of live domains can be adjusted via the `set_bounds` function.

Unlike `Lwt_preemptive` which creates new systhreads frequently, all live domains are reused here because repeatedly creating and shutting down new domains is an expensive process, which could be avoided.

When `detach` function is called it obtains a new worker from the pool of domains and the function is executed in that worker domain. After the execution is done, the worker domain will again be ready to take tasks.

A separate queue of jobs is maintained that are supposed to be executed on the main domain, being called from `run_in_main`.

### Benchmark

A simple server that returns Fibonacci number of a given input was ported to run in parallel. The server and client code can be found [here](https://github.com/Sudha247/code-samples/tree/master/lwt-parallel). The benchmark was run with 10 clients and 10 requests per client, it's time is shown below. Individual timings can be found in the blog post mentioned below. 

**Time graph of parallel Fibonacci server**

![image](https://user-images.githubusercontent.com/13328130/119338917-34236b80-bcae-11eb-83b7-d43f01c43299.png)

#### Side note

`Unix.fork` is not compatible with multiple domains. Hence, the test-suite is modified to run sequentially and all the tests that run `Unix.fork` are run before the `Lwt_domain` test.

---

This module is intended to work with OCaml 5.0 with parallelism support. It can be used now with Multicore OCaml obtained from [multicore-opam](https://github.com/ocaml-multicore/multicore-opam). Any suggestions/feedback welcome, benchmarks from potential applications of this module will be appreciated too!

### Further reading

* [Related blog post](https://sudha247.github.io/2020/10/01/lwt-multicore/)
* [Concurrency and parallelism and design notes](https://github.com/ocaml-multicore/ocaml-multicore/wiki/Concurrency-and-parallelism-design-notes)


raphael-proust: Hello,

Thanks a lot for this PR! I'm looking forward to multicore-lwt!

I've just had a quick look. (I'll do a longer review later.) I have a few questions/comments:

- You added `Lwt_domain` to the `unix/` domain. Is there a reason for this? Is there a dependency from the multicore part of the runtime on the OS? Or is it by similarity with `Lwt_preemptive` that it ended up there? In general we want to put code in `core/` if it doesn't rely on unix.

    Currently there's a call to lwt_unix, for a notification thing. Is it for convenience (the function with the right signature was there) or intrisically dependent on a unix feature?

- We'll need to grow the test suite a bit just to buff up the coverage. But that's not urgent at all.
avsm: Lwt_offload should be in core/ indeed -- it's not part of the Unix-specific part of multicore OCaml.

@Sudha247 it would be good to get more of your benchmarks into the test suite here. For example the fib run would be ideal to check that you get the same results and also provide an example.

I'm just discussing with caml-devel the right way to be able to release this with Lwt_offload as an optional module -- I'll update when I find consensus.
Sudha247: Thanks for the comments @raphael-proust and @avsm!

Agree about moving this module to core. The notification call is just for convenience, I'll work on removing this part after which there won't be any dependency on lwt_unix, so then the module will be ready to be moved to core.

Having more tests for the module would certainly be useful, I'll add the fib example to the testsuite.
Sudha247: Some updates on the latest commit are:
* Ported the `Lwt_domain` module to domainslib Task pool rather than managing creating domains on the module itself. This reduces duplication with domainslib.
* Added a couple more tests - a test for `run_in_main` and a shorter running version of the Fibonacci benchmark.

With the new update, there's a slight digression from the `Lwt_preemptive` module; since the process of creating and destroying domains is expensive, `Lwt_domain` creates a fixed number of worker domains onto which tasks will be offloaded to, so there's no notion of minimum and maximum number of domains.
### Benchmarks
Some benchmark results with the updates are below:
**Benchmark**: Computes `fib 42` 100 times.

#### Time
[Sequential version](https://github.com/Sudha247/code-samples/blob/master/lwt-parallel/fib_bench_sequential.ml): 205.397s
[Preemptive threads version](https://github.com/Sudha247/code-samples/blob/master/lwt-parallel/fib_bench_preemptive.ml): 210.665s
[Parallel version](https://github.com/Sudha247/code-samples/blob/master/lwt-parallel/fib_bench_parallel.ml) (with `Lwt_domain`)

The results were obtained on an Intel Xeon Gold 5120 processor with 24 isolated cores.

| Cores | Time(s)   | Speedup      |
|-------|--------|--------------|
| 1     | 212.72 | 0.9655744641 |
| 2     | 106.34 | 1.931512131  |
| 4     | 53.15  | 3.864477893  |
| 8     | 27.64  | 7.431150507  |
| 12    | 19.13  | 10.73690538  |
| 16    | 14.89  | 13.79429147  |
| 20    | 10.64  | 19.30422932  |
| 24    | 11.02  | 18.63856624  |

![image](https://user-images.githubusercontent.com/13328130/120754420-41e8b480-c52a-11eb-8646-b032ba879904.png)

Note: There's still a dependency on `Lwt_unix` due to calling notifications. I'm trying to replicate that nicely with Domainslib channels. Will update the PR and move the module to core when it's done.
raphael-proust: This module is very promising (pun intended).

I'll work on packaging: how to ship this module without introducing a hard dependence on OCaml.5.0. I think it'll just need to be a separate opam package `lwt-domain` or something of the sort.
Sudha247: Thanks a lot for the comments @raphael-proust! I'm doing another pass to update documentation and remove obsolete parts in the PR. I'll think through some of these open-ended questions and respond to them.
avsm: It looks like there is a real error here in the CI:

```
File "src/unix/lwt_domain.ml", line 24, characters 42-43:
24 | let pool = ref (T.setup_pool ~num_domains:0)
                                               ^
Error: The function applied to this argument has type
         num_additional_domains:int -> Domainslib__Task.pool
```

Is this expected @Sudha247?
Sudha247: Needed to bump domainslib to the latest version and change the argument to `~num_additional_domains`, it's fixed now.
avsm: We need to define whether the [Lwt.async exception hook](https://ocsigen.org/lwt/3.1.0/api/Lwt#VALasync_exception_hook) is supported or not when on a different domain.
raphael-proust: I toyed around with replacing the Lwt_unix.condition signaling mechanism with a lower-level, no-Unix version, but I wasn't satisfied with the result. I think that we can move the Lwt_domain module outside of unix/ and into core/ but we might need

- to add some new global data-structure in lwt.ml (similar to `paused` but for detached computation instead),
- add some interaction in the loop of Lwt_main.run to check on those (again, similar to pause),
- add some other mechanism in the js-of-ocaml lwt runtime.

In my opinion, this can wait: we should focus on getting something that works and we can later get it to work better.
raphael-proust: > We need to define whether the [Lwt.async exception hook](https://ocsigen.org/lwt/3.1.0/api/Lwt#VALasync_exception_hook) is supported or not when on a different domain.

The documentation about the exception is explicit. But to make sure the situation re: the async exception hook is clear, we could add a paragraph that explains what happens if we do `Lwt.dont_wait (fun () -> Lwt_domain.detach …) (fun exc -> …)` and if we do `Lwt.async (Lwt_domain.detach …)`.

We can add this later because it can be inferred from the current documentation.
yawaramin: Thinking about this design a bit more; I think we also need a convenience function:

```ocaml
val Lwt.domain : (* or, detach/blocking/… *)
  ?pool:Lwt_domain.pool ->
  ('a -> 'b) ->
  'a ->
  'b Lwt.t
```

In a typical application, we might want to run a blocking computation at various points in the code. It would become a hassle to set up a domain pool at the application’s top layer and thread that through to all lower layers which needed it. Lwt should set up a domain pool by default, and allow users to override it if necessary.

We can add some docs to the effect that ‘promises are for non-blocking I/O but we have a convenient way to represent blocking computations as promises’.
Sudha247: >It would become a hassle to set up a domain pool at the application’s top layer and thread that through to all lower layers which needed it.

It sure is a hassle, especially while modifying existing modules. This is why named pools were introduced in [domainslib.0.3.1](https://github.com/ocaml-multicore/domainslib/releases/tag/0.3.1). Pools can be obtained at a later point with the help of an identifier string it is associated to, thereby eliminating the need to thread through the pool across layers.

>Lwt should set up a domain pool by default, and allow users to override it if necessary.

We were doing this earlier. But it could turn out problematic inter-operating with multiple Multicore enabled libraries, in the sense that it gets harder tracking down all the live domain pools. Ideally in Multicore OCaml (and OCaml 5.0) programs; number of domains = number of cores, exceeding that will introduce overheads and could slow down the program. If at all we do end up with a default domain pool, I think the right place for that to reside would be at domainslib.

>We can add some docs to the effect that ‘promises are for non-blocking I/O but we have a convenient way to represent blocking computations as promises’.

This sounds like a good idea. I think I'm not clear about how this convenience function would be useful, it looks like it's exposing `Lwt_domain.detach` to Lwt but I may be misreading here.
Sudha247: Thanks to @raphael-proust `lwt-domain` is moved to its own package now.
yawaramin: Thanks for the explanation. I am now understanding a couple of new things. Btw let me preface this comment by saying that, if this `lwt_domain` package were to be merged right now, in my humble opinion it is fine as it is. My suggestion is just to improve developer experience.

> Pools can be obtained at a later point with the help of an identifier string it is associated to,

OK, that is convenient, and then my suggestion becomes:

```ocaml
val Lwt.domain : (* or, detach/blocking/… *)
  string ->
  ('a -> 'b) ->
  'a ->
  'b Lwt.t
```

> But it could turn out problematic inter-operating with multiple Multicore enabled libraries

That's a bummer.

> If at all we do end up with a default domain pool, I think the right place for that to reside would be at domainslib.

Fair enough.

> I think I'm not clear about how this convenience function would be useful,

I am suggesting that in most cases users should not have to think about `Lwt_domain`, and just call `Lwt.domain` to 'magically' parallelize their code. E.g.:

```ocaml
(* main.ml *)

let main () =
  let _ = Lwt_domain.setup_pool ~name:"main" 3 in
  ...

let () = main ()

(* person.ml *)

type t = {
  id : int;
  name : string;
} [@@deriving of_yojson]

let of_yojson = Lwt.domain "main" of_yojson
(* val of_yojson : Yojson.Safe.t -> (t, string) Lwt_result.t *)
```

Now just by wrapping an existing CPU-bound function with `Lwt.domain "main"`, we turn it into a parallelized function in the Lwt context. This convenience will be very beneficial.

Patch:
diff --git a/.github/workflows/workflow.yml b/.github/workflows/workflow.yml
index fb2fc7083..3c990e98e 100644
--- a/.github/workflows/workflow.yml
+++ b/.github/workflows/workflow.yml
@@ -30,56 +30,78 @@ jobs:
           - false
         ppx:
           - true
+        domain:
+          - false
         local-packages:
-          - "*.opam"
+          - |
+            *.opam
+            !lwt_domain.opam
         include:
           - os: ubuntu-latest
             ocaml-compiler: ocaml-variants.4.13.1+options,ocaml-option-flambda,ocaml-option-musl,ocaml-option-static
             libev: false
             ppx: true
-            local-packages: "*.opam"
+            domain: false
+            local-packages: |
+              *.opam
+              !lwt_domain.opam
           - os: ubuntu-latest
             ocaml-compiler: ocaml-variants.4.12.0+domains
             libev: false
             ppx: true
+            domain: true
             local-packages: "*.opam"
           - os: macos-latest
             ocaml-compiler: 4.13.x
             libev: true
             ppx: true
-            local-packages: "*.opam"
+            domain: false
+            local-packages: |
+              *.opam
+              !lwt_domain.opam
           - os: windows-latest
             ocaml-compiler: 4.13.x
             libev: false
             ppx: true
-            local-packages: "*.opam"
+            domain: false
+            local-packages: |
+              *.opam
+              !lwt_domain.opam
           - os: ubuntu-latest
             ocaml-compiler: 4.02.x
             libev: true
             ppx: false
+            domain: false
             local-packages: |
               *.opam
+              !lwt_domain.opam
               !lwt_ppx.opam
           - os: ubuntu-latest
             ocaml-compiler: 4.03.x
             libev: true
             ppx: false
+            domain: false
             local-packages: |
               *.opam
+              !lwt_domain.opam
               !lwt_ppx.opam
           - os: macos-latest
             ocaml-compiler: 4.02.x
             libev: true
             ppx: false
+            domain: false
             local-packages: |
               *.opam
+              !lwt_domain.opam
               !lwt_ppx.opam
           - os: windows-latest
             ocaml-compiler: 4.06.x
             libev: false
             ppx: false
+            domain: false
             local-packages: |
               *.opam
+              !lwt_domain.opam
               !lwt_ppx.opam
 
     runs-on: ${{ matrix.os }}
@@ -98,23 +120,29 @@ jobs:
       - run: opam depext conf-libev --install
         if: ${{ matrix.libev == true }}
 
-      - run: opam install . --deps-only --with-test
-        if: ${{ matrix.ppx == true }}
-
       - run: opam install lwt_luv lwt_react lwt --deps-only --with-test
-        if: ${{ matrix.ppx == false }}
 
-      - run: opam exec -- make build
+      - run: opam install lwt_ppx --deps-only --with-test
         if: ${{ matrix.ppx == true }}
 
+      - run: opam install lwt_domain --deps-only --with-test
+        if: ${{ matrix.domain == true }}
+
       - run: opam exec -- dune build --only-packages lwt_luv,lwt_react,lwt
-        if: ${{ matrix.ppx == false }}
 
-      - run: opam exec -- make test
+      - run: opam exec -- dune build --only-packages lwt_ppx
         if: ${{ matrix.ppx == true }}
 
+      - run: opam exec -- dune build --only-packages lwt_domain
+        if: ${{ matrix.domain == true }}
+
       - run: opam exec -- dune runtest --only-packages lwt_luv,lwt_react,lwt
-        if: ${{ matrix.ppx == false }}
+
+      - run: opam exec -- dune runtest --only-packages lwt_ppx
+        if: ${{ matrix.ppx == true }}
+
+      - run: opam exec -- dune runtest --only-packages lwt_domain
+        if: ${{ matrix.domain == true }}
 
       - run: opam exec -- make ppx_let-test-deps ppx_let-test
         if: ${{ matrix.ppx == true }}
diff --git a/CHANGES b/CHANGES
index 9d6f1ce33..5f7dbaf07 100644
--- a/CHANGES
+++ b/CHANGES
@@ -39,6 +39,8 @@
 
   * In the Lwt_unix module, add `?cloexec:bool` optional arguments to functions that create file descriptors (`dup`, `dup2`, `pipe`, `pipe_in`, `pipe_out`, `socket`, `socketpair`, `accept`, `accept_n`). The `?cloexec` argument is simply forwarded to the wrapped Unix function (with OCaml >= 4.05, see PR ocaml/ocaml#650), or emulated as best-effort with `Unix.set_close_on_exec` on older OCaml versions (#327, #847, #872, #901, Antonin Décimo).
 
+  * Lwt_domain: helpers for using domainslib from Lwt (#860, Sudha Parimala)
+
 ====== Misc ======
 
   * Code quality improvement: remove an uneeded Obj.magic (#844, Benoit Montagu).
diff --git a/lwt_domain.opam b/lwt_domain.opam
new file mode 100644
index 000000000..20ad1be8a
--- /dev/null
+++ b/lwt_domain.opam
@@ -0,0 +1,28 @@
+opam-version: "2.0"
+
+synopsis: "Helpers for using Domainslib with Lwt"
+
+version: "1.1.4"
+license: "MIT"
+homepage: "https://github.com/ocsigen/lwt"
+doc: "https://ocsigen.org/lwt/dev/api/Lwt_domain"
+bug-reports: "https://github.com/ocsigen/lwt/issues"
+
+authors: [
+  "Sudha Parimala"
+]
+maintainer: [
+  "Sudha Parimala"
+]
+dev-repo: "git+https://github.com/ocsigen/lwt.git"
+
+depends: [
+  "dune" {>= "1.8.0"}
+  "lwt" {>= "3.0.0"}
+  "ocaml"
+  "domainslib" {>= "0.3.2"}
+]
+
+build: [
+  ["dune" "build" "-p" name "-j" jobs]
+]
diff --git a/src/domain/dune b/src/domain/dune
new file mode 100644
index 000000000..d86fadcd5
--- /dev/null
+++ b/src/domain/dune
@@ -0,0 +1,19 @@
+(* -*- tuareg -*- *)
+
+let preprocess =
+   match Sys.getenv "BISECT_ENABLE" with
+   | "yes" -> "(preprocess (pps bisect_ppx))"
+   | _ -> ""
+   | exception _ -> ""
+
+let () = Jbuild_plugin.V1.send @@ {|
+
+(library
+ (public_name lwt_domain)
+ (synopsis "Multicore programming helpers for Lwt")
+ (wrapped false)
+ (libraries lwt lwt.unix domainslib)
+ |} ^ preprocess ^ {|
+ (flags (:standard -w +A)))
+
+|}
diff --git a/src/domain/lwt_domain.ml b/src/domain/lwt_domain.ml
new file mode 100644
index 000000000..00e124369
--- /dev/null
+++ b/src/domain/lwt_domain.ml
@@ -0,0 +1,66 @@
+open Lwt.Infix
+
+module C = Domainslib.Chan
+module T = Domainslib.Task
+
+type pool = Domainslib.Task.pool
+
+let setup_pool ?name num_additional_domains =
+    T.setup_pool ?name ~num_additional_domains ()
+
+let teardown_pool = T.teardown_pool
+
+let lookup_pool = T.lookup_pool
+
+let get_num_domains = T.get_num_domains
+
+let init_result = Error (Failure "Lwt_domain.detach")
+
+let detach pool f args =
+  if (get_num_domains pool = 1) then
+    Lwt.wrap1 f args
+  else begin
+    let result = ref init_result in
+    let task () =
+      result := try Ok (f args) with exn -> Error exn
+    in
+    let waiter, wakener = Lwt.wait () in
+    let id =
+      Lwt_unix.make_notification ~once:true
+        (fun () -> Lwt.wakeup_result wakener !result)
+    in
+    let _ = T.async pool (fun _ -> task ();
+    Lwt_unix.send_notification id) in
+    waiter
+  end
+
+(* +-----------------------------------------------------------------+
+   | Running Lwt threads in the main domain                          |
+   +-----------------------------------------------------------------+ *)
+
+(* Jobs to be run in the main domain *)
+let jobs = C.make_unbounded ()
+let job_done = C.make_bounded 0
+let job_notification =
+  Lwt_unix.make_notification
+    (fun () ->
+      let thunk = C.recv jobs in
+      ignore (thunk ()))
+
+let run_in_main f =
+  let res = ref init_result in
+  let job () =
+    Lwt.try_bind f
+      (fun ret -> Lwt.return (Result.Ok ret))
+      (fun exn -> Lwt.return (Result.Error exn)) >>= fun result ->
+    res := result;
+    C.send job_done ();
+    Lwt.return_unit
+  in
+  C.send jobs job;
+  Lwt_unix.send_notification job_notification;
+  (* blocks calling domain until the job is executed *)
+  C.recv job_done;
+  match !res with
+  | Result.Ok ret -> ret
+  | Result.Error exn -> raise exn
diff --git a/src/domain/lwt_domain.mli b/src/domain/lwt_domain.mli
new file mode 100644
index 000000000..eb543ec5d
--- /dev/null
+++ b/src/domain/lwt_domain.mli
@@ -0,0 +1,98 @@
+(* 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. *)
+
+
+
+(** This module provides the necessary function ({!detach}) to schedule some
+    computations to be ran in parallel in a separate domain. The result of such
+    a computation is exposed to the caller of {!detach} as a promise. Thus, this
+    module allows to mix multicore parallelism with the concurrent-only
+    scheduling of the rest of Lwt. *)
+
+    type pool
+    (** Domainslib Task pool *)
+
+    val detach : pool-> ('a -> 'b) -> 'a -> 'b Lwt.t
+    (** [detach pool f x] runs the computation [f x] in a separate domain in
+        parallel.
+
+        [detach pool f x] evaluates to an Lwt promise which is pending until the
+        domain completes the execution of [f x] at which point it becomes
+        resolved. If [f x] raises an exception, then the promise is rejected.
+
+        It is recommended you initialise the task pool using
+        {!setup_pool} with a number of domains equal to the number of
+        physical cores.
+
+        Note that the function [f] passed to [detach] cannot safely use {!Lwt}.
+        This is true even for implicit callback arguments (i.e.,
+        {!Lwt.with_value}). If you need to use {!Lwt} or interact with promises,
+        you must use {!run_in_main}.
+
+        In the special case where the task pool has size one (i.e., when there
+        is no additional domain to detach the computation to), the computation
+        runs immediately on the main domain. In other words, when the number of
+        domains is one (1), then [detach f x] is identical to
+        [Lwt.return (f x)].
+
+        @raise [Invalid_argument] if pool is already torn down. *)
+
+  val run_in_main : (unit -> 'a Lwt.t) -> 'a
+    (** [run_in_main f] can be called from a detached computation to execute [f
+        ()] in the parent domain, i.e. the one executing {!Lwt_main.run}.
+
+        [run_in_main f] blocks until [f ()] completes, then it returns its
+        result. If [f ()] raises an exception, [run_in_main f] raises the same
+        exception. The whole of {!Lwt} can be safely used from within [f].
+        However, note that implicit callback arguments are local to [f]. I.e.,
+        {!Lwt.get} can only retrieve values set inside of [f], and not those set
+        inside the promise that called [detach] that called [run_in_main].
+
+        Note that the calling domain will be idle until [f ()] completes
+        execution and returns the result. Thus, heavy use of [run_in_main] may
+        lead to most or all domains being frozen. It's also possible to create a
+        dead-lock when [run_in_main] is called (thus freezing a domain) with a
+        function that calls [detach] (thus needing a domain). Consequently, it
+        is recommended to use this function sparingly. *)
+
+  val setup_pool : ?name:string -> int -> pool
+  (** [setup_pool name num_additional_domains] returns a task pool with
+      [num_additional_domains] domains including the current domain.
+
+      It is recommended to use this function to create a pool once before
+      calling [Lwt_main.run] and to not call it again afterwards. To resize the
+      pool, call [teardown_pool ()] first before creating a new pool again.
+      Multiple calls to resize the domain pool are safe but costly.
+
+      If [name] is provided, the pool is mapped to name. It can be obtained
+      later with [lookup_pool name].
+
+      For more details about task pool, please refer:
+      https://github.com/ocaml-multicore/domainslib/blob/master/lib/task.mli
+
+      @raise [Invalid_argument] if given number of domains [n] is smaller than
+      [1].
+
+      @raise [Failure] if the pool is already initialised when the function is
+      called.
+      *)
+
+  val teardown_pool : pool -> unit
+  (** [teardown_pool ()] shuts down the task pool. It is safe to call
+      [setup_pool] again after [teardown_pool] returns.
+
+      This function is useful if different portions of your program have benefit
+      from different degree of parallelism.
+
+      @raise [TasksActive] if any tasks in the pool are currently active.
+
+      @raise [Invalid_argument] if pool is already torn down. *)
+
+  val lookup_pool : string -> pool option
+  (** [lookup_pool name] returns [Some pool] if [pool] is associated to [name]
+      or returns [None] if no value is associated to it. *)
+
+  val get_num_domains : pool -> int
+    (** [get_num_domains pool] returns the number of domains in [pool]. *)
+
+  (**/**)


Test patch:
diff --git a/test/domain/dune b/test/domain/dune
new file mode 100644
index 000000000..9e4ee5eb3
--- /dev/null
+++ b/test/domain/dune
@@ -0,0 +1,9 @@
+(executable
+ (name main)
+ (libraries lwt_domain lwttester tester))
+
+(alias
+ (name runtest)
+ (package lwt_domain)
+ (action (run %{exe:main.exe}))
+)
diff --git a/test/domain/main.ml b/test/domain/main.ml
new file mode 100644
index 000000000..aaee0bcca
--- /dev/null
+++ b/test/domain/main.ml
@@ -0,0 +1,7 @@
+(* 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. *)
+
+let () =
+  Test.run "domain" [
+    Test_lwt_domain.suite;
+  ]
diff --git a/test/domain/test_lwt_domain.ml b/test/domain/test_lwt_domain.ml
new file mode 100644
index 000000000..0face6c22
--- /dev/null
+++ b/test/domain/test_lwt_domain.ml
@@ -0,0 +1,89 @@
+(* 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. *)
+
+open Test
+open Lwt.Infix
+
+let lwt_domain_test = [
+  test "run_in_domain" begin fun () ->
+    let pool = Lwt_domain.setup_pool ~name:"pool_1" 4 in
+    let f () = 40 + 2 in
+    Lwt_domain.detach pool f () >>= fun x ->
+    Lwt.return (x = 42)
+  end;
+  test "run_in_main_domain" begin fun () ->
+    let pool = Option.get (Lwt_domain.lookup_pool "pool_1") in
+    let f () =
+      Lwt_domain.run_in_main (fun () ->
+        Lwt_unix.sleep 0.01 >>= fun () ->
+        Lwt.return 42)
+    in
+    Lwt_domain.detach pool f () >>= fun x ->
+    Lwt.return (x = 42)
+  end;
+  test "run_in_main_domain_exception" begin fun () ->
+    let pool = Option.get (Lwt_domain.lookup_pool "pool_1") in
+    let f () = Lwt_domain.detach pool (fun () ->
+      Lwt_domain.run_in_main (fun () ->
+        Lwt_unix.sleep 0.01 >>= fun () ->
+        Lwt.return (5/0))) ()
+    in
+    Lwt.try_bind f
+    (fun _ -> Lwt.return_false)
+    (fun exn -> Lwt.return (exn = Division_by_zero))
+  end;
+  test "fib_domain" begin fun () ->
+    let pool = Option.get (Lwt_domain.lookup_pool "pool_1") in
+    let rec fib n =
+      if n < 2 then n
+      else fib (n - 1) + fib (n - 2)
+    in
+    let l1 =
+      List.init 10 (fun i -> Lwt_domain.detach pool fib i) in
+    let l2 =
+      List.init 10 (fun i -> Lwt.return (fib i)) in
+    let s1 = Lwt.all l1 in
+    let s2 = Lwt.all l2 in
+    Lwt_unix.sleep 0.01 >>= fun () ->
+    Lwt.return (s1 = s2)
+  end;
+  test "invalid_num_domains" begin fun () ->
+    let set () =
+      let _ = Lwt_domain.setup_pool (-1) in
+      Lwt.return_true
+    in
+    Lwt.try_bind (fun () -> set ())
+      (fun _ -> Lwt.return_false)
+      (fun exn ->
+        Lwt.return (exn = Invalid_argument
+        "Task.setup_pool: num_additional_domains must be at least 0"))
+  end;
+  test "detach_exception" begin fun () ->
+    let pool = Option.get (Lwt_domain.lookup_pool "pool_1") in
+    let r = Lwt_domain.detach pool (fun () -> 10 / 0) () in
+    Lwt.try_bind (fun () -> r)
+      (fun _ -> Lwt_domain.teardown_pool pool; Lwt.return_false)
+      (fun exn -> Lwt_domain.teardown_pool pool;
+          Lwt.return (exn = Division_by_zero))
+  end;
+  test "one_domain" begin fun () ->
+    let p2 = Lwt_domain.setup_pool 1 ~name:"pool2" in
+    let f n = n * 10 in
+    Lwt_domain.detach p2 f 100 >>= fun x ->
+      Lwt.return (x = 1000)
+  end;
+  test "pool_already_shutdown" begin fun () ->
+    let p2 = Option.get (Lwt_domain.lookup_pool "pool2") in
+    Lwt_domain.teardown_pool p2;
+    Lwt.try_bind (fun () -> Lwt_domain.detach p2 (fun () -> Lwt.return_true) ())
+      (fun _ -> Lwt.return_false)
+      (fun exn -> Lwt.return
+        (exn = Invalid_argument "pool already torn down"))
+  end
+]
+
+let suite =
+  suite "lwt_domain"
+    (
+     lwt_domain_test
+    )