Commit 0b0203fe authored by Erwan Jahier's avatar Erwan Jahier
Browse files

Split lurettetop.ml into several files.

parent 2e09ef45
......@@ -8,7 +8,7 @@ test-lucky:
cd lucky/tut-examples/ && make test;
cd xlurette/Gyro && make test ;
cd xlurette/fault-tolerant-heater/ && make test ;
cd xlurette/tram/ && make test ;
# cd xlurette/tram/ && make test ;
cd xlurette/heater/ && make test ;
cd luckyDraw/ocaml/ && make test ;
cd luckyDraw/c/ && make test ;
......@@ -38,13 +38,13 @@ endif
test-lutin:
cd lutin/up_and_down && make test;
cd lutin/test_ok && make test;
cd lutin/C && make test;
cd lutin/xlurette && make test;
cd lutin/ocaml && make test;
cd lutin/external_code && make test;
cd lutin/luciole && make test ;
cd lutin/lustre && make test ;
cd lutin/test_ok && make test ;
cd lutin/C && make test;
echo "All lutin tests ran correctly."
# problem ~
......
LINKER= $(CC)
EXE=
DEBUG=-D_DEBUG
DEBUG=-D_DEBUG
DEBUG=
CFLAGS = \
-L../../../lib \
-I../../../include $(DEBUG)
-I../../../include $(DEBUG) -D_LAUNCH_LUTIN_AUTOMATICALLY
LIBS = -lluc4c_nc -llucky_nc -lgmp -lm -ldl -lstdc++
LUC2C=../../../$(HOSTTYPE)/bin/lutin --2c-4c
LUC2CSOCK=../../../$(HOSTTYPE)/bin/lutin --2c-4c-socks -seed 42
LUC2CSOCK=../../../$(HOSTTYPE)/bin/lutin --2c-4c-socks 127.0.0.1 -seed 42
ifeq ($(HOSTTYPE),mac)
LINKER=g++ -g
......@@ -21,13 +21,13 @@ ifneq (,$(findstring win32,$(HOSTTYPE)))
LINKER=$(CC)
CFLAGS = \
-L../../../lib \
-I../../../include -D_WIN32 -D_WINSOCK $(DEBUG) \
-I../../../include -D_WIN32 -D_WINSOCK $(DEBUG) -D_LAUNCH_LUTIN_AUTOMATICALLY \
-Winline -Wimplicit-function-declaration
LIBS = -lluc4c_nc -llucky_nc -lgmp -lws2_32 -lm -lstdc++ -lole32
LIBSSOCK = -lws2_32 -lole32
LUC2C=../../../$(HOSTTYPE)/bin/lutin.exe --2c-4c
LUC2CSOCK=../../../$(HOSTTYPE)/bin/lutin.exe --2c-4c-socks
LUC2CSOCK=../../../$(HOSTTYPE)/bin/lutin.exe --2c-4c-socks 127.0.0.1 -seed 42
endif
ifeq ($(HOSTTYPE),cygwin)
EXE=.exe
......
......@@ -17,8 +17,23 @@ USE_CAMLP4 = yes
SOURCES = \
$(OBJDIR)/genlex.mli $(OBJDIR)/genlex.ml \
$(OBJDIR)/version.ml $(OBJDIR)/util.ml $(OBJDIR)/util2.ml $(OBJDIR)/lurettetop.ml
$(OBJDIR)/genlex.mli $(OBJDIR)/genlex.ml \
$(OBJDIR)/version.ml \
$(OBJDIR)/util.ml \
$(OBJDIR)/util2.ml \
$(OBJDIR)/ltopArg.ml \
$(OBJDIR)/ocaml.mli \
$(OBJDIR)/ocaml.ml \
$(OBJDIR)/extTools.mli \
$(OBJDIR)/extTools.ml \
$(OBJDIR)/pipe.ml \
$(OBJDIR)/build.mli \
$(OBJDIR)/build.ml \
$(OBJDIR)/run.mli \
$(OBJDIR)/run.ml \
$(OBJDIR)/cmd.mli \
$(OBJDIR)/cmd.ml \
$(OBJDIR)/lurettetop.ml
RESULT = ./lurettetop_exe$(EXE)
......
open LtopArg
let check_config_types_exist dir =
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";
output_string oc "#define bool int\n";
output_string oc "#define _int int\n";
output_string oc "#define real double\n";
flush oc;
close_out oc
let chop_ext = Util.chop_ext_no_excp
(* XXX bien compliqué tout ca. A reprendre proprement *)
let (f : unit -> bool) =
fun () ->
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 (
"... 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;
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
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;
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 @
[
"-r";
(* "-C"; *)
(* ("\"" ^ (args.tmp_dir) ^ "\""); *)
"-f";
makefile;
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
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
| 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
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 *)
val read : (unit -> string) -> bool
(* A set of functions that basically calls external tools via create_process *)
open LtopArg
let lurette_path =
try Unix.getenv "LURETTE_PATH"
with _ ->
output_string args.ocr "lurettetop: Environment var LURETTE_PATH is unset.\n";
output_string args.ocr "You must use the lurettetop script, not lurettetop_exe.\n";
flush args.ocr;
""
let hosttype = Util.hosttype args.ocr
let lurette_bin = (Filename.concat lurette_path "bin")
(************************************************************************)
let exe = if hosttype = "cygwin" || hosttype = "win32" then "_exe" else ""
let exe, dot_exe =
if Str.string_match (Str.regexp "win32") hosttype 0 then
"_exe", ".exe"
else
"",""
(************************************************************************)
(* XXX i should use Util.my_create_process *)
(* use to perform system calls of Lurette utilities *)
let (my_create_process : string -> string list -> in_channel -> out_channel ->
out_channel -> bool) =
fun prog arg ic oc ec ->
try
let pid =
output_string args.ecr "lurettetop launches: ";
List.iter (fun x -> output_string args.ecr (x ^ " ")) (prog::arg);
output_string args.ecr "\n";
flush args.ecr;
Unix.create_process prog (Array.of_list (prog::arg))
(Unix.descr_of_in_channel ic)
(Unix.descr_of_out_channel oc)
(Unix.descr_of_out_channel ec)
in
let (_,status) =
try (Unix.waitpid [Unix.WUNTRACED] pid) with _ -> assert false
in
(match status with
Unix.WEXITED i ->
if i = 0 || i = 1 then
(output_string ec (" ... " ^ prog ^ " exited normally.\n");
flush ec;
true)
else
(output_string oc ("*** Error: " ^ prog ^ " exited ABnormally (return code=" ^
(string_of_int i)^").\n");
flush oc;
false
)
| _ ->
output_string oc ("*** Error: " ^ prog ^ " exited ABnormally!\n");
flush oc;
false
)
with
| Unix.Unix_error(error, name, arg) ->
let msg = ( "*** << " ^ (Unix.error_message error) ^
" >> in the system call: << " ^ name ^ " " ^ arg ^ " >>\n")
in
output_string oc msg;
flush oc;
false
| e ->
output_string oc (Printexc.to_string e);
flush oc;
false
let chop_ext = Util.chop_ext_no_excp
let (empty_a_file : string -> unit) =
fun file ->
close_out (open_out file)
let (gen_stubs : string -> string -> string -> string -> bool) =
fun sut sut_node oracle oracle_node ->
if
Sys.file_exists ((chop_ext sut) ^ "_io.c") &&
args.sut_compiler = Sildex
then
(
output_string args.ecr ("Delete " ^ (chop_ext sut) ^ "_io.c\n");
flush args.ecr;
empty_a_file ((chop_ext sut) ^ "_io.c")
);
if
Sys.file_exists ((chop_ext oracle) ^ "_io.c") &&
args.oracle_compiler = Sildex
then
(
output_string args.ecr ("Delete " ^ (chop_ext oracle) ^ "_io.c\n");
flush args.ecr;
empty_a_file ((chop_ext oracle) ^ "_io.c")
);
my_create_process (Filename.concat lurette_bin ("gen_stubs" ^ exe))
([ sut; sut_node; (compiler_to_string args.sut_compiler)
] @
(if oracle = "" then [] else
[oracle; oracle_node ; (compiler_to_string args.oracle_compiler) ]
) @
[args.tmp_dir]
@ (if (args.sut_compiler<> ScadeGUI) && (args.oracle_compiler <> ScadeGUI) then [] else [(args.root_node) ^ ".h"])
)
stdin args.ocr args.ecr
let (show_luc : string -> bool) =
fun luc_file ->
(my_create_process
(Filename.concat lurette_bin ("show_luc"))
(luc_file::(
match args.pp with
None -> []
| Some p -> if p = "" then [] else ["-pp"; p]
)
)
stdin args.ocr args.ecr
)
exception LutinFailure
(* exported *)
let (lutin : string -> string -> bool) =
fun lutfile outputfile ->
my_create_process
(Filename.concat lurette_bin ("lutin"))
[lutfile; outputfile]
stdin args.ocr args.ecr
(***********************************************************************)
(***********************************************************************)
(* In order to avoid the launching of a new gnuplot process each time
I need to, I launch a gnuplor process once for all, and
communicate with it via sockets *)
let gp_pid = ref 0
let my_name = "127.0.0.1"
(* Unix.gethostname () *)
let my_entrie_byname = Unix.gethostbyname my_name
let inet_addr = my_entrie_byname.Unix.h_addr_list.(0)
let gp_sock = Unix.socket Unix.PF_INET Unix.SOCK_STREAM 0
let port =
let rec (bind_with_free_port : Unix.file_descr -> Unix.inet_addr -> int -> int
-> int) =
fun s saddr port maxtry ->
if maxtry = 0 then
failwith ("lurettetop: socket bind failure at adr " ^
(Unix.string_of_inet_addr saddr) )
else
try
Unix.bind s (Unix.ADDR_INET(saddr, port));
port
with e ->
bind_with_free_port s saddr (port+1) (maxtry-1)
in
bind_with_free_port gp_sock inet_addr 1000 1000
let _ =
let prog = "gnuplot-socket" in
let arg_list = [prog; (Unix.string_of_inet_addr inet_addr); (string_of_int port)] in
try
gp_pid := Unix.create_process (prog) (Array.of_list arg_list)
(* args.icr args.ocr args.ecr *)
(* Unix.stdin Unix.stdout Unix.stderr *)
Unix.stdin
(Unix.descr_of_out_channel args.ocr)
(Unix.descr_of_out_channel args.ecr)
with _ ->
output_string args.ocr (
"*** can not find gnuplot-socket. Is your path set properly?\n" ^
"*** It should contain the lurette/<arch>/bin/ directory\n");
flush args.ocr;
exit 2
let (connected_gp_sock, _) =
try
Unix.listen gp_sock 1;
Unix.accept gp_sock (* bloquant *)
with
Unix.Unix_error(errcode, funcstr, paramstr) ->
output_string args.ocr "lurettetop socket failure: ";
output_string args.ocr (Unix.error_message errcode);
output_string args.ocr "\n";
flush args.ocr ;
exit 2
let gp_ic = Unix.in_channel_of_descr connected_gp_sock
let gp_oc = Unix.out_channel_of_descr connected_gp_sock
(* let _ = *)
(* Unix.setsockopt_float connected_gp_sock Unix.SO_RCVTIMEO 0.00001 *)
let (gnuplot: string -> bool) =
fun file ->
try
if !gp_pid = 0 then
(
output_string args.ecr "*** can not launch gnuplot. Is it in your PATH?\n";
flush args.ecr;
false
)
else
let gnuplotrif = Unix.getenv "GNUPLOTRIF" in
let cmd2 = ("\n load \"" ^ (Filename.chop_extension file) ^ ".plot\"") in
let res =
(* update gnuplot files *)
my_create_process gnuplotrif [file]
stdin stdout args.ecr
in
output_string gp_oc ("cd \'" ^ args.sut_dir ^ "\'\n");
output_string gp_oc (cmd2 ^ "\n") ;
output_string args.ecr (cmd2 ^ "\n") ;
flush gp_oc;
if res then
(
output_string args.ecr " ... gnuplot-rif: 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 (quit_gnuplot : unit -> unit) =
fun () ->
try
if !(gp_pid) <> 0 then
(try Unix.kill (!(gp_pid)) Sys.sigkill with _ -> () );
if args.socket_port <> None then
(
Unix.shutdown (Unix.descr_of_in_channel args.icr) Unix.SHUTDOWN_ALL;
if args.log then (close_out args.ocr; close_out args.ecr)
else
(
Unix.shutdown (Unix.descr_of_out_channel args.ocr)
Unix.SHUTDOWN_ALL;
Unix.shutdown (Unix.descr_of_out_channel args.ecr)
Unix.SHUTDOWN_ALL;
)
)
with
e ->
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
(* a few useful constants depending on the system *)