unit_test.ml

   1 (******************************************************************************)
   2 (*  SXSI : XPath evaluator                                                    *)
   3 (*  Kim Nguyen (Kim.Nguyen@nicta.com.au)                                      *)
   4 (*  Copyright NICTA 2008                                                      *)
   5 (*  Distributed under the terms of the LGPL (see LICENCE)                     *)
   6 (******************************************************************************)
   7
   8 let collect_tags v =
   9   let rec aux acc v =
  10     if Tree.Binary.is_node v
  11     then
  12       let tag = Tree.Binary.tag v
  13       in
  14       let acc = aux (Ptset.add tag acc) (Tree.Binary.first_child v)
  15       in
  16         aux (Ptset.add tag acc) (Tree.Binary.next_sibling v)
  17     else acc
  18   in
  19     aux Ptset.empty v
  20 ;;
  21
  22
  23 if Array.length (Sys.argv) <> 2
  24 then
  25   begin
  26     Printf.printf "usage: %s file.xml\n" (Sys.argv.(0));
  27     exit 1
  28   end
  29
  30
  31 let doc =
  32         try
  33           Tree.Binary.load Sys.argv.(1)
  34         with
  35           | _ ->
  36               (     try
  37                       Tree.Binary.parse_xml_uri Sys.argv.(1)
  38                     with
  39                       | _ ->(
  40
  41                           Printf.printf "Error parsing document\n";
  42                           exit 2))
  43 ;;
  44 let _ = Tag.init (Tree.Binary.tag_pool doc)
  45 ;;
  46 (*
  47   let tags = (collect_tags doc)
  48   ;;
  49 (*
  50 let _ = Tree.Binary.test_xml_tree Format.std_formatter tags doc
  51 ;;
  52
  53 let _ = Printf.printf "Testing //a with jumping\n"
  54 ;;
  55 *)
  56 let rec test_a dir t acc ctx =
  57   if Tree.Binary.is_node t
  58   then
  59     let acc =
  60       if (Tree.Binary.tag t) == (Tag.tag "a")
  61       then Ata.TS.cons t acc
  62       else acc
  63     in
  64     let first = Tree.Binary.tagged_below t Ptset.empty (Ptset.singleton (Tag.tag "a"))
  65     and next = Tree.Binary.tagged_next t Ptset.empty (Ptset.singleton (Tag.tag "a")) ctx
  66     in
  67     let _ =
  68       Printf.printf "t is :";
  69       Tree.Binary.print_xml_fast stdout t;
  70       Printf.printf " called from %s of " (if dir then "below" else "next");
  71       Tree.Binary.print_xml_fast stdout ctx;
  72       if (Tree.Binary.is_node next)
  73       then begin
  74         Printf.printf ", Next a is %!";
  75         Tree.Binary.print_xml_fast stdout next;
  76       end
  77       else
  78         Printf.printf ", Next a is empty!";
  79       print_newline();
  80     in
  81       test_a false next (test_a true first acc t) t
  82   else acc
  83 ;;
  84
  85 let rec test_text dir t acc ctx =
  86   if Tree.Binary.is_node t
  87   then
  88     let acc =
  89       if (Tree.Binary.tag t) == (Tag.pcdata)
  90       then Ata.TS.cons t acc
  91       else acc
  92     in
  93     let first = Tree.Binary.text_below t
  94     and next = Tree.Binary.text_next t ctx
  95     in
  96       (*
  97     let _ =
  98       Printf.printf "t is :";
  99       Tree.Binary.print_xml_fast stdout t;
 100       Printf.printf " called from %s of " (if dir then "below" else "next");
 101       Tree.Binary.print_xml_fast stdout ctx;
 102       if (Tree.Binary.is_node first)
 103       then begin
 104         Printf.printf "First (text) is %!";
 105         Tree.Binary.print_xml_fast stdout first;
 106       end
 107       else
 108         Printf.printf "First (text) is empty!";
 109       if (Tree.Binary.is_node next)
 110         then begin
 111         Printf.printf ", Next (text) is %!";
 112         Tree.Binary.print_xml_fast stdout next;
 113         end
 114         else
 115         Printf.printf ", Next (text) is empty!";
 116         print_newline();
 117         in  *)
 118       test_text false next (test_text true first acc t) ctx
 119   else acc
 120 ;;
 121 (*
 122 let r = test_a true doc Ata.TS.empty doc;;
 123 (*
 124 let _ = Printf.printf "==> %i nodes\n" (Ata.TS.length r)
 125 let _ = Ata.TS.iter (fun t -> Tree.Binary.print_xml_fast stdout t; print_newline();) r
 126
 127 *)
 128 let _ = Tree.Binary.init_contains doc "car"
 129
 130 let r = test_text true doc Ata.TS.empty doc
 131 let _ = Printf.printf "==> %i nodes\n" (Ata.TS.length r)
 132 (* let _ = Ata.TS.iter (fun t -> Tree.Binary.print_xml_fast stdout t; print_newline();) r *)
 133 ;;
 134
 135 *) *)
 136 let time f x =
 137   let t1 = Unix.gettimeofday () in
 138   let r = f x in
 139   let t2 = Unix.gettimeofday () in
 140   let t = (1000. *.(t2 -. t1)) in
 141     Printf.eprintf "  %fms\n%!" t ;
 142     r
 143 ;;
 144 let _ = Printf.eprintf "Timing full //keyword ... "
 145 let x = List.length (time (Tree.Binary.time_xml_tree doc) (Tag.tag "keyword"))
 146 let _ = Printf.eprintf "Timing jump //keyword ... "
 147 let y = List.length (time (Tree.Binary.time_xml_tree2 doc) (Tag.tag "keyword"))
 148 let _ = Printf.eprintf "coherant : %b\n" (x=y)