Project

General

Profile

Revision 3769b712 src/main_lustre_testgen.ml

View differences:

src/main_lustre_testgen.ml
10 10
(********************************************************************)
11 11

  
12 12
(* This module is used for the lustre test generator *)
13

  
13
open Lustrec
14 14
open Format
15
open Log
15
open Lustrec.Log
16 16

  
17
open Utils
18
open Lustre_types
17
open Lustrec.Utils
18
open Lustrec.Lustre_types
19 19
open Compiler_common
20 20

  
21 21
let usage = "Usage: lustret [options] \x1b[4msource file\x1b[0m"
......
41 41
let testgen_source dirname basename extension =
42 42
  let source_name = dirname ^ "/" ^ basename ^ extension in
43 43

  
44
  Log.report ~level:1 (fun fmt -> fprintf fmt "@[<v>");
44
  Lustrec.Log.report ~level:1 (fun fmt -> fprintf fmt "@[<v>");
45 45

  
46 46
  (* Parsing source *)
47 47
  let prog = parse source_name extension in
......
50 50
    try
51 51
      Compiler_stages.stage1 params prog dirname basename extension 
52 52
   with Compiler_stages.StopPhase1 prog -> (
53
      if !Options.print_nodes then (
54
        Format.printf "%a@.@?" Printers.pp_node_list prog;
53
      if !Lustrec.Options.print_nodes then (
54
        Format.printf "%a@.@?" Lustrec.Printers.pp_node_list prog;
55 55
        exit 0
56 56
      )
57 57
      else
......
64 64
     - generation of mutants: a number of mutated lustre files 
65 65
  *)
66 66
  
67
  if !Options.gen_mcdc then (
67
  if !Lustrec.Options.gen_mcdc then (
68 68
    let prog_mcdc = PathConditions.mcdc prog in
69 69
    (* We re-type the fresh equations *)
70 70
    (*let _ = Modules.load ~is_header:false prog_mcdc in*)
71
    let _ = type_decls !Global.type_env prog_mcdc in
71
    let _ = type_decls !Lustrec.Global.type_env prog_mcdc in
72 72
    
73
    let destname = !Options.dest_dir ^ "/" ^ basename in
73
    let destname = !Lustrec.Options.dest_dir ^ "/" ^ basename in
74 74
    let source_file = destname ^ ".mcdc" in (* Could be changed *)
75 75

  
76 76
    (* Modified Lustre is produced in fresh .lus file *)
77 77
    let source_lus = source_file ^ ".lus" in
78 78
    let source_out = open_out source_lus in
79 79
    let fmt = formatter_of_out_channel source_out in
80
    Printers.pp_prog fmt prog_mcdc;
80
    Lustrec.Printers.pp_prog fmt prog_mcdc;
81 81
    Format.fprintf fmt "@.@?";
82 82

  
83 83
    (* Prog is 
84 84
       (1) cleaned from initial equations TODO
85 85
       (2) produced as EMF
86 86
    *)
87
    Options.output := "emf";
87
    Lustrec.Options.output := "emf";
88 88
    let params = Backends.get_normalization_params () in
89
    let prog_mcdc = Normalization.normalize_prog params prog_mcdc in
89
    let prog_mcdc = Lustrec.Normalization.normalize_prog params prog_mcdc in
90 90
    let prog_mcdc, machine_code = Compiler_stages.stage2 params prog_mcdc in
91 91
    let source_emf = source_file ^ ".emf" in 
92 92
    let source_out = open_out source_emf in
......
98 98

  
99 99
  
100 100
  (* generate mutants *)
101
  let mutants = Mutation.mutate !Options.nb_mutants prog in
101
  let mutants = Mutation.mutate !Lustrec.Options.nb_mutants prog in
102 102
  
103 103
  (* Print generated mutants in target directory. *)
104 104
  let cpt = ref 0 in
......
106 106
    List.map (fun (mutation, mutation_loc, mutant) ->
107 107
    (* Debugging code *)
108 108
    (* if List.mem !cpt [238;371;601;799;875;998] then *)
109
    (*   Format.eprintf "Mutant %i: %a -> %a" !cpt Printers.pp_expr orig_e Printers.pp_expr new_e  *)
109
    (*   Format.eprintf "Mutant %i: %a -> %a" !cpt Lustrec.Printers.pp_expr orig_e Lustrec.Printers.pp_expr new_e  *)
110 110
    (* ; *)
111 111
      incr cpt;
112 112
      let mutant_basename = (Filename.basename basename)^ ".mutant.n" ^ (string_of_int !cpt) ^ extension  in
113 113
      let mutant_filename = 
114
	match !Options.dest_dir with
114
	match !Lustrec.Options.dest_dir with
115 115
	| "" -> (* Mutants are generated in source directory *)
116 116
	   basename^ ".mutant.n" ^ (string_of_int !cpt) ^ extension 
117 117
      | dir ->  (* Mutants are generated in target directory *)
......
129 129
      mutant_filename
130 130
      Mutation.print_directive mutation
131 131
    );
132
    Format.fprintf mutant_fmt "%a@." Printers.pp_prog mutant;
132
    Format.fprintf mutant_fmt "%a@." Lustrec.Printers.pp_prog mutant;
133 133
    mutation, mutation_loc, mutant_basename
134 134
    )
135 135
      mutants
136 136
  in
137
  Log.report ~level:1 (fun fmt -> fprintf fmt ".. done @ @]@.");
137
  Lustrec.Log.report ~level:1 (fun fmt -> fprintf fmt ".. done @ @]@.");
138 138
  
139 139
  (* Printing traceability *)
140 140
  let trace_filename = 
141
    match !Options.dest_dir with
141
    match !Lustrec.Options.dest_dir with
142 142
    | "" -> (* Mutant report is generated in source directory *)
143 143
       basename^ ".mutation.json" 
144 144
    | dir ->  (* Mutants are generated in target directory *)
......
148 148

  
149 149
  (* Printing the CMakeLists.txt file *)
150 150
  let cmakelists = 
151
    (if !Options.dest_dir = "" then "" else !Options.dest_dir ^ "/") ^ "CMakeLists.txt"
151
    (if !Lustrec.Options.dest_dir = "" then "" else !Lustrec.Options.dest_dir ^ "/") ^ "CMakeLists.txt"
152 152
  in
153 153
  let cmake_file = open_out cmakelists in
154 154
  let cmake_fmt = formatter_of_out_channel cmake_file in
155 155
  Format.fprintf cmake_fmt "cmake_minimum_required(VERSION 3.5)@.";
156
  Format.fprintf cmake_fmt "include(\"%s/share/helpful_functions.cmake\")@." Version.prefix;
157
  Format.fprintf cmake_fmt "include(\"%s/share/FindLustre.cmake\")@." Version.prefix;
156
  Format.fprintf cmake_fmt "include(\"%s/share/helpful_functions.cmake\")@." (Version.prefix ());
157
  Format.fprintf cmake_fmt "include(\"%s/share/FindLustre.cmake\")@." (Version.prefix ());
158 158
  Format.fprintf cmake_fmt "LUSTREFILES(LFILES ${CMAKE_CURRENT_SOURCE_DIR} )@.";
159 159
  Format.fprintf cmake_fmt "@[<v 2>FOREACH(lus_file ${LFILES})@ ";
160 160
  Format.fprintf cmake_fmt "get_lustre_name_ext(${lus_file} L E)@ ";
161 161
  Format.fprintf cmake_fmt "Lustre_Compile(@[<v 0>@ ";
162
  if !Options.main_node <> "" then Format.fprintf cmake_fmt "NODE \"%s_mutant\"@ " !Options.main_node;
163
  Format.fprintf cmake_fmt "LIBNAME \"${L}_%s_mutant\"@ " !Options.main_node;
162
  if !Lustrec.Options.main_node <> "" then Format.fprintf cmake_fmt "NODE \"%s_mutant\"@ " !Lustrec.Options.main_node;
163
  Format.fprintf cmake_fmt "LIBNAME \"${L}_%s_mutant\"@ " !Lustrec.Options.main_node;
164 164
  Format.fprintf cmake_fmt "LUS_FILES \"${lus_file}\")@]@]@.";
165 165
  Format.fprintf cmake_fmt "ENDFOREACH()@.@?";
166 166
  
......
189 189
    raise (Arg.Bad ("Can only compile *.lus files"))
190 190

  
191 191
let _ =
192
  Global.initialize ();
193
  Corelang.add_internal_funs ();
192
  Lustrec.Global.initialize ();
193
  Lustrec.Corelang.add_internal_funs ();
194 194
  try
195 195
    Printexc.record_backtrace true;
196 196

  
197
    let options = Options_management.lustret_options
197
    let options = Lustrec.Options_management.lustret_options
198 198

  
199 199
    in
200 200
    
201 201
    Arg.parse options anonymous usage
202 202
  with
203 203
  | Parse.Error _
204
  | Types.Error (_,_) | Clocks.Error (_,_)
205
  | Error.Error _ (*| Task_set.Error _*)
206
  | Causality.Error _ -> exit 1
204
  | Lustrec.Types.Error (_,_) | Lustrec.Clocks.Error (_,_)
205
  |Lustrec.Error.Error _ (*| Task_set.Error _*)
206
  | Lustrec.Causality.Error _ -> exit 1
207 207
  | Sys_error msg -> (eprintf "Failure: %s@." msg)
208 208
  | exc -> (track_exception (); raise exc)
209 209

  

Also available in: Unified diff