test: add a few qtest tests

Makefile

 
 
 build: lib/sasacore/sasaVersion.ml
-	dune build  @install
+	dune build  @install @runtest
 
 install:
 	dune install

Makefile.sasa

 
 
-build: lib/sasacore/sasaVersion.ml
-	dune build  @install
-
 
 .PHONY:test
 test:

lib/qtest/dune

+;;; the qtest documentatiopn wrt its use of dune is helpless
+;; this file is my solution to do it by hand
+
+(rule
+ (targets run_qtest.ml)
+  (deps (source_tree ../sasacore))
+  ; here is where you need to tell qtest what files to consider
+
+  (action
+   (run qtest --preamble "open Sasacore\nopen Daemon\nopen Enumerate"
+	extract ../sasacore/daemon.ml ../sasacore/enumerate.ml -o %{targets})
+   )
+
+  )
+
+(executable
+  (name run_qtest)
+  (modules run_qtest)
+  ; disable some warnings in qtests
+  (flags :standard -warn-error -a -w -33-35-27-39)
+  (libraries qcheck  dynlink ocamlgraph lutils sasacore algo)
+
+;   (action  (run %{target}))
+  )
+
+(rule
+ (alias runtest)
+ (action
+  (run ./run_qtest.exe)))

lib/sasacore/daemon.ml

-(* Time-stamp: <modified the 21/10/2021 (at 14:17) by Erwan Jahier> *)
+(* Time-stamp: <modified the 25/01/2023 (at 16:47) by Erwan Jahier> *)
 
-(* Enabled processes (with its enabling action + neighbors) *)           
+(* Enabled processes (with its enabling action + neighbors) *)
 type 'v pna = 'v Process.t * 'v Register.neighbor list * Register.action
 type 'v enabled = 'v pna list list
 type 'v triggered = 'v pna list
@@ -16,14 +16,14 @@ let (random_list2 : 'a list -> 'a * 'a list) = fun l ->
   assert (l <> []);
   let rec split acc i = function
     | [] -> assert false (* sno *)
-    | x::l -> 
+    | x::l ->
       if i=0 then x, List.rev_append acc l else split (x::acc) (i-1) l
   in
   let i = Random.int (List.length l) in
   split [] i l
 
 let (central: 'a list list -> 'a list) =
-  fun all -> 
+  fun all ->
     if all = [] then [] else
       let al = List.map random_list all in
       let a = random_list al in
@@ -36,13 +36,13 @@ let rec (distributed: 'a list list -> 'a list) =
       let al = List.map random_list all in
       let al = List.filter (fun _ -> Random.bool ()) al in
       if al = [] then distributed all else al
-   
+
 let (synchrone: 'a list list -> 'a list) = fun all ->
   if all = [] then [] else
   let al = List.map random_list all in
   al
 
-(* LC= 2 neighbors cannot be activated at the same step 
+(* LC= 2 neighbors cannot be activated at the same step
 
 XXX this daemon is not fair: it is biased by the degree of nodes.
 *)
@@ -94,11 +94,15 @@ let rec map3 f l1 l2 l3 =
   | ([], _, _) -> invalid_arg "map3 (1st arg too short)"
   | (_, [], _) -> invalid_arg "map3 (2nd arg too short)"
   | (_, _, []) -> invalid_arg "map3 (3rd arg too short)"
-  
+
+(*$T map3
+  map3 (fun x y z -> x-y+z) [1;2;3] [1;2;3] [1;2;3] = [1;2;3]
+  map3 (fun x y z -> x-y+z) [] [] [] = []
+*)
 
 let (custom: 'v enabled -> 'v Process.t list -> bool list list ->
      (string -> string -> bool) -> bool list list * 'v triggered) =
-  fun pnall pl enab_ll get_action_value -> 
+  fun pnall pl enab_ll get_action_value ->
     let f p pnal enab_l =
       let actions = p.Process.actions in
       let trigger_l = List.map (get_action_value p.Process.pid) actions in
@@ -107,12 +111,12 @@ let (custom: 'v enabled -> 'v Process.t list -> bool list list ->
           (fun trig enab a ->
              let acti = trig && enab in
              acti, if acti
-             then List.filter (fun (_,_,a') -> a=a') pnal 
+             then List.filter (fun (_,_,a') -> a=a') pnal
              else []
           ) trigger_l enab_l actions
       in
       acti_l_al
-    in    
+    in
     let acti_l_all = map3 f pl pnall enab_ll in
     let acti_l_al = List.flatten acti_l_all in
     let al = snd (List.split acti_l_al) in
@@ -131,7 +135,7 @@ let (get_activate_val: 'v triggered -> 'v Process.t list -> bool list list)=
       List.map (fun p -> List.map (fun a -> p,a) p.Process.actions) pl
     in
     let al = List.map (fun (p,_,a) -> p,a) al in
-    List.map  (List.map (fun a -> List.mem a al)) actions 
+    List.map  (List.map (fun a -> List.mem a al)) actions
 
 let (f: bool -> bool -> DaemonType.t -> 'v Process.t list ->
      ('v SimuState.t -> string -> 'v * ('v Register.neighbor * string) list) ->

lib/sasacore/daemon.mli

-(* Time-stamp: <modified the 15/10/2021 (at 11:04) by Erwan Jahier> *)
+(* Time-stamp: <modified the 25/01/2023 (at 16:07) by Erwan Jahier> *)
 
 type 'v pna = 'v Process.t * 'v Register.neighbor list * Register.action
 type 'v enabled = 'v pna list list
 type 'v triggered = 'v pna list
-            
+
 (** f dummy_input_flag verbose_mode daemon p_nl_l actions_ll enab
 
 inputs:
-- dummy_input_flag: true when used with --ignore-first-inputs 
+- dummy_input_flag: true when used with --ignore-first-inputs
 - verbose_mode: true when the verbose level is > 0
-- daemon: 
+- daemon:
 - p_nl_l: list of all processes, and their neighbors
-- actions_ll: list of list of existing actions 
+- actions_ll: list of list of existing actions
 - enab: list of list saying which actions are enabled
 
     At the inner list level, exactly one action ought to be chosen. At the
@@ -31,7 +31,7 @@ nb: it is possible that we read on stdin that an action should be
 *)
 
 type 'v step = 'v triggered -> 'v SimuState.t -> 'v SimuState.t
-            
+
 val f : bool -> bool -> DaemonType.t -> 'v Process.t list ->
   ('v SimuState.t -> string -> 'v * ('v Register.neighbor * string) list) ->
   'v SimuState.t -> 'v enabled -> bool list list ->
@@ -45,3 +45,4 @@ val distributed: 'a list list -> 'a list
 
 (* pid + its neighbors in input *)
 val locally_central: ('v * 'v list) list list -> 'v list
+val map3 : ('a -> 'b -> 'c -> 'd) -> 'a list -> 'b list -> 'c list  -> 'd list

lib/sasacore/dune

-;; Time-stamp: <modified the 05/10/2021 (at 09:59) by Erwan Jahier>
+;; Time-stamp: <modified the 26/01/2023 (at 16:42) by Erwan Jahier>
 
 (library
  (name     sasacore)
  (public_name  sasacore)
  (libraries dynlink ocamlgraph lutils psq functory)
  ; (flags -noassert)
-  ;; 
+  ;;
 ; (wrapped false)
+ ; (inline_tests (backend qtest.lib)) ;; does not work );
  (library_flags -linkall)
  (synopsis "The Sasa main files (shared by the sasa exec and the rdbg plugin)")
 )
 
+;; qtest does not work with dune anyway (would require 'wrapped false')
+;; cf ../qtest/dune for a workaround
 
 ; (modules_without_implementation algo)
 

lib/sasacore/enumerate.ml

 
 
-(* Enumerate all schedules using continuations *) 
+(* Enumerate all schedules using continuations *)
 type 'a cont = NoMore | Elt of 'a * (unit -> 'a cont)
 
 (* compose continuations *)
@@ -8,9 +8,9 @@ let rec (comp : 'a cont -> 'a cont -> 'a cont) =
   fun c1 c2 ->
   match c1 with
   | NoMore -> c2
-  | Elt(x, c1) -> Elt(x, fun () -> comp (c1()) c2) 
-                             
-(* Enumerate all possible schedules (with one action per process at most) 
+  | Elt(x, c1) -> Elt(x, fun () -> comp (c1()) c2)
+
+(* Enumerate all possible schedules (with one action per process at most)
    nb: it can be a lot!
 *)
 let (all : 'a list list -> 'a list cont) = fun all ->
@@ -25,7 +25,7 @@ let (all : 'a list list -> 'a list cont) = fun all ->
              let cont_a = f (a::acc) tl in
              comp cont_a cont_acc
            )
-           (f acc tl) 
+           (f acc tl)
            al
     in
     res
@@ -39,6 +39,7 @@ let (central : 'a list list -> 'a cont) = fun all ->
   List.fold_left (fun acc a -> Elt(a, fun () -> acc)) NoMore al
 
 
+
 let (all_list : 'a list list -> 'a list list) = fun ll ->
   let rec f acc c =
     match c with
@@ -47,8 +48,22 @@ let (all_list : 'a list list -> 'a list list) = fun ll ->
   in
   f [] (all ll)
 
+let sort_ll ll =
+  ll |> List.map (List.sort compare) |> List.sort compare
+
+(*$T all_list
+   sort_ll (all_list [ [1] ;[2]; [3]; [] ]) = sort_ll [ [1]; [2]; [3]; [1;2]; [1;3]; [2;3]; [1;2;3] ];
+   sort_ll (all_list [ [1;2]; [3]; [] ])    = sort_ll [ [1]; [2]; [3]; [1;3]; [2;3] ];
+ *)
+
 let (central_list : 'a list list -> 'a list list) = fun all ->
   let al = List.flatten all in
   List.map (fun x -> [x]) al
 
 
+let string_of_int_ll ll =
+  "[" ^ (String.concat "," (List.map (fun l -> "[" ^ (String.concat "," l ^ "]")) ll)) ^ "]"
+
+(*$T central_list
+    List.sort compare (central_list [ [1;2]; [3]; [4;5] ]) = [ [1]; [2]; [3]; [4]; [5] ];
+ *)

lib/sasacore/worstInit.ml

-(* Time-stamp: <modified the 28/11/2022 (at 17:41) by Erwan Jahier> *)
+(* Time-stamp: <modified the 25/01/2023 (at 15:24) by Erwan Jahier> *)
 
 open Register
 
@@ -70,23 +70,27 @@ let all_dim_succ d n =
     p.(j) <- mutate_value d p.(j)
   done;
   p
-    
-      
+
+
 let tf = float_of_int
 let ti = int_of_float
-    
+
 let (choose : int -> point -> (point -> point) -> point list) =
   fun n p heuristic ->
-  (*choose n successors of p using heuristic *)  
+  (*choose n successors of p using heuristic *)
   assert (n>=0);
   let rec f acc i = if i <= 0 then acc else f ((heuristic p)::acc)  (i-1) in
   f [] n
 
+(*$T choose
+  List.length (choose 10 [| F(10.), F(42.) |] (one_dim_succ Close)) = 10
+*)
+
 (*****************************************************************************)
 (* XXX a ranger ailleurs !!! *)
 
 open Process
-    
+
 let (point_to_ss : point -> 'v SimuState.t -> 'v SimuState.t) =
   fun point ss ->
   let (state_to_values, values_to_state :
@@ -110,8 +114,8 @@ let (point_to_ss : point -> 'v SimuState.t -> 'v SimuState.t) =
     in
     f l i j
   in
-  let new_config, _ = 
-    List.fold_left 
+  let new_config, _ =
+    List.fold_left
     (fun (e,j) p ->
        let value = make_value [] state_size (j*state_size) in
        let st = values_to_state value (Conf.get e p.pid) in
@@ -124,7 +128,7 @@ let (point_to_ss : point -> 'v SimuState.t -> 'v SimuState.t) =
   if debug then Printf.printf "point_to_ss  ok\n%!";
   { ss with config = new_config }
 
-    
+
 let (ss_to_point : 'v SimuState.t -> point) =
   fun ss ->
   let (state_to_values : ('v -> Register.value list) ) =
@@ -152,7 +156,7 @@ let (ss_to_point : 'v SimuState.t -> point) =
     ss.network;
   point
 (*****************************************************************************)
-    
+
 open LocalSearch
 
 
@@ -189,10 +193,10 @@ let (fchc : out_channel -> ('v SimuState.t -> int) -> 'v SimuState.t -> int
   let step_cpt = ref 1 in
   let cost p = run (point_to_ss p ss_init) in
   let pinit = ss_to_point ss_init in
-  let percent_done = ref 0 in  
+  let percent_done = ref 0 in
   Functory.Cores.set_number_of_cores ss_init.sasarg.cores_nb;
   let g =
-    { 
+    {
       init = ({ st = pinit ; d = 0 ; cost = cost pinit ; cpt = 0 }, Q.empty, ());
       succ = (fun n ->
           (* let beam_size = min 50 (max 1 (dmax / 10)) in *)
@@ -206,7 +210,7 @@ let (fchc : out_channel -> ('v SimuState.t -> int) -> 'v SimuState.t -> int
           let beam_size = max 50 ss_init.sasarg.cores_nb in
           let percent_close = ((tf !cpt) /. (tf dmax)) ** 2.0 in
           let percent_far = 1.0 -. percent_close in
-          
+
           let far_nb = max 1 (ti ((tf beam_size) *. percent_far) / 6) in
           let close_nb = max 1 (ti ((tf beam_size) *. percent_close) / 6) in
           incr step_cpt;
@@ -264,10 +268,10 @@ let (fchc : out_channel -> ('v SimuState.t -> int) -> 'v SimuState.t -> int
         | LocalSearch.NoMore ->
           (* occurs if all successors are cut *)
           run_more psol more
-        | LocalSearch.Stopped -> 
+        | LocalSearch.Stopped ->
           Printf.printf "\nThe worst initial configuration costs %d :" psol.cost;
           point_to_ss psol.st ss_init
-        | LocalSearch.Sol (nsol, more) ->          
+        | LocalSearch.Sol (nsol, more) ->
             if nsol.cost > psol.cost then (
               Printf.printf "Hey, I've found a conf of cost %d! (simu #%d, depth %d)\n%!"
                 nsol.cost nsol.cpt nsol.d;
@@ -276,8 +280,8 @@ let (fchc : out_channel -> ('v SimuState.t -> int) -> 'v SimuState.t -> int
               run_more psol more
             )
       )
-  
-  in  
+
+  in
   match LocalSearch.run g None with
   | LocalSearch.Stopped -> assert false (* SNO *)
   | LocalSearch.NoMore-> assert false (* SNO *)
@@ -329,5 +333,5 @@ let (global : out_channel -> ('v SimuState.t -> int) -> 'v SimuState.t -> int
         n_percent_done dmax
     );
     if cpt > dmax then ss_worst else loop (cpt+1) (ss_worst, worst)
-  in 
+  in
   loop 1 (ss_init, run ss_init)

sasa.opam

@@ -23,6 +23,7 @@ depends: [
   "conf-graphviz"
   "lutils"
   "psq"
+  "qtest"
   "functory"
   "ledit"
   "rdbg" { >= "1.200" }