Project

General

Profile

Revision 4eada2bb

View differences:

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