Fix a nasty bug where the wrong pointer was passed to the C side.
authorKim Nguyễn <kn@lri.fr>
Fri, 12 Oct 2012 20:46:38 +0000 (22:46 +0200)
committerKim Nguyễn <kn@lri.fr>
Fri, 12 Oct 2012 20:46:38 +0000 (22:46 +0200)
src/common_stub.hpp
src/lexindex_stub.cpp
src/lextest.ml
src/tree.ml
src/tree.mli

index 6bfb57d..3e874b7 100644 (file)
@@ -13,6 +13,7 @@ extern "C" {
 #include <caml/bigarray.h>
 }
 #include <typeinfo>
+#include <cstdio>
 
 #define NoAlloc
 
index a09216e..5e6dcdc 100644 (file)
@@ -48,10 +48,10 @@ extern "C" value caml_build_lex_index(value vtree, value vtag)
 {
   CAMLparam2(vtree, vtag);
   CAMLlocal1(vindex);
+  const char * s;
   vindex = sxsi_alloc_custom<lex_index*>();
   xml_tree * tree = XMLTREE(vtree);
   xml_tree::tag_t tag = TAG(vtag);
-
   //Uncomment the following and comment the failwith line
   //LEXINDEX(vindex) = ... return a lex_index* ....
 
index 0c297ca..77701cb 100644 (file)
@@ -2,7 +2,8 @@
 
 type index
 
-external build_lex_index : Tree.t -> Tag.t -> index = "caml_build_lex_index"
+external build_lex_index : Tree.tree_pointer -> Tag.t -> index = "caml_build_lex_index"
+
 external print_lex_index : index -> unit = "caml_print_lex_index"
 
 
@@ -20,8 +21,9 @@ let main () =
     else
     let () = Printf.eprintf "Error: unrecognized extension" in exit 2
   in
-  Printf.printf "Building lex index\n%!";
-  let index = build_lex_index document (Tag.tag Sys.argv.(2)) in
+  Tag.init (Tree.tag_operations document);
+  Printf.printf "Building lex index for tag %s\n%!" (Tag.to_string (Tag.tag Sys.argv.(2)));
+  let index = build_lex_index (Tree.get_tree_pointer document) (Tag.tag Sys.argv.(2)) in
   Printf.printf "Printing lex index\n%!";
   print_lex_index index;
   exit 0
index 31e2f79..ef2a082 100644 (file)
@@ -809,3 +809,6 @@ Largest tag id: %i@\n@?"
 ;;
 
 *)
+
+type tree_pointer = tree
+let get_tree_pointer x = x.doc
index e24add3..883538d 100644 (file)
@@ -91,3 +91,6 @@ val bit_vector_unsafe_set : bit_vector -> int -> bool -> unit
 val bit_vector_unsafe_get : bit_vector -> int -> bool
 
 val reinit : unit -> unit
+
+type tree_pointer
+val get_tree_pointer : t -> tree_pointer