diff --git a/emit1.sh b/emit1.sh index 86794bc3..72a15305 100755 --- a/emit1.sh +++ b/emit1.sh @@ -1,2 +1,3 @@ #!/bin/sh -exec dune exec --profile=release tests/bin/emit1.exe -- $@ +OPTS="--profile=release --display=quiet --ignore-promoted-rules" +exec dune exec $OPTS tests/bin/emit1.exe -- $@ diff --git a/tests/bin/dune b/tests/bin/dune index 7ac29933..3cf0a999 100644 --- a/tests/bin/dune +++ b/tests/bin/dune @@ -9,6 +9,13 @@ (preprocess (pps lwt_ppx)) (libraries unix opentelemetry opentelemetry-lwt opentelemetry-client-cohttp-lwt lwt.unix)) +(executable + (name emit2_cohttp) + (modules emit2_cohttp) + (preprocess (pps lwt_ppx)) + (libraries unix trace-lwt opentelemetry opentelemetry.trace + opentelemetry-client-cohttp-lwt lwt lwt.unix)) + (executable (name cohttp_client) (modules cohttp_client) diff --git a/tests/bin/emit2_cohttp.ml b/tests/bin/emit2_cohttp.ml new file mode 100644 index 00000000..82423cb6 --- /dev/null +++ b/tests/bin/emit2_cohttp.ml @@ -0,0 +1,165 @@ +module T = Trace_lwt +module Otel = Opentelemetry +open Lwt.Syntax + +let spf = Printf.sprintf + +let ( let@ ) f x = f x + +let sleep_inner = ref 0.1 + +let sleep_outer = ref 2.0 + +let n_jobs = ref 1 + +let num_sleep = Atomic.make 0 + +let stress_alloc_ = ref true + +let stop = Atomic.make false + +let num_tr = Atomic.make 0 + +let run_job () : unit Lwt.t = + let i = ref 0 in + while%lwt not @@ Atomic.get stop do + let@ _sc = + T.with_span_lwt ~__FILE__ ~__LINE__ "loop.outer" ~data:(fun () -> + [ "i", `Int !i ]) + in + + let run_sub n ~j = + (* parent scope is found via thread local storage *) + let@ _sc = + T.with_span_lwt ~__FILE__ ~__LINE__ "inside.job" ~data:(fun () -> + [ "j", `Int j ]) + in + + let* () = Lwt_unix.sleep (!sleep_outer +. (float n *. 0.01)) in + Atomic.incr num_sleep; + + T.messagef (fun k -> k "inner at %d" j); + + incr i; + + let run_sub_or_fail () = + Atomic.incr num_tr; + let@ _span = T.with_span_lwt ~__FILE__ ~__LINE__ "alloc" in + + (* allocate some stuff *) + if !stress_alloc_ then ( + let _arr = Sys.opaque_identity @@ Array.make (25 * 25551) 42.0 in + ignore _arr + ); + + let* () = Lwt_unix.sleep !sleep_inner in + Atomic.incr num_sleep; + + if j = 4 && !i mod 13 = 0 then failwith "oh no"; + + (* simulate a failure *) + (* TODO: do we need [Trace.add_msg_to_span …]? + T.Trace.add_event scope (fun () -> T.Event.make "done with alloc"); + *) + Lwt.return () + in + + let run_sub () = + try%lwt run_sub_or_fail () with Failure _ -> Lwt.return () + in + + let sub1 = run_sub () in + let sub2 = run_sub () in + let sub3 = run_sub () in + + let* () = sub1 and* () = sub2 and* () = sub3 in + Lwt.return () + in + + for%lwt j = 0 to 4 do + (* parent scope is found via thread local storage *) + let@ _sc = + T.with_span_lwt ~__FILE__ ~__LINE__ "loop.inner" ~data:(fun () -> + [ "j", `Int j ]) + in + + let sub1 = run_sub 1 ~j in + let sub2 = run_sub 2 ~j in + let sub3 = run_sub 3 ~j in + + let* () = sub1 and* () = sub2 and* () = sub3 in + Lwt.return () + done + done + +let run () : unit Lwt.t = + Printf.printf "collector is on %S\n%!" + (Opentelemetry_client_cohttp_lwt.get_url ()); + Otel.GC_metrics.basic_setup (); + + Otel.Metrics_callbacks.register (fun () -> + Otel.Metrics. + [ + sum ~name:"num-sleep" ~is_monotonic:true + [ int (Atomic.get num_sleep) ]; + ]); + + let n_jobs = max 1 !n_jobs in + Printf.printf "run %d jobs\n%!" n_jobs; + + let jobs = Array.init n_jobs (fun _ -> run_job ()) |> Array.to_list in + Lwt.join jobs + +let () = + Sys.catch_break true; + Otel.Globals.service_name := "t2"; + Otel.Globals.service_namespace := Some "ocaml-otel.test"; + let ts_start = Unix.gettimeofday () in + + let debug = ref false in + let batch_traces = ref 400 in + let batch_metrics = ref 3 in + let opts = + [ + "--debug", Arg.Bool (( := ) debug), " enable debug output"; + ( "--stress-alloc", + Arg.Bool (( := ) stress_alloc_), + " perform heavy allocs in inner loop" ); + "--batch-traces", Arg.Int (( := ) batch_traces), " size of traces batch"; + ( "--batch-metrics", + Arg.Int (( := ) batch_metrics), + " size of metrics batch" ); + "--sleep-inner", Arg.Set_float sleep_inner, " sleep (in s) in inner loop"; + "--sleep-outer", Arg.Set_float sleep_outer, " sleep (in s) in outer loop"; + "-j", Arg.Set_int n_jobs, " number of parallel jobs"; + ] + |> Arg.align + in + + Arg.parse opts (fun _ -> ()) "emit1 [opt]*"; + + let some_if_nzero r = + if !r > 0 then + Some !r + else + None + in + let config = + Opentelemetry_client_cohttp_lwt.Config.make ~debug:!debug + ~batch_traces:(some_if_nzero batch_traces) + ~batch_metrics:(some_if_nzero batch_metrics) + () + in + Format.printf "@[<2>sleep outer: %.3fs,@ sleep inner: %.3fs,@ config: %a@]@." + !sleep_outer !sleep_inner Opentelemetry_client_cohttp_lwt.Config.pp config; + + let@ () = + Fun.protect ~finally:(fun () -> + let elapsed = Unix.gettimeofday () -. ts_start in + let n_per_sec = float (Atomic.get num_tr) /. elapsed in + Printf.printf "\ndone. %d spans in %.4fs (%.4f/s)\n%!" + (Atomic.get num_tr) elapsed n_per_sec) + in + Opentelemetry_client_cohttp_lwt.with_setup ~stop ~config () @@ fun () -> + Opentelemetry_trace.setup (); + Lwt_main.run @@ run ()