Fix

Author: cknitt

compiler/ml/typemod.ml

@@ -870,9 +870,10 @@ and transl_signature env sg =
         let trem, rem, final_env = transl_sig newenv srem in
         (mksig (Tsig_include incl) env loc :: trem, sg @ rem, final_env)
       | Psig_attribute x ->
-        Builtin_attributes.warning_attribute x;
-        let trem, rem, final_env = transl_sig env srem in
-        (mksig (Tsig_attribute x) env loc :: trem, rem, final_env)
+        Builtin_attributes.warning_scope ~ppwarning:false
+          ~report_attribute_errors:false [x] (fun () ->
+            let trem, rem, final_env = transl_sig env srem in
+            (mksig (Tsig_attribute x) env loc :: trem, rem, final_env))
       | Psig_extension (ext, _attrs) ->
         raise (Error_forward (Builtin_attributes.error_of_extension ext)))
   in
@@ -1590,14 +1591,24 @@ and type_structure ?(toplevel = false) funct_body anchor env sstr scope =
       (Tstr_include incl, sg, new_env)
     | Pstr_extension (ext, _attrs) ->
       raise (Error_forward (Builtin_attributes.error_of_extension ext))
-    | Pstr_attribute x ->
-      Builtin_attributes.warning_attribute x;
-      (Tstr_attribute x, [], env)
+    | Pstr_attribute x -> (Tstr_attribute x, [], env)
   in
   let rec type_struct env sstr =
     Ctype.init_def (Ident.current_time ());
     match sstr with
     | [] -> ([], [], env)
+    | {pstr_desc = Pstr_attribute x; pstr_loc; _} :: srem ->
+      let previous_saved_types = Cmt_format.get_saved_types () in
+      let str =
+        {str_desc = Tstr_attribute x; str_loc = pstr_loc; str_env = env}
+      in
+      Cmt_format.set_saved_types
+        (Cmt_format.Partial_structure_item str :: previous_saved_types);
+      let str_rem, sig_rem, final_env =
+        Builtin_attributes.warning_scope ~ppwarning:false
+          ~report_attribute_errors:false [x] (fun () -> type_struct env srem)
+      in
+      (str :: str_rem, sig_rem, final_env)
     | pstr :: srem ->
       let previous_saved_types = Cmt_format.get_saved_types () in
       let desc, sg, new_env = type_str_item env srem pstr in

tests/build_tests/super_errors/expected/malformed_warning_attribute.res.expected

@@ -0,0 +1,10 @@
+
+  Warning number 47
+  /.../fixtures/malformed_warning_attribute.res:1:1-9
+
+  1 │ @@warning(123)
+  2 │ 
+  3 │ let x = 1
+
+  illegal payload for attribute 'warning'.
+A single string literal is expected

tests/build_tests/super_errors/expected/ppwarning_structure_attribute.res.expected

@@ -0,0 +1,9 @@
+
+  Warning number 22
+  /.../fixtures/ppwarning_structure_attribute.res:1:13-19
+
+  1 │ @@ppwarning("hello")
+  2 │ 
+  3 │ let x = 1
+
+  hello

tests/build_tests/super_errors/expected/warning102_expr_attribute.res.expected

@@ -1 +0,0 @@
-

tests/build_tests/super_errors/expected/warning102_nullish_equality.res.expected

@@ -1 +0,0 @@
-

tests/build_tests/super_errors/expected/warning102_polymorphic_equality.res.expected

@@ -0,0 +1,8 @@
+
+  Warning number 102
+  /.../fixtures/warning102_polymorphic_equality.res:1:19-24
+
+  1 │ let f = (a, b) => a == b
+  2 │ 
+
+  Polymorphic comparison introduced (maybe unsafe)

tests/build_tests/super_errors/expected/warning102_structure_attribute.res.expected

@@ -1 +0,0 @@
-

tests/build_tests/super_errors/expected/warning102_value_attribute.res.expected

@@ -1 +0,0 @@
-

tests/build_tests/super_errors/fixtures/malformed_warning_attribute.res

@@ -0,0 +1,3 @@
+@@warning(123)
+
+let x = 1

tests/build_tests/super_errors/fixtures/ppwarning_structure_attribute.res

@@ -0,0 +1,3 @@
+@@ppwarning("hello")
+
+let x = 1