Merge pull request #9669 from lpw25/fix-7538

Check for misplaced attributes on module aliases (Fix #7538)
ocaml · Sep 18, 2020 · 9f3472d · 9f3472d
2 parents b6b42f3 + 3c9ca39
commit 9f3472d
Show file tree

Hide file tree

Showing 4 changed files with 41 additions and 3 deletions.
diff --git a/Changes b/Changes
@@ -416,6 +416,9 @@ Working version
 
 ### Bug fixes:
 
+- #7538, #9669: Check for misplaced attributes on module aliases
+  (Leo White, report by Thomas Leonard, review by Florian Angeletti)
+
 - #7902, #9556: Type-checker infers recursive type, even though -rectypes is
   off.
   (Jacques Garrigue, report by Francois Pottier, review by Leo White)

diff --git a/lambda/translmod.ml b/lambda/translmod.ml
@@ -666,7 +666,11 @@ and transl_structure ~scopes loc fields cc rootpath final_env = function
               in
               Llet(pure_module mb.mb_expr, Pgenval, id, module_body, body), size
           end
-      | Tstr_module {mb_presence=Mp_absent} ->
+      | Tstr_module ({mb_presence=Mp_absent} as mb) ->
+          List.iter (Translattribute.check_attribute_on_module mb.mb_expr)
+            mb.mb_attributes;
+          List.iter (Translattribute.check_attribute_on_module mb.mb_expr)
+            mb.mb_expr.mod_attributes;
           transl_structure ~scopes loc fields cc rootpath final_env rem
       | Tstr_recmodule bindings ->
           let ext_fields =
@@ -1120,7 +1124,11 @@ let transl_store_structure ~scopes glob map prims aliases str =
                            transl_store ~scopes rootpath
                              (add_ident true id subst)
                              cont rem))
-        | Tstr_module {mb_presence=Mp_absent} ->
+        | Tstr_module ({mb_presence=Mp_absent} as mb) ->
+            List.iter (Translattribute.check_attribute_on_module mb.mb_expr)
+              mb.mb_attributes;
+            List.iter (Translattribute.check_attribute_on_module mb.mb_expr)
+              mb.mb_expr.mod_attributes;
             transl_store ~scopes rootpath subst cont rem
         | Tstr_recmodule bindings ->
             let ids = List.filter_map (fun mb -> mb.mb_id) bindings in
@@ -1539,8 +1547,13 @@ let transl_toplevel_item ~scopes item =
                transl_module ~scopes Tcoerce_none None od.open_expr,
                set_idents 0 ids)
       end
+  | Tstr_module ({mb_presence=Mp_absent} as mb) ->
+      List.iter (Translattribute.check_attribute_on_module mb.mb_expr)
+        mb.mb_attributes;
+      List.iter (Translattribute.check_attribute_on_module mb.mb_expr)
+        mb.mb_expr.mod_attributes;
+      lambda_unit
   | Tstr_modtype _
-  | Tstr_module {mb_presence=Mp_absent}
   | Tstr_type _
   | Tstr_class_type _
   | Tstr_attribute _ ->

diff --git a/testsuite/tests/warnings/w53.compilers.reference b/testsuite/tests/warnings/w53.compilers.reference
@@ -50,3 +50,19 @@ File "w53.ml", line 41, characters 17-29:
 41 | module G' = (A [@ocaml.inline])(struct end) (* rejected *)
                       ^^^^^^^^^^^^
 Warning 53 [misplaced-attribute]: the "ocaml.inline" attribute cannot appear in this context
+File "w53.ml", line 45, characters 22-29:
+45 | module I = Set.Make [@inlined]
+                           ^^^^^^^
+Warning 53 [misplaced-attribute]: the "inlined" attribute cannot appear in this context
+File "w53.ml", line 46, characters 23-36:
+46 | module I' = Set.Make [@ocaml.inlined]
+                            ^^^^^^^^^^^^^
+Warning 53 [misplaced-attribute]: the "ocaml.inlined" attribute cannot appear in this context
+File "w53.ml", line 48, characters 23-30:
+48 | module J = Set.Make [@@inlined]
+                            ^^^^^^^
+Warning 53 [misplaced-attribute]: the "inlined" attribute cannot appear in this context
+File "w53.ml", line 49, characters 24-37:
+49 | module J' = Set.Make [@@ocaml.inlined]
+                             ^^^^^^^^^^^^^
+Warning 53 [misplaced-attribute]: the "ocaml.inlined" attribute cannot appear in this context
diff --git a/testsuite/tests/warnings/w53.ml b/testsuite/tests/warnings/w53.ml
@@ -41,3 +41,9 @@ module G = (A [@inline])(struct end) (* rejected *)
 module G' = (A [@ocaml.inline])(struct end) (* rejected *)
 
 module H = Set.Make [@inlined] (Int32) (* GPR#1808 *)
+
+module I = Set.Make [@inlined]
+module I' = Set.Make [@ocaml.inlined]
+
+module J = Set.Make [@@inlined]
+module J' = Set.Make [@@ocaml.inlined]