Fix async context checking for module await.

CHANGELOG.md

@@ -16,6 +16,10 @@
 
 - Allow single newline in JSX. https://github.com/rescript-lang/rescript/pull/7269
 
+#### :bug: Bug fix
+
+- Fix async context checking for module await. https://github.com/rescript-lang/rescript/pull/7271
+
 # 12.0.0-alpha.8
 
 #### :bug: Bug fix

compiler/frontend/ast_attributes.ml

@@ -142,7 +142,7 @@ let is_inline : attr -> bool = fun ({txt}, _) -> txt = "inline"
 
 let has_inline_payload (attrs : t) = Ext_list.find_first attrs is_inline
 
-let has_await_payload (attrs : t) = Ext_list.find_first attrs Ast_await.is_await
+let has_await_payload (attrs : t) = Ext_list.exists attrs Ast_await.is_await
 
 type derive_attr = {bs_deriving: Ast_payload.action list option} [@@unboxed]
 

compiler/frontend/ast_attributes.mli

@@ -35,7 +35,7 @@ val process_attributes_rev : t -> attr_kind * t
 
 val has_inline_payload : t -> attr option
 
-val has_await_payload : t -> attr option
+val has_await_payload : t -> bool
 
 type derive_attr = {bs_deriving: Ast_payload.action list option} [@@unboxed]
 

compiler/frontend/bs_builtin_ppx.ml

@@ -196,11 +196,13 @@ let expr_mapper ~async_context ~in_function_def (self : mapper)
         ({
            pmod_desc =
              Pmod_constraint
-               ({pmod_desc = Pmod_ident _}, {pmty_desc = Pmty_ident mtyp_lid});
-           pmod_attributes;
+               ( {pmod_desc = Pmod_ident _; pmod_attributes = attrs1},
+                 {pmty_desc = Pmty_ident mtyp_lid} );
+           pmod_attributes = attrs2;
          } as me),
         expr )
-    when Res_parsetree_viewer.has_await_attribute pmod_attributes ->
+    when Res_parsetree_viewer.has_await_attribute attrs1
+         || Res_parsetree_viewer.has_await_attribute attrs2 ->
     {
       e with
       pexp_desc =
@@ -217,29 +219,33 @@ let expr_mapper ~async_context ~in_function_def (self : mapper)
   let async_saved = !async_context in
   let result = expr_mapper ~async_context ~in_function_def self e in
   async_context := async_saved;
-  let is_module, has_await =
-    match e.pexp_desc with
-    | Pexp_letmodule (_, {pmod_desc = Pmod_ident _; pmod_attributes}, _)
-    | Pexp_letmodule
-        ( _,
-          {
-            pmod_desc =
-              Pmod_constraint
-                ({pmod_desc = Pmod_ident _}, {pmty_desc = Pmty_ident _});
-            pmod_attributes;
-          },
-          _ ) ->
-      (true, Ast_attributes.has_await_payload pmod_attributes)
-    | _ -> (false, Ast_attributes.has_await_payload e.pexp_attributes)
-  in
-  match has_await with
-  | None -> result
-  | Some _ ->
+  let check_await () =
     if !async_context = false then
       Location.raise_errorf ~loc:e.pexp_loc
-        "Await on expression not in an async context";
-    if is_module = false then Ast_await.create_await_expression result
-    else result
+        "Await on expression not in an async context"
+  in
+  match e.pexp_desc with
+  | Pexp_letmodule (_, {pmod_desc = Pmod_ident _; pmod_attributes}, _)
+    when Ast_attributes.has_await_payload pmod_attributes ->
+    check_await ();
+    result
+  | Pexp_letmodule
+      ( _,
+        {
+          pmod_desc =
+            Pmod_constraint
+              ({pmod_desc = Pmod_ident _; pmod_attributes = attrs1}, _);
+          pmod_attributes = attrs2;
+        },
+        _ )
+    when Ast_attributes.has_await_payload attrs1
+         || Ast_attributes.has_await_payload attrs2 ->
+    check_await ();
+    result
+  | _ when Ast_attributes.has_await_payload e.pexp_attributes ->
+    check_await ();
+    Ast_await.create_await_expression result
+  | _ -> result
 
 let typ_mapper (self : mapper) (typ : Parsetree.core_type) =
   Ast_core_type_class_type.typ_mapper self typ

compiler/syntax/src/res_core.ml

@@ -5873,12 +5873,7 @@ and parse_module_expr p =
     | _ -> (false, mk_loc start_pos start_pos)
   in
   let attrs = parse_attributes p in
-  let attrs =
-    if has_await then
-      (({txt = "res.await"; loc = loc_await}, PStr []) : Parsetree.attribute)
-      :: attrs
-    else attrs
-  in
+  let attrs = if has_await then make_await_attr loc_await :: attrs else attrs in
   let mod_expr =
     if is_es6_arrow_functor p then parse_functor_module_expr p
     else parse_primary_mod_expr p

tests/build_tests/super_errors/expected/ModuleAwait.res.expected

@@ -0,0 +1,11 @@
+
+  We've found a bug for you!
+  /.../fixtures/ModuleAwait.res:2:3-3:11
+
+  1 │ let f0 = () => {
+  2 │   module O: module type of Belt.Option = await Belt.Option
+  3 │   O.forEach
+  4 │ }
+  5 │ 
+
+  Await on expression not in an async context

tests/build_tests/super_errors/fixtures/ModuleAwait.res

@@ -0,0 +1,4 @@
+let f0 = () => {
+  module O: module type of Belt.Option = await Belt.Option
+  O.forEach
+}

tests/tests/src/async_await.mjs

@@ -34,6 +34,14 @@ async function f(value) {
   return await Promise.resolve(1);
 }
 
+async function f0() {
+  return (await import("rescript/lib/es6/Belt_Option.js")).forEach;
+}
+
+async function f1() {
+  return (await import("rescript/lib/es6/Belt_Option.js")).forEach;
+}
+
 export {
   next,
   useNext,
@@ -43,5 +51,7 @@ export {
   toplevelAwait,
   toplevelAwait2,
   f,
+  f0,
+  f1,
 }
 /* toplevelAwait Not a pure module */

tests/tests/src/async_await.res

@@ -18,3 +18,15 @@ let toplevelAwait2 = arr[await topFoo()]
 let f = async (type input, value: input) => {
   await Js.Promise.resolve(1)
 }
+
+module type MT = module type of Belt.Option
+
+let f0 = async () => {
+  module O = await Belt.Option
+  O.forEach
+}
+
+let f1 = async () => {
+  module O: MT = await Belt.Option
+  O.forEach
+}