Skip to content

Commit fb16595

Browse files
committed
write lin_prop in plain function syntax
1 parent 599a3a7 commit fb16595

File tree

2 files changed

+34
-36
lines changed

2 files changed

+34
-36
lines changed

lib/lin_effect.ml

Lines changed: 17 additions & 18 deletions
Original file line numberDiff line numberDiff line change
@@ -92,24 +92,23 @@ module Make_internal (Spec : Internal.CmdSpec [@alert "-internal"]) = struct
9292
(c,res)::interp sut cs
9393

9494
(* Concurrent agreement property based on effect-handler scheduler *)
95-
let lin_prop =
96-
(fun (seq_pref,cmds1,cmds2) ->
97-
let sut = Spec.init () in
98-
(* exclude [Yield]s from sequential prefix *)
99-
let pref_obs = EffTest.interp_plain sut (List.filter (fun c -> c <> EffSpec.SchedYield) seq_pref) in
100-
let obs1,obs2 = ref [], ref [] in
101-
let main () =
102-
fork (fun () -> let tmp1 = interp sut cmds1 in obs1 := tmp1);
103-
fork (fun () -> let tmp2 = interp sut cmds2 in obs2 := tmp2); in
104-
let () = start_sched main in
105-
let () = Spec.cleanup sut in
106-
let seq_sut = Spec.init () in
107-
(* exclude [Yield]s from sequential executions when searching for an interleaving *)
108-
EffTest.check_seq_cons (filter_res pref_obs) (filter_res !obs1) (filter_res !obs2) seq_sut []
109-
|| QCheck.Test.fail_reportf " Results incompatible with linearized model\n\n%s"
110-
@@ Util.print_triple_vertical ~fig_indent:5 ~res_width:35
111-
(fun (c,r) -> Printf.sprintf "%s : %s" (EffSpec.show_cmd c) (EffSpec.show_res r))
112-
(pref_obs,!obs1,!obs2))
95+
let lin_prop (seq_pref,cmds1,cmds2) =
96+
let sut = Spec.init () in
97+
(* exclude [Yield]s from sequential prefix *)
98+
let pref_obs = EffTest.interp_plain sut (List.filter (fun c -> c <> EffSpec.SchedYield) seq_pref) in
99+
let obs1,obs2 = ref [], ref [] in
100+
let main () =
101+
fork (fun () -> let tmp1 = interp sut cmds1 in obs1 := tmp1);
102+
fork (fun () -> let tmp2 = interp sut cmds2 in obs2 := tmp2); in
103+
let () = start_sched main in
104+
let () = Spec.cleanup sut in
105+
let seq_sut = Spec.init () in
106+
(* exclude [Yield]s from sequential executions when searching for an interleaving *)
107+
EffTest.check_seq_cons (filter_res pref_obs) (filter_res !obs1) (filter_res !obs2) seq_sut []
108+
|| QCheck.Test.fail_reportf " Results incompatible with linearized model\n\n%s"
109+
@@ Util.print_triple_vertical ~fig_indent:5 ~res_width:35
110+
(fun (c,r) -> Printf.sprintf "%s : %s" (EffSpec.show_cmd c) (EffSpec.show_res r))
111+
(pref_obs,!obs1,!obs2)
113112

114113
let lin_test ~count ~name =
115114
let arb_cmd_triple = EffTest.arb_cmds_triple 20 12 in

lib/lin_thread.ml

Lines changed: 17 additions & 18 deletions
Original file line numberDiff line numberDiff line change
@@ -18,24 +18,23 @@ module Make_internal (Spec : Internal.CmdSpec [@alert "-internal"]) = struct
1818
let arb_cmds_triple = arb_cmds_triple
1919

2020
(* Linearization property based on [Thread] *)
21-
let lin_prop =
22-
(fun (seq_pref, cmds1, cmds2) ->
23-
let sut = Spec.init () in
24-
let obs1, obs2 = ref [], ref [] in
25-
let pref_obs = interp_plain sut seq_pref in
26-
let wait = ref true in
27-
let th1 = Thread.create (fun () -> while !wait do Thread.yield () done; obs1 := interp_thread sut cmds1) () in
28-
let th2 = Thread.create (fun () -> wait := false; obs2 := interp_thread sut cmds2) () in
29-
Thread.join th1;
30-
Thread.join th2;
31-
Spec.cleanup sut;
32-
let seq_sut = Spec.init () in
33-
(* we reuse [check_seq_cons] to linearize and interpret sequentially *)
34-
check_seq_cons pref_obs !obs1 !obs2 seq_sut []
35-
|| QCheck.Test.fail_reportf " Results incompatible with sequential execution\n\n%s"
36-
@@ Util.print_triple_vertical ~fig_indent:5 ~res_width:35
37-
(fun (c,r) -> Printf.sprintf "%s : %s" (Spec.show_cmd c) (Spec.show_res r))
38-
(pref_obs,!obs1,!obs2))
21+
let lin_prop (seq_pref, cmds1, cmds2) =
22+
let sut = Spec.init () in
23+
let obs1, obs2 = ref [], ref [] in
24+
let pref_obs = interp_plain sut seq_pref in
25+
let wait = ref true in
26+
let th1 = Thread.create (fun () -> while !wait do Thread.yield () done; obs1 := interp_thread sut cmds1) () in
27+
let th2 = Thread.create (fun () -> wait := false; obs2 := interp_thread sut cmds2) () in
28+
Thread.join th1;
29+
Thread.join th2;
30+
Spec.cleanup sut;
31+
let seq_sut = Spec.init () in
32+
(* we reuse [check_seq_cons] to linearize and interpret sequentially *)
33+
check_seq_cons pref_obs !obs1 !obs2 seq_sut []
34+
|| QCheck.Test.fail_reportf " Results incompatible with sequential execution\n\n%s"
35+
@@ Util.print_triple_vertical ~fig_indent:5 ~res_width:35
36+
(fun (c,r) -> Printf.sprintf "%s : %s" (Spec.show_cmd c) (Spec.show_res r))
37+
(pref_obs,!obs1,!obs2)
3938

4039
let lin_test ~count ~name =
4140
lin_test ~rep_count:100 ~count ~retries:5 ~name ~lin_prop:lin_prop

0 commit comments

Comments
 (0)