From c9a7d99ab052ecab4b90f76853c95bf6568e88a5 Mon Sep 17 00:00:00 2001
From: Julien Girard <julien.girard2@cea.fr>
Date: Thu, 1 Jun 2023 11:30:28 +0200
Subject: [PATCH] [tests] added support for future multiple logging categories
---
src/logging.ml | 6 +++---
src/logging.mli | 2 +-
src/main.ml | 8 ++++----
3 files changed, 8 insertions(+), 8 deletions(-)
diff --git a/src/logging.ml b/src/logging.ml
index 8767bc0..ebe3f2d 100644
--- a/src/logging.ml
+++ b/src/logging.ml
@@ -55,12 +55,12 @@ let pp_header =
let specification_enabled = ref false
-let setup_log level category =
+let setup_log level categories =
Fmt_tty.setup_std_outputs ~style_renderer:`Ansi_tty ();
Logs.set_level level;
let () =
- match category with
- | Some Category.Specification -> specification_enabled := true
+ match categories with
+ | Some [ Category.Specification ] -> specification_enabled := true
| _ -> ()
in
Logs.set_reporter (Logs_fmt.reporter ~pp_header ())
diff --git a/src/logging.mli b/src/logging.mli
index 208bf4d..04be938 100644
--- a/src/logging.mli
+++ b/src/logging.mli
@@ -30,4 +30,4 @@ end
val specification_enabled : bool ref
val spec_tag : unit -> Logs.Tag.set
-val setup_log : Logs.level option -> Category.t option -> unit
+val setup_log : Logs.level option -> Category.t list option -> unit
diff --git a/src/main.ml b/src/main.ml
index e523d83..e82a636 100644
--- a/src/main.ml
+++ b/src/main.ml
@@ -36,24 +36,24 @@ let () =
(* -- Logs. *)
-let log_category =
+let log_categories =
let all_categories = Logging.Category.list_available () in
let doc =
Fmt.str "Logging categories. Available are $(docv)s: %a."
(Fmt.list ~sep:Fmt.comma Fmt.string)
(List.map ~f:Logging.Category.to_string all_categories)
in
- let log_categories =
+ let enum_log_categories =
Arg.enum
(List.map ~f:(fun c -> (Logging.Category.to_string c, c)) all_categories)
in
Arg.(
value
- & opt (some log_categories) None
+ & opt (some (list enum_log_categories)) None
& info [ "c"; "log-category" ] ~doc ~docv:"LOGTAG")
let setup_logs =
- Term.(const Logging.setup_log $ Logs_cli.level () $ log_category)
+ Term.(const Logging.setup_log $ Logs_cli.level () $ log_categories)
let log_level_is_debug () =
match Logs.level () with Some Debug -> true | _ -> false
--
GitLab