From 70587c2b6028c5622dbadffdf5f6479f83916a4e Mon Sep 17 00:00:00 2001 From: Sylvain Ribstein Date: Thu, 18 Aug 2022 16:07:38 +0200 Subject: [PATCH 1/6] test/scoru: rework pp function --- .../test/pbt/test_refutation_game.ml | 20 +++++++++---------- 1 file changed, 9 insertions(+), 11 deletions(-) diff --git a/src/proto_alpha/lib_protocol/test/pbt/test_refutation_game.ml b/src/proto_alpha/lib_protocol/test/pbt/test_refutation_game.ml index 790331336879..557989dbac4c 100644 --- a/src/proto_alpha/lib_protocol/test/pbt/test_refutation_game.ml +++ b/src/proto_alpha/lib_protocol/test/pbt/test_refutation_game.ml @@ -1076,7 +1076,9 @@ let pp_levels_and_inputs ppf levels_and_inputs = ppf "level %d, inputs %a" level - (pp_print_list pp_print_string) + (pp_print_list + ~pp_sep:(fun ppf () -> pp_print_string ppf "; ") + pp_print_string) inputs) ppf) levels_and_inputs) @@ -1087,25 +1089,21 @@ let pp_player_client ppf ppf "@[player:@,\ %a@]@,\ - @[states:@,\ + @[ticks and states:@,\ %a@]@,\ final tick: %a@,\ @[levels and inputs:@,\ %a@]@," pp_player player - (Format.pp_print_list (fun ppf (tick, hash) -> - Format.fprintf - ppf - "tick %a, state hash %a" - Tick.pp - tick - State_hash.pp_short - hash)) + Format.( + pp_print_list + ~pp_sep:(fun ppf () -> pp_print_string ppf "; ") + (fun ppf (tick, hash) -> + fprintf ppf "(%a, %a)" Tick.pp tick State_hash.pp_short hash)) states Tick.pp final_tick - (* inbox *) pp_levels_and_inputs levels_and_inputs -- GitLab From 8b2d0ce07125096a5a7cf8c598907986ec891ad8 Mon Sep 17 00:00:00 2001 From: Sylvain Ribstein Date: Thu, 18 Aug 2022 16:08:49 +0200 Subject: [PATCH 2/6] test/scoru/refutation:refactor eval_inputs fct --- .../test/pbt/test_refutation_game.ml | 57 +++++++++---------- 1 file changed, 28 insertions(+), 29 deletions(-) diff --git a/src/proto_alpha/lib_protocol/test/pbt/test_refutation_game.ml b/src/proto_alpha/lib_protocol/test/pbt/test_refutation_game.ml index 557989dbac4c..78ca861d03d7 100644 --- a/src/proto_alpha/lib_protocol/test/pbt/test_refutation_game.ml +++ b/src/proto_alpha/lib_protocol/test/pbt/test_refutation_game.ml @@ -1024,17 +1024,17 @@ let construct_inbox_proto block rollup levels_and_inputs contract = the protocol. *) type strategy = - | Random (** A random player will execute its own random vision of inputs. *) | Perfect (** A perfect player, never lies, always win. GSW 73-9 2014-2015 mindset. *) + | Random (** A random player will execute its own random vision of inputs. *) | Lazy (** A lazy player will not execute all messages. *) | Eager (** A eager player will not cheat until a certain point. *) | Keen (** A keen player will execute more messages. *) let pp_strategy fmt = function - | Random -> Format.pp_print_string fmt "Random" | Perfect -> Format.pp_print_string fmt "Perfect" + | Random -> Format.pp_print_string fmt "Random" | Lazy -> Format.pp_print_string fmt "Lazy" | Eager -> Format.pp_print_string fmt "Eager" | Keen -> Format.pp_print_string fmt "Keen" @@ -1121,6 +1121,13 @@ module Player_client = struct @@ let+ index = Tezos_context_memory.Context.init id in Tezos_context_memory.Context.empty index + let eval_inputs ctxt levels_and_inputs = + Lwt_main.run + @@ + let open Lwt_result_syntax in + let*! r = Arith_test_pvm.eval_levels_and_inputs ctxt levels_and_inputs in + Lwt.return @@ WithExceptions.Result.get_ok ~loc:__LOC__ r + (* TODO: https://gitlab.com/tezos/tezos/-/issues/3529 Factor code for the unit test. @@ -1160,27 +1167,16 @@ module Player_client = struct (** Generate [our_states] for [levels_and_inputs] based on the strategy. It needs [level_min] and [level_max] in case it will need to generate new inputs. *) - let gen_our_states ctxt strategy ?level_min ?level_max levels_and_inputs = + let gen_our_levels_and_inputs strategy ?level_min ?level_max levels_and_inputs + = let open QCheck2.Gen in - let eval_inputs levels_and_inputs = - Lwt_main.run - @@ - let open Lwt_result_syntax in - let*! r = Arith_test_pvm.eval_levels_and_inputs ctxt levels_and_inputs in - Lwt.return @@ WithExceptions.Result.get_ok ~loc:__LOC__ r - in match strategy with | Perfect -> (* The perfect player does not lie, evaluates correctly the inputs. *) - let _state, tick, our_states = eval_inputs levels_and_inputs in - return (tick, our_states, levels_and_inputs) + return levels_and_inputs | Random -> (* Random player generates its own list of inputs. *) - let* new_levels_and_inputs = - gen_arith_pvm_inputs_for_levels ?level_min ?level_max () - in - let _state, tick, our_states = eval_inputs new_levels_and_inputs in - return (tick, our_states, new_levels_and_inputs) + gen_arith_pvm_inputs_for_levels ?level_min ?level_max () | Lazy -> (* Lazy player removes inputs from [levels_and_inputs]. *) let n = List.length levels_and_inputs in @@ -1188,8 +1184,7 @@ module Player_client = struct let new_levels_and_inputs = List.take_n (n - remove_k) levels_and_inputs in - let _state, tick, our_states = eval_inputs new_levels_and_inputs in - return (tick, our_states, new_levels_and_inputs) + return new_levels_and_inputs | Eager -> (* Eager player executes correctly the inbox until a certain point. *) let nb_of_input = @@ -1214,8 +1209,7 @@ module Player_client = struct inputs )) levels_and_inputs in - let _state, tick, our_states = eval_inputs new_levels_and_inputs in - return (tick, our_states, new_levels_and_inputs) + return new_levels_and_inputs | Keen -> (* Keen player will add more messages. *) let* new_levels_and_inputs = @@ -1227,28 +1221,33 @@ module Player_client = struct (fun (l, _) (l', _) -> Compare.Int.compare l l') new_levels_and_inputs in - let _state, tick, our_states = eval_inputs new_levels_and_inputs in - return (tick, our_states, new_levels_and_inputs) + return new_levels_and_inputs (** [gen ~rollup ~level_min ~level_max player levels_and_inputs] generates a {!player_client} based on {!player.strategy}. *) let gen ~rollup ~origination_level ~level_min ~level_max player levels_and_inputs = let open QCheck2.Gen in - let ctxt = empty_memory_ctxt "foo" in - let* tick, our_states, levels_and_inputs = - gen_our_states - ctxt + let* our_levels_and_inputs = + gen_our_levels_and_inputs player.strategy ~level_min ~level_max levels_and_inputs in + let ctxt = empty_memory_ctxt "foo" in + let _state, tick, our_states = eval_inputs ctxt our_levels_and_inputs in let inbox = - construct_inbox ~origination_level ctxt rollup levels_and_inputs + construct_inbox ~origination_level ctxt rollup our_levels_and_inputs in return - {player; final_tick = tick; states = our_states; inbox; levels_and_inputs} + { + player; + final_tick = tick; + states = our_states; + inbox; + levels_and_inputs = our_levels_and_inputs; + } end (** [create_commitment ~predecessor ~inbox_level ~our_states] creates -- GitLab From ab2bb003a68782f9e00f514fdf2d7b7492c463ac Mon Sep 17 00:00:00 2001 From: Sylvain Ribstein Date: Thu, 18 Aug 2022 16:21:48 +0200 Subject: [PATCH 3/6] test/scoru/refutation: keen inputs must be nonempty --- .../lib_protocol/test/pbt/test_refutation_game.ml | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/src/proto_alpha/lib_protocol/test/pbt/test_refutation_game.ml b/src/proto_alpha/lib_protocol/test/pbt/test_refutation_game.ml index 78ca861d03d7..9a8141dc5093 100644 --- a/src/proto_alpha/lib_protocol/test/pbt/test_refutation_game.ml +++ b/src/proto_alpha/lib_protocol/test/pbt/test_refutation_game.ml @@ -1213,7 +1213,11 @@ module Player_client = struct | Keen -> (* Keen player will add more messages. *) let* new_levels_and_inputs = - gen_arith_pvm_inputs_for_levels ?level_min ?level_max () + gen_arith_pvm_inputs_for_levels + ~nonempty_inputs:true + ?level_min + ?level_max + () in let new_levels_and_inputs = new_levels_and_inputs @ levels_and_inputs in let new_levels_and_inputs = -- GitLab From e67c41d37a192825c9a870fdc6e9042bcca35a34 Mon Sep 17 00:00:00 2001 From: Sylvain Ribstein Date: Thu, 18 Aug 2022 16:50:27 +0200 Subject: [PATCH 4/6] test/scoru: use assert instead of assume QCheck2.assume did not work for an unknown reason. --- .../lib_protocol/test/pbt/test_refutation_game.ml | 14 +++++++++++++- 1 file changed, 13 insertions(+), 1 deletion(-) diff --git a/src/proto_alpha/lib_protocol/test/pbt/test_refutation_game.ml b/src/proto_alpha/lib_protocol/test/pbt/test_refutation_game.ml index 9a8141dc5093..d4627d45d59e 100644 --- a/src/proto_alpha/lib_protocol/test/pbt/test_refutation_game.ml +++ b/src/proto_alpha/lib_protocol/test/pbt/test_refutation_game.ml @@ -1579,7 +1579,19 @@ let test_game ?nonempty_inputs ~p1_strategy ~p2_strategy () = levels_and_inputs ) -> let open Lwt_result_syntax in (* Otherwise, there is no conflict. *) - QCheck2.assume (not (p1_client.states = p2_client.states)) ; + assert ( + not + (List.equal + (fun (t, s) (t', s') -> + Tick.equal t t' && Sc_rollup.State_hash.equal s s') + p1_client.states + p2_client.states)) ; + assert ( + not + (List.equal + (fun (l, is) (l', is') -> l = l' && List.equal String.equal is is') + p1_client.levels_and_inputs + p2_client.levels_and_inputs)) ; let* block = prepare_game block -- GitLab From 381a546b19f08d14c6d25e6a9f7f79b34156b855 Mon Sep 17 00:00:00 2001 From: Sylvain Ribstein Date: Thu, 18 Aug 2022 17:19:49 +0200 Subject: [PATCH 5/6] test/scoru: make sure keen inputs not same as perfect --- .../test/pbt/test_refutation_game.ml | 44 +++++++++++++------ 1 file changed, 30 insertions(+), 14 deletions(-) diff --git a/src/proto_alpha/lib_protocol/test/pbt/test_refutation_game.ml b/src/proto_alpha/lib_protocol/test/pbt/test_refutation_game.ml index d4627d45d59e..de2adc1556c2 100644 --- a/src/proto_alpha/lib_protocol/test/pbt/test_refutation_game.ml +++ b/src/proto_alpha/lib_protocol/test/pbt/test_refutation_game.ml @@ -1212,20 +1212,32 @@ module Player_client = struct return new_levels_and_inputs | Keen -> (* Keen player will add more messages. *) - let* new_levels_and_inputs = - gen_arith_pvm_inputs_for_levels - ~nonempty_inputs:true - ?level_min - ?level_max - () - in - let new_levels_and_inputs = new_levels_and_inputs @ levels_and_inputs in - let new_levels_and_inputs = - List.sort_uniq - (fun (l, _) (l', _) -> Compare.Int.compare l l') - new_levels_and_inputs + let rec aux () = + let* new_levels_and_inputs = + gen_arith_pvm_inputs_for_levels + ~nonempty_inputs:true + ?level_min + ?level_max + () + in + let new_levels_and_inputs = + new_levels_and_inputs @ levels_and_inputs + in + let new_levels_and_inputs = + List.sort_uniq + (fun (l, _) (l', _) -> Compare.Int.compare l l') + new_levels_and_inputs + in + if + List.equal + (fun (l, is) (l', is') -> + l = l' && List.equal String.equal is is') + new_levels_and_inputs + levels_and_inputs + then aux () + else return new_levels_and_inputs in - return new_levels_and_inputs + aux () (** [gen ~rollup ~level_min ~level_max player levels_and_inputs] generates a {!player_client} based on {!player.strategy}. *) @@ -1490,6 +1502,7 @@ let gen_game ?nonempty_inputs ~p1_strategy ~p2_strategy () = p2_client, contract3, p1_start, + first_inputs, levels_and_inputs ) (** [prepare_game block lcc originated_level p1_client p2_client @@ -1533,6 +1546,7 @@ let test_game ?nonempty_inputs ~p1_strategy ~p2_strategy () = p2_client, _contract3, p1_start, + first_inputs, levels_and_inputs ) -> let level = WithExceptions.Result.get_ok ~loc:__LOC__ @@ Context.get_level (B block) @@ -1564,7 +1578,7 @@ let test_game ?nonempty_inputs ~p1_strategy ~p2_strategy () = p2_client (if p1_start then "p1" else "p2") pp_levels_and_inputs - levels_and_inputs) + ((1, first_inputs) :: levels_and_inputs)) ~count:1_000 ~name ~gen:(gen_game ?nonempty_inputs ~p1_strategy ~p2_strategy ()) @@ -1576,6 +1590,8 @@ let test_game ?nonempty_inputs ~p1_strategy ~p2_strategy () = p2_client, contract3, p1_start, + (* no need as it has already been added in the same level as origination *) + _first_inputs, levels_and_inputs ) -> let open Lwt_result_syntax in (* Otherwise, there is no conflict. *) -- GitLab From 2f85df5bfec055b060c367eae4fddc46bfcd9a9b Mon Sep 17 00:00:00 2001 From: Sylvain Ribstein Date: Thu, 18 Aug 2022 17:20:20 +0200 Subject: [PATCH 6/6] [DRAFT]: deactivate all test except keen against perfect --- .../test/pbt/test_refutation_game.ml | 107 ++++++++++++------ 1 file changed, 75 insertions(+), 32 deletions(-) diff --git a/src/proto_alpha/lib_protocol/test/pbt/test_refutation_game.ml b/src/proto_alpha/lib_protocol/test/pbt/test_refutation_game.ml index de2adc1556c2..58cb40d30ab0 100644 --- a/src/proto_alpha/lib_protocol/test/pbt/test_refutation_game.ml +++ b/src/proto_alpha/lib_protocol/test/pbt/test_refutation_game.ml @@ -327,13 +327,24 @@ let gen_arith_pvm_inputs ~gen_size = let+ inputs = sized_size gen_size @@ fix produce_inputs in snd inputs |> List.rev |> String.concat " " +(** Generate a list of arith pvm inputs for a level *) +let gen_arith_pvm_inputs ?(nonempty = false) () = + let rec aux () = + let open QCheck2.Gen in + let* input = gen_arith_pvm_inputs ~gen_size:(pure 0) in + let* rest_inputs = small_list (gen_arith_pvm_inputs ~gen_size:(pure 0)) in + let all_inputs = input :: rest_inputs in + if nonempty && Compare.List_length_with.(all_inputs = 0) then aux () + else return all_inputs + in + aux () + (** Generate a list of arith pvm inputs for a level *) let gen_arith_pvm_inputs_for_level ?(level_min = 0) ?(level_max = 1_000) () = let open QCheck2.Gen in let* level = level_min -- level_max in - let* input = gen_arith_pvm_inputs ~gen_size:(pure 0) in - let* inputs = small_list (gen_arith_pvm_inputs ~gen_size:(pure 0)) in - return (level, input :: inputs) + let* inputs = gen_arith_pvm_inputs () in + return (level, inputs) (** Generate a list of level and associated arith pvm inputs. *) let gen_arith_pvm_inputs_for_levels ?(nonempty_inputs = false) ?level_min @@ -811,7 +822,7 @@ module Dissection = struct return (expect_invalid_move expected_reason res)) - let tests = + let _tests = ( "Dissection", qcheck_wrap [ @@ -1006,6 +1017,7 @@ let construct_inbox_proto block rollup levels_and_inputs contract = (fun block (level, payloads) -> let*? current_level = Context.get_level (B block) in let diff_with_level = + (* TODO: we should use Raw_level.t in levels_and_inputs *) Raw_level.(diff (of_int32_exn (Int32.of_int level)) current_level) |> Int32.to_int in @@ -1211,11 +1223,12 @@ module Player_client = struct in return new_levels_and_inputs | Keen -> - (* Keen player will add more messages. *) + (* Keen player will add more messages in between. *) let rec aux () = let* new_levels_and_inputs = gen_arith_pvm_inputs_for_levels ~nonempty_inputs:true + (* otherwise we could end up with the same list *) ?level_min ?level_max () @@ -1449,11 +1462,7 @@ let gen_game ?nonempty_inputs ~p1_strategy ~p2_strategy () = let open QCheck2.Gen in (* If there is no good player, we do not care about the outcome. *) assert (p1_strategy = Perfect || p2_strategy = Perfect) ; - let* first_inputs = - let* input = gen_arith_pvm_inputs ~gen_size:(pure 0) in - let* inputs = small_list (gen_arith_pvm_inputs ~gen_size:(pure 0)) in - return (input :: inputs) - in + let* first_inputs = gen_arith_pvm_inputs ~nonempty:true () in let block, rollup, genesis_info, (contract1, contract2, contract3) = create_ctxt ~first_inputs in @@ -1469,10 +1478,13 @@ let gen_game ?nonempty_inputs ~p1_strategy ~p2_strategy () = Raw_level.to_int32 genesis_info.level |> Int32.to_int in let level_min = origination_level + 1 in - let level_max = origination_level + commitment_period - 1 in - let* levels_and_inputs = + let level_max = origination_level + commitment_period - 2 in + let* rest_levels_and_inputs = gen_arith_pvm_inputs_for_levels ?nonempty_inputs ~level_min ~level_max () in + let levels_and_inputs = + (origination_level, first_inputs) :: rest_levels_and_inputs + in let* p1_client = Player_client.gen ~origination_level:genesis_info.level @@ -1480,7 +1492,7 @@ let gen_game ?nonempty_inputs ~p1_strategy ~p2_strategy () = ~level_max ~rollup p1 - ((origination_level, first_inputs) :: levels_and_inputs) + levels_and_inputs in let* p2_client = Player_client.gen @@ -1489,7 +1501,7 @@ let gen_game ?nonempty_inputs ~p1_strategy ~p2_strategy () = ~level_max ~rollup p2 - ((origination_level, first_inputs) :: levels_and_inputs) + levels_and_inputs in let* p1_start = bool in let commitment_level = origination_level + commitment_period in @@ -1503,7 +1515,7 @@ let gen_game ?nonempty_inputs ~p1_strategy ~p2_strategy () = contract3, p1_start, first_inputs, - levels_and_inputs ) + rest_levels_and_inputs ) (** [prepare_game block lcc originated_level p1_client p2_client inputs_and_levels] prepares a context where [p1_client] and [p2_client] @@ -1579,7 +1591,7 @@ let test_game ?nonempty_inputs ~p1_strategy ~p2_strategy () = (if p1_start then "p1" else "p2") pp_levels_and_inputs ((1, first_inputs) :: levels_and_inputs)) - ~count:1_000 + ~count:8_000 ~name ~gen:(gen_game ?nonempty_inputs ~p1_strategy ~p2_strategy ()) (fun ( block, @@ -1605,9 +1617,40 @@ let test_game ?nonempty_inputs ~p1_strategy ~p2_strategy () = assert ( not (List.equal - (fun (l, is) (l', is') -> l = l' && List.equal String.equal is is') + (fun (l, is) (l', is') -> + Int.equal l l' && List.equal String.equal is is') p1_client.levels_and_inputs p2_client.levels_and_inputs)) ; + let*? () = + List.iter2 + ~when_different_lengths:[] + (fun (l, is) (l', is') -> + if not (Int.equal l l' && List.equal String.equal is is') then + Format.( + printf + "@[DIFF : (%d,[%a]) <> (%d,[%a])@,@]" + l + (pp_print_list + ~pp_sep:(fun ppf () -> pp_print_string ppf "; ") + pp_print_string) + is + l' + (pp_print_list + ~pp_sep:(fun ppf () -> pp_print_string ppf "; ") + pp_print_string) + is') + else + Format.( + printf + "@[EQ: (%d,[%a]) @,@]" + l + (pp_print_list + ~pp_sep:(fun ppf () -> pp_print_string ppf "; ") + pp_print_string) + is)) + p1_client.levels_and_inputs + p2_client.levels_and_inputs + in let* block = prepare_game block @@ -1648,25 +1691,25 @@ let test_game ?nonempty_inputs ~p1_strategy ~p2_strategy () = | Defender_wins -> return (defender.player.strategy = Perfect) | Refuter_wins -> return (refuter.player.strategy = Perfect)) -let test_perfect_against_random = +let _test_perfect_against_random = test_game ~p1_strategy:Perfect ~p2_strategy:Random () -let test_random_against_perfect = +let _test_random_against_perfect = test_game ~p1_strategy:Random ~p2_strategy:Perfect () -let test_perfect_against_lazy = +let _test_perfect_against_lazy = test_game ~nonempty_inputs:true ~p1_strategy:Perfect ~p2_strategy:Lazy () -let test_lazy_against_perfect = +let _test_lazy_against_perfect = test_game ~nonempty_inputs:true ~p1_strategy:Lazy ~p2_strategy:Perfect () -let test_perfect_against_eager = +let _test_perfect_against_eager = test_game ~nonempty_inputs:true ~p1_strategy:Perfect ~p2_strategy:Eager () -let test_eager_against_perfect = +let _test_eager_against_perfect = test_game ~nonempty_inputs:true ~p1_strategy:Eager ~p2_strategy:Perfect () -let test_perfect_against_keen = +let _test_perfect_against_keen = test_game ~p1_strategy:Perfect ~p2_strategy:Keen () let test_keen_against_perfect = @@ -1676,18 +1719,18 @@ let tests = ( "Refutation", qcheck_wrap [ - test_perfect_against_random; - test_random_against_perfect; - test_perfect_against_lazy; - test_lazy_against_perfect; - test_perfect_against_eager; - test_eager_against_perfect; - test_perfect_against_keen; + (* test_perfect_against_random; *) + (* test_random_against_perfect; *) + (* test_perfect_against_lazy; *) + (* test_lazy_against_perfect; *) + (* test_perfect_against_eager; *) + (* test_eager_against_perfect; *) + (* test_perfect_against_keen; *) test_keen_against_perfect; ] ) (** {2 Entry point} *) -let tests = [tests; Dissection.tests] +let tests = [tests] let () = Alcotest.run "Refutation_game" tests -- GitLab