diff --git a/test/proto_alpha/proto_alpha_helpers.ml b/test/proto_alpha/proto_alpha_helpers.ml index 621ffb3a2..ec3e5c921 100644 --- a/test/proto_alpha/proto_alpha_helpers.ml +++ b/test/proto_alpha/proto_alpha_helpers.ml @@ -244,6 +244,9 @@ module Protocol = struct open Account + let voting_period_kind ?(block = `Prevalidation) () = + Client_proto_rpcs.Context.voting_period_kind rpc_config block + let inject_proposals ?async ?force ?(block = `Prevalidation) ~src:({ pk; sk } : Account.t) proposals = Client_node_rpcs.Blocks.info rpc_config block >>=? fun block_info -> Client_proto_rpcs.Context.next_level rpc_config block >>=? fun next_level -> @@ -381,6 +384,13 @@ module Assert = struct ~eq:Protocol_hash.equal block_proto h + let check_voting_period_kind ?msg ~block kind = + Client_proto_rpcs.Context.voting_period_kind rpc_config block + >>=? fun current_kind -> + return @@ Assert.equal + ?msg:(Assert.format_msg msg) + current_kind kind + end module Mining = struct diff --git a/test/proto_alpha/proto_alpha_helpers.mli b/test/proto_alpha/proto_alpha_helpers.mli index 2d8ae1709..9c29cc231 100644 --- a/test/proto_alpha/proto_alpha_helpers.mli +++ b/test/proto_alpha/proto_alpha_helpers.mli @@ -220,6 +220,10 @@ module Assert : sig ?msg:string -> block:Client_node_rpcs.Blocks.block -> Hash.Protocol_hash.t -> unit tzresult Lwt.t + val check_voting_period_kind : + ?msg:string -> block:Client_node_rpcs.Blocks.block -> + Voting_period.kind -> unit tzresult Lwt.t + end val rpc_config: Client_rpcs.config diff --git a/test/proto_alpha/test_vote.ml b/test/proto_alpha/test_vote.ml index f153acc8f..6cd2b3729 100644 --- a/test/proto_alpha/test_vote.ml +++ b/test/proto_alpha/test_vote.ml @@ -23,6 +23,8 @@ let print_level head = let run_change_to_demo_proto block ({ b1 ; b2 ; b3 ; b4 ; b5 } : Account.bootstrap_accounts) = Mining.mine b1 block >>=? fun head -> Format.eprintf "Entering `Proposal` voting period@."; + Assert.check_voting_period_kind ~msg:__LOC__ ~block:(`Hash head) + Voting_period.Proposal >>=? fun () -> Mining.mine b2 (`Hash head) >>=? fun head -> (* 1. Propose the 'demo' protocol as b1 (during the Proposal period) *) @@ -36,6 +38,8 @@ let run_change_to_demo_proto block ({ b1 ; b2 ; b3 ; b4 ; b5 } : Account.bootstr Mining.mine ~operations:[oph] b3 (`Hash head) >>=? fun head -> Format.eprintf "Entering `Testing_vote` voting period@."; Mining.mine b4 (`Hash head) >>=? fun head -> + Assert.check_voting_period_kind ~msg:__LOC__ ~block:(`Hash head) + Voting_period.Testing_vote >>=? fun () -> (* 2. Vote unanimously for a proposal *) @@ -56,13 +60,17 @@ let run_change_to_demo_proto block ({ b1 ; b2 ; b3 ; b4 ; b5 } : Account.bootstr Mining.mine ~operations b5 (`Hash head) >>=? fun head -> Format.eprintf "Entering `Testing` voting period@."; Mining.mine b1 (`Hash head) >>=? fun head -> + Assert.check_voting_period_kind ~msg:__LOC__ ~block:(`Hash head) + Voting_period.Testing >>=? fun () -> (* 3. Test the proposed protocol *) - (* Mine blocks to switch to next vote period (Promote_vote) *) + (* Mine blocks to switch to next vote period (Promotion_vote) *) Mining.mine b2 (`Hash head) >>=? fun head -> - Format.eprintf "Entering `Promote_vote` voting period@."; + Format.eprintf "Entering `Promotion_vote` voting period@."; Mining.mine b3 (`Hash head) >>=? fun head -> + Assert.check_voting_period_kind ~msg:__LOC__ ~block:(`Hash head) + Voting_period.Promotion_vote >>=? fun () -> (* 4. Vote unanimously for promoting the protocol *) map_s (fun src -> vote_for_demo ~src ~block:(`Hash head) Vote.Yay)