From 7770ced615bbfccc7fcb0c1deb5ed7dc29610015 Mon Sep 17 00:00:00 2001
From: Erwan Jahier <erwan.jahier@univ-grenoble-alpes.fr>
Date: Wed, 8 Jul 2020 15:14:11 +0200
Subject: [PATCH] Update: Call the fault function if provided when a legitimate
configuration is reached
nb: does not really work yet.
---
lib/algo/algo.mli | 4 +-
src/sasaMain.ml | 103 ++++++++++++++++++++++++++++---------------
test/unison/state.ml | 8 +++-
3 files changed, 78 insertions(+), 37 deletions(-)
diff --git a/lib/algo/algo.mli b/lib/algo/algo.mli
index 801bd0ba..aea01bbe 100644
--- a/lib/algo/algo.mli
+++ b/lib/algo/algo.mli
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 07/07/2020 (at 16:11) by Erwan Jahier> *)
+(* Time-stamp: <modified the 08/07/2020 (at 15:12) by Erwan Jahier> *)
(** {1 The Algorithm programming Interface.} *)
(**
{1 What's need to be provided by users.}
@@ -86,7 +86,9 @@ Useful to explore best/worst case daemons
type pid = string
type 's pf_info = { neighbors: 's neighbor list; curr: 's ; next: 's; action: action }
type 's potential_fun = pid list -> (pid -> 's pf_info) -> float
+(** *)
+
(** {1 Legitimate Configurations} *)
type 's legitimate_fun = pid list -> (pid -> 's * 's neighbor list) -> bool
(** By default, legitimate configurations (i.e., global states) are
diff --git a/src/sasaMain.ml b/src/sasaMain.ml
index 95ff58e6..e7e4ef9f 100644
--- a/src/sasaMain.ml
+++ b/src/sasaMain.ml
@@ -59,47 +59,79 @@ let legitimate p_nl_l e =
if p.Process.pid = pid then Env.get e pid, nl else from_pid tail pid
in
ulf pidl (from_pid p_nl_l)
-
+
+
+let inject_fault ff p_nl e =
+ let update_nodes e (p,nl) =
+ let pid = p.Process.pid in
+ let v = Env.get e pid in
+ let v = ff (List.length nl) pid v in
+ Env.set e pid v
+ in
+ List.fold_left update_nodes e p_nl
+
+
let (simustep: int -> int -> SasArg.t -> string ->
- ('v Process.t * 'v Register.neighbor list) list -> 'v Env.t -> 'v Env.t * string) =
+ ('v Process.t * 'v Register.neighbor list) list -> 'v Env.t -> 'v Env.t * string) =
fun n i args activate_val p_nl e ->
- (* 1: Get enable processes *)
- let all, enab_ll = Sasacore.Main.get_enable_processes p_nl e in
- let pl = fst(List.split p_nl) in
- List.iter (List.iter (fun b -> if b then incr moves)) enab_ll;
-
+ (* 1: Get enable processes *)
+ let all, enab_ll = Sasacore.Main.get_enable_processes p_nl e in
+ let pl = fst(List.split p_nl) in
+ List.iter (List.iter (fun b -> if b then incr moves)) enab_ll;
+
+ let e =
if
not (args.rif) && List.for_all (fun b -> not b) (List.flatten enab_ll)
then (
- print_step n i args e pl activate_val enab_ll;
- incr rounds;
- raise (Silent (n-i+1))
+ match Register.get_fault () with
+ | None ->
+ print_step n i args e pl activate_val enab_ll;
+ incr rounds;
+ raise (Silent (n-i+1))
+ | Some ff ->
+ print_step n i args e pl activate_val enab_ll;
+ let str = if args.rif then "#" else "" in
+ Printf.eprintf "\n%sThis algo is silent after %i moves, %i steps, %i rounds.\n"
+ str !moves i !rounds;
+ Printf.eprintf "==> Inject a fault\n%!";
+ inject_fault ff p_nl e
) else if legitimate p_nl e then (
- print_step n i args e pl activate_val enab_ll;
- raise (Legitimate (n-i+1))
+ match Register.get_fault () with
+ | None ->
+ print_step n i args e pl activate_val enab_ll;
+ raise (Legitimate (n-i+1))
+ | Some ff ->
+ print_step n i args e pl activate_val enab_ll;
+ let str = if args.rif then "#" else "" in
+ Printf.eprintf
+ "\n%sThis algo Reached a legitimate configuration after %i moves, %i steps, %i rounds.\n"
+ str !moves i !rounds;
+ Printf.eprintf "==> Inject a fault\n%!";
+ inject_fault ff p_nl e
)
- else
-
- if args.daemon = Daemon.Custom then
- print_step n i args e pl activate_val enab_ll;
- (* 2: read the actions *)
- let get_action_value = RifRead.bool (args.verbose > 1) in
- let next_activate_val, pnal = Daemon.f args.dummy_input
- (args.verbose > 1) args.daemon pl e all enab_ll get_action_value
- in
- update_round next_activate_val enab_ll;
- let next_activate_val =
- String.concat " "
- (List.map
- (fun b -> if b then "t" else "f")
- (List.flatten next_activate_val)
- )
- in
- (* 3: Do the steps *)
- let ne = Sasacore.Step.f pnal e in
- if args.daemon <> Daemon.Custom then
- print_step n i args e pl next_activate_val enab_ll;
- ne, next_activate_val
+ else
+ e
+ in
+ if args.daemon = Daemon.Custom then
+ print_step n i args e pl activate_val enab_ll;
+ (* 2: read the actions *)
+ let get_action_value = RifRead.bool (args.verbose > 1) in
+ let next_activate_val, pnal = Daemon.f args.dummy_input
+ (args.verbose > 1) args.daemon pl e all enab_ll get_action_value
+ in
+ update_round next_activate_val enab_ll;
+ let next_activate_val =
+ String.concat " "
+ (List.map
+ (fun b -> if b then "t" else "f")
+ (List.flatten next_activate_val)
+ )
+ in
+ (* 3: Do the steps *)
+ let ne = Sasacore.Step.f pnal e in
+ if args.daemon <> Daemon.Custom then
+ print_step n i args e pl next_activate_val enab_ll;
+ ne, next_activate_val
let rec (simuloop: int -> int -> SasArg.t -> string ->
('v Process.t * 'v Register.neighbor list) list -> 'v Env.t -> unit) =
@@ -127,7 +159,8 @@ let () =
flush stdout
| Legitimate i ->
let str = if args.rif then "#" else "" in
- Printf.eprintf "\n%sThis algo Reached a legitimate configuration after %i moves, %i steps, %i rounds.\n"
+ Printf.eprintf
+ "\n%sThis algo Reached a legitimate configuration after %i moves, %i steps, %i rounds.\n"
str !moves i !rounds;
flush stderr;
flush stdout;
diff --git a/test/unison/state.ml b/test/unison/state.ml
index 2b1f745b..63168c90 100644
--- a/test/unison/state.ml
+++ b/test/unison/state.ml
@@ -5,7 +5,13 @@ let of_string = None
let copy x = x
let actions = ["g"]
let potential = None
-let fault = None
+
+
+let fault m _ e =
+ if Random.bool () then Random.int m else e
+
+
+let fault = Some fault
let legitimate pidl from_pid =
(* a legitimate configuration is reached when all states have the same values *)
--
GitLab