Run "misplaced attributes" check when compiling mlis (ocaml#72)

driver/compile_common.ml

@@ -69,6 +69,7 @@ let typecheck_intf info ast =
           sg);
   ignore (Includemod.signatures info.env ~mark:Mark_both sg sg);
   Typecore.force_delayed_checks ();
+  Builtin_attributes.warn_unused ();
   Warnings.check_fatal ();
   tsg
 

parsing/builtin_attributes.ml

@@ -200,13 +200,13 @@ let alert_attr x =
 let alert_attrs l =
   List.filter_map alert_attr l
 
-let mark_alerts_used l =
-  List.iter (fun a ->
-    match a.attr_name.txt with
-    | "ocaml.deprecated"|"deprecated"|"ocaml.alert"|"alert" ->
-      mark_used a.attr_name
-    | _ -> ())
-    l
+let mark_alert_used a =
+  match a.attr_name.txt with
+  | "ocaml.deprecated"|"deprecated"|"ocaml.alert"|"alert" ->
+    mark_used a.attr_name
+  | _ -> ()
+
+let mark_alerts_used l = List.iter mark_alert_used l
 
 let mark_warn_on_literal_pattern_used l =
   List.iter (fun a ->

parsing/builtin_attributes.mli

@@ -49,6 +49,7 @@ val mk_internal:
 (** Marks alert attributes used for the purposes of misplaced attribute
     warnings.  Call this when moving things with alert attributes into the
     environment. *)
+val mark_alert_used : Parsetree.attribute -> unit
 val mark_alerts_used : Parsetree.attributes -> unit
 
 (** Marks "warn_on_literal_pattern" attributes used for the purposes of

stdlib/obj.mli

@@ -28,7 +28,7 @@ type raw_data = nativeint  (* @since 4.12 *)
 external repr : 'a -> t = "%identity"
 external obj : t -> 'a = "%identity"
 external magic : 'a -> 'b = "%obj_magic"
-val [@inline always] is_block : t -> bool
+val is_block : t -> bool
 external is_int : t -> bool = "%obj_is_int"
 external tag : t -> int = "caml_obj_tag" [@@noalloc]
 val size : t -> int
@@ -57,8 +57,8 @@ val field : t -> int -> t
 *)
 val set_field : t -> int -> t -> unit
 
-val [@inline always] double_field : t -> int -> float  (* @since 3.11.2 *)
-val [@inline always] set_double_field : t -> int -> float -> unit
+val double_field : t -> int -> float  (* @since 3.11.2 *)
+val set_double_field : t -> int -> float -> unit
   (* @since 3.11.2 *)
 
 external raw_field : t -> int -> raw_data = "caml_obj_raw_field"
@@ -111,14 +111,14 @@ module Extension_constructor :
 sig
   type t = extension_constructor
   val of_val : 'a -> t
-  val [@inline always] name : t -> string
-  val [@inline always] id : t -> int
+  val name : t -> string
+  val id : t -> int
 end
 val extension_constructor : 'a -> extension_constructor
   [@@ocaml.deprecated "use Obj.Extension_constructor.of_val"]
-val [@inline always] extension_name : extension_constructor -> string
+val extension_name : extension_constructor -> string
   [@@ocaml.deprecated "use Obj.Extension_constructor.name"]
-val [@inline always] extension_id : extension_constructor -> int
+val extension_id : extension_constructor -> int
   [@@ocaml.deprecated "use Obj.Extension_constructor.id"]
 
 module Ephemeron: sig

testsuite/tests/warnings/w53.compilers.reference

@@ -86,10 +86,6 @@ File "w53.ml", line 52, characters 17-27:
 52 |   val a1 : int [@deprecated]   (* rejected *)
                       ^^^^^^^^^^
 Warning 53 [misplaced-attribute]: the "deprecated" attribute cannot appear in this context
-File "w53.ml", line 54, characters 19-29:
-54 |   val a3 : int [@@@deprecated] (* rejected *)
-                        ^^^^^^^^^^
-Warning 53 [misplaced-attribute]: the "deprecated" attribute cannot appear in this context
 File "w53.ml", line 57, characters 6-14:
 57 | let [@unrolled 42] rec test_unrolled x = (* rejected *)
            ^^^^^^^^
@@ -106,14 +102,14 @@ File "w53.ml", line 75, characters 14-25:
 75 |   type t4 [@@@immediate64] (* rejected *)
                    ^^^^^^^^^^^
 Warning 53 [misplaced-attribute]: the "immediate64" attribute cannot appear in this context
-File "w53.ml", line 79, characters 15-24:
-79 |   let x = (4 [@immediate], 42 [@immediate64]) (* rejected *)
-                    ^^^^^^^^^
-Warning 53 [misplaced-attribute]: the "immediate" attribute cannot appear in this context
 File "w53.ml", line 79, characters 32-43:
 79 |   let x = (4 [@immediate], 42 [@immediate64]) (* rejected *)
                                      ^^^^^^^^^^^
 Warning 53 [misplaced-attribute]: the "immediate64" attribute cannot appear in this context
+File "w53.ml", line 79, characters 15-24:
+79 |   let x = (4 [@immediate], 42 [@immediate64]) (* rejected *)
+                    ^^^^^^^^^
+Warning 53 [misplaced-attribute]: the "immediate" attribute cannot appear in this context
 File "w53.ml", line 84, characters 26-31:
 84 |   type t2 = {x : int} [@@@boxed]   (* rejected *)
                                ^^^^^
@@ -126,14 +122,14 @@ File "w53.ml", line 87, characters 17-24:
 87 |   val x : int [@@unboxed]          (* rejected *)
                       ^^^^^^^
 Warning 53 [misplaced-attribute]: the "unboxed" attribute cannot appear in this context
-File "w53.ml", line 91, characters 15-22:
-91 |   let x = (5 [@unboxed], 42 [@boxed]) (* rejected *)
-                    ^^^^^^^
-Warning 53 [misplaced-attribute]: the "unboxed" attribute cannot appear in this context
 File "w53.ml", line 91, characters 30-35:
 91 |   let x = (5 [@unboxed], 42 [@boxed]) (* rejected *)
                                    ^^^^^
 Warning 53 [misplaced-attribute]: the "boxed" attribute cannot appear in this context
+File "w53.ml", line 91, characters 15-22:
+91 |   let x = (5 [@unboxed], 42 [@boxed]) (* rejected *)
+                    ^^^^^^^
+Warning 53 [misplaced-attribute]: the "unboxed" attribute cannot appear in this context
 File "w53.ml", line 95, characters 21-30:
 95 |   type 'a t1 = 'a [@@principal] (* rejected *)
                           ^^^^^^^^^

testsuite/tests/warnings/w53.ml

@@ -51,7 +51,7 @@ module J' = Set.Make [@@ocaml.inlined]
 module type K = sig
   val a1 : int [@deprecated]   (* rejected *)
   val a2 : int [@@deprecated]  (* accepted *)
-  val a3 : int [@@@deprecated] (* rejected *)
+  [@@@deprecated] (* accepted*)
 end
 
 let [@unrolled 42] rec test_unrolled x = (* rejected *)

testsuite/tests/warnings/w53_mli.compilers.reference

@@ -0,0 +1,4 @@
+File "w53_mli.mli", line 14, characters 15-25:
+14 | val a1 : int [@deprecated]   (* rejected *)
+                    ^^^^^^^^^^
+Warning 53 [misplaced-attribute]: the "deprecated" attribute cannot appear in this context

testsuite/tests/warnings/w53_mli.mli

@@ -0,0 +1,16 @@
+(* TEST
+
+flags = "-w +A-60-70"
+
+* setup-ocamlc.byte-build-env
+** ocamlc.byte
+compile_only = "true"
+*** check-ocamlc.byte-output
+
+*)
+
+(* Just ensure that we're running the check on mli files too *)
+
+val a1 : int [@deprecated]   (* rejected *)
+val a2 : int [@@deprecated]  (* accepted *)
+

typing/typemod.ml

@@ -1756,6 +1756,7 @@ and transl_signature env (sg : Parsetree.signature) =
         typedtree, tsg, newenv
     | Psig_attribute attr ->
         Builtin_attributes.parse_standard_interface_attributes attr;
+        Builtin_attributes.mark_alert_used attr;
         mksig (Tsig_attribute attr) env loc, [], env
     | Psig_extension (ext, _attrs) ->
         raise (Error_forward (Builtin_attributes.error_of_extension ext))
@@ -2890,6 +2891,7 @@ and type_structure ?(toplevel = None) funct_body anchor env sstr =
         raise (Error_forward (Builtin_attributes.error_of_extension ext))
     | Pstr_attribute attr ->
         Builtin_attributes.parse_standard_implementation_attributes attr;
+        Builtin_attributes.mark_alert_used attr;
         Tstr_attribute attr, [], shape_map, env
   in
   let toplevel_sig = Option.value toplevel ~default:[] in