112 lines · plain
1(* RUN: rm -rf %t && mkdir -p %t && cp %s %t/target.ml2 * RUN: %ocamlc -g -w +A -package llvm.target -package llvm.all_backends -linkpkg %t/target.ml -o %t/executable3 * RUN: %ocamlopt -g -w +A -package llvm.target -package llvm.all_backends -linkpkg %t/target.ml -o %t/executable4 * RUN: %t/executable %t/bitcode.bc5 * XFAIL: vg_leak6 *)7 8(* Note: It takes several seconds for ocamlopt to link an executable with9 libLLVMCore.a, so it's better to write a big test than a bunch of10 little ones. *)11 12open Llvm13open Llvm_target14 15let () = Llvm_all_backends.initialize ()16 17let context = global_context ()18let i32_type = Llvm.i32_type context19let i64_type = Llvm.i64_type context20 21(* Tiny unit test framework - really just to help find which line is busted *)22let print_checkpoints = false23 24let _ =25 Printexc.record_backtrace true26 27let assert_equal a b =28 if a <> b then failwith "assert_equal"29 30 31(*===-- Fixture -----------------------------------------------------------===*)32 33let filename = Sys.argv.(1)34let m = create_module context filename35 36let target = Target.by_triple (Target.default_triple ())37 38let machine = TargetMachine.create (Target.default_triple ()) target39 40(*===-- Data Layout -------------------------------------------------------===*)41 42let test_target_data () =43 let module DL = DataLayout in44 let layout = "e-p:32:32-f64:32:64-v64:32:64-v128:32:128-n32-S32" in45 let dl = DL.of_string layout in46 let sty = struct_type context [| i32_type; i64_type |] in47 48 assert_equal (DL.as_string dl) layout;49 assert_equal (DL.byte_order dl) Endian.Little;50 assert_equal (DL.pointer_size dl) 4;51 assert_equal (DL.intptr_type context dl) i32_type;52 assert_equal (DL.qualified_pointer_size 0 dl) 4;53 assert_equal (DL.qualified_intptr_type context 0 dl) i32_type;54 assert_equal (DL.size_in_bits sty dl) (Int64.of_int 96);55 assert_equal (DL.store_size sty dl) (Int64.of_int 12);56 assert_equal (DL.abi_size sty dl) (Int64.of_int 12);57 assert_equal (DL.stack_align sty dl) 4;58 assert_equal (DL.preferred_align sty dl) 8;59 assert_equal (DL.preferred_align_of_global (declare_global sty "g" m) dl) 8;60 assert_equal (DL.element_at_offset sty (Int64.of_int 1) dl) 0;61 assert_equal (DL.offset_of_element sty 1 dl) (Int64.of_int 4)62 63 64(*===-- Target ------------------------------------------------------------===*)65 66let test_target () =67 let module T = Target in68 ignore (T.succ target);69 ignore (T.name target);70 ignore (T.description target);71 ignore (T.has_jit target);72 ignore (T.has_target_machine target);73 ignore (T.has_asm_backend target)74 75 76(*===-- Target Machine ----------------------------------------------------===*)77 78let test_target_machine () =79 let module TM = TargetMachine in80 assert_equal (TM.target machine) target;81 assert_equal (TM.triple machine) (Target.default_triple ());82 assert_equal (TM.cpu machine) "";83 assert_equal (TM.features machine) "";84 ignore (TM.data_layout machine);85 TM.set_verbose_asm true machine86 87 88(*===-- Code Emission -----------------------------------------------------===*)89 90let test_code_emission () =91 TargetMachine.emit_to_file m CodeGenFileType.ObjectFile filename machine;92 try93 TargetMachine.emit_to_file m CodeGenFileType.ObjectFile94 "/nonexistent/file" machine;95 failwith "must raise"96 with Llvm_target.Error _ ->97 ();98 99 let buf = TargetMachine.emit_to_memory_buffer m CodeGenFileType.ObjectFile100 machine in101 Llvm.MemoryBuffer.dispose buf102 103 104(*===-- Driver ------------------------------------------------------------===*)105 106let _ =107 test_target_data ();108 test_target ();109 test_target_machine ();110 test_code_emission ();111 dispose_module m112