Update: Call the fault function if provided when a legitimate configuration is reached

nb: does not really work yet.

lib/algo/algo.mli

-(* 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

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;

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