Project

General

Profile

Revision 55a8633c src/mutation.ml

View differences:

src/mutation.ml
344 344

  
345 345
type mutant_t = Boolexpr of int | Pre of int | Op of string * int * string | IncrIntCst of int | DecrIntCst of int | SwitchIntCst of int * int 
346 346

  
347
(* Denotes the parent node, the equation lhs and the location of the mutation *)
348
type mutation_loc = ident * ident list * Location.t
347 349
let target : mutant_t option ref = ref None
348 350

  
351
let mutation_info : mutation_loc option ref = ref None
352
let current_node: ident option ref = ref None 
353
let current_eq_lhs : ident list option ref = ref None
354
let current_loc : Location.t option ref = ref None
355
  
356
let set_mutation_loc () =
357
  target := None;
358
  match !current_node, !current_eq_lhs, !current_loc with
359
  | Some n, Some elhs, Some l ->  mutation_info := Some (n, elhs, l)
360
  | _ -> assert false (* Those global vars should be defined during the
361
			   visitor pattern execution *)
362

  
349 363
let print_directive fmt d =
350 364
  match d with
351 365
  | Pre n -> Format.fprintf fmt "pre %i" n
......
355 369
  | DecrIntCst n ->  Format.fprintf fmt "decr int cst %i" n
356 370
  | SwitchIntCst (n, m) ->  Format.fprintf fmt "switch int cst %i -> %i" n m
357 371

  
372
let print_directive_json fmt d =
373
  match d with
374
  | Pre _ -> Format.fprintf fmt "\"mutation\": \"pre\""
375
  | Boolexpr _ -> Format.fprintf fmt "\"mutation\": \"not\"" 
376
  | Op (o, _, d) -> Format.fprintf fmt "\"mutation\": \"op_conv\", \"from\": \"%s\", \"to\": \"%s\"" o d
377
  | IncrIntCst n ->  Format.fprintf fmt "\"mutation\": \"cst_incr\""
378
  | DecrIntCst n ->  Format.fprintf fmt "\"mutation\": \"cst_decr\""
379
  | SwitchIntCst (n, m) ->  Format.fprintf fmt "\"mutation\": \"cst_switch\", \"to_cst\": \"%i\"" m
380
  
381
let print_loc_json fmt (n,eqlhs, l) =
382
  Format.fprintf fmt "\"node_id\": \"%s\", \"eq_lhs\": [%a], \"loc_line\": \"%i\""
383
    n
384
    (Utils.fprintf_list ~sep:", " (fun fmt s -> Format.fprintf fmt "\"%s\"" s)) eqlhs
385
    (Location.loc_line l)
386
    
358 387
let fold_mutate_int i = 
359 388
  if Random.int 100 > threshold_inc_int then
360 389
    i+1
......
390 419
(* | _ -> op *)
391 420
  match !target with
392 421
  | Some (Op(op_orig, 0, op_new)) when op_orig = op -> (
393
    target := None;
422
    set_mutation_loc ();
394 423
    op_new
395 424
  )
396 425
  | Some (Op(op_orig, n, op_new)) when op_orig = op -> (
......
413 442
let fold_mutate_boolexpr expr =
414 443
  match !target with
415 444
  | Some (Boolexpr 0) -> (
416
    target := None;
445
     set_mutation_loc ();
446

  
417 447
    mkpredef_call expr.expr_loc "not" [expr]
418 448
  )
419 449
  | Some (Boolexpr n) ->
......
423 453
let fold_mutate_pre orig_expr e = 
424 454
  match !target with
425 455
    Some (Pre 0) -> (
426
      target := None;
456
      set_mutation_loc ();
427 457
      Expr_pre ({orig_expr with expr_desc = Expr_pre e}) 
428 458
    )
429 459
  | Some (Pre n) -> (
......
436 466
match c with
437 467
| Const_int i -> (
438 468
  match !target with
439
  | Some (IncrIntCst 0) -> (target := None; Const_int (i+1))
440
  | Some (DecrIntCst 0) -> (target := None; Const_int (i-1))
441
  | Some (SwitchIntCst (0, id)) -> (target := None; Const_int (List.nth (IntSet.elements (IntSet.remove i !records.consts)) id)) 
469
  | Some (IncrIntCst 0) -> (set_mutation_loc (); Const_int (i+1))
470
  | Some (DecrIntCst 0) -> (set_mutation_loc (); Const_int (i-1))
471
  | Some (SwitchIntCst (0, id)) -> (set_mutation_loc (); Const_int (List.nth (IntSet.elements (IntSet.remove i !records.consts)) id)) 
442 472
  | Some (IncrIntCst n) -> (target := Some (IncrIntCst (n-1)); c)
443 473
  | Some (DecrIntCst n) -> (target := Some (DecrIntCst (n-1)); c)
444 474
  | Some (SwitchIntCst (n, id)) -> (target := Some (SwitchIntCst (n-1, id)); c)
......
459 489
  { c with const_value = fold_mutate_const_value c.const_value }
460 490

  
461 491
let rec fold_mutate_expr expr =
492
  current_loc := Some expr.expr_loc;
462 493
  let new_expr = 
463 494
    match expr.expr_desc with
464 495
    | Expr_ident id -> fold_mutate_var expr
......
492 523
    new_expr
493 524

  
494 525
let fold_mutate_eq eq =
526
  current_eq_lhs := Some eq.eq_lhs;
495 527
  { eq with eq_rhs = fold_mutate_expr eq.eq_rhs }
496 528

  
497 529
let fold_mutate_stmt stmt =
......
499 531
  | Eq eq   -> Eq (fold_mutate_eq eq)
500 532
  | Aut aut -> assert false
501 533

  
502
let fold_mutate_node nd = 
534
let fold_mutate_node nd =
535
  current_node := Some nd.node_id;
503 536
  { nd with 
504 537
    node_stmts = 
505 538
      List.fold_right (fun stmt res -> (fold_mutate_stmt stmt)::res) nd.node_stmts [];
......
519 552
let create_mutant prog directive =  
520 553
  target := Some directive; 
521 554
  let prog' = fold_mutate_prog prog in
522
  target := None;
523
  prog'
555
  let mutation_info = match !target , !mutation_info with
556
    | None, Some mi -> mi
557
    | _ -> assert false (* The mutation has not been performed. *)
558
     
559
  in
560
(*  target := None; (* should happen only if no mutation occured during the
561
    visit *)*)
562
  prog', mutation_info
524 563
  
525 564

  
526 565
let op_mutation op = 
......
645 684
	create_mutants_directives (rnb-1) (random_mutation::mutants)
646 685
  in
647 686
  let mutants_directives = create_mutants_directives nb [] in
648
  List.map (fun d -> d, create_mutant prog d) mutants_directives 
687
  List.map (fun d ->
688
    let mutant, loc = create_mutant prog d in
689
    d, loc, mutant ) mutants_directives 
649 690
  
650 691

  
651 692
let mutate nb prog =
......
655 696
(*     !records.nb_boolexpr *)
656 697
(*     (\* !records.op *\) *)
657 698
(* ;  *)   
658
  fold_mutate nb prog, print_directive
699
  fold_mutate nb prog 
659 700

  
660 701

  
661 702

  

Also available in: Unified diff