Project

General

Profile

Revision 5487dd79

View differences:

src/main_lustre_testgen.ml
117 117
       dir ^ "/" ^ (Filename.basename basename)^ ".mutation.json"
118 118
  in
119 119
  pp_trace trace_filename mutation_list;
120

  
121
  (* Printing the CMakeLists.txt file *)
122
  let cmakelists = 
123
    (if !Options.dest_dir = "" then "" else !Options.dest_dir ^ "/") ^ "CMakeLists.txt"
124
  in
125
  let cmake_file = open_out cmakelists in
126
  let cmake_fmt = formatter_of_out_channel cmake_file in
127
  Format.fprintf cmake_fmt "cmake_minimum_required(VERSION 3.5)@.";
128
  Format.fprintf cmake_fmt "include(\"/home/ploc/Local/share/helpful_functions.cmake\")@.";
129
  Format.fprintf cmake_fmt "include(\"/home/ploc/Local/share/FindLustre.cmake\")@."; 
130
  Format.fprintf cmake_fmt "LUSTREFILES(LFILES ${CMAKE_CURRENT_SOURCE_DIR} )@.";
131
  Format.fprintf cmake_fmt "@[<v 2>FOREACH(lus_file ${LFILES})@ ";
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\"@ ";
135
  Format.fprintf cmake_fmt "LUS_FILES \"${lus_file}\")@]@]@.";
136
  Format.fprintf cmake_fmt "ENDFOREACH()@.@?";
137
  
138
  
120 139
  (* We stop the process here *)
121 140
  exit 0
122 141
    
src/mutation.ml
1

  
2
(* Comments in function fold_mutate
3

  
4
 TODO: check if we can generate more cases. The following lines were
5
	     cylcing and missing to detect that the enumaration was complete,
6
	     leading to a non terminating process. The current setting is harder
7
	     but may miss enumerating some cases. To be checked! 
8
	
9

  
10
*)
11

  
12

  
1 13
open LustreSpec
2 14
open Corelang
3 15
open Log
......
556 568
  let prog' = fold_mutate_prog prog in
557 569
  let mutation_info = match !target , !mutation_info with
558 570
    | None, Some mi -> mi
559
    | _ -> assert false (* The mutation has not been performed. *)
571
    | _ -> (
572
      Format.eprintf "Failed when creating mutant for directive %a@.@?" print_directive directive;
573
      let _ = match !target with Some dir' -> Format.eprintf "New directive %a@.@?" print_directive dir' | _ -> () in
574
      assert false (* The mutation has not been performed. *)
575
    )
560 576
     
561 577
  in
562 578
(*  target := None; (* should happen only if no mutation occured during the
......
640 656
    else first_boolexpr ()
641 657

  
642 658
  in
643
  (* Format.eprintf "from: %a to: %a@." print_directive m print_directive res; *)
659
   (* Format.eprintf "from: %a to: %a@." print_directive m print_directive res;  *)
644 660
  res
645 661

  
646 662
let fold_mutate nb prog = 
......
648 664
  Random.init !random_seed;
649 665
  let find_next_new mutants mutant =
650 666
    let rec find_next_new init current =
651
      if init = current then raise Not_found else
652
	if List.mem current mutants then
653
	  find_next_new init (next_change current)
654
	else
655
	  current
667
      if init = current || List.mem current mutants then raise Not_found else
668

  
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! *)
673
	
674
	  (* if List.mem current mutants then *)
675
	  (*   find_next_new init (next_change current) *)
676
	  (* else *)
677
	current
656 678
    in
657 679
    find_next_new mutant (next_change mutant) 
658 680
  in
659 681
  (* Creating list of nb elements of mutants *)
660 682
  let rec create_mutants_directives rnb mutants = 
661 683
    if rnb <= 0 then mutants 
662
    else 
663
      let random_mutation = 
664
	match Random.int 6 with
665
	| 5 -> IncrIntCst (try Random.int (IntSet.cardinal !records.consts) with _ -> 0)
666
	| 4 -> DecrIntCst (try Random.int (IntSet.cardinal !records.consts) with _ -> 0)
667
	| 3 -> SwitchIntCst ((try Random.int (IntSet.cardinal !records.consts) with _ -> 0), (try Random.int (-1 + IntSet.cardinal !records.consts) with _ -> 0))
668
	| 2 -> Pre (try Random.int !records.nb_pre with _ -> 0)
669
	| 1 -> Boolexpr (try Random.int !records.nb_boolexpr with _ -> 0)
670
	| 0 -> let bindings = OpCount.bindings !records.nb_op in
671
	       let op, nb_op = List.nth bindings (try Random.int (List.length bindings) with _ -> 0) in
672
	       let new_op = List.nth (op_mutation op) (try Random.int (List.length (op_mutation op)) with _ -> 0) in
673
	       Op (op, (try Random.int nb_op with _ -> 0), new_op)
674
	| _ -> assert false
684
    else
685
      (* Initial list of transformation *)
686
      let rec init_list x = if x <= 0 then [0] else x::(init_list (x-1)) in
687
      let init_list = init_list 5 in
688
      (* We generate a random permutation of the list: the first item is the
689
	 transformation, the rest of the list act as fallback choices to make
690
	 sure we produce something *)
691
      let shuffle l =
692
	let nd = List.map (fun c -> Random.bits (), c) l in
693
	let sond = List.sort compare nd in
694
	List.map snd sond
695
      in
696
      let transforms = shuffle init_list in
697
      let rec apply_transform transforms =
698
	let f id = 
699
	  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))
706
	  | 2 -> !records.nb_pre >0, Pre (try Random.int !records.nb_pre with _ -> 0)
707
	  | 1 -> !records.nb_boolexpr > 0, Boolexpr (try Random.int !records.nb_boolexpr with _ -> 0)
708
	  | 0 -> let bindings = OpCount.bindings !records.nb_op in
709
		 let bindings_len = List.length bindings in
710
		 let op, nb_op = List.nth bindings (try Random.int (List.length bindings) with _ -> 0) in
711
		 let new_op = List.nth (op_mutation op) (try Random.int (List.length (op_mutation op)) with _ -> 0) in
712
	         bindings_len > 0, Op (op, (try Random.int nb_op with _ -> 0), new_op)
713
	  | _ -> assert false
714
	in
715
	match transforms with
716
	| [] -> assert false
717
	| [hd] -> f hd
718
	| hd::tl -> let ok, random_mutation = f hd in
719
		    if ok then
720
		      ok, random_mutation
721
		    else
722
		      apply_transform tl
675 723
      in
676
      if List.mem random_mutation mutants then
724
      let ok, random_mutation = apply_transform transforms in
725
      let stop_process () =
726
	report ~level:1 (fun fmt -> fprintf fmt
727
	  "Only %i mutants directives generated out of %i expected@."
728
	  (nb-rnb)
729
	  nb); 
730
	mutants
731
      in
732
      if not ok then
733
	stop_process ()
734
      else if List.mem random_mutation mutants then
677 735
	try
678 736
	  let new_mutant = (find_next_new mutants random_mutation) in
679
	  report ~level:2 (fun fmt -> fprintf fmt " %i mutants generated out of %i expected@." (nb-rnb) nb);
680
	 create_mutants_directives (rnb-1) (new_mutant::mutants) 
737
	  report ~level:2 (fun fmt -> fprintf fmt " %i mutants directive generated out of %i expected@." (nb-rnb) nb);
738
	  create_mutants_directives (rnb-1) (new_mutant::mutants) 
681 739
	with Not_found -> (
682
	  report ~level:1 (fun fmt -> fprintf fmt "Only %i mutants generated out of %i expected@." (nb-rnb) nb); 
683
	  mutants
740
	  stop_process ()
684 741
	)
685
      else
742
      else (
686 743
	create_mutants_directives (rnb-1) (random_mutation::mutants)
744
      )
687 745
  in
688 746
  let mutants_directives = create_mutants_directives nb [] in
689 747
  List.map (fun d ->

Also available in: Unified diff