Fixed bug in collect_tags (Tree.ml)

Tag Table was wrong (following copied in descendant tags too)

git-svn-id: svn+ssh://idea.nguyen.vg/svn/sxsi/trunk/xpathcomp@409 3cdefd35-fc62-479d-8e8d-bae585ffb9ca

diff --git a/ata.ml b/ata.ml
index eb4f394..90458a3 100644 (file)
--- a/ata.ml
+++ b/ata.ml
@@ -382,7 +382,7 @@ let tags_of_state a q =
     module type ResultSet = 
     sig
       type t
-      type elt = [` Tree] Tree.node
+      type elt = [` Tree ] Tree.node
       val empty : t
       val cons : elt -> t -> t
       val concat : t -> t -> t

diff --git a/html_trace.ml b/html_trace.ml
index 333682c..bcd086e 100644 (file)
--- a/html_trace.ml
+++ b/html_trace.ml
@@ -230,7 +230,7 @@ let output_trace a tree file results =
          );
          pr_str "%s" "\nTriggered transitions:\n";
          pr_str "%s" "<table><tr valign=\"top\">";
-         List.iter (fun fl ->
+         Formlistlist.iter (fun fl ->
                       pr_str "%s" "<td>";Formlist.print strf fl;pr_str "</td>";
                       max_tt := max !max_tt (Formlist.length fl);
                    ) trans;

diff --git a/tests/test.xml b/tests/test.xml
index a9c7a55..8f0e255 100644 (file)
--- a/tests/test.xml
+++ b/tests/test.xml
@@ -1,10 +1,6 @@
 <?xml version="1.0"?>
 <a>
-  <d><a><b>foo</b></a></d>
-  <d><a><b>foo</b></a></d>
-  <d><a><b>foo</b></a></d>
-  <d><a><b>foo</b></a></d>
-  <d><a><b>foo</b></a></d>
-  <d><b>foo</b></d>
+  <b><c/><d/></b>
+  <e><f/><g/></e>
 </a>
   

diff --git a/tree.ml b/tree.ml
index a1ddcac..0a31e83 100644 (file)
--- a/tree.ml
+++ b/tree.ml
@@ -178,24 +178,28 @@ let collect_tags tree =
       Hashtbl.replace h t 
        (pt_cup sc schild,pt_cup sbelow sb, pt_cup ssibling ss, pt_cup safter sa)
   in
-  let rec loop_right id acc_sibling acc_after= 
+  let rec loop_right id acc_after = 
     if  id == nil
-    then (acc_sibling,acc_after)
+    then Ptset.Int.empty,Ptset.Int.empty,acc_after
     else
-      let sibling2,after2 = loop_right (tree_next_sibling tree id) acc_sibling acc_after in
-      let child1,below1   = loop_left (tree_first_child tree id) after2  in
-      let tag = tree_tag_id tree id in
-       update tag child1 below1 sibling2 after2;
-       (pt_add tag sibling2, (pt_add tag (pt_cup after2 below1)))
+    let sibling2,desc2,after2 = loop_right (tree_next_sibling tree id) acc_after in
+    let child1,desc1,after1   = loop_left (tree_first_child tree id) after2  in
+    let tag = tree_tag_id tree id in
+    update tag child1 desc1 sibling2 after2;
+    ( pt_add tag sibling2, 
+      pt_add tag (pt_cup desc1 desc2),
+      pt_cup after1 (pt_cup desc1 desc2) )
   and loop_left id acc_after = 
-    if id == nil 
-    then (Ptset.Int.empty,Ptset.Int.empty)
+    if  id == nil
+    then Ptset.Int.empty,Ptset.Int.empty,acc_after
     else
-      let sibling2,after2 = loop_right (tree_next_sibling tree id) Ptset.Int.empty acc_after in
-      let child1,below1 = loop_left (tree_first_child tree id) after2 in
-      let tag = tree_tag_id tree id in
-       update tag child1 below1 sibling2 after2;
-       (pt_add tag sibling2,(pt_add tag (pt_cup after2 below1)))      
+    let sibling2,desc2,after2 = loop_right (tree_next_sibling tree id) acc_after in
+    let child1,desc1,after1   = loop_left (tree_first_child tree id) after2  in
+    let tag = tree_tag_id tree id in
+    update tag child1 desc1 sibling2 after2;
+    (pt_add tag sibling2, 
+     pt_add tag (pt_cup desc1 desc2),
+     acc_after )
   in
   let _ = loop_left (tree_root tree) Ptset.Int.empty in h
                          
@@ -288,7 +292,21 @@ let is_root t = t == root
 let node_of_t t  =
   let _ = Tag.init (Obj.magic t) in
   let table = collect_tags t 
+  in (*
+  let _ = Hashtbl.iter (fun t (c,d,ns,f) ->
+                         Printf.eprintf "Tag %s has:\n" (Tag.to_string t);
+                         Printf.eprintf "Child tags: ";
+                         Ptset.Int.iter (fun t -> Printf.eprintf "%s "(Tag.to_string t)) c;
+                         Printf.eprintf "\nDescendant tags: ";
+                         Ptset.Int.iter (fun t -> Printf.eprintf "%s "(Tag.to_string t)) d;
+                         Printf.eprintf "\nNextSibling tags: ";
+                         Ptset.Int.iter (fun t -> Printf.eprintf "%s "(Tag.to_string t)) ns;
+                         Printf.eprintf "\nFollowing tags: ";
+                         Ptset.Int.iter (fun t -> Printf.eprintf "%s "(Tag.to_string t)) f;
+                         Printf.eprintf "\n\n%!";) table
   in
+                         
+     *)                          
     { doc= t; 
       ttable = table;
     }
@@ -310,7 +328,7 @@ let parse_xml_string str =  parse parse_xml_string str
 external pool : tree -> Tag.pool = "%identity"
 
 let magic_string = "SXSI_INDEX"
-let version_string = "1"
+let version_string = "2"
 
 let pos fd =
   Unix.lseek fd 0  Unix.SEEK_CUR