Test: add to rdbg the capability to display dot graphs that keep only the parent edges.

Of course this is only useful for algo that compute some kind of trees (more
specifically, this only work if the state contains a variable named "par" !)

test/my-rdbg-tuning.ml

@@ -272,14 +272,25 @@ let man () = man();
 let p = Topology.read dotfile;;
 
 (* shortcuts for dot viewer *)
-let dot () = dot p dotfile !e;;
-let ne () = neato p dotfile !e;;
-let tw () = twopi p dotfile !e;;
-let ci () = circo p dotfile !e;;
-let fd () = fdp p dotfile !e;;
-let sf () = sfdp p dotfile !e;;
-let pa () = patchwork p dotfile !e;;
-let os () = osage p dotfile !e;;
+let d_par () = dot true p dotfile !e;;
+let dot_par () = dot true p dotfile !e;;
+let ne_par () = neato true p dotfile !e;;
+let tw_par () = twopi true p dotfile !e;;
+let ci_par () = circo true p dotfile !e;;
+let fd_par () = fdp true p dotfile !e;;
+let sf_par () = sfdp true p dotfile !e;;
+let pa_par () = patchwork true p dotfile !e;;
+let os_par () = osage true p dotfile !e;;
+
+let dot () = dot false p dotfile !e;;
+let ne () = neato false p dotfile !e;;
+let tw () = twopi false p dotfile !e;;
+let ci () = circo false p dotfile !e;;
+let fd () = fdp false p dotfile !e;;
+let sf () = sfdp false p dotfile !e;;
+let pa () = patchwork false p dotfile !e;;
+let os () = osage false p dotfile !e;;
+
 
 (* To be able to choose the different default dot viewer on a per  directory basis.
    To change the graph printer: 
@@ -410,6 +421,19 @@ let l () =
    sf: "^(RdbgMain.doc_msg "sf")^"
    pa: "^(RdbgMain.doc_msg "pa")^"
    os: "^(RdbgMain.doc_msg "os")^"
+   
+   nb: for algorithms that have a field named 'par', you can try 
+   of the following (which only draw the parent arcs) 
+ 
+   d_par: "^(RdbgMain.doc_msg "d")^" (parent arcs only)
+   ne_par: "^(RdbgMain.doc_msg "ne")^" (parent arcs only)
+   tw_par: "^(RdbgMain.doc_msg "tw")^" (parent arcs only)
+   ci_par: "^(RdbgMain.doc_msg "ci")^" (parent arcs only)
+   fd_par: "^(RdbgMain.doc_msg "fd")^" (parent arcs only)
+   sf_par: "^(RdbgMain.doc_msg "sf")^" (parent arcs only)
+   pa_par: "^(RdbgMain.doc_msg "pa")^" (parent arcs only)
+   os_par: "^(RdbgMain.doc_msg "os")^" (parent arcs only)
+
  + Moving commands [*]
    sd: "^(RdbgMain.doc_msg "sd")^"
    nd: "^(RdbgMain.doc_msg "nd")^"

test/rdbg-utils/dot.ml

@@ -99,8 +99,11 @@ let (get_parent_var_name: nodes list -> string) =
       vn
       *)
 
-(* Compute a dot from the content of e.data  *)
-let to_pdf engine par_var g f e =
+(* Compute  a dot from the  content of e.data. if  [only_parent], only
+   display the arcs of the parent, where the parent is an integer held
+   in a variable named "par". if no such variable exist in the current
+   algo, no edges are drawn.  *)
+let to_pdf engine par_var only_parent g f e =
   let nodes = g.nodes in
   let (pidl : process list) = get_processes e in
   let n = List.length pidl in
@@ -131,7 +134,7 @@ let to_pdf engine par_var g f e =
                     pid.vars
                 )
             in
-            if (n>200 || ln > 500) && enabled <> "" then
+            if (n>200 || ln > 5000) && enabled <> "" then
               Printf.sprintf " %s [shape=point]"  pid.name 
             else 
               Printf.sprintf " %s [%slabel=\"%s|{%s%s}\"] "
@@ -172,7 +175,10 @@ let to_pdf engine par_var g f e =
     Str.global_replace (Str.regexp "--") "->" trans_undir_str in
   let trans_str =
     (*     if trans_dir_str = "" then trans_undir_str else *)
-    Printf.sprintf "subgraph dir {\n\t%s} 
+    if only_parent then 
+        Printf.sprintf "subgraph dir {\n\t%s} " trans_dir_str 
+      else 
+      Printf.sprintf "subgraph dir {\n\t%s} 
 subgraph undir {\n\t edge [dir=none]\n%s} " trans_dir_str trans_undir_str
   in
   Printf.fprintf oc