Home | History | Annotate | Download | only in OCaml
      1 (* RUN: cp %s %T/bitreader.ml
      2  * RUN: %ocamlc -g -w +A -package llvm.bitreader -package llvm.bitwriter -linkpkg %T/bitreader.ml -o %t
      3  * RUN: %t %t.bc
      4  * RUN: %ocamlopt -g -w +A -package llvm.bitreader -package llvm.bitwriter -linkpkg %T/bitreader.ml -o %t
      5  * RUN: %t %t.bc
      6  * RUN: llvm-dis < %t.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 test x = if not x then exit 1 else ()
     16 
     17 let _ =
     18   let fn = Sys.argv.(1) in
     19   let m = Llvm.create_module context "ocaml_test_module" in
     20 
     21   test (Llvm_bitwriter.write_bitcode_file m fn);
     22 
     23   Llvm.dispose_module m;
     24 
     25   (* parse_bitcode *)
     26   begin
     27     let mb = Llvm.MemoryBuffer.of_file fn in
     28     begin try
     29       let m = Llvm_bitreader.parse_bitcode context mb in
     30       Llvm.dispose_module m
     31     with x ->
     32       Llvm.MemoryBuffer.dispose mb;
     33       raise x
     34     end
     35   end;
     36 
     37   (* MemoryBuffer.of_file *)
     38   test begin try
     39     let mb = Llvm.MemoryBuffer.of_file (fn ^ ".bogus") in
     40     Llvm.MemoryBuffer.dispose mb;
     41     false
     42   with Llvm.IoError _ ->
     43     true
     44   end;
     45 
     46   (* get_module *)
     47   begin
     48     let mb = Llvm.MemoryBuffer.of_file fn in
     49     let m = begin try
     50       Llvm_bitreader.get_module context mb
     51     with x ->
     52       Llvm.MemoryBuffer.dispose mb;
     53       raise x
     54     end in
     55     Llvm.dispose_module m
     56   end;
     57 
     58   (* corrupt the bitcode *)
     59   let fn = fn ^ ".txt" in
     60   begin let oc = open_out fn in
     61     output_string oc "not a bitcode file\n";
     62     close_out oc
     63   end;
     64 
     65   (* test get_module exceptions *)
     66   test begin
     67     try
     68       let mb = Llvm.MemoryBuffer.of_file fn in
     69       let m = begin try
     70         Llvm_bitreader.get_module context mb
     71       with x ->
     72         Llvm.MemoryBuffer.dispose mb;
     73         raise x
     74       end in
     75       Llvm.dispose_module m;
     76       false
     77     with Llvm_bitreader.Error _ ->
     78       true
     79   end
     80