From fb6fea0d0745254ffb0cda8f98060cebedfd04c2 Mon Sep 17 00:00:00 2001
From: Anton Bachin <antonbachin@yahoo.com>
Date: Wed, 22 Apr 2020 05:56:04 +0300
Subject: [PATCH] Test let* and and*

Follow-on to #775.
---
 src/core/lwt.mli             |  3 ++-
 test/core/dune               |  1 +
 test/core/test_lwt.ml        | 33 +++++++++++++++++++++++++++++++++
 test/core/test_lwt_result.ml | 32 +++++++++++++++++++++++++++++++-
 4 files changed, 67 insertions(+), 2 deletions(-)

diff --git a/src/core/lwt.mli b/src/core/lwt.mli
index 72ce753d21..4a1453ee4d 100644
--- a/src/core/lwt.mli
+++ b/src/core/lwt.mli
@@ -1397,7 +1397,7 @@ let () =
   end
 end
 
-(** {3 Syntax} *)
+(** {3 Let syntax} *)
 module Syntax :
 sig
   val (let*) : 'a t -> ('a -> 'b t) -> 'b t
@@ -1405,6 +1405,7 @@ sig
 end
 
 
+
 (** {3 Pre-allocated promises} *)
 
 val return_unit : unit t
diff --git a/test/core/dune b/test/core/dune
index d6beaacd90..e5e0e8c45c 100644
--- a/test/core/dune
+++ b/test/core/dune
@@ -1,6 +1,7 @@
 (executable
  (name main)
  (libraries lwttester)
+ (preprocess (future_syntax))
  (flags (:standard -w +A-40-42)))
 
 (alias
diff --git a/test/core/test_lwt.ml b/test/core/test_lwt.ml
index d6635315dd..ba7b66941b 100644
--- a/test/core/test_lwt.ml
+++ b/test/core/test_lwt.ml
@@ -3903,6 +3903,39 @@ let suites = suites @ [ppx_let_tests]
 
 
 
+let let_syntax_tests = suite "let syntax" [
+  test "let*" begin fun () ->
+    let p1, r1 = Lwt.wait () in
+    let p2, r2 = Lwt.wait () in
+    let p' =
+      let open Lwt.Syntax in
+      let* s1 = p1 in
+      let* s2 = p2 in
+      Lwt.return (s1 ^ s2)
+    in
+    Lwt.wakeup r1 "foo";
+    Lwt.wakeup r2 "bar";
+    state_is (Lwt.Return "foobar") p'
+  end;
+
+  test "and*" begin fun () ->
+    let p1, r1 = Lwt.wait () in
+    let p2, r2 = Lwt.wait () in
+    let p' =
+      let open Lwt.Syntax in
+      let* s1 = p1
+      and* s2 = p2 in
+      Lwt.return (s1 ^ s2)
+    in
+    Lwt.wakeup r1 "foo";
+    Lwt.wakeup r2 "bar";
+    state_is (Lwt.Return "foobar") p'
+  end;
+]
+let suites = suites @ [let_syntax_tests]
+
+
+
 (* Tests for [Lwt.add_task_l] and [Lwt.add_task_r]. *)
 
 let lwt_sequence_contains sequence list =
diff --git a/test/core/test_lwt_result.ml b/test/core/test_lwt_result.ml
index 9d123bd4ed..e3183bebf5 100644
--- a/test/core/test_lwt_result.ml
+++ b/test/core/test_lwt_result.ml
@@ -131,7 +131,7 @@ let suite =
          let f y = Result.Ok (y + 1) in
          Lwt.return (Lwt_result.bind_result x f = Lwt_result.fail 0)
       );
-    
+
     test "both ok"
       (fun () ->
          let p =
@@ -185,4 +185,34 @@ let suite =
          Lwt.wakeup_later r1 (Result.Error 0);
          Lwt.bind p (fun x -> Lwt.return (x = Result.Error 1))
       );
+
+    test "let*"
+      (fun () ->
+        let p1, r1 = Lwt.wait () in
+        let p2, r2 = Lwt.wait () in
+        let p' =
+          let open Lwt_result.Syntax in
+          let* s1 = p1 in
+          let* s2 = p2 in
+          Lwt.return (Result.Ok (s1 ^ s2))
+        in
+        Lwt.wakeup r1 (Result.Ok "foo");
+        Lwt.wakeup r2 (Result.Ok "bar");
+        state_is (Lwt.Return (Result.Ok "foobar")) p'
+      );
+
+    test "and*"
+      (fun () ->
+        let p1, r1 = Lwt.wait () in
+        let p2, r2 = Lwt.wait () in
+        let p' =
+          let open Lwt_result.Syntax in
+          let* s1 = p1
+          and* s2 = p2 in
+          Lwt.return (Result.Ok (s1 ^ s2))
+        in
+        Lwt.wakeup r1 (Result.Ok "foo");
+        Lwt.wakeup r2 (Result.Ok "bar");
+        state_is (Lwt.Return (Result.Ok "foobar")) p'
+      );
   ]