unikernel/duniverse/logs/test/tags.ml

@@ -0,0 +1,50 @@
+(* This code is in the public domain. *)
+
+(* Example with tags and custom reporter. *)
+
+let stamp_tag : Mtime.span Logs.Tag.def =
+  Logs.Tag.def "stamp" ~doc:"Relative monotonic time stamp" Mtime.Span.pp
+
+let stamp c = Logs.Tag.(empty |> add stamp_tag (Mtime_clock.count c))
+
+let run () =
+  let rec wait n = if n = 0 then () else wait (n - 1) in
+  let c = Mtime_clock.counter () in
+  Logs.info (fun m -> m "Starting run");
+  let delay1, delay2, delay3 = 10_000, 20_000, 40_000 in
+  Logs.info (fun m -> m "Start action 1 (%d)." delay1 ~tags:(stamp c));
+  wait delay1;
+  Logs.info (fun m -> m "Start action 2 (%d)." delay2 ~tags:(stamp c));
+  wait delay2;
+  Logs.info (fun m -> m "Start action 3 (%d)." delay3 ~tags:(stamp c));
+  wait delay3;
+  Logs.info (fun m -> m "Done." ?header:None ~tags:(stamp c));
+  ()
+
+let reporter ppf =
+  let report src level ~over k msgf =
+    let k _ = over (); k () in
+    let with_stamp h tags k ppf fmt =
+      let stamp = match tags with
+      | None -> None
+      | Some tags -> Logs.Tag.find stamp_tag tags
+      in
+      let dt = match stamp with
+      | None -> 0.
+      | Some s -> Mtime.Span.to_float_ns s *. 1000.
+      in
+      Format.kfprintf k ppf ("%a[%0+4.0fus] @[" ^^ fmt ^^ "@]@.")
+        Logs.pp_header (level, h) dt
+    in
+    msgf @@ fun ?header ?tags fmt -> with_stamp header tags k ppf fmt
+  in
+  { Logs.report = report }
+
+let main () =
+  Logs.set_reporter (reporter (Format.std_formatter));
+  Logs.set_level (Some Logs.Info);
+  run ();
+  run ();
+  ()
+
+let () = main ()

unikernel/duniverse/logs/test/test_browser.ml

@@ -0,0 +1,21 @@
+(*---------------------------------------------------------------------------
+   Copyright (c) 2015 The logs programmers. All rights reserved.
+   SPDX-License-Identifier: ISC
+  ---------------------------------------------------------------------------*)
+
+open Js_of_ocaml
+
+let main _ =
+  Logs.set_level @@ Some Logs.Debug;
+  Logs.set_reporter @@ Logs_browser.console_reporter ();
+  Logs.info (fun m -> m ~header:"START" ?tags:None "Starting main");
+  Logs.warn (fun m -> m "Hey be warned by %d." 7);
+  Logs.err (fun m -> m "Hey be errored.");
+  Logs.debug (fun m -> m "Would you mind to be debugged a bit ?");
+  Logs.app (fun m -> m "This is for the application console or stdout.");
+  Logs.app (fun m -> m ~header:"HEAD" "Idem but with a header");
+  Logs.err (fun m -> m "NO CARRIER");
+  Logs.info (fun m -> m "Ending main");
+  Js._false
+
+let () = Js.Unsafe.set Dom_html.window "onload" (Dom_html.handler main)

unikernel/duniverse/logs/test/test_count.ml

@@ -0,0 +1,25 @@
+(*---------------------------------------------------------------------------
+   Copyright (c) 2025 The logs programmers. All rights reserved.
+   SPDX-License-Identifier: ISC
+  ---------------------------------------------------------------------------*)
+
+open B0_testing
+
+let test_count =
+  Test.test "Logs.{err,warn}_count" @@ fun () ->
+  let logit () =
+    Logs.warn (fun m -> m "Hey");
+    Logs.err (fun m -> m "Ho");
+    Logs.warn (fun m -> m "Let's go");
+  in
+  logit ();
+  Test.int (Logs.err_count ()) 1 ~__POS__;
+  Test.int (Logs.warn_count ()) 2 ~__POS__;
+  Logs.set_level None;
+  logit ();
+  Test.int (Logs.err_count ()) 2 ~__POS__;
+  Test.int (Logs.warn_count ()) 4 ~__POS__;
+  ()
+
+let main () = Test.main @@ fun () -> Test.autorun ()
+let () = if !Sys.interactive then () else exit (main ())

unikernel/duniverse/logs/test/test_fmt.ml

@@ -0,0 +1,36 @@
+(*---------------------------------------------------------------------------
+   Copyright (c) 2015 The logs programmers. All rights reserved.
+   SPDX-License-Identifier: ISC
+  ---------------------------------------------------------------------------*)
+
+let pp_key = Format.pp_print_string
+let pp_val = Format.pp_print_string
+
+
+let err_invalid_kv args =
+  Logs.err @@ fun m ->
+  args (fun k v -> m "invalid kv (%a,%a)" pp_key k pp_val v)
+
+let err_no_carrier args =
+  Logs.err @@ fun m -> args (m "NO CARRIER")
+
+let main () =
+  Fmt_tty.setup_std_outputs ();
+  Logs.set_level @@ Some Logs.Debug;
+  Logs.set_reporter @@ Logs_fmt.reporter ();
+  Logs.info (fun m -> m ~header:"START" ?tags:None "Starting main");
+  Logs.warn (fun m -> m "Hey be warned by %d." 7);
+  Logs.err (fun m -> m "Hey be errored.");
+  Logs.debug (fun m -> m "Would you mind to be debugged a bit ?");
+  Logs.app (fun m -> m "This is for the application console or stdout.");
+  Logs.app (fun m -> m ~header:"HEAD" "Idem but with a header");
+  let k = "key" in
+  let v = "value" in
+  Logs.err (fun m -> m "invalid kv (%a,%a)" pp_key k pp_val v);
+  Logs.err (fun m -> m "NO CARRIER");
+  err_invalid_kv (fun args -> args k v);
+  err_no_carrier (fun () -> ());
+  Logs.info (fun m -> m "Ending main");
+  exit (if (Logs.err_count () > 0) then 1 else 0)
+
+let () = main ()

unikernel/duniverse/logs/test/test_formatter.ml

@@ -0,0 +1,33 @@
+(*---------------------------------------------------------------------------
+   Copyright (c) 2016 The logs programmers. All rights reserved.
+   SPDX-License-Identifier: ISC
+  ---------------------------------------------------------------------------*)
+
+let pp_key = Format.pp_print_string
+let pp_val = Format.pp_print_string
+
+let err_invalid_kv args =
+  Logs.err @@ fun m ->
+  args (fun k v -> m "invalid kv (%a,%a)" pp_key k pp_val v)
+
+let err_no_carrier args =
+  Logs.err @@ fun m -> args (m "NO CARRIER")
+
+let main () =
+  Logs.set_level @@ Some Logs.Debug;
+  Logs.set_reporter @@ Logs.format_reporter ();
+  Logs.info (fun m -> m ~header:"START" ?tags:None "Starting main");
+  Logs.warn (fun m -> m "Hey be warned by %d." 7);
+  Logs.err (fun m -> m "Hey be errored.");
+  Logs.debug (fun m -> m "Would you mind to be debugged a bit ?");
+  Logs.app (fun m -> m "This is for the application console or stdout.");
+  let k = "key" in
+  let v = "value" in
+  Logs.err (fun m -> m "invalid kv (%a,%a)" pp_key k pp_val v);
+  Logs.err (fun m -> m "NO CARRIER");
+  err_invalid_kv (fun args -> args k v);
+  err_no_carrier (fun () -> ());
+  Logs.info (fun m -> m "Ending main");
+  if (Logs.err_count () > 0) then 1 else 0
+
+let () = if !Sys.interactive then () else exit (main ())

unikernel/duniverse/logs/test/test_lwt.ml

@@ -0,0 +1,62 @@
+(*---------------------------------------------------------------------------
+   Copyright (c) 2015 The logs programmers. All rights reserved.
+   SPDX-License-Identifier: ISC
+  ---------------------------------------------------------------------------*)
+
+open B0_testing
+
+let ( >>= ) = Lwt.bind
+
+let lwt_reporter () =
+  let buf_fmt ~like =
+    let b = Buffer.create 512 in
+    Fmt.with_buffer ~like b,
+    fun () -> let m = Buffer.contents b in Buffer.reset b; m
+  in
+  let app, app_flush = buf_fmt ~like:Fmt.stdout in
+  let dst, dst_flush = buf_fmt ~like:Fmt.stderr in
+  let reporter = Logs_fmt.reporter ~app ~dst () in
+  let report src level ~over k msgf =
+    let k () =
+      let write () = match level with
+      | Logs.App -> Lwt_io.write Lwt_io.stdout (app_flush ())
+      | _ -> Lwt_io.write Lwt_io.stderr (dst_flush ())
+      in
+      let unblock () = over (); Lwt.return_unit in
+      Lwt.finalize write unblock |> Lwt.ignore_result;
+      k ()
+    in
+    reporter.Logs.report src level ~over:(fun () -> ()) k msgf;
+  in
+  { Logs.report = report }
+
+let test_count () =
+  let logit () =
+    Logs_lwt.warn (fun m -> m "Hey") >>= fun () ->
+    Logs_lwt.err (fun m -> m "Ho") >>= fun () ->
+    Logs_lwt.warn (fun m -> m "Let's go")
+  in
+  Test.int (Logs.err_count ()) 1 ~__POS__;
+  Test.int (Logs.warn_count ()) 1 ~__POS__;
+  Logs.set_level None;
+  logit () >>= fun () ->
+  Test.int (Logs.err_count ()) 2 ~__POS__;
+  Test.int (Logs.warn_count ()) 3 ~__POS__;
+  Lwt.return_unit
+
+let main () =
+  Test.main @@ fun () ->
+  Fmt_tty.setup_std_outputs ();
+  Logs.set_reporter @@ lwt_reporter ();
+  Lwt_main.run @@ begin
+  Logs.set_level (Some Logs.Debug);
+  Logs_lwt.info (fun m -> m ~header:"START" ?tags:None "Starting main")
+  >>= fun () -> Logs_lwt.warn (fun m -> m "Hey be warned by %d." 7)
+  >>= fun () -> Logs_lwt.err (fun m -> m "Hey be errored.")
+  >>= fun () -> Logs_lwt.debug (fun m -> m "Be debugged a bit ?")
+  >>= fun () -> Logs_lwt.app (fun m -> m "Application console or stdout.")
+  >>= fun () -> Logs_lwt.info (fun m -> m "Ending main")
+  >>= fun () -> test_count ()
+end
+
+let () = if !Sys.interactive then () else exit (main ())

unikernel/duniverse/logs/test/test_multi.ml

@@ -0,0 +1,18 @@
+(* This code is in the public domain. *)
+
+(* Example for installing multiple reporters. *)
+
+let combine r1 r2 =
+  let report = fun src level ~over k msgf ->
+    let v = r1.Logs.report src level ~over:(fun () -> ()) k msgf in
+    r2.Logs.report src level ~over (fun () -> v) msgf
+  in
+  { Logs.report }
+
+let () =
+  let r1 = Logs.format_reporter () in
+  let r2 = Logs_fmt.reporter () in
+  Fmt_tty.setup_std_outputs ();
+  Logs.set_reporter (combine r1 r2);
+  Logs.err (fun m -> m "HEY HO!");
+  ()

unikernel/duniverse/logs/test/test_threaded.ml

@@ -0,0 +1,14 @@
+let loop s =
+  for _ = 0 to 10 do
+    Logs.info (fun f -> f "%s.%s" s s)
+  done
+
+let () =
+  Logs_threaded.enable ();
+  Logs.set_level (Some Logs.Debug);
+  Logs.set_reporter (Logs_fmt.reporter ());
+  let t1 = Thread.create loop "aaaa" in
+  let t2 = Thread.create loop "bbbb" in
+  loop "cccc";
+  Thread.join t1;
+  Thread.join t2

unikernel/duniverse/logs/test/tests.itarget

@@ -0,0 +1,7 @@
+test_fmt.native
+test_formatter.native
+tool.native
+tags.native
+test_browser.html
+test_browser.byte
+test_lwt.native

unikernel/duniverse/logs/test/tool.ml

@@ -0,0 +1,34 @@
+(* This code is in the public domain. *)
+
+(* Example setup for a simple command line tool with colorful output. *)
+
+let hello _ msg =
+  Logs.app (fun m -> m "%s" msg);
+  Logs.info (fun m -> m "End-user information.");
+  Logs.debug (fun m -> m "Developer information.");
+  Logs.err (fun m -> m "Something bad happened.");
+  Logs.warn (fun m -> m "Something bad may happen in the future.");
+  if Logs.err_count () > 0 then 1 else 0
+
+let setup_log style_renderer level =
+  Fmt_tty.setup_std_outputs ?style_renderer ();
+  Logs.set_level level;
+  Logs.set_reporter (Logs_fmt.reporter ())
+
+(* Command line interface *)
+
+open Cmdliner
+
+let setup_log =
+  let env = Cmd.Env.info "TOOL_VERBOSITY" in
+  Term.(const setup_log $ Fmt_cli.style_renderer () $ Logs_cli.level ~env ())
+
+let msg =
+  let doc = "The message to output."  in
+  Arg.(value & pos 0 string "Hello horrible world!" & info [] ~doc)
+
+let main () =
+  let cmd = Cmd.v (Cmd.info "tool") Term.(const hello $ setup_log $ msg) in
+  Cmd.eval' cmd
+
+let () = if !Sys.interactive then () else exit (main ())