1(* RUN: cp %s %T/diagnostic_handler.ml
2 * RUN: %ocamlc -g -w +A -package llvm.bitreader -linkpkg %T/diagnostic_handler.ml -o %t
3 * RUN: %t %t.bc | FileCheck %s
4 * RUN: %ocamlopt -g -w +A -package llvm.bitreader -linkpkg %T/diagnostic_handler.ml -o %t
5 * RUN: %t %t.bc | FileCheck %s
6 * XFAIL: vg_leak
7 *)
8
9let context = Llvm.global_context ()
10
11let 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
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" 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
49