diff options
author | Stephen Hines <srhines@google.com> | 2014-12-01 14:51:49 -0800 |
---|---|---|
committer | Stephen Hines <srhines@google.com> | 2014-12-02 16:08:10 -0800 |
commit | 37ed9c199ca639565f6ce88105f9e39e898d82d0 (patch) | |
tree | 8fb36d3910e3ee4c4e1b7422f4f017108efc52f5 /test/Bindings/OCaml/executionengine.ml | |
parent | d2327b22152ced7bc46dc629fc908959e8a52d03 (diff) | |
download | external_llvm-37ed9c199ca639565f6ce88105f9e39e898d82d0.zip external_llvm-37ed9c199ca639565f6ce88105f9e39e898d82d0.tar.gz external_llvm-37ed9c199ca639565f6ce88105f9e39e898d82d0.tar.bz2 |
Update aosp/master LLVM for rebase to r222494.
Change-Id: Ic787f5e0124df789bd26f3f24680f45e678eef2d
Diffstat (limited to 'test/Bindings/OCaml/executionengine.ml')
-rw-r--r-- | test/Bindings/OCaml/executionengine.ml | 105 |
1 files changed, 105 insertions, 0 deletions
diff --git a/test/Bindings/OCaml/executionengine.ml b/test/Bindings/OCaml/executionengine.ml new file mode 100644 index 0000000..893f988 --- /dev/null +++ b/test/Bindings/OCaml/executionengine.ml @@ -0,0 +1,105 @@ +(* RUN: cp %s %T/executionengine.ml + * RUN: %ocamlc -g -warn-error A -package llvm.executionengine -linkpkg %T/executionengine.ml -o %t + * RUN: %t + * RUN: %ocamlopt -g -warn-error A -package llvm.executionengine -linkpkg %T/executionengine.ml -o %t + * RUN: %t + * REQUIRES: native, object-emission + * XFAIL: vg_leak + *) + +open Llvm +open Llvm_executionengine +open Llvm_target + +(* Note that this takes a moment to link, so it's best to keep the number of + individual tests low. *) + +let context = global_context () +let i8_type = Llvm.i8_type context +let i32_type = Llvm.i32_type context +let i64_type = Llvm.i64_type context +let double_type = Llvm.double_type context + +let () = + assert (Llvm_executionengine.initialize ()) + +let bomb msg = + prerr_endline msg; + exit 2 + +let define_getglobal m pg = + let fn = define_function "getglobal" (function_type i32_type [||]) m in + let b = builder_at_end (global_context ()) (entry_block fn) in + let g = build_call pg [||] "" b in + ignore (build_ret g b); + fn + +let define_plus m = + let fn = define_function "plus" (function_type i32_type [| i32_type; + i32_type |]) m in + let b = builder_at_end (global_context ()) (entry_block fn) in + let add = build_add (param fn 0) (param fn 1) "sum" b in + ignore (build_ret add b); + fn + +let test_executionengine () = + let open Ctypes in + + (* create *) + let m = create_module (global_context ()) "test_module" in + let ee = create m in + + (* add plus *) + let plus = define_plus m in + + (* add module *) + let m2 = create_module (global_context ()) "test_module2" in + add_module m2 ee; + + (* add global mapping *) + (* BROKEN: see PR20656 *) + (* let g = declare_function "g" (function_type i32_type [||]) m2 in + let cg = coerce (Foreign.funptr (void @-> returning int32_t)) (ptr void) + (fun () -> 42l) in + add_global_mapping g cg ee; + + (* check g *) + let cg' = get_pointer_to_global g (ptr void) ee in + if 0 <> ptr_compare cg cg' then bomb "int pointers to g differ"; + + (* add getglobal *) + let getglobal = define_getglobal m2 g in*) + + (* run_static_ctors *) + run_static_ctors ee; + + (* call plus *) + let cplusty = Foreign.funptr (int32_t @-> int32_t @-> returning int32_t) in + let cplus = get_pointer_to_global plus cplusty ee in + if 4l <> cplus 2l 2l then bomb "plus didn't work"; + + (* call getglobal *) + (* let cgetglobalty = Foreign.funptr (void @-> returning int32_t) in + let cgetglobal = get_pointer_to_global getglobal cgetglobalty ee in + if 42l <> cgetglobal () then bomb "getglobal didn't work"; *) + + (* remove_module *) + remove_module m2 ee; + dispose_module m2; + + (* run_static_dtors *) + run_static_dtors ee; + + (* Show that the data layout binding links and runs.*) + let dl = data_layout ee in + + (* Demonstrate that a garbage pointer wasn't returned. *) + let ty = DataLayout.intptr_type context dl in + if ty != i32_type && ty != i64_type then bomb "target_data did not work"; + + (* dispose *) + dispose ee + +let () = + test_executionengine (); + Gc.compact () |