Added test program

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

diff --git a/Makefile b/Makefile
index 7354e47..8ecd5d8 100644 (file)
--- a/Makefile
+++ b/Makefile
@@ -88,6 +88,11 @@ main: libcamlshredder.a  $(MLOBJS)
        $(HIDE) $(OCAMLFIND) $(LINK) -o main -package "$(OCAMLPACKAGES)" $(SYNTAX) -cclib \
        "$(LIBS) ./libcamlshredder.a"  $(MLOBJS)
 
+sxsi_test: libcamlshredder.a uid.cmx custom.cmx hcons.cmx ptset.cmx finiteCofinite.cmx tag.cmx tagSet.cmx options.cmx tree.cmx
+       @echo [LINK] $@ 
+       $(HIDE) $(OCAMLFIND) $(LINK) -o sxsi_test -package "$(OCAMLPACKAGES)" $(SYNTAX) -cclib \
+       "$(LIBS) ./libcamlshredder.a"  uid.cmx custom.cmx hcons.cmx ptset.cmx finiteCofinite.cmx tag.cmx tagSet.cmx options.cmx tree.cmx sxsi_test.ml
+
 unit_test: libcamlshredder.a  $(BASEOBJS) unit_test.cmx
        @echo [LINK] $@ 
        $(HIDE) $(OCAMLFIND) $(LINK) -o unit_test -package "$(OCAMLPACKAGES)" $(SYNTAX) -cclib \
@@ -126,7 +131,7 @@ libcamlshredder.a: $(CXXOBJECTS) XMLTree/XMLTree.a
 
 clean:
        @echo [CLEAN]
-       $(HIDE) rm -f *~ *.cm* *.[oa] *.so main *.s
+       $(HIDE) rm -f *~ *.cm* *.[oa] *.so main *.s sxsi_test
        $(HIDE) rm -rf .libs
 
 

diff --git a/OCamlDriver.cpp b/OCamlDriver.cpp
index a5e47f8..0e3af12 100644 (file)
--- a/OCamlDriver.cpp
+++ b/OCamlDriver.cpp
@@ -786,7 +786,7 @@ extern "C" value caml_benchmark_jump(value tree,value tag){
   treeNode root = XMLTREE(tree)->FirstChild(0);
   root = XMLTREE(tree)->FirstChild(root);
   count = iterjump(XMLTREE(tree), root , Int_val(tag),0);
-  return Val_unit;
+  return Val_int(count);
 }
 
 int iterfcns(XMLTree* tree, treeNode node){

diff --git a/main.ml b/main.ml
index c9fc2c5..9ce75ba 100644 (file)
--- a/main.ml
+++ b/main.ml
@@ -79,7 +79,8 @@ let test_text doc =
   ()
 
 type pointers
-external build_pointers : Tree.t -> pointers = "caml_build_pointers"
+type order = PREORDER | INORDER | POSTORDER
+external build_pointers : Tree.t -> order -> pointers = "caml_build_pointers"
 external iter_pointers : pointers -> int = "caml_iter_pointers"
 external free_pointers : pointers -> unit = "caml_free_pointers"
 
@@ -97,19 +98,48 @@ let main v query_string output =
       let _ = Printf.eprintf "Number of nodes %i\n%!" (Tree.size v) in
 (*      let _ = test_text v in *)
 (*      let _ = Tree.stats v in *)
-      let _ = Printf.eprintf "Timing first_child/next_sibling %!" in
+      let _ = Printf.eprintf "\nTiming first_child/next_sibling on sxsi %!" in
       let c = time (Tree.benchmark_fcns)  v in
       let _ = Printf.eprintf "Traversed %i nodes\n" c in
-      let _ = Printf.eprintf "Timing last_child/prev_sibling %!" in
+      let _ = Printf.eprintf "\nTiming first_element/next_element on sxsi %!" in
+      let c = time (Tree.benchmark_fene)  v in
+      let _ = Printf.eprintf "Traversed %i nodes\n" c in
+      let _ = Printf.eprintf "\nTiming last_child/prev_sibling on sxsi %!" in
       let _ = time (Tree.benchmark_lcps)  v in
-      let _ = Printf.eprintf "Timing jump to a %!" in
-      let _ = time (Tree.benchmark_jump v) (Tag.tag "a")  in
-      let _ = Printf.eprintf "Timing pointer allocation %!" in
-      let pointers = time (build_pointers) v  in
-      let _ = Printf.eprintf "Timing pointer iteration %!" in
+      let tag = "keyword" in
+      let _ = Printf.eprintf "\nTiming jump to <%s> on sxsi %!" tag in
+      let _ = time (Tree.benchmark_jump v) (Tag.tag tag)  in
+  (*    let _ = Printf.eprintf "\nTiming pointer allocation (preorder) %!" in
+      let pointers = time (build_pointers v) PREORDER  in
+      let _ = Printf.eprintf "\nTiming pointer iteration %!" in
+      let i = time (iter_pointers) pointers  in
+      let _ = Printf.eprintf "Traversed %i pointers\nTiming pointer deallocation %!" i in
+      let _  = time (free_pointers) pointers  in
+
+
+      let _ = Printf.eprintf "\nTiming pointer allocation (inorder) %!" in
+      let pointers = time (build_pointers v) INORDER  in
+      let _ = Printf.eprintf "\nTiming pointer iteration %!" in
       let i = time (iter_pointers) pointers  in
-      let _ = Printf.eprintf "Traversed %i pointers\n\nTiming pointer deallocation %!" i in
+      let _ = Printf.eprintf "Traversed %i pointers\nTiming pointer deallocation %!" i in
       let _  = time (free_pointers) pointers  in
+
+      let _ = Printf.eprintf "\nTiming pointer allocation (postorder) %!" in
+      let pointers = time (build_pointers v) POSTORDER  in
+      let _ = Printf.eprintf "\nTiming pointer iteration %!" in
+      let i = time (iter_pointers) pointers  in
+      let _ = Printf.eprintf "Traversed %i pointers\nTiming pointer deallocation %!" i in
+      let _  = time (free_pointers) pointers  in *)
+
+      let _ = Printf.eprintf "\nTiming iterative_traversal on sxsi %!" in
+      let c = time (Tree.benchmark_iter)  v in
+      let _ = Printf.eprintf "Traversed %i nodes\n" c in
+
+
+
+
+
+
 (*      let _ = Printf.eprintf "Timing //keyword :" in
       let r = time (test_loop v) (Tag.tag "keyword") in
       let _ = Printf.eprintf "Count is %i\n%!" r in

diff --git a/options.ml b/options.ml
index fdfc867..ad1541b 100644 (file)
--- a/options.ml
+++ b/options.ml
@@ -38,7 +38,5 @@ let parse_cmdline() =
     if (!pos > 3 || !pos < 2)
     then begin Arg.usage spec usage_msg; exit 1 end
 
-      
-            
 
   

diff --git a/sxsi_test.ml b/sxsi_test.ml
new file mode 100644 (file)
index 0000000..6e85278
--- /dev/null
+++ b/sxsi_test.ml
@@ -0,0 +1,134 @@
+let time f a msg =
+  let t0 = Unix.gettimeofday () in
+  let r = f a in
+  let t1 = Unix.gettimeofday () in
+    Printf.printf "Timing %s: %f ms\n" msg ((t1 -. t0) *. 1000.);
+    r
+
+
+
+type pointers
+type allocation_order = PREORDER | INORDER | POSTORDER
+external build_pointers : Tree.t -> allocation_order -> pointers = "caml_build_pointers"
+external iter_pointers : pointers -> int = "caml_iter_pointers"
+external free_pointers : pointers -> unit = "caml_free_pointers"
+
+let string_of_alloc =
+  function
+      PREORDER -> "preorder"
+    | INORDER -> "inorder"
+    | POSTORDER -> "postorder"
+
+
+let test_pointers alloc v =
+  let size = Tree.subtree_size v Tree.root in
+    if ((size * (Sys.word_size/8)*2) / (1024*1024)) >= 2800
+    then Printf.printf "Not enough memory to allocate pointer with %i nodes\n%!" size
+    else begin
+      let msg1 = Printf.sprintf "pointer structure %s allocation" (string_of_alloc alloc) in
+      let pointers = time (build_pointers v) alloc msg1 in
+      let i = time (iter_pointers) pointers "pointer structure full traversal" in
+       Printf.printf "Traversed %i nodes\n" i;
+       time (free_pointers) pointers "pointer structure deallocation"
+    end
+;;
+
+let test_iterative v =
+  let i = time (Tree.benchmark_iter) v "iterative traversal (on sxsi)" in
+    Printf.printf "Traversed %i nodes\n%!" i
+
+let test_full_traversal v =
+  let i = time (Tree.benchmark_fcns) v "recursive traversal (on sxsi)" in
+    Printf.printf "Traversed %i nodes\n%!" i
+
+let test_full_elements v =
+  let i = time (Tree.benchmark_fene) v "recursive traversal of element nodes (on sxsi)" in
+    Printf.printf "Traversed %i nodes\n%!" i
+
+let test_tag_jump v t =
+  let msg = Printf.sprintf "jumping to tag <%s> (on sxsi)" (Tag.to_string t) in
+  let i = time (Tree.benchmark_jump v) t msg in
+    Printf.printf "Traversed %i nodes\n%!" i
+
+
+module Options =
+  struct
+    open Arg
+    let input_file = ref ""
+    let save_file = ref ""
+    let run_iterative = ref false
+    let run_full_sxsi = ref false
+    let run_elements = ref false
+    let run_pointers = ref []
+    let run_jump_tag = ref ""
+
+    let add_pointer t =
+      let tag = match t with
+       | "preorder" -> PREORDER
+       | "inorder" -> INORDER
+       | "postorder" -> POSTORDER
+       | _ -> raise (Bad (t))
+      in
+       if not (List.mem tag !run_pointers) then run_pointers := tag :: !run_pointers
+
+
+    let spec = align
+      [ "-s", Set_string save_file, "<output.srx> saves the index in file output.srx";
+       "-i", Set run_iterative, " runs the iterative full traversal (on sxsi)";
+       "-f", Set run_full_sxsi, " runs the recursive full traversal (on sxsi)";
+       "-e", Set run_elements, " simulates //* on sxsi";
+       "-p", Symbol ([ "preorder"; "inorder"; "postorder" ],
+                     add_pointer), "runs a full traveral over pointers with given allocation scheme";
+       "-t", Set_string run_jump_tag, "<tag> simulates //tag on sxsi" ]
+
+    let usage_msg = Printf.sprintf "%s [options] <input.{xml|srx}>" Sys.argv.(0)
+    let parse () = parse spec (fun s -> input_file := s) usage_msg
+    let usage () = usage spec usage_msg
+  end
+
+let fail msg = Printf.eprintf "error: %s%!" msg; Options.usage (); exit 1
+
+let line () = Printf.printf "\n%!"
+
+let main () =
+  Options.parse ();
+  if !Options.input_file = "" then fail "missing input file";
+  let ifile = !Options.input_file in
+  let doc =
+    if Filename.check_suffix ifile ".srx" then
+      Tree.load ifile
+    else Tree.parse_xml_uri ifile in
+    if !Options.save_file <> "" then begin
+      Printf.printf "Saving index to %s ... %!" !Options.save_file;
+      Tree.save doc !Options.save_file;
+      Printf.printf "done\n%!"
+    end;
+    Tag.init (Tree.tag_pool doc);
+    line ();
+    if !Options.run_iterative then (test_iterative doc; line ());
+
+    if !Options.run_full_sxsi then (test_full_traversal doc; line ());
+
+    if !Options.run_elements then (test_full_elements doc; line ());
+
+    if !Options.run_jump_tag <> "" then (test_tag_jump doc (Tag.tag  !Options.run_jump_tag);
+                                       line ());
+
+    if !Options.run_pointers <> [] then
+      List.iter (fun s -> test_pointers s doc; line ())
+      !Options.run_pointers;
+
+    exit 0
+;;
+
+let _ =
+  let () = Printexc.record_backtrace true in
+    try
+      main ()
+    with
+       _ ->
+         let msg = Printexc.get_backtrace () in
+         Printf.eprintf "%s\n%!" msg;
+         exit 3
+
+

diff --git a/tree.ml b/tree.ml
index 5327aa0..d304e05 100644 (file)
--- a/tree.ml
+++ b/tree.ml
@@ -128,7 +128,7 @@ external tree_closing : tree -> [`Tree] node -> [`Tree] node = "caml_xml_tree_cl
 external tree_is_open : tree -> [`Tree] node -> bool = "caml_xml_tree_is_open" "noalloc"
 
 
-external benchmark_jump : tree -> Tag.t -> unit = "caml_benchmark_jump" "noalloc"
+external benchmark_jump : tree -> Tag.t -> int = "caml_benchmark_jump" "noalloc"
 
 let benchmark_jump t s = benchmark_jump t.doc s
 

diff --git a/tree.mli b/tree.mli
index 539103c..a9c38f1 100644 (file)
--- a/tree.mli
+++ b/tree.mli
@@ -87,7 +87,7 @@ val text_next :  t -> [`Tree] node -> [`Tree] node -> [`Tree] node
 val closing : t -> [`Tree] node -> [`Tree] node
 val is_open : t -> [`Tree] node -> bool
 
-val benchmark_jump : t -> Tag.t -> unit
+val benchmark_jump : t -> Tag.t -> int
 val benchmark_fcns : t -> int
 val benchmark_fene : t -> int
 val benchmark_lcps : t -> unit