Deprecate let%lwt at the module item level

src/ppx/dune

@@ -6,5 +6,5 @@
  (libraries compiler-libs.common ocaml-migrate-parsetree ppx_tools_versioned)
  (ppx_runtime_libraries lwt)
  (kind ppx_rewriter)
- (preprocess (pps ppx_tools_versioned.metaquot_409))
+ (preprocess (pps ppx_tools_versioned.metaquot_409 bisect_ppx --conditional))
  (flags (:standard -w +A-4)))

src/ppx/ppx_lwt.ml

@@ -39,10 +39,6 @@ let lwt_prefix = "__ppx_lwt_"
 
 (** {2 Here we go!} *)
 
-let warn_let_lwt_rec loc attrs =
-  let attr = attribute_of_warning loc "\"let%lwt rec\" is not a recursive Lwt binding" in
-  attr :: attrs
-
 let debug      = ref true
 let log        = ref false
 let sequence   = ref true
@@ -117,37 +113,6 @@ let gen_binds e_loc l e =
 (* Note: instances of [@metaloc !default_loc] below are workarounds for
     https://github.com/ocaml-ppx/ppx_tools_versioned/issues/21. *)
 
-(** [p = x and p' = x' and ...] ≡
-    [p, p', ... = Lwt_main.run (
-      Lwt.bind x  (fun __ppx_lwt_$i  ->
-      Lwt.bind x' (fun __ppx_lwt_$i' ->
-      ...
-      Lwt.return (__ppx_lwt_$i, __ppx_lwt_$i', ...))))] *)
-
-let gen_top_binds vbs =
-  let gen_exp vbs i =
-    match vbs with
-    | {pvb_expr; _}::_rest ->
-      if !debug then
-        [%expr
-          let module Reraise = struct external reraise : exn -> 'a = "%reraise" end in
-          Lwt.backtrace_bind
-            (fun exn -> try Reraise.reraise exn with exn -> exn)
-            [%e pvb_expr]
-            (fun [%p pvar (gen_name i)] -> gen_exp _rest (i + 1))
-        ] [@metaloc !default_loc]
-      else
-        [%expr Lwt.bind [%e pvb_expr] (fun [%p pvar (gen_name i)] -> gen_exp rest (i + 1))]
-          [@metaloc !default_loc]
-    | [] ->
-      let rec names i =
-        if i >= 0 then evar (gen_name i) :: names (i - 1) else []
-      in Exp.tuple (names i)
-  in
-  [Vb.mk (Pat.tuple (vbs |> List.map (fun { pvb_pat; _ } -> pvb_pat)))
-     [%expr Lwt_main.run [%e gen_exp vbs 0]]]
-    [@metaloc !default_loc]
-
 let lwt_sequence mapper ~exp ~lhs ~rhs ~ext_loc =
   let pat= [%pat? ()][@metaloc ext_loc] in
   let lhs, rhs = mapper.expr mapper lhs, mapper.expr mapper rhs in
@@ -500,17 +465,17 @@ let mapper =
       default_loc := stri.pstr_loc;
       match stri with
       | [%stri let%lwt [%p? var] = [%e? exp]] ->
-        [%stri let [%p var] = Lwt_main.run [%e mapper.expr mapper exp]]
+        let warning =
+          str
+            ("let%lwt should not be used at the module item level.\n" ^
+             "Replace let%lwt x = e by let x = Lwt_main.run (e)")
+        in
+        [%stri
+          let [%p var] =
+            (Lwt_main.run [@ocaml.ppwarning [%e warning]])
+              [%e mapper.expr mapper exp]]
           [@metaloc !default_loc]
 
-      | {pstr_desc = Pstr_extension (({txt = "lwt"; _}, PStr [
-        {pstr_desc = Pstr_value (Recursive, _); _}]) as content, attrs); pstr_loc} ->
-        {stri with pstr_desc =
-          Pstr_extension (content, warn_let_lwt_rec pstr_loc attrs)}
-
-      | {pstr_desc = Pstr_extension (({txt = "lwt"; _}, PStr [
-        {pstr_desc = Pstr_value (Nonrecursive, vbs); _}]), _); _} ->
-        mapper.structure_item mapper (Str.value Nonrecursive (gen_top_binds vbs))
       | x -> default_mapper.structure_item mapper x);
 }
 

test/ppx_expect/cases/match_5.expect

@@ -1,2 +1,2 @@
-File "match_5.ml", line 2, characters 2-81:
+File "match_5.ml", line 3, characters 2-61:
 Error: match%lwt must contain at least one non-exception pattern.

test/ppx_expect/cases/match_5.ml

@@ -1,3 +1,3 @@
 let _ =
-  match%lwt Lwt.return () with
-  | exception (Invalid_argument _) -> Lwt.return 0
+  (* The ugly one-line match is for error message compatibility with 4.09. *)
+  match%lwt Lwt.return () with exception Exit -> Lwt.return 0

test/ppx_expect/cases/run_1.expect

@@ -0,0 +1,3 @@
+File "run_1.ml", line 2, characters 0-26:
+Warning 22: let%lwt should not be used at the module item level.
+Replace let%lwt x = e by let x = Lwt_main.run (e)

test/ppx_expect/cases/run_1.ml

@@ -0,0 +1,2 @@
+(* On one line for error message compatibility with 4.09. *)
+let%lwt () = Lwt.return ()

test/ppx_expect/cases/run_2.expect

@@ -0,0 +1,2 @@
+File "run_2.ml", line 1, characters 4-7:
+Error: Uninterpreted extension 'lwt'.

test/ppx_expect/cases/run_2.ml

@@ -0,0 +1,2 @@
+let%lwt rec () = Lwt.return ()
+and () = Lwt.return ()

test/ppx_expect/main.ml

@@ -51,26 +51,14 @@ let run_test name =
   let fixed_name = name ^ ".fixed" in
   let command =
     Printf.sprintf
-      "OCAMLPATH=%s ocamlfind c %s -linkpkg -package lwt,lwt_ppx %s > %s 2>&1"
-      package_directory "-color=never" ml_name fixed_name
+      "%s %s ocamlfind c %s -linkpkg -thread -package %s %s > %s 2>&1"
+      ("OCAMLPATH=" ^ package_directory) "OCAML_ERROR_STYLE=short"
+      "-color=never" "lwt.unix,lwt_ppx" ml_name fixed_name
   in
-  let ocaml_return_code = _run_int command in
-  begin if ocaml_return_code = 0 then
-    failwith
-      (Printf.sprintf "Unexpected compiler return code: %d" ocaml_return_code)
-  end;
+  ignore (_run_int command);
   diff expect_name fixed_name
 
 let () =
-  (* Don't run on 4.08, due to different error and warning output. *)
-  let ocaml_version =
-    Scanf.sscanf Sys.ocaml_version "%u.%u%[.]%[0-9]"
-      (fun major minor _periods patchlevel ->
-        major, minor, try Some (int_of_string patchlevel) with _ -> None)
-  in
-  if ocaml_version >= (4, 8, None) then
-    exit 0;
-
   let test_cases =
     Sys.readdir test_directory
     |> Array.to_list