Revision 4eada2bb
Added by Pierre-Loïc Garoche about 11 years ago
src/mutation.ml | ||
---|---|---|
14 | 14 |
let threshold_rel_op = 95 |
15 | 15 |
let threshold_bool_op = 95 |
16 | 16 |
|
17 |
let int_consts = ref [] |
|
18 |
|
|
19 |
(************************************************************************************) |
|
20 |
|
|
21 |
|
|
22 |
|
|
23 |
let mutate_pre orig_expr e = |
|
24 |
if Random.int 100 <= threshold_delay then |
|
25 |
(* We do not nothing *) |
|
26 |
Expr_pre e |
|
27 |
else (* We add a pre *) |
|
28 |
Expr_pre ({orig_expr with expr_desc = Expr_pre e}) |
|
29 |
|
|
30 |
|
|
31 |
let get_int_consts_const_value c = |
|
32 |
match c with |
|
33 |
| Const_int i -> [i] |
|
34 |
| _ -> [] |
|
35 |
|
|
36 |
let get_int_consts_const c = get_int_consts_const_value c.const_value |
|
37 |
|
|
38 |
let rec get_int_consts_expr expr = |
|
39 |
match expr.expr_desc with |
|
40 |
| Expr_const c -> get_int_consts_const_value c |
|
41 |
| Expr_tuple l -> List.flatten (List.map get_int_consts_expr l) |
|
42 |
| Expr_ite (i,t,e) -> get_int_consts_expr i @ get_int_consts_expr e @ get_int_consts_expr t |
|
43 |
| Expr_arrow (e1, e2) -> get_int_consts_expr e1 @ get_int_consts_expr e2 |
|
44 |
| Expr_pre e -> get_int_consts_expr e |
|
45 |
| Expr_appl (op_id, args, r) -> get_int_consts_expr args |
|
46 |
| _ -> [] |
|
47 |
|
|
48 |
let get_int_consts_eq eq = get_int_consts_expr eq.eq_rhs |
|
49 |
|
|
50 |
let get_int_consts_node nd = List.flatten (List.map get_int_consts_eq nd.node_eqs) |
|
51 |
|
|
52 |
let get_int_consts_top_decl td = |
|
53 |
match td.top_decl_desc with |
|
54 |
| Node nd -> get_int_consts_node nd |
|
55 |
| Consts constsl -> List.flatten (List.map get_int_consts_const constsl) |
|
56 |
| _ -> [] |
|
57 |
|
|
58 |
let get_int_consts prog = |
|
59 |
List.flatten (List.map get_int_consts_top_decl prog) |
|
60 |
(***************************************************************) |
|
61 |
|
|
17 | 62 |
let mutate_int i = |
18 | 63 |
if Random.int 100 > threshold_inc_int then |
19 | 64 |
i+1 |
... | ... | |
22 | 67 |
else if Random.int 100 > threshold_random_int then |
23 | 68 |
Random.int 10 |
24 | 69 |
else if Random.int 100 > threshold_switch_int then |
25 |
assert false |
|
70 |
let idx = Random.int (List.length !int_consts) in |
|
71 |
List.nth !int_consts idx |
|
26 | 72 |
else |
27 | 73 |
i |
28 | 74 |
|
... | ... | |
75 | 121 |
{ c with const_value = mutate_const_value c.const_value } |
76 | 122 |
|
77 | 123 |
|
124 |
let select_in_list list mutate_elem = |
|
125 |
let selected = Random.int (List.length list) in |
|
126 |
let new_list, _ = |
|
127 |
List.fold_right |
|
128 |
(fun elem (res, cpt) -> if cpt = selected then (mutate_elem elem)::res, cpt+1 else elem::res, cpt+1) |
|
129 |
list |
|
130 |
([], 0) |
|
131 |
in |
|
132 |
new_list |
|
133 |
|
|
78 | 134 |
let rec mutate_expr expr = |
79 | 135 |
match expr.expr_desc with |
80 | 136 |
| Expr_ident id -> mutate_var expr |
... | ... | |
106 | 162 |
{ eq with eq_rhs = mutate_expr eq.eq_rhs } |
107 | 163 |
|
108 | 164 |
let mutate_node nd = |
109 |
{ nd with node_eqs = List.map mutate_eq nd.node_eqs }
|
|
165 |
{ nd with node_eqs = select_in_list nd.node_eqs mutate_eq }
|
|
110 | 166 |
|
111 | 167 |
let mutate_top_decl td = |
112 | 168 |
match td.top_decl_desc with |
... | ... | |
116 | 172 |
|
117 | 173 |
(* Create a single mutant with the provided random seed *) |
118 | 174 |
let mutate_prog prog = |
119 |
List.map mutate_top_decl prog
|
|
175 |
select_in_list prog mutate_top_decl
|
|
120 | 176 |
|
121 |
let rec mutate nb prog = |
|
177 |
let mutate nb prog = |
|
178 |
int_consts := get_int_consts prog; |
|
122 | 179 |
let rec iterate nb res = |
123 | 180 |
incr random_seed; |
124 | 181 |
if nb <= 0 then |
Also available in: Unified diff
Single mutation at a time
Gather int constants to perform constant replacement
Optimized the generation mechanism to avoid inifite run when the max number of mutant is reached.