Alpha/Test: added voting tests for quorum

Co-authored-by: Eugen Zalinescu <eugen.zalinescu@nomadic-labs.com>

src/proto_alpha/lib_protocol/test/helpers/account.ml

@@ -63,12 +63,16 @@ let find_alternate pkh =
 
 let dummy_account = new_account ()
 
-let generate_accounts n : (t * Tez_repr.t) list =
+let generate_accounts ?(initial_balances = []) n : (t * Tez_repr.t) list =
   Signature.Public_key_hash.Table.clear known_accounts ;
-  let amount = Tez_repr.of_mutez_exn 4_000_000_000_000L in
+  let default_amount = Tez_repr.of_mutez_exn 4_000_000_000_000L in
-  List.map (fun _ ->
+  let amount i = match List.nth_opt initial_balances i with
+    | None -> default_amount
+    | Some a -> Tez_repr.of_mutez_exn a
+  in
+  List.map (fun i ->
       let (pkh, pk, sk) = Signature.generate_key () in
       let account = { pkh ; pk ; sk } in
       Signature.Public_key_hash.Table.add known_accounts pkh account ;
-      account, amount)
+      account, amount i)
     (0--(n-1))

src/proto_alpha/lib_protocol/test/helpers/account.mli

@@ -42,6 +42,9 @@ val add_account : t -> unit
 val find: Signature.Public_key_hash.t -> t tzresult Lwt.t
 val find_alternate: Signature.Public_key_hash.t -> t
 
-(** [generate_accounts n] : generates [n] random accounts with
+(** [generate_accounts ?initial_balances n] : generates [n] random
-    4.000.000.000 tz and add them to the global account state *)
+    accounts with the initial balance of the [i]th account given by the
-val generate_accounts : int -> (t * Tez_repr.t) list
+    [i]th value in the list [initial_balances] or otherwise
+    4.000.000.000 tz (if the list is too short); and add them to the
+    global account state *)
+val generate_accounts : ?initial_balances:int64 list -> int -> (t * Tez_repr.t) list

src/proto_alpha/lib_protocol/test/helpers/context.ml

@@ -231,8 +231,9 @@ let init
     ?preserved_cycles
     ?endorsers_per_block
     ?commitments
+    ?(initial_balances = [])
     n =
-  let accounts = Account.generate_accounts n in
+  let accounts = Account.generate_accounts ~initial_balances n in
   let contracts = List.map (fun (a, _) ->
       Alpha_context.Contract.implicit_contract Account.(a.pkh)) accounts in
   begin

src/proto_alpha/lib_protocol/test/helpers/context.mli

@@ -107,4 +107,5 @@ val init:
   ?preserved_cycles:int ->
   ?endorsers_per_block:int ->
   ?commitments:Commitment_repr.t list ->
+  ?initial_balances: int64 list ->
   int -> (Block.t * Alpha_context.Contract.t list) tzresult Lwt.t

src/proto_alpha/lib_protocol/test/voting.ml

@@ -24,6 +24,7 @@
 (*****************************************************************************)
 
 open Proto_alpha
+open Test_utils
 
 (* missing stuff in Alpha_context.Vote *)
 let ballots_zero = Alpha_context.Vote.{ yay = 0l ; nay = 0l ; pass = 0l }
@@ -32,6 +33,22 @@ let ballots_equal b1 b2 =
 let ballots_pp ppf v = Alpha_context.Vote.(
     Format.fprintf ppf "{ yay = %ld ; nay = %ld ; pass = %ld" v.yay v.nay v.pass)
 
+(* constantans and ratios used in voting:
+   percent_mul denotes the percent multiplier
+   initial_qr is 8000 that is, 8/10 * percent_mul
+   the quorum ratio qr_num / den = 8 / 10
+   the participation ration pr_num / den = 2 / 10
+   note: we use the same denominator for both quorum and participation rate.
+   supermajority rate is s_num / s_den = 8 / 10 *)
+let percent_mul = 100_00
+let initial_qr = 8 * percent_mul / 10
+let qr_num = 8
+let den = 10
+let pr_num = den - qr_num
+let s_num = 8
+let s_den = 10
+
+(* Protocol_hash.zero is "PrihK96nBAFSxVL1GLJTVhu9YnzkMFiBeuJRPA8NwuZVZCE1L6i" *)
 let protos = Array.map (fun s -> Protocol_hash.of_b58check_exn s)
     [| "ProtoALphaALphaALphaALphaALphaALphaALpha61322gcLUGH" ;
        "ProtoALphaALphaALphaALphaALphaALphaALphabc2a7ebx6WB" ;
@@ -55,8 +72,27 @@ let protos = Array.map (fun s -> Protocol_hash.of_b58check_exn s)
        "ProtoALphaALphaALphaALphaALphaALphaALphaeec52dKF6Gx" ;
        "ProtoALphaALphaALphaALphaALphaALphaALpha841f2cQqajX" ; |]
 
-let test_voting () =
+(** helper functions *)
-  Context.init 5 >>=? fun (b,delegates) ->
+let mk_contracts_from_pkh pkh_list =
+  List.map (Alpha_context.Contract.implicit_contract) pkh_list
+
+(* get the list of delegates and the list of their rolls from listings *)
+let get_delegates_and_rolls_from_listings b =
+  Context.Vote.get_listings (B b) >>=? fun l ->
+  return ((mk_contracts_from_pkh (List.map fst l)), List.map snd l)
+
+(* compute the rolls of each delegate *)
+let get_rolls b delegates loc =
+  map_s (fun delegate ->
+      Context.Contract.pkh delegate >>=? fun pkh ->
+      Context.Vote.get_listings (B b) >>=? fun l ->
+      match List.find_opt (fun (del,_) -> del = pkh) l with
+      | None -> failwith "%s - Missing delegate" loc
+      | Some (_, rolls) -> return rolls
+    ) delegates
+
+let test_successful_vote num_delegates () =
+  Context.init num_delegates >>=? fun (b,_) ->
 
   (* Because of a minor bug in the initialization of the voting state, the
      listings are not populated in the very first period. After that they get
@@ -87,9 +123,9 @@ let test_voting () =
     | _ -> failwith "%s - Unexpected period kind" __LOC__
   end >>=? fun () ->
 
-  (* quorum starts at 80% *)
+  (* quorum starts at initial_qr *)
   Context.Vote.get_current_quorum (B b) >>=? fun v ->
-  Assert.equal_int ~loc:__LOC__ 8000 (Int32.to_int v) >>=? fun () ->
+  Assert.equal_int ~loc:__LOC__ initial_qr (Int32.to_int v) >>=? fun () ->
 
   (* listings must be populated in proposal period *)
   Context.Vote.get_listings (B b) >>=? begin function
@@ -97,6 +133,10 @@ let test_voting () =
     | _ -> return_unit
   end >>=? fun () ->
 
+  (* beginning of proposal, denoted by _p1;
+     take a snapshot of the active delegates and their rolls from listings *)
+  get_delegates_and_rolls_from_listings b >>=? fun (delegates_p1, rolls_p1) ->
+
   (* no proposals at the beginning of proposal period *)
   Context.Vote.get_proposals (B b) >>=? fun ps ->
   begin if Alpha_environment.Protocol_hash.Map.is_empty ps
@@ -110,9 +150,10 @@ let test_voting () =
     | Some _ -> failwith "%s - Unexpected proposal" __LOC__
   end >>=? fun () ->
 
-  let del1 = List.nth delegates 0 in
+  let del1 = List.nth delegates_p1 0 in
-  let del2 = List.nth delegates 1 in
+  let del2 = List.nth delegates_p1 1 in
-  let props = List.map (fun i -> protos.(i)) (2--Constants.max_proposals_per_delegate) in
+  let props = List.map (fun i -> protos.(i))
+      (2 -- Constants.max_proposals_per_delegate) in
   Op.proposals (B b) del1 (Protocol_hash.zero::props) >>=? fun ops1 ->
   Op.proposals (B b) del2 [Protocol_hash.zero] >>=? fun ops2 ->
   Block.bake ~operations:[ops1;ops2] b >>=? fun b ->
@@ -120,18 +161,9 @@ let test_voting () =
   (* proposals are now populated *)
   Context.Vote.get_proposals (B b) >>=? fun ps ->
 
-  (* compute the rolls of each delegate *)
-  map_s (fun delegate ->
-      Context.Contract.pkh delegate >>=? fun pkh ->
-      Context.Vote.get_listings (B b) >>=? fun l ->
-      match List.find_opt (fun (del,_) -> del = pkh) l with
-      | None -> failwith "%s - Missing delegate" __LOC__
-      | Some (_, rolls) -> return rolls
-    ) delegates >>=? fun rolls ->
-
   (* correctly count the double proposal for zero *)
   begin
-    let weight = Int32.add (List.nth rolls 0) (List.nth rolls 1) in
+    let weight = Int32.add (List.nth rolls_p1 0) (List.nth rolls_p1 1) in
     match Alpha_environment.Protocol_hash.(Map.find_opt zero ps) with
     | Some v -> if v = weight then return_unit
         else failwith "%s - Wrong count %ld is not %ld" __LOC__ v weight
@@ -154,7 +186,7 @@ let test_voting () =
     | _ -> false
   end >>=? fun () ->
 
-  (* skip to vote_testing period
+  (* skip to testing_vote period
      -1 because we already baked one block with the proposal *)
   Block.bake_n ((Int32.to_int blocks_per_voting_period)-2) b >>=? fun b ->
 
@@ -177,6 +209,10 @@ let test_voting () =
     | _ -> return_unit
   end >>=? fun () ->
 
+  (* beginning of testing_vote period, denoted by _p2;
+     take a snapshot of the active delegates and their rolls from listings *)
+  get_delegates_and_rolls_from_listings b >>=? fun (delegates_p2, rolls_p2) ->
+
   (* no proposals during testing_vote period *)
   Context.Vote.get_proposals (B b) >>=? fun ps ->
   begin if Alpha_environment.Protocol_hash.Map.is_empty ps
@@ -191,13 +227,12 @@ let test_voting () =
     | None -> failwith "%s - Missing proposal" __LOC__
   end >>=? fun () ->
 
-  (* unanimous vote *)
+  (* unanimous vote: all delegates --active when p2 started-- vote *)
   map_s (fun del ->
       Op.ballot (B b) del Protocol_hash.zero Vote.Yay)
-    delegates >>=? fun operations ->
+    delegates_p2 >>=? fun operations ->
   Block.bake ~operations b >>=? fun b ->
 
-  (* voting twice for the same proposal is not allowed *)
   Op.ballot (B b) del1 Protocol_hash.zero Vote.Nay >>=? fun op ->
   Block.bake ~operations:[op] b >>= fun res ->
   Assert.proto_error ~loc:__LOC__ res begin function
@@ -206,7 +241,7 @@ let test_voting () =
   end >>=? fun () ->
 
   fold_left_s (fun v acc -> return Int32.(add v acc))
-    0l rolls >>=? fun rolls_sum ->
+    0l rolls_p2 >>=? fun rolls_sum ->
 
   (* # of Yays in ballots matches rolls of the delegate *)
   Context.Vote.get_ballots (B b) >>=? fun v ->
@@ -223,7 +258,7 @@ let test_voting () =
             | None -> failwith "%s - Missing delegate" __LOC__
             | Some (_, Vote.Yay) -> return_unit
             | Some _ -> failwith "%s - Wrong ballot" __LOC__
-          ) delegates
+          ) delegates_p2
   end >>=? fun () ->
 
 
@@ -276,6 +311,10 @@ let test_voting () =
     | _ -> return_unit
   end >>=? fun () ->
 
+  (* beginning of promotion_vote period, denoted by _p4;
+     take a snapshot of the active delegates and their rolls from listings *)
+  get_delegates_and_rolls_from_listings b >>=? fun (delegates_p4, rolls_p4) ->
+
   (* no proposals during promotion_vote period *)
   Context.Vote.get_proposals (B b) >>=? fun ps ->
   begin if Alpha_environment.Protocol_hash.Map.is_empty ps
@@ -290,24 +329,19 @@ let test_voting () =
     | None -> failwith "%s - Missing proposal" __LOC__
   end >>=? fun () ->
 
-  (* unanimous vote *)
+  (* unanimous vote: all delegates --active when p4 started-- vote *)
   map_s (fun del ->
       Op.ballot (B b) del Protocol_hash.zero Vote.Yay)
-    delegates >>=? fun operations ->
+    delegates_p4 >>=? fun operations ->
   Block.bake ~operations b >>=? fun b ->
 
-  fold_left_s (fun acc delegate ->
+  fold_left_s (fun v acc -> return Int32.(add v acc))
-      Context.Contract.pkh delegate >>=? fun pkh ->
+    0l rolls_p4 >>=? fun rolls_sum ->
-      Context.Vote.get_listings (B b) >>=? fun l ->
-      match List.find_opt (fun (del,_) -> del = pkh) l with
-      | None -> failwith "%s - Missing delegate" __LOC__
-      | Some (_, rolls) -> return (Int32.add acc rolls)
-    ) 0l delegates >>=? fun rolls ->
 
   (* # of Yays in ballots matches rolls of the delegate *)
   Context.Vote.get_ballots (B b) >>=? fun v ->
   Assert.equal ~loc:__LOC__ ballots_equal "Unexpected ballots" ballots_pp
-    v Vote.{ yay = rolls ; nay = 0l ; pass = 0l } >>=? fun () ->
+    v Vote.{ yay = rolls_sum ; nay = 0l ; pass = 0l } >>=? fun () ->
 
   (* One Yay ballot per delegate *)
   Context.Vote.get_ballot_list (B b) >>=? begin function
@@ -319,7 +353,7 @@ let test_voting () =
             | None -> failwith "%s - Missing delegate" __LOC__
             | Some (_, Vote.Yay) -> return_unit
             | Some _ -> failwith "%s - Wrong ballot" __LOC__
-          ) delegates
+          ) delegates_p4
   end >>=? fun () ->
 
   (* skip to end of promotion_vote period and activation*)
@@ -332,21 +366,199 @@ let test_voting () =
 
   return_unit
 
-let test_period1 () =
+(* given a list of active delegates,
-  Context.init 10 >>=? fun (b,delegates) ->
+   return the first k active delegates with which one can have quorum, that is:
+   their roll sum divided by the total roll sum is bigger than qr_num/qr_den *)
+let get_smallest_prefix_voters_for_quorum active_delegates active_rolls =
+  fold_left_s (fun v acc -> return Int32.(add v acc))
+    0l active_rolls >>=? fun active_rolls_sum ->
+  let rec loop delegates rolls sum selected =
+    match delegates, rolls with
+    | [], [] -> selected
+    | del :: delegates, del_rolls :: rolls ->
+        if den * sum < qr_num * (Int32.to_int active_rolls_sum) then
+          loop delegates rolls (sum + (Int32.to_int del_rolls)) (del :: selected)
+        else selected
+    | _, _ -> [] in
+  return (loop active_delegates active_rolls 0 [])
 
+let get_expected_quorum ?(min_participation=0) rolls voter_rolls old_quorum =
+  (* formula to compute the updated quorum as in the whitepaper *)
+  let get_updated_quorum old_quorum participation =
+    (* if not enough participation, don't update the quorum *)
+    if participation < min_participation
+    then (Int32.to_int old_quorum)
+    else (qr_num * (Int32.to_int old_quorum) +
+          pr_num * participation) / den
+  in
+  fold_left_s (fun v acc -> return Int32.(add v acc))
+    0l rolls >>=? fun rolls_sum ->
+  fold_left_s (fun v acc -> return Int32.(add v acc))
+    0l voter_rolls >>=? fun voter_rolls_sum ->
+  let participation = (Int32.to_int voter_rolls_sum) * percent_mul /
+                      (Int32.to_int rolls_sum) in
+  return (get_updated_quorum old_quorum participation)
+
+(* if not enough quorum -- get_updated_quorum < qr_num/qr_den -- in testing vote,
+   go back to proposal period *)
+let test_not_enough_quorum_in_testing_vote num_delegates () =
+  Context.init num_delegates >>=? fun (b,delegates) ->
+
+  (* Because of a minor bug in the initialization of the voting state, the
+     listings are not populated in the very first period. After that they get
+     correctly populated. An empty listing means no proposals will be accepted. *)
   Context.get_constants (B b) >>=? fun { parametric = {blocks_per_voting_period} } ->
   Block.bake_n (Int32.to_int blocks_per_voting_period) b >>=? fun b ->
 
-  let del1 = List.nth delegates 0 in
+  (* proposal period *)
-  let del2 = List.nth delegates 1 in
+  let open Alpha_context in
+  Context.Vote.get_current_period_kind (B b) >>=? begin function
+    | Proposal -> return_unit
+    | _ -> failwith "%s - Unexpected period kind" __LOC__
+  end >>=? fun () ->
 
-  Op.proposals (B b) del1 [protos.(0)] >>=? fun ops1 ->
+  let proposer = List.nth delegates 0 in
-  Op.proposals (B b) del2 [protos.(1)] >>=? fun ops2 ->
+  Op.proposals (B b) proposer [Protocol_hash.zero] >>=? fun ops ->
-  Block.bake ~operations:[ops1;ops2] b >>=? fun b ->
+  Block.bake ~operations:[ops] b >>=? fun b ->
+
+  (* skip to vote_testing period
+     -1 because we already baked one block with the proposal *)
+  Block.bake_n ((Int32.to_int blocks_per_voting_period)-2) b >>=? fun b ->
+
+  (* we moved to a testing_vote period with one proposal *)
+  Context.Vote.get_current_period_kind (B b) >>=? begin function
+    | Testing_vote -> return_unit
+    | _ -> failwith "%s - Unexpected period kind" __LOC__
+  end >>=? fun () ->
+
+  Context.Vote.get_current_quorum (B b) >>=? fun initial_quorum ->
+  (* beginning of testing_vote period, denoted by _p2;
+     take a snapshot of the active delegates and their rolls from listings *)
+  get_delegates_and_rolls_from_listings b >>=? fun (delegates_p2, rolls_p2) ->
+
+  get_smallest_prefix_voters_for_quorum delegates_p2 rolls_p2 >>=? fun voters ->
+  (* take the first voter out so there cannot be quorum *)
+  let voters_without_quorum = List.tl voters in
+  get_rolls b voters_without_quorum __LOC__ >>=? fun voters_rolls_in_testing_vote ->
+
+  (* all voters_without_quorum vote, for yays;
+     no nays, so supermajority is satisfied *)
+  map_s (fun del ->
+      Op.ballot (B b) del Protocol_hash.zero Vote.Yay)
+    voters_without_quorum >>=? fun operations ->
+  Block.bake ~operations b >>=? fun b ->
+
+  (* skip to testing period *)
   Block.bake_n ((Int32.to_int blocks_per_voting_period)-1) b >>=? fun b ->
 
-  (* we remain in the proposal when there is no winner *)
+  (* we move back to the proposal period because not enough quorum *)
+  Context.Vote.get_current_period_kind (B b) >>=? begin function
+    | Proposal -> return_unit
+    | _ -> failwith "%s - Unexpected period kind" __LOC__
+  end >>=? fun () ->
+
+  (* check quorum update *)
+  get_expected_quorum rolls_p2
+    voters_rolls_in_testing_vote initial_quorum >>=? fun expected_quorum ->
+  Context.Vote.get_current_quorum (B b) >>=? fun new_quorum ->
+  (* assert the formula to calculate quorum is correct *)
+  Assert.equal_int ~loc:__LOC__ expected_quorum
+    (Int32.to_int new_quorum) >>=? fun () ->
+
+  return_unit
+
+(* if not enough quorum -- get_updated_quorum < qr_num/qr_den -- in promotion vote,
+   go back to proposal period *)
+let test_not_enough_quorum_in_promotion_vote num_delegates () =
+  Context.init num_delegates >>=? fun (b,delegates) ->
+  (* Because of a minor bug in the initialization of the voting state, the
+     listings are not populated in the very first period. After that they get
+     correctly populated. An empty listing means no proposals will be accepted. *)
+  Context.get_constants (B b) >>=? fun { parametric = {blocks_per_voting_period} } ->
+  Block.bake_n (Int32.to_int blocks_per_voting_period) b >>=? fun b ->
+
+  Context.Vote.get_current_period_kind (B b) >>=? begin function
+    | Proposal -> return_unit
+    | _ -> failwith "%s - Unexpected period kind" __LOC__
+  end >>=? fun () ->
+
+  let proposer = List.nth delegates 0 in
+  Op.proposals (B b) proposer (Protocol_hash.zero::[]) >>=? fun ops ->
+  Block.bake ~operations:[ops] b >>=? fun b ->
+
+  (* skip to vote_testing period
+     -1 because we already baked one block with the proposal *)
+  Block.bake_n ((Int32.to_int blocks_per_voting_period)-2) b >>=? fun b ->
+
+  (* we moved to a testing_vote period with one proposal *)
+  Context.Vote.get_current_period_kind (B b) >>=? begin function
+    | Testing_vote -> return_unit
+    | _ -> failwith "%s - Unexpected period kind" __LOC__
+  end >>=? fun () ->
+
+  (* beginning of testing_vote period, denoted by _p2;
+     take a snapshot of the active delegates and their rolls from listings *)
+  get_delegates_and_rolls_from_listings b >>=? fun (delegates_p2, rolls_p2) ->
+
+  get_smallest_prefix_voters_for_quorum delegates_p2 rolls_p2 >>=? fun voters ->
+
+  let open Alpha_context in
+
+  (* all voters vote, for yays;
+       no nays, so supermajority is satisfied *)
+  map_s (fun del ->
+      Op.ballot (B b) del Protocol_hash.zero Vote.Yay)
+    voters >>=? fun operations ->
+
+  Block.bake ~operations b >>=? fun b ->
+
+  (* skip to testing period *)
+  Block.bake_n ((Int32.to_int blocks_per_voting_period)-1) b >>=? fun b ->
+
+  (* we move to testing because we have supermajority and enough quorum *)
+  Context.Vote.get_current_period_kind (B b) >>=? begin function
+    | Testing -> return_unit
+    | _ -> failwith "%s - Unexpected period kind" __LOC__
+  end >>=? fun () ->
+
+  (* skip to promotion_vote period *)
+  Block.bake_n (Int32.to_int blocks_per_voting_period) b >>=? fun b ->
+
+  Context.Vote.get_current_period_kind (B b) >>=? begin function
+    | Promotion_vote -> return_unit
+    | _ -> failwith "%s - Unexpected period kind" __LOC__
+  end >>=? fun () ->
+
+  Context.Vote.get_current_quorum (B b) >>=? fun initial_quorum ->
+  (* beginning of promotion period, denoted by _p4;
+     take a snapshot of the active delegates and their rolls from listings *)
+  get_delegates_and_rolls_from_listings b >>=? fun (delegates_p4, rolls_p4) ->
+  get_smallest_prefix_voters_for_quorum delegates_p4 rolls_p4 >>=? fun voters ->
+
+  (* take the first voter out so there cannot be quorum *)
+  let voters_without_quorum = List.tl voters in
+  get_rolls b voters_without_quorum __LOC__ >>=? fun voter_rolls ->
+
+  (* all voters_without_quorum vote, for yays;
+     no nays, so supermajority is satisfied *)
+  map_s (fun del ->
+      Op.ballot (B b) del Protocol_hash.zero Vote.Yay)
+    voters_without_quorum >>=? fun operations ->
+  Block.bake ~operations b >>=? fun b ->
+
+  (* skip to end of promotion_vote period *)
+  Block.bake_n ((Int32.to_int blocks_per_voting_period)-1) b >>=? fun b ->
+
+  get_expected_quorum rolls_p4 voter_rolls
+    initial_quorum >>=? fun expected_quorum ->
+
+  Context.Vote.get_current_quorum (B b) >>=? fun new_quorum ->
+
+  (* assert the formula to calculate quorum is correct *)
+  Assert.equal_int ~loc:__LOC__ expected_quorum
+    (Int32.to_int new_quorum) >>=? fun () ->
+
+  (* we move back to the proposal period because not enough quorum *)
   Context.Vote.get_current_period_kind (B b) >>=? begin function
     | Proposal -> return_unit
     | _ -> failwith "%s - Unexpected period kind" __LOC__
@@ -354,8 +566,106 @@ let test_period1 () =
 
   return_unit
 
+let test_multiple_identical_proposals_count_as_one () =
+  Context.init 1 >>=? fun (b,delegates) ->
 
-let test_period2_supermajority supermajority () =
+  (* Because of a minor bug in the initialization of the voting state, the
+     listings are not populated in the very first period. After that they get
+     correctly populated. An empty listing means no proposals will be accepted. *)
+  Context.get_constants (B b) >>=? fun { parametric = {blocks_per_voting_period} } ->
+  Block.bake_n (Int32.to_int blocks_per_voting_period) b >>=? fun b ->
+
+  Context.Vote.get_current_period_kind (B b) >>=? begin function
+    | Proposal -> return_unit
+    | _ -> failwith "%s - Unexpected period kind" __LOC__
+  end >>=? fun () ->
+
+  let proposer = List.hd delegates in
+  Op.proposals (B b) proposer
+    [Protocol_hash.zero; Protocol_hash.zero] >>=? fun ops ->
+  Block.bake ~operations:[ops] b >>=? fun b ->
+  (* compute the weight of proposals *)
+  Context.Vote.get_proposals (B b) >>=? fun ps ->
+
+  (* compute the rolls of proposer *)
+  Context.Contract.pkh proposer >>=? fun pkh ->
+  Context.Vote.get_listings (B b) >>=? fun l ->
+  begin match List.find_opt (fun (del,_) -> del = pkh) l with
+    | None -> failwith "%s - Missing delegate" __LOC__
+    | Some (_, proposer_rolls) -> return proposer_rolls
+  end >>=? fun proposer_rolls ->
+
+  (* correctly count the double proposal for zero as one proposal *)
+  let expected_weight_proposer = proposer_rolls in
+  match Alpha_environment.Protocol_hash.(Map.find_opt zero ps) with
+  | Some v -> if v = expected_weight_proposer then return_unit
+      else failwith
+          "%s - Wrong count %ld is not %ld; identical proposals count as one"
+          __LOC__ v expected_weight_proposer
+  | None -> failwith "%s - Missing proposal" __LOC__
+
+
+(* assumes the initial balance of allocated by Context.init is at
+   least 4 time the value of the tokens_per_roll constant *)
+let test_supermajority_in_proposal there_is_a_winner () =
+  Context.init ~initial_balances:[1L; 1L; 1L] 10 >>=? fun (b,delegates) ->
+  Context.get_constants (B b)
+  >>=? fun { parametric = {blocks_per_cycle; blocks_per_voting_period; tokens_per_roll} } ->
+
+  let del1 = List.nth delegates 0 in
+  let del2 = List.nth delegates 1 in
+  let del3 = List.nth delegates 2 in
+
+  map_s (fun del -> Context.Contract.pkh del) [del1; del2; del3] >>=? fun pkhs ->
+  let policy = Block.Excluding pkhs in
+
+  Op.transaction (B b) (List.nth delegates 3) del1 tokens_per_roll >>=? fun op1 ->
+  Op.transaction (B b) (List.nth delegates 4) del2 tokens_per_roll >>=? fun op2 ->
+  begin
+    if there_is_a_winner
+    then Test_tez.Tez.( *? ) tokens_per_roll 3L
+    else Test_tez.Tez.( *? ) tokens_per_roll 2L
+  end >>?= fun bal3 ->
+  Op.transaction (B b) (List.nth delegates 5) del3 bal3 >>=? fun op3 ->
+
+  Block.bake ~policy ~operations:[op1; op2; op3] b >>=? fun b ->
+
+  (* to avoid the bug where the listings are not initialized, we let
+     one voting period pass; we make sure that the three selected
+     delegates remain active and their number of rolls do not change *)
+  let amount = let open Test_tez in Tez.of_int 10 in
+  fold_left_s (fun b _ ->
+      Op.transaction (B b) del1 del2 amount >>=? fun op1 ->
+      Op.transaction (B b) del2 del3 amount >>=? fun op2 ->
+      Op.transaction (B b) del3 del1 amount >>=? fun op3 ->
+      Block.bake ~policy ~operations:[op1; op2; op3] b >>=? fun b ->
+      Block.bake_until_cycle_end ~policy b
+    ) b (1 --
+         (Int32.to_int (Int32.div blocks_per_voting_period blocks_per_cycle))) >>=? fun b ->
+
+  (* make the proposals *)
+  Op.proposals (B b) del1 [protos.(0)] >>=? fun ops1 ->
+  Op.proposals (B b) del2 [protos.(0)] >>=? fun ops2 ->
+  Op.proposals (B b) del3 [protos.(1)] >>=? fun ops3 ->
+  Block.bake ~policy ~operations:[ops1;ops2;ops3] b >>=? fun b ->
+  Block.bake_n ~policy ((Int32.to_int blocks_per_voting_period)-1) b >>=? fun b ->
+
+  (* we remain in the proposal period when there is no winner,
+     otherwise we move to the testing vote period *)
+  Context.Vote.get_current_period_kind (B b) >>=? begin function
+    | Testing_vote ->
+        if there_is_a_winner then return_unit
+        else failwith "%s - Expected period kind Proposal, obtained Testing_vote" __LOC__
+    | Proposal ->
+        if not there_is_a_winner then return_unit
+        else failwith "%s - Expected period kind Testing_vote, obtained Proposal" __LOC__
+    | _ -> failwith "%s - Unexpected period kind" __LOC__
+  end >>=? fun () ->
+
+  return_unit
+
+
+let test_supermajority_in_testing_vote supermajority () =
   Context.init 100 >>=? fun (b,delegates) ->
 
   Context.get_constants (B b) >>=? fun { parametric = {blocks_per_voting_period} } ->
@@ -368,7 +678,7 @@ let test_period2_supermajority supermajority () =
   Block.bake ~operations:[ops1] b >>=? fun b ->
   Block.bake_n ((Int32.to_int blocks_per_voting_period)-1) b >>=? fun b ->
 
-  (* we remain in the proposal when there is no winner *)
+  (* move to testing_vote *)
   Context.Vote.get_current_period_kind (B b) >>=? begin function
     | Testing_vote -> return_unit
     | _ -> failwith "%s - Unexpected period kind" __LOC__
@@ -381,21 +691,21 @@ let test_period2_supermajority supermajority () =
     | None -> failwith "%s - Missing proposal" __LOC__
   end >>=? fun () ->
 
-  (* majority/minority vote depending on the [ok] parameter *)
+  (* beginning of testing_vote period, denoted by _p2;
-  filter_s
+     take a snapshot of the active delegates and their rolls from listings *)
-    (fun del ->
+  get_delegates_and_rolls_from_listings b >>=? fun (delegates_p2, _olls_p2) ->
-       Context.Contract.pkh del >>=? fun pkh ->
-       Context.Delegate.info (B b) pkh >>=? fun {deactivated} -> return (not deactivated))
-    delegates >>=? fun active_delegates ->
 
-  let num_delegates = List.length active_delegates in
+  (* supermajority means [num_yays / (num_yays + num_nays) >= s_num / s_den],
-  let num_nays = num_delegates / 5 in
+     which is equivalent with [num_yays >= num_nays * s_num / (s_den - s_num)] *)
-  let num_yays = num_nays * 4 in
+  let num_delegates = List.length delegates_p2 in
+  let num_nays = num_delegates / 5 in (* any smaller number will do as well *)
+  let num_yays = num_nays * s_num / (s_den - s_num) in
+  (* majority/minority vote depending on the [supermajority] parameter *)
   let num_yays = if supermajority then num_yays else num_yays - 1 in
 
   let open Alpha_context in
 
-  let nays_delegates, rest = List.split_n num_nays active_delegates in
+  let nays_delegates, rest = List.split_n num_nays delegates_p2 in
   let yays_delegates, _ = List.split_n num_yays rest in
   map_s (fun del ->
       Op.ballot (B b) del proposal Vote.Yay)
@@ -414,16 +724,55 @@ let test_period2_supermajority supermajority () =
         else failwith "%s - Expected period kind Proposal, obtained Testing" __LOC__
     | Proposal ->
         if not supermajority then return_unit
-        else failwith "%s - Expected period kind Proposal, obtained Testing_vote" __LOC__
+        else failwith "%s - Expected period kind Testing_vote, obtained Proposal" __LOC__
     | _ -> failwith "%s - Unexpected period kind" __LOC__
   end >>=? fun () ->
 
   return_unit
 
+(* test also how the selection scales: all delegates propose max proposals *)
+let test_no_winning_proposal num_delegates () =
+  Context.init num_delegates >>=? fun (b,_) ->
+
+  (* Because of a minor bug in the initialization of the voting state, the
+     listings are not populated in the very first period. After that they get
+     correctly populated. An empty listing means no proposals will be accepted. *)
+  Context.get_constants (B b) >>=? fun { parametric = {blocks_per_voting_period} } ->
+  Block.bake_n (Int32.to_int blocks_per_voting_period) b >>=? fun b ->
+
+  (* beginning of proposal, denoted by _p1;
+     take a snapshot of the active delegates and their rolls from listings *)
+  get_delegates_and_rolls_from_listings b >>=? fun (delegates_p1, _rolls_p1) ->
+
+  let open Alpha_context in
+  let props = List.map (fun i -> protos.(i))
+      (1 -- Constants.max_proposals_per_delegate) in
+  (* all delegates active in p1 propose the same proposals *)
+  map_s
+    (fun del -> Op.proposals (B b) del props)
+    delegates_p1 >>=? fun ops_list ->
+  Block.bake ~operations:ops_list b >>=? fun b ->
+
+  (* skip to testing_vote period
+     -1 because we already baked one block with the proposal *)
+  Block.bake_n ((Int32.to_int blocks_per_voting_period)-2) b >>=? fun b ->
+
+  (* we stay in the same proposal period because no winning proposal *)
+  Context.Vote.get_current_period_kind (B b) >>=? begin function
+    | Proposal -> return_unit
+    | _ -> failwith "%s - Unexpected period kind" __LOC__
+  end >>=? fun () ->
+
+  return_unit
 
 let tests = [
-  Test.tztest "voting" `Quick (test_voting) ;
+  Test.tztest "voting successful_vote" `Quick (test_successful_vote 137) ;
-  Test.tztest "voting: test period 1" `Quick (test_period1) ;
+  Test.tztest "voting testing vote, not enough quorum" `Quick (test_not_enough_quorum_in_testing_vote 245) ;
-  Test.tztest "voting: test period 2, with supermajority" `Quick (test_period2_supermajority true) ;
+  Test.tztest "voting promotion vote, not enough quorum" `Quick (test_not_enough_quorum_in_promotion_vote 432) ;
-  Test.tztest "voting: test period 2, without supermajority" `Quick (test_period2_supermajority false) ;
+  Test.tztest "voting counting double proposal" `Quick test_multiple_identical_proposals_count_as_one;
+  Test.tztest "voting proposal, with supermajority" `Quick (test_supermajority_in_proposal true) ;
+  Test.tztest "voting proposal, without supermajority" `Quick (test_supermajority_in_proposal false) ;
+  Test.tztest "voting testing vote, with supermajority" `Quick (test_supermajority_in_testing_vote true) ;
+  Test.tztest "voting testing vote, without supermajority" `Quick (test_supermajority_in_testing_vote false) ;
+  Test.tztest "voting proposal, no winning proposal" `Quick (test_no_winning_proposal 400) ;
 ]