diff --git a/CHANGES.md b/CHANGES.md index a51c53db534..1b950ddd528 100644 --- a/CHANGES.md +++ b/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) ------------------ diff --git a/src/dune_lang/t.ml b/src/dune_lang/t.ml index e43193035a3..6ebcf5d81ba 100644 --- a/src/dune_lang/t.ml +++ b/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 = diff --git a/src/dune_rules/colors.ml b/src/dune_rules/colors.ml index ea7315ed758..d378b9280c7 100644 --- a/src/dune_rules/colors.ml +++ b/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 + })