test/Bindings/OCaml/bitreader.ml

   1 (* RUN: rm -rf %t && mkdir -p %t && cp %s %t/bitreader.ml
   2  * RUN: %ocamlc -g -w +A -package llvm.bitreader -package llvm.bitwriter -linkpkg %t/bitreader.ml -o %t/executable
   3  * RUN: %t/executable %t/bitcode.bc
   4  * RUN: %ocamlopt -g -w +A -package llvm.bitreader -package llvm.bitwriter -linkpkg %t/bitreader.ml -o %t/executable
   5  * RUN: %t/executable %t/bitcode.bc
   6  * RUN: llvm-dis < %t/bitcode.bc
   7  * XFAIL: vg_leak
   8  *)
   9
  10 (* Note that this takes a moment to link, so it's best to keep the number of
  11    individual tests low. *)
  12
  13 let context = Llvm.global_context ()
  14
  15 let diagnostic_handler _ = ()
  16
  17 let test x = if not x then exit 1 else ()
  18
  19 let _ =
  20   Llvm.set_diagnostic_handler context (Some diagnostic_handler);
  21
  22   let fn = Sys.argv.(1) in
  23   let m = Llvm.create_module context "ocaml_test_module" in
  24
  25   test (Llvm_bitwriter.write_bitcode_file m fn);
  26
  27   Llvm.dispose_module m;
  28
  29   (* parse_bitcode *)
  30   begin
  31     let mb = Llvm.MemoryBuffer.of_file fn in
  32     begin try
  33       let m = Llvm_bitreader.parse_bitcode context mb in
  34       Llvm.dispose_module m
  35     with x ->
  36       Llvm.MemoryBuffer.dispose mb;
  37       raise x
  38     end
  39   end;
  40
  41   (* MemoryBuffer.of_file *)
  42   test begin try
  43     let mb = Llvm.MemoryBuffer.of_file (fn ^ ".bogus") in
  44     Llvm.MemoryBuffer.dispose mb;
  45     false
  46   with Llvm.IoError _ ->
  47     true
  48   end;
  49
  50   (* get_module *)
  51   begin
  52     let mb = Llvm.MemoryBuffer.of_file fn in
  53     let m = begin try
  54       Llvm_bitreader.get_module context mb
  55     with x ->
  56       Llvm.MemoryBuffer.dispose mb;
  57       raise x
  58     end in
  59     Llvm.dispose_module m
  60   end;
  61
  62   (* corrupt the bitcode *)
  63   let fn = fn ^ ".txt" in
  64   begin let oc = open_out fn in
  65     output_string oc "not a bitcode file\n";
  66     close_out oc
  67   end;
  68
  69   (* test get_module exceptions *)
  70   test begin
  71     try
  72       let mb = Llvm.MemoryBuffer.of_file fn in
  73       let m = begin try
  74         Llvm_bitreader.get_module context mb
  75       with x ->
  76         Llvm.MemoryBuffer.dispose mb;
  77         raise x
  78       end in
  79       Llvm.dispose_module m;
  80       false
  81     with Llvm_bitreader.Error _ ->
  82       true
  83   end