T230: Add missing data access functions to the Reference_tree module with unit tests

4 files changed, 114 insertions, 0 deletions

diff --git a/src/reference_tree.ml b/src/reference_tree.ml
index 8b26449..29b4265 100644
--- a/src/reference_tree.ml
+++ b/src/reference_tree.ml
@@ -189,3 +189,32 @@ let is_hidden reftree path =
 let is_secret reftree path =
     let data = Vytree.get_data reftree path in
     data.secret
+
+let is_tag reftree path =
+    let data = Vytree.get_data reftree path in
+    match data.node_type with
+    | Tag -> true
+    | _ -> false
+
+let is_leaf reftree path = 
+    let data = Vytree.get_data reftree path in
+    match data.node_type with
+    | Leaf -> true
+    | _ -> false
+
+let is_valueless reftree path =
+    let data = Vytree.get_data reftree path in
+    data.valueless
+
+let get_keep_order reftree path =
+    let data = Vytree.get_data reftree path in
+    data.keep_order
+
+let get_owner reftree path =
+    let data = Vytree.get_data reftree path in
+    data.owner
+
+let get_help_string reftree path =
+    let data = Vytree.get_data reftree path in
+    data.help
+
diff --git a/src/reference_tree.mli b/src/reference_tree.mli
index 3bbfc4b..8b635d2 100644
--- a/src/reference_tree.mli
+++ b/src/reference_tree.mli
@@ -29,3 +29,15 @@ val is_multi : t -> string list -> bool
 val is_hidden : t -> string list -> bool
 
 val is_secret : t -> string list -> bool
+
+val is_tag : t -> string list -> bool
+
+val is_leaf : t -> string list -> bool
+
+val is_valueless : t -> string list -> bool
+
+val get_keep_order : t -> string list -> bool
+
+val get_owner : t -> string list -> string option
+
+val get_help_string : t -> string list -> string
diff --git a/test/data/interface_definition_sample.xml b/test/data/interface_definition_sample.xml
index 6a4f201..c6185c0 100644
--- a/test/data/interface_definition_sample.xml
+++ b/test/data/interface_definition_sample.xml
@@ -5,6 +5,7 @@
       <node name="login" owner="login">
         <children>
           <tagNode name="user">
+            <keepChildOrder/>
             <properties>
               <help>User name</help>
               <constraint>
diff --git a/test/reference_tree_test.ml b/test/reference_tree_test.ml
index 078fc00..703c0b1 100644
--- a/test/reference_tree_test.ml
+++ b/test/reference_tree_test.ml
@@ -91,6 +91,66 @@ let test_is_hidden_invalid test_ctxt =
     let r = load_from_xml r (in_testdata_dir test_ctxt ["interface_definition_sample.xml"]) in
     assert_equal (is_hidden r ["system"; "login"; "user"; "full-name"]) false
 
+let test_is_tag_valid test_ctxt =
+    let r = Vytree.make default_data "root" in
+    let r = load_from_xml r (in_testdata_dir test_ctxt ["interface_definition_sample.xml"]) in
+    assert_equal (is_tag r ["system"; "login"; "user"]) true
+
+let test_is_tag_invalid test_ctxt =
+    let r = Vytree.make default_data "root" in
+    let r = load_from_xml r (in_testdata_dir test_ctxt ["interface_definition_sample.xml"]) in
+    assert_equal (is_tag r ["system"; "login"]) false
+
+let test_is_leaf_valid test_ctxt =
+    let r = Vytree.make default_data "root" in
+    let r = load_from_xml r (in_testdata_dir test_ctxt ["interface_definition_sample.xml"]) in
+    assert_equal (is_leaf r ["system"; "login"; "user"; "full-name"]) true
+
+let test_is_leaf_invalid test_ctxt =
+    let r = Vytree.make default_data "root" in
+    let r = load_from_xml r (in_testdata_dir test_ctxt ["interface_definition_sample.xml"]) in
+    assert_equal (is_leaf r ["system"; "login"; "user"]) false
+
+let test_is_valueless_valid test_ctxt =
+    let r = Vytree.make default_data "root" in
+    let r = load_from_xml r (in_testdata_dir test_ctxt ["interface_definition_sample.xml"]) in
+    assert_equal (is_valueless r ["system"; "options"; "reboot-on-panic"]) true
+
+let test_is_valueless_invalid test_ctxt =
+    let r = Vytree.make default_data "root" in
+    let r = load_from_xml r (in_testdata_dir test_ctxt ["interface_definition_sample.xml"]) in
+    assert_equal (is_valueless r ["system"; "login"; "user"; "full-name"]) false
+
+let test_get_keep_order_valid test_ctxt =
+    let r = Vytree.make default_data "root" in
+    let r = load_from_xml r (in_testdata_dir test_ctxt ["interface_definition_sample.xml"]) in
+    assert_equal (get_keep_order r ["system"; "login"; "user"]) true
+
+let test_get_keep_order_invalid test_ctxt =
+    let r = Vytree.make default_data "root" in
+    let r = load_from_xml r (in_testdata_dir test_ctxt ["interface_definition_sample.xml"]) in
+    assert_equal (get_keep_order r ["system"; "login"; "user"; "full-name"]) false
+
+let test_get_owner_valid test_ctxt =
+    let r = Vytree.make default_data "root" in
+    let r = load_from_xml r (in_testdata_dir test_ctxt ["interface_definition_sample.xml"]) in
+    assert_equal (get_owner r ["system"; "login"]) (Some "login")
+
+let test_get_owner_invalid test_ctxt =
+    let r = Vytree.make default_data "root" in
+    let r = load_from_xml r (in_testdata_dir test_ctxt ["interface_definition_sample.xml"]) in
+    assert_equal (get_owner r ["system"; "login"; "user"]) None
+
+let test_get_help_string_valid test_ctxt =
+    let r = Vytree.make default_data "root" in
+    let r = load_from_xml r (in_testdata_dir test_ctxt ["interface_definition_sample.xml"]) in
+    assert_equal (get_help_string r ["system"; "login"; "user"; "full-name"]) ("User full name")
+
+let test_get_help_string_default test_ctxt =
+    let r = Vytree.make default_data "root" in
+    let r = load_from_xml r (in_testdata_dir test_ctxt ["interface_definition_sample.xml"]) in
+    assert_equal (get_help_string r ["system"; "host-name"]) ("No help available")
+
 let suite =
     "Util tests" >::: [
         "test_load_valid_definition" >:: test_load_valid_definition;
@@ -109,6 +169,18 @@ let suite =
         "test_is_secret_invalid" >:: test_is_secret_invalid;
         "test_is_hidden_valid" >:: test_is_hidden_valid; 
         "test_is_hidden_invalid" >:: test_is_hidden_invalid;
+        "test_is_tag_valid" >:: test_is_tag_valid;
+        "test_is_tag_invalid" >:: test_is_tag_invalid;
+        "test_is_leaf_valid" >:: test_is_leaf_valid;
+        "test_is_leaf_invalid" >:: test_is_leaf_valid;
+        "test_is_valueless_valid" >:: test_is_valueless_valid;
+        "test_is_valueless_invalid" >:: test_is_valueless_valid;
+        "test_get_keep_order_valid" >:: test_get_keep_order_valid; 
+        "test_get_keep_order_invalid" >:: test_get_keep_order_invalid;
+        "test_get_owner_valid" >:: test_get_owner_valid;
+        "test_get_owner_invalid" >:: test_get_owner_invalid;
+        "test_get_help_string_valid" >:: test_get_help_string_valid;
+        "test_get_help_string_default" >:: test_get_help_string_default;
     ]
 
 let () =