[2.9] Compatibility with OCaml 5.0

CHANGES.md

@@ -4,6 +4,8 @@ Unreleased
 - No longer reference deprecated Toploop functions when using dune files in
   OCaml syntax. (#4834, fixes #4830, @nojb)
 
+- Use the stag format API to be compatible with OCaml 5.0 (#5351, @emillon).
+
 2.9.1 (07/09/2021)
 ------------------
 

src/dune_lang/t.ml

@@ -77,32 +77,30 @@ module Deprecated = struct
     let state = ref [] in
     Format.pp_set_mark_tags ppf true;
     let ofuncs = Format.pp_get_formatter_out_functions ppf () in
-    let tfuncs =
-      (Format.pp_get_formatter_tag_functions ppf () [@warning "-3"])
-    in
-    Format.pp_set_formatter_tag_functions ppf
+    let tfuncs = Format.pp_get_formatter_stag_functions ppf () in
+    Format.pp_set_formatter_stag_functions ppf
       { tfuncs with
-        mark_open_tag =
+        mark_open_stag =
           (function
-          | "atom" ->
+          | Format.String_tag "atom" ->
             state := In_atom :: !state;
             ""
-          | "makefile-action" ->
+          | Format.String_tag "makefile-action" ->
             state := In_makefile_action :: !state;
             ""
-          | "makefile-stuff" ->
+          | Format.String_tag "makefile-stuff" ->
             state := In_makefile_stuff :: !state;
             ""
-          | s -> tfuncs.mark_open_tag s)
-      ; mark_close_tag =
+          | s -> tfuncs.mark_open_stag s)
+      ; mark_close_stag =
           (function
-          | "atom"
-          | "makefile-action"
-          | "makefile-stuff" ->
+          | Format.String_tag "atom"
+          | Format.String_tag "makefile-action"
+          | Format.String_tag "makefile-stuff" ->
             state := List.tl !state;
             ""
-          | s -> tfuncs.mark_close_tag s)
-      } [@warning "-3"];
+          | s -> tfuncs.mark_close_stag s)
+      };
     Format.pp_set_formatter_out_functions ppf
       { ofuncs with
         out_newline =

src/dune_rules/colors.ml

@@ -33,23 +33,25 @@ module Style = struct
     | _ -> None
 end
 
-let mark_open_tag s =
-  match Style.of_string s with
-  | Some style -> Ansi_color.Style.escape_sequence (Style.to_styles style)
-  | None ->
-    if s <> "" && s.[0] = '\027' then
-      s
-    else
-      ""
+let mark_open_stag = function
+  | Format.String_tag s -> (
+    match Style.of_string s with
+    | Some style -> Ansi_color.Style.escape_sequence (Style.to_styles style)
+    | None ->
+      if s <> "" && s.[0] = '\027' then
+        s
+      else
+        "")
+  | _ -> ""
 
 let setup_err_formatter_colors () =
   let open Format in
   if Lazy.force Ansi_color.stderr_supports_color then
     List.iter [ err_formatter; Dune_util.Report_error.ppf ] ~f:(fun ppf ->
-        let funcs = (pp_get_formatter_tag_functions ppf () [@warning "-3"]) in
+        let funcs = pp_get_formatter_stag_functions ppf () in
         pp_set_mark_tags ppf true;
-        pp_set_formatter_tag_functions ppf
+        pp_set_formatter_stag_functions ppf
           { funcs with
-            mark_close_tag = (fun _ -> Ansi_color.Style.escape_sequence [])
-          ; mark_open_tag
-          } [@warning "-3"])
+            mark_close_stag = (fun _ -> Ansi_color.Style.escape_sequence [])
+          ; mark_open_stag
+          })