From 2bbd5df246919635f2e91738936adfe2740add99 Mon Sep 17 00:00:00 2001
From: Erwan Jahier <erwan.jahier@univ-grenoble-alpes.fr>
Date: Fri, 28 May 2021 09:19:41 +0200
Subject: [PATCH] Fix: in rdbg4sasa, round buttons and legitimate button now
work
---
lib/sasacore/daemon.ml | 4 +-
tools/rdbg4sasa/gtkgui.ml | 68 +++++++++++++++----------------
tools/rdbg4sasa/sasa-rdbg-cmds.ml | 16 ++++++--
3 files changed, 48 insertions(+), 40 deletions(-)
diff --git a/lib/sasacore/daemon.ml b/lib/sasacore/daemon.ml
index ffa1ebc1..fbc7298c 100644
--- a/lib/sasacore/daemon.ml
+++ b/lib/sasacore/daemon.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 07/05/2021 (at 16:43) by Erwan Jahier> *)
+(* Time-stamp: <modified the 27/05/2021 (at 09:06) by Erwan Jahier> *)
type t =
| Synchronous (* select all actions *)
@@ -147,7 +147,7 @@ let (f: bool -> bool -> t -> 'v Process.t list ->
bool list list * 'v pna list) =
fun dummy_input verbose_mode daemon pl neigbors_of_pid e all enab get_action_value ->
let nall = remove_empty_list all in
- if nall = [] then assert false (* failwith "Silent" *);
+ if nall = [] then failwith "Silent";
if daemon <> Custom && dummy_input then
ignore (RifRead.bool verbose_mode ((List.hd pl).pid) "");
match daemon with
diff --git a/tools/rdbg4sasa/gtkgui.ml b/tools/rdbg4sasa/gtkgui.ml
index 28ab05ee..5297f79b 100644
--- a/tools/rdbg4sasa/gtkgui.ml
+++ b/tools/rdbg4sasa/gtkgui.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 27/05/2021 (at 17:23) by Erwan Jahier> *)
+(* Time-stamp: <modified the 28/05/2021 (at 09:16) by Erwan Jahier> *)
#thread
#require "lablgtk3"
@@ -54,12 +54,6 @@ let rdbg_nodes_enabled e =
in
last::res
-(* The interesting event to start in not the first event *)
-let set_first_check_point e =
- e.save_state e.nb;
- RdbgStdLib.ckpt_list := [e]
-
-
type daemon_kind = Distributed | Synchronous | Central | LocCentral | ManualCentral | Manual
let daemon_kind = ref ManualCentral
@@ -208,7 +202,6 @@ let custom_daemon p gtext vbox step_button round_button legitimate_button =
if args.salut_mode then goto_hook_exit ();
goto_hook_call ();
blue_add gtext#buffer (str_of_sasa_event false !e);
- set_first_check_point !e;
d();
let nodes_enabled = rdbg_nodes_enabled !e in
@@ -561,21 +554,12 @@ let main () =
in
let round_button =
button ~use_mnemonic:true ~stock:`MEDIA_FORWARD ~packing:bbox#add ~label:"round" ()
- in
- let legitimate () =
- let legitimate_button = button ~use_mnemonic:true ~packing:bbox#add () in
- set_tooltip legitimate_button
- "Move FORWARD until a legitimate configuration is reached (silence by default)";
- let image = GMisc.image ~file:(libui_prefix^"/chut_small.svg") () in
- legitimate_button#set_image image#coerce;
- (* change_label legitimate_button "Silen_t"; *)
- ignore (legitimate_button#connect#clicked ~callback:
- (button_cb true (fun () -> legitimate(); goto_hook_call ())));
- legitimate_button#misc#hide(); (* indeed, in the defaut mode (manual central),
- it should be hided *)
- legitimate_button
- in
- let legitimate_button = legitimate () in
+ in
+ let legitimate_button = button ~use_mnemonic:true ~packing:bbox#add () in
+ set_tooltip legitimate_button
+ "Move FORWARD until a legitimate configuration is reached (silence by default)";
+ let image = GMisc.image ~file:(libui_prefix^"/chut_small.svg") () in
+ legitimate_button#set_image image#coerce;
let ze_step =
if custom_mode then
@@ -587,8 +571,20 @@ let main () =
ze_step();
d()
in
+ let rec legitimate_gui () =
+ ze_step();
+ if is_legitimate !e || is_silent !e then () else (legitimate_gui ())
+ in
+ (* change_label legitimate_button "Silen_t"; *)
+ ignore (legitimate_button#connect#clicked ~callback:
+ (button_cb true (fun () ->
+ if custom_mode then legitimate_gui() else legitimate ())
+ )
+ );
+ legitimate_button#misc#hide(); (* indeed, in the defaut mode (manual central),
+ it should be hided *)
let rec next_round_gui rn =
- ze_step(); (* il faut un step qui mette à jour la table des rondes. c'est pas le cas ? *)
+ ze_step();
if rn < !roundnb || is_silent !e then () else (next_round_gui rn)
in
@@ -600,9 +596,14 @@ let main () =
ignore (round_button#connect#clicked
~callback:(
button_cb true (fun () ->
- next_round_gui !roundnb;
- if custom_mode && !e.name <> "mv_hook" && !e.kind <> Call then
- goto_hook_call ()))
+ if custom_mode then (
+ next_round_gui !roundnb;
+ if custom_mode && !e.name <> "mv_hook" && !e.kind <> Call then
+ goto_hook_call ()
+ )
+ else
+ nr ()
+ ))
);
set_tooltip back_round_button "Move BACKWARD to the previous ROUND";
change_label back_round_button "Roun_d";
@@ -628,11 +629,10 @@ let main () =
butt
in
if args.oracles <> [] then (
- let oracle_button = make_button `OK "_Oracle" "Move FORWARD until an oracle is violated"
- (* let image = GMisc.image ~file:"../rdbg-utils/oracle_small.jpg" () in *)
- (* viol_button#set_image image#coerce; *)
- (button_cb_string
- (fun () -> let str = viol_string () in goto_hook_call (); d();str))
+ let oracle_button =
+ make_button `OK "_Oracle" "Move FORWARD until an oracle is violated"
+ (button_cb_string
+ (fun () -> let str = viol_string () in goto_hook_call (); d();str))
in
oracle_button#misc#hide(); (* indeed, in the defaut mode (manual central), it should be hided *)
oracle_button_ref := Some oracle_button
@@ -647,11 +647,10 @@ let main () =
r();
if args.salut_mode then
(* in this mode, the hook plays first to provide fake values to sasa
- but the hook does not need input at this first step
+ but the hook does not need input at this first step
*)
goto_hook_exit ();
goto_hook_call ();
- set_first_check_point !e;
d()))
in
let _ = make_button `REFRESH "_New Seed" "Restart from the beginning using a New Seed"
@@ -669,7 +668,6 @@ let main () =
*)
goto_hook_exit ();
goto_hook_call ();
- set_first_check_point !e;
d()))
in
let _ = make_button `MEDIA_PLAY "_Sim2chro" "Launch sim2chro on the generated data (so far)"
diff --git a/tools/rdbg4sasa/sasa-rdbg-cmds.ml b/tools/rdbg4sasa/sasa-rdbg-cmds.ml
index 5143bc6f..21a943d9 100644
--- a/tools/rdbg4sasa/sasa-rdbg-cmds.ml
+++ b/tools/rdbg4sasa/sasa-rdbg-cmds.ml
@@ -155,7 +155,12 @@ let pr () =
(* I need to overrides those *)
let u () = undo (); ignore (round !e);;
-let r () = r (); roundnb := 1; Hashtbl.clear roundtbl;ignore (round !e);;
+let r () =
+ r ();
+ roundnb := 1;
+ Hashtbl.clear roundtbl;
+ ckpt_list := [!e];
+ ignore (round !e);;
(**********************************************************************)
(* print_event tuning *)
@@ -284,7 +289,7 @@ let _ = add_doc_entry
"sasa" "sasa-rdbg-cmds.ml";
add_doc_entry
"is_silent" "RdbgEvent.t -> bool"
- "is the event correspond to a silent configuration? (i.e., no enable node)"
+ "does the event correspond to a silent configuration? (i.e., no enable node)"
"sasa" "sasa-rdbg-cmds.ml";;
let is_legitimate e =
@@ -294,9 +299,14 @@ let is_legitimate e =
let goto_legitimate e = next_cond e is_legitimate
let legitimate () = e:=goto_legitimate !e; !dot_view ();;
-let _ = add_doc_entry
+let _ =
+ add_doc_entry
"legitimate" "unit -> unit"
" Move forward until a legitimate configuration is reached (uses 'silence' by default)"
+ "sasa" "sasa-rdbg-cmds.ml";
+ add_doc_entry
+ "is_legitimate" "RdbgEvent.t -> bool"
+ "does the event correspond to a legitimate configuration?"
"sasa" "sasa-rdbg-cmds.ml";;
--
GitLab