balsoft/ligo
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Locator: added extended test with benchmark

Browse Source
This commit is contained in:
Marco Stronati 2018-01-31 16:38:08 +01:00 committed by Benjamin Canou
parent d05dceb0b0
commit 3ca9a081f9
3 changed files with 366 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
src/lib_shell/test/jbuild
View File

@ -1,7 +1,8 @@
(jbuild_version 1) (jbuild_version 1)
(executables (executables
((names (test_state)) ((names (test_state
test_locator))
(libraries (tezos-base (libraries (tezos-base
tezos-storage tezos-storage
tezos-protocol-updater tezos-protocol-updater
@ -18,15 +19,25 @@
(alias (alias
((name buildtest) ((name buildtest)
(deps (test_state.exe)))) (deps (test_state.exe
test_locator.exe))))
(alias (alias
((name runtest_state) ((name runtest_state)
(action (run ${exe:test_state.exe})))) (action (run ${exe:test_state.exe}))))
(alias
((name runtest_locator)
(action (run ${exe:test_locator.exe} --no-bench))))
(alias
((name runbench_locator)
(action (run ${exe:test_locator.exe}))))
(alias (alias
((name runtest) ((name runtest)
(deps ((alias runtest_state))))) (deps ((alias runtest_state)
(alias runtest_locator)))))
(alias (alias
((name runtest_indent) ((name runtest_indent)

329
src/lib_shell/test/test_locator.ml Normal file
View File

@ -0,0 +1,329 @@
(**************************************************************************)
(* *)
(* Copyright (c) 2014 - 2017. *)
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* All rights reserved. No warranty, explicit or implicit, provided. *)
(* *)
(**************************************************************************)
let (//) = Filename.concat
(** Basic blocks *)
let genesis_hash =
Block_hash.of_b58check_exn
"BLockGenesisGenesisGenesisGenesisGenesisGeneskvg68z"
let genesis_protocol =
Protocol_hash.of_b58check_exn
"ProtoDemoDemoDemoDemoDemoDemoDemoDemoDemoDemoD3c8k9"
let genesis_time = Time.of_seconds 0L
let state_genesis_block =
{
State.Net.time = genesis_time;
State.Net.block= genesis_hash;
State.Net.protocol = genesis_protocol
}
let net_id = Net_id.of_block_hash genesis_hash
module Proto = (val Registred_protocol.get_exn genesis_protocol)
let incr_timestamp timestamp =
Time.add timestamp (Int64.add 1L (Random.int64 10L))
let incr_fitness fitness =
let new_fitness =
match fitness with
| [ fitness ] ->
Pervasives.(
Data_encoding.Binary.of_bytes Data_encoding.int64 fitness
|> Option.unopt ~default:0L
|> Int64.succ
|> Data_encoding.Binary.to_bytes Data_encoding.int64
)
| _ -> Data_encoding.Binary.to_bytes Data_encoding.int64 1L
in
[ new_fitness ]
(* returns a new state with a single block, genesis *)
let init_net base_dir : State.Net.t Lwt.t =
let store_root = base_dir // "store" in
let context_root = base_dir // "context" in
State.read ~store_root ~context_root () >>= function
| Error _ -> Pervasives.failwith "read err"
| Ok (state:State.global_state) ->
State.Net.create state state_genesis_block
let block_header
?(context = Context_hash.zero)
(pred : State.Block.t) : Block_header.t =
let pred_header = State.Block.shell_header pred in
let timestamp = incr_timestamp pred_header.timestamp in
let fitness = incr_fitness pred_header.fitness in
{
Block_header.shell =
{
level = Int32.add Int32.one (State.Block.level pred);
proto_level = 0;
predecessor = State.Block.hash pred;
timestamp = timestamp;
validation_passes = 0;
operations_hash = Operation_list_list_hash.empty;
fitness = fitness ;
context ;
} ;
Block_header.proto = MBytes.of_string "" ;
}
(* adds n blocks on top of an initialized net *)
let make_empty_chain (net:State.Net.t) n : Block_hash.t Lwt.t =
State.Block.read_exn net genesis_hash >>= fun genesis ->
State.Block.context genesis >>= fun empty_context ->
let header = State.Block.header genesis in
Context.commit
~time:header.shell.timestamp empty_context >>= fun context ->
let header = { header with shell = { header.shell with context } } in
let empty_result : Updater.validation_result = {
context = empty_context ;
fitness = [] ;
message = None ;
max_operation_data_length = 0 ;
max_operations_ttl = 0 ;
} in
let rec loop lvl pred =
if lvl >= n then
return pred
else
let header =
{ header with
shell = { header.shell with predecessor = pred ;
level = Int32.of_int lvl } } in
State.Block.store net header [] empty_result >>=? fun _ ->
loop (lvl+1) (Block_header.hash header)
in
loop 1 genesis_hash >>= function
| Ok b -> Lwt.return b
| Error err ->
Error_monad.pp_print_error Format.err_formatter err ;
assert false
(* helper functions ------------------------------------- *)
(* wall clock time of a unit function *)
let time1 (f: unit -> 'a) : 'a * float =
let t = Unix.gettimeofday () in
let res = f () in
let wall_clock = Unix.gettimeofday () -. t in
(res,wall_clock)
(* returns result from first run and average time of [runs] runs *)
let time ?(runs=1) f =
if runs < 1 then invalid_arg "time negative arg" else
let rec loop cnt sum =
if cnt = (runs)
then sum
else
let (_,t) = time1 f in
loop (cnt+1) (sum+.t)
in
let (res,t) = time1 f in
let sum = loop 1 t in
(res, sum /. (float runs))
let rec repeat f n =
if n<0 then invalid_arg "repeat: negative arg" else
if n=0 then ()
else let _ = f () in repeat f (n-1)
(* ----------------------------------------------------- *)
let print_block b =
Printf.printf "%6i %s\n"
(Int32.to_int (State.Block.level b))
(Block_hash.to_b58check (State.Block.hash b))
let print_block_h net bh =
State.Block.read_exn net bh >|= fun b ->
print_block b
(* returns the predecessor at distance one, reading the header *)
let linear_predecessor net (bh: Block_hash.t) : Block_hash.t option Lwt.t =
State.Block.read_exn net bh >>= fun b ->
State.Block.predecessor b >|= function
| None -> None
| Some pred -> Some (State.Block.hash pred)
let print_chain net bh =
let rec loop bh cnt =
let _ = print_block_h net bh in
linear_predecessor net bh >>= function
| Some pred -> loop pred (cnt+1)
| None -> Lwt.return_unit
in
loop bh 0
(* returns the predecessors at ditance n, traversing all n intermediate blocks *)
let linear_predecessor_n (net:State.Net.t) (bh:Block_hash.t) (distance:int)
: Block_hash.t option Lwt.t =
(* let _ = Printf.printf "LP: %4i " distance; print_block_h net bh in *)
if distance < 1 then invalid_arg "distance<1" else
let rec loop bh distance =
if distance = 0
then Lwt.return_some bh (* reached distance *)
else
linear_predecessor net bh >>= function
| None -> Lwt.return_none
| Some pred ->
loop pred (distance-1)
in
loop bh distance
(* Tests that the linear predecessor defined above and the
exponential predecessor implemented in State.predecessor_n
return the same block and it is the block at the distance
requested *)
let test_pred (base_dir:string) : unit tzresult Lwt.t =
let size_chain = 1000 in
init_net base_dir >>= fun net ->
make_empty_chain net size_chain >>= fun head ->
let test_once distance =
linear_predecessor_n net head distance >>= fun lin_res ->
State.Block.predecessor_n net head distance >>= fun exp_res ->
match lin_res,exp_res with
| None, None ->
Lwt.return_unit
| None,Some _ | Some _,None ->
Assert.fail_msg "mismatch between exponential and linear predecessor_n"
| Some lin_res, Some exp_res ->
(* check that the two results are the same *)
(assert (lin_res = exp_res));
State.Block.read_exn net lin_res >>= fun pred ->
let level_pred = Int32.to_int (State.Block.level pred) in
State.Block.read_exn net head >>= fun head ->
let level_start = Int32.to_int (State.Block.level head) in
(* check distance using the level *)
assert (level_start - distance = level_pred);
Lwt.return_unit
in
let _ = Random.self_init () in
let range = size_chain+(size_chain/10) in
let repeats = 100 in
return (repeat (fun () -> test_once (Random.int range)) repeats)
(* compute locator using the linear predecessor *)
let compute_linear_locator (net:State.Net.t) ~size block =
let genesis = State.Net.genesis net in
let block_hash = State.Block.hash block in
let header = State.Block.header block in
Block_locator.compute ~predecessor:(linear_predecessor_n net)
~genesis:genesis.block block_hash header size
(* given the size of a chain, returns the size required for a locator
to reach genesis *)
let compute_size_locator size_chain =
let repeats = 10. in
int_of_float ((log ((float size_chain) /. repeats)) /. (log 2.) -. 1.) * 10
(* given the size of a locator, returns the size of the chain that it
can cover back to genesis *)
let compute_size_chain size_locator =
let repeats = 10. in
int_of_float (repeats *. (2. ** (float (size_locator + 1))))
(* test if the linear and exponential locator are the same and outputs
their timing.
Run the test with:
$ jbuilder build @runbench_locator
Copy the output to a file timing.dat and plot it with:
$ test_locator_plot.sh timing.dat
*)
(*
chain 1 year 518k covered by locator 150
chain 2 months 86k covered by locator 120
*)
let test_locator base_dir =
let size_chain = 80000 in
(* timing locators with average over [runs] times *)
let runs = 10 in
let _ = Printf.printf "#runs %i\n" runs in
(* limit after which exp should go linear *)
let exp_limit = compute_size_chain 120 in
let _ = Printf.printf "#exp_limit %i\n" exp_limit in
(* size after which locator always reaches genesis *)
let locator_limit = compute_size_locator size_chain in
let _ = Printf.printf "#locator_limit %i\n" locator_limit in
init_net base_dir >>= fun net ->
time1 (fun () ->
make_empty_chain net size_chain) |>
fun (res, t_chain) ->
let _ = Printf.printf
"#size_chain %i built in %f sec\n# size exp lins\n"
size_chain t_chain in
res >>= fun head ->
let check_locator size : unit tzresult Lwt.t =
State.Block.read net head >>=? fun block ->
time ~runs:runs (fun () ->
State.compute_locator net ~size:size block) |>
fun (l_exp,t_exp) ->
time ~runs:runs (fun () ->
compute_linear_locator net ~size:size block) |>
fun (l_lin,t_lin) ->
l_exp >>= fun l_exp ->
l_lin >>= fun l_lin ->
let _, l_exp = (l_exp : Block_locator.t :> _ * _) in
let _, l_lin = (l_lin : Block_locator.t :> _ * _) in
let _ = Printf.printf "%10i %f %f\n" size t_exp t_lin in
List.iter2
(fun hn ho ->
if not (Block_hash.equal hn ho)
then
Assert.fail_msg "Invalid locator %i" size)
l_exp l_lin;
return ()
in
let stop = locator_limit + 20 in
let rec loop size =
if size < stop then (
check_locator size >>=? fun _ ->
loop (size+5)
)
else return ()
in
loop 1
let tests : (string * (string -> unit tzresult Lwt.t)) list =
[ "test pred", test_pred ]
let bench = [ "test locator", test_locator ]
let tests =
try
if Sys.argv.(1) = "--no-bench" then
tests
else
tests @ bench
with _ -> tests @ bench
let () =
let module Test = Tezos_test_helpers.Test.Make(Error_monad) in
Test.run "state." tests

23
src/lib_shell/test/test_locator_plot.sh Executable file
View File

@ -0,0 +1,23 @@
#!/bin/bash
# plots the output of 'jbuilder build @runtest_locator'
set -e
size_chain=$(grep 'size_chain' $1 | awk '{print $2}')
exp_limit=$(grep 'exp_limit' $1 | awk '{print $2}')
locator_limit=$(grep 'locator_limit' $1 | awk '{print $2}')
runs=$(grep 'runs' $1 | awk '{print $2}')
echo "\
input=\"${1}\";
set terminal svg;
#set terminal dumb;
set key top left;
#set logscale y;
set title '# stored predecessors 12, runs ${runs}, size chain ${size_chain}, exp limit ${exp_limit}, locator limit ${locator_limit}'
set xlabel 'size locator';
set ylabel 'time (seconds)';
plot input using 1:2 ls 1 title 'exponential', \
input using 1:3 ls 2 title 'linear'
" | gnuplot > ${1}.svg