From 50255d753c93195b2118e1c1e1677d59e0becf19 Mon Sep 17 00:00:00 2001
From: Erwan Jahier <erwan.jahier@univ-grenoble-alpes.fr>
Date: Thu, 6 Feb 2020 11:11:39 +0100
Subject: [PATCH] Update: write all sasa error msgs on stderr
---
lib/sasacore/genRegister.ml | 12 ++++++------
lib/sasacore/main.ml | 16 ++++++++--------
lib/sasacore/register.ml | 26 +++++++++-----------------
lib/sasacore/sasArg.ml | 4 ++--
src/sasaMain.ml | 2 +-
test/Makefile.inc | 6 ++++--
test/coloring/p.ml | 4 ++--
test/unison/Makefile | 5 ++---
8 files changed, 34 insertions(+), 41 deletions(-)
diff --git a/lib/sasacore/genRegister.ml b/lib/sasacore/genRegister.ml
index c2c0eb38..93a29798 100644
--- a/lib/sasacore/genRegister.ml
+++ b/lib/sasacore/genRegister.ml
@@ -36,7 +36,7 @@ let (f: string list -> string * string -> unit) =
fun ml_ins (state_file, register_file) ->
let state_module = ml_filename_to_module state_file in
if Sys.file_exists register_file then (
- Printf.printf "Warning: %s already exist.\n" register_file
+ Printf.eprintf " [sasa] Warning: %s already exist.\n%!" register_file
) else (
let oc = open_out register_file in
let entete = Mypervasives.entete2 "(*" "*)" SasaVersion.str SasaVersion.sha in
@@ -54,11 +54,11 @@ let (f: string list -> string * string -> unit) =
state_module state_module state_module ;
flush oc;
close_out oc;
- Printf.printf " [sasa] The file %s has been generated\n" register_file;
- flush stdout
+ Printf.eprintf " [sasa] The file %s has been generated\n" register_file;
+ flush stderr
);
if Sys.file_exists state_file then (
- Printf.printf " [sasa] Warning: %s already exist.\n" state_file
+ Printf.eprintf " [sasa] Warning: %s already exist.\n%!" state_file
) else (
let oc = open_out state_file in
let entete = Mypervasives.entete2 "(*" "*)" SasaVersion.str SasaVersion.sha in
@@ -70,6 +70,6 @@ let copy x = x
";
flush oc;
close_out oc;
- Printf.printf " [sasa] The file %s has been generated\n" state_file;
- flush stdout
+ Printf.eprintf " [sasa] The file %s has been generated\n" state_file;
+ flush stderr
)
diff --git a/lib/sasacore/main.ml b/lib/sasacore/main.ml
index 52fd5189..446f3831 100644
--- a/lib/sasacore/main.ml
+++ b/lib/sasacore/main.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 30/01/2020 (at 16:07) by Erwan Jahier> *)
+(* Time-stamp: <modified the 04/02/2020 (at 10:43) by Erwan Jahier> *)
open Register
@@ -203,9 +203,9 @@ let (make : bool -> string array -> 'v t) =
let algo_files = List.sort_uniq compare algo_files in
let ml_inputs = String.concat " " algo_files in
GenRegister.f algo_files (ml_state_file, ml_register_file);
- Printf.printf " [sasa] Hint: you may wish to generate %s out of %s with:\n"
+ Printf.eprintf " [sasa] Hint: you may wish to generate %s out of %s with:\n"
cmxs ml_register_file;
- Printf.printf " [sasa] ocamlfind ocamlopt -package algo -shared %s %s %s -o %s\n%!"
+ Printf.eprintf " [sasa] ocamlfind ocamlopt -package algo -shared %s %s %s -o %s\n%!"
ml_state_file ml_inputs ml_register_file cmxs;
exit 0
);
@@ -228,7 +228,7 @@ let (make : bool -> string array -> 'v t) =
if dynlink then (
(* Dynamically link the cmxs file (not possible from rdbg) *)
let cmxs = Dynlink.adapt_filename cmxs in
- if !Register.verbose_level > 0 then Printf.printf " [sasa] Loading %s...\n" cmxs;
+ if !Register.verbose_level > 0 then Printf.eprintf " [sasa] Loading %s...\n" cmxs;
Dynlink.loadfile_private cmxs;
) else ();
@@ -261,7 +261,7 @@ let (make : bool -> string array -> 'v t) =
let oc = open_out fn in
Printf.fprintf oc "%s%!" (GenLutin.f pl);
close_out oc;
- Printf.printf " [sasa] %s has been generated.\n%!" fn;
+ Printf.eprintf " [sasa] %s has been generated.\n%!" fn;
exit 0);
if args.gen_oracle then (
let fn = (Filename.remove_extension args.topo) ^ "_oracle.lus" in
@@ -271,7 +271,7 @@ let (make : bool -> string array -> 'v t) =
let oc = open_out fn in
Printf.fprintf oc "%s%!" (GenOracle.f g pl);
close_out oc;
- Printf.printf " [sasa] %s has been generated.\n%!" fn;
+ Printf.eprintf " [sasa] %s has been generated.\n%!" fn;
exit 0);
let seed = seed_get args in
if args.no_data_file then () else (
@@ -302,9 +302,9 @@ let (make : bool -> string array -> 'v t) =
args, pl_n, e
with
| Dynlink.Error e ->
- Printf.printf " [sasa] Error when dynlinking (Sasacore.make): %s\n%!"
+ Printf.eprintf " [sasa] Error when dynlinking (Sasacore.make): %s\n%!"
(Dynlink.error_message e);
exit 2
| e ->
- Printf.printf " [sasa] Error (Sasacore.make): %s\n%!" (Printexc.to_string e);
+ Printf.eprintf " [sasa] Error (Sasacore.make): %s\n%!" (Printexc.to_string e);
exit 2
diff --git a/lib/sasacore/register.ml b/lib/sasacore/register.ml
index 5b33bb4e..df1eb3d9 100644
--- a/lib/sasacore/register.ml
+++ b/lib/sasacore/register.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 17/10/2019 (at 21:08) by Erwan Jahier> *)
+(* Time-stamp: <modified the 04/02/2020 (at 10:45) by Erwan Jahier> *)
type 's neighbor = {
state: 's ;
@@ -84,14 +84,12 @@ exception Unregistred of string * string
let print_table lbl tbl =
let keys = Hashtbl.fold (fun k _ acc -> Printf.sprintf "%s,%s" k acc) tbl "" in
- if !verbose_level > 0 then Printf.printf "Defined keys for %s: %s\n" lbl keys;
- flush stdout
+ if !verbose_level > 0 then Printf.eprintf "Defined keys for %s: %s\n%!" lbl keys
let (reg_init_state : algo_id -> (int -> 's) -> unit) =
fun algo_id x ->
- if !verbose_level > 0 then Printf.printf "Registering %s init_vars\n" algo_id;
- flush stdout;
+ if !verbose_level > 0 then Printf.eprintf "Registering %s init_vars\n%!" algo_id;
Hashtbl.replace tbls.init_state algo_id (Obj.repr x)
@@ -104,8 +102,7 @@ let (get_init_state : algo_id -> int -> 's) =
let (reg_enable : algo_id -> 's enable_fun -> unit) = fun algo_id x ->
- if !verbose_level > 0 then Printf.printf "Registering %s enable\n" algo_id;
- flush stdout;
+ if !verbose_level > 0 then Printf.eprintf "Registering %s enable\n%!" algo_id;
Hashtbl.replace tbls.enable algo_id (Obj.repr x)
let (get_enable : algo_id -> 's enable_fun) = fun algo_id ->
try Obj.obj (Hashtbl.find tbls.enable algo_id)
@@ -114,8 +111,7 @@ let (get_enable : algo_id -> 's enable_fun) = fun algo_id ->
raise (Unregistred ("enable", algo_id))
let (reg_step : algo_id -> 's step_fun -> unit) = fun algo_id x ->
- if !verbose_level > 0 then Printf.printf "Registering %s step\n" algo_id;
- flush stdout;
+ if !verbose_level > 0 then Printf.eprintf "Registering %s step\n%!" algo_id;
Hashtbl.replace tbls.step algo_id (Obj.repr x)
let (get_step : algo_id -> 's step_fun) = fun algo_id ->
@@ -126,8 +122,7 @@ let (get_step : algo_id -> 's step_fun) = fun algo_id ->
let (reg_actions : algo_id -> action list -> unit) =
fun algo_id x ->
- if !verbose_level > 0 then Printf.printf "Registering %s actions\n" algo_id;
- flush stdout;
+ if !verbose_level > 0 then Printf.eprintf "Registering %s actions\n%!" algo_id;
Hashtbl.replace tbls.actions algo_id x
let (get_actions : algo_id -> action list) = fun algo_id ->
try Hashtbl.find tbls.actions algo_id
@@ -137,8 +132,7 @@ let (get_actions : algo_id -> action list) = fun algo_id ->
let (reg_value_to_string : ('s -> string) -> unit) =
fun f ->
- if !verbose_level > 0 then Printf.printf "Registering value_to_string\n";
- flush stdout;
+ if !verbose_level > 0 then Printf.eprintf "Registering value_to_string\n%!";
Hashtbl.replace tbls.value_to_string "_global" (Obj.repr f)
let (get_value_to_string : unit -> 's -> string) = fun () ->
try Obj.obj (Hashtbl.find tbls.value_to_string "_global")
@@ -148,8 +142,7 @@ let (get_value_to_string : unit -> 's -> string) = fun () ->
let (reg_value_of_string : (string -> 's) -> unit) =
fun f ->
- if !verbose_level > 0 then Printf.printf "Registering value_of_string\n";
- flush stdout;
+ if !verbose_level > 0 then Printf.eprintf "Registering value_of_string\n%!";
Hashtbl.replace tbls.value_of_string "_global" (Obj.repr f)
let (get_value_of_string : unit -> (string -> 's) option) = fun () ->
try Some (Obj.obj (Hashtbl.find tbls.value_of_string "_global"))
@@ -158,8 +151,7 @@ let (get_value_of_string : unit -> (string -> 's) option) = fun () ->
let (reg_copy_value : ('s -> 's) -> unit) =
fun f ->
- if !verbose_level > 0 then Printf.printf "Registering copy_value\n";
- flush stdout;
+ if !verbose_level > 0 then Printf.eprintf "Registering copy_value\n%!";
Hashtbl.replace tbls.copy_value "_global" (Obj.repr f)
let (get_copy_value : unit -> ('s -> 's)) = fun () ->
diff --git a/lib/sasacore/sasArg.ml b/lib/sasacore/sasArg.ml
index 8a9dd176..9187d1e0 100644
--- a/lib/sasacore/sasArg.ml
+++ b/lib/sasacore/sasArg.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 22/01/2020 (at 10:02) by Erwan Jahier> *)
+(* Time-stamp: <modified the 04/02/2020 (at 10:38) by Erwan Jahier> *)
type t = {
@@ -287,7 +287,7 @@ let parse argv = (
)
with
| Arg.Bad msg ->
- Printf.fprintf stderr "*** Error when calling '%s': %s\n%s\n" (argv.(0))
+ Printf.fprintf stderr " [sasa] Error when calling '%s': %s\n%s\n%!" (argv.(0))
(first_line msg) (usage_msg argv.(0)); exit 2;
| Arg.Help msg ->
Printf.fprintf stdout "%s\n%s\n" msg (usage_msg argv.(0));
diff --git a/src/sasaMain.ml b/src/sasaMain.ml
index 98a1a793..411ba1d5 100644
--- a/src/sasaMain.ml
+++ b/src/sasaMain.ml
@@ -80,7 +80,7 @@ let () =
let n = args.length in
simuloop n n args "" pl_n e
with
- | Failure msg -> Printf.printf "Error: %s\n" msg
+ | Failure msg -> Printf.eprintf " [sasa] Error: %s\n%!" msg
| Silent i ->
let str = if args.rif then "#" else "" in
Printf.eprintf "\n%sThis algo is silent after %i steps\n" str i ;
diff --git a/test/Makefile.inc b/test/Makefile.inc
index a72fa588..71ae2bb3 100644
--- a/test/Makefile.inc
+++ b/test/Makefile.inc
@@ -1,4 +1,4 @@
-# Time-stamp: <modified the 27/01/2020 (at 22:40) by Erwan Jahier>
+# Time-stamp: <modified the 05/02/2020 (at 14:37) by Erwan Jahier>
DIR=../../_build/install/default
@@ -30,6 +30,8 @@ LIB=-package algo
osage -Tpdf $*.dot -o $*.pdf
xpdf $*.pdf
+%.ocd: %.ml
+ rdbg -camldebug -sut "sasa $.dot" -l 1000
@@ -38,7 +40,7 @@ s:sim2chrogtk
genclean:
rm -f *.cmxs sasa *.cm* *.o *.pdf *.rif *.gp *.log *.dro *.seed *.c *.h sasa-*.dot
- rm -f rdbg-session*.ml luretteSession*.ml *.lut a.out *.cov
+ rm -f rdbg-session*.ml luretteSession* *.lut a.out *.cov read_dot.ml
rm -f *.exec *.sh
##################################################################################
-include Makefile.untracked
diff --git a/test/coloring/p.ml b/test/coloring/p.ml
index 7bc44e28..66a2df71 100644
--- a/test/coloring/p.ml
+++ b/test/coloring/p.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 04/12/2019 (at 17:17) by Erwan Jahier> *)
+(* Time-stamp: <modified the 06/02/2020 (at 11:05) by Erwan Jahier> *)
(* This is algo 3.1 in the book *)
@@ -44,7 +44,7 @@ let (free : 'v neighbor list -> 'v list) = fun nl ->
let (enable_f: 'v -> 'v neighbor list -> action list) =
fun e nl ->
- if (clash e nl) then ["conflict"] else []
+ if (clash e nl) then ["conflict"] else []
let (step_f : 'v -> 'v neighbor list -> action -> 'v) =
fun e nl a ->
diff --git a/test/unison/Makefile b/test/unison/Makefile
index 42c82551..98832e2f 100644
--- a/test/unison/Makefile
+++ b/test/unison/Makefile
@@ -1,4 +1,4 @@
-# Time-stamp: <modified the 23/10/2019 (at 15:40) by Erwan Jahier>
+# Time-stamp: <modified the 05/02/2020 (at 13:42) by Erwan Jahier>
test: test1 test2 lurette0 lurette1 rdbg_test
@@ -35,8 +35,7 @@ lurette1: ring.lut ring_oracle.lus
lurette: lurette0 s g
rdbg: ring.ml
- rdbg -o unison.rif \
- -sut "$(sasa) ring.dot -sd -rif" \
+ rdbg -o unison.rif -sut "$(sasa) ring.dot -sd -rif"
rdbg_test: ring.ml
echo "\nnr\nsd\n" | rdbg -o unison.rif \
--
GitLab