Add support of tracing to the tool

MinaProtocol · Nov 27, 2023 · 1811f12 · 1811f12
1 parent fc61fa1
commit 1811f12
Show file tree

Hide file tree

Showing 2 changed files with 12 additions and 2 deletions.
diff --git a/src/app/cli/src/init/client.ml b/src/app/cli/src/init/client.ml
@@ -2267,6 +2267,7 @@ let test_ledger_application =
      and has_second_partition =
        flag "--has-second-partition"
          ~doc:"Assume there is a second partition (scan state)" no_arg
+     and tracing = flag "--tracing" ~doc:"Wrap test into tracing" no_arg
      and no_masks = flag "--no-masks" ~doc:"Do not create masks" no_arg in
      Cli_lib.Exceptions.handle_nicely
      @@ fun () ->
@@ -2278,7 +2279,7 @@ let test_ledger_application =
      let max_depth = Option.value ~default:290 max_depth in
      Test_ledger_application.test ~privkey_path ~ledger_path ~prev_block_path
        ~first_partition_slots ~no_new_stack ~has_second_partition
-       ~num_txs_per_round ~rounds ~no_masks ~max_depth num_txs )
+       ~num_txs_per_round ~rounds ~no_masks ~max_depth ~tracing num_txs )
 
 let itn_create_accounts =
   Command.async ~summary:"Fund new accounts for incentivized testnet"

diff --git a/src/app/cli/src/init/test_ledger_application.ml b/src/app/cli/src/init/test_ledger_application.ml
@@ -131,7 +131,9 @@ let apply_txs ~first_partition_slots ~no_new_stack ~has_second_partition
 
 let test ~privkey_path ~ledger_path ~prev_block_path ~first_partition_slots
     ~no_new_stack ~has_second_partition ~num_txs_per_round ~rounds ~no_masks
-    ~max_depth num_txs_final =
+    ~max_depth ~tracing num_txs_final =
+  O1trace.thread "mina"
+  @@ fun () ->
   let%bind keypair = read_privkey privkey_path in
   let init_ledger =
     Ledger.create ~directory_name:ledger_path
@@ -159,12 +161,19 @@ let test ~privkey_path ~ledger_path ~prev_block_path ~first_partition_slots
       Ledger.commit ledger ;
       Ledger.remove_and_reparent_exn ledger ledger )
   in
+  let stop_tracing =
+    if tracing then (fun x -> Mina_tracing.stop () ; x) else ident
+  in
   Deferred.List.fold (List.init rounds ~f:ident) ~init:(init_ledger, [])
     ~f:(fun (ledger, ledgers) i ->
+      let%bind () =
+        if tracing && i = 1 then Mina_tracing.start "." else Deferred.unit
+      in
       List.hd (List.drop ledgers (max_depth - 1))
       |> Option.iter ~f:drop_old_ledger ;
       apply ~num_txs:num_txs_per_round ~i ledger
       >>| mask_handler ledger
       >>| Fn.flip Tuple2.create (ledger :: ledgers) )
   >>| fst
   >>= apply ~num_txs:num_txs_final ~i:rounds
+  >>| stop_tracing