test/Bindings/OCaml/diagnostic_handler.ml

   1 (* RUN: rm -rf %t && mkdir -p %t && cp %s %t/diagnostic_handler.ml
   2  * RUN: %ocamlc -g -w +A -package llvm.bitreader -linkpkg %t/diagnostic_handler.ml -o %t/executable
   3  * RUN: %t/executable %t/bitcode.bc | FileCheck %s
   4  * RUN: %ocamlopt -g -w +A -package llvm.bitreader -linkpkg %t/diagnostic_handler.ml -o %t/executable
   5  * RUN: %t/executable %t/bitcode.bc | FileCheck %s
   6  * XFAIL: vg_leak
   7  *)
   8
   9 let context = Llvm.global_context ()
  10
  11 let diagnostic_handler d =
  12   Printf.printf
  13     "Diagnostic handler called: %s\n" (Llvm.Diagnostic.description d);
  14   match Llvm.Diagnostic.severity d with
  15   | Error -> Printf.printf "Diagnostic severity is Error\n"
  16   | Warning -> Printf.printf "Diagnostic severity is Warning\n"
  17   | Remark -> Printf.printf "Diagnostic severity is Remark\n"
  18   | Note -> Printf.printf "Diagnostic severity is Note\n"
  19
  20 let test x = if not x then exit 1 else ()
  21
  22 let _ =
  23   Llvm.set_diagnostic_handler context (Some diagnostic_handler);
  24
  25   (* corrupt the bitcode *)
  26   let fn = Sys.argv.(1) ^ ".txt" in
  27   begin let oc = open_out fn in
  28     output_string oc "not a bitcode file\n";
  29     close_out oc
  30   end;
  31
  32   test begin
  33     try
  34       let mb = Llvm.MemoryBuffer.of_file fn in
  35       let m = begin try
  36         (* CHECK: Diagnostic handler called: Invalid bitcode signature
  37          * CHECK: Diagnostic severity is Error
  38          *)
  39         Llvm_bitreader.get_module context mb
  40       with x ->
  41         Llvm.MemoryBuffer.dispose mb;
  42         raise x
  43       end in
  44       Llvm.dispose_module m;
  45       false
  46     with Llvm_bitreader.Error _ ->
  47       true
  48   end