This commit is contained in:
swrup 2025-11-11 02:07:51 +01:00
parent aa2ff7b2f0
commit 2f3113f55d
11742 changed files with 1223940 additions and 0 deletions

View file

@ -0,0 +1,154 @@
(*
* Copyright (c) 2018 Thomas Gazagnaire <thomas@gazagnaire.org>
*
* Permission to use, copy, modify, and distribute this software for any
* purpose with or without fee is hereby granted, provided that the above
* copyright notice and this permission notice appear in all copies.
*
* THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
* WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
* MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
* ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
* WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
* ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
* OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
*)
(*************)
(* Reporters *)
(*************)
let data_ = Queue.create ()
let data () = Queue.pop data_
let now =
let n = ref ~-1 in
fun () ->
incr n;
Int64.of_int !n
let set_mem_reporter () =
let report ~tags ~data ~over src k =
let data_fields = Metrics.Data.fields data in
let name = Metrics.Src.name src in
let field f =
(Fmt.to_to_string Metrics.pp_key f, Fmt.to_to_string Metrics.pp_value f)
in
let fields = List.map field in
let timestamp =
match Metrics.Data.timestamp data with
| Some ts -> ts
| None -> Int64.to_string (now ())
in
let d = (name, fields tags, fields data_fields, timestamp) in
Queue.push d data_;
over ();
k ()
in
let at_exit () = () in
Metrics.set_reporter { Metrics.report; now; at_exit }
(*************)
(* Tests *)
(*************)
let src =
let open Metrics in
let tags = Tags.[ int "foo"; string "bar" ] in
let data i =
Data.v [ string "toto" ("XXX" ^ string_of_int i); int "titi" i ]
in
Src.v "test" ~tags ~data
let f tags =
Metrics.add src tags (fun m -> m 42);
Metrics.add src tags (fun m -> m 43)
let i0 t = t 42 "hi!"
let i1 t = t 12 "toto"
let timer =
let open Metrics in
let tags = Tags.[ string "truc" ] in
let data (_ : (unit, string) rresult) = Data.v [] in
Src.v "sleep" ~tags ~data ~duration:true ~status:true
let m1 t = t "foo"
let m2 t = t "bar"
let status =
let open Metrics in
let tags = Tags.[] in
let data (_ : (unit, unit) rresult) = Data.v [] in
Src.v "status" ~tags ~data ~duration:false ~status:true
let d =
let pp_string = Fmt.fmt "%S" in
let pp_field = Fmt.Dump.pair pp_string pp_string in
let pp ppf (n, t, f, x) =
Fmt.pf ppf "(%S, %a, %a, %S)" n
Fmt.(Dump.list pp_field)
t
Fmt.(Dump.list pp_field)
f x
in
Alcotest.testable pp ( = )
let test_f () =
f i0;
Alcotest.check d "i0" (data ())
( "test",
[ ("foo", "42"); ("bar", "hi!") ],
[ ("toto", "XXX42"); ("titi", "42") ],
"0" );
Alcotest.check d "i0" (data ())
( "test",
[ ("foo", "42"); ("bar", "hi!") ],
[ ("toto", "XXX43"); ("titi", "43") ],
"1" );
f i1;
Alcotest.check d "i0" (data ())
( "test",
[ ("foo", "12"); ("bar", "toto") ],
[ ("toto", "XXX42"); ("titi", "42") ],
"2" );
Alcotest.check d "i1" (data ())
( "test",
[ ("foo", "12"); ("bar", "toto") ],
[ ("toto", "XXX43"); ("titi", "43") ],
"3" )
let test_timer () =
let _ = Metrics.rrun timer m1 (fun () -> Ok (Unix.sleep 1)) in
Alcotest.check d "m1-ok" (data ())
("sleep", [ ("truc", "foo") ], [ ("duration", "1"); ("status", "ok") ], "6");
let _ =
try Metrics.rrun timer m1 (fun () -> raise Not_found)
with Not_found -> Ok ()
in
Alcotest.check d "m1-error" (data ())
( "sleep",
[ ("truc", "foo") ],
[ ("duration", "1"); ("status", "error") ],
"9" )
let test_status () =
let _ = Metrics.rrun status (fun t -> t) (fun () -> Ok ()) in
Alcotest.check d "status" (data ()) ("status", [], [ ("status", "ok") ], "12");
let _ = Metrics.rrun status (fun t -> t) (fun () -> Error ()) in
Alcotest.check d "status" (data ())
("status", [], [ ("status", "error") ], "15");
()
let () =
Metrics.enable_all ();
set_mem_reporter ();
Alcotest.run "metrics"
[
( "base",
[
("f", `Quick, test_f);
("timer", `Quick, test_timer);
("status", `Quick, test_status);
] );
]