2863

Committed 05 Nov 2024 06:20PM UTC coverage: 30.754% (-16.6%) from 47.311%

Build # 2863

Build Type

push

buildkite

Committed by

web-flow

Commit Message

Merge pull request #16296 from MinaProtocol/dkijania/more_multi_jobs

more multi jobs in CI

Run Details

20276 of 65930 relevant lines covered (30.75%)

8631.7 hits per line

Source File
Press 'n' to go to next uncovered line, 'b' for previous

2.94

/src/lib/work_selector/test.ml

open Core_kernel
open Async
open Currency
open Pipe_lib

module Make_test (Make_selection_method : Intf.Make_selection_method_intf) =
struct
  module T = Inputs.Test_inputs

  let reassignment_wait = 2000

  module Lib = Work_lib.Make (T)
  module Selection_method = Make_selection_method (T) (Lib)

  let gen_staged_ledger =
    (*Staged_ledger for tests is a list of work specs*)
    Quickcheck.Generator.list
    @@ Snark_work_lib.Work.Single.Spec.gen Int.quickcheck_generator Fee.gen

  let precomputed_values = Precomputed_values.for_unit_tests

  let init_state sl reassignment_wait logger =
    let tf_reader, tf_writer = Broadcast_pipe.create None in
    let work_state =
      Lib.State.init ~reassignment_wait ~frontier_broadcast_pipe:tf_reader
        ~logger
    in
    let%map () = Broadcast_pipe.Writer.write tf_writer (Some sl) in
    work_state

  let%test_unit "Workspec chunk doesn't send same things again" =
    Backtrace.elide := false ;
    let p = 50 in
    let snark_pool = T.Snark_pool.create () in
    let fee = Currency.Fee.zero in
    let logger = Logger.null () in
    Quickcheck.test gen_staged_ledger ~trials:100 ~f:(fun sl ->
        Async.Thread_safe.block_on_async_exn (fun () ->
            let open Deferred.Let_syntax in
            let%bind work_state = init_state sl reassignment_wait logger in
            let rec go i =
              [%test_result: Bool.t]
                ~message:"Exceeded time expected to exhaust work" ~expect:true
                (i <= p) ;
              let stuff =
                Selection_method.work ~snark_pool ~fee ~logger work_state
              in
              match stuff with None -> return () | _ -> go (i + 1)
            in
            go 0 ) )

  let%test_unit "Reassign work after the wait time" =
    Backtrace.elide := false ;
    let snark_pool = T.Snark_pool.create () in
    let fee = Currency.Fee.zero in
    let logger = Logger.null () in
    let send_work work_state =
      let rec go all_work =
        let stuff = Selection_method.work ~snark_pool ~fee ~logger work_state in
        match stuff with
        | None ->
            all_work
        | Some work ->
            go (One_or_two.to_list work @ all_work)
      in
      go []
    in
    Quickcheck.test gen_staged_ledger ~trials:10 ~f:(fun sl ->
        Async.Thread_safe.block_on_async_exn (fun () ->
            let open Deferred.Let_syntax in
            let%bind work_state = init_state sl reassignment_wait logger in
            let work_sent = send_work work_state in
            (*wait for wait_time after which all the work will be reassigned*)
            let%map () =
              Async.after (Time.Span.of_ms (Float.of_int reassignment_wait))
            in
            let work_sent_again = send_work work_state in
            assert (List.length work_sent = List.length work_sent_again) ) )

  let gen_snark_pool (works : ('a, 'b) Lib.Work_spec.t One_or_two.t list) fee =
    let open Quickcheck.Generator.Let_syntax in
    let cheap_work_fee = Option.value_exn Fee.(sub fee one) in
    let expensive_work_fee = Option.value_exn Fee.(add fee one) in
    let snark_pool = T.Snark_pool.create () in
    let rec add_works = function
      | [] ->
          return ()
      | work :: rest ->
          let%bind fee =
            Quickcheck.Generator.of_list [ cheap_work_fee; expensive_work_fee ]
          in
          T.Snark_pool.add_snark snark_pool ~work ~fee ;
          add_works rest
    in
    let%map () =
      add_works (List.map ~f:(One_or_two.map ~f:Lib.Work_spec.statement) works)
    in
    snark_pool

  let%test_unit "selector shouldn't get work that it cannot outbid" =
    Backtrace.elide := false ;
    let my_fee = Currency.Fee.of_nanomina_int_exn 2 in
    let p = 50 in
    let logger = Logger.null () in
    let g =
      let open Quickcheck.Generator.Let_syntax in
      let%bind sl = gen_staged_ledger in
      let%map pool =
        gen_snark_pool
          ( T.Staged_ledger.all_work_pairs sl ~get_state:(fun _ ->
                Ok
                  (Lazy.force precomputed_values).protocol_state_with_hashes
                    .data )
          |> Or_error.ok_exn )
          (Currency.Fee.of_nanomina_int_exn 2)
      in
      (sl, pool)
    in
    Quickcheck.test g
      ~sexp_of:
        [%sexp_of:
          (int, Fee.t) Lib.Work_spec.t list * Fee.t T.Snark_pool.Work.Table.t]
      ~trials:100 ~f:(fun (sl, snark_pool) ->
        Async.Thread_safe.block_on_async_exn (fun () ->
            let open Deferred.Let_syntax in
            let%bind work_state = init_state sl reassignment_wait logger in
            let rec go i =
              [%test_result: Bool.t]
                ~message:"Exceeded time expected to exhaust work" ~expect:true
                (i <= p) ;
              let work =
                Selection_method.work ~snark_pool ~fee:my_fee work_state ~logger
              in
              match work with
              | None ->
                  return ()
              | Some job ->
                  [%test_result: Bool.t]
                    ~message:"Should not get any cheap jobs" ~expect:true
                    (Lib.For_tests.does_not_have_better_fee ~snark_pool
                       ~fee:my_fee
                       (One_or_two.map job ~f:Lib.Work_spec.statement) ) ;
                  go (i + 1)
            in
            go 0 ) )
end

1	open Core_kernel	1✔
2	open Async
3	open Currency
4	open Pipe_lib
5
6	module Make_test (Make_selection_method : Intf.Make_selection_method_intf) =
7	struct
8	module T = Inputs.Test_inputs
9
10	let reassignment_wait = 2000
11
12	module Lib = Work_lib.Make (T)
13	module Selection_method = Make_selection_method (T) (Lib)
14
15	let gen_staged_ledger =
16	(Staged_ledger for tests is a list of work specs)
17	Quickcheck.Generator.list	×
18	@@ Snark_work_lib.Work.Single.Spec.gen Int.quickcheck_generator Fee.gen	×
19
20	let precomputed_values = Precomputed_values.for_unit_tests
21
22	let init_state sl reassignment_wait logger =
23	let tf_reader, tf_writer = Broadcast_pipe.create None in	×
24	let work_state =	×
25	Lib.State.init ~reassignment_wait ~frontier_broadcast_pipe:tf_reader
26	~logger
27	in
28	let%map () = Broadcast_pipe.Writer.write tf_writer (Some sl) in	×
29	work_state	×
30
31	let%test_unit "Workspec chunk doesn't send same things again" =
32	Backtrace.elide := false ;	×
33	let p = 50 in
34	let snark_pool = T.Snark_pool.create () in
35	let fee = Currency.Fee.zero in	×
36	let logger = Logger.null () in
37	Quickcheck.test gen_staged_ledger ~trials:100 ~f:(fun sl ->	×
38	Async.Thread_safe.block_on_async_exn (fun () ->	×
39	let open Deferred.Let_syntax in	×
40	let%bind work_state = init_state sl reassignment_wait logger in	×
41	let rec go i =	×
42	[%test_result: Bool.t]	×
43	~message:"Exceeded time expected to exhaust work" ~expect:true
44	(i <= p) ;
45	let stuff =	×
46	Selection_method.work ~snark_pool ~fee ~logger work_state
47	in
48	match stuff with None -> return () \| _ -> go (i + 1)	×
49	in
50	go 0 ) )
51
52	let%test_unit "Reassign work after the wait time" =
53	Backtrace.elide := false ;	×
54	let snark_pool = T.Snark_pool.create () in
55	let fee = Currency.Fee.zero in	×
56	let logger = Logger.null () in
57	let send_work work_state =	×
58	let rec go all_work =	×
59	let stuff = Selection_method.work ~snark_pool ~fee ~logger work_state in	×
60	match stuff with	×
61	\| None ->	×
62	all_work
63	\| Some work ->	×
64	go (One_or_two.to_list work @ all_work)	×
65	in
66	go []
67	in
68	Quickcheck.test gen_staged_ledger ~trials:10 ~f:(fun sl ->
69	Async.Thread_safe.block_on_async_exn (fun () ->	×
70	let open Deferred.Let_syntax in	×
71	let%bind work_state = init_state sl reassignment_wait logger in	×
72	let work_sent = send_work work_state in	×
73	(wait for wait_time after which all the work will be reassigned)
74	let%map () =
75	Async.after (Time.Span.of_ms (Float.of_int reassignment_wait))	×
76	in
77	let work_sent_again = send_work work_state in	×
78	assert (List.length work_sent = List.length work_sent_again) ) )	×
79
80	let gen_snark_pool (works : ('a, 'b) Lib.Work_spec.t One_or_two.t list) fee =
81	let open Quickcheck.Generator.Let_syntax in	×
82	let cheap_work_fee = Option.value_exn Fee.(sub fee one) in	×
83	let expensive_work_fee = Option.value_exn Fee.(add fee one) in	×
84	let snark_pool = T.Snark_pool.create () in	×
85	let rec add_works = function	×
86	\| [] ->	×
87	return ()
88	\| work :: rest ->	×
89	let%bind fee =
90	Quickcheck.Generator.of_list [ cheap_work_fee; expensive_work_fee ]	×
91	in
92	T.Snark_pool.add_snark snark_pool ~work ~fee ;	×
93	add_works rest	×
94	in
95	let%map () =
96	add_works (List.map ~f:(One_or_two.map ~f:Lib.Work_spec.statement) works)	×
97	in
98	snark_pool	×
99
100	let%test_unit "selector shouldn't get work that it cannot outbid" =
101	Backtrace.elide := false ;	×
102	let my_fee = Currency.Fee.of_nanomina_int_exn 2 in
103	let p = 50 in	×
104	let logger = Logger.null () in
105	let g =	×
106	let open Quickcheck.Generator.Let_syntax in
107	let%bind sl = gen_staged_ledger in
108	let%map pool =
109	gen_snark_pool	×
110	( T.Staged_ledger.all_work_pairs sl ~get_state:(fun _ ->
111	Ok	×
112	(Lazy.force precomputed_values).protocol_state_with_hashes	×
113	.data )
114	\|> Or_error.ok_exn )	×
115	(Currency.Fee.of_nanomina_int_exn 2)	×
116	in
117	(sl, pool)	×
118	in
119	Quickcheck.test g
120	~sexp_of:
121	[%sexp_of:
122	(int, Fee.t) Lib.Work_spec.t list * Fee.t T.Snark_pool.Work.Table.t]
123	~trials:100 ~f:(fun (sl, snark_pool) ->
124	Async.Thread_safe.block_on_async_exn (fun () ->	×
125	let open Deferred.Let_syntax in	×
126	let%bind work_state = init_state sl reassignment_wait logger in	×
127	let rec go i =	×
128	[%test_result: Bool.t]	×
129	~message:"Exceeded time expected to exhaust work" ~expect:true
130	(i <= p) ;
131	let work =	×
132	Selection_method.work ~snark_pool ~fee:my_fee work_state ~logger
133	in
134	match work with	×
135	\| None ->	×
136	return ()
137	\| Some job ->	×
138	[%test_result: Bool.t]	×
139	~message:"Should not get any cheap jobs" ~expect:true
140	(Lib.For_tests.does_not_have_better_fee ~snark_pool	×
141	~fee:my_fee
142	(One_or_two.map job ~f:Lib.Work_spec.statement) ) ;	×
143	go (i + 1)	×
144	in
145	go 0 ) )
146	end	1✔

MinaProtocol / mina / 2863

Source File Press 'n' to go to next uncovered line, 'b' for previous

Source File
Press 'n' to go to next uncovered line, 'b' for previous