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.parse_xml_uri Sys.argv.(1)
  34   with
  35     | _ ->(
  36         try
  37           Tree.Binary.load Sys.argv.(1)
  38         with
  39           | _ ->
  40               Printf.printf "Error parsing document\n";
  41               exit 2)
  42 ;;
  43 let _ = Tag.init (Tree.Binary.tag_pool doc)
  44 ;;
  45 let tags = (collect_tags doc)
  46 ;;
  47 (*
  48 let _ = Tree.Binary.test_xml_tree Format.std_formatter tags doc
  49 ;;
  50
  51 let _ = Printf.printf "Testing //a with jumping\n"
  52 ;;
  53 *)
  54 let rec test_a dir t acc ctx =
  55   if Tree.Binary.is_node t
  56   then
  57     let acc =
  58       if (Tree.Binary.tag t) == (Tag.tag "a")
  59       then Ata.TS.cons t acc
  60       else acc
  61     in
  62     let first = Tree.Binary.tagged_below t Ptset.empty (Ptset.singleton (Tag.tag "a"))
  63     and next = Tree.Binary.tagged_next t Ptset.empty (Ptset.singleton (Tag.tag "a")) ctx
  64     in
  65     let _ =
  66       Printf.printf "t is :";
  67       Tree.Binary.print_xml_fast stdout t;
  68       Printf.printf " called from %s of " (if dir then "below" else "next");
  69       Tree.Binary.print_xml_fast stdout ctx;
  70       if (Tree.Binary.is_node next)
  71       then begin
  72         Printf.printf ", Next a is %!";
  73         Tree.Binary.print_xml_fast stdout next;
  74       end
  75       else
  76         Printf.printf ", Next a is empty!";
  77       print_newline();
  78     in
  79       test_a false next (test_a true first acc t) t
  80   else acc
  81 ;;
  82
  83 let rec test_text dir t acc ctx =
  84   if Tree.Binary.is_node t
  85   then
  86     let acc =
  87       if (Tree.Binary.tag t) == (Tag.pcdata)
  88       then Ata.TS.cons t acc
  89       else acc
  90     in
  91     let first = Tree.Binary.text_below t
  92     and next = Tree.Binary.text_next t ctx
  93     in
  94       (*
  95     let _ =
  96       Printf.printf "t is :";
  97       Tree.Binary.print_xml_fast stdout t;
  98       Printf.printf " called from %s of " (if dir then "below" else "next");
  99       Tree.Binary.print_xml_fast stdout ctx;
 100       if (Tree.Binary.is_node first)
 101       then begin
 102         Printf.printf "First (text) is %!";
 103         Tree.Binary.print_xml_fast stdout first;
 104       end
 105       else
 106         Printf.printf "First (text) is empty!";
 107       if (Tree.Binary.is_node next)
 108         then begin
 109         Printf.printf ", Next (text) is %!";
 110         Tree.Binary.print_xml_fast stdout next;
 111         end
 112         else
 113         Printf.printf ", Next (text) is empty!";
 114         print_newline();
 115         in  *)
 116       test_text false next (test_text true first acc t) ctx
 117   else acc
 118 ;;
 119 (*
 120 let r = test_a true doc Ata.TS.empty doc;;
 121 (*
 122 let _ = Printf.printf "==> %i nodes\n" (Ata.TS.length r)
 123 let _ = Ata.TS.iter (fun t -> Tree.Binary.print_xml_fast stdout t; print_newline();) r
 124
 125 *)
 126 let _ = Tree.Binary.init_contains doc "car"
 127
 128 let r = test_text true doc Ata.TS.empty doc
 129 let _ = Printf.printf "==> %i nodes\n" (Ata.TS.length r)
 130 (* let _ = Ata.TS.iter (fun t -> Tree.Binary.print_xml_fast stdout t; print_newline();) r *)
 131 ;;
 132
 133 *)
 134 let time f x =
 135   let t1 = Unix.gettimeofday () in
 136   let r = f x in
 137   let t2 = Unix.gettimeofday () in
 138   let t = (1000. *.(t2 -. t1)) in
 139     Printf.eprintf "  %fms\n%!" t ;
 140     r
 141 ;;
 142 let _ = Printf.eprintf "Timing jump //keyword ... "
 143 let _ = time Tree.Binary.test_jump doc (Tag.tag "keyword")