Skip to content

Commit ddae4aa

Browse files
address feedback
1 parent a2e28fc commit ddae4aa

File tree

5 files changed

+116
-72
lines changed

5 files changed

+116
-72
lines changed

dscheck.opam

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -13,6 +13,7 @@ depends: [
1313
"tsort"
1414
"oseq"
1515
"alcotest" {>= "1.6.0" & with-test}
16+
"cmdliner"
1617
"odoc" {with-doc}
1718
]
1819
build: [

dune-project

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -11,6 +11,6 @@
1111
(package
1212
(name dscheck)
1313
(synopsis "Traced Atomics")
14-
(depends (ocaml (>= 5.0.0)) dune containers tsort oseq (alcotest (and (>= 1.6.0) :with-test))))
14+
(depends (ocaml (>= 5.0.0)) dune containers tsort oseq (alcotest (and (>= 1.6.0) :with-test)) cmdliner))
1515

1616

src/tracedAtomic.ml

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -316,7 +316,7 @@ let rec explore_random func state =
316316
let len = List.length enabled in
317317
if len == 0 then ()
318318
else
319-
let random_index = Random.int (List.length enabled) in
319+
let random_index = Random.int len in
320320
let j = List.nth enabled random_index in
321321
let j_proc = List.nth s.procs j in
322322
let schedule =

tests/dune

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -40,5 +40,5 @@
4040

4141
(executable
4242
(name gen_program)
43-
(libraries dscheck)
43+
(libraries dscheck cmdliner)
4444
(modules gen_program))

tests/gen_program.ml

Lines changed: 112 additions & 69 deletions
Original file line numberDiff line numberDiff line change
@@ -2,24 +2,23 @@ module Atomic = Dscheck.TracedAtomic
22
module IntSet = Set.Make (Int)
33

44
type config = {
5-
globals_count : int;
5+
global_count : int;
66
value_limit : int;
7-
operations_count : int;
8-
thread_count : int;
7+
operation_count : int;
8+
domain_count : int;
99
generate_conditionals : bool;
1010
print_tests : bool;
11-
seed : int option;
11+
seed : int;
1212
}
1313

1414
let print_config t =
1515
Printf.printf "CONFIG\n";
16-
Printf.printf "globals_count: %d\n" t.globals_count;
16+
Printf.printf "global_count: %d\n" t.global_count;
1717
Printf.printf "value_limit: %d\n" t.value_limit;
18-
Printf.printf "operations_count: %d\n" t.operations_count;
19-
Printf.printf "thread_count: %d\n" t.thread_count;
18+
Printf.printf "operations_count: %d\n" t.operation_count;
19+
Printf.printf "domain_count: %d\n" t.domain_count;
2020
Printf.printf "generate_conditionals: %b\n%!" t.generate_conditionals;
21-
Printf.printf "seed: %s\n%!"
22-
(Option.map Int.to_string t.seed |> Option.value ~default:"<random>")
21+
Printf.printf "seed: %d\n%!" t.seed
2322

2423
let var_name i = Char.chr (i + 97)
2524

@@ -177,7 +176,7 @@ module Step = struct
177176
| Noop -> ()
178177

179178
let rec gen ~config ~fuel () =
180-
let var_id = Random.int config.globals_count in
179+
let var_id = Random.int config.global_count in
181180
let next fuel =
182181
if fuel > 1 then gen ~config ~fuel:(fuel - 1) () else Noop
183182
in
@@ -196,10 +195,10 @@ module Step = struct
196195
FetchAndAdd { var_id; delta; next = next fuel }
197196
| 6 ->
198197
let func_count =
199-
min (max 1 fuel) (min config.globals_count (1 + Random.int 2))
198+
min (max 1 fuel) (min config.global_count (1 + Random.int 2))
200199
in
201200
let var_ids =
202-
List.init func_count (fun _ -> Random.int config.globals_count)
201+
List.init func_count (fun _ -> Random.int config.global_count)
203202
in
204203
let conditional =
205204
Conditional.gen func_count ~value_limit:config.value_limit
@@ -241,12 +240,10 @@ module Program = struct
241240
end
242241

243242
let run_random config () =
244-
(match config.seed with
245-
| None -> Random.self_init ()
246-
| Some seed -> Random.init seed);
247-
let globals = CCVector.of_list (List.init config.globals_count Fun.id) in
248-
let thread_f = Step.gen ~config ~fuel:config.operations_count in
249-
let threads = List.init config.thread_count (fun _ -> thread_f ()) in
243+
Random.init config.seed;
244+
let globals = CCVector.of_list (List.init config.global_count Fun.id) in
245+
let thread_f = Step.gen ~config ~fuel:config.operation_count in
246+
let threads = List.init config.domain_count (fun _ -> thread_f ()) in
250247
let program = ({ globals; threads } : Program.t) in
251248
if config.print_tests then Program.print program;
252249
let random = Program.run ~impl:(`Random 100) program in
@@ -260,61 +257,107 @@ let run_random config () =
260257

261258
let run config test_count =
262259
Printf.printf "\n\n";
263-
for i = 0 to test_count do
260+
for i = 1 to test_count do
264261
Printf.printf "----run: %d/%d\r%!" i test_count;
265262
run_random config ()
266263
done;
267264
Printf.printf "\nall generated programs passed\n%!"
268265

269-
(* cmd *)
270-
let _ =
271-
let test_count = ref 100 in
272-
let globals_count = ref 3 in
273-
let value_limit = ref 3 in
274-
let operations_count = ref 3 in
275-
let thread_count = ref 3 in
276-
let generate_conditionals = ref true in
277-
let print_tests = ref false in
278-
let seed = ref 0 in
279-
let speclist =
280-
[
281-
( "-test-count",
282-
Arg.Set_int test_count,
283-
"number of programs to generate and test" );
284-
("-print-tests", Arg.Set print_tests, "print all tests");
285-
( "-global-vars-count",
286-
Arg.Set_int globals_count,
287-
"number of shared atomic variables (the more, the higher the reduction)"
288-
);
289-
( "-value-limit",
290-
Arg.Set_int value_limit,
291-
"range of values used by generated operations" );
292-
( "-operations-count",
293-
Arg.Set_int operations_count,
294-
"number of operations per thread" );
295-
("-thread-count", Arg.Set_int thread_count, "number of threads");
296-
( "-generate-conditionals",
297-
Arg.Set generate_conditionals,
298-
"enable/disable generation of conditional statements" );
299-
("-seed", Arg.Set_int seed, "random seed for generation");
300-
]
266+
(* Command line interface *)
267+
open Cmdliner
268+
269+
let test_count =
270+
let default = 100 in
271+
let info =
272+
Arg.info [ "t"; "test-count" ] ~docv:"INT"
273+
~doc:"Number of programs to generate and test."
274+
in
275+
Arg.value (Arg.opt Arg.int default info)
276+
277+
let global_count =
278+
let default = 3 in
279+
let info =
280+
Arg.info [ "g"; "global-count" ] ~docv:"INT"
281+
~doc:"Number of global atomic variables in generated programs."
282+
in
283+
Arg.value (Arg.opt Arg.int default info)
284+
285+
let print_tests =
286+
let info = Arg.info [ "p"; "print-tests" ] ~doc:"Print generated tests." in
287+
Arg.value (Arg.flag info)
288+
289+
let value_limit =
290+
let default = 3 in
291+
let info =
292+
Arg.info [ "l"; "value-limit" ] ~docv:"INT"
293+
~doc:
294+
"Values of atomic operations stay (mostly) between zero and this value."
295+
in
296+
Arg.value (Arg.opt Arg.int default info)
297+
298+
let operation_count =
299+
let default = 3 in
300+
let info =
301+
Arg.info [ "o"; "operation-count" ] ~docv:"INT"
302+
~doc:"Number of operations generated for every domain."
301303
in
302-
Arg.parse speclist
303-
(fun _ -> ())
304-
"gen_program.exe [-test-count INT] [-global-vars-count INT] [-value-limit \
305-
INT] [-operations-count INT] [-thread-count INT] [-generate-conditionals \
306-
BOOL]";
307-
let config =
308-
({
309-
globals_count = !globals_count;
310-
value_limit = !value_limit;
311-
operations_count = !operations_count;
312-
thread_count = !thread_count;
313-
generate_conditionals = !generate_conditionals;
314-
print_tests = !print_tests;
315-
seed = (if !seed > 0 then Some !seed else None);
316-
}
317-
: config)
304+
Arg.value (Arg.opt Arg.int default info)
305+
306+
let domain_count =
307+
let default = 3 in
308+
let info =
309+
Arg.info [ "d"; "domain-count" ] ~docv:"INT"
310+
~doc:"Number of domains in generated tests."
311+
in
312+
Arg.value (Arg.opt Arg.int default info)
313+
314+
let generate_conditionals =
315+
let info =
316+
Arg.info
317+
[ "c"; "generate-conditionals" ]
318+
~doc:"Generate tests with conditional statements."
318319
in
319-
print_config config;
320-
run config !test_count
320+
Arg.value (Arg.flag info)
321+
322+
let seed_opt =
323+
let info = Arg.info [ "s"; "random-seed" ] ~docv:"INT" ~doc:"Random seed" in
324+
Arg.value (Arg.opt (Arg.some Arg.int) None info)
325+
326+
let cmd =
327+
let open Term in
328+
const
329+
(fun
330+
test_count
331+
global_count
332+
print_tests
333+
value_limit
334+
operation_count
335+
domain_count
336+
generate_conditionals
337+
seed_opt
338+
->
339+
let seed =
340+
match seed_opt with
341+
| Some seed -> seed
342+
| None ->
343+
Random.self_init ();
344+
Random.bits ()
345+
in
346+
let config =
347+
({
348+
global_count;
349+
value_limit;
350+
operation_count;
351+
domain_count;
352+
generate_conditionals;
353+
print_tests;
354+
seed;
355+
}
356+
: config)
357+
in
358+
print_config config;
359+
run config test_count)
360+
$ test_count $ global_count $ print_tests $ value_limit $ operation_count
361+
$ domain_count $ generate_conditionals $ seed_opt
362+
363+
let () = exit @@ Cmd.eval @@ Cmd.v (Cmd.info ~doc:"Test generator for DSCheck" "gen_program") cmd

0 commit comments

Comments
 (0)