62 lines
2.1 KiB
OCaml
62 lines
2.1 KiB
OCaml
(*---------------------------------------------------------------------------
|
|
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 ())
|