Project

General

Profile

Statistics
| Branch: | Tag: | Revision:

lustrec / src / mutation.ml @ 4eada2bb

History | View | Annotate | Download (5.81 KB)

1 f30a2012 ploc
open Corelang
2
open Log
3
open Format
4
5
let random_seed = ref 0
6
let threshold_delay = 95
7
let threshold_inc_int = 97
8
let threshold_dec_int = 97
9
let threshold_random_int = 96
10
let threshold_switch_int = 100 (* not implemented yet *)
11
let threshold_random_float = 100 (* not used yet *)
12
let threshold_negate_bool_var = 95
13
let threshold_arith_op = 95
14
let threshold_rel_op = 95
15
let threshold_bool_op = 95
16
17 4eada2bb ploc
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
62 f30a2012 ploc
let mutate_int i = 
63
  if Random.int 100 > threshold_inc_int then
64
    i+1
65
  else if Random.int 100 > threshold_dec_int then
66
    i-1
67
  else if Random.int 100 > threshold_random_int then
68
    Random.int 10
69
  else if Random.int 100 > threshold_switch_int then
70 4eada2bb ploc
    let idx = Random.int (List.length !int_consts) in
71
    List.nth !int_consts idx
72 f30a2012 ploc
  else
73
    i
74
  
75
let mutate_float f =
76
  if Random.int 100 > threshold_random_float then
77
    Random.float 10.
78
  else 
79
    f
80
81
let mutate_op op = 
82
match op with
83
| "+" | "-" | "*" | "/" when Random.int 100 > threshold_arith_op ->
84
  let filtered = List.filter (fun x -> x <> op) ["+"; "-"; "*"; "/"] in
85
  List.nth filtered (Random.int 3)
86
| "&&" | "||" | "xor" | "impl" when Random.int 100 > threshold_bool_op ->
87
  let filtered = List.filter (fun x -> x <> op) ["&&"; "||"; "xor"; "impl"] in
88
  List.nth filtered (Random.int 3)
89
| "<" | "<=" | ">" | ">=" | "!=" | "=" when Random.int 100 > threshold_rel_op ->
90
  let filtered = List.filter (fun x -> x <> op) ["<"; "<="; ">"; ">="; "!="; "="] in
91
  List.nth filtered (Random.int 5)
92
| _ -> op
93
94
95
let mutate_var expr = 
96
  match (Types.repr expr.expr_type).Types.tdesc with 
97
  | Types.Tbool ->
98
    if Random.int 100 > threshold_negate_bool_var then
99
      mkpredef_unary_call Location.dummy_loc "not" expr
100
    else 
101
      expr
102
  | _ -> expr
103
    
104
let mutate_pre orig_expr e = 
105
  if Random.int 100 <= threshold_delay then
106
    (* We do not nothing *)
107
    Expr_pre e 
108
  else (* We add a pre *)
109
    Expr_pre ({orig_expr with expr_desc = Expr_pre e}) 
110
111
112
let mutate_const_value c =
113
  match c with
114
  | Const_int i -> Const_int (mutate_int i)
115
  | Const_real s -> Const_real s (* those are string, let's leave them *)
116
  | Const_float f -> Const_float (mutate_float f)
117
  | Const_array _
118
  | Const_tag _ -> c
119
120
let mutate_const c =
121
  { c with const_value = mutate_const_value c.const_value }
122
123
124 4eada2bb ploc
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
134 f30a2012 ploc
let rec mutate_expr expr =
135
  match expr.expr_desc with
136
  | Expr_ident id -> mutate_var expr
137
  | _ -> (
138
    let new_desc = match expr.expr_desc with
139
      | Expr_const c -> Expr_const (mutate_const_value c)
140
      | Expr_tuple l -> Expr_tuple (List.map mutate_expr l)
141
      | Expr_ite (i,t,e) -> Expr_ite (mutate_expr i, mutate_expr t, mutate_expr e)
142
      | Expr_arrow (e1, e2) -> Expr_arrow (mutate_expr e1, mutate_expr e2)
143
      | Expr_pre e -> mutate_pre expr (mutate_expr e)
144
      | Expr_appl (op_id, args, r) -> Expr_appl (mutate_op op_id, mutate_expr args, r)
145
  (* Other constructs are kept.
146
  | Expr_fby of expr * expr
147
  | Expr_array of expr list
148
  | Expr_access of expr * Dimension.dim_expr
149
  | Expr_power of expr * Dimension.dim_expr
150
  | Expr_when of expr * ident * label
151
  | Expr_merge of ident * (label * expr) list
152
  | Expr_uclock of expr * int
153
  | Expr_dclock of expr * int
154
  | Expr_phclock of expr * rat *)
155
  | _ -> expr.expr_desc
156
157
    in
158
    { expr with expr_desc = new_desc }
159
  )
160
161
let mutate_eq eq =
162
  { eq with eq_rhs = mutate_expr eq.eq_rhs }
163
164
let mutate_node nd = 
165 4eada2bb ploc
  { nd with node_eqs = select_in_list nd.node_eqs mutate_eq }
166 f30a2012 ploc
167
let mutate_top_decl td =
168
  match td.top_decl_desc with
169
  | Node nd -> { td with top_decl_desc = Node (mutate_node nd)}
170
  | Consts constsl -> { td with top_decl_desc = Consts (List.map mutate_const constsl)}
171
  | _ -> td
172
    
173
(* Create a single mutant with the provided random seed *)
174
let mutate_prog prog = 
175 4eada2bb ploc
  select_in_list prog mutate_top_decl
176 f30a2012 ploc
177 4eada2bb ploc
let mutate nb prog = 
178
  int_consts := get_int_consts prog;
179 f30a2012 ploc
  let rec iterate nb res =
180
    incr random_seed;
181
    if nb <= 0 then
182
      res
183
    else (
184
      Random.init !random_seed;
185
      let new_mutant = mutate_prog prog in
186
      if List.mem new_mutant res then (
187
	report ~level:1 (fun fmt -> fprintf fmt "New mutant is not new %i@." nb);
188
	iterate nb res
189
      )
190
      else
191
	iterate (nb-1) (new_mutant::res)
192
    )
193
  in
194
  iterate nb []
195
196
197
198
199
(* Local Variables: *)
200
(* compile-command:"make -C .." *)
201
(* End: *)
202
203