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

source/Lurettetop/cmd.ml

@@ -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"

source/Lurettetop/ltopArg.ml

@@ -699,3 +699,4 @@ let (explicit_the_file : string -> string) =
     then (Filename.concat args.sut_dir s)
     else s
 
+ 

source/Lurettetop/lurettetop.ml

@@ -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; 

source/Lurettetop/run.ml

@@ -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) ->

source/Lurettetop/run.mli

@@ -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

source/Lurettetop/runBin.ml

 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;

source/Lurettetop/runBin.mli

@@ -3,4 +3,4 @@
 
 open LtopArg
 
-val f : LtopArg.t -> int
+val f : unit -> int

source/Lurettetop/runDirect.ml

@@ -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

source/Lurettetop/runDirect.mli

@@ -6,4 +6,4 @@ and LutExe (for lutin).
  *)
 
 
-val f : LtopArg.t -> int
+val f : unit -> int

source/Lurettetop/runPipe.ml

@@ -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

source/Lurettetop/runPipe.mli

@@ -18,4 +18,4 @@
    
 *)
 
-val f : LtopArg.t -> int
+val f : unit -> int

source/common/formula_to_bdd.ml

@@ -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
 	    )

source/common/lustreRun.ml

@@ -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

source/common/lustreRun.mli

@@ -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)