Alpha/Test: fix tests failing when tokens_per_roll changes

This commit fixes the tests (except those from voting.ml) which failed when the value
of tokens_per_roll (from src/proto_alpha/lib_protocol/src/constants_repr.ml) changes.

Notably, 2 functions were deleted with get next baker by priority from double_baking.
They were used only in one test and they were creating pairs of baker and index,
but this index did not necessarily correspond to the baker's priority.

src/proto_alpha/lib_protocol/test/delegation.ml

@@ -67,7 +67,8 @@ let bootstrap_delegate_cannot_change ~fee () =
   Context.init 2 >>=? fun (b, bootstrap_contracts) ->
   let bootstrap0 = List.nth bootstrap_contracts 0 in
   let bootstrap1 = List.nth bootstrap_contracts 1 in
-  Incremental.begin_construction b >>=? fun i ->
+  Context.Contract.pkh bootstrap0 >>=? fun pkh1 ->
+  Incremental.begin_construction b ~policy:(Block.Excluding [pkh1]) >>=? fun i ->
   Context.Contract.manager (I i) bootstrap1 >>=? fun manager1 ->
   Context.Contract.balance (I i) bootstrap0 >>=? fun balance0 ->
   Context.Contract.delegate (I i) bootstrap0 >>=? fun delegate0 ->

src/proto_alpha/lib_protocol/test/double_baking.ml

@@ -44,17 +44,6 @@ let get_first_different_bakers ctxt =
   get_first_different_baker baker_1 (List.tl bakers) >>=? fun baker_2 ->
   return (baker_1, baker_2)
 
-let get_first_different_baker_priority baker bakers =
-  return @@ List.find (fun baker' ->
-      Signature.Public_key_hash.(<>) baker @@ fst baker')
-  @@ List.mapi (fun i x -> x, i) @@ bakers
-
-let get_first_different_bakers_priority ctxt =
-  Context.get_bakers ctxt >>=? fun bakers ->
-  let baker_1 = List.hd bakers in
-  get_first_different_baker_priority baker_1 bakers >>=? fun baker_2_p ->
-  return ((baker_1, 0), baker_2_p)
-
 let get_first_different_endorsers ctxt =
   Context.get_endorsers ctxt >>=? fun endorsers ->
   let endorser_1 = (List.hd endorsers).delegate in
@@ -169,19 +158,18 @@ let different_delegates () =
     | Apply.Inconsistent_double_baking_evidence _ -> true
     | _ -> false end
 
-let wrong_delegate () =
+let wrong_signer () =
-  (* Bakes a block with a correct priority and timestamp but
+  (* Baker_2 bakes a block but baker signs it. *)
-     signed by an arbitrary baker *)
+  let header_custom_signer baker baker_2 b =
-  let header_custom_signer baker priority b =
+    Block.Forge.forge_header ~policy:(By_account baker_2) b >>=? fun header ->
-    Block.Forge.forge_header ~policy:(By_priority priority) b >>=? fun header ->
     Block.Forge.set_baker baker header |>
     Block.Forge.sign_header
   in
 
   Context.init 2 >>=? fun (b, _) ->
-  get_first_different_bakers_priority (B b) >>=? fun ((baker_1, _), (_, p_2)) ->
+  get_first_different_bakers (B b) >>=? fun (baker_1, baker_2) ->
   Block.bake ~policy:(By_account baker_1) b >>=? fun blk_a ->
-  header_custom_signer baker_1 p_2 b >>=? fun header_b ->
+  header_custom_signer baker_1 baker_2 b >>=? fun header_b ->
   Op.double_baking (B blk_a) blk_a.header header_b >>=? fun operation ->
   Block.bake ~operation blk_a >>= fun e ->
   Assert.proto_error ~loc:__LOC__ e begin function
@@ -197,5 +185,5 @@ let tests = [
   Test.tztest "too early double baking evidence" `Quick too_early_double_baking_evidence ;
   Test.tztest "too late double baking evidence" `Quick too_late_double_baking_evidence ;
   Test.tztest "different delegates" `Quick different_delegates ;
-  Test.tztest "wrong delegate" `Quick wrong_delegate ;
+  Test.tztest "wrong delegate" `Quick wrong_signer ;
 ]

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

@@ -53,8 +53,9 @@ let rpc_ctxt =
   new Alpha_environment.proto_rpc_context_of_directory
     rpc_context Proto_alpha.rpc_services
 
-let begin_construction ?(priority=0) ?timestamp (predecessor : Block.t) =
+let begin_construction ?(priority=0) ?timestamp
-  Block.get_next_baker ~policy:(Block.By_priority priority)
+    ?(policy=Block.By_priority priority) (predecessor : Block.t) =
+  Block.get_next_baker ~policy
     predecessor >>=? fun (delegate, priority, real_timestamp) ->
   Account.find delegate >>=? fun delegate ->
   let timestamp = Option.unopt ~default:real_timestamp timestamp in

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

@@ -37,7 +37,9 @@ val level: incremental -> int32
 val begin_construction:
   ?priority:int ->
   ?timestamp:Time.t ->
-  Block.t -> incremental tzresult Lwt.t
+  ?policy:Block.baker_policy ->
+  Block.t ->
+  incremental tzresult Lwt.t
 
 val add_operation:
   ?expect_failure:(error list -> unit tzresult Lwt.t) ->

src/proto_alpha/lib_protocol/test/seed.ml

@@ -53,11 +53,12 @@ let no_commitment () =
     | _ -> false
   end
 
-(** Tests that:
+(** Choose a baker, denote it by id. In the first cycle, make id bake only once.
-    - after baking with a commitment the bond is frozen and the reward allocated
+    Test that:
-    - revealing too early produces an error
+    - after id bakes with a commitment the bond is frozen and the reward allocated
-    - revealing at the right time but the wrong value produces an error
+    - when id reveals the nonce too early, there's an error
-    - revealing correctly rewards the baker with the tip
+    - when id reveals at the right time but the wrong value, there's an error
+    - when another baker reveals correctly, it receives the tip
     - revealing twice produces an error
     - after [preserved cycles] a committer that correctly revealed
       receives back the bond and the reward
@@ -73,15 +74,18 @@ let revelation_early_wrong_right_twice () =
   let blocks_per_commitment = Int32.to_int csts.parametric.blocks_per_commitment in
   let preserved_cycles = csts.parametric.preserved_cycles in
 
-  (* bake until commitment *)
+  (* get the pkh of a baker *)
-  Block.bake_n (blocks_per_commitment-2) b >>=? fun b ->
-  (* the next baker [id] will include a seed_nonce commitment *)
   Block.get_next_baker b >>=? fun (pkh,_,_) ->
   let id = Alpha_context.Contract.implicit_contract pkh in
+  let policy = Block.Excluding [pkh] in
+  (* bake until commitment, excluding id *)
+  Block.bake_n ~policy (blocks_per_commitment-2) b >>=? fun b ->
   Context.Contract.balance ~kind:Main (B b) id >>=? fun bal_main ->
   Context.Contract.balance ~kind:Deposit (B b) id >>=? fun bal_deposit ->
   Context.Contract.balance ~kind:Rewards (B b) id >>=? fun bal_rewards ->
-  Block.bake b >>=? fun b ->
+
+  (* the baker [id] will include a seed_nonce commitment *)
+  Block.bake ~policy:(Block.By_account pkh) b >>=? fun b ->
   Context.get_level (B b) >>=? fun level_commitment ->
   Context.get_seed_nonce_hash (B b) >>=? fun committed_hash ->
 
@@ -95,14 +99,14 @@ let revelation_early_wrong_right_twice () =
 
   (* test that revealing too early produces an error *)
   Op.seed_nonce_revelation (B b) level_commitment (Nonce.get committed_hash) >>=? fun operation ->
-  Block.bake ~operation b >>= fun e ->
+
+  Block.bake ~policy ~operation b >>= fun e ->
   let expected = function
     | Nonce_storage.Too_early_revelation -> true
     | _ -> false in
   Assert.proto_error ~loc:__LOC__ e expected >>=? fun () ->
 
-  (* finish the cycle excluding the committing baker *)
+  (* finish the cycle excluding the committing baker, id *)
-  let policy = Block.Excluding [pkh] in
   Block.bake_until_cycle_end ~policy b >>=? fun b ->
 
   (* test that revealing at the right time but the wrong value produces an error *)
@@ -121,6 +125,7 @@ let revelation_early_wrong_right_twice () =
   Context.Contract.balance ~kind:Main (B b) baker >>=? fun baker_bal_main ->
   Context.Contract.balance ~kind:Deposit (B b) baker >>=? fun baker_bal_deposit ->
   Context.Contract.balance ~kind:Rewards (B b) baker >>=? fun baker_bal_rewards ->
+
   (* bake the operation in a block *)
   Block.bake ~policy ~operation b >>=? fun b ->
 
@@ -135,7 +140,7 @@ let revelation_early_wrong_right_twice () =
 
   (* test that revealing twice produces an error *)
   Op.seed_nonce_revelation (B b) level_commitment (Nonce.get wrong_hash) >>=? fun operation ->
-  Block.bake ~operation b >>= fun e ->
+  Block.bake ~operation ~policy b >>= fun e ->
   Assert.proto_error ~loc:__LOC__ e begin function
     | Nonce_storage.Previously_revealed_nonce -> true
     | _ -> false
@@ -146,6 +151,8 @@ let revelation_early_wrong_right_twice () =
     b (1 -- preserved_cycles) >>=? fun b ->
 
   (* test that [id] receives back the bond and the reward *)
+  (* note that in order to have that new_bal = bal_main + reward,
+     id can only bake once; this is why we exclude id from all other bake ops. *)
   balance_was_credited ~loc:__LOC__
     (B b) id ~kind:Main bal_main reward >>=? fun () ->
   balance_is ~loc:__LOC__

src/proto_alpha/lib_protocol/test/transfer.ml

@@ -214,11 +214,15 @@ let transfer_to_originate_with_fee () =
 
 let transfer_amount_of_contract_balance () =
   register_two_contracts () >>=? fun (b, contract_1, contract_2) ->
-  Incremental.begin_construction b >>=? fun b ->
+  Context.Contract.pkh contract_1 >>=? fun pkh1 ->
+  (* given that contract_1 no longer has a sufficient balance to bake,
+     make sure it cannot be chosen as baker *)
+  Incremental.begin_construction b ~policy:(Block.Excluding [pkh1]) >>=? fun b ->
   (* get the balance of the source contract *)
   Context.Contract.balance (I b) contract_1 >>=? fun balance ->
   (* transfer all the tez inside contract 1 *)
-  transfer_and_check_balances ~loc:__LOC__ b contract_1 contract_2 balance >>=? fun (b,_) ->
+  transfer_and_check_balances ~loc:__LOC__
+    b contract_1 contract_2 balance >>=? fun (b,_) ->
   Incremental.finalize_block b >>=? fun _ ->
   return_unit
 
@@ -245,7 +249,10 @@ let transfers_to_self () =
 
 let missing_transaction () =
   register_two_contracts () >>=? fun (b, contract_1, contract_2) ->
-  Incremental.begin_construction b >>=? fun b ->
+  (* given that contract_1 no longer has a sufficient balance to bake,
+     make sure it cannot be chosen as baker *)
+  Context.Contract.pkh contract_1 >>=? fun pkh1 ->
+  Incremental.begin_construction b ~policy:(Block.Excluding [pkh1]) >>=? fun b ->
   two_nth_of_balance b contract_1 6L >>=? fun amount ->
   (* do the transfer 3 times from source contract to destination contract *)
   n_transactions 3 b contract_1 contract_2 amount >>=? fun b ->
@@ -580,9 +587,12 @@ let random_contract contract_array =
 let random_transfer () =
   Context.init 10 >>=? fun (b, contracts) ->
   let contracts = Array.of_list contracts in
-  Incremental.begin_construction b >>=? fun b ->
   let source = random_contract contracts in
   let dest = random_contract contracts in
+  Context.Contract.pkh source >>=? fun source_pkh ->
+  (* given that source may not have a sufficient balance for the transfer + to bake, 
+     make sure it cannot be chosen as baker *)
+  Incremental.begin_construction b ~policy:(Block.Excluding [source_pkh]) >>=? fun b ->
   Context.Contract.balance (I b) source >>=? fun amount ->
   begin
     if source = dest