49 lines · plain
1(* RUN: rm -rf %t && mkdir -p %t && cp %s %t/diagnostic_handler.ml2 * RUN: %ocamlc -g -w +A -package llvm.bitreader -linkpkg %t/diagnostic_handler.ml -o %t/executable3 * RUN: %t/executable %t/bitcode.bc | FileCheck %s4 * RUN: %ocamlopt -g -w +A -package llvm.bitreader -linkpkg %t/diagnostic_handler.ml -o %t/executable5 * RUN: %t/executable %t/bitcode.bc | FileCheck %s6 * XFAIL: vg_leak7 *)8 9let context = Llvm.global_context ()10 11let diagnostic_handler d =12 Printf.printf13 "Diagnostic handler called: %s\n" (Llvm.Diagnostic.description d);14 match Llvm.Diagnostic.severity d with15 | 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 20let test x = if not x then exit 1 else ()21 22let _ =23 Llvm.set_diagnostic_handler context (Some diagnostic_handler);24 25 (* corrupt the bitcode *)26 let fn = Sys.argv.(1) ^ ".txt" in27 begin let oc = open_out fn in28 output_string oc "not a bitcode file\n";29 close_out oc30 end;31 32 test begin33 try34 let mb = Llvm.MemoryBuffer.of_file fn in35 let m = begin try36 (* CHECK: Diagnostic handler called: Invalid bitcode signature37 * CHECK: Diagnostic severity is Error38 *)39 Llvm_bitreader.get_module context mb40 with x ->41 Llvm.MemoryBuffer.dispose mb;42 raise x43 end in44 Llvm.dispose_module m;45 false46 with Llvm_bitreader.Error _ ->47 true48 end49