fix(ocamlc_loc): parse alerts

correctly parse alerts and add a new severity kind

Signed-off-by: Rudi Grinberg <me@rgrinberg.com>

ps-id: 4ec7db6f-4026-4936-991c-fcfc4d535ba2

CHANGES.md

@@ -1,6 +1,9 @@
 Unreleased
 ----------
 
+- Fix the parsing of alerts. They will now show up in diagnostics correctly.
+  (#6678, @rginberg)
+
 - Fix the compilation of modules generated at link time when
   `implicit_transitive_deps` is enabled (#6642, @rgrinberg)
 

otherlibs/ocamlc_loc/src/lexer.mli

@@ -14,6 +14,10 @@ type source =
 type severity =
   | Error of source option
   | Warning of source
+  | Alert of
+      { name : string
+      ; source : string
+      }
 
 type loc =
   { chars : (int * int) option

otherlibs/ocamlc_loc/src/lexer.mll

@@ -13,6 +13,7 @@
   type severity =
     | Error of source option
     | Warning of source
+    | Alert of { name : string ; source : string }
 
   type loc =
     { chars : (int * int) option
@@ -45,6 +46,8 @@ let range = digits "-" digits
 
 let any = _ *
 
+let alert_name = ['a' - 'z'] ['A' - 'Z' 'a' - 'z' '0' - '9' '_']*
+
 rule skip_excerpt = parse
   | blank digits " | " [^ '\n']* "\n"?
     { `Continue }
@@ -66,9 +69,12 @@ and severity = parse
     (blank any as rest)
     { Some (Error (Some (Code { code = int_of_string code ; name })), rest)
     }
+    | "Alert " blank (alert_name as name) ":" (any as source)
+    {  Some (Alert { name ; source }, "")
+    }
   | (("Error" | "Warning") as kind) " (alert " ([^ ')']+ as alert) "):"
     (blank any as rest)
-    { let alert = Alert alert in
+    { let alert : source = Alert alert in
       let res =
         match kind with
         | "Error" -> Error (Some alert)

otherlibs/ocamlc_loc/src/ocamlc_loc.ml

@@ -19,6 +19,9 @@ let dyn_of_severity =
   function
   | Error w -> variant "Error" [ option dyn_of_source w ]
   | Warning w -> variant "Warning" [ dyn_of_source w ]
+  | Alert { name; source } ->
+    variant "Alert"
+      [ record [ ("name", string name); ("source", string source) ] ]
 
 let dyn_of_loc { path; lines; chars } =
   let open Dyn in
@@ -86,6 +89,8 @@ end
 let indent_of_severity = function
   | Error _ -> String.length "Error: "
   | Warning _ -> String.length "Warning: "
+  | Alert { name; source } ->
+    String.length "Alert :" + String.length name + String.length source + 1
 
 let severity tokens =
   match Tokens.peek tokens with

otherlibs/ocamlc_loc/src/ocamlc_loc.mli

@@ -21,6 +21,10 @@ type loc =
 type severity =
   | Error of source option
   | Warning of source
+  | Alert of
+      { name : string
+      ; source : string
+      }
 
 type report =
   { loc : loc

otherlibs/ocamlc_loc/test/ocamlc_loc_tests.ml

@@ -400,7 +400,14 @@ File "foo.ml", line 8, characters 9-12:
 Alert deprecated: A.f
 foo
   |};
-  [%expect {||}];
+  [%expect
+    {|
+    >> error 0
+    { loc = { path = "foo.ml"; line = Single 8; chars = Some (9, 12) }
+    ; message = "foo"
+    ; related = []
+    ; severity = Alert { name = "deprecated"; source = " A.f" }
+    } |}];
   test_error
     {|
 File "foo.ml", line 8, characters 9-12:
@@ -409,4 +416,11 @@ File "foo.ml", line 8, characters 9-12:
 Alert foobar: A.f
 blah
 |};
-  [%expect {||}]
+  [%expect
+    {|
+    >> error 0
+    { loc = { path = "foo.ml"; line = Single 8; chars = Some (9, 12) }
+    ; message = "blah"
+    ; related = []
+    ; severity = Alert { name = "foobar"; source = " A.f" }
+    } |}]