ocaml-trace/test/lwt/t1.ml

open Lwt.Syntax

let ( let@ ) = ( @@ )

module Barrier = struct
  type t = {
    mutable n: int;
    size: int;
    cond: unit Lwt_condition.t;
  }

  let create size : t = { n = 0; size; cond = Lwt_condition.create () }

  let wait (self : t) : unit Lwt.t =
    self.n <- self.n + 1;
    if self.n >= self.size then (
      (* all reached barrier, reset and wakeup everyone *)
      self.n <- 0;
      Lwt_condition.broadcast self.cond ();
      Lwt.return ()
    ) else
      Lwt_condition.wait self.cond
end

let inner_loop ~off i barrier =
  let rec loop j =
    if j >= 5 then
      Lwt.return ()
    else
      let* () = Lwt_unix.sleep (float off *. 0.01) in
      let* () =
        let@ _sp =
          Trace_lwt.with_span_lwt ~__FILE__ ~__LINE__ "inner.loop.step"
        in
        Trace.messagef (fun k -> k "hello %d %d" i j);
        Trace.message "world";

        let* () =
          if j = 2 then
            let* () = Lwt_unix.sleep (float off *. 0.01) in
            let@ _sp =
              Trace_lwt.with_span_lwt ~__FILE__ ~__LINE__ "sub-sleep"
            in
            Lwt_unix.sleep 0.01
          else
            Lwt.return ()
        in

        let* () = Lwt_unix.sleep 0.06 in
        let* () = Barrier.wait barrier in
        Lwt.return ()
      in

      loop (j + 1)
  in
  let@ _sp =
    Trace_lwt.with_span_lwt ~force_toplevel:true ~__FILE__ ~__LINE__
      "inner.loop"
  in
  loop 0

let outer_loop ~off barrier =
  let rec loop i =
    if i = 20 then
      Lwt.return ()
    else
      let* () =
        let* () = Lwt_unix.sleep (float off *. 0.04) in
        let@ _sp =
          Trace_lwt.with_span_lwt ~__FILE__ ~__LINE__ "outer.loop.step"
        in

        let barrier_inner = Barrier.create 2 in
        let* () = inner_loop ~off:0 i barrier_inner
        and* () = inner_loop ~off:1 i barrier_inner in
        let* () = Barrier.wait barrier in
        Lwt.return ()
      in
      loop (i + 1)
  in

  let@ _sp =
    Trace_lwt.with_span_lwt ~force_toplevel:true ~__FILE__ ~__LINE__
      "outer.loop"
  in
  loop 0

let run () : unit Lwt.t =
  Trace.set_process_name "main";
  Trace.set_thread_name "t1";

  let barrier = Barrier.create 2 in
  let* () = outer_loop ~off:0 barrier and* () = outer_loop ~off:1 barrier in
  Lwt.return ()

let () =
  Trace_tef.Internal_.mock_all_ ();
  Trace_tef.with_setup ~out:`Stdout () @@ fun () -> Lwt_main.run (run ())