Revision ca7ff3f7
Added by Lélio Brun over 1 year ago
src/mutation.ml | ||
---|---|---|
1 |
|
|
2 | 1 |
(* Comments in function fold_mutate |
3 | 2 |
|
4 |
TODO: check if we can generate more cases. The following lines were |
|
5 |
cylcing and missing to detect that the enumaration was complete, |
|
6 |
leading to a non terminating process. The current setting is harder |
|
7 |
but may miss enumerating some cases. To be checked! |
|
8 |
|
|
9 |
|
|
10 |
*) |
|
11 |
|
|
3 |
TODO: check if we can generate more cases. The following lines were cylcing |
|
4 |
and missing to detect that the enumaration was complete, leading to a non |
|
5 |
terminating process. The current setting is harder but may miss enumerating |
|
6 |
some cases. To be checked! *) |
|
12 | 7 |
|
13 | 8 |
open Lustre_types |
14 | 9 |
open Corelang |
... | ... | |
16 | 11 |
open Format |
17 | 12 |
|
18 | 13 |
let random_seed = ref 0 |
14 |
|
|
19 | 15 |
let threshold_delay = 95 |
16 |
|
|
20 | 17 |
let threshold_inc_int = 97 |
18 |
|
|
21 | 19 |
let threshold_dec_int = 97 |
20 |
|
|
22 | 21 |
let threshold_random_int = 96 |
23 |
let threshold_switch_int = 100 (* not implemented yet *) |
|
24 |
let threshold_random_float = 100 (* not used yet *) |
|
22 |
|
|
23 |
let threshold_switch_int = 100 |
|
24 |
(* not implemented yet *) |
|
25 |
|
|
26 |
let threshold_random_float = 100 |
|
27 |
(* not used yet *) |
|
28 |
|
|
25 | 29 |
let threshold_negate_bool_var = 95 |
30 |
|
|
26 | 31 |
let threshold_arith_op = 95 |
32 |
|
|
27 | 33 |
let threshold_rel_op = 95 |
34 |
|
|
28 | 35 |
let threshold_bool_op = 95 |
29 | 36 |
|
30 | 37 |
let int_consts = ref [] |
31 | 38 |
|
32 | 39 |
let rename_app id = |
33 |
if List.mem id Basic_library.internal_funs || |
|
34 |
!Options.no_mutation_suffix then |
|
40 |
if List.mem id Basic_library.internal_funs || !Options.no_mutation_suffix then |
|
35 | 41 |
id |
36 | 42 |
else |
37 | 43 |
let node = Corelang.node_from_name id in |
38 | 44 |
let is_imported = |
39 |
match node.top_decl_desc with |
|
40 |
| ImportedNode _ -> true |
|
41 |
| _ -> false |
|
45 |
match node.top_decl_desc with ImportedNode _ -> true | _ -> false |
|
42 | 46 |
in |
43 |
if is_imported then |
|
44 |
id |
|
45 |
else |
|
46 |
id ^ "_mutant" |
|
47 |
if is_imported then id else id ^ "_mutant" |
|
47 | 48 |
|
48 | 49 |
(************************************************************************************) |
49 |
(* Gathering constants in the code *)
|
|
50 |
(* Gathering constants in the code *)
|
|
50 | 51 |
(************************************************************************************) |
51 | 52 |
|
52 |
module IntSet = Set.Make (struct type t = int let compare = compare end) |
|
53 |
module OpCount = Mmap.Make (struct type t = string let compare = compare end) |
|
53 |
module IntSet = Set.Make (struct |
|
54 |
type t = int |
|
55 |
|
|
56 |
let compare = compare |
|
57 |
end) |
|
58 |
|
|
59 |
module OpCount = Mmap.Make (struct |
|
60 |
type t = string |
|
61 |
|
|
62 |
let compare = compare |
|
63 |
end) |
|
54 | 64 |
|
55 | 65 |
type records = { |
56 |
consts: IntSet.t; |
|
57 |
nb_consts: int; |
|
58 |
nb_boolexpr: int; |
|
59 |
nb_pre: int; |
|
60 |
nb_op: int OpCount.t; |
|
66 |
consts : IntSet.t;
|
|
67 |
nb_consts : int;
|
|
68 |
nb_boolexpr : int;
|
|
69 |
nb_pre : int;
|
|
70 |
nb_op : int OpCount.t;
|
|
61 | 71 |
} |
62 | 72 |
|
63 |
let arith_op = ["+" ; "-" ; "*" ; "/"] |
|
64 |
let bool_op = ["&&"; "||"; "xor"; "impl"] |
|
65 |
let rel_op = ["<" ; "<=" ; ">" ; ">=" ; "!=" ; "=" ] |
|
73 |
let arith_op = [ "+"; "-"; "*"; "/" ] |
|
74 |
|
|
75 |
let bool_op = [ "&&"; "||"; "xor"; "impl" ] |
|
76 |
|
|
77 |
let rel_op = [ "<"; "<="; ">"; ">="; "!="; "=" ] |
|
78 |
|
|
66 | 79 |
let ops = arith_op @ bool_op @ rel_op |
80 |
|
|
67 | 81 |
let all_ops = "not" :: ops |
68 | 82 |
|
69 |
let empty_records = |
|
70 |
{consts=IntSet.empty; nb_consts=0; nb_boolexpr=0; nb_pre=0; nb_op=OpCount.empty} |
|
83 |
let empty_records = |
|
84 |
{ |
|
85 |
consts = IntSet.empty; |
|
86 |
nb_consts = 0; |
|
87 |
nb_boolexpr = 0; |
|
88 |
nb_pre = 0; |
|
89 |
nb_op = OpCount.empty; |
|
90 |
} |
|
71 | 91 |
|
72 | 92 |
let records = ref empty_records |
73 | 93 |
|
74 |
let merge_records records_list =
|
|
94 |
let merge_records records_list = |
|
75 | 95 |
let merge_record r1 r2 = |
76 | 96 |
{ |
77 | 97 |
consts = IntSet.union r1.consts r2.consts; |
78 |
|
|
79 | 98 |
nb_consts = r1.nb_consts + r2.nb_consts; |
80 | 99 |
nb_boolexpr = r1.nb_boolexpr + r2.nb_boolexpr; |
81 | 100 |
nb_pre = r1.nb_pre + r2.nb_pre; |
82 |
|
|
83 |
nb_op = OpCount.merge (fun _ r1opt r2opt -> |
|
84 |
match r1opt, r2opt with |
|
85 |
| None, _ -> r2opt |
|
86 |
| _, None -> r1opt |
|
87 |
| Some x, Some y -> Some (x+y) |
|
88 |
) r1.nb_op r2.nb_op |
|
101 |
nb_op = |
|
102 |
OpCount.merge |
|
103 |
(fun _ r1opt r2opt -> |
|
104 |
match r1opt, r2opt with |
|
105 |
| None, _ -> |
|
106 |
r2opt |
|
107 |
| _, None -> |
|
108 |
r1opt |
|
109 |
| Some x, Some y -> |
|
110 |
Some (x + y)) |
|
111 |
r1.nb_op r2.nb_op; |
|
89 | 112 |
} |
90 | 113 |
in |
91 | 114 |
List.fold_left merge_record empty_records records_list |
92 |
|
|
115 |
|
|
93 | 116 |
let compute_records_const_value c = |
94 | 117 |
match c with |
95 |
| Const_int i -> {empty_records with consts = IntSet.singleton i; nb_consts = 1} |
|
96 |
| _ -> empty_records |
|
118 |
| Const_int i -> |
|
119 |
{ empty_records with consts = IntSet.singleton i; nb_consts = 1 } |
|
120 |
| _ -> |
|
121 |
empty_records |
|
97 | 122 |
|
98 | 123 |
let rec compute_records_expr expr = |
99 |
let boolexpr =
|
|
124 |
let boolexpr = |
|
100 | 125 |
if Types.is_bool_type expr.expr_type then |
101 |
{empty_records with nb_boolexpr = 1} |
|
102 |
else |
|
103 |
empty_records |
|
126 |
{ empty_records with nb_boolexpr = 1 } |
|
127 |
else empty_records |
|
104 | 128 |
in |
105 |
let subrec =
|
|
129 |
let subrec = |
|
106 | 130 |
match expr.expr_desc with |
107 |
| Expr_const c -> compute_records_const_value c |
|
108 |
| Expr_tuple l -> merge_records (List.map compute_records_expr l) |
|
109 |
| Expr_ite (i,t,e) -> |
|
110 |
merge_records (List.map compute_records_expr [i;t;e]) |
|
111 |
| Expr_arrow (e1, e2) -> |
|
112 |
merge_records (List.map compute_records_expr [e1;e2]) |
|
113 |
| Expr_pre e -> |
|
114 |
merge_records ( |
|
115 |
({empty_records with nb_pre = 1}) |
|
116 |
::[compute_records_expr e]) |
|
131 |
| Expr_const c -> |
|
132 |
compute_records_const_value c |
|
133 |
| Expr_tuple l -> |
|
134 |
merge_records (List.map compute_records_expr l) |
|
135 |
| Expr_ite (i, t, e) -> |
|
136 |
merge_records (List.map compute_records_expr [ i; t; e ]) |
|
137 |
| Expr_arrow (e1, e2) -> |
|
138 |
merge_records (List.map compute_records_expr [ e1; e2 ]) |
|
139 |
| Expr_pre e -> |
|
140 |
merge_records |
|
141 |
[ { empty_records with nb_pre = 1 }; compute_records_expr e ] |
|
117 | 142 |
| Expr_appl (op_id, args, _) -> |
118 | 143 |
if List.mem op_id ops then |
119 |
merge_records ( |
|
120 |
({empty_records with nb_op = OpCount.singleton op_id 1}) |
|
121 |
::[compute_records_expr args]) |
|
122 |
else |
|
123 |
compute_records_expr args |
|
124 |
| _ -> empty_records |
|
144 |
merge_records |
|
145 |
[ |
|
146 |
{ empty_records with nb_op = OpCount.singleton op_id 1 }; |
|
147 |
compute_records_expr args; |
|
148 |
] |
|
149 |
else compute_records_expr args |
|
150 |
| _ -> |
|
151 |
empty_records |
|
125 | 152 |
in |
126 |
merge_records [boolexpr;subrec]
|
|
153 |
merge_records [ boolexpr; subrec ]
|
|
127 | 154 |
|
128 | 155 |
let compute_records_eq eq = compute_records_expr eq.eq_rhs |
129 | 156 |
|
130 | 157 |
let compute_records_node nd = |
131 | 158 |
let eqs, auts = get_node_eqs nd in |
132 |
assert (auts=[]); (* Automaton should be expanded by now *) |
|
159 |
assert (auts = []); |
|
160 |
(* Automaton should be expanded by now *) |
|
133 | 161 |
merge_records (List.map compute_records_eq eqs) |
134 | 162 |
|
135 | 163 |
let compute_records_top_decl td = |
136 | 164 |
match td.top_decl_desc with |
137 |
| Node nd -> compute_records_node nd |
|
138 |
| Const cst -> compute_records_const_value cst.const_value |
|
139 |
| _ -> empty_records |
|
140 |
|
|
141 |
let compute_records prog = |
|
165 |
| Node nd -> |
|
166 |
compute_records_node nd |
|
167 |
| Const cst -> |
|
168 |
compute_records_const_value cst.const_value |
|
169 |
| _ -> |
|
170 |
empty_records |
|
171 |
|
|
172 |
let compute_records prog = |
|
142 | 173 |
merge_records (List.map compute_records_top_decl prog) |
143 | 174 |
|
144 | 175 |
(*****************************************************************) |
... | ... | |
148 | 179 |
let check_mut e1 e2 = |
149 | 180 |
let rec eq e1 e2 = |
150 | 181 |
match e1.expr_desc, e2.expr_desc with |
151 |
| Expr_const c1, Expr_const c2 -> c1 = c2 |
|
152 |
| Expr_ident id1, Expr_ident id2 -> id1 = id2 |
|
153 |
| Expr_tuple el1, Expr_tuple el2 -> List.length el1 = List.length el2 && List.for_all2 eq el1 el2 |
|
154 |
| Expr_ite (i1, t1, e1), Expr_ite (i2, t2, e2) -> eq i1 i2 && eq t1 t2 && eq e1 e2 |
|
155 |
| Expr_arrow (x1, y1), Expr_arrow (x2, y2) -> eq x1 x2 && eq y1 y2 |
|
156 |
| Expr_pre e1, Expr_pre e2 -> eq e1 e2 |
|
157 |
| Expr_appl (id1, e1, _), Expr_appl (id2, e2, _) -> id1 = id2 && eq e1 e2 |
|
158 |
| _ -> false |
|
182 |
| Expr_const c1, Expr_const c2 -> |
|
183 |
c1 = c2 |
|
184 |
| Expr_ident id1, Expr_ident id2 -> |
|
185 |
id1 = id2 |
|
186 |
| Expr_tuple el1, Expr_tuple el2 -> |
|
187 |
List.length el1 = List.length el2 && List.for_all2 eq el1 el2 |
|
188 |
| Expr_ite (i1, t1, e1), Expr_ite (i2, t2, e2) -> |
|
189 |
eq i1 i2 && eq t1 t2 && eq e1 e2 |
|
190 |
| Expr_arrow (x1, y1), Expr_arrow (x2, y2) -> |
|
191 |
eq x1 x2 && eq y1 y2 |
|
192 |
| Expr_pre e1, Expr_pre e2 -> |
|
193 |
eq e1 e2 |
|
194 |
| Expr_appl (id1, e1, _), Expr_appl (id2, e2, _) -> |
|
195 |
id1 = id2 && eq e1 e2 |
|
196 |
| _ -> |
|
197 |
false |
|
159 | 198 |
in |
160 |
if not (eq e1 e2) then |
|
161 |
Some (e1, e2) |
|
162 |
else |
|
163 |
None |
|
199 |
if not (eq e1 e2) then Some (e1, e2) else None |
|
164 | 200 |
|
165 | 201 |
let mk_cst_expr c = mkexpr Location.dummy_loc (Expr_const c) |
166 | 202 |
|
167 |
let rdm_mutate_int i = |
|
168 |
if Random.int 100 > threshold_inc_int then |
|
169 |
i+1 |
|
170 |
else if Random.int 100 > threshold_dec_int then |
|
171 |
i-1 |
|
172 |
else if Random.int 100 > threshold_random_int then |
|
173 |
Random.int 10 |
|
203 |
let rdm_mutate_int i = |
|
204 |
if Random.int 100 > threshold_inc_int then i + 1 |
|
205 |
else if Random.int 100 > threshold_dec_int then i - 1 |
|
206 |
else if Random.int 100 > threshold_random_int then Random.int 10 |
|
174 | 207 |
else if Random.int 100 > threshold_switch_int then |
175 | 208 |
let idx = Random.int (List.length !int_consts) in |
176 | 209 |
List.nth !int_consts idx |
177 |
else |
|
178 |
i |
|
179 |
|
|
210 |
else i |
|
211 |
|
|
180 | 212 |
let rdm_mutate_real r = |
181 | 213 |
if Random.int 100 > threshold_random_float then |
182 | 214 |
(* interval [0, bound] for random values *) |
... | ... | |
185 | 217 |
let digits = 5 in |
186 | 218 |
(* number of digits after comma *) |
187 | 219 |
let shift = Random.int (digits + 1) in |
188 |
let eshift = 10. ** (float_of_int shift) in
|
|
189 |
let i = Random.int (1 + bound * (int_of_float eshift)) in
|
|
220 |
let eshift = 10. ** float_of_int shift in
|
|
221 |
let i = Random.int (1 + (bound * int_of_float eshift)) in
|
|
190 | 222 |
let f = float_of_int i /. eshift in |
191 | 223 |
Real.create (string_of_int i) shift (string_of_float f) |
192 |
else |
|
193 |
r |
|
194 |
|
|
195 |
let rdm_mutate_op op = |
|
196 |
match op with |
|
197 |
| "+" | "-" | "*" | "/" when Random.int 100 > threshold_arith_op -> |
|
198 |
let filtered = List.filter (fun x -> x <> op) ["+"; "-"; "*"; "/"] in |
|
199 |
List.nth filtered (Random.int 3) |
|
200 |
| "&&" | "||" | "xor" | "impl" when Random.int 100 > threshold_bool_op -> |
|
201 |
let filtered = List.filter (fun x -> x <> op) ["&&"; "||"; "xor"; "impl"] in |
|
202 |
List.nth filtered (Random.int 3) |
|
203 |
| "<" | "<=" | ">" | ">=" | "!=" | "=" when Random.int 100 > threshold_rel_op -> |
|
204 |
let filtered = List.filter (fun x -> x <> op) ["<"; "<="; ">"; ">="; "!="; "="] in |
|
205 |
List.nth filtered (Random.int 5) |
|
206 |
| _ -> op |
|
207 |
|
|
224 |
else r |
|
225 |
|
|
226 |
let rdm_mutate_op op = |
|
227 |
match op with |
|
228 |
| ("+" | "-" | "*" | "/") when Random.int 100 > threshold_arith_op -> |
|
229 |
let filtered = List.filter (fun x -> x <> op) [ "+"; "-"; "*"; "/" ] in |
|
230 |
List.nth filtered (Random.int 3) |
|
231 |
| ("&&" | "||" | "xor" | "impl") when Random.int 100 > threshold_bool_op -> |
|
232 |
let filtered = |
|
233 |
List.filter (fun x -> x <> op) [ "&&"; "||"; "xor"; "impl" ] |
|
234 |
in |
|
235 |
List.nth filtered (Random.int 3) |
|
236 |
| ("<" | "<=" | ">" | ">=" | "!=" | "=") |
|
237 |
when Random.int 100 > threshold_rel_op -> |
|
238 |
let filtered = |
|
239 |
List.filter (fun x -> x <> op) [ "<"; "<="; ">"; ">="; "!="; "=" ] |
|
240 |
in |
|
241 |
List.nth filtered (Random.int 5) |
|
242 |
| _ -> |
|
243 |
op |
|
208 | 244 |
|
209 | 245 |
let rdm_mutate_var expr = |
210 | 246 |
if Types.is_bool_type expr.expr_type then |
211 | 247 |
(* if Random.int 100 > threshold_negate_bool_var then *) |
212 |
let new_e = mkpredef_call expr.expr_loc "not" [expr] in
|
|
248 |
let new_e = mkpredef_call expr.expr_loc "not" [ expr ] in
|
|
213 | 249 |
Some (expr, new_e), new_e |
214 | 250 |
(* else *) |
215 |
(* expr *) |
|
216 |
else |
|
217 |
None, expr |
|
218 |
|
|
219 |
let rdm_mutate_pre orig_expr = |
|
220 |
let new_e = Expr_pre orig_expr in |
|
221 |
Some (orig_expr, {orig_expr with expr_desc = new_e}), new_e |
|
251 |
(* expr *) |
|
252 |
else None, expr |
|
222 | 253 |
|
254 |
let rdm_mutate_pre orig_expr = |
|
255 |
let new_e = Expr_pre orig_expr in |
|
256 |
Some (orig_expr, { orig_expr with expr_desc = new_e }), new_e |
|
223 | 257 |
|
224 | 258 |
let rdm_mutate_const_value c = |
225 | 259 |
match c with |
226 |
| Const_int i -> Const_int (rdm_mutate_int i) |
|
227 |
| Const_real r -> Const_real (rdm_mutate_real r) |
|
260 |
| Const_int i -> |
|
261 |
Const_int (rdm_mutate_int i) |
|
262 |
| Const_real r -> |
|
263 |
Const_real (rdm_mutate_real r) |
|
228 | 264 |
| Const_array _ |
229 | 265 |
| Const_string _ |
230 | 266 |
| Const_modeid _ |
231 | 267 |
| Const_struct _ |
232 |
| Const_tag _ -> c |
|
268 |
| Const_tag _ -> |
|
269 |
c |
|
233 | 270 |
|
234 | 271 |
let rdm_mutate_const c = |
235 | 272 |
let new_const = rdm_mutate_const_value c.const_value in |
236 | 273 |
let mut = check_mut (mk_cst_expr c.const_value) (mk_cst_expr new_const) in |
237 | 274 |
mut, { c with const_value = new_const } |
238 | 275 |
|
239 |
|
|
240 |
let select_in_list list rdm_mutate_elem = |
|
276 |
let select_in_list list rdm_mutate_elem = |
|
241 | 277 |
let selected = Random.int (List.length list) in |
242 |
let mutation_opt, new_list, _ =
|
|
278 |
let mutation_opt, new_list, _ = |
|
243 | 279 |
List.fold_right |
244 |
(fun elem (mutation_opt, res, cpt) -> if cpt = selected then |
|
245 |
let mutation, new_elem = rdm_mutate_elem elem in |
|
246 |
Some mutation, new_elem::res, cpt+1 else mutation_opt, elem::res, cpt+1) |
|
247 |
list |
|
248 |
(None, [], 0) |
|
280 |
(fun elem (mutation_opt, res, cpt) -> |
|
281 |
if cpt = selected then |
|
282 |
let mutation, new_elem = rdm_mutate_elem elem in |
|
283 |
Some mutation, new_elem :: res, cpt + 1 |
|
284 |
else mutation_opt, elem :: res, cpt + 1) |
|
285 |
list (None, [], 0) |
|
249 | 286 |
in |
250 |
match mutation_opt with |
|
251 |
| Some mut -> mut, new_list |
|
252 |
| _ -> assert false |
|
253 |
|
|
287 |
match mutation_opt with Some mut -> mut, new_list | _ -> assert false |
|
254 | 288 |
|
255 | 289 |
let rec rdm_mutate_expr expr = |
256 | 290 |
let mk_e d = { expr with expr_desc = d } in |
257 | 291 |
match expr.expr_desc with |
258 |
| Expr_ident _ -> rdm_mutate_var expr |
|
259 |
| Expr_const c -> |
|
260 |
let new_const = rdm_mutate_const_value c in |
|
292 |
| Expr_ident _ -> |
|
293 |
rdm_mutate_var expr |
|
294 |
| Expr_const c -> |
|
295 |
let new_const = rdm_mutate_const_value c in |
|
261 | 296 |
let mut = check_mut (mk_cst_expr c) (mk_cst_expr new_const) in |
262 | 297 |
mut, mk_e (Expr_const new_const) |
263 |
| Expr_tuple l ->
|
|
298 |
| Expr_tuple l -> |
|
264 | 299 |
let mut, l' = select_in_list l rdm_mutate_expr in |
265 | 300 |
mut, mk_e (Expr_tuple l') |
266 |
| Expr_ite (i,t,e) -> (
|
|
267 |
let mut, l = select_in_list [i; t; e] rdm_mutate_expr in
|
|
301 |
| Expr_ite (i, t, e) -> (
|
|
302 |
let mut, l = select_in_list [ i; t; e ] rdm_mutate_expr in
|
|
268 | 303 |
match l with |
269 |
| [i'; t'; e'] -> mut, mk_e (Expr_ite (i', t', e')) |
|
270 |
| _ -> assert false |
|
271 |
) |
|
304 |
| [ i'; t'; e' ] -> |
|
305 |
mut, mk_e (Expr_ite (i', t', e')) |
|
306 |
| _ -> |
|
307 |
assert false) |
|
272 | 308 |
| Expr_arrow (e1, e2) -> ( |
273 |
let mut, l = select_in_list [e1; e2] rdm_mutate_expr in
|
|
309 |
let mut, l = select_in_list [ e1; e2 ] rdm_mutate_expr in
|
|
274 | 310 |
match l with |
275 |
| [e1'; e2'] -> mut, mk_e (Expr_arrow (e1', e2')) |
|
276 |
| _ -> assert false |
|
277 |
) |
|
278 |
| Expr_pre e -> |
|
311 |
| [ e1'; e2' ] -> |
|
312 |
mut, mk_e (Expr_arrow (e1', e2')) |
|
313 |
| _ -> |
|
314 |
assert false) |
|
315 |
| Expr_pre e -> |
|
279 | 316 |
let select_pre = Random.bool () in |
280 | 317 |
if select_pre then |
281 | 318 |
let mut, new_expr = rdm_mutate_pre expr in |
... | ... | |
283 | 320 |
else |
284 | 321 |
let mut, e' = rdm_mutate_expr e in |
285 | 322 |
mut, mk_e (Expr_pre e') |
286 |
| Expr_appl (op_id, args, r) ->
|
|
323 |
| Expr_appl (op_id, args, r) -> |
|
287 | 324 |
let select_op = Random.bool () in |
288 | 325 |
if select_op then |
289 | 326 |
let new_op_id = rdm_mutate_op op_id in |
... | ... | |
293 | 330 |
else |
294 | 331 |
let mut, new_args = rdm_mutate_expr args in |
295 | 332 |
mut, mk_e (Expr_appl (op_id, new_args, r)) |
296 |
(* Other constructs are kept. |
|
297 |
| Expr_fby of expr * expr |
|
298 |
| Expr_array of expr list |
|
299 |
| Expr_access of expr * Dimension.dim_expr |
|
300 |
| Expr_power of expr * Dimension.dim_expr |
|
301 |
| Expr_when of expr * ident * label |
|
302 |
| Expr_merge of ident * (label * expr) list |
|
303 |
| Expr_uclock of expr * int |
|
304 |
| Expr_dclock of expr * int |
|
305 |
| Expr_phclock of expr * rat *) |
|
306 |
| _ -> None, expr |
|
307 |
|
|
333 |
(* Other constructs are kept. | Expr_fby of expr * expr | Expr_array of expr |
|
334 |
list | Expr_access of expr * Dimension.dim_expr | Expr_power of expr * |
|
335 |
Dimension.dim_expr | Expr_when of expr * ident * label | Expr_merge of |
|
336 |
ident * (label * expr) list | Expr_uclock of expr * int | Expr_dclock of |
|
337 |
expr * int | Expr_phclock of expr * rat *) |
|
338 |
| _ -> |
|
339 |
None, expr |
|
308 | 340 |
|
309 | 341 |
let rdm_mutate_eq eq = |
310 | 342 |
let mutation, new_rhs = rdm_mutate_expr eq.eq_rhs in |
... | ... | |
312 | 344 |
|
313 | 345 |
let rnd_mutate_stmt stmt = |
314 | 346 |
match stmt with |
315 |
| Eq eq -> let mut, new_eq = rdm_mutate_eq eq in |
|
316 |
report ~level:1 |
|
317 |
(fun fmt -> fprintf fmt "mutation: %a becomes %a@ " |
|
318 |
Printers.pp_node_eq eq |
|
319 |
Printers.pp_node_eq new_eq); |
|
320 |
mut, Eq new_eq |
|
321 |
| Aut _ -> assert false |
|
322 |
|
|
323 |
let rdm_mutate_node nd = |
|
324 |
let mutation, new_node_stmts = |
|
325 |
select_in_list |
|
326 |
nd.node_stmts rnd_mutate_stmt |
|
327 |
in |
|
347 |
| Eq eq -> |
|
348 |
let mut, new_eq = rdm_mutate_eq eq in |
|
349 |
report ~level:1 (fun fmt -> |
|
350 |
fprintf fmt "mutation: %a becomes %a@ " Printers.pp_node_eq eq |
|
351 |
Printers.pp_node_eq new_eq); |
|
352 |
mut, Eq new_eq |
|
353 |
| Aut _ -> |
|
354 |
assert false |
|
355 |
|
|
356 |
let rdm_mutate_node nd = |
|
357 |
let mutation, new_node_stmts = select_in_list nd.node_stmts rnd_mutate_stmt in |
|
328 | 358 |
mutation, { nd with node_stmts = new_node_stmts } |
329 | 359 |
|
330 | 360 |
let rdm_mutate_top_decl td = |
331 | 361 |
match td.top_decl_desc with |
332 |
| Node nd ->
|
|
333 |
let mutation, new_node = rdm_mutate_node nd in
|
|
334 |
mutation, { td with top_decl_desc = Node new_node} |
|
335 |
| Const cst ->
|
|
362 |
| Node nd -> |
|
363 |
let mutation, new_node = rdm_mutate_node nd in |
|
364 |
mutation, { td with top_decl_desc = Node new_node }
|
|
365 |
| Const cst -> |
|
336 | 366 |
let mut, new_cst = rdm_mutate_const cst in |
337 | 367 |
mut, { td with top_decl_desc = Const new_cst } |
338 |
| _ -> None, td |
|
339 |
|
|
368 |
| _ -> |
|
369 |
None, td |
|
370 |
|
|
340 | 371 |
(* Create a single mutant with the provided random seed *) |
341 |
let rdm_mutate_prog prog = |
|
342 |
select_in_list prog rdm_mutate_top_decl |
|
372 |
let rdm_mutate_prog prog = select_in_list prog rdm_mutate_top_decl |
|
343 | 373 |
|
344 |
let rdm_mutate nb prog =
|
|
374 |
let rdm_mutate nb prog = |
|
345 | 375 |
let rec iterate nb res = |
346 | 376 |
incr random_seed; |
347 |
if nb <= 0 then |
|
348 |
res |
|
377 |
if nb <= 0 then res |
|
349 | 378 |
else ( |
350 | 379 |
Random.init !random_seed; |
351 | 380 |
let mutation, new_mutant = rdm_mutate_prog prog in |
352 | 381 |
match mutation with |
353 |
None -> iterate nb res |
|
354 |
| Some mutation -> ( |
|
355 |
if List.mem_assoc mutation res then ( |
|
356 |
iterate nb res |
|
357 |
) |
|
358 |
else ( |
|
359 |
report ~level:1 (fun fmt -> fprintf fmt "%i mutants remaining@ " nb); |
|
360 |
iterate (nb-1) ((mutation, new_mutant)::res) |
|
361 |
) |
|
362 |
) |
|
363 |
) |
|
382 |
| None -> |
|
383 |
iterate nb res |
|
384 |
| Some mutation -> |
|
385 |
if List.mem_assoc mutation res then iterate nb res |
|
386 |
else ( |
|
387 |
report ~level:1 (fun fmt -> fprintf fmt "%i mutants remaining@ " nb); |
|
388 |
iterate (nb - 1) ((mutation, new_mutant) :: res))) |
|
364 | 389 |
in |
365 | 390 |
iterate nb [] |
366 | 391 |
|
367 |
|
|
368 | 392 |
(*****************************************************************) |
369 | 393 |
(* Random mutation *) |
370 | 394 |
(*****************************************************************) |
... | ... | |
375 | 399 |
| Op of string * int * string |
376 | 400 |
| IncrIntCst of int |
377 | 401 |
| DecrIntCst of int |
378 |
| SwitchIntCst of int * int
|
|
402 |
| SwitchIntCst of int * int |
|
379 | 403 |
|
380 | 404 |
(* Denotes the parent node, the equation lhs and the location of the mutation *) |
381 | 405 |
type mutation_loc = ident * ident list * Location.t |
406 |
|
|
382 | 407 |
let target : mutant_t option ref = ref None |
383 | 408 |
|
384 | 409 |
let mutation_info : mutation_loc option ref = ref None |
385 |
let current_node: ident option ref = ref None |
|
410 |
|
|
411 |
let current_node : ident option ref = ref None |
|
412 |
|
|
386 | 413 |
let current_eq_lhs : ident list option ref = ref None |
414 |
|
|
387 | 415 |
let current_loc : Location.t option ref = ref None |
388 |
|
|
416 |
|
|
389 | 417 |
let set_mutation_loc () = |
390 | 418 |
target := None; |
391 | 419 |
match !current_node, !current_eq_lhs, !current_loc with |
392 |
| Some n, Some elhs, Some l -> mutation_info := Some (n, elhs, l) |
|
393 |
| _ -> assert false (* Those global vars should be defined during the |
|
394 |
visitor pattern execution *) |
|
420 |
| Some n, Some elhs, Some l -> |
|
421 |
mutation_info := Some (n, elhs, l) |
|
422 |
| _ -> |
|
423 |
assert false |
|
424 |
(* Those global vars should be defined during the visitor pattern execution *) |
|
395 | 425 |
|
396 | 426 |
let print_directive fmt d = |
397 | 427 |
match d with |
398 |
| Pre n -> Format.fprintf fmt "pre %i" n |
|
399 |
| Boolexpr n -> Format.fprintf fmt "boolexpr %i" n |
|
400 |
| Op (o, i, d) -> Format.fprintf fmt "%s %i -> %s" o i d |
|
401 |
| IncrIntCst n -> Format.fprintf fmt "incr int cst %i" n |
|
402 |
| DecrIntCst n -> Format.fprintf fmt "decr int cst %i" n |
|
403 |
| SwitchIntCst (n, m) -> Format.fprintf fmt "switch int cst %i -> %i" n m |
|
428 |
| Pre n -> |
|
429 |
Format.fprintf fmt "pre %i" n |
|
430 |
| Boolexpr n -> |
|
431 |
Format.fprintf fmt "boolexpr %i" n |
|
432 |
| Op (o, i, d) -> |
|
433 |
Format.fprintf fmt "%s %i -> %s" o i d |
|
434 |
| IncrIntCst n -> |
|
435 |
Format.fprintf fmt "incr int cst %i" n |
|
436 |
| DecrIntCst n -> |
|
437 |
Format.fprintf fmt "decr int cst %i" n |
|
438 |
| SwitchIntCst (n, m) -> |
|
439 |
Format.fprintf fmt "switch int cst %i -> %i" n m |
|
404 | 440 |
|
405 | 441 |
let print_directive_json fmt d = |
406 | 442 |
match d with |
407 |
| Pre _ -> Format.fprintf fmt "\"mutation\": \"pre\"" |
|
408 |
| Boolexpr _ -> Format.fprintf fmt "\"mutation\": \"not\"" |
|
409 |
| Op (o, _, d) -> Format.fprintf fmt "\"mutation\": \"op_conv\", \"from\": \"%s\", \"to\": \"%s\"" o d |
|
410 |
| IncrIntCst _ -> Format.fprintf fmt "\"mutation\": \"cst_incr\"" |
|
411 |
| DecrIntCst _ -> Format.fprintf fmt "\"mutation\": \"cst_decr\"" |
|
412 |
| SwitchIntCst (_, m) -> Format.fprintf fmt "\"mutation\": \"cst_switch\", \"to_cst\": \"%i\"" m |
|
413 |
|
|
414 |
let print_loc_json fmt (n,eqlhs, l) = |
|
415 |
Format.fprintf fmt "\"node_id\": \"%s\", \"eq_lhs\": [%a], \"loc_line\": \"%i\"" |
|
416 |
n |
|
417 |
(Utils.fprintf_list ~sep:", " (fun fmt s -> Format.fprintf fmt "\"%s\"" s)) eqlhs |
|
418 |
(Location.loc_line l) |
|
419 |
|
|
420 |
let fold_mutate_int i = |
|
421 |
if Random.int 100 > threshold_inc_int then |
|
422 |
i+1 |
|
423 |
else if Random.int 100 > threshold_dec_int then |
|
424 |
i-1 |
|
425 |
else if Random.int 100 > threshold_random_int then |
|
426 |
Random.int 10 |
|
443 |
| Pre _ -> |
|
444 |
Format.fprintf fmt "\"mutation\": \"pre\"" |
|
445 |
| Boolexpr _ -> |
|
446 |
Format.fprintf fmt "\"mutation\": \"not\"" |
|
447 |
| Op (o, _, d) -> |
|
448 |
Format.fprintf fmt |
|
449 |
"\"mutation\": \"op_conv\", \"from\": \"%s\", \"to\": \"%s\"" o d |
|
450 |
| IncrIntCst _ -> |
|
451 |
Format.fprintf fmt "\"mutation\": \"cst_incr\"" |
|
452 |
| DecrIntCst _ -> |
|
453 |
Format.fprintf fmt "\"mutation\": \"cst_decr\"" |
|
454 |
| SwitchIntCst (_, m) -> |
|
455 |
Format.fprintf fmt "\"mutation\": \"cst_switch\", \"to_cst\": \"%i\"" m |
|
456 |
|
|
457 |
let print_loc_json fmt (n, eqlhs, l) = |
|
458 |
Format.fprintf fmt |
|
459 |
"\"node_id\": \"%s\", \"eq_lhs\": [%a], \"loc_line\": \"%i\"" n |
|
460 |
(Utils.fprintf_list ~sep:", " (fun fmt s -> Format.fprintf fmt "\"%s\"" s)) |
|
461 |
eqlhs (Location.loc_line l) |
|
462 |
|
|
463 |
let fold_mutate_int i = |
|
464 |
if Random.int 100 > threshold_inc_int then i + 1 |
|
465 |
else if Random.int 100 > threshold_dec_int then i - 1 |
|
466 |
else if Random.int 100 > threshold_random_int then Random.int 10 |
|
427 | 467 |
else if Random.int 100 > threshold_switch_int then |
428 | 468 |
try |
429 |
let idx = Random.int (List.length !int_consts) in
|
|
430 |
List.nth !int_consts idx
|
|
469 |
let idx = Random.int (List.length !int_consts) in
|
|
470 |
List.nth !int_consts idx |
|
431 | 471 |
with _ -> i |
432 |
else |
|
433 |
i |
|
434 |
|
|
472 |
else i |
|
473 |
|
|
435 | 474 |
let fold_mutate_float f = |
436 |
if Random.int 100 > threshold_random_float then |
|
437 |
Random.float 10. |
|
438 |
else
|
|
439 |
f
|
|
440 |
|
|
441 |
let fold_mutate_op op =
|
|
442 |
(* match op with *)
|
|
443 |
(* | "+" | "-" | "*" | "/" when Random.int 100 > threshold_arith_op -> *)
|
|
444 |
(* let filtered = List.filter (fun x -> x <> op) ["+"; "-"; "*"; "/"] in *)
|
|
445 |
(* List.nth filtered (Random.int 3) *)
|
|
446 |
(* | "&&" | "||" | "xor" | "impl" when Random.int 100 > threshold_bool_op -> *)
|
|
447 |
(* let filtered = List.filter (fun x -> x <> op) ["&&"; "||"; "xor"; "impl"] in *)
|
|
448 |
(* List.nth filtered (Random.int 3) *)
|
|
449 |
(* | "<" | "<=" | ">" | ">=" | "!=" | "=" when Random.int 100 > threshold_rel_op -> *)
|
|
450 |
(* let filtered = List.filter (fun x -> x <> op) ["<"; "<="; ">"; ">="; "!="; "="] in *)
|
|
451 |
(* List.nth filtered (Random.int 5) *) |
|
452 |
(* | _ -> op *) |
|
475 |
if Random.int 100 > threshold_random_float then Random.float 10. else f
|
|
476 |
|
|
477 |
let fold_mutate_op op =
|
|
478 |
(* match op with *)
|
|
479 |
(* | "+" | "-" | "*" | "/" when Random.int 100 > threshold_arith_op -> *) |
|
480 |
(* let filtered = List.filter (fun x -> x <> op) ["+"; "-"; "*"; "/"] in *)
|
|
481 |
(* List.nth filtered (Random.int 3) *)
|
|
482 |
(* | "&&" | "||" | "xor" | "impl" when Random.int 100 > threshold_bool_op -> *)
|
|
483 |
(* let filtered = List.filter (fun x -> x <> op) ["&&"; "||"; "xor"; "impl"]
|
|
484 |
in *)
|
|
485 |
(* List.nth filtered (Random.int 3) *)
|
|
486 |
(* | "<" | "<=" | ">" | ">=" | "!=" | "=" when Random.int 100 >
|
|
487 |
threshold_rel_op -> *)
|
|
488 |
(* let filtered = List.filter (fun x -> x <> op) ["<"; "<="; ">"; ">="; "!=";
|
|
489 |
"="] in *)
|
|
490 |
(* List.nth filtered (Random.int 5) *)
|
|
491 |
(* | _ -> op *)
|
|
453 | 492 |
match !target with |
454 |
| Some (Op(op_orig, 0, op_new)) when op_orig = op -> (
|
|
493 |
| Some (Op (op_orig, 0, op_new)) when op_orig = op ->
|
|
455 | 494 |
set_mutation_loc (); |
456 | 495 |
op_new |
457 |
) |
|
458 |
| Some (Op(op_orig, n, op_new)) when op_orig = op -> ( |
|
459 |
target := Some (Op(op_orig, n-1, op_new)); |
|
496 |
| Some (Op (op_orig, n, op_new)) when op_orig = op -> |
|
497 |
target := Some (Op (op_orig, n - 1, op_new)); |
|
498 |
op |
|
499 |
| _ -> |
|
460 | 500 |
op |
461 |
) |
|
462 |
| _ -> op |
|
463 |
|
|
464 | 501 |
|
465 |
let fold_mutate_var expr =
|
|
502 |
let fold_mutate_var expr = |
|
466 | 503 |
(* match (Types.repr expr.expr_type).Types.tdesc with *) |
467 | 504 |
(* | Types.Tbool -> *) |
468 | 505 |
(* (\* if Random.int 100 > threshold_negate_bool_var then *\) *) |
469 | 506 |
(* mkpredef_unary_call Location.dummy_loc "not" expr *) |
470 | 507 |
(* (\* else *\) *) |
471 | 508 |
(* (\* expr *\) *) |
472 |
(* | _ -> |
|
473 |
*)expr
|
|
509 |
(* | _ -> *)
|
|
510 |
expr
|
|
474 | 511 |
|
475 | 512 |
let fold_mutate_boolexpr expr = |
476 | 513 |
match !target with |
477 |
| Some (Boolexpr 0) -> (
|
|
478 |
set_mutation_loc ();
|
|
514 |
| Some (Boolexpr 0) -> |
|
515 |
set_mutation_loc (); |
|
479 | 516 |
|
480 |
mkpredef_call expr.expr_loc "not" [expr] |
|
481 |
) |
|
517 |
mkpredef_call expr.expr_loc "not" [ expr ] |
|
482 | 518 |
| Some (Boolexpr n) -> |
483 |
(target := Some (Boolexpr (n-1)); expr) |
|
484 |
| _ -> expr |
|
485 |
|
|
486 |
let fold_mutate_pre orig_expr e = |
|
519 |
target := Some (Boolexpr (n - 1)); |
|
520 |
expr |
|
521 |
| _ -> |
|
522 |
expr |
|
523 |
|
|
524 |
let fold_mutate_pre orig_expr e = |
|
487 | 525 |
match !target with |
488 |
Some (Pre 0) -> ( |
|
489 |
set_mutation_loc (); |
|
490 |
Expr_pre ({orig_expr with expr_desc = Expr_pre e}) |
|
491 |
) |
|
492 |
| Some (Pre n) -> ( |
|
493 |
target := Some (Pre (n-1)); |
|
526 |
| Some (Pre 0) -> |
|
527 |
set_mutation_loc (); |
|
528 |
Expr_pre { orig_expr with expr_desc = Expr_pre e } |
|
529 |
| Some (Pre n) -> |
|
530 |
target := Some (Pre (n - 1)); |
|
531 |
Expr_pre e |
|
532 |
| _ -> |
|
494 | 533 |
Expr_pre e |
495 |
) |
|
496 |
| _ -> Expr_pre e |
|
497 |
|
|
534 |
|
|
498 | 535 |
let fold_mutate_const_value c = |
499 | 536 |
match c with |
500 | 537 |
| Const_int i -> ( |
501 | 538 |
match !target with |
502 |
| Some (IncrIntCst 0) -> (set_mutation_loc (); Const_int (i+1)) |
|
503 |
| Some (DecrIntCst 0) -> (set_mutation_loc (); Const_int (i-1)) |
|
539 |
| Some (IncrIntCst 0) -> |
|
540 |
set_mutation_loc (); |
|
541 |
Const_int (i + 1) |
|
542 |
| Some (DecrIntCst 0) -> |
|
543 |
set_mutation_loc (); |
|
544 |
Const_int (i - 1) |
|
504 | 545 |
| Some (SwitchIntCst (0, id)) -> |
505 |
(set_mutation_loc (); Const_int id) |
|
506 |
| Some (IncrIntCst n) -> (target := Some (IncrIntCst (n-1)); c) |
|
507 |
| Some (DecrIntCst n) -> (target := Some (DecrIntCst (n-1)); c) |
|
508 |
| Some (SwitchIntCst (n, id)) -> (target := Some (SwitchIntCst (n-1, id)); c) |
|
509 |
| _ -> c) |
|
510 |
| _ -> c |
|
511 |
|
|
512 |
(* |
|
513 |
match c with |
|
514 |
| Const_int i -> Const_int (fold_mutate_int i) |
|
515 |
| Const_real s -> Const_real s (* those are string, let's leave them *) |
|
516 |
| Const_float f -> Const_float (fold_mutate_float f) |
|
517 |
| Const_array _ |
|
518 |
| Const_tag _ -> c |
|
519 |
TODO |
|
520 |
|
|
521 |
*) |
|
546 |
set_mutation_loc (); |
|
547 |
Const_int id |
|
548 |
| Some (IncrIntCst n) -> |
|
549 |
target := Some (IncrIntCst (n - 1)); |
|
550 |
c |
|
551 |
| Some (DecrIntCst n) -> |
|
552 |
target := Some (DecrIntCst (n - 1)); |
|
553 |
c |
|
554 |
| Some (SwitchIntCst (n, id)) -> |
|
555 |
target := Some (SwitchIntCst (n - 1, id)); |
|
556 |
c |
|
557 |
| _ -> |
|
558 |
c) |
|
559 |
| _ -> |
|
560 |
c |
|
561 |
|
|
562 |
(* match c with | Const_int i -> Const_int (fold_mutate_int i) | Const_real s -> |
|
563 |
Const_real s (* those are string, let's leave them *) | Const_float f -> |
|
564 |
Const_float (fold_mutate_float f) | Const_array _ | Const_tag _ -> c TODO *) |
|
522 | 565 |
let fold_mutate_const c = |
523 | 566 |
{ c with const_value = fold_mutate_const_value c.const_value } |
524 | 567 |
|
525 | 568 |
let rec fold_mutate_expr expr = |
526 | 569 |
current_loc := Some expr.expr_loc; |
527 |
let new_expr =
|
|
570 |
let new_expr = |
|
528 | 571 |
match expr.expr_desc with |
529 |
| Expr_ident _ -> fold_mutate_var expr |
|
530 |
| _ -> ( |
|
531 |
let new_desc = match expr.expr_desc with |
|
532 |
| Expr_const c -> Expr_const (fold_mutate_const_value c) |
|
533 |
| Expr_tuple l -> Expr_tuple (List.fold_right (fun e res -> (fold_mutate_expr e)::res) l []) |
|
534 |
| Expr_ite (i,t,e) -> Expr_ite (fold_mutate_expr i, fold_mutate_expr t, fold_mutate_expr e) |
|
535 |
| Expr_arrow (e1, e2) -> Expr_arrow (fold_mutate_expr e1, fold_mutate_expr e2) |
|
536 |
| Expr_pre e -> fold_mutate_pre expr (fold_mutate_expr e) |
|
537 |
| Expr_appl (op_id, args, r) -> Expr_appl (fold_mutate_op op_id, fold_mutate_expr args, r) |
|
538 |
(* Other constructs are kept. |
|
539 |
| Expr_fby of expr * expr |
|
540 |
| Expr_array of expr list |
|
541 |
| Expr_access of expr * Dimension.dim_expr |
|
542 |
| Expr_power of expr * Dimension.dim_expr |
|
543 |
| Expr_when of expr * ident * label |
|
544 |
| Expr_merge of ident * (label * expr) list |
|
545 |
| Expr_uclock of expr * int |
|
546 |
| Expr_dclock of expr * int |
|
547 |
| Expr_phclock of expr * rat *) |
|
548 |
| _ -> expr.expr_desc |
|
549 |
|
|
572 |
| Expr_ident _ -> |
|
573 |
fold_mutate_var expr |
|
574 |
| _ -> |
|
575 |
let new_desc = |
|
576 |
match expr.expr_desc with |
|
577 |
| Expr_const c -> |
|
578 |
Expr_const (fold_mutate_const_value c) |
|
579 |
| Expr_tuple l -> |
|
580 |
Expr_tuple |
|
581 |
(List.fold_right (fun e res -> fold_mutate_expr e :: res) l []) |
|
582 |
| Expr_ite (i, t, e) -> |
|
583 |
Expr_ite (fold_mutate_expr i, fold_mutate_expr t, fold_mutate_expr e) |
|
584 |
| Expr_arrow (e1, e2) -> |
|
585 |
Expr_arrow (fold_mutate_expr e1, fold_mutate_expr e2) |
|
586 |
| Expr_pre e -> |
|
587 |
fold_mutate_pre expr (fold_mutate_expr e) |
|
588 |
| Expr_appl (op_id, args, r) -> |
|
589 |
Expr_appl (fold_mutate_op op_id, fold_mutate_expr args, r) |
|
590 |
(* Other constructs are kept. | Expr_fby of expr * expr | Expr_array of |
|
591 |
expr list | Expr_access of expr * Dimension.dim_expr | Expr_power of |
|
592 |
expr * Dimension.dim_expr | Expr_when of expr * ident * label | |
|
593 |
Expr_merge of ident * (label * expr) list | Expr_uclock of expr * int |
|
594 |
| Expr_dclock of expr * int | Expr_phclock of expr * rat *) |
|
595 |
| _ -> |
|
596 |
expr.expr_desc |
|
550 | 597 |
in |
598 |
|
|
551 | 599 |
{ expr with expr_desc = new_desc } |
552 |
) |
|
553 | 600 |
in |
554 |
if Types.is_bool_type expr.expr_type then |
|
555 |
fold_mutate_boolexpr new_expr |
|
556 |
else |
|
557 |
new_expr |
|
601 |
if Types.is_bool_type expr.expr_type then fold_mutate_boolexpr new_expr |
|
602 |
else new_expr |
|
558 | 603 |
|
559 | 604 |
let fold_mutate_eq eq = |
560 | 605 |
current_eq_lhs := Some eq.eq_lhs; |
561 | 606 |
{ eq with eq_rhs = fold_mutate_expr eq.eq_rhs } |
562 | 607 |
|
563 | 608 |
let fold_mutate_stmt stmt = |
564 |
match stmt with |
|
565 |
| Eq eq -> Eq (fold_mutate_eq eq) |
|
566 |
| Aut _ -> assert false |
|
567 |
|
|
609 |
match stmt with Eq eq -> Eq (fold_mutate_eq eq) | Aut _ -> assert false |
|
568 | 610 |
|
569 | 611 |
let fold_mutate_node nd = |
570 | 612 |
current_node := Some nd.node_id; |
571 | 613 |
let nd = |
572 |
{ nd with |
|
573 |
node_stmts = |
|
574 |
List.fold_right (fun stmt res -> (fold_mutate_stmt stmt)::res) nd.node_stmts []; |
|
614 |
{ |
|
615 |
nd with |
|
616 |
node_stmts = |
|
617 |
List.fold_right |
|
618 |
(fun stmt res -> fold_mutate_stmt stmt :: res) |
|
619 |
nd.node_stmts []; |
|
575 | 620 |
} |
576 | 621 |
in |
577 |
rename_node rename_app (fun x -> x) nd
|
|
622 |
rename_node rename_app (fun x -> x) nd |
|
578 | 623 |
|
579 | 624 |
let fold_mutate_top_decl td = |
580 | 625 |
match td.top_decl_desc with |
581 |
| Node nd -> { td with top_decl_desc = Node (fold_mutate_node nd)} |
|
582 |
| Const cst -> { td with top_decl_desc = Const (fold_mutate_const cst)} |
|
583 |
| _ -> td |
|
584 |
|
|
626 |
| Node nd -> |
|
627 |
{ td with top_decl_desc = Node (fold_mutate_node nd) } |
|
628 |
| Const cst -> |
|
629 |
{ td with top_decl_desc = Const (fold_mutate_const cst) } |
|
630 |
| _ -> |
|
631 |
td |
|
632 |
|
|
585 | 633 |
(* Create a single mutant with the provided random seed *) |
586 |
let fold_mutate_prog prog =
|
|
587 |
List.fold_right (fun e res -> (fold_mutate_top_decl e)::res) prog []
|
|
634 |
let fold_mutate_prog prog = |
|
635 |
List.fold_right (fun e res -> fold_mutate_top_decl e :: res) prog []
|
|
588 | 636 |
|
589 |
let create_mutant prog directive =
|
|
590 |
target := Some directive;
|
|
637 |
let create_mutant prog directive = |
|
638 |
target := Some directive; |
|
591 | 639 |
let prog' = fold_mutate_prog prog in |
592 |
let mutation_info = match !target , !mutation_info with |
|
593 |
| None, Some mi -> mi |
|
594 |
| _ -> ( |
|
595 |
Format.eprintf "Failed when creating mutant for directive %a@.@?" print_directive directive; |
|
596 |
let _ = match !target with Some dir' -> Format.eprintf "New directive %a@.@?" print_directive dir' | _ -> () in |
|
597 |
assert false (* The mutation has not been performed. *) |
|
598 |
) |
|
599 |
|
|
640 |
let mutation_info = |
|
641 |
match !target, !mutation_info with |
|
642 |
| None, Some mi -> |
|
643 |
mi |
|
644 |
| _ -> |
|
645 |
Format.eprintf "Failed when creating mutant for directive %a@.@?" |
|
646 |
print_directive directive; |
|
647 |
let _ = |
|
648 |
match !target with |
|
649 |
| Some dir' -> |
|
650 |
Format.eprintf "New directive %a@.@?" print_directive dir' |
|
651 |
| _ -> |
|
652 |
() |
|
653 |
in |
|
654 |
assert false |
|
655 |
(* The mutation has not been performed. *) |
|
600 | 656 |
in |
601 |
(* target := None; (* should happen only if no mutation occured during the |
|
602 |
visit *)*) |
|
657 |
|
|
658 |
(* target := None; (* should happen only if no mutation occured during the |
|
659 |
visit *)*) |
|
603 | 660 |
prog', mutation_info |
604 |
|
|
605 | 661 |
|
606 |
let op_mutation op =
|
|
662 |
let op_mutation op = |
|
607 | 663 |
let res = |
608 | 664 |
let rem_op l = List.filter (fun e -> e <> op) l in |
609 |
if List.mem op arith_op then rem_op arith_op else
|
|
610 |
if List.mem op bool_op then rem_op bool_op else
|
|
611 |
if List.mem op rel_op then rem_op rel_op else
|
|
612 |
(Format.eprintf "Failing with op %s@." op;
|
|
613 |
assert false
|
|
614 |
)
|
|
665 |
if List.mem op arith_op then rem_op arith_op
|
|
666 |
else if List.mem op bool_op then rem_op bool_op
|
|
667 |
else if List.mem op rel_op then rem_op rel_op
|
|
668 |
else (
|
|
669 |
Format.eprintf "Failing with op %s@." op;
|
|
670 |
assert false)
|
|
615 | 671 |
in |
616 |
(* Format.eprintf "Mutation op %s to [%a]@." op (Utils.fprintf_list ~sep:"," Format.pp_print_string) res; *) |
|
672 |
(* Format.eprintf "Mutation op %s to [%a]@." op (Utils.fprintf_list ~sep:"," |
|
673 |
Format.pp_print_string) res; *) |
|
617 | 674 |
res |
618 | 675 |
|
619 | 676 |
let rec remains select list = |
620 |
match list with |
|
621 |
[] -> [] |
|
622 |
| hd::tl -> if select hd then tl else remains select tl |
|
623 |
|
|
677 |
match list with |
|
678 |
| [] -> |
|
679 |
[] |
|
680 |
| hd :: tl -> |
|
681 |
if select hd then tl else remains select tl |
|
682 |
|
|
624 | 683 |
let next_change m = |
625 |
let res = |
|
626 |
let rec first_op () = |
|
627 |
try |
|
628 |
let min_binding = OpCount.min_binding !records.nb_op in |
|
629 |
Op (fst min_binding, 0, List.hd (op_mutation (fst min_binding))) |
|
630 |
with Not_found -> first_boolexpr () |
|
631 |
and first_boolexpr () = |
|
632 |
if !records.nb_boolexpr > 0 then |
|
633 |
Boolexpr 0 |
|
634 |
else first_pre () |
|
635 |
and first_pre () = |
|
636 |
if !records.nb_pre > 0 then |
|
637 |
Pre 0 |
|
638 |
else |
|
639 |
first_op () |
|
640 |
and first_intcst () = |
|
641 |
if IntSet.cardinal !records.consts > 0 then |
|
642 |
IncrIntCst 0 |
|
643 |
else |
|
644 |
first_boolexpr () |
|
684 |
let res = |
|
685 |
let rec first_op () = |
|
686 |
try |
|
687 |
let min_binding = OpCount.min_binding !records.nb_op in |
|
688 |
Op (fst min_binding, 0, List.hd (op_mutation (fst min_binding))) |
|
689 |
with Not_found -> first_boolexpr () |
|
690 |
and first_boolexpr () = |
|
691 |
if !records.nb_boolexpr > 0 then Boolexpr 0 else first_pre () |
|
692 |
and first_pre () = if !records.nb_pre > 0 then Pre 0 else first_op () |
|
693 |
and first_intcst () = |
|
694 |
if IntSet.cardinal !records.consts > 0 then IncrIntCst 0 |
|
695 |
else first_boolexpr () |
|
696 |
in |
|
697 |
match m with |
|
698 |
| Boolexpr n -> |
|
699 |
if n + 1 >= !records.nb_boolexpr then first_pre () else Boolexpr (n + 1) |
|
700 |
| Pre n -> |
|
701 |
if n + 1 >= !records.nb_pre then first_op () else Pre (n + 1) |
|
702 |
| Op (orig, id, mut_op) -> ( |
|
703 |
match remains (fun x -> x = mut_op) (op_mutation orig) with |
|
704 |
| next_op :: _ -> |
|
705 |
Op (orig, id, next_op) |
|
706 |
| [] -> |
|
707 |
if id + 1 >= OpCount.find orig !records.nb_op then |
|
708 |
match |
|
709 |
remains (fun (k1, _) -> k1 = orig) (OpCount.bindings !records.nb_op) |
|
710 |
with |
|
711 |
| [] -> |
|
712 |
first_intcst () |
|
713 |
| hd :: _ -> |
|
714 |
Op (fst hd, 0, List.hd (op_mutation (fst hd))) |
|
715 |
else Op (orig, id + 1, List.hd (op_mutation orig))) |
|
716 |
| IncrIntCst n -> |
|
717 |
if n + 1 >= IntSet.cardinal !records.consts then DecrIntCst 0 |
|
718 |
else IncrIntCst (n + 1) |
|
719 |
| DecrIntCst n -> |
|
720 |
if n + 1 >= IntSet.cardinal !records.consts then SwitchIntCst (0, 0) |
|
721 |
else DecrIntCst (n + 1) |
|
722 |
| SwitchIntCst (n, m) -> |
|
723 |
if m + 1 > -1 + IntSet.cardinal !records.consts then |
|
724 |
SwitchIntCst (n, m + 1) |
|
725 |
else if n + 1 >= IntSet.cardinal !records.consts then |
|
726 |
SwitchIntCst (n + 1, 0) |
|
727 |
else first_boolexpr () |
|
645 | 728 |
in |
646 |
match m with |
|
647 |
| Boolexpr n -> |
|
648 |
if n+1 >= !records.nb_boolexpr then |
|
649 |
first_pre () |
|
650 |
else |
|
651 |
Boolexpr (n+1) |
|
652 |
| Pre n -> |
|
653 |
if n+1 >= !records.nb_pre then |
|
654 |
first_op () |
|
655 |
else Pre (n+1) |
|
656 |
| Op (orig, id, mut_op) -> ( |
|
657 |
match remains (fun x -> x = mut_op) (op_mutation orig) with |
|
658 |
| next_op::_ -> Op (orig, id, next_op) |
|
659 |
| [] -> if id+1 >= OpCount.find orig !records.nb_op then ( |
|
660 |
match remains (fun (k1, _) -> k1 = orig) (OpCount.bindings !records.nb_op) with |
|
661 |
| [] -> first_intcst () |
|
662 |
| hd::_ -> Op (fst hd, 0, List.hd (op_mutation (fst hd))) |
|
663 |
) else |
|
664 |
Op(orig, id+1, List.hd (op_mutation orig)) |
|
665 |
) |
|
666 |
| IncrIntCst n -> |
|
667 |
if n+1 >= IntSet.cardinal !records.consts then |
|
668 |
DecrIntCst 0 |
|
669 |
else IncrIntCst (n+1) |
|
670 |
| DecrIntCst n -> |
|
671 |
if n+1 >= IntSet.cardinal !records.consts then |
|
672 |
SwitchIntCst (0, 0) |
|
673 |
else DecrIntCst (n+1) |
|
674 |
| SwitchIntCst (n, m) -> |
|
675 |
if m+1 > -1 + IntSet.cardinal !records.consts then |
|
676 |
SwitchIntCst (n, m+1) |
|
677 |
else if n+1 >= IntSet.cardinal !records.consts then |
|
678 |
SwitchIntCst (n+1, 0) |
|
679 |
else first_boolexpr () |
|
680 | 729 |
|
681 |
in |
|
682 |
(* Format.eprintf "from: %a to: %a@." print_directive m print_directive res; *) |
|
730 |
(* Format.eprintf "from: %a to: %a@." print_directive m print_directive res; *) |
|
683 | 731 |
res |
684 | 732 |
|
685 |
let fold_mutate nb prog =
|
|
733 |
let fold_mutate nb prog = |
|
686 | 734 |
incr random_seed; |
687 | 735 |
Random.init !random_seed; |
736 |
|
|
688 | 737 |
(* Local references to keep track of generated directives *) |
689 | 738 |
|
690 | 739 |
(* build a set of integer 0, 1, ... n-1 for input n *) |
... | ... | |
692 | 741 |
let arr = Array.init cpt (fun x -> x) in |
693 | 742 |
Array.fold_right IntSet.add arr IntSet.empty |
694 | 743 |
in |
695 |
|
|
744 |
|
|
696 | 745 |
let possible_const_id = cpt_to_intset !records.nb_consts in |
746 |
|
|
697 | 747 |
(* let possible_boolexpr_id = cpt_to_intset !records.nb_boolexpr in *) |
698 | 748 |
(* let possible_pre_id = cpt_to_intset !records.nb_pre in *) |
699 |
|
|
700 | 749 |
let incremented_const_id = ref IntSet.empty in |
701 | 750 |
let decremented_const_id = ref IntSet.empty in |
702 |
|
|
751 |
|
|
703 | 752 |
let create_new_incr_decr registered build = |
704 |
let possible = IntSet.diff possible_const_id !registered |> IntSet.elements in |
|
753 |
let possible = |
|
754 |
IntSet.diff possible_const_id !registered |> IntSet.elements |
|
755 |
in |
|
705 | 756 |
let len = List.length possible in |
706 |
if len <= 0 then |
|
707 |
false, build (-1) (* Should not be stored *) |
|
757 |
if len <= 0 then false, build (-1) (* Should not be stored *) |
|
708 | 758 |
else |
709 | 759 |
let picked = List.nth possible (Random.int (List.length possible)) in |
710 | 760 |
registered := IntSet.add picked !registered; |
711 | 761 |
true, build picked |
712 | 762 |
in |
713 | 763 |
|
764 |
let module DblIntSet = Set.Make (struct |
|
765 |
type t = int * int |
|
714 | 766 |
|
715 |
let module DblIntSet = Set.Make (struct type t = int * int let compare = compare end) in |
|
767 |
let compare = compare |
|
768 |
end) in |
|
716 | 769 |
let switch_const_id = ref DblIntSet.empty in |
717 | 770 |
let switch_set = |
718 |
if IntSet.cardinal !records.consts <= 1 then |
|
719 |
DblIntSet.empty |
|
771 |
if IntSet.cardinal !records.consts <= 1 then DblIntSet.empty |
|
720 | 772 |
else |
721 |
(* First element is cst id (the ith cst) while second is the |
|
722 |
ith element of the set of gathered constants
|
|
723 |
!record.consts *)
|
|
724 |
IntSet.fold (fun cst_id set ->
|
|
725 |
IntSet.fold (fun ith_cst set ->
|
|
726 |
DblIntSet.add (cst_id, ith_cst) set
|
|
727 |
) !records.consts set
|
|
728 |
) possible_const_id DblIntSet.empty
|
|
773 |
(* First element is cst id (the ith cst) while second is the ith element
|
|
774 |
of the set of gathered constants !record.consts *)
|
|
775 |
IntSet.fold
|
|
776 |
(fun cst_id set ->
|
|
777 |
IntSet.fold
|
|
778 |
(fun ith_cst set -> DblIntSet.add (cst_id, ith_cst) set)
|
|
779 |
!records.consts set)
|
|
780 |
possible_const_id DblIntSet.empty
|
|
729 | 781 |
in |
730 | 782 |
|
731 | 783 |
let create_new_switch registered build = |
732 |
let possible = DblIntSet.diff switch_set !registered |> DblIntSet.elements in |
|
784 |
let possible = |
|
785 |
DblIntSet.diff switch_set !registered |> DblIntSet.elements |
|
786 |
in |
|
733 | 787 |
let len = List.length possible in |
734 |
if len <= 0 then |
|
735 |
false, build (-1,-1) (* Should not be stored *) |
|
788 |
if len <= 0 then false, build (-1, -1) (* Should not be stored *) |
|
736 | 789 |
else |
737 | 790 |
let picked = List.nth possible (Random.int (List.length possible)) in |
738 | 791 |
registered := DblIntSet.add picked !registered; |
739 | 792 |
true, build picked |
740 | 793 |
in |
741 |
|
|
794 |
|
|
742 | 795 |
let find_next_new mutants mutant = |
743 | 796 |
let find_next_new init current = |
744 |
if init = current || List.mem current mutants then raise Not_found else
|
|
745 |
|
|
746 |
(* TODO: check if we can generate more cases. The following lines were
|
|
747 |
cylcing and missing to detect that the enumaration was complete,
|
|
748 |
leading to a non terminating process. The current setting is harder
|
|
749 |
but may miss enumerating some cases. To be checked! *)
|
|
750 |
|
|
751 |
(* if List.mem current mutants then *)
|
|
752 |
(* find_next_new init (next_change current) *)
|
|
753 |
(* else *)
|
|
754 |
current
|
|
797 |
if init = current || List.mem current mutants then raise Not_found |
|
798 |
else |
|
799 |
(* TODO: check if we can generate more cases. The following lines were
|
|
800 |
cylcing and missing to detect that the enumaration was complete,
|
|
801 |
leading to a non terminating process. The current setting is harder
|
|
802 |
but may miss enumerating some cases. To be checked! *)
|
|
803 |
|
|
804 |
(* if List.mem current mutants then *)
|
|
805 |
(* find_next_new init (next_change current) *)
|
|
806 |
(* else *)
|
|
807 |
current
|
|
755 | 808 |
in |
756 |
find_next_new mutant (next_change mutant)
|
|
809 |
find_next_new mutant (next_change mutant) |
|
757 | 810 |
in |
758 | 811 |
(* Creating list of nb elements of mutants *) |
759 |
let rec create_mutants_directives rnb mutants =
|
|
760 |
if rnb <= 0 then mutants
|
|
812 |
let rec create_mutants_directives rnb mutants = |
|
813 |
if rnb <= 0 then mutants |
|
761 | 814 |
else |
762 | 815 |
(* Initial list of transformation *) |
763 |
let rec init_list x = if x <= 0 then [0] else x::(init_list (x-1)) in
|
|
816 |
let rec init_list x = if x <= 0 then [ 0 ] else x :: init_list (x - 1) in
|
|
764 | 817 |
let init_list = init_list 5 in |
765 | 818 |
(* We generate a random permutation of the list: the first item is the |
766 |
transformation, the rest of the list act as fallback choices to make
|
|
767 |
sure we produce something *)
|
|
819 |
transformation, the rest of the list act as fallback choices to make
|
|
820 |
sure we produce something *)
|
|
768 | 821 |
let shuffle l = |
769 |
let nd = List.map (fun c -> Random.bits (), c) l in
|
|
770 |
let sond = List.sort compare nd in
|
|
771 |
List.map snd sond
|
|
822 |
let nd = List.map (fun c -> Random.bits (), c) l in
|
|
823 |
let sond = List.sort compare nd in
|
|
824 |
List.map snd sond
|
|
772 | 825 |
in |
773 | 826 |
let transforms = shuffle init_list in |
774 | 827 |
let rec apply_transform transforms = |
775 |
let f id = |
|
776 |
match id with |
|
777 |
| 5 -> create_new_incr_decr incremented_const_id (fun x -> IncrIntCst x) |
|
778 |
| 4 -> create_new_incr_decr decremented_const_id (fun x -> DecrIntCst x) |
|
779 |
| 3 -> create_new_switch switch_const_id (fun (x,y) -> SwitchIntCst(x, y)) |
|
780 |
| 2 -> !records.nb_pre >0, Pre (try Random.int !records.nb_pre with _ -> 0) |
|
781 |
| 1 -> !records.nb_boolexpr > 0, Boolexpr (try Random.int !records.nb_boolexpr with _ -> 0) |
|
782 |
| 0 -> let bindings = OpCount.bindings !records.nb_op in |
|
783 |
let bindings_len = List.length bindings in |
|
784 |
if bindings_len > 0 then |
|
785 |
let op, nb_op = List.nth bindings (try Random.int bindings_len with _ -> 0) in |
|
786 |
let op_mut = op_mutation op in |
|
787 |
let new_op = List.nth op_mut (try Random.int (List.length op_mut) with _ -> 0) in |
|
788 |
true, Op (op, (try Random.int nb_op with _ -> 0), new_op) |
|
789 |
else |
|
790 |
false, Boolexpr 0 (* Providing a dummy construct, |
|
791 |
it will be filtered out thanks |
|
792 |
to the negative status (fst = |
|
793 |
false) *) |
|
794 |
| _ -> assert false |
|
795 |
in |
|
796 |
match transforms with |
|
797 |
| [] -> assert false |
|
798 |
| [hd] -> f hd |
|
799 |
| hd::tl -> let ok, random_mutation = f hd in |
|
800 |
if ok then |
|
801 |
ok, random_mutation |
|
802 |
else |
|
803 |
apply_transform tl |
|
828 |
let f id = |
|
829 |
match id with |
|
830 |
| 5 -> |
|
831 |
create_new_incr_decr incremented_const_id (fun x -> IncrIntCst x) |
|
832 |
| 4 -> |
|
833 |
create_new_incr_decr decremented_const_id (fun x -> DecrIntCst x) |
|
834 |
| 3 -> |
|
835 |
create_new_switch switch_const_id (fun (x, y) -> |
|
836 |
SwitchIntCst (x, y)) |
|
837 |
| 2 -> |
|
838 |
( !records.nb_pre > 0, |
|
839 |
Pre (try Random.int !records.nb_pre with _ -> 0) ) |
|
840 |
| 1 -> |
|
841 |
( !records.nb_boolexpr > 0, |
|
842 |
Boolexpr (try Random.int !records.nb_boolexpr with _ -> 0) ) |
|
843 |
| 0 -> |
|
844 |
let bindings = OpCount.bindings !records.nb_op in |
|
845 |
let bindings_len = List.length bindings in |
|
846 |
if bindings_len > 0 then |
|
847 |
let op, nb_op = |
|
848 |
List.nth bindings (try Random.int bindings_len with _ -> 0) |
|
849 |
in |
|
850 |
let op_mut = op_mutation op in |
|
851 |
let new_op = |
|
852 |
List.nth op_mut |
|
853 |
(try Random.int (List.length op_mut) with _ -> 0) |
|
854 |
in |
|
855 |
true, Op (op, (try Random.int nb_op with _ -> 0), new_op) |
|
856 |
else false, Boolexpr 0 |
|
857 |
(* Providing a dummy construct, it will be filtered out thanks to the |
|
858 |
negative status (fst = false) *) |
|
859 |
| _ -> |
|
860 |
assert false |
|
861 |
in |
|
862 |
match transforms with |
|
863 |
| [] -> |
|
864 |
assert false |
|
865 |
| [ hd ] -> |
|
866 |
f hd |
|
867 |
| hd :: tl -> |
|
868 |
let ok, random_mutation = f hd in |
|
869 |
if ok then ok, random_mutation else apply_transform tl |
|
804 | 870 |
in |
805 | 871 |
let ok, random_mutation = apply_transform transforms in |
806 | 872 |
let stop_process () = |
807 |
report ~level:1 (fun fmt -> fprintf fmt
|
|
808 |
"Only %i mutants directives generated out of %i expected@ "
|
|
809 |
(nb-rnb)
|
|
810 |
nb);
|
|
811 |
mutants
|
|
873 |
report ~level:1 (fun fmt ->
|
|
874 |
fprintf fmt
|
|
875 |
"Only %i mutants directives generated out of %i expected@ "
|
|
876 |
(nb - rnb) nb);
|
|
877 |
mutants
|
|
812 | 878 |
in |
813 |
if not ok then |
|
814 |
stop_process () |
|
879 |
if not ok then stop_process () |
|
815 | 880 |
else if List.mem random_mutation mutants then |
816 |
try |
|
817 |
let new_mutant = (find_next_new mutants random_mutation) in |
|
818 |
report ~level:2 (fun fmt -> fprintf fmt " %i mutants directive generated out of %i expected@ " (nb-rnb) nb); |
|
819 |
create_mutants_directives (rnb-1) (new_mutant::mutants) |
|
820 |
with Not_found -> ( |
|
821 |
stop_process () |
|
822 |
) |
|
823 |
else ( |
|
824 |
create_mutants_directives (rnb-1) (random_mutation::mutants) |
|
825 |
) |
|
881 |
try |
|
882 |
let new_mutant = find_next_new mutants random_mutation in |
|
883 |
report ~level:2 (fun fmt -> |
|
884 |
fprintf fmt " %i mutants directive generated out of %i expected@ " |
|
885 |
(nb - rnb) nb); |
|
886 |
create_mutants_directives (rnb - 1) (new_mutant :: mutants) |
|
887 |
with Not_found -> stop_process () |
|
888 |
else create_mutants_directives (rnb - 1) (random_mutation :: mutants) |
|
826 | 889 |
in |
827 | 890 |
let mutants_directives = create_mutants_directives nb [] in |
828 |
List.map (fun d -> |
|
891 |
List.map |
|
892 |
(fun d -> |
|
829 | 893 |
let mutant, loc = create_mutant prog d in |
830 |
d, loc, mutant ) mutants_directives
|
|
831 |
|
|
894 |
d, loc, mutant)
|
|
895 |
mutants_directives |
|
832 | 896 |
|
833 | 897 |
let mutate nb prog = |
834 | 898 |
records := compute_records prog; |
835 | 899 |
(* Format.printf "Records: %i pre, %i boolexpr" (\* , %a ops *\) *) |
836 | 900 |
(* !records.nb_pre *) |
837 |
(* !records.nb_boolexpr *) |
|
838 |
(* (\* !records.op *\) *) |
|
839 |
(* ; *) |
|
840 |
fold_mutate nb prog |
|
841 |
|
|
842 |
|
|
843 |
|
|
901 |
(* !records.nb_boolexpr *) |
|
902 |
(* (\* !records.op *\) *) |
|
903 |
(* ; *) |
|
904 |
fold_mutate nb prog |
|
844 | 905 |
|
845 | 906 |
(* Local Variables: *) |
846 | 907 |
(* compile-command:"make -C .." *) |
847 | 908 |
(* End: *) |
848 |
|
|
849 |
|
Also available in: Unified diff
reformatting