Commit 76cc6c4f authored by Erwan Jahier's avatar Erwan Jahier
Browse files

fix pbs in the lurettetop Direct mode.

- changes in the verbosity level, or in lutin files were not taken inti account
- propagate the verbosity level to the lutin interpreter
parent 39ba0d1b
......@@ -789,7 +789,7 @@ let (read : (unit -> string) -> bool) =
if not args.direct_mode then remove_outdated_files ();
if ( args.direct_mode || Build.f args) then (
Unix.chdir args.sut_dir;
let result = Run.f args in
let result = Run.f () in
if result <> 0
then output_string args.ocr "\n*** lurette has terminated abnormally.\n \n"
else output_string args.ocr "\nLurette has terminated normally.\n"
......
......@@ -699,3 +699,4 @@ let (explicit_the_file : string -> string) =
then (Filename.concat args.sut_dir s)
else s
......@@ -226,7 +226,7 @@ let main_loop_start () =
else
(if args.direct_mode || Build.f args then (
Unix.chdir args.sut_dir;
let res = Run.f args in
let res = Run.f () in
if (res) <> 0 then (
Printf.fprintf args.ocr "Lurette failed (%d).\n \n \n" res;
flush args.ocr;
......
......@@ -2,10 +2,10 @@
open LtopArg
let (f : LtopArg.t -> int) =
fun args ->
let (f : unit -> int) =
fun () ->
try
if args.direct_mode then RunDirect.f args else
if args.direct_mode then RunDirect.f () else
if
let f = Filename.concat args.tmp_dir ("lurette" ^ ExtTools.dot_exe) in
not (Sys.file_exists f)
......@@ -13,14 +13,14 @@ let (f : LtopArg.t -> int) =
1
else
(match args.sut_compiler with
| Stdin -> RunPipe.f args
| Stdin -> RunPipe.f ()
| VerimagV4
| VerimagV6
| Scade
| ScadeGUI
| Sildex
| Ocaml ->
RunBin.f args
RunBin.f ()
)
with
| Unix.Unix_error(error, name, arg) ->
......
......@@ -2,4 +2,4 @@
(* Run the lurette executable (made by Build.f) using LtopArg.args
and returns the exit status. *)
val f : LtopArg.t -> int
val f : unit -> int
open LtopArg
let (f : LtopArg.t -> int) =
fun args ->
let (f : unit -> int) =
fun () ->
if args.env = "" then (
output_string args.ocr ("No environment is provided\n");
flush args.ocr;
......
......@@ -3,4 +3,4 @@
open LtopArg
val f : LtopArg.t -> int
val f : unit -> int
......@@ -47,15 +47,15 @@ let (check_compat : vars -> vars -> vars -> vars -> vars -> vars -> int) =
)
let (f : LtopArg.t -> int) =
fun args ->
let (f : unit -> int) =
fun () ->
(* Get sut info (var names, step func, etc.) *)
let add_init init (a,b,c,d) = (a,b,c,d,init,init) in
let sut_in, sut_out, sut_kill, sut_step_sl, sut_init_in, sut_init_out =
match args.suts with
[LustreV6(prog,node)] -> add_init [] (LustreRun.make_v6 prog node)
| [LustreEc(prog)] -> add_init [] (LustreRun.make_ec prog)
| [Lutin(prog,node)] -> add_init [] (LustreRun.make_lut prog node)
| [Lutin(prog,node)] -> add_init [] (LustreRun.make_lut ~verb:args.verbose prog node)
| [Socket(addr, port)] -> add_init [] (LustreRun.make_socket addr port)
| [SocketInit(addr, port)] -> LustreRun.make_socket_init addr port
| _ -> assert false
......@@ -70,12 +70,12 @@ let (f : LtopArg.t -> int) =
| [Socket(addr, port)] -> LustreRun.make_socket addr port
| [Lutin(prog,node)] -> LustreRun.make_lut prog node
| [SocketInit(addr, port)] -> assert false
| [] -> [],[],(fun () -> ()), (fun _ -> [])
| [] -> [],[],(fun _ -> ()), (fun _ -> [])
| _ -> assert false
in
let env_in, env_out, env_kill, env_step_sl, env_init_in, env_init_out =
match args.envs with
| [Lutin(prog,node)] -> add_init [] (LustreRun.make_lut prog node)
| [Lutin(prog,node)] -> add_init [] (LustreRun.make_lut ~verb:args.verbose prog node)
| [LustreV6(prog,node)] -> add_init [] (LustreRun.make_v6 prog node)
| [LustreEc(prog)] -> add_init [] (LustreRun.make_ec prog)
| [Socket(addr, port)] -> add_init [] (LustreRun.make_socket addr port)
......@@ -138,7 +138,11 @@ let (f : LtopArg.t -> int) =
let oracle_out_vals = oracle_step_sl oracle_in_vals in
let print_val (vn,vv) = Rif_base.rif_val_to_string vv in
Printf.fprintf oc "#step %d\n" i;
output_string oc (String.concat " " (List.map print_val sut_in_vals));
if args.delay_env_outputs then
output_string oc (String.concat " " (List.map print_val pre_env_out_vals))
else
output_string oc (String.concat " " (List.map print_val env_out_vals));
output_string oc " #outs ";
output_string oc (String.concat " " (List.map print_val sut_out_vals));
output_string oc "\n";
......@@ -172,28 +176,27 @@ let (f : LtopArg.t -> int) =
Rif.write oc ("# This is lurettop Version " ^ Version.str ^ " (" ^Version.sha^")\n");
Rif.write oc ("# The random engine was initialized with the seed " ^
(string_of_int seed) ^ "\n" );
Rif_base.write_interface oc env_in env_out loc;
Rif_base.write_interface oc env_out sut_out loc;
Rif.flush oc;
in
let res =
let msg, res =
try
if res_compat = 0 then
let cov, res = loop cov_init sut_init_out sut_init_in 0 in
(match cov, args.oracle with
| _,None -> ()
| None, None -> ()
| Some cov, Some oracle -> Coverage.dump oracle args.output cov
| None, Some _ -> assert false
| Some _, None -> assert false
);
res
"#quit", res
else
res_compat
"#quit", res_compat
with e ->
print_string (Printexc.to_string e);
2
(Printexc.to_string e), 2
in
sut_kill();
oracle_kill();
sut_kill msg;
oracle_kill msg;
close_out oc;
res
......@@ -6,4 +6,4 @@ and LutExe (for lutin).
*)
val f : LtopArg.t -> int
val f : unit -> int
......@@ -6,8 +6,8 @@ let blank_star = (Str.regexp "[ \t]+")
let host = ExtTools.hosttype
let (f : LtopArg.t -> int) =
fun args ->
let (f : unit -> int) =
fun () ->
try
let seed_str =
match args.seed with
......
......@@ -18,4 +18,4 @@
*)
val f : LtopArg.t -> int
val f : unit -> int
......@@ -510,7 +510,7 @@ and
let ff = if f then 0.0 else 1.0 in
output_msg "\n*** Type error, ";
output_msg ((string_of_bool f)
^ " is a bool, but a float is expected. I convert it to '"^
^ " is a bool, but a float is expected. I convert it to '"^
(string_of_float ff)^"'\n");
assert false
)
......
......@@ -10,34 +10,36 @@ let subst_to_string (n,v) =
let (step_channel : in_channel -> out_channel -> vars -> vars ->
Rif_base.subst list -> Rif_base.subst list) =
fun ic oc in_vars out_vars sl ->
if debug then (
let str = String.concat " " (List.map subst_to_string sl) in
Printf.fprintf stdout "step_channel %s\n" str;
flush stdout
);
let in_vals_str =
List.fold_left
(fun acc (name, _)->
let value =
try List.assoc name sl
with Not_found -> assert false
in
acc ^ " "^ (Rif_base.rif_val_to_string value)
)
""
in_vars
in
let res =
output_string oc (in_vals_str ^"\n");
flush oc;
Rif_base.read ic None out_vars
in
res
(* XXX Doable with DynLink? Or via Ezdl? *)
let (make_ec : string -> vars * vars * (unit -> unit) *
try
if debug then (
let str = String.concat " " (List.map subst_to_string sl) in
Printf.fprintf stdout "step_channel %s\n" str;
flush stdout
);
let in_vals_str =
List.fold_left
(fun acc (name, _)->
let value =
try List.assoc name sl
with Not_found -> assert false
in
acc ^ " "^ (Rif_base.rif_val_to_string value)
)
""
in_vars
in
let res =
output_string oc (in_vals_str ^"\n");
flush oc;
Rif_base.read ic None out_vars
in
res
with e ->
failwith(Printexc.to_string e)
(* XXX Doable with DynLink? Or via Ezdl? *)
let (make_ec : string -> vars * vars * (string -> unit) *
(Rif_base.subst list -> Rif_base.subst list)) =
fun ec_file ->
......@@ -65,14 +67,14 @@ let (make_ec : string -> vars * vars * (unit -> unit) *
exit 2
in
let _ = Printf.eprintf "Process %d (ecexe) created\n" pid_lustre; flush stderr in
let kill () =
let kill msg =
Unix.close ec_stdin_in;
Unix.close ec_stdin_out;
Unix.close ec_stdout_in;
Unix.close ec_stdout_out;
(try
Printf.eprintf "Killing process %d\n" pid_lustre;
Printf.eprintf "%s\nKilling process %d\n" msg pid_lustre;
flush stderr;
Unix.kill pid_lustre Sys.sigterm
with e -> (Printf.printf "Killing of ecexe process failed: %s\n" (Printexc.to_string e) ))
......@@ -82,7 +84,7 @@ let (make_ec : string -> vars * vars * (unit -> unit) *
(* Via une edition de liens dynamique *)
let (make_ec_dynlink: string -> string -> string -> vars * vars * (unit -> unit) *
let (make_ec_dynlink: string -> string -> string -> vars * vars * (string -> unit) *
(Rif_base.subst list -> Rif_base.subst list)) =
fun node ec_file dl_file ->
let ec_in, ec_out = Util.get_io_from_lustre ec_file None in
......@@ -97,7 +99,7 @@ let (make_ec_dynlink: string -> string -> string -> vars * vars * (unit -> unit)
assert false
(**********************************************************************************)
let (make_v6 : string -> string -> vars * vars * (unit -> unit) *
let (make_v6 : string -> string -> vars * vars * (string -> unit) *
(Rif_base.subst list -> Rif_base.subst list)) =
fun lus_file node ->
let dir = Filename.dirname lus_file in
......@@ -117,7 +119,7 @@ let rec connect_loop sock addr k =
let (make_socket_do : string -> int -> in_channel *
vars * vars * (unit -> unit) * (Rif_base.subst list -> Rif_base.subst list)) =
vars * vars * (string -> unit) * (Rif_base.subst list -> Rif_base.subst list)) =
fun sock_adr port ->
let inet_addr = Unix.inet_addr_of_string sock_adr in
let sock = Unix.socket Unix.PF_INET Unix.SOCK_STREAM 0 in
......@@ -129,13 +131,15 @@ let (make_socket_do : string -> int -> in_channel *
(Unix.in_channel_of_descr sock, Unix.out_channel_of_descr sock)
with
Unix.Unix_error(errcode, funcstr, paramstr) ->
print_string "LustreRun connect failure: ";
print_string (Unix.error_message errcode);
print_string ("(" ^ funcstr ^ " " ^ paramstr ^")\n");
flush stdout;
exit 2
failwith ("LustreRun connect failure: " ^ (Unix.error_message errcode) ^
"(" ^ funcstr ^ " " ^ paramstr ^")\n")
in
let kill msg =
output_string sock_out msg;
let _ = input_line sock_in in
(* make sure that the sut process has read the quit before closing socks *)
Unix.shutdown sock Unix.SHUTDOWN_ALL
in
let kill () = Unix.shutdown sock Unix.SHUTDOWN_ALL in
let vars_in, vars_out =
Printf.fprintf stderr "make_socket: read_interface declarations on the socket.\n";
flush stderr;
......@@ -145,19 +149,19 @@ let (make_socket_do : string -> int -> in_channel *
(* exported *)
let (make_socket : string -> int ->
vars * vars * (unit -> unit) * (Rif_base.subst list -> Rif_base.subst list)) =
vars * vars * (string -> unit) * (Rif_base.subst list -> Rif_base.subst list)) =
fun sock_adr port ->
let _, vars_in, vars_out, kill, step = make_socket_do sock_adr port in
vars_in, vars_out, kill, step
(* exported *)
let (make_socket_init : string -> int ->
vars * vars * (unit -> unit) * (Rif_base.subst list -> Rif_base.subst list)
vars * vars * (string -> unit) * (Rif_base.subst list -> Rif_base.subst list)
* Rif_base.subst list * Rif_base.subst list) =
fun sock_adr port ->
let sock_in, vars_in, vars_out, kill, step = make_socket_do sock_adr port in
let in_init = Rif_base.read sock_in None vars_in in
let out_init = Rif_base.read sock_in None vars_out in
let in_init = Rif_base.read sock_in None vars_in in
vars_in, vars_out, kill, step, in_init, out_init
......@@ -176,9 +180,9 @@ let (to_vals : Rif_base.subst list -> Value.OfIdent.t) =
Value.OfIdent.empty
let (make_lut: ?libs:string list option -> string -> string ->
vars * vars * (unit -> unit) * (Rif_base.subst list -> Rif_base.subst list)) =
fun ?(libs = None) prog node ->
let (make_lut: ?verb:int -> ?libs:string list option -> string -> string ->
vars * vars * (string -> unit) * (Rif_base.subst list -> Rif_base.subst list)) =
fun ?(verb = 0) ?(libs = None) prog node ->
let lut_mach = LutExe.make ~libs:libs prog node in
let lut_in = List.map var_to_string_pair (LutExe.in_var_list lut_mach) in
let lut_out = List.map var_to_string_pair (LutExe.out_var_list lut_mach) in
......@@ -203,7 +207,8 @@ let (make_lut: ?libs:string list option -> string -> string ->
data_state := new_ds;
to_subst_list lut_out new_ds.LutExe.outs
in
lut_in, lut_out, (fun () -> ()), lut_step
Verbose.set (verb);
lut_in, lut_out, (fun _ -> ()), lut_step
(**********************************************************************************)
......@@ -219,7 +224,7 @@ let output_msg2 rif msg =
(*
let (make_luciole : string -> vars -> vars ->
(unit -> unit) * (Rif_base.subst list -> Rif_base.subst list)) =
(string -> unit) * (Rif_base.subst list -> Rif_base.subst list)) =
fun dro_file luciole_inputs luciole_outputs ->
let (luciole_stdin_in, luciole_stdin_out ) = Unix.pipe () in
let (luciole_stdout_in, luciole_stdout_out) = Unix.pipe () in
......
......@@ -18,32 +18,41 @@ type vars = (string * string) list
(** [make_ec ec_file] handles ec programs (expanded code coming from
Verimag lustre compilers. *)
Verimag lustre compilers.
Raises Failure of string if something bas happens.
*)
val make_ec : string ->
vars * vars * (unit -> unit) * (Rif_base.subst list -> Rif_base.subst list)
vars * vars * (string -> unit) * (Rif_base.subst list -> Rif_base.subst list)
(** [make_v6 file node] handles Verimag/Lustre v6 programs
(** [make_v6 file node] handles Verimag/Lustre v6 programs *)
Raises Failure of string if something bas happens.
*)
val make_v6 : string -> string ->
vars * vars * (unit -> unit) * (Rif_base.subst list -> Rif_base.subst list)
vars * vars * (string -> unit) * (Rif_base.subst list -> Rif_base.subst list)
(** [make_socket sock_addr port]
Take a socket address and a socket port, connect to it. This socket
is supposed to read and write information using the RIF.
Aborts (exit 2) in the connection to the socket fails.
Raises Failure of string if something bas happens.
The process that feeds the other side of the socket is supposed
to stop if it receives "#quit".
*)
val make_socket : string -> int ->
vars * vars * (unit -> unit) * (Rif_base.subst list -> Rif_base.subst list)
vars * vars * (string -> unit) * (Rif_base.subst list -> Rif_base.subst list)
val make_socket_init : string -> int ->
vars * vars * (unit -> unit) * (Rif_base.subst list -> Rif_base.subst list)
vars * vars * (string -> unit) * (Rif_base.subst list -> Rif_base.subst list)
* Rif_base.subst list * Rif_base.subst list
val make_lut: ?libs:string list option -> string -> string ->
vars * vars * (unit -> unit) * (Rif_base.subst list -> Rif_base.subst list)
val make_lut: ?verb:int -> ?libs:string list option -> string -> string ->
vars * vars * (string -> unit) * (Rif_base.subst list -> Rif_base.subst list)
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment