Fix async context checking for module await.

The check was not firing for `module M: ModTyp` as it was looking for attributes in the wrong place.

Author: cristianoc

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

@@ -217,29 +217,27 @@ 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}, _)
+ | Pexp_letmodule
+ ( _,
+ {
+ pmod_desc =
+ Pmod_constraint ({pmod_desc = Pmod_ident _; pmod_attributes}, _);
+ },
+ _ )
+ when Ast_attributes.has_await_payload pmod_attributes ->
+ 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
+}