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 790331336879d178f924bc1c555de94c1febe9bd..58cb40d30ab0e5a483a61843cd401b2b389e892f 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
@@ -1024,17 +1036,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"
@@ -1076,7 +1088,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 +1101,21 @@ let pp_player_client ppf
     ppf
     "@[<v 2>player:@,\
      %a@]@,\
-     @[<v 2>states:@,\
+     @[<v 2>ticks and states:@,\
      %a@]@,\
      final tick: %a@,\
      @[<v 2>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
 
@@ -1123,6 +1133,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.
@@ -1162,27 +1179,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
@@ -1190,8 +1196,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 =
@@ -1216,41 +1221,62 @@ 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 =
-          gen_arith_pvm_inputs_for_levels ?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
+        (* 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
+              ()
+          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
-        let _state, tick, our_states = eval_inputs new_levels_and_inputs in
-        return (tick, our_states, new_levels_and_inputs)
+        aux ()
 
   (** [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
@@ -1436,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
@@ -1456,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
@@ -1467,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
@@ -1476,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
@@ -1489,7 +1514,8 @@ let gen_game ?nonempty_inputs ~p1_strategy ~p2_strategy () =
       p2_client,
       contract3,
       p1_start,
-      levels_and_inputs )
+      first_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]
@@ -1532,6 +1558,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)
@@ -1563,8 +1590,8 @@ 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)
-    ~count:1_000
+        ((1, first_inputs) :: levels_and_inputs))
+    ~count:8_000
     ~name
     ~gen:(gen_game ?nonempty_inputs ~p1_strategy ~p2_strategy ())
     (fun ( block,
@@ -1575,10 +1602,55 @@ 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. *)
-      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') ->
+               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
+                  "@[<v 0>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
+                  "@[<v 0>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
@@ -1619,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 =
@@ -1647,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