Project

General

Profile

Revision 5d5139a5

View differences:

src/main_lustre_testgen.ml
55 55
  
56 56
  if !Options.gen_mcdc then (
57 57
    let prog_mcdc = PathConditions.mcdc prog in
58
  let _, type_env, _ = import_dependencies prog_mcdc in
58
    let _, type_env, _ = import_dependencies prog_mcdc in
59 59

  
60 60
    let _ = type_decls type_env prog_mcdc in
61 61

  
......
130 130
  Format.fprintf cmake_fmt "LUSTREFILES(LFILES ${CMAKE_CURRENT_SOURCE_DIR} )@.";
131 131
  Format.fprintf cmake_fmt "@[<v 2>FOREACH(lus_file ${LFILES})@ ";
132 132
  Format.fprintf cmake_fmt "get_lustre_name_ext(${lus_file} L E)@ ";
133
  Format.fprintf cmake_fmt "Lustre_Compile(@[<v 0>NODE \"top_mutant\"@ ";
134
  Format.fprintf cmake_fmt "LIBNAME \"${L}_top_mutant\"@ ";
133
  Format.fprintf cmake_fmt "Lustre_Compile(@[<v 0>@ ";
134
  if !Options.main_node <> "" then Format.fprintf cmake_fmt "NODE \"%s_mutant\"@ " !Options.main_node;
135
  Format.fprintf cmake_fmt "LIBNAME \"${L}_%s_mutant\"@ " !Options.main_node;
135 136
  Format.fprintf cmake_fmt "LUS_FILES \"${lus_file}\")@]@]@.";
136 137
  Format.fprintf cmake_fmt "ENDFOREACH()@.@?";
137 138
  
src/mutation.ml
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 ()

Also available in: Unified diff