Warn on unhandled internal tags

It was possible to attach those tags to anything and would be ignored if
unecessary.
This emits a warning in this case.

Author: Julow

src/model/error.ml

@@ -79,6 +79,8 @@ let raised_warnings = ref []
 let raise_warnings' warnings =
   raised_warnings := List.rev_append warnings !raised_warnings
 
+let raise_warning t = raised_warnings := t :: !raised_warnings
+
 let raise_warnings with_warnings =
   raise_warnings' with_warnings.warnings;
   with_warnings.value

src/model/error.mli

@@ -33,6 +33,9 @@ val accumulate_warnings : (warning_accumulator -> 'a) -> 'a with_warnings
 
 val warning : warning_accumulator -> t -> unit
 
+val raise_warning : t -> unit
+(** Raise a warning that need to be caught with [catch_warnings]. *)
+
 val raise_warnings : 'a with_warnings -> 'a
 (** Accumulate warnings into a global variable. See [catch_warnings]. *)
 

src/model/semantics.ml

@@ -15,10 +15,26 @@ type _ handle_internal_tags =
       : [ `Dot of Paths.Path.Module.t * string ] option handle_internal_tags
   | Expect_none : unit handle_internal_tags
 
+let describe_internal_tag = function
+  | `Canonical _ -> "@canonical"
+  | `Inline -> "@inline"
+  | `Open -> "@open"
+  | `Closed -> "@closed"
+
+let unexpected_tag { Location.value; location } =
+  Error.raise_warning
+  @@ Error.make "Unexpected tag '%s' at this location."
+       (describe_internal_tag value)
+       location
+
 let rec find_tag f = function
   | [] -> None
   | hd :: tl -> (
-      match f hd.Location.value with Some _ as x -> x | None -> find_tag f tl)
+      match f hd.Location.value with
+      | Some _ as x -> x
+      | None ->
+          unexpected_tag hd;
+          find_tag f tl)
 
 let handle_internal_tags (type a) tags : a handle_internal_tags -> a = function
   | Expect_status -> (
@@ -31,7 +47,10 @@ let handle_internal_tags (type a) tags : a handle_internal_tags -> a = function
       | None -> `Default)
   | Expect_canonical ->
       find_tag (function `Canonical (`Dot _ as p) -> Some p | _ -> None) tags
-  | Expect_none -> ()
+  | Expect_none ->
+      (* Will raise warnings. *)
+      ignore (find_tag (fun _ -> None) tags);
+      ()
 
 (* Errors *)
 let invalid_raw_markup_target : string -> Location.span -> Error.t =

test/model/test.ml

@@ -6981,32 +6981,27 @@ let%expect_test _ =
 
     let canonical_something =
       test "@canonical Foo";
-      [%expect
-        {|
+      [%expect {|
         { "value": [], "warnings": [] } |}]
 
     let canonical_module =
       test "@canonical module-Foo";
-      [%expect
-        {|
+      [%expect {|
         { "value": [], "warnings": [] } |}]
 
     let canonical_path =
       test "@canonical Foo.Bar";
-      [%expect
-        {|
+      [%expect {|
         { "value": [], "warnings": [] } |}]
 
     let canonical_val =
       test "@canonical val-foo";
-      [%expect
-        {|
+      [%expect {|
         { "value": [], "warnings": [] } |}]
 
     let canonical_bad_parent =
       test "@canonical bar.page-foo";
-      [%expect
-        {|
+      [%expect {|
         { "value": [], "warnings": [] } |}]
 
     let canonical_empty_component =

test/xref2/canonical_unit.t/run.t

@@ -4,6 +4,8 @@ top-comment.
 The module Test__X is expected to be referenced through Test.X.
 
   $ compile test__x.mli test.ml
+  File "test.ml", line 15, characters 6-24:
+  Unexpected tag '@canonical' at this location.
 
 Test__x has a 'canonical' field:
 

test/xref2/module_preamble.t/run.t

@@ -13,6 +13,8 @@ and that "hidden" modules (eg. `A__b`, rendered to `html/A__b`) are not rendered
 
   $ odoc compile --pkg test -o a__b.odoc -I . a__b.cmti
   $ odoc compile --pkg test -o a.odoc -I . a.cmti
+  File "a.mli", line 4, characters 4-17:
+  Unexpected tag '@canonical' at this location.
 
   $ odoc link -I . a__b.odoc
   $ odoc link -I . a.odoc

test/xref2/ocaml_stdlib.t/run.t

@@ -9,6 +9,8 @@ Imitate the way the stdlib is built and how its documentation should be built.
   [1]
 
   $ odoc compile --pkg ocaml -o main.odoc main.cmti -I .
+  File "main.mli", line 3, characters 4-17:
+  Unexpected tag '@canonical' at this location.
   $ odoc compile --pkg ocaml -o main__x.odoc main__x.cmti -I .
 
   $ odoc html --indent -o html main__x.odoc -I .