1(* RUN: rm -rf %t.builddir
2 * RUN: mkdir -p %t.builddir
3 * RUN: cp %s %t.builddir
4 * RUN: %ocamlopt -g -warn-error A llvm.cmxa llvm_target.cmxa llvm_executionengine.cmxa %t.builddir/target.ml -o %t
5 * RUN: %t %t.bc
6 * REQUIRES: native, object-emission
7 * XFAIL: vg_leak
8 *)
9
10(* Note: It takes several seconds for ocamlopt to link an executable with
11         libLLVMCore.a, so it's better to write a big test than a bunch of
12         little ones. *)
13
14open Llvm
15open Llvm_target
16
17let _ = Llvm_executionengine.initialize_native_target ()
18
19let context = global_context ()
20let i32_type = Llvm.i32_type context
21let i64_type = Llvm.i64_type context
22
23(* Tiny unit test framework - really just to help find which line is busted *)
24let print_checkpoints = false
25
26let _ =
27  Printexc.record_backtrace true
28
29let assert_equal a b =
30  if a <> b then failwith "assert_equal"
31
32
33(*===-- Fixture -----------------------------------------------------------===*)
34
35let filename = Sys.argv.(1)
36let m = create_module context filename
37
38let target = Target.by_triple (Target.default_triple ())
39
40let machine = TargetMachine.create (Target.default_triple ()) target
41
42(*===-- Data Layout -------------------------------------------------------===*)
43
44let test_target_data () =
45  let module DL = DataLayout in
46  let layout = "e-p:32:32:32-S32-i1:8:8-i8:8:8-i16:16:16-i32:32:32-i64:32:64-" ^
47               "f16:16:16-f32:32:32-f64:32:64-f128:128:128-v64:32:64-v128:32:128-" ^
48               "a0:0:64-n32" in
49  let dl     = DL.of_string layout in
50  let sty    = struct_type context [| i32_type; i64_type |] in
51
52  assert_equal (DL.as_string dl) layout;
53  assert_equal (DL.byte_order dl) Endian.Little;
54  assert_equal (DL.pointer_size dl) 4;
55  assert_equal (DL.intptr_type context dl) i32_type;
56  assert_equal (DL.qualified_pointer_size 0 dl) 4;
57  assert_equal (DL.qualified_intptr_type context 0 dl) i32_type;
58  assert_equal (DL.size_in_bits sty dl) (Int64.of_int 96);
59  assert_equal (DL.store_size sty dl) (Int64.of_int 12);
60  assert_equal (DL.abi_size sty dl) (Int64.of_int 12);
61  assert_equal (DL.stack_align sty dl) 4;
62  assert_equal (DL.preferred_align sty dl) 8;
63  assert_equal (DL.preferred_align_of_global (declare_global sty "g" m) dl) 8;
64  assert_equal (DL.element_at_offset sty (Int64.of_int 1) dl) 0;
65  assert_equal (DL.offset_of_element sty 1 dl) (Int64.of_int 4);
66
67  let pm = PassManager.create () in
68  ignore (DL.add_to_pass_manager pm dl)
69
70
71(*===-- Target ------------------------------------------------------------===*)
72
73let test_target () =
74  let module T = Target in
75  ignore (T.succ target);
76  ignore (T.name target);
77  ignore (T.description target);
78  ignore (T.has_jit target);
79  ignore (T.has_target_machine target);
80  ignore (T.has_asm_backend target)
81
82
83(*===-- Target Machine ----------------------------------------------------===*)
84
85let test_target_machine () =
86  let module TM = TargetMachine in
87  assert_equal (TM.target machine) target;
88  assert_equal (TM.triple machine) (Target.default_triple ());
89  assert_equal (TM.cpu machine) "";
90  assert_equal (TM.features machine) "";
91  ignore (TM.data_layout machine)
92
93
94(*===-- Code Emission -----------------------------------------------------===*)
95
96let test_code_emission () =
97  TargetMachine.emit_to_file m CodeGenFileType.ObjectFile filename machine;
98  try
99    TargetMachine.emit_to_file m CodeGenFileType.ObjectFile
100                               "/nonexistent/file" machine;
101    failwith "must raise"
102  with Llvm_target.Error _ ->
103    ();
104
105  let buf = TargetMachine.emit_to_memory_buffer m CodeGenFileType.ObjectFile
106                                                machine in
107  Llvm.MemoryBuffer.dispose buf
108
109
110(*===-- Driver ------------------------------------------------------------===*)
111
112let _ =
113  test_target_data ();
114  test_target ();
115  test_target_machine ();
116  (* test_code_emission (); *) (* broken without AsmParser support *)
117  dispose_module m
118