Project

General

Profile

Revision bde99c3f src/mutation.ml

View differences:

src/mutation.ml
1
open LustreSpec
1 2
open Corelang
2 3
open Log
3 4
open Format
......
103 104
let compute_records_eq eq = compute_records_expr eq.eq_rhs
104 105

  
105 106
let compute_records_node nd = 
106
  merge_records (List.map compute_records_eq nd.node_eqs)
107
  merge_records (List.map compute_records_eq (get_node_eqs nd))
107 108

  
108 109
let compute_records_top_decl td =
109 110
  match td.top_decl_desc with
110 111
  | Node nd -> compute_records_node nd
111
  | Consts constsl -> merge_records (List.map (fun c -> compute_records_const_value c.const_value) constsl)
112
  | Const cst -> compute_records_const_value cst.const_value
112 113
  | _ -> empty_records
113 114

  
114 115
let compute_records prog = 
......
150 151
  else
151 152
    i
152 153
  
153
let rdm_mutate_float f =
154
let rdm_mutate_real r =
154 155
  if Random.int 100 > threshold_random_float then
155
    Random.float 10.
156
    (* interval [0, bound] for random values *)
157
    let bound = 10 in
158
    (* max number of digits after comma *)
159
    let digits = 5 in
160
    (* number of digits after comma *)
161
    let shift = Random.int (digits + 1) in
162
    let eshift = 10. ** (float_of_int shift) in
163
    let i = Random.int (1 + bound * (int_of_float eshift)) in
164
    let f = float_of_int i /. eshift in
165
    (Num.num_of_int i, shift, string_of_float f)
156 166
  else 
157
    f
167
    r
158 168

  
159 169
let rdm_mutate_op op = 
160 170
match op with
......
174 184
  match (Types.repr expr.expr_type).Types.tdesc with 
175 185
  | Types.Tbool ->
176 186
    (* if Random.int 100 > threshold_negate_bool_var then *)
177
    let new_e = mkpredef_unary_call Location.dummy_loc "not" expr in
187
    let new_e = mkpredef_call expr.expr_loc "not" [expr] in
178 188
    Some (expr, new_e), new_e
179 189
    (* else  *)
180 190
    (*   expr *)
......
188 198
let rdm_mutate_const_value c =
189 199
  match c with
190 200
  | 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)
201
  | Const_real (n, i, s) -> let (n', i', s') = rdm_mutate_real (n, i, s) in Const_real (n', i', s')
193 202
  | Const_array _
203
  | Const_string _
204
  | Const_struct _
194 205
  | Const_tag _ -> c
195 206

  
196 207
let rdm_mutate_const c =
......
249 260
    else
250 261
      let mut, new_args = rdm_mutate_expr args in
251 262
      mut, mk_e (Expr_appl (op_id, new_args, r))
252
	
253 263
  (* Other constructs are kept.
254 264
  | Expr_fby of expr * expr
255 265
  | Expr_array of expr list
......
260 270
  | Expr_uclock of expr * int
261 271
  | Expr_dclock of expr * int
262 272
  | Expr_phclock of expr * rat *)
263
  (* | _ -> expr.expr_desc *)
273
   | _ -> None, expr
264 274
  
265 275

  
266 276
let rdm_mutate_eq eq =
267 277
  let mutation, new_rhs = rdm_mutate_expr eq.eq_rhs in
268 278
  mutation, { eq with eq_rhs = new_rhs }
269 279

  
270
let rdm_mutate_node nd = 
271
  let mutation, new_node_eqs =       
272
    select_in_list 
273
      nd.node_eqs 
274
      (fun eq -> let mut, new_eq = rdm_mutate_eq eq in
280
let rnd_mutate_stmt stmt =
281
  match stmt with
282
  | Eq eq   -> let mut, new_eq = rdm_mutate_eq eq in
275 283
		 report ~level:1 
276 284
		   (fun fmt -> fprintf fmt "mutation: %a becomes %a@." 
277 285
		     Printers.pp_node_eq eq
278 286
		     Printers.pp_node_eq new_eq);
279
		 mut, new_eq )
287
		 mut, Eq new_eq 
288
  | Aut aut -> assert false
289

  
290
let rdm_mutate_node nd = 
291
  let mutation, new_node_stmts =       
292
    select_in_list 
293
      nd.node_stmts rnd_mutate_stmt
280 294
  in
281
  mutation, { nd with node_eqs = new_node_eqs }
295
  mutation, { nd with node_stmts = new_node_stmts }
282 296

  
283 297
let rdm_mutate_top_decl td =
284 298
  match td.top_decl_desc with
285 299
  | Node nd -> 
286 300
    let mutation, new_node = rdm_mutate_node nd in 
287 301
    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 }
302
  | Const cst -> 
303
    let mut, new_cst = rdm_mutate_const cst in
304
    mut, { td with top_decl_desc = Const new_cst }
291 305
  | _ -> None, td
292 306
    
293 307
(* Create a single mutant with the provided random seed *)
......
394 408
  match !target with
395 409
  | Some (Boolexpr 0) -> (
396 410
    target := None;
397
    mkpredef_unary_call Location.dummy_loc "not" expr
411
    mkpredef_call expr.expr_loc "not" [expr]
398 412
  )
399 413
  | Some (Boolexpr n) ->
400 414
      (target := Some (Boolexpr (n-1)); expr)
......
474 488
let fold_mutate_eq eq =
475 489
  { eq with eq_rhs = fold_mutate_expr eq.eq_rhs }
476 490

  
491
let fold_mutate_stmt stmt =
492
  match stmt with
493
  | Eq eq   -> Eq (fold_mutate_eq eq)
494
  | Aut aut -> assert false
495

  
477 496
let fold_mutate_node nd = 
478 497
  { nd with 
479
    node_eqs = 
480
      List.fold_right (fun e res -> (fold_mutate_eq e)::res) nd.node_eqs [];
498
    node_stmts = 
499
      List.fold_right (fun stmt res -> (fold_mutate_stmt stmt)::res) nd.node_stmts [];
481 500
    node_id = rename_app nd.node_id
482 501
  }
483 502

  
484 503
let fold_mutate_top_decl td =
485 504
  match td.top_decl_desc with
486
  | 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 [])}
505
  | Node nd   -> { td with top_decl_desc = Node  (fold_mutate_node nd)}
506
  | Const cst -> { td with top_decl_desc = Const (fold_mutate_const cst)}
488 507
  | _ -> td
489 508
    
490 509
(* Create a single mutant with the provided random seed *)

Also available in: Unified diff