29 |
29 |
|
30 |
30 |
let int_consts = ref []
|
31 |
31 |
|
32 |
|
let rename_app id =
|
33 |
|
if !Options.no_mutation_suffix then
|
|
32 |
let rename_app id =
|
|
33 |
let node = Corelang.node_from_name id in
|
|
34 |
let is_imported =
|
|
35 |
match node.top_decl_desc with
|
|
36 |
| ImportedNode _ -> true
|
|
37 |
| _ -> false
|
|
38 |
in
|
|
39 |
if !Options.no_mutation_suffix || is_imported then
|
34 |
40 |
id
|
35 |
41 |
else
|
36 |
42 |
id ^ "_mutant"
|
... | ... | |
44 |
50 |
|
45 |
51 |
type records = {
|
46 |
52 |
consts: IntSet.t;
|
|
53 |
nb_consts: int;
|
47 |
54 |
nb_boolexpr: int;
|
48 |
55 |
nb_pre: int;
|
49 |
56 |
nb_op: int OpCount.t;
|
... | ... | |
56 |
63 |
let all_ops = "not" :: ops
|
57 |
64 |
|
58 |
65 |
let empty_records =
|
59 |
|
{consts=IntSet.empty; nb_boolexpr=0; nb_pre=0; nb_op=OpCount.empty}
|
|
66 |
{consts=IntSet.empty; nb_consts=0; nb_boolexpr=0; nb_pre=0; nb_op=OpCount.empty}
|
60 |
67 |
|
61 |
68 |
let records = ref empty_records
|
62 |
69 |
|
... | ... | |
65 |
72 |
{
|
66 |
73 |
consts = IntSet.union r1.consts r2.consts;
|
67 |
74 |
|
|
75 |
nb_consts = r1.nb_consts + r2.nb_consts;
|
68 |
76 |
nb_boolexpr = r1.nb_boolexpr + r2.nb_boolexpr;
|
69 |
77 |
nb_pre = r1.nb_pre + r2.nb_pre;
|
70 |
78 |
|
... | ... | |
80 |
88 |
|
81 |
89 |
let compute_records_const_value c =
|
82 |
90 |
match c with
|
83 |
|
| Const_int i -> {empty_records with consts = IntSet.singleton i}
|
|
91 |
| Const_int i -> {empty_records with consts = IntSet.singleton i; nb_consts = 1}
|
84 |
92 |
| _ -> empty_records
|
85 |
93 |
|
86 |
94 |
let rec compute_records_expr expr =
|
... | ... | |
301 |
309 |
match stmt with
|
302 |
310 |
| Eq eq -> let mut, new_eq = rdm_mutate_eq eq in
|
303 |
311 |
report ~level:1
|
304 |
|
(fun fmt -> fprintf fmt "mutation: %a becomes %a@."
|
|
312 |
(fun fmt -> fprintf fmt "mutation: %a becomes %a@ "
|
305 |
313 |
Printers.pp_node_eq eq
|
306 |
314 |
Printers.pp_node_eq new_eq);
|
307 |
315 |
mut, Eq new_eq
|
... | ... | |
343 |
351 |
iterate nb res
|
344 |
352 |
)
|
345 |
353 |
else (
|
346 |
|
report ~level:1 (fun fmt -> fprintf fmt "%i mutants remaining@." nb);
|
|
354 |
report ~level:1 (fun fmt -> fprintf fmt "%i mutants remaining@ " nb);
|
347 |
355 |
iterate (nb-1) ((mutation, new_mutant)::res)
|
348 |
356 |
)
|
349 |
357 |
)
|
... | ... | |
482 |
490 |
match !target with
|
483 |
491 |
| Some (IncrIntCst 0) -> (set_mutation_loc (); Const_int (i+1))
|
484 |
492 |
| Some (DecrIntCst 0) -> (set_mutation_loc (); Const_int (i-1))
|
485 |
|
| Some (SwitchIntCst (0, id)) -> (set_mutation_loc (); Const_int (List.nth (IntSet.elements (IntSet.remove i !records.consts)) id))
|
|
493 |
| Some (SwitchIntCst (0, id)) ->
|
|
494 |
(set_mutation_loc (); Const_int id)
|
486 |
495 |
| Some (IncrIntCst n) -> (target := Some (IncrIntCst (n-1)); c)
|
487 |
496 |
| Some (DecrIntCst n) -> (target := Some (DecrIntCst (n-1)); c)
|
488 |
497 |
| Some (SwitchIntCst (n, id)) -> (target := Some (SwitchIntCst (n-1, id)); c)
|
... | ... | |
662 |
671 |
let fold_mutate nb prog =
|
663 |
672 |
incr random_seed;
|
664 |
673 |
Random.init !random_seed;
|
|
674 |
(* Local references to keep track of generated directives *)
|
|
675 |
|
|
676 |
(* build a set of integer 0, 1, ... n-1 for input n *)
|
|
677 |
let cpt_to_intset cpt =
|
|
678 |
let arr = Array.init cpt (fun x -> x) in
|
|
679 |
Array.fold_right IntSet.add arr IntSet.empty
|
|
680 |
in
|
|
681 |
|
|
682 |
let possible_const_id = cpt_to_intset !records.nb_consts in
|
|
683 |
(* let possible_boolexpr_id = cpt_to_intset !records.nb_boolexpr in *)
|
|
684 |
(* let possible_pre_id = cpt_to_intset !records.nb_pre in *)
|
|
685 |
|
|
686 |
let incremented_const_id = ref IntSet.empty in
|
|
687 |
let decremented_const_id = ref IntSet.empty in
|
|
688 |
|
|
689 |
let create_new_incr_decr registered build =
|
|
690 |
let possible = IntSet.diff possible_const_id !registered |> IntSet.elements in
|
|
691 |
let len = List.length possible in
|
|
692 |
if len <= 0 then
|
|
693 |
false, build (-1) (* Should not be stored *)
|
|
694 |
else
|
|
695 |
let picked = List.nth possible (Random.int (List.length possible)) in
|
|
696 |
registered := IntSet.add picked !registered;
|
|
697 |
true, build picked
|
|
698 |
in
|
|
699 |
|
|
700 |
|
|
701 |
let module DblIntSet = Set.Make (struct type t = int * int let compare = compare end) in
|
|
702 |
let switch_const_id = ref DblIntSet.empty in
|
|
703 |
let switch_set =
|
|
704 |
if IntSet.cardinal !records.consts <= 1 then
|
|
705 |
DblIntSet.empty
|
|
706 |
else
|
|
707 |
(* First element is cst id (the ith cst) while second is the
|
|
708 |
ith element of the set of gathered constants
|
|
709 |
!record.consts *)
|
|
710 |
IntSet.fold (fun cst_id set ->
|
|
711 |
IntSet.fold (fun ith_cst set ->
|
|
712 |
DblIntSet.add (cst_id, ith_cst) set
|
|
713 |
) !records.consts set
|
|
714 |
) possible_const_id DblIntSet.empty
|
|
715 |
in
|
|
716 |
|
|
717 |
let create_new_switch registered build =
|
|
718 |
let possible = DblIntSet.diff switch_set !registered |> DblIntSet.elements in
|
|
719 |
let len = List.length possible in
|
|
720 |
if len <= 0 then
|
|
721 |
false, build (-1,-1) (* Should not be stored *)
|
|
722 |
else
|
|
723 |
let picked = List.nth possible (Random.int (List.length possible)) in
|
|
724 |
registered := DblIntSet.add picked !registered;
|
|
725 |
true, build picked
|
|
726 |
in
|
|
727 |
|
665 |
728 |
let find_next_new mutants mutant =
|
666 |
729 |
let rec find_next_new init current =
|
667 |
730 |
if init = current || List.mem current mutants then raise Not_found else
|
668 |
731 |
|
669 |
|
(* TODO: check if we can generate more cases. The following lines were
|
670 |
|
cylcing and missing to detect that the enumaration was complete,
|
671 |
|
leading to a non terminating process. The current setting is harder
|
672 |
|
but may miss enumerating some cases. To be checked! *)
|
|
732 |
(* TODO: check if we can generate more cases. The following lines were
|
|
733 |
cylcing and missing to detect that the enumaration was complete,
|
|
734 |
leading to a non terminating process. The current setting is harder
|
|
735 |
but may miss enumerating some cases. To be checked! *)
|
673 |
736 |
|
674 |
|
(* if List.mem current mutants then *)
|
675 |
|
(* find_next_new init (next_change current) *)
|
676 |
|
(* else *)
|
|
737 |
(* if List.mem current mutants then *)
|
|
738 |
(* find_next_new init (next_change current) *)
|
|
739 |
(* else *)
|
677 |
740 |
current
|
678 |
741 |
in
|
679 |
742 |
find_next_new mutant (next_change mutant)
|
... | ... | |
697 |
760 |
let rec apply_transform transforms =
|
698 |
761 |
let f id =
|
699 |
762 |
match id with
|
700 |
|
| 5 -> let card = IntSet.cardinal !records.consts in
|
701 |
|
card > 0, IncrIntCst (try Random.int (IntSet.cardinal !records.consts) with _ -> 0)
|
702 |
|
| 4 -> let card = IntSet.cardinal !records.consts in
|
703 |
|
card > 0, DecrIntCst (try Random.int (IntSet.cardinal !records.consts) with _ -> 0)
|
704 |
|
| 3 -> let card = IntSet.cardinal !records.consts in
|
705 |
|
card > 0, SwitchIntCst ((try Random.int (-1 + IntSet.cardinal !records.consts) with _ -> 0), (try Random.int (-1 + IntSet.cardinal !records.consts) with _ -> 0))
|
|
763 |
| 5 -> create_new_incr_decr incremented_const_id (fun x -> IncrIntCst x)
|
|
764 |
| 4 -> create_new_incr_decr decremented_const_id (fun x -> DecrIntCst x)
|
|
765 |
| 3 -> create_new_switch switch_const_id (fun (x,y) -> SwitchIntCst(x, y))
|
706 |
766 |
| 2 -> !records.nb_pre >0, Pre (try Random.int !records.nb_pre with _ -> 0)
|
707 |
767 |
| 1 -> !records.nb_boolexpr > 0, Boolexpr (try Random.int !records.nb_boolexpr with _ -> 0)
|
708 |
768 |
| 0 -> let bindings = OpCount.bindings !records.nb_op in
|
... | ... | |
724 |
784 |
let ok, random_mutation = apply_transform transforms in
|
725 |
785 |
let stop_process () =
|
726 |
786 |
report ~level:1 (fun fmt -> fprintf fmt
|
727 |
|
"Only %i mutants directives generated out of %i expected@."
|
|
787 |
"Only %i mutants directives generated out of %i expected@ "
|
728 |
788 |
(nb-rnb)
|
729 |
789 |
nb);
|
730 |
790 |
mutants
|
... | ... | |
734 |
794 |
else if List.mem random_mutation mutants then
|
735 |
795 |
try
|
736 |
796 |
let new_mutant = (find_next_new mutants random_mutation) in
|
737 |
|
report ~level:2 (fun fmt -> fprintf fmt " %i mutants directive generated out of %i expected@." (nb-rnb) nb);
|
|
797 |
report ~level:2 (fun fmt -> fprintf fmt " %i mutants directive generated out of %i expected@ " (nb-rnb) nb);
|
738 |
798 |
create_mutants_directives (rnb-1) (new_mutant::mutants)
|
739 |
799 |
with Not_found -> (
|
740 |
800 |
stop_process ()
|
[lustret] More effective mutants generation
Solved the misrenaming of imported nodes (eg int_to_real)