Revision bde99c3f src/mutation.ml
src/mutation.ml  

1 
open LustreSpec 

1  2 
open Corelang 
2  3 
open Log 
3  4 
open Format 
...  ...  
103  104 
let compute_records_eq eq = compute_records_expr eq.eq_rhs 
104  105  
105  106 
let compute_records_node nd = 
106 
merge_records (List.map compute_records_eq nd.node_eqs)


107 
merge_records (List.map compute_records_eq (get_node_eqs nd))


107  108  
108  109 
let compute_records_top_decl td = 
109  110 
match td.top_decl_desc with 
110  111 
 Node nd > compute_records_node nd 
111 
 Consts constsl > merge_records (List.map (fun c > compute_records_const_value c.const_value) constsl)


112 
 Const cst > compute_records_const_value cst.const_value


112  113 
 _ > empty_records 
113  114  
114  115 
let compute_records prog = 
...  ...  
150  151 
else 
151  152 
i 
152  153 

153 
let rdm_mutate_float f =


154 
let rdm_mutate_real r =


154  155 
if Random.int 100 > threshold_random_float then 
155 
Random.float 10. 

156 
(* interval [0, bound] for random values *) 

157 
let bound = 10 in 

158 
(* max number of digits after comma *) 

159 
let digits = 5 in 

160 
(* number of digits after comma *) 

161 
let shift = Random.int (digits + 1) in 

162 
let eshift = 10. ** (float_of_int shift) in 

163 
let i = Random.int (1 + bound * (int_of_float eshift)) in 

164 
let f = float_of_int i /. eshift in 

165 
(Num.num_of_int i, shift, string_of_float f) 

156  166 
else 
157 
f


167 
r


158  168  
159  169 
let rdm_mutate_op op = 
160  170 
match op with 
...  ...  
174  184 
match (Types.repr expr.expr_type).Types.tdesc with 
175  185 
 Types.Tbool > 
176  186 
(* if Random.int 100 > threshold_negate_bool_var then *) 
177 
let new_e = mkpredef_unary_call Location.dummy_loc "not" expr in


187 
let new_e = mkpredef_call expr.expr_loc "not" [expr] in


178  188 
Some (expr, new_e), new_e 
179  189 
(* else *) 
180  190 
(* expr *) 
...  ...  
188  198 
let rdm_mutate_const_value c = 
189  199 
match c with 
190  200 
 Const_int i > Const_int (rdm_mutate_int i) 
191 
 Const_real s > Const_real s (* those are string, let's leave them *) 

192 
 Const_float f > Const_float (rdm_mutate_float f) 

201 
 Const_real (n, i, s) > let (n', i', s') = rdm_mutate_real (n, i, s) in Const_real (n', i', s') 

193  202 
 Const_array _ 
203 
 Const_string _ 

204 
 Const_struct _ 

194  205 
 Const_tag _ > c 
195  206  
196  207 
let rdm_mutate_const c = 
...  ...  
249  260 
else 
250  261 
let mut, new_args = rdm_mutate_expr args in 
251  262 
mut, mk_e (Expr_appl (op_id, new_args, r)) 
252 


253  263 
(* Other constructs are kept. 
254  264 
 Expr_fby of expr * expr 
255  265 
 Expr_array of expr list 
...  ...  
260  270 
 Expr_uclock of expr * int 
261  271 
 Expr_dclock of expr * int 
262  272 
 Expr_phclock of expr * rat *) 
263 
(*  _ > expr.expr_desc *)


273 
 _ > None, expr


264  274 

265  275  
266  276 
let rdm_mutate_eq eq = 
267  277 
let mutation, new_rhs = rdm_mutate_expr eq.eq_rhs in 
268  278 
mutation, { eq with eq_rhs = new_rhs } 
269  279  
270 
let rdm_mutate_node nd = 

271 
let mutation, new_node_eqs = 

272 
select_in_list 

273 
nd.node_eqs 

274 
(fun eq > let mut, new_eq = rdm_mutate_eq eq in 

280 
let rnd_mutate_stmt stmt = 

281 
match stmt with 

282 
 Eq eq > let mut, new_eq = rdm_mutate_eq eq in 

275  283 
report ~level:1 
276  284 
(fun fmt > fprintf fmt "mutation: %a becomes %a@." 
277  285 
Printers.pp_node_eq eq 
278  286 
Printers.pp_node_eq new_eq); 
279 
mut, new_eq ) 

287 
mut, Eq new_eq 

288 
 Aut aut > assert false 

289  
290 
let rdm_mutate_node nd = 

291 
let mutation, new_node_stmts = 

292 
select_in_list 

293 
nd.node_stmts rnd_mutate_stmt 

280  294 
in 
281 
mutation, { nd with node_eqs = new_node_eqs }


295 
mutation, { nd with node_stmts = new_node_stmts }


282  296  
283  297 
let rdm_mutate_top_decl td = 
284  298 
match td.top_decl_desc with 
285  299 
 Node nd > 
286  300 
let mutation, new_node = rdm_mutate_node nd in 
287  301 
mutation, { td with top_decl_desc = Node new_node} 
288 
 Consts constsl >


289 
let mut, new_constsl = select_in_list constsl rdm_mutate_const in


290 
mut, { td with top_decl_desc = Consts new_constsl }


302 
 Const cst >


303 
let mut, new_cst = rdm_mutate_const cst in


304 
mut, { td with top_decl_desc = Const new_cst }


291  305 
 _ > None, td 
292  306 

293  307 
(* Create a single mutant with the provided random seed *) 
...  ...  
394  408 
match !target with 
395  409 
 Some (Boolexpr 0) > ( 
396  410 
target := None; 
397 
mkpredef_unary_call Location.dummy_loc "not" expr


411 
mkpredef_call expr.expr_loc "not" [expr]


398  412 
) 
399  413 
 Some (Boolexpr n) > 
400  414 
(target := Some (Boolexpr (n1)); expr) 
...  ...  
474  488 
let fold_mutate_eq eq = 
475  489 
{ eq with eq_rhs = fold_mutate_expr eq.eq_rhs } 
476  490  
491 
let fold_mutate_stmt stmt = 

492 
match stmt with 

493 
 Eq eq > Eq (fold_mutate_eq eq) 

494 
 Aut aut > assert false 

495  
477  496 
let fold_mutate_node nd = 
478  497 
{ nd with 
479 
node_eqs =


480 
List.fold_right (fun e res > (fold_mutate_eq e)::res) nd.node_eqs [];


498 
node_stmts =


499 
List.fold_right (fun stmt res > (fold_mutate_stmt stmt)::res) nd.node_stmts [];


481  500 
node_id = rename_app nd.node_id 
482  501 
} 
483  502  
484  503 
let fold_mutate_top_decl td = 
485  504 
match td.top_decl_desc with 
486 
 Node nd > { td with top_decl_desc = Node (fold_mutate_node nd)}


487 
 Consts constsl > { td with top_decl_desc = Consts (List.fold_right (fun e res > (fold_mutate_const e)::res) constsl [])}


505 
 Node nd > { td with top_decl_desc = Node (fold_mutate_node nd)}


506 
 Const cst > { td with top_decl_desc = Const (fold_mutate_const cst)}


488  507 
 _ > td 
489  508 

490  509 
(* Create a single mutant with the provided random seed *) 
Also available in: Unified diff