Commit 7bfb021b authored by Erwan Jahier's avatar Erwan Jahier
Browse files

lurettetop: More code cleaning.

In particular, split Run into Run and RunBin.
parent a3055824
......@@ -47,13 +47,18 @@ let gen_makefile str env_ext =
^str^"_luciole.o "^str^".dro "^str^".h Makefile."^str);
print_string ("File Makefile." ^ str ^ " has been created. Launch \n");
print_string (" make -f Makefile." ^ str ^ "\n to run luciole\n");
(* XXX Pourquoi ca ne marche pas ??? *)
ignore (Util.my_create_process "make" ["-f";("Makefile." ^ str)]);
close_out oc
(* This function is used
- for lucky via luc2c (from_lurette=false and lutin=false)
- for lutin via luc2c (from_lurette=false and lutin=true)
- for lurette via luc2luciole (from_lurette=true)
It generates a C file that will be compiled into a .dro file.
*)
let (gen_stubs : bool -> bool -> string -> vn_ct list -> vn_ct list -> unit) =
fun from_lurette lutin str inputs outputs ->
let oc =
......
......@@ -26,9 +26,12 @@ SOURCES = \
$(OBJDIR)/ocaml.ml \
$(OBJDIR)/extTools.mli \
$(OBJDIR)/extTools.ml \
$(OBJDIR)/pipe.ml \
$(OBJDIR)/build.mli \
$(OBJDIR)/build.ml \
$(OBJDIR)/runBin.mli \
$(OBJDIR)/runBin.ml \
$(OBJDIR)/runPipe.mli \
$(OBJDIR)/runPipe.ml \
$(OBJDIR)/run.mli \
$(OBJDIR)/run.ml \
$(OBJDIR)/cmd.mli \
......@@ -39,6 +42,10 @@ RESULT = ./lurettetop_exe$(EXE)
ln: $(OBJDIR) $(SOURCES)
ddot :
ocamldoc -dot $(SOURCES) -dot-reduce -o ltop.dot
dot -Tpdf ltop.dot -o ltop.pdf
xpdf ltop.pdf
OCAMLMAKEFILE = $(LURETTE_PATH)/OcamlMakefile
include $(OCAMLMAKEFILE)
......
open LtopArg
let check_config_types_exist dir =
(* Under the scade GUI, the file config_types.h is automatically
generated. Therefore, i mimick that behavior in the Scade
non GUI mode. *)
let check_config_types_exist args =
let dir = args.tmp_dir in
if
args.sut_compiler = Scade
&& not (Sys.file_exists (Filename.concat dir "config_types.h"))
then
(* under the scade GUI, the file config_types.h is automatically
generated. Therefore, i mimick that behavior in the Scade
non GUI mode. *)
let oc = open_out (Filename.concat dir "config_types.h") in
output_string oc "#define false 0\n";
output_string oc "#define true 1\n";
......@@ -21,162 +22,147 @@ let check_config_types_exist dir =
let chop_ext = Util.chop_ext_no_excp
(* XXX bien compliqué tout ca. A reprendre proprement *)
let (f : unit -> bool) =
fun () ->
let (f : LtopArg.t -> bool) =
fun args ->
if args.sut_compiler = Stdin then true else
let _ = check_config_types_exist args.tmp_dir in
let sut_path = Filename.concat args.sut_dir args.sut in
let _ = output_string args.ecr (
let _ =
check_config_types_exist args;
output_string args.ecr (
"... generating lurette" ^ " from " ^ sut_path ^ "\n");
in
if
not (Sys.file_exists sut_path)
then
(
output_string args.ocr ("\n*** File " ^ sut_path ^
" does not exist.\n");
flush args.ocr;
if not (Sys.file_exists sut_path) then (
output_string args.ocr ("\n*** File "^sut_path^" does not exist.\n");
flush args.ocr;
false
)
else (
output_string args.ecr " building lurette ...\n";
flush args.ecr;
if args.sut = "" then (
output_string args.ocr "*** The sut field must be filled in.\n ";
flush args.ecr;
false
)
else
(
output_string args.ecr " building lurette ...\n";
flush args.ecr;
if
args.sut = ""
then
(
output_string args.ocr "*** The sut field must be filled in.\n ";
flush args.ecr;
else
let (oracle, oracle2, oracle_dir) =
match args.oracle
with
| None -> ( "", "",args.tmp_dir)
| Some str ->
let str2 =
if Filename.is_implicit str then
(* we assume the oracle is in the same dir as the
sut in that case *)
(Filename.concat args.sut_dir str)
else
str
in
(str2, str2, args.tmp_dir)
in
let make_rule = "nc" in
let make_opt =
match (args.sut_compiler, args.oracle_compiler) with
| Scade, _ -> "scade"
| VerimagV4, VerimagV6 -> make_rule
| VerimagV6, VerimagV4 -> make_rule
| VerimagV6, VerimagV6 -> make_rule
| VerimagV4, VerimagV4 -> make_rule
| Ocaml, Ocaml -> "ocaml"
| Sildex, VerimagV4 -> "sildex_sut"
| VerimagV4, Sildex -> "sildex_oracle"
| Sildex, Sildex -> "sildex_both"
| ScadeGUI, _ -> "lurette"
| _, ScadeGUI -> assert false
| _, Scade -> "scade"
| Stdin, _ -> assert false
| _, Stdin -> assert false
| sc,oc ->
assert false
in
if (oracle2 <> "") && not (Sys.file_exists oracle2) then (
output_string args.ocr
("\n*** File " ^ oracle2 ^ " does not exist.\n");
flush args.ocr;
false
)
else
let (oracle, oracle2, oracle_dir) =
match args.oracle
with
None ->
( "", "",args.tmp_dir)
| Some str ->
let str2 =
if Filename.is_implicit str then
(* we assume the oracle is in the same dir as the
sut in that case *)
(Filename.concat args.sut_dir str)
else
str
in
(str2, str2, args.tmp_dir)
in
let make_rule = "nc" in
let make_opt =
match (args.sut_compiler, args.oracle_compiler) with
| Scade, _ -> "scade"
| VerimagV4, VerimagV6 -> make_rule
| VerimagV6, VerimagV4 -> make_rule
| VerimagV6, VerimagV6 -> make_rule
| VerimagV4, VerimagV4 -> make_rule
| Ocaml, Ocaml -> "ocaml"
| Sildex, VerimagV4 -> "sildex_sut"
| VerimagV4, Sildex -> "sildex_oracle"
| Sildex, Sildex -> "sildex_both"
| ScadeGUI, _ -> "lurette"
| _, ScadeGUI -> assert false
| _, Scade -> "scade"
| Stdin, _ -> assert false
| _, Stdin -> assert false
| sc,oc ->
assert false
in
if
(oracle2 <> "") && not (Sys.file_exists oracle2)
then
(
output_string args.ocr
("\n*** File " ^ oracle2 ^ " does not exist.\n");
flush args.ocr;
false
)
else
(
let sut_node = args.sut_node in
let oracle_node = args.oracle_node in
try
let putenv var value =
Printf.fprintf args.ecr "%s=%s\n" var value;
flush args.ecr;
Unix.putenv var value
in
Unix.chdir args.tmp_dir;
putenv "SUT_DIR" args.tmp_dir;
if args.sut_compiler = Ocaml then
putenv "SUT" args.sut
else
putenv "SUT" sut_node;
putenv "ENV" args.env;
(match args.pp with None -> () |
Some pp -> putenv "PP" ("-pp "^ (pp)));
putenv "ORACLE_DIR" oracle_dir;
if args.oracle_compiler = Ocaml then
(match args.oracle with
None-> ()
| Some str -> putenv "ORACLE" str)
else
putenv "ORACLE" oracle_node;
else (
let sut_node = args.sut_node in
let oracle_node = args.oracle_node in
try
let putenv var value =
Printf.fprintf args.ecr "%s=%s\n" var value;
flush args.ecr;
Unix.putenv var value
in
Unix.chdir args.tmp_dir;
putenv "SUT_DIR" args.tmp_dir;
if args.sut_compiler = Ocaml
then putenv "SUT" args.sut
else putenv "SUT" sut_node;
putenv "ENV" args.env;
(match args.pp with None -> () |
Some pp -> putenv "PP" ("-pp "^ (pp)));
putenv "ORACLE_DIR" oracle_dir;
if args.oracle_compiler = Ocaml then
(match args.oracle with
None-> ()
| Some str -> putenv "ORACLE" str)
else
putenv "ORACLE" oracle_node;
putenv "USER_TESTING_DIR" (args.sut_dir);
putenv "LURETTE_TMP_DIR" (args.tmp_dir);
if args.sut_compiler = Ocaml then (
let ocaml_module =
Filename.basename (chop_ext args.sut) in
let ocaml_module = String.capitalize ocaml_module in
if ocaml_module = "Sut" then
failwith "*** You cannot name your sut 'sut.ml'; please rename it.\n"
else
Ocaml.gen_ocaml_sut ocaml_module
);
(match args.oracle_compiler, args.oracle with
| Ocaml, Some oracle ->
let ocaml_module = Filename.basename (chop_ext oracle) in
let ocaml_module = String.capitalize ocaml_module in
if ocaml_module = "Oracle" then
failwith
"*** You cannot name your oracle 'oracle.ml', please rename it.\n"
else
Ocaml.gen_ocaml_oracle ocaml_module
| Ocaml, None ->
Ocaml.gen_fake_ocaml_oracle ()
| _,_ -> ()
);
putenv "USER_TESTING_DIR" (args.sut_dir);
putenv "LURETTE_TMP_DIR" (args.tmp_dir);
if args.sut_compiler = Ocaml then (
let ocaml_module =
Filename.basename (chop_ext args.sut) in
let ocaml_module = String.capitalize ocaml_module in
if ocaml_module = "Sut" then
failwith "*** You cannot name your sut 'sut.ml'; please rename it.\n"
else
Ocaml.gen_ocaml_sut ocaml_module
);
(match args.oracle_compiler, args.oracle with
| Ocaml, Some oracle ->
let ocaml_module = Filename.basename (chop_ext oracle) in
let ocaml_module = String.capitalize ocaml_module in
if ocaml_module = "Oracle" then
failwith
"*** You cannot name your oracle 'oracle.ml', please rename it.\n"
else
Ocaml.gen_ocaml_oracle ocaml_module
| Ocaml, None ->
Ocaml.gen_fake_ocaml_oracle ()
| _,_ -> ()
);
if
if args.sut_compiler <> Ocaml then
(
not (ExtTools.gen_stubs (Filename.concat args.sut_dir args.sut) sut_node
(if oracle = "" then "" else oracle)
(if oracle = "" then "" else oracle_node)
))
else
false
then
false
else
let make =
try
Util2.string_to_string_list (Unix.getenv "MAKE")
with _ ->
["make"]
in
let makefile =
if args.scade_gui then
(Filename.concat args.tmp_dir "Makefile")
else
(Filename.concat
(Filename.concat ExtTools.lurette_path "lib")
"Makefile.lurette")
in
let make_arg_list =
make @
if
if args.sut_compiler <> Ocaml then (
not (ExtTools.gen_stubs (Filename.concat args.sut_dir args.sut) sut_node
(if oracle = "" then "" else oracle)
(if oracle = "" then "" else oracle_node)
))
else
false
then
false
else
let make =
try Util2.string_to_string_list (Unix.getenv "MAKE")
with _ ->
["make"]
in
let makefile =
if args.scade_gui then
(Filename.concat args.tmp_dir "Makefile")
else
(Filename.concat
(Filename.concat ExtTools.lurette_path "lib")
"Makefile.lurette")
in
let make_arg_list =
make @
[
"-r";
(* "-C"; *)
......@@ -186,36 +172,36 @@ let (f : unit -> bool) =
make_opt
]
in
let make_pid =
List.iter
(fun x -> output_string args.ecr (x ^ " ")) make_arg_list;
output_string args.ecr "\n";
flush args.ecr;
Unix.create_process
(List.hd make)
(Array.of_list make_arg_list)
(Unix.stdin)
(Unix.descr_of_out_channel args.ecr)
(Unix.descr_of_out_channel args.ecr)
in
ignore(Unix.waitpid [Unix.WUNTRACED] make_pid);
output_string args.ecr " ... make ok.\n";
flush args.ecr;
true
in
let make_pid =
List.iter
(fun x -> output_string args.ecr (x ^ " ")) make_arg_list;
output_string args.ecr "\n";
flush args.ecr;
Unix.create_process
(List.hd make)
(Array.of_list make_arg_list)
(Unix.stdin)
(Unix.descr_of_out_channel args.ecr)
(Unix.descr_of_out_channel args.ecr)
in
ignore(Unix.waitpid [Unix.WUNTRACED] make_pid);
output_string args.ecr " ... make ok.\n";
flush args.ecr;
true
with
| Unix.Unix_error(error, name, arg) ->
output_string args.ocr
( "*** << " ^
with
| Unix.Unix_error(error, name, arg) ->
output_string args.ocr
( "*** << " ^
(Unix.error_message error) ^
" >> in the system call: << " ^ name ^ " " ^ arg ^ " >>\n");
flush args.ocr;
false
flush args.ocr;
false
| Failure e ->
output_string args.ocr e ;
flush args.ocr ;
false
)
)
| Failure e ->
output_string args.ocr e ;
flush args.ocr ;
false
)
)
(* Returns true if it managed to build the lurette executable *)
val f : unit -> bool
(* Returns true if f managed to build the lurette executable (using LtopArg.args).
It relies on Makefile.lurette
*)
val f : LtopArg.t -> bool
This diff is collapsed.
(* [read readline] uses readline to read and execute a command
provided at the top-level loop. It returns true if the commands
was executed normally *)
(* [read readline] uses readline to read (from stdin) and execute commands
provided at the top-level loop. It returns true if the main loop
should not be interupted.
side effect :
- modifies LtopArg.args
- builds and runs lurette
*)
val read : (unit -> string) -> bool
......@@ -14,6 +14,10 @@ let hosttype = Util.hosttype args.ocr
let lurette_bin = (Filename.concat lurette_path "bin")
let (make : string list) =
try Util2.string_to_string_list (Unix.getenv "MAKE")
with _ -> ["make"]
(************************************************************************)
......@@ -262,24 +266,25 @@ let (quit_gnuplot : unit -> unit) =
print_string (Printexc.to_string e);
flush stdout
let (gnuplot_ps: string -> bool) =
fun file ->
try
let gnuplotrif = Unix.getenv "GNUPLOTRIF" in
let res = my_create_process gnuplotrif [file; "-cps"]
stdin args.ocr args.ecr
in
if res then
(
output_string args.ecr " ... gnuplot-rif -ps : ok\n";
flush args.ecr
);
res
with
Not_found ->
output_string args.ocr "*** Can not find GNUPLOTRIF env variable.\n";
flush args.ocr;
false
| _ ->
false
let (gnuplot_ps: string -> bool) =
fun file ->
try
let gnuplotrif = Unix.getenv "GNUPLOTRIF" in
let res = my_create_process gnuplotrif [file; "-cps"]
stdin args.ocr args.ecr
in
if res then
(
output_string args.ecr " ... gnuplot-rif -ps : ok\n";
flush args.ecr
);
res
with
Not_found ->
output_string args.ocr "*** Can not find GNUPLOTRIF env variable.\n";
flush args.ocr;
false
| _ ->
false
......@@ -3,6 +3,7 @@
val dot_exe:string
val lurette_path:string
val hosttype:string
val make : string list
val lutin : string -> string -> bool
......
......@@ -222,9 +222,9 @@ let lurettetop_quit _ =
let main_loop_start () =
if not !(args.go) then (main_loop 1; Unix.chdir args.sut_dir)
else
(if Build.f () then (
(if Build.f args then (
Unix.chdir args.sut_dir;
if (Run.f ()) <> 0 then (
if (Run.f args) <> 0 then (
output_string args.ocr "Can not run lurette, sorry.\n \n \n";
flush args.ocr;
lurettetop_quit ();
......
......@@ -2,182 +2,25 @@
open LtopArg
let (f : unit -> int) =
fun () ->
let (f : LtopArg.t -> int) =
fun args ->
if
let f = Filename.concat args.tmp_dir ("lurette" ^ ExtTools.dot_exe) in
not (Sys.file_exists f)
then
1
else if args.sut_compiler = Stdin then Pipe.run () else
else
try
if args.env = "" then (
output_string args.ocr ("No environment is provided\n");
flush args.ocr;
1
)
else
let compiler =
if args.sut_compiler = Stdin then ["-stdin"] else []
in
let seed_str =
match args.seed with
None -> []
| Some i -> "-seed"::[(string_of_int i)]
and precision_str = "--precision"::[string_of_int args.precision]
and compute_volume_str =
if !(args.compute_volume) then ["--compute-poly-volume"] else []
and verb_str = ["-v"; (string_of_int (args.verbose))]
and reactive_str = if !(args.reactive) then ["--reactive"] else []
and show_step_str = if !(args.show_step) then ["--show-step"] else []
and step_mode_str = [step_mode_to_string args.step_mode]
and inside_nb_str = [string_of_int args.draw_inside]
and edges_nb_str = [string_of_int args.draw_edges]
and vertices_nb_str = [string_of_int args.draw_vertices]
and all_formula_str =
if args.all_formula then ["--draw-all-formula"] else []
and all_vertices_str =
if args.all_vertices then ["--draw-all-vertices"] else []
and orac_str =
match args.oracle with
None -> ["--no-oracle"]
| Some str -> []
and step_nb_str = [(string_of_int args.step_nb)]
and draw_nb_str = [(string_of_int args.draw_nb)]
and outp_str = "-o"::[args.output]
and step_str = match !(args.step_by_step) with Some i -> ["-s"; string_of_int i] | None -> []
and sim2_str =
if !(args.display_sim2chro) then ["--call-sim2chro"] else ["-ns2c"]
and dlvr_str =
if !(args.display_local_var) then ["--display-local-var"] else ["-nlv"]
and env_str =
let lut_list = Util2.string_to_string_list args.env in
(* List.iter *)
(* (fun lut -> *)
(* if lut = "x" then () else *)
(* if Util.get_extension lut = ".lut" then *)
(* let file = chop_ext lut in *)
(* ignore (lutin lut (file ^ ".luc")) *)
(* ) *)
(* lut_list; *)
(* List.map *)
(* (fun lut -> *)
(* try let file = chop_ext lut in *)
(* (file ^ ".luc") *)
(* with _ -> lut *)
(* ) *)
lut_list
and pp_str =