Revision 7ecfca04 src/mutation.ml
src/mutation.ml  

1  1 
open Corelang 
2 
open LustreSpec 

2  3 
open Log 
3  4 
open Format 
4  5  
...  ...  
102  103  
103  104 
let compute_records_eq eq = compute_records_expr eq.eq_rhs 
104  105  
106 
let compute_records_stmt s = 

107 
match s with 

108 
 Eq eq > compute_records_expr eq.eq_rhs 

109 
 _ > empty_records (* Automata should have been desintegrate by now *) 

110  
105  111 
let compute_records_node nd = 
106 
merge_records (List.map compute_records_eq nd.node_eqs)


112 
merge_records (List.map compute_records_stmt nd.node_stmts)


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


117 
 Const const > compute_records_const_value const.const_value


112  118 
 _ > empty_records 
113  119  
114  120 
let compute_records prog = 
...  ...  
188  194 
let rdm_mutate_const_value c = 
189  195 
match c with 
190  196 
 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)


197 
 Const_real (num, npow, s) as c > c


198 
(* OTOD: mutation disable here, should look at rdm_mutate_float f and adapt it *)


193  199 
 Const_array _ 
194 
 Const_tag _ > c 

200 
 Const_tag _ 

201 
 Const_string _ 

202 
Const_struct _ > c 

195  203  
196  204 
let rdm_mutate_const c = 
197  205 
let new_const = rdm_mutate_const_value c.const_value in 
...  ...  
268  276 
mutation, { eq with eq_rhs = new_rhs } 
269  277  
270  278 
let rdm_mutate_node nd = 
271 
let mutation, new_node_eqs =


279 
let mutation, new_node_stmts =


272  280 
select_in_list 
273 
nd.node_eqs 

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

275 
report ~level:1 

276 
(fun fmt > fprintf fmt "mutation: %a becomes %a@." 

277 
Printers.pp_node_eq eq 

278 
Printers.pp_node_eq new_eq); 

279 
mut, new_eq ) 

281 
nd.node_stmts 

282 
(fun stmt >match stmt with 

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

284 
report ~level:1 

285 
(fun fmt > fprintf fmt "mutation: %a becomes %a@." 

286 
Printers.pp_node_eq eq 

287 
Printers.pp_node_eq new_eq); 

288 
mut, Eq new_eq 

289 
 _ > assert false (* shold have been removed by now *) ) 

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


291 
mutation, { nd with node_stmts = new_node_stmts }


282  292  
283  293 
let rdm_mutate_top_decl td = 
284  294 
match td.top_decl_desc with 
285  295 
 Node nd > 
286  296 
let mutation, new_node = rdm_mutate_node nd in 
287  297 
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 }


298 
 Const const >


299 
let mut, new_const = rdm_mutate_const const in


300 
mut, { td with top_decl_desc = Const new_const }


291  301 
 _ > None, td 
292  302 

293  303 
(* Create a single mutant with the provided random seed *) 
...  ...  
474  484 
let fold_mutate_eq eq = 
475  485 
{ eq with eq_rhs = fold_mutate_expr eq.eq_rhs } 
476  486  
487 
let fold_mutate_stmt s = 

488 
match s with 

489 
 Eq eq > Eq { eq with eq_rhs = fold_mutate_expr eq.eq_rhs } 

490 
 _ > assert false (* should have been removed by now *) 

491  
477  492 
let fold_mutate_node nd = 
478  493 
{ nd with 
479 
node_eqs =


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


494 
node_stmts =


495 
List.fold_right (fun e res > (fold_mutate_stmt e)::res) nd.node_stmts [];


481  496 
node_id = rename_app nd.node_id 
482  497 
} 
483  498  
484  499 
let fold_mutate_top_decl td = 
485  500 
match td.top_decl_desc with 
486  501 
 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 [])}


502 
 Const const > { td with top_decl_desc = Const (fold_mutate_const const)}


488  503 
 _ > td 
489  504 

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