@@ -118,7 +118,8 @@ struct
118118 then return []
119119 else
120120 (arb s).gen >> = fun c ->
121- (gen_cmds arb (Spec. next_state c s) (fuel-1 )) >> = fun cs ->
121+ let s' = try Spec. next_state c s with _ -> s in
122+ (gen_cmds arb s' (fuel-1 )) >> = fun cs ->
122123 return (c::cs))
123124 (* * A fueled command list generator.
124125 Accepts a state parameter to enable state-dependent [cmd] generation. *)
@@ -127,7 +128,7 @@ struct
127128 | [] -> true
128129 | c ::cs ->
129130 Spec. precond c s &&
130- let s' = Spec. next_state c s in
131+ let s' = try Spec. next_state c s with _ -> s in
131132 cmds_ok s' cs
132133
133134 (* This is an adaption of [QCheck.Shrink.list_spine]
@@ -180,66 +181,61 @@ struct
180181 | c ::cs ->
181182 let res = Spec. run c sut in
182183 let b = Spec. postcond c s res in
183- let s' = Spec. next_state c s in
184184 if b
185185 then
186+ let s' = Spec. next_state c s in
186187 match check_disagree s' sut cs with
187188 | None -> None
188189 | Some rest -> Some ((c,res)::rest)
189190 else Some [c,res]
190191
191- let check_and_next (c ,res ) s =
192- let b = Spec. postcond c s res in
193- let s' = Spec. next_state c s in
194- b,s'
195-
196192 (* checks that all interleavings of a cmd triple satisfies all preconditions *)
197193 let rec all_interleavings_ok pref cs1 cs2 s =
198194 match pref with
199195 | c ::pref' ->
200196 Spec. precond c s &&
201- let s' = Spec. next_state c s in
197+ let s' = try Spec. next_state c s with _ -> s in
202198 all_interleavings_ok pref' cs1 cs2 s'
203199 | [] ->
204200 match cs1,cs2 with
205201 | [] ,[] -> true
206202 | [] ,c2 ::cs2' ->
207203 Spec. precond c2 s &&
208- let s' = Spec. next_state c2 s in
204+ let s' = try Spec. next_state c2 s with _ -> s in
209205 all_interleavings_ok pref cs1 cs2' s'
210206 | c1 ::cs1' ,[] ->
211207 Spec. precond c1 s &&
212- let s' = Spec. next_state c1 s in
208+ let s' = try Spec. next_state c1 s with _ -> s in
213209 all_interleavings_ok pref cs1' cs2 s'
214210 | c1 ::cs1' ,c2 ::cs2' ->
215211 (Spec. precond c1 s &&
216- let s' = Spec. next_state c1 s in
212+ let s' = try Spec. next_state c1 s with _ -> s in
217213 all_interleavings_ok pref cs1' cs2 s')
218214 &&
219215 (Spec. precond c2 s &&
220- let s' = Spec. next_state c2 s in
216+ let s' = try Spec. next_state c2 s with _ -> s in
221217 all_interleavings_ok pref cs1 cs2' s')
222218
223219 let rec check_obs pref cs1 cs2 s =
224220 match pref with
225- | p ::pref' ->
226- let b,s' = check_and_next p s in
227- b && check_obs pref' cs1 cs2 s'
221+ | ( c , res ) ::pref' ->
222+ let b = Spec. postcond c s res in
223+ b && check_obs pref' cs1 cs2 ( Spec. next_state c s)
228224 | [] ->
229225 match cs1,cs2 with
230226 | [] ,[] -> true
231- | [] ,p2 ::cs2' ->
232- let b,s' = check_and_next p2 s in
233- b && check_obs pref cs1 cs2' s'
234- | p1 ::cs1' ,[] ->
235- let b,s' = check_and_next p1 s in
236- b && check_obs pref cs1' cs2 s'
237- | p1 ::cs1' ,p2 ::cs2' ->
238- (let b1,s' = check_and_next p1 s in
239- b1 && check_obs pref cs1' cs2 s' )
227+ | [] ,( c2 , res2 ) ::cs2' ->
228+ let b = Spec. postcond c2 s res2 in
229+ b && check_obs pref cs1 cs2' ( Spec. next_state c2 s)
230+ | ( c1 , res1 ) ::cs1' ,[] ->
231+ let b = Spec. postcond c1 s res1 in
232+ b && check_obs pref cs1' cs2 ( Spec. next_state c1 s)
233+ | ( c1 , res1 ) ::cs1' ,( c2 , res2 ) ::cs2' ->
234+ (let b1 = Spec. postcond c1 s res1 in
235+ b1 && check_obs pref cs1' cs2 ( Spec. next_state c1 s) )
240236 ||
241- (let b2,s' = check_and_next p2 s in
242- b2 && check_obs pref cs1 cs2' s' )
237+ (let b2 = Spec. postcond c2 s res2 in
238+ b2 && check_obs pref cs1 cs2' ( Spec. next_state c2 s) )
243239
244240 let gen_cmds_size gen s size_gen = Gen. sized_size size_gen (gen_cmds gen s)
245241
@@ -312,7 +308,7 @@ struct
312308 let gen_triple =
313309 Gen. (seq_pref_gen >> = fun seq_pref ->
314310 int_range 2 (2 * par_len) >> = fun dbl_plen ->
315- let spawn_state = List. fold_left (fun st c -> Spec. next_state c st) Spec. init_state seq_pref in
311+ let spawn_state = List. fold_left (fun st c -> try Spec. next_state c st with _ -> st) Spec. init_state seq_pref in
316312 let par_len1 = dbl_plen/ 2 in
317313 let par_gen1 = gen_cmds_size arb1 spawn_state (return par_len1) in
318314 let par_gen2 = gen_cmds_size arb2 spawn_state (return (dbl_plen - par_len1)) in
0 commit comments