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 ())