Merge pull request #26 from jestabro/sagitta-backports-T6149-T6180

 T6149: T6180: combined backports for reference_tree bug resp. mask_tree function

5 files changed, 42 insertions, 1 deletions

diff --git a/src/config_diff.ml b/src/config_diff.ml
index 35a5b55..3529a5d 100644
--- a/src/config_diff.ml
+++ b/src/config_diff.ml
@@ -390,6 +390,35 @@ let show_diff ?(cmds=false) path left right =
         in
         strs
 
+let is_terminal_path node path =
+    try
+        let n = Vytree.get node path in
+        match (Vytree.children_of_node n) with
+        | [] -> true
+        | _ -> false
+    with Vytree.Nonexistent_path -> false
+
+(* mask function; mask applied on right *)
+let mask_func ?recurse:_ (path : string list) (Diff_tree res) (m : change) =
+    match m with
+    | Added -> Diff_tree (res)
+    | Subtracted ->
+            (match path with
+            | [_] -> Diff_tree {res with left = Vytree.delete res.left path}
+            |  _  -> if not (is_terminal_path res.right (list_but_last path)) then
+                         Diff_tree {res with left = Vytree.delete res.left path}
+                     else Diff_tree (res))
+    | Unchanged -> Diff_tree (res)
+    | Updated _ -> Diff_tree (res)
+
+(* call recursive diff with mask_func; mask applied on right *)
+let mask_tree left right =
+    let trees = make_diff_trees left right in
+    let d = diff [] mask_func trees (Option.some left, Option.some right)
+    in
+    let res = eval_result d in
+    res.left
+
 let union_of_values (n : Config_tree.t) (m : Config_tree.t) =
     let set_n = ValueS.of_list (data_of n).values in
     let set_m = ValueS.of_list (data_of m).values in
diff --git a/src/config_diff.mli b/src/config_diff.mli
index c995ba3..6adf5a7 100644
--- a/src/config_diff.mli
+++ b/src/config_diff.mli
@@ -37,3 +37,4 @@ exception Nonexistent_child
 val diff_tree : string list -> Config_tree.t -> Config_tree.t -> Config_tree.t
 val show_diff : ?cmds:bool -> string list -> Config_tree.t -> Config_tree.t -> string
 val tree_union : Config_tree.t -> Config_tree.t -> Config_tree.t
+val mask_tree : Config_tree.t -> Config_tree.t -> Config_tree.t
diff --git a/src/reference_tree.ml b/src/reference_tree.ml
index 302437e..7f6cc25 100644
--- a/src/reference_tree.ml
+++ b/src/reference_tree.ml
@@ -179,7 +179,12 @@ let rec insert_from_xml basepath reftree xml =
         let data = {data with node_type=node_type; owner=node_owner; default_value=default_value} in
         let name = Xml.attrib xml "name" in
         let path = basepath @ [name] in
-        let new_tree = Vytree.insert_maybe reftree path data in
+        let new_tree =
+            if data <> default_data then
+                Vytree.insert_or_update reftree path data
+            else
+                Vytree.insert_maybe reftree path data
+        in
         (match node_type with
         | Leaf -> new_tree
         | _ ->
diff --git a/src/vytree.ml b/src/vytree.ml
index ace587b..05b3088 100644
--- a/src/vytree.ml
+++ b/src/vytree.ml
@@ -167,6 +167,10 @@ let update node path data =
         replace node' child
     in do_with_child (update_data data) node path
 
+let insert_or_update ?(position=Default) node path data =
+    try insert ~position:position node path data
+    with Duplicate_child -> update node path data
+
 let rec get node path =
     match path with
     | [] -> raise Empty_path
diff --git a/src/vytree.mli b/src/vytree.mli
index a7bf680..412379a 100644
--- a/src/vytree.mli
+++ b/src/vytree.mli
@@ -25,6 +25,8 @@ val insert : ?position:position -> ?children:('a t list) -> 'a t -> string list
 
 val insert_maybe : ?position:position -> 'a t -> string list -> 'a -> 'a t
 
+val insert_or_update : ?position:position -> 'a t -> string list -> 'a -> 'a t
+
 val insert_multi_level : 'a -> 'a t -> string list -> string list -> 'a -> 'a t
 
 val merge_children : ('a -> 'a -> 'a) -> (string -> string -> int) -> 'a t -> 'a t